release version 7.2.
* lisp/mail/mh-alias.el, lisp/mail/mh-comp.el,
lisp/mail/mh-customize.el, lisp/mail/mh-e.el, lisp/mail/mh-funcs.el,
lisp/mail/mh-identity.el, lisp/mail/mh-index.el,
lisp/mail/mh-loaddefs.el, lisp/mail/mh-mime.el, lisp/mail/mh-pick.el,
lisp/mail/mh-seq.el, lisp/mail/mh-speed.el, lisp/mail/mh-utils.el,
lisp/mail/mh-xemacs-compat.el: Moved to mh-e. Note that reply2.pbm and
reply2.xpm, which were created by the MH-E package, were left in mail
since they can probably be used by other mail packages.
* makefile.w32-in (WINS): Added mh-e.
* makefile.nt (WINS): Added mh-e.
+2003-01-25 Bill Wohler <wohler@newt.com>
+
+ * mh-e: Created directory. ChangeLog will appear in a week when we
+ release version 7.2.
+
+ * lisp/mail/mh-alias.el, lisp/mail/mh-comp.el,
+ lisp/mail/mh-customize.el, lisp/mail/mh-e.el,
+ lisp/mail/mh-funcs.el, lisp/mail/mh-identity.el,
+ lisp/mail/mh-index.el, lisp/mail/mh-loaddefs.el,
+ lisp/mail/mh-mime.el, lisp/mail/mh-pick.el, lisp/mail/mh-seq.el,
+ lisp/mail/mh-speed.el, lisp/mail/mh-utils.el,
+ lisp/mail/mh-xemacs-compat.el: Moved to mh-e. Note that reply2.pbm
+ and reply2.xpm, which were created by the MH-E package, were left
+ in mail since they can probably be used by other mail packages.
+
+ * makefile.w32-in (WINS): Added mh-e.
+
+ * makefile.nt (WINS): Added mh-e.
+
2003-01-25 Richard M. Stallman <rms@gnu.org>
* emacs-lisp/bytecomp.el (byte-compile-file-form-custom-declare-variable):
+++ /dev/null
-;;; mh-alias.el --- MH-E mail alias completion and expansion
-;;
-;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Peter S. Galbraith <psg@debian.org>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; [To be deleted when documented in MH-E manual.]
-;;
-;; This module provides mail alias completion when entering addresses.
-;;
-;; Use the TAB key to complete aliases (and optionally local usernames) when
-;; initially composing a message in the To: and Cc: minibuffer prompts. You
-;; may enter multiple addressees separated with a comma (but do *not* add any
-;; space after the comma).
-;;
-;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
-;; complete aliases. This is useful when you want to add an addressee as an
-;; afterthought when creating a message, or when adding an additional
-;; addressee to a reply.
-;;
-;; By default, completion is case-insensitive. This can be changed by
-;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
-;; useful, for example, to differentiate between people aliases in lowercase
-;; such as:
-;;
-;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
-;;
-;; and lists in uppercase such as:
-;;
-;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
-;;
-;; Note that this variable affects minibuffer completion only. If you have an
-;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
-;; be expanded in the letter buffer because MH is case-insensitive.
-;;
-;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
-;; the minibuffer, the expansion for the previous mail alias appears briefly.
-;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
-;;
-;; The addresses and aliases entered in the minibuffer are added to the
-;; message draft. To expand the aliases before they are added to the draft,
-;; customize the variable `mh-alias-expand-aliases-flag'.
-;;
-;; Completion is also performed on usernames extracted from the /etc/passwd
-;; file. This can be a handy tool on a machine where you and co-workers
-;; exchange messages, but should probably be disabled on a system with
-;; thousands of users you don't know. This is done by customizing the
-;; variable `mh-alias-local-users'. This variable also takes a string which
-;; is executed to generate the password file. For example, you'd use "ypcat
-;; passwd" for NIS.
-;;
-;; Aliases are loaded the first time you send mail and get the "To:" prompt
-;; and whenever a source of aliases changes. Sources of system aliases are
-;; defined in the customization variable `mh-alias-system-aliases' and
-;; include:
-;;
-;; /etc/nmh/MailAliases
-;; /usr/lib/mh/MailAliases
-;; /etc/passwd
-;;
-;; Sources of personal aliases are read from the files listed in your MH
-;; profile component Aliasfile. Multiple files are separated by white space
-;; and are relative to your mail directory.
-;;
-;; Alias Insertions
-;; ~~~~~~~~~~~~~~~~
-;; There are commands to insert new aliases into your alias file(s) (defined
-;; by the `Aliasfile' component in the .mh_profile file or by the variable
-;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
-;; an alias from the From line of the current message.
-
-;;; Code:
-
-(require 'mh-e)
-(load "cmr" t t) ; Non-fatal dependency for
- ; completing-read-multiple.
-(eval-when-compile (defvar mail-abbrev-syntax-table))
-
-;;; Autoloads
-(autoload 'mail-abbrev-complete-alias "mailabbrev")
-(autoload 'multi-prompt "multi-prompt")
-
-(defvar mh-alias-alist nil
- "Alist of MH aliases.")
-(defvar mh-alias-blind-alist nil
- "Alist of MH aliases that are blind lists.")
-(defvar mh-alias-passwd-alist nil
- "Alist of aliases extracted from passwd file and their expansions.")
-(defvar mh-alias-tstamp nil
- "Time aliases were last loaded.")
-(defvar mh-alias-read-address-map nil)
-(if mh-alias-read-address-map
- ()
- (setq mh-alias-read-address-map
- (copy-keymap minibuffer-local-completion-map))
- (if mh-alias-flash-on-comma
- (define-key mh-alias-read-address-map
- "," 'mh-alias-minibuffer-confirm-address))
- (define-key mh-alias-read-address-map " " 'self-insert-command))
-
-\f
-;;; Alias Loading
-
-(defun mh-alias-tstamp (arg)
- "Check whether alias files have been modified.
-Return t if any file listed in the MH profile component Aliasfile has been
-modified since the timestamp.
-If ARG is non-nil, set timestamp with the current time."
- (if arg
- (let ((time (current-time)))
- (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
- (let ((stamp))
- (car (memq t (mapcar
- (function
- (lambda (file)
- (when (and file (file-exists-p file))
- (setq stamp (nth 5 (file-attributes file)))
- (or (> (car stamp) (car mh-alias-tstamp))
- (and (= (car stamp) (car mh-alias-tstamp))
- (> (cadr stamp) (cadr mh-alias-tstamp)))))))
- (mh-alias-filenames t)))))))
-
-(defun mh-alias-filenames (arg)
- "Return list of filenames that contain aliases.
-The filenames come from the MH profile component Aliasfile and are expanded.
-If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
- (or mh-progs (mh-find-path))
- (save-excursion
- (let* ((filename (mh-profile-component "Aliasfile"))
- (filelist (and filename (split-string filename "[ \t]+")))
- (userlist
- (mapcar
- (function
- (lambda (file)
- (if (and mh-user-path file
- (file-exists-p (expand-file-name file mh-user-path)))
- (expand-file-name file mh-user-path))))
- filelist)))
- (if arg
- (if (stringp mh-alias-system-aliases)
- (append userlist (list mh-alias-system-aliases))
- (append userlist mh-alias-system-aliases))
- userlist))))
-
-(defun mh-alias-local-users ()
- "Return an alist of local users from /etc/passwd."
- (let (passwd-alist)
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- (cond
- ((eq mh-alias-local-users t)
- (if (file-readable-p "/etc/passwd")
- (insert-file-contents "/etc/passwd")))
- ((stringp mh-alias-local-users)
- (insert mh-alias-local-users "\n")
- (shell-command-on-region (point-min)(point-max) mh-alias-local-users t)
- (goto-char (point-min))))
- (while (< (point) (point-max))
- (cond
- ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]")
- (when (> (string-to-int (match-string 2)) 200)
- (let* ((username (match-string 1))
- (gecos-name (match-string 3))
- (realname
- (if (string-match "&" gecos-name)
- (concat
- (substring gecos-name 0 (match-beginning 0))
- (capitalize username)
- (substring gecos-name (match-end 0)))
- gecos-name)))
- (setq passwd-alist
- (cons (list username
- (if (string-equal "" realname)
- (concat "<" username ">")
- (concat realname " <" username ">")))
- passwd-alist))))))
- (forward-line 1)))
- passwd-alist))
-
-;;;###mh-autoload
-(defun mh-alias-reload ()
- "Load MH aliases into `mh-alias-alist'."
- (interactive)
- (save-excursion
- (message "Loading MH aliases...")
- (mh-alias-tstamp t)
- (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
- (setq mh-alias-alist nil)
- (setq mh-alias-blind-alist nil)
- (while (< (point) (point-max))
- (cond
- ((looking-at "^[ \t]")) ;Continuation line
- ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
- (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist))
- (setq mh-alias-blind-alist
- (cons (list (match-string 1)) mh-alias-blind-alist))
- (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
- ((looking-at "\\(.+\\): .*$") ; A new MH alias
- (when (not (assoc-ignore-case (match-string 1) mh-alias-alist))
- (setq mh-alias-alist
- (cons (list (match-string 1)) mh-alias-alist)))))
- (forward-line 1)))
- (when mh-alias-local-users
- (setq mh-alias-passwd-alist (mh-alias-local-users))
- ;; Update aliases with local users, but leave existing aliases alone.
- (let ((local-users mh-alias-passwd-alist)
- user)
- (while local-users
- (setq user (car local-users))
- (if (not (assoc-ignore-case (car user) mh-alias-alist))
- (setq mh-alias-alist (append mh-alias-alist (list user))))
- (setq local-users (cdr local-users)))))
- (message "Loading MH aliases...done"))
-
-(defun mh-alias-reload-maybe ()
- "Load new MH aliases."
- (if (or (not mh-alias-alist) ; Doesn't exist, so create it.
- (mh-alias-tstamp nil)) ; Out of date, so recreate it.
- (mh-alias-reload)))
-
-\f
-;;; Alias Expansion
-
-(defun mh-alias-ali (alias &optional user)
- "Return ali expansion for ALIAS.
-ALIAS must be a string for a single alias.
-If USER is t, then assume ALIAS is an address and call ali -user.
-ali returns the string unchanged if not defined. The same is done here."
- (save-excursion
- (let ((user-arg (if user "-user" "-nouser")))
- (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
- (goto-char (point-max))
- (if (looking-at "^$") (delete-backward-char 1))
- (buffer-substring (point-min)(point-max))))
-
-(defun mh-alias-expand (alias)
- "Return expansion for ALIAS.
-Blind aliases or users from /etc/passwd are not expanded."
- (cond
- ((assoc-ignore-case alias mh-alias-blind-alist)
- alias) ; Don't expand a blind alias
- ((assoc-ignore-case alias mh-alias-passwd-alist)
- (cadr (assoc-ignore-case alias mh-alias-passwd-alist)))
- (t
- (mh-alias-ali alias))))
-
-;;;###mh-autoload
-(defun mh-read-address (prompt)
- "Read an address from the minibuffer with PROMPT."
- (mh-alias-reload-maybe)
- (if (not mh-alias-alist) ; If still no aliases, just prompt
- (read-string prompt)
- (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
- (completion-ignore-case mh-alias-completion-ignore-case-flag)
- (the-answer
- (or (cond
- ((fboundp 'completing-read-multiple)
- (completing-read-multiple prompt mh-alias-alist nil nil))
- ((featurep 'multi-prompt)
- (multi-prompt "," nil prompt mh-alias-alist nil nil))
- (t
- (split-string
- (completing-read "To: " mh-alias-alist nil nil)
- ","))))))
- (if (not mh-alias-expand-aliases-flag)
- (mapconcat 'identity the-answer ", ")
- ;; Loop over all elements, checking if in passwd aliast or blind first
- (mapconcat 'mh-alias-expand the-answer ",\n ")))))
-
-;;;###mh-autoload
-(defun mh-alias-minibuffer-confirm-address ()
- "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
- (interactive)
- (if (not mh-alias-flash-on-comma)
- ()
- (save-excursion
- (let* ((case-fold-search t)
- (the-name (buffer-substring
- (progn (skip-chars-backward " \t")(point))
- ;; This moves over to previous comma, if any
- (progn (or (and (not (= 0 (skip-chars-backward "^,")))
- ;; the skips over leading whitespace
- (skip-chars-forward " "))
- ;; no comma, then to beginning of word
- (skip-chars-backward "^ \t"))
- ;; In Emacs21, the beginning of the prompt
- ;; line is accessible, which wasn't the case
- ;; in emacs20. Skip over it.
- (if (looking-at "^[^ \t]+:")
- (skip-chars-forward "^ \t"))
- (skip-chars-forward " ")
- (point)))))
- (if (assoc-ignore-case the-name mh-alias-alist)
- (message "%s -> %s" the-name (mh-alias-expand the-name))
- ;; Check if if was a single word likely to be an alias
- (if (and (equal mh-alias-flash-on-comma 1)
- (not (string-match " " the-name)))
- (message "No alias for %s" the-name))))))
- (self-insert-command 1))
-
-;;;###mh-autoload
-(defun mh-alias-letter-expand-alias ()
- "Expand mail alias before point."
- (mh-alias-reload-maybe)
- (let ((mail-abbrevs mh-alias-alist))
- (mail-abbrev-complete-alias))
- (when mh-alias-expand-aliases-flag
- (let* ((end (point))
- (syntax-table (syntax-table))
- (beg (unwind-protect
- (save-excursion
- (set-syntax-table mail-abbrev-syntax-table)
- (backward-word 1)
- (point))
- (set-syntax-table syntax-table)))
- (alias (buffer-substring beg end))
- (expansion (mh-alias-expand alias)))
- (delete-region beg end)
- (insert expansion))))
-\f
-;;; Adding addresses to alias file.
-
-(defun mh-alias-suggest-alias (string)
- "Suggest an alias for STRING."
- (cond
- ((string-match "^\\sw+$" string)
- ;; One word -> downcase it.
- (downcase string))
- ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
- ;; Two words -> first.last
- (downcase
- (format "%s.%s" (match-string 1 string) (match-string 2 string))))
- ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
- string)
- ;; email only -> downcase username
- (downcase (match-string 1 string)))
- ((string-match "^\"\\(.*\\)\".*" string)
- ;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
- (mh-alias-suggest-alias (match-string 1 string)))
- ((string-match "^\\(.*\\) +<.*>$" string)
- ;; Some name <somename@foo.bar> -> recurse -> Some name
- (mh-alias-suggest-alias (match-string 1 string)))
- ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
- ;; somename@foo.bar (Some name) -> recurse -> Some name
- (mh-alias-suggest-alias (match-string 1 string)))
- ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
- ;; Strip out title
- (mh-alias-suggest-alias (match-string 2 string)))
- ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
- ;; Strip out tails with comma
- (mh-alias-suggest-alias (match-string 1 string)))
- ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
- ;; Strip out tails
- (mh-alias-suggest-alias (match-string 1 string)))
- ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
- ;; Strip out initials
- (mh-alias-suggest-alias
- (format "%s %s" (match-string 1 string) (match-string 2 string))))
- ((string-match "^\\([^,]+\\), +\\(.*\\)$" string)
- ;; Reverse order of comma-separated fields
- (mh-alias-suggest-alias
- (format "%s %s" (match-string 2 string) (match-string 1 string))))
- (t
- ;; Output string, with spaces replaced by dots.
- (downcase (replace-regexp-in-string
- "\\.\\.+" "."
- (replace-regexp-in-string " +" "." string))))))
-
-(defun mh-alias-which-file-has-alias (alias file-list)
- "Return the name of writable file which defines ALIAS from list FILE-LIST."
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (let ((the-list file-list)
- (found))
- (while the-list
- (erase-buffer)
- (when (file-writable-p (car file-list))
- (insert-file-contents (car file-list))
- (if (re-search-forward (concat "^" (regexp-quote alias) ":"))
- (setq found (car file-list)
- the-list nil)
- (setq the-list (cdr the-list)))))
- found)))
-
-(defun mh-alias-insert-file (&optional alias)
- "Return the alias file to write a new entry for ALIAS in.
-Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component
-value.
-If ALIAS is specified and it already exists, try to return the file that
-contains it."
- (cond
- ((and mh-alias-insert-file (listp mh-alias-insert-file))
- (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
- (car mh-alias-insert-file)
- (if (or (not alias)
- (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
- (completing-read "Alias file [press Tab]: "
- (mapcar 'list mh-alias-insert-file) nil t)
- (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
- (completing-read "Alias file [press Tab]: "
- (mapcar 'list mh-alias-insert-file) nil t)))))
- ((and mh-alias-insert-file (stringp mh-alias-insert-file))
- mh-alias-insert-file)
- (t
- ;; writable ones returned from (mh-alias-filenames):
- (let ((autolist (delq nil (mapcar (lambda (file)
- (if (and (file-writable-p file)
- (not (string-equal
- file "/etc/passwd")))
- file))
- (mh-alias-filenames t)))))
- (cond
- ((not autolist)
- (error "No writable alias file.
-Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
- ((not (elt autolist 1)) ; Only one entry, use it
- (car autolist))
- ((or (not alias)
- (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
- (completing-read "Alias file [press Tab]: "
- (mapcar 'list autolist) nil t))
- (t
- (or (mh-alias-which-file-has-alias alias autolist)
- (completing-read "Alias file [press Tab]: "
- (mapcar 'list autolist) nil t))))))))
-
-(defun mh-alias-address-to-alias (address)
- "Return the ADDRESS alias if defined, or nil."
- (let* ((aliases (mh-alias-ali address t)))
- (if (string-equal aliases address)
- nil ; ali returned same string -> no.
- ;; For the comma-separated aliases reyurned by ali, check that one of
- ;; them doesn't expand into a list. e.g. we do have an individual
- ;; alias for that adress.
- (car (delq nil (mapcar
- (function
- (lambda (alias)
- (let ((recurse (mh-alias-ali alias nil)))
- (if (string-match ".*,.*" recurse)
- nil
- alias))))
- (split-string aliases ", +")))))))
-
-;;;###mh-autoload
-(defun mh-alias-from-has-no-alias-p ()
- "Return t is From has no current alias set."
- (mh-alias-reload-maybe)
- (save-excursion
- (if (not (mh-folder-line-matches-show-buffer-p))
- nil ;No corresponding show buffer
- (if (eq major-mode 'mh-folder-mode)
- (set-buffer mh-show-buffer))
- (not (mh-alias-address-to-alias (mh-extract-from-header-value))))))
-
-(defun mh-alias-add-alias-to-file (alias address &optional file)
- "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
-Prompt for alias file if not provided and there is more than one candidate.
-If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend
-after it."
- (if (not file)
- (setq file (mh-alias-insert-file alias)))
- (save-excursion
- (set-buffer (find-file-noselect file))
- (goto-char (point-min))
- (let ((alias-search (concat alias ":"))
- (letter)
- (here (point))
- (case-fold-search t))
- (cond
- ;; Search for exact match (if we had the same alias before)
- ((re-search-forward
- (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
- (let ((answer (read-string
- (format "Exists for %s; [i]nsert, [a]ppend: "
- (match-string 1))))
- (case-fold-search t))
- (cond ((string-match "^i" answer))
- ((string-match "^a" answer)
- (forward-line 1))
- (t
- error "Quitting."))))
- ;; No, so sort-in at the right place
- ;; search for "^alias", then "^alia", etc.
- ((eq mh-alias-insertion-location 'sorted)
- (setq letter (substring alias-search -1)
- alias-search (substring alias-search 0 -1))
- (while (and (not (equal alias-search ""))
- (not (re-search-forward
- (concat "^" (regexp-quote alias-search)) nil t)))
- (setq letter (substring alias-search -1)
- alias-search (substring alias-search 0 -1)))
- ;; Next, move forward to sort alphabetically for following letters
- (beginning-of-line)
- (while (re-search-forward
- (concat "^" (regexp-quote alias-search) "[a-" letter "]")
- nil t)
- (forward-line 1)))
- ((eq mh-alias-insertion-location 'bottom)
- (goto-char (point-max)))
- ((eq mh-alias-insertion-location 'top)
- (goto-char (point-min)))))
- (beginning-of-line)
- (insert (format "%s: %s\n" alias address))
- (save-buffer)))
-
-;;;###mh-autoload
-(defun mh-alias-add-alias (alias address)
- "*Add ALIAS for ADDRESS in personal alias file.
-Prompts for confirmation if the address already has an alias.
-If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
- (interactive "P\nP")
- (mh-alias-reload-maybe)
- (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
- (setq address (read-string "Address: " address))
- (let ((address-alias (mh-alias-address-to-alias address))
- (alias-address (mh-alias-expand alias)))
- (if (string-equal alias-address alias)
- (setq alias-address nil))
- (cond
- ((and (equal alias address-alias)
- (equal address alias-address))
- (message "Already defined as: %s" alias-address))
- (address-alias
- (if (y-or-n-p (format "Address has alias %s; set new one? "
- address-alias))
- (mh-alias-add-alias-to-file alias address)))
- (t
- (mh-alias-add-alias-to-file alias address)))))
-
-;;;###mh-autoload
-(defun mh-alias-grab-from-field ()
- "*Add ALIAS for ADDRESS in personal alias file.
-Prompts for confirmation if the alias is already in use or if the address
-already has an alias."
- (interactive)
- (mh-alias-reload-maybe)
- (save-excursion
- (cond
- ((mh-folder-line-matches-show-buffer-p)
- (set-buffer mh-show-buffer))
- ((and (eq major-mode 'mh-folder-mode)
- (mh-get-msg-num nil))
- (set-buffer (get-buffer-create mh-temp-buffer))
- (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
- ((eq major-mode 'mh-folder-mode)
- (error "Cursor not pointing to a message")))
- (let* ((address (mh-extract-from-header-value))
- (alias (mh-alias-suggest-alias address)))
- (mh-alias-add-alias alias address))))
-
-;;;###mh-autoload
-(defun mh-alias-add-address-under-point ()
- "Insert an alias for email address under point."
- (interactive)
- (let ((address (mh-goto-address-find-address-at-point)))
- (if address
- (mh-alias-add-alias nil address)
- (message "No email address found under point."))))
-
-(provide 'mh-alias)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-alias.el ends here
+++ /dev/null
-;;; mh-comp.el --- MH-E functions for composing messages
-
-;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Internal support for MH-E package.
-
-;;; Change Log:
-
-;; $Id: mh-comp.el,v 1.164 2003/01/07 21:16:25 satyaki Exp $
-
-;;; Code:
-
-(require 'mh-e)
-(require 'gnus-util)
-(require 'easymenu)
-(require 'cl)
-
-;; Shush the byte-compiler
-(defvar adaptive-fill-first-line-regexp)
-(defvar font-lock-defaults)
-(defvar mark-active)
-(defvar sendmail-coding-system)
-(defvar mh-identity-list)
-(defvar mh-identity-default)
-(defvar mh-identity-menu)
-
-;;; Autoloads
-(autoload 'Info-goto-node "info")
-(autoload 'mail-mode-fill-paragraph "sendmail")
-(autoload 'mm-handle-displayed-p "mm-decode")
-
-(autoload 'sc-cite-original "sc"
- "Workhorse citing function which performs the initial citation.
-This is callable from the various mail and news readers' reply
-function according to the agreed upon standard. See `\\[sc-describe]'
-for more details. `sc-cite-original' does not do any yanking of the
-original message but it does require a few things:
-
- 1) The reply buffer is the current buffer.
-
- 2) The original message has been yanked and inserted into the
- reply buffer.
-
- 3) Verbose mail headers from the original message have been
- inserted into the reply buffer directly before the text of the
- original message.
-
- 4) Point is at the beginning of the verbose headers.
-
- 5) Mark is at the end of the body of text to be cited.
-
-For Emacs 19's, the region need not be active (and typically isn't
-when this function is called. Also, the hook `sc-pre-hook' is run
-before, and `sc-post-hook' is run after the guts of this function.")
-
-;;; Site customization (see also mh-utils.el):
-
-(defvar mh-send-prog "send"
- "Name of the MH send program.
-Some sites need to change this because of a name conflict.")
-
-(defvar mh-redist-full-contents nil
- "Non-nil if the `dist' command needs whole letter for redistribution.
-This is the case only when `send' is compiled with the BERK option.
-If MH will not allow you to redist a previously redist'd msg, set to nil.")
-
-(defvar mh-redist-background nil
- "If non-nil redist will be done in background like send.
-This allows transaction log to be visible if -watch, -verbose or -snoop are
-used.")
-
-(defvar mh-note-repl "-"
- "String whose first character is used to notate replied to messages.")
-
-(defvar mh-note-forw "F"
- "String whose first character is used to notate forwarded messages.")
-
-(defvar mh-note-dist "R"
- "String whose first character is used to notate redistributed messages.")
-
-(defvar mh-yank-hooks nil
- "Obsolete hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between point and mark.
-And each hook function should leave point and mark around the citation
-text as modified.
-
-This is a normal hook, misnamed for historical reasons.
-It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
-
-(defvar mail-citation-hook nil
- "*Hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between point and mark.
-And each hook function should leave point and mark around the citation
-text as modified.
-
-If this hook is entirely empty (nil), the text of the message is inserted
-with `mh-ins-buf-prefix' prefixed to each line.
-
-See also the variable `mh-yank-from-start-of-msg', which controls how
-much of the message passed to the hook.
-
-This hook was historically provided to set up supercite. You may now leave
-this nil and set up supercite by setting the variable
-`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
-to 'autosupercite.")
-
-(defvar mh-comp-formfile "components"
- "Name of file to be used as a skeleton for composing messages.
-Default is \"components\". If not an absolute file name, the file
-is searched for first in the user's MH directory, then in the
-system MH lib directory.")
-
-(defvar mh-repl-formfile "replcomps"
- "Name of file to be used as a skeleton for replying to messages.
-Default is \"replcomps\". If not an absolute file name, the file
-is searched for first in the user's MH directory, then in the
-system MH lib directory.")
-
-(defvar mh-repl-group-formfile "replgroupcomps"
- "Name of file to be used as a skeleton for replying to messages.
-This file is used to form replies to the sender and all recipients of a
-message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
-If not an absolute file name, the file is searched for first in the user's MH
-directory, then in the system MH lib directory.")
-
-(defvar mh-rejected-letter-start
- (format "^%s$"
- (regexp-opt
- '("Content-Type: message/rfc822" ;MIME MDN
- " ----- Unsent message follows -----" ;from sendmail V5
- " --------Unsent Message below:" ; from sendmail at BU
- " ----- Original message follows -----" ;from sendmail V8
- "------- Unsent Draft" ;from MH itself
- "---------- Original Message ----------" ;from zmailer
- " --- The unsent message follows ---" ;from AIX mail system
- " Your message follows:" ;from MMDF-II
- "Content-Description: Returned Content" ;1993 KJ sendmail
- ))))
-
-(defvar mh-new-draft-cleaned-headers
- "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
- "Regexp of header lines to remove before offering a message as a new draft.
-Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
-
-(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
- ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
- ("d" . "Dcc:"))
- "Alist of (final-character . field-name) choices for `mh-to-field'.")
-
-(defvar mh-letter-mode-map (copy-keymap text-mode-map)
- "Keymap for composing mail.")
-
-(defvar mh-letter-mode-syntax-table nil
- "Syntax table used by MH-E while in MH-Letter mode.")
-
-(if mh-letter-mode-syntax-table
- ()
- (setq mh-letter-mode-syntax-table
- (make-syntax-table text-mode-syntax-table))
- (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
-
-(defvar mh-sent-from-folder nil
- "Folder of msg assoc with this letter.")
-
-(defvar mh-sent-from-msg nil
- "Number of msg assoc with this letter.")
-
-(defvar mh-send-args nil
- "Extra args to pass to \"send\" command.")
-
-(defvar mh-annotate-char nil
- "Character to use to annotate `mh-sent-from-msg'.")
-
-(defvar mh-annotate-field nil
- "Field name for message annotation.")
-
-;;;###autoload
-(defun mh-smail ()
- "Compose and send mail with the MH mail system.
-This function is an entry point to MH-E, the Emacs front end
-to the MH mail system.
-
-See documentation of `\\[mh-send]' for more details on composing mail."
- (interactive)
- (mh-find-path)
- (call-interactively 'mh-send))
-
-(defvar mh-error-if-no-draft nil) ;raise error over using old draft
-
-;;;###autoload
-(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
- "Set up a mail composition draft with the MH mail system.
-This function is an entry point to MH-E, the Emacs front end
-to the MH mail system. This function does not prompt the user
-for any header fields, and thus is suitable for use by programs
-that want to create a mail buffer.
-Users should use `\\[mh-smail]' to compose mail.
-Optional arguments for setting certain fields include TO, SUBJECT, and
-OTHER-HEADERS. Additional arguments are IGNORED."
- (mh-find-path)
- (let ((mh-error-if-no-draft t))
- (mh-send (or to "") "" (or subject ""))))
-
-;; XEmacs needs this:
-;;;###autoload
-(defun mh-user-agent-compose (&optional to subject other-headers continue
- switch-function yank-action
- send-actions)
- "Set up mail composition draft with the MH mail system.
-This is `mail-user-agent' entry point to MH-E.
-
-The optional arguments TO and SUBJECT specify recipients and the
-initial Subject field, respectively.
-
-OTHER-HEADERS is an alist specifying additional
-header fields. Elements look like (HEADER . VALUE) where both
-HEADER and VALUE are strings.
-
-CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
- (mh-find-path)
- (let ((mh-error-if-no-draft t))
- (mh-send to "" subject)
- (while other-headers
- (mh-insert-fields (concat (car (car other-headers)) ":")
- (cdr (car other-headers)))
- (setq other-headers (cdr other-headers)))))
-
-;;;###mh-autoload
-(defun mh-edit-again (msg)
- "Clean up a draft or a message MSG previously sent and make it resendable.
-Default is the current message.
-The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
-See also documentation for `\\[mh-send]' function."
- (interactive (list (mh-get-msg-num t)))
- (let* ((from-folder mh-current-folder)
- (config (current-window-configuration))
- (draft
- (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
- (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
- (rename-buffer (format "draft-%d" msg))
- ;; Make buffer writable...
- (setq buffer-read-only nil)
- ;; If buffer was being used to display the message reinsert
- ;; from file...
- (when (eq major-mode 'mh-show-mode)
- (erase-buffer)
- (insert-file-contents buffer-file-name))
- (buffer-name))
- (t
- (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
- (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
- (mh-insert-header-separator)
- (goto-char (point-min))
- (save-buffer)
- (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
- config)
- (mh-letter-mode-message)))
-
-;;;###mh-autoload
-(defun mh-extract-rejected-mail (msg)
- "Extract message MSG returned by the mail system and make it resendable.
-Default is the current message. The variable `mh-new-draft-cleaned-headers'
-gives the headers to clean out of the original message.
-See also documentation for `\\[mh-send]' function."
- (interactive (list (mh-get-msg-num t)))
- (let ((from-folder mh-current-folder)
- (config (current-window-configuration))
- (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
- (goto-char (point-min))
- (cond ((re-search-forward mh-rejected-letter-start nil t)
- (skip-chars-forward " \t\n")
- (delete-region (point-min) (point))
- (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
- (t
- (message "Does not appear to be a rejected letter.")))
- (mh-insert-header-separator)
- (goto-char (point-min))
- (save-buffer)
- (mh-compose-and-send-mail draft "" from-folder msg
- (mh-get-header-field "To:")
- (mh-get-header-field "From:")
- (mh-get-header-field "Cc:")
- nil nil config)
- (mh-letter-mode-message)))
-
-;;;###mh-autoload
-(defun mh-forward (to cc &optional msg-or-seq)
- "Forward one or more messages to the recipients TO and CC.
-
-Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
-
-Default is the displayed message. If optional prefix argument is given then
-prompt for the message sequence. If variable `transient-mark-mode' is non-nil
-and the mark is active, then the selected region is forwarded.
-See also documentation for `\\[mh-send]' function."
- (interactive (list (mh-read-address "To: ")
- (mh-read-address "Cc: ")
- (cond
- ((mh-mark-active-p t)
- (mh-region-to-msg-list (region-beginning) (region-end)))
- (current-prefix-arg
- (mh-read-seq-default "Forward" t))
- (t
- (mh-get-msg-num t)))))
- (let* ((folder mh-current-folder)
- (msgs (cond ((numberp msg-or-seq) (list msg-or-seq))
- ((listp msg-or-seq) msg-or-seq)
- (t (mh-seq-to-msgs msg-or-seq))))
- (config (current-window-configuration))
- (fwd-msg-file (mh-msg-filename (car msgs) folder))
- ;; forw always leaves file in "draft" since it doesn't have -draft
- (draft-name (expand-file-name "draft" mh-user-path))
- (draft (cond ((or (not (file-exists-p draft-name))
- (y-or-n-p "The file 'draft' exists. Discard it? "))
- (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
- mh-current-folder msgs)
- (prog1
- (mh-read-draft "" draft-name t)
- (mh-insert-fields "To:" to "Cc:" cc)
- (save-buffer)))
- (t
- (mh-read-draft "" draft-name nil)))))
- (let (orig-from
- orig-subject)
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- (insert-file-contents fwd-msg-file)
- (setq orig-from (mh-get-header-field "From:"))
- (setq orig-subject (mh-get-header-field "Subject:")))
- (let ((forw-subject
- (mh-forwarded-letter-subject orig-from orig-subject))
- (compose))
- (mh-insert-fields "Subject:" forw-subject)
- (goto-char (point-min))
- ;; If using MML, translate mhn
- (if (equal mh-compose-insertion 'gnus)
- (save-excursion
- (setq compose t)
- (re-search-forward (format "^\\(%s\\)?$"
- mh-mail-header-separator))
- (while
- (re-search-forward
- "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
- (point-max) t)
- (let ((description (if (equal (match-string 1)
- "forwarded messages")
- "forwarded message %d"
- (match-string 1)))
- (msgs (split-string (match-string 3)))
- (i 0))
- (beginning-of-line)
- (delete-region (point) (progn (forward-line 1) (point)))
- (dolist (msg msgs)
- (setq i (1+ i))
- (mh-mml-forward-message (format description i)
- folder msg))))))
- ;; Postition just before forwarded message
- (if (re-search-forward "^------- Forwarded Message" nil t)
- (forward-line -1)
- (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator))
- (forward-line 1))
- (delete-other-windows)
- (mh-add-msgs-to-seq msgs 'forwarded t)
- (mh-compose-and-send-mail draft "" folder msg-or-seq
- to forw-subject cc
- mh-note-forw "Forwarded:"
- config)
- (if compose
- (setq mh-mml-compose-insert-flag t))
- (mh-letter-mode-message)))))
-
-(defun mh-forwarded-letter-subject (from subject)
- "Return a Subject suitable for a forwarded message.
-Original message has headers FROM and SUBJECT."
- (let ((addr-start (string-match "<" from))
- (comment (string-match "(" from)))
- (cond ((and addr-start (> addr-start 0))
- ;; Full Name <luser@host>
- (setq from (substring from 0 (1- addr-start))))
- (comment
- ;; luser@host (Full Name)
- (setq from (substring from (1+ comment) (1- (length from)))))))
- (format mh-forward-subject-format from subject))
-
-;;;###autoload
-(defun mh-smail-other-window ()
- "Compose and send mail in other window with the MH mail system.
-This function is an entry point to MH-E, the Emacs front end
-to the MH mail system.
-
-See documentation of `\\[mh-send]' for more details on composing mail."
- (interactive)
- (mh-find-path)
- (call-interactively 'mh-send-other-window))
-
-;;;###mh-autoload
-(defun mh-redistribute (to cc &optional msg)
- "Redistribute displayed message to recipients TO and CC.
-Use optional argument MSG to redistribute another message.
-Depending on how your copy of MH was compiled, you may need to change the
-setting of the variable `mh-redist-full-contents'. See its documentation."
- (interactive (list (mh-read-address "Redist-To: ")
- (mh-read-address "Redist-Cc: ")
- (mh-get-msg-num t)))
- (or msg
- (setq msg (mh-get-msg-num t)))
- (save-window-excursion
- (let ((folder mh-current-folder)
- (draft (mh-read-draft "redistribution"
- (if mh-redist-full-contents
- (mh-msg-filename msg)
- nil)
- nil)))
- (mh-goto-header-end 0)
- (insert "Resent-To: " to "\n")
- (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
- (mh-clean-msg-header (point-min)
- "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
- nil)
- (save-buffer)
- (message "Redistributing...")
- (if (not mh-redist-background)
- (if mh-redist-full-contents
- (call-process "/bin/sh" nil 0 nil "-c"
- (format "mhdist=1 mhaltmsg=%s %s -push %s"
- buffer-file-name
- (expand-file-name mh-send-prog mh-progs)
- buffer-file-name))
- (call-process "/bin/sh" nil 0 nil "-c"
- (format
- "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
- (mh-msg-filename msg folder)
- (expand-file-name mh-send-prog mh-progs)
- buffer-file-name))))
- (mh-annotate-msg msg folder mh-note-dist
- "-component" "Resent:"
- "-text" (format "\"%s %s\"" to cc))
- (if mh-redist-background
- (mh-exec-cmd-daemon "/bin/sh" "-c"
- (format "mhdist=1 mhaltmsg=%s %s %s %s"
- (if mh-redist-full-contents
- buffer-file-name
- (mh-msg-filename msg folder))
- (if mh-redist-full-contents
- ""
- "mhannotate=1")
- (mh-expand-file-name "send" mh-progs)
- buffer-file-name)))
- (kill-buffer draft)
- (message "Redistributing...done"))))
-
-(defun mh-show-buffer-message-number (&optional buffer)
- "Message number of displayed message in corresponding show buffer.
-Return nil if show buffer not displayed.
-If in `mh-letter-mode', don't display the message number being replied to,
-but rather the message number of the show buffer associated with our
-originating folder buffer.
-Optional argument BUFFER can be used to specify the buffer."
- (save-excursion
- (if buffer
- (set-buffer buffer))
- (cond ((eq major-mode 'mh-show-mode)
- (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
- (car (read-from-string (substring buffer-file-name
- (1+ number-start))))))
- ((and (eq major-mode 'mh-folder-mode)
- mh-show-buffer
- (get-buffer mh-show-buffer))
- (mh-show-buffer-message-number mh-show-buffer))
- ((and (eq major-mode 'mh-letter-mode)
- mh-sent-from-folder
- (get-buffer mh-sent-from-folder))
- (mh-show-buffer-message-number mh-sent-from-folder))
- (t
- nil))))
-
-;;;###mh-autoload
-(defun mh-reply (message &optional reply-to includep)
- "Reply to MESSAGE (default: current message).
-If the optional argument REPLY-TO is not given, prompts for type of addresses
-to reply to:
- from sender only,
- to sender and primary recipients,
- cc/all sender and all recipients.
-If optional prefix argument INCLUDEP provided, then include the message
-in the reply using filter `mhl.reply' in your MH directory.
-If the file named by `mh-repl-formfile' exists, it is used as a skeleton
-for the reply. See also documentation for `\\[mh-send]' function."
- (interactive (list
- (mh-get-msg-num t)
- (let ((minibuffer-help-form
- "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
- (or mh-reply-default-reply-to
- (completing-read "Reply to whom? (from, to, all) [from]: "
- '(("from") ("to") ("cc") ("all"))
- nil
- t)))
- current-prefix-arg))
- (let* ((folder mh-current-folder)
- (show-buffer mh-show-buffer)
- (config (current-window-configuration))
- (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
- (form-file (cond ((and mh-nmh-flag group-reply
- (stringp mh-repl-group-formfile))
- mh-repl-group-formfile)
- ((stringp mh-repl-formfile) mh-repl-formfile)
- (t nil))))
- (message "Composing a reply...")
- (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
- (if form-file
- (list "-form" form-file))
- mh-current-folder message
- (cond ((or (equal reply-to "from") (equal reply-to ""))
- '("-nocc" "all"))
- ((equal reply-to "to")
- '("-cc" "to"))
- (group-reply (if mh-nmh-flag
- '("-group" "-nocc" "me")
- '("-cc" "all" "-nocc" "me"))))
- (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
- (eq mh-yank-from-start-of-msg 'autoattrib))
- '("-noformat"))
- (includep '("-filter" "mhl.reply"))
- (t '())))
- (let ((draft (mh-read-draft "reply"
- (expand-file-name "reply" mh-user-path)
- t)))
- (delete-other-windows)
- (save-buffer)
-
- (let ((to (mh-get-header-field "To:"))
- (subject (mh-get-header-field "Subject:"))
- (cc (mh-get-header-field "Cc:")))
- (goto-char (point-min))
- (mh-goto-header-end 1)
- (or includep
- (not mh-reply-show-message-flag)
- (mh-in-show-buffer (show-buffer)
- (mh-display-msg message folder)))
- (mh-add-msgs-to-seq message 'answered t)
- (message "Composing a reply...done")
- (mh-compose-and-send-mail draft "" folder message to subject cc
- mh-note-repl "Replied:" config))
- (when (and (or (eq 'autosupercite mh-yank-from-start-of-msg)
- (eq 'autoattrib mh-yank-from-start-of-msg))
- (eq (mh-show-buffer-message-number) mh-sent-from-msg))
- (undo-boundary)
- (mh-yank-cur-msg))
- (mh-letter-mode-message))))
-
-;;;###mh-autoload
-(defun mh-send (to cc subject)
- "Compose and send a letter.
-
-Do not call this function from outside MH-E; use \\[mh-smail] instead.
-
-The file named by `mh-comp-formfile' will be used as the form.
-The letter is composed in `mh-letter-mode'; see its documentation for more
-details.
-If `mh-compose-letter-function' is defined, it is called on the draft and
-passed three arguments: TO, CC, and SUBJECT."
- (interactive (list
- (mh-read-address "To: ")
- (mh-read-address "Cc: ")
- (read-string "Subject: ")))
- (let ((config (current-window-configuration)))
- (delete-other-windows)
- (mh-send-sub to cc subject config)))
-
-;;;###mh-autoload
-(defun mh-send-other-window (to cc subject)
- "Compose and send a letter in another window.
-
-Do not call this function from outside MH-E; use \\[mh-smail-other-window]
-instead.
-
-The file named by `mh-comp-formfile' will be used as the form.
-The letter is composed in `mh-letter-mode'; see its documentation for more
-details.
-If `mh-compose-letter-function' is defined, it is called on the draft and
-passed three arguments: TO, CC, and SUBJECT."
- (interactive (list
- (mh-read-address "To: ")
- (mh-read-address "Cc: ")
- (read-string "Subject: ")))
- (let ((pop-up-windows t))
- (mh-send-sub to cc subject (current-window-configuration))))
-
-(defun mh-send-sub (to cc subject config)
- "Do the real work of composing and sending a letter.
-Expects the TO, CC, and SUBJECT fields as arguments.
-CONFIG is the window configuration before sending mail."
- (let ((folder mh-current-folder)
- (msg-num (mh-get-msg-num nil)))
- (message "Composing a message...")
- (let ((draft (mh-read-draft
- "message"
- (let (components)
- (cond
- ((file-exists-p
- (setq components
- (expand-file-name mh-comp-formfile mh-user-path)))
- components)
- ((file-exists-p
- (setq components
- (expand-file-name mh-comp-formfile mh-lib)))
- components)
- ((file-exists-p
- (setq components
- (expand-file-name mh-comp-formfile
- ;; What is this mh-etc ?? -sm
- ;; This is dead code, so
- ;; remove it.
- ;(and (boundp 'mh-etc) mh-etc)
- )))
- components)
- (t
- (error (format "Can't find components file \"%s\""
- components)))))
- nil)))
- (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
- (goto-char (point-max))
- (mh-compose-and-send-mail draft "" folder msg-num
- to subject cc
- nil nil config)
- (mh-letter-mode-message))))
-
-(defun mh-read-draft (use initial-contents delete-contents-file)
- "Read draft file into a draft buffer and make that buffer the current one.
-USE is a message used for prompting about the intended use of the message.
-INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
-if buffer should not be modified. Delete the initial-contents file if
-DELETE-CONTENTS-FILE flag is set.
-Returns the draft folder's name.
-If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
-used each time and saved in the draft folder. The draft file can then be
-reused."
- (cond (mh-draft-folder
- (let ((orig-default-dir default-directory)
- (draft-file-name (mh-new-draft-name)))
- (pop-to-buffer (generate-new-buffer
- (format "draft-%s"
- (file-name-nondirectory draft-file-name))))
- (condition-case ()
- (insert-file-contents draft-file-name t)
- (file-error))
- (setq default-directory orig-default-dir)))
- (t
- (let ((draft-name (expand-file-name "draft" mh-user-path)))
- (pop-to-buffer "draft") ; Create if necessary
- (if (buffer-modified-p)
- (if (y-or-n-p "Draft has been modified; kill anyway? ")
- (set-buffer-modified-p nil)
- (error "Draft preserved")))
- (setq buffer-file-name draft-name)
- (clear-visited-file-modtime)
- (unlock-buffer)
- (cond ((and (file-exists-p draft-name)
- (not (equal draft-name initial-contents)))
- (insert-file-contents draft-name)
- (delete-file draft-name))))))
- (cond ((and initial-contents
- (or (zerop (buffer-size))
- (if (y-or-n-p
- (format "A draft exists. Use for %s? " use))
- (if mh-error-if-no-draft
- (error "A prior draft exists"))
- t)))
- (erase-buffer)
- (insert-file-contents initial-contents)
- (if delete-contents-file (delete-file initial-contents))))
- (auto-save-mode 1)
- (if mh-draft-folder
- (save-buffer)) ; Do not reuse draft name
- (buffer-name))
-
-(defun mh-new-draft-name ()
- "Return the pathname of folder for draft messages."
- (save-excursion
- (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
- (buffer-substring (point-min) (1- (point-max)))))
-
-(defun mh-annotate-msg (msg buffer note &rest args)
- "Mark MSG in BUFFER with character NOTE and annotate message with ARGS."
- (apply 'mh-exec-cmd "anno" buffer msg args)
- (save-excursion
- (cond ((get-buffer buffer) ; Buffer may be deleted
- (set-buffer buffer)
- (if (numberp msg)
- (mh-notate msg note (1+ mh-cmd-note))
- (mh-notate-seq msg note (1+ mh-cmd-note)))))))
-
-(defun mh-insert-fields (&rest name-values)
- "Insert the NAME-VALUES pairs in the current buffer.
-If the field exists, append the value to it.
-Do not insert any pairs whose value is the empty string."
- (let ((case-fold-search t))
- (while name-values
- (let ((field-name (car name-values))
- (value (car (cdr name-values))))
- (cond ((equal value "")
- nil)
- ((mh-position-on-field field-name)
- (insert " " (or value "")))
- (t
- (insert field-name " " value "\n")))
- (setq name-values (cdr (cdr name-values)))))))
-
-(defun mh-position-on-field (field &optional ignored)
- "Move to the end of the FIELD in the header.
-Move to end of entire header if FIELD not found.
-Returns non-nil iff FIELD was found.
-The optional second arg is for pre-version 4 compatibility and is IGNORED."
- (cond ((mh-goto-header-field field)
- (mh-header-field-end)
- t)
- ((mh-goto-header-end 0)
- nil)))
-
-(defun mh-get-header-field (field)
- "Find and return the body of FIELD in the mail header.
-Returns the empty string if the field is not in the header of the
-current buffer."
- (if (mh-goto-header-field field)
- (progn
- (skip-chars-forward " \t") ;strip leading white space in body
- (let ((start (point)))
- (mh-header-field-end)
- (buffer-substring-no-properties start (point))))
- ""))
-
-(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
-
-(defun mh-goto-header-field (field)
- "Move to FIELD in the message header.
-Move to the end of the FIELD name, which should end in a colon.
-Returns t if found, nil if not."
- (goto-char (point-min))
- (let ((case-fold-search t)
- (headers-end (save-excursion
- (mh-goto-header-end 0)
- (point))))
- (re-search-forward (format "^%s" field) headers-end t)))
-
-(defun mh-goto-header-end (arg)
- "Move the cursor ARG lines after the header."
- (if (re-search-forward "^-*$" nil nil)
- (forward-line arg)))
-
-(defun mh-extract-from-header-value ()
- "Extract From: string from header."
- (save-excursion
- (if (not (mh-goto-header-field "From:"))
- (error "No From header line found")
- (skip-chars-forward " \t")
- (buffer-substring-no-properties
- (point) (progn (mh-header-field-end)(point))))))
-
-\f
-
-;;; Mode for composing and sending a draft message.
-
-(put 'mh-letter-mode 'mode-class 'special)
-
-;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
-(eval-when-compile (defvar mh-letter-menu nil))
-(cond
- ((fboundp 'easy-menu-define)
- (easy-menu-define
- mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
- '("Letter"
- ["Send This Draft" mh-send-letter t]
- ["Split Current Line" mh-open-line t]
- ["Check Recipient" mh-check-whom t]
- ["Yank Current Message" mh-yank-cur-msg t]
- ["Insert a Message..." mh-insert-letter t]
- ["Insert Signature" mh-insert-signature t]
- ["GPG Sign message"
- mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
- ["GPG Encrypt message"
- mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
- ["Compose Insertion (MIME)..." mh-compose-insertion t]
- ;; ["Compose Compressed tar (MIME)..."
- ;;mh-mhn-compose-external-compressed-tar t]
- ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
- ["Compose Forward (MIME)..." mh-compose-forward t]
- ;; The next two will have to be merged. But I also need to make sure the
- ;; user can't mix directives of both types.
- ["Pull in All Compositions (mhn)"
- mh-edit-mhn mh-mhn-compose-insert-flag]
- ["Pull in All Compositions (gnus)"
- mh-mml-to-mime mh-mml-compose-insert-flag]
- ["Revert to Non-MIME Edit (mhn)"
- mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
- ["Kill This Draft" mh-fully-kill-draft t]))))
-
-;;; Help Messages
-;;; Group messages logically, more or less.
-(defvar mh-letter-mode-help-messages
- '((nil
- "Send letter: \\[mh-send-letter]"
- "\t\tOpen line: \\[mh-open-line]\n"
- "Kill letter: \\[mh-fully-kill-draft]"
- "\t\tInsert:\n"
- "Check recipients: \\[mh-check-whom]"
- "\t\t Current message: \\[mh-yank-cur-msg]\n"
- "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]"
- "\t\t Attachment: \\[mh-compose-insertion]\n"
- "Sign message: \\[mh-mml-secure-message-sign-pgpmime]"
- "\t\t Message to forward: \\[mh-compose-forward]\n"
- " "
- "\t\t Signature: \\[mh-insert-signature]"))
- "Key binding cheat sheet.
-
-This is an associative array which is used to show the most common commands.
-The key is a prefix char. The value is one or more strings which are
-concatenated together and displayed in the minibuffer if ? is pressed after
-the prefix character. The special key nil is used to display the
-non-prefixed commands.
-
-The substitutions described in `substitute-command-keys' are performed as
-well.")
-
-;;;###mh-autoload
-(defun mh-fill-paragraph-function (arg)
- "Fill paragraph at or after point.
-Prefix ARG means justify as well. This function enables `fill-paragraph' to
-work better in MH-Letter mode."
- (interactive "P")
- (let ((fill-paragraph-function) (fill-prefix))
- (if (mh-in-header-p)
- (mail-mode-fill-paragraph arg)
- (fill-paragraph arg))))
-
-;;;###autoload
-(define-derived-mode mh-letter-mode text-mode "MH-Letter"
- "Mode for composing letters in MH-E.\\<mh-letter-mode-map>
-
-When you have finished composing, type \\[mh-send-letter] to send the message
-using the MH mail handling system.
-
-There are two types of MIME directives used by MH-E: Gnus and MH. The option
-`mh-compose-insertion' controls what type of directives are inserted by MH-E
-commands. These directives can be converted to MIME body parts by running
-\\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives.
-This step is mandatory if these directives are added manually. If the
-directives are inserted with MH-E commands such as \\[mh-compose-insertion],
-the directives are expanded automatically when the letter is sent.
-
-Options that control this mode can be changed with
-\\[customize-group]; specify the \"mh-compose\" group.
-
-When a message is composed, the hooks `text-mode-hook' and
-`mh-letter-mode-hook' are run.
-
-\\{mh-letter-mode-map}"
-
- (or mh-user-path (mh-find-path))
- (make-local-variable 'mh-send-args)
- (make-local-variable 'mh-annotate-char)
- (make-local-variable 'mh-annotate-field)
- (make-local-variable 'mh-previous-window-config)
- (make-local-variable 'mh-sent-from-folder)
- (make-local-variable 'mh-sent-from-msg)
- (make-local-variable 'mail-header-separator)
- (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
- (make-local-variable 'mh-help-messages)
- (setq mh-help-messages mh-letter-mode-help-messages)
-
- ;; From sendmail.el for proper paragraph fill
- ;; sendmail.el also sets a normal-auto-fill-function (not done here)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'mh-fill-paragraph-function)
- (make-local-variable 'adaptive-fill-regexp)
- (setq adaptive-fill-regexp
- (concat adaptive-fill-regexp
- "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
- (make-local-variable 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp
- (concat adaptive-fill-first-line-regexp
- "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
- ;; `-- ' precedes the signature. `-----' appears at the start of the
- ;; lines that delimit forwarded messages.
- ;; Lines containing just >= 3 dashes, perhaps after whitespace,
- ;; are also sometimes used and should be separators.
- (setq paragraph-start (concat (regexp-quote mail-header-separator)
- "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
- "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
- "-- $\\|---+$\\|"
- page-delimiter))
- (setq paragraph-separate paragraph-start)
- ;; --- End of code from sendmail.el ---
-
- (if (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
- (make-local-variable 'font-lock-defaults)
- (cond
- ((or (equal mh-highlight-citation-p 'font-lock)
- (equal mh-highlight-citation-p 'gnus))
- ;; Let's use font-lock even if gnus is used in show-mode. The reason
- ;; is that gnus uses static text properties which are not appropriate
- ;; for a buffer that will be edited. So the choice here is either fontify
- ;; the citations and header...
- (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
- (t
- ;; ...or the header only
- (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
- (easy-menu-add mh-letter-menu)
- ;; See if a "forw: -mime" message containing a MIME composition.
- ;; Mode clears local vars, so can't do this in mh-forward.
- (save-excursion
- (goto-char (point-min))
- (when (and (re-search-forward
- (format "^\\(%s\\)?$" mail-header-separator) nil t)
- (= 0 (forward-line 1))
- (looking-at "^#forw"))
- (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var
- (setq mh-mhn-compose-insert-flag t)))
- (setq fill-column mh-letter-fill-column)
- ;; If text-mode-hook turned on auto-fill, tune it for messages
- (when auto-fill-function
- (make-local-variable 'auto-fill-function)
- (setq auto-fill-function 'mh-auto-fill-for-letter)))
-
-(defun mh-auto-fill-for-letter ()
- "Perform auto-fill for message.
-Header is treated specially by inserting a tab before continuation lines."
- (if (mh-in-header-p)
- (let ((fill-prefix "\t"))
- (do-auto-fill))
- (do-auto-fill)))
-
-(defun mh-insert-header-separator ()
- "Insert `mh-mail-header-separator', if absent."
- (save-excursion
- (goto-char (point-min))
- (rfc822-goto-eoh)
- (if (looking-at "$")
- (insert mh-mail-header-separator))))
-
-;;;###mh-autoload
-(defun mh-to-field ()
- "Move point to the end of a specified header field.
-The field is indicated by the previous keystroke (the last keystroke
-of the command) according to the list in the variable `mh-to-field-choices'.
-Create the field if it does not exist. Set the mark to point before moving."
- (interactive)
- (expand-abbrev)
- (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
- mh-to-field-choices)
- ;; also look for a char for version 4 compat
- (assoc (logior last-input-char ?`)
- mh-to-field-choices))))
- (case-fold-search t))
- (push-mark)
- (cond ((mh-position-on-field target)
- (let ((eol (point)))
- (skip-chars-backward " \t")
- (delete-region (point) eol))
- (if (and (not (eq (logior last-input-char ?`) ?s))
- (save-excursion
- (backward-char 1)
- (not (looking-at "[:,]"))))
- (insert ", ")
- (insert " ")))
- (t
- (if (mh-position-on-field "To:")
- (forward-line 1))
- (insert (format "%s \n" target))
- (backward-char 1)))))
-
-;;;###mh-autoload
-(defun mh-to-fcc (&optional folder)
- "Insert an Fcc: FOLDER field in the current message.
-Prompt for the field name with a completion list of the current folders."
- (interactive)
- (or folder
- (setq folder (mh-prompt-for-folder
- "Fcc"
- (or (and mh-default-folder-for-message-function
- (save-excursion
- (goto-char (point-min))
- (funcall
- mh-default-folder-for-message-function)))
- "")
- t)))
- (let ((last-input-char ?\C-f))
- (expand-abbrev)
- (save-excursion
- (mh-to-field)
- (insert (if (mh-folder-name-p folder)
- (substring folder 1)
- folder)))))
-
-;;;###mh-autoload
-(defun mh-insert-signature ()
- "Insert the file named by `mh-signature-file-name' at point.
-The value of `mh-letter-insert-signature-hook' is a list of functions to be
-called, with no arguments, before the signature is actually inserted."
- (interactive)
- (let ((mh-signature-file-name mh-signature-file-name))
- (run-hooks 'mh-letter-insert-signature-hook)
- (if mh-signature-file-name
- (insert-file-contents mh-signature-file-name)))
- (force-mode-line-update))
-
-;;;###mh-autoload
-(defun mh-check-whom ()
- "Verify recipients of the current letter, showing expansion of any aliases."
- (interactive)
- (let ((file-name buffer-file-name))
- (save-buffer)
- (message "Checking recipients...")
- (mh-in-show-buffer ("*Recipients*")
- (bury-buffer (current-buffer))
- (erase-buffer)
- (mh-exec-cmd-output "whom" t file-name))
- (message "Checking recipients...done")))
-
-\f
-
-;;; Routines to compose and send a letter.
-
-(defun mh-insert-x-face ()
- "Append X-Face field to header.
-If the field already exists, this function does nothing."
- (when (and (file-exists-p mh-x-face-file)
- (file-readable-p mh-x-face-file))
- (save-excursion
- (when (null (mh-position-on-field "X-Face"))
- (insert "X-Face: ")
- (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
- (if (not (looking-at "^"))
- (insert "\n"))))))
-
-(defun mh-insert-x-mailer ()
- "Append an X-Mailer field to the header.
-The versions of MH-E, Emacs, and MH are shown."
-
- ;; Lazily initialize mh-x-mailer-string.
- (when (null mh-x-mailer-string)
- (save-window-excursion
- (mh-version)
- (set-buffer mh-temp-buffer)
- (if mh-nmh-flag
- (search-forward-regexp "^nmh-\\(\\S +\\)")
- (search-forward-regexp "^MH \\(\\S +\\)" nil t))
- (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1))))
- (setq mh-x-mailer-string
- (format "MH-E %s; %s %s; %s %d.%d"
- mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
- (if mh-xemacs-flag
- "XEmacs"
- "Emacs")
- emacs-major-version emacs-minor-version)))
- (kill-buffer mh-temp-buffer)))
- ;; Insert X-Mailer, but only if it doesn't already exist.
- (save-excursion
- (when (null (mh-goto-header-field "X-Mailer"))
- (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
-
-(defun mh-regexp-in-field-p (regexp &rest fields)
- "Non-nil means REGEXP was found in FIELDS."
- (save-excursion
- (let ((search-result nil)
- (field))
- (while fields
- (setq field (car fields))
- (if (and (mh-goto-header-field field)
- (re-search-forward
- regexp (save-excursion (mh-header-field-end)(point)) t))
- (setq fields nil
- search-result t)
- (setq fields (cdr fields))))
- search-result)))
-
-(defun mh-insert-mail-followup-to ()
- "Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'."
- (save-excursion
- (if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))
- (not (mh-goto-header-field "Mail-Followup-To: ")))
- (let ((list mh-insert-mail-followup-to-list))
- (while list
- (let ((regexp (nth 0 (car list)))
- (entry (nth 1 (car list))))
- (when (mh-regexp-in-field-p regexp "To:" "cc:")
- (if (mh-goto-header-field "Mail-Followup-To: ")
- (insert entry ", ")
- (mh-goto-header-end 0)
- (insert "Mail-Followup-To: " entry "\n")))
- (setq list (cdr list))))))))
-
-(defun mh-compose-and-send-mail (draft send-args
- sent-from-folder sent-from-msg
- to subject cc
- annotate-char annotate-field
- config)
- "Edit and compose a draft message in buffer DRAFT and send or save it.
-SEND-ARGS is the argument passed to the send command.
-SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
-nil if none exists.
-SENT-FROM-MSG is the message number or sequence name or nil.
-The TO, SUBJECT, and CC fields are passed to the
-`mh-compose-letter-function'.
-If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
-message. In that case, the ANNOTATE-FIELD is used to build a string
-for `mh-annotate-msg'.
-CONFIG is the window configuration to restore after sending the letter."
- (pop-to-buffer draft)
- (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to))
- (mh-letter-mode)
-
- ;; mh-identity support
- (if (and (boundp 'mh-identity-default)
- mh-identity-default)
- (mh-insert-identity mh-identity-default))
- (when (and (boundp 'mh-identity-list)
- mh-identity-list)
- (mh-identity-make-menu)
- (easy-menu-add mh-identity-menu))
-
- (setq mh-sent-from-folder sent-from-folder)
- (setq mh-sent-from-msg sent-from-msg)
- (setq mh-send-args send-args)
- (setq mh-annotate-char annotate-char)
- (setq mh-annotate-field annotate-field)
- (setq mh-previous-window-config config)
- (setq mode-line-buffer-identification (list "{%b}"))
- (if (and (boundp 'mh-compose-letter-function)
- mh-compose-letter-function)
- ;; run-hooks will not pass arguments.
- (let ((value mh-compose-letter-function))
- (if (and (listp value) (not (eq (car value) 'lambda)))
- (while value
- (funcall (car value) to subject cc)
- (setq value (cdr value)))
- (funcall mh-compose-letter-function to subject cc)))))
-
-(defun mh-letter-mode-message ()
- "Display a help message for users of `mh-letter-mode'.
-This should be the last function called when composing the draft."
- (message "%s" (substitute-command-keys
- (concat "Type \\[mh-send-letter] to send message, "
- "\\[mh-help] for help."))))
-
-;;;###mh-autoload
-(defun mh-send-letter (&optional arg)
- "Send the draft letter in the current buffer.
-If optional prefix argument ARG is provided, monitor delivery.
-The value of `mh-before-send-letter-hook' is a list of functions to be called,
-with no arguments, before doing anything.
-Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
-Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
-Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
-Insert X-Face field if the file specified by `mh-x-face-file' exists."
- (interactive "P")
- (run-hooks 'mh-before-send-letter-hook)
- (cond
- ((and (boundp 'mh-mhn-compose-insert-flag)
- mh-mhn-compose-insert-flag)
- (mh-edit-mhn))
- ((and (boundp 'mh-mml-compose-insert-flag)
- mh-mml-compose-insert-flag)
- (mh-mml-to-mime)))
- (if mh-insert-x-mailer-flag (mh-insert-x-mailer))
- (mh-insert-x-face)
- (save-buffer)
- (message "Sending...")
- (let ((draft-buffer (current-buffer))
- (file-name buffer-file-name)
- (config mh-previous-window-config)
- (coding-system-for-write
- (if (and (local-variable-p 'buffer-file-coding-system
- (current-buffer)) ;XEmacs needs two args
- ;; We're not sure why, but buffer-file-coding-system
- ;; tends to get set to undecided-unix.
- (not (memq buffer-file-coding-system
- '(undecided undecided-unix undecided-dos))))
- buffer-file-coding-system
- (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
- (and (boundp 'default-buffer-file-coding-system )
- default-buffer-file-coding-system)
- 'iso-latin-1))))
- ;; The default BCC encapsulation will make a MIME message unreadable.
- ;; With nmh use the -mime arg to prevent this.
- (if (and mh-nmh-flag
- (mh-goto-header-field "Bcc:")
- (mh-goto-header-field "Content-Type:"))
- (setq mh-send-args (format "-mime %s" mh-send-args)))
- (cond (arg
- (pop-to-buffer "MH mail delivery")
- (erase-buffer)
- (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
- "-nodraftfolder" mh-send-args file-name)
- (goto-char (point-max)) ; show the interesting part
- (recenter -1)
- (set-buffer draft-buffer)) ; for annotation below
- (t
- (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
- mh-send-args file-name)))
- (if mh-annotate-char
- (mh-annotate-msg mh-sent-from-msg
- mh-sent-from-folder
- mh-annotate-char
- "-component" mh-annotate-field
- "-text" (format "\"%s %s\""
- (mh-get-header-field "To:")
- (mh-get-header-field "Cc:"))))
-
- (cond ((or (not arg)
- (y-or-n-p "Kill draft buffer? "))
- (kill-buffer draft-buffer)
- (if config
- (set-window-configuration config))))
- (if arg
- (message "Sending...done")
- (message "Sending...backgrounded"))))
-
-;;;###mh-autoload
-(defun mh-insert-letter (folder message verbatim)
- "Insert a message into the current letter.
-Removes the header fields according to the variable `mh-invisible-headers'.
-Prefixes each non-blank line with `mh-ins-buf-prefix', unless
-`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
-used to format the message.
-Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
-not indent and do not delete headers. Leaves the mark before the letter
-and point after it."
- (interactive
- (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
- (read-input (format "Message number%s: "
- (if (numberp mh-sent-from-msg)
- (format " [%d]" mh-sent-from-msg)
- "")))
- current-prefix-arg))
- (save-restriction
- (narrow-to-region (point) (point))
- (let ((start (point-min)))
- (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
- (insert-file-contents
- (expand-file-name message (mh-expand-file-name folder)))
- (when (not verbatim)
- (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
- (goto-char (point-max)) ;Needed for sc-cite-original
- (push-mark) ;Needed for sc-cite-original
- (goto-char (point-min)) ;Needed for sc-cite-original
- (mh-insert-prefix-string mh-ins-buf-prefix)))))
-
-(defun mh-extract-from-attribution ()
- "Extract phrase or comment from From header field."
- (save-excursion
- (if (not (mh-goto-header-field "From: "))
- nil
- (skip-chars-forward " ")
- (cond
- ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
- (format "%s %s %s" (match-string 1)(match-string 2)
- mh-extract-from-attribution-verb))
- ((looking-at "\\([^<\n]+<.+>\\)$")
- (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))
- ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
- (format "%s <%s> %s" (match-string 2)(match-string 1)
- mh-extract-from-attribution-verb))
- ((looking-at " *\\(.+\\)$")
- (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
-
-;;;###mh-autoload
-(defun mh-yank-cur-msg ()
- "Insert the current message into the draft buffer.
-Prefix each non-blank line in the message with the string in
-`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
-only the region will be inserted. Otherwise, the entire message will
-be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
-is nil, the portion of the message following the point will be yanked.
-If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
-yanked message will be deleted."
- (interactive)
- (if (and mh-sent-from-folder
- (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
- (save-excursion (set-buffer mh-sent-from-folder)
- (get-buffer mh-show-buffer))
- mh-sent-from-msg)
- (let ((to-point (point))
- (to-buffer (current-buffer)))
- (set-buffer mh-sent-from-folder)
- (if mh-delete-yanked-msg-window-flag
- (delete-windows-on mh-show-buffer))
- (set-buffer mh-show-buffer) ; Find displayed message
- (let* ((from-attr (mh-extract-from-attribution))
- (yank-region (mh-mark-active-p nil))
- (mh-ins-str
- (cond ((and yank-region
- (or (eq 'supercite mh-yank-from-start-of-msg)
- (eq 'autosupercite mh-yank-from-start-of-msg)
- (eq t mh-yank-from-start-of-msg)))
- ;; supercite needs the full header
- (concat
- (buffer-substring (point-min) (mail-header-end))
- "\n"
- (buffer-substring (region-beginning) (region-end))))
- (yank-region
- (buffer-substring (region-beginning) (region-end)))
- ((or (eq 'body mh-yank-from-start-of-msg)
- (eq 'attribution
- mh-yank-from-start-of-msg)
- (eq 'autoattrib
- mh-yank-from-start-of-msg))
- (buffer-substring
- (save-excursion
- (goto-char (point-min))
- (mh-goto-header-end 1)
- (point))
- (point-max)))
- ((or (eq 'supercite mh-yank-from-start-of-msg)
- (eq 'autosupercite mh-yank-from-start-of-msg)
- (eq t mh-yank-from-start-of-msg))
- (buffer-substring (point-min) (point-max)))
- (t
- (buffer-substring (point) (point-max))))))
- (set-buffer to-buffer)
- (save-restriction
- (narrow-to-region to-point to-point)
- (insert (mh-filter-out-non-text mh-ins-str))
- (goto-char (point-max)) ;Needed for sc-cite-original
- (push-mark) ;Needed for sc-cite-original
- (goto-char (point-min)) ;Needed for sc-cite-original
- (mh-insert-prefix-string mh-ins-buf-prefix)
- (if (or (eq 'attribution mh-yank-from-start-of-msg)
- (eq 'autoattrib mh-yank-from-start-of-msg))
- (insert from-attr "\n\n"))
- ;; If the user has selected a region, he has already "edited" the
- ;; text, so leave the cursor at the end of the yanked text. In
- ;; either case, leave a mark at the opposite end of the included
- ;; text to make it easy to jump or delete to the other end of the
- ;; text.
- (push-mark)
- (goto-char (point-max))
- (if (null yank-region)
- (mh-exchange-point-and-mark-preserving-active-mark)))))
- (error "There is no current message")))
-
-(defun mh-filter-out-non-text (string)
- "Return STRING but without adornments such as MIME buttons and smileys."
- (with-temp-buffer
- ;; Insert the string to filter
- (insert string)
- (goto-char (point-min))
-
- ;; Remove the MIME buttons
- (let ((can-move-forward t)
- (in-button nil))
- (while can-move-forward
- (cond ((and (not (get-text-property (point) 'mh-data))
- in-button)
- (delete-region (1- (point)) (point))
- (setq in-button nil))
- ((get-text-property (point) 'mh-data)
- (delete-region (point)
- (save-excursion (forward-line) (point)))
- (setq in-button t))
- (t (setq can-move-forward (= (forward-line) 0))))))
-
- ;; Return the contents without properties... This gets rid of emphasis
- ;; and smileys
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(defun mh-insert-prefix-string (mh-ins-string)
- "Insert prefix string before each line in buffer.
-The inserted letter is cited using `sc-cite-original' if
-`mh-yank-from-start-of-msg' is one of 'supercite or 'autosupercite. Otherwise,
-simply insert MH-INS-STRING before each line."
- (goto-char (point-min))
- (cond ((or (eq mh-yank-from-start-of-msg 'supercite)
- (eq mh-yank-from-start-of-msg 'autosupercite))
- (sc-cite-original))
- (mail-citation-hook
- (run-hooks 'mail-citation-hook))
- (mh-yank-hooks ;old hook name
- (run-hooks 'mh-yank-hooks))
- (t
- (or (bolp) (forward-line 1))
- (while (< (point) (point-max))
- (insert mh-ins-string)
- (forward-line 1))
- (goto-char (point-min))))) ;leave point like sc-cite-original
-
-;;;###mh-autoload
-(defun mh-fully-kill-draft ()
- "Kill the draft message file and the draft message buffer.
-Use \\[kill-buffer] if you don't want to delete the draft message file."
- (interactive)
- (if (y-or-n-p "Kill draft message? ")
- (let ((config mh-previous-window-config))
- (if (file-exists-p buffer-file-name)
- (delete-file buffer-file-name))
- (set-buffer-modified-p nil)
- (kill-buffer (buffer-name))
- (message "")
- (if config
- (set-window-configuration config)))
- (error "Message not killed")))
-
-(defun mh-current-fill-prefix ()
- "Return the `fill-prefix' on the current line as a string."
- (save-excursion
- (beginning-of-line)
- ;; This assumes that the major-mode sets up adaptive-fill-regexp
- ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
- ;; perhaps I should use the variable and simply inserts its value here,
- ;; and set it locally in a let scope. --psg
- (if (re-search-forward adaptive-fill-regexp nil t)
- (match-string 0)
- "")))
-
-;;;###mh-autoload
-(defun mh-open-line ()
- "Insert a newline and leave point after it.
-In addition, insert newline and quoting characters before text after point.
-This is useful in breaking up paragraphs in replies."
- (interactive)
- (let ((column (current-column))
- (prefix (mh-current-fill-prefix)))
- (if (> (length prefix) column)
- (message "Sorry, point seems to be within the line prefix")
- (newline 2)
- (insert prefix)
- (while (> column (current-column))
- (insert " "))
- (forward-line -1))))
-
-;;;###mh-autoload
-(defun mh-letter-complete (arg)
- "Perform completion on header field or word preceding point.
-Alias completion is done within the mail header on selected fields and
-by the function designated by `mh-letter-complete-function' elsewhere,
-passing the prefix ARG if any."
- (interactive "P")
- (let ((case-fold-search t))
- (if (and (mh-in-header-p)
- (save-excursion
- (mh-header-field-beginning)
- (looking-at "^.*\\(to\\|cc\\|from\\):")))
- (mh-alias-letter-expand-alias)
- (funcall mh-letter-complete-function arg))))
-
-;;; Build the letter-mode keymap:
-;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
-(gnus-define-keys mh-letter-mode-map
- "\C-c?" mh-help
- "\C-c\C-c" mh-send-letter
- "\C-c\C-d" mh-insert-identity
- "\C-c\C-e" mh-edit-mhn
- "\C-c\C-f\C-b" mh-to-field
- "\C-c\C-f\C-c" mh-to-field
- "\C-c\C-f\C-d" mh-to-field
- "\C-c\C-f\C-f" mh-to-fcc
- "\C-c\C-f\C-r" mh-to-field
- "\C-c\C-f\C-s" mh-to-field
- "\C-c\C-f\C-t" mh-to-field
- "\C-c\C-fb" mh-to-field
- "\C-c\C-fc" mh-to-field
- "\C-c\C-fd" mh-to-field
- "\C-c\C-ff" mh-to-fcc
- "\C-c\C-fr" mh-to-field
- "\C-c\C-fs" mh-to-field
- "\C-c\C-ft" mh-to-field
- "\C-c\C-i" mh-insert-letter
- "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime
- "\C-c\C-m\C-f" mh-compose-forward
- "\C-c\C-m\C-i" mh-compose-insertion
- "\C-c\C-m\C-m" mh-mml-to-mime
- "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime
- "\C-c\C-m\C-u" mh-revert-mhn-edit
- "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime
- "\C-c\C-mf" mh-compose-forward
- "\C-c\C-mi" mh-compose-insertion
- "\C-c\C-mm" mh-mml-to-mime
- "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime
- "\C-c\C-mu" mh-revert-mhn-edit
- "\C-c\C-o" mh-open-line
- "\C-c\C-q" mh-fully-kill-draft
- "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
- "\C-c\C-s" mh-insert-signature
- "\C-c\C-^" mh-insert-signature ;if no C-s
- "\C-c\C-w" mh-check-whom
- "\C-c\C-y" mh-yank-cur-msg
- "\M-\t" mh-letter-complete)
-
-;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
-
-(provide 'mh-comp)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-comp.el ends here
+++ /dev/null
-;;; mh-customize.el --- MH-E customization
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; All of the defgroups, defcustoms, and deffaces in MH-E are found here. This
-;; makes it possible to customize modules that aren't loaded yet. It also
-;; makes it easier to organize the customization groups.
-
-;; This file contains the following sections:
-;;
-;; 1. MH-E Customization Groups
-;;
-;; These are the customization group definitions. These are organized in a
-;; logical order. High-level, windows and toolbar, folder, message,
-;; composing and hooks.
-;;
-;; 2. MH-E Customization
-;;
-;; Here are the actual customization variables. There is a sub-section for
-;; each group in the MH-E Customization Groups section. Within each
-;; section, variables are sorted alphabetically. The manual section
-;; dictates which group a variable should be placed. New variables should
-;; be placed in the section where they would most likely be defined.
-;;
-;; All hooks should be placed in the 'mh-hook group; in addition, add the
-;; group in which the hook is defined in the manual (or, if it is new,
-;; where it would be defined). These two actions insures that the hooks
-;; appear last in each group.
-;;
-;; 3. Faces
-
-;;; Change Log:
-
-;; $Id: mh-customize.el,v 1.18 2003/01/08 00:45:37 wohler Exp $
-
-;;; Code:
-
-;;;###mh-autoload
-(defun mh-customize ()
- "Customize MH-E variables."
- (interactive)
- (customize-group 'mh))
-
-;;; MH-E Customization Groups
-
-(defgroup mh nil
- "GNU Emacs interface to the MH mail system."
- :link '(custom-manual "(mh-e)Top")
- :group 'mail)
-
-(defgroup mh-toolbar nil
- "Toolbar configuration."
- :prefix "mh-"
- :group 'mh)
-
-(defgroup mh-speed nil
- "Speedbar and folder configuration."
- :prefix "mh-"
- :link '(custom-manual "(mh-e)Customizing Moving Mail")
- :group 'mh)
-
-(defgroup mh-folder nil
- "Options for controlling scan listing."
- :prefix "mh-"
- :link '(custom-manual "(mh-e)Customizing Moving Mail")
- :group 'mh)
-
-(defgroup mh-show nil
- "Message display."
- :prefix "mh-"
- :link '(custom-manual "(mh-e)Customizing Reading")
- :group 'mh)
-
-(defgroup mh-letter nil
- "Composing messages."
- :prefix "mh-"
- :link '(custom-manual "(mh-e)Customizing Sending")
- :group 'mh)
-
-(defgroup mh-alias nil
- "Alias handling."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-alias-"
- :group 'mh)
-
-(defgroup mh-index nil
- "Indexed searching."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'mh)
-
-(defgroup mh-identity nil
- "Multiple personalities."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'mh)
-
-(defgroup mh-faces nil
- "Faces used in MH-E."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'faces
- :group 'mh)
-
-(defgroup mh-hooks nil
- "MH-E hooks."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'mh)
-
-;;; Faces
-
-(defgroup mh-speed-faces nil
- "Faces used in speedbar."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'mh-faces
- :group 'mh-speed)
-
-(defgroup mh-folder-faces nil
- "Faces used in scan listing."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'mh-faces
- :group 'mh-folder)
-
-(defgroup mh-show-faces nil
- "Faces used in message display."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'mh-faces
- :group 'mh-show)
-
-(defgroup mh-index-faces nil
- "Faces used in indexed searches."
- :link '(custom-manual "(mh-e)Customizing mh-e")
- :prefix "mh-"
- :group 'mh-faces
- :group 'mh-index)
-
-\f
-
-;;; MH-E Customization (:group mh)
-
-;;; Toolbar configuration (:group 'mh-toolbar)
-
-(defconst mh-tool-bar-item-inc "Incorporate new mail in Inbox")
-(defconst mh-tool-bar-item-save-mime "Save MIME parts")
-(defconst mh-tool-bar-item-prev-msg "Previous message")
-(defconst mh-tool-bar-item-page-msg "Page this message")
-(defconst mh-tool-bar-item-next-msg "Next message")
-(defconst mh-tool-bar-item-delete "Mark for deletion")
-(defconst mh-tool-bar-item-refile "Refile this message")
-(defconst mh-tool-bar-item-undo "Undo this mark")
-(defconst mh-tool-bar-item-perform "Perform moves and deletes")
-(defconst mh-tool-bar-item-toggle-show "Toggle showing message")
-(defconst mh-tool-bar-item-reply-from "Reply to \"from\"")
-(defconst mh-tool-bar-item-reply-to "Reply to \"to\"")
-(defconst mh-tool-bar-item-reply-all "Reply to \"all\"")
-(defconst mh-tool-bar-item-reply "Reply to this message")
-(defconst mh-tool-bar-item-alias "Grab From alias")
-(defconst mh-tool-bar-item-compose "Compose new message")
-(defconst mh-tool-bar-item-rescan "Rescan this folder")
-(defconst mh-tool-bar-item-repack "Repack this folder")
-(defconst mh-tool-bar-item-search "Search")
-(defconst mh-tool-bar-item-visit "Visit other folder")
-(defconst mh-tool-bar-item-prefs "MH-E preferences")
-(defconst mh-tool-bar-item-help "Help")
-(defconst mh-tool-bar-item-widen "Widen from this sequence")
-
-(defconst mh-tool-bar-item-send "Send this letter")
-(defconst mh-tool-bar-item-attach "Insert attachment")
-(defconst mh-tool-bar-item-spell "Check spelling")
-(defconst mh-tool-bar-item-save "Save current buffer to its file")
-(defconst mh-tool-bar-item-undo-op "Undo last operation")
-(defconst mh-tool-bar-item-kill
- "Cut (kill) text in region between mark and current position")
-(defconst mh-tool-bar-item-copy
- "Copy text in region between mark and current position")
-(defconst mh-tool-bar-item-paste
- "Paste (yank) text cut or copied earlier")
-(defconst mh-tool-bar-item-kill-draft "Kill this draft")
-(defconst mh-tool-bar-item-comp-prefs "MH-E composition preferences")
-
-(defcustom mh-tool-bar-reply-3-buttons-flag nil
- "*Non-nil means use three buttons for reply commands in tool-bar.
-If you have room on your tool-bar because you are using a large font, you
-may set this variable to expand the single reply button into three buttons
-that won't lead to minibuffer prompt about who to reply to."
- :type 'boolean
- :group 'mh-toolbar)
-
-(defcustom mh-tool-bar-search-function 'mh-search-folder
- "*Function called by the tool-bar search button.
-See `mh-search-folder' and `mh-index-search' for details."
- :type '(choice (const mh-search-folder)
- (const mh-index-search)
- (function :tag "Other function"))
- :group 'mh-toolbar)
-
-(eval-when-compile (defvar tool-bar-map))
-(defvar mh-show-tool-bar-map nil)
-(defun mh-tool-bar-show-set ()
- "Construct toolbar for `mh-show-mode'."
- (when (fboundp 'tool-bar-add-item)
- (setq
- mh-show-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
- (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder
- :help mh-tool-bar-item-inc))
- (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
- (tool-bar-add-item "attach" 'mh-mime-save-parts
- 'mh-showtoolbar-mime-save-parts
- :help mh-tool-bar-item-save-mime))
- (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
- (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg
- 'mh-showtoolbar-prev
- :help mh-tool-bar-item-prev-msg))
- (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
- (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page
- :help mh-tool-bar-item-page-msg))
- (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
- (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg
- 'mh-showtoolbar-next
- :help mh-tool-bar-item-next-msg))
- (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
- (tool-bar-add-item "close" 'mh-show-delete-msg
- 'mh-showtoolbar-delete
- :help mh-tool-bar-item-delete))
- (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
- (tool-bar-add-item "refile" 'mh-show-refile-msg
- 'mh-showtoolbar-refile
- :help mh-tool-bar-item-refile))
- (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
- (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo
- :help mh-tool-bar-item-undo))
- (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
- (tool-bar-add-item "execute" 'mh-show-execute-commands
- 'mh-showtoolbar-exec
- :help mh-tool-bar-item-perform))
- (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
- (tool-bar-add-item "show" 'mh-show-toggle-showing
- 'mh-showtoolbar-toggle-show
- :help mh-tool-bar-item-toggle-show))
- (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
- (tool-bar-add-item "reply-from"
- (lambda (&optional arg)
- (interactive "P")
- (set-buffer mh-show-folder-buffer)
- (mh-reply (mh-get-msg-num nil) "from" arg))
- 'mh-showtoolbar-reply-from
- :help mh-tool-bar-item-reply-from))
- (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
- (tool-bar-add-item "reply-to"
- (lambda (&optional arg)
- (interactive "P")
- (set-buffer mh-show-folder-buffer)
- (mh-reply (mh-get-msg-num nil) "to" arg))
- 'mh-showtoolbar-reply-to
- :help mh-tool-bar-item-reply-to))
- (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
- (tool-bar-add-item "reply-all"
- (lambda (&optional arg)
- (interactive "P")
- (set-buffer mh-show-folder-buffer)
- (mh-reply (mh-get-msg-num nil) "all" arg))
- 'mh-showtoolbar-reply-all
- :help mh-tool-bar-item-reply-all))
- (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
- (tool-bar-add-item "mail/reply2" 'mh-show-reply
- 'mh-showtoolbar-reply
- :help mh-tool-bar-item-reply))
- (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
- (tool-bar-add-item "alias" 'mh-alias-grab-from-field
- 'mh-showtoolbar-alias
- :help mh-tool-bar-item-alias
- :enable '(mh-alias-from-has-no-alias-p)))
- (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
- (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose
- :help mh-tool-bar-item-compose))
- (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
- (tool-bar-add-item "rescan" 'mh-show-rescan-folder
- 'mh-showtoolbar-rescan
- :help mh-tool-bar-item-rescan))
- (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
- (tool-bar-add-item "repack" 'mh-show-pack-folder
- 'mh-showtoolbar-pack
- :help mh-tool-bar-item-repack))
- (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
- (tool-bar-add-item "search"
- (lambda (&optional arg)
- (interactive "P")
- (call-interactively
- mh-tool-bar-search-function))
- 'mh-showtoolbar-search
- :help mh-tool-bar-item-search))
- (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
- (tool-bar-add-item "fld_open" 'mh-visit-folder
- 'mh-showtoolbar-visit
- :help mh-tool-bar-item-visit))
- (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
- (tool-bar-add-item "preferences" (lambda ()
- (interactive)
- (customize-group "mh"))
- 'mh-showtoolbar-customize
- :help mh-tool-bar-item-prefs))
- (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
- (tool-bar-add-item "help" (lambda ()
- (interactive)
- (Info-goto-node "(mh-e)Top"))
- 'mh-showtoolbar-help
- :help mh-tool-bar-item-help))
- tool-bar-map))))
-
-(defvar mh-letter-tool-bar-map nil)
-;;;###mh-autoload
-(defun mh-tool-bar-letter-set ()
- "Construct toolbar for `mh-letter-mode'."
- (when (fboundp 'tool-bar-add-item)
- (setq
- mh-letter-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- (if (member mh-tool-bar-item-send mh-tool-bar-letter-buttons)
- (tool-bar-add-item "mail_send" 'mh-send-letter
- 'mh-lettertoolbar-send
- :help mh-tool-bar-item-send))
- (if (member mh-tool-bar-item-attach mh-tool-bar-letter-buttons)
- (tool-bar-add-item "attach" 'mh-compose-insertion
- 'mh-lettertoolbar-compose
- :help mh-tool-bar-item-attach))
- (if (member mh-tool-bar-item-spell mh-tool-bar-letter-buttons)
- (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell
- :help mh-tool-bar-item-spell))
- (if (member mh-tool-bar-item-save mh-tool-bar-letter-buttons)
- (tool-bar-add-item-from-menu 'save-buffer "save"))
- (if (member mh-tool-bar-item-undo-op mh-tool-bar-letter-buttons)
- (tool-bar-add-item-from-menu 'undo "undo"))
- (if (member mh-tool-bar-item-kill mh-tool-bar-letter-buttons)
- (tool-bar-add-item-from-menu 'kill-region "cut"))
- (if (member mh-tool-bar-item-copy mh-tool-bar-letter-buttons)
- (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy"))
- (if (member mh-tool-bar-item-paste mh-tool-bar-letter-buttons)
- (tool-bar-add-item-from-menu 'yank "paste"))
- (if (member mh-tool-bar-item-kill-draft mh-tool-bar-letter-buttons)
- (tool-bar-add-item "close" 'mh-fully-kill-draft
- 'mh-lettertoolbar-kill
- :help mh-tool-bar-item-kill-draft))
- (if (member mh-tool-bar-item-comp-prefs mh-tool-bar-letter-buttons)
- (tool-bar-add-item "preferences" (lambda ()
- (interactive)
- (customize-group "mh-compose"))
- 'mh-lettertoolbar-customize
- :help mh-tool-bar-item-comp-prefs))
- (if (member mh-tool-bar-item-help mh-tool-bar-letter-buttons)
- (tool-bar-add-item "help" (lambda ()
- (interactive)
- (Info-goto-node "(mh-e)Draft Editing"))
- 'mh-lettertoolbar-help
- :help mh-tool-bar-item-help))
- tool-bar-map))))
-
-(defvar mh-folder-tool-bar-map nil)
-(defvar mh-folder-seq-tool-bar-map nil
- "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.")
-;;;###mh-autoload
-(defun mh-tool-bar-folder-set ()
- "Construct toolbar for `mh-folder-mode'."
- (when (fboundp 'tool-bar-add-item)
- (setq
- mh-folder-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
- (tool-bar-add-item "mail" 'mh-inc-folder
- 'mh-foldertoolbar-inc-folder
- :help mh-tool-bar-item-inc))
- (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
- (tool-bar-add-item "attach" 'mh-mime-save-parts
- 'mh-foldertoolbar-mime-save-parts
- :help mh-tool-bar-item-save-mime))
- (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
- (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg
- 'mh-foldertoolbar-prev
- :help mh-tool-bar-item-prev-msg))
- (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
- (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page
- :help mh-tool-bar-item-page-msg))
- (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
- (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg
- 'mh-foldertoolbar-next
- :help mh-tool-bar-item-next-msg))
- (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
- (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete
- :help mh-tool-bar-item-delete))
- (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
- (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile
- :help mh-tool-bar-item-refile))
- (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
- (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo
- :help mh-tool-bar-item-undo))
- (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
- (tool-bar-add-item "execute" 'mh-execute-commands
- 'mh-foldertoolbar-exec
- :help mh-tool-bar-item-perform))
- (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
- (tool-bar-add-item "show" 'mh-toggle-showing
- 'mh-foldertoolbar-toggle-show
- :help mh-tool-bar-item-toggle-show))
- (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
- (tool-bar-add-item "reply-from"
- (lambda (&optional arg)
- (interactive "P")
- (mh-reply (mh-get-msg-num nil) "from" arg))
- 'mh-foldertoolbar-reply-from
- :help mh-tool-bar-item-reply-from))
- (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
- (tool-bar-add-item "reply-to"
- (lambda (&optional arg)
- (interactive "P")
- (mh-reply (mh-get-msg-num nil) "to" arg))
- 'mh-foldertoolbar-reply-to
- :help mh-tool-bar-item-reply-to))
- (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
- (tool-bar-add-item "reply-all"
- (lambda (&optional arg)
- (interactive "P")
- (mh-reply (mh-get-msg-num nil) "all" arg))
- 'mh-foldertoolbar-reply-all
- :help mh-tool-bar-item-reply-all))
- (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
- (tool-bar-add-item "mail/reply2" 'mh-reply
- 'mh-foldertoolbar-reply
- :help mh-tool-bar-item-reply))
- (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
- (tool-bar-add-item "alias" 'mh-alias-grab-from-field
- 'mh-foldertoolbar-alias
- :help mh-tool-bar-item-alias
- :enable '(mh-alias-from-has-no-alias-p)))
- (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
- (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose
- :help mh-tool-bar-item-compose))
- (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
- (tool-bar-add-item "rescan" 'mh-rescan-folder
- 'mh-foldertoolbar-rescan
- :help mh-tool-bar-item-rescan))
- (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
- (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack
- :help mh-tool-bar-item-repack))
- (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
- (tool-bar-add-item "search"
- (lambda (&optional arg)
- (interactive "P")
- (call-interactively
- mh-tool-bar-search-function))
- 'mh-foldertoolbar-search
- :help mh-tool-bar-item-search))
- (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
- (tool-bar-add-item "fld_open" 'mh-visit-folder
- 'mh-foldertoolbar-visit
- :help mh-tool-bar-item-visit))
- (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
- (tool-bar-add-item "preferences" (lambda ()
- (interactive)
- (customize-group "mh"))
- 'mh-foldertoolbar-customize
- :help mh-tool-bar-item-prefs))
- (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
- (tool-bar-add-item "help" (lambda ()
- (interactive)
- (Info-goto-node "(mh-e)Top"))
- 'mh-foldertoolbar-help
- :help mh-tool-bar-item-help))
- tool-bar-map))
-
- (setq mh-folder-seq-tool-bar-map
- (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
- (if (member mh-tool-bar-item-widen mh-tool-bar-folder-buttons)
- (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen
- :help mh-tool-bar-item-widen))
- tool-bar-map))))
-
-(defun mh-tool-bar-folder-buttons-set (symbol value)
- "Update the `mh-tool-bar-folder-buttons' variable, and rebuild the tool-bar.
-Sets the default for SYMBOL (e.g. `mh-tool-bar-folder-buttons') to VALUE (as
-set in customization). This is called after 'customize is used to alter
-`mh-tool-bar-folder-buttons'."
- (set-default symbol value)
- (mh-tool-bar-show-set)
- (mh-tool-bar-folder-set))
-
-(custom-declare-variable
- 'mh-tool-bar-folder-buttons
- '(append
- (list mh-tool-bar-item-inc
- mh-tool-bar-item-save-mime
- mh-tool-bar-item-prev-msg
- mh-tool-bar-item-page-msg
- mh-tool-bar-item-next-msg
- mh-tool-bar-item-delete
- mh-tool-bar-item-refile
- mh-tool-bar-item-undo
- mh-tool-bar-item-perform
-;;; mh-tool-bar-item-toggle-show
- )
- (if mh-tool-bar-reply-3-buttons-flag
- (list mh-tool-bar-item-reply-from
- mh-tool-bar-item-reply-to
- mh-tool-bar-item-reply-all)
- (list mh-tool-bar-item-reply))
- (list mh-tool-bar-item-alias
- mh-tool-bar-item-compose
- mh-tool-bar-item-rescan
-;;; mh-tool-bar-item-repack
- mh-tool-bar-item-search
- mh-tool-bar-item-visit
- mh-tool-bar-item-prefs
- mh-tool-bar-item-help
- mh-tool-bar-item-widen))
- "Buttons to include in MH-E folder/show toolbar."
- :group 'mh-toolbar
- :set 'mh-tool-bar-folder-buttons-set
- :type `(set (const ,mh-tool-bar-item-inc)
- (const ,mh-tool-bar-item-save-mime)
- (const ,mh-tool-bar-item-prev-msg)
- (const ,mh-tool-bar-item-page-msg)
- (const ,mh-tool-bar-item-next-msg)
- (const ,mh-tool-bar-item-delete)
- (const ,mh-tool-bar-item-refile)
- (const ,mh-tool-bar-item-undo)
- (const ,mh-tool-bar-item-perform)
- (const ,mh-tool-bar-item-toggle-show)
- (const ,mh-tool-bar-item-reply-from)
- (const ,mh-tool-bar-item-reply-to)
- (const ,mh-tool-bar-item-reply-all)
- (const ,mh-tool-bar-item-reply)
- (const ,mh-tool-bar-item-alias)
- (const ,mh-tool-bar-item-compose)
- (const ,mh-tool-bar-item-rescan)
- (const ,mh-tool-bar-item-repack)
- (const ,mh-tool-bar-item-search)
- (const ,mh-tool-bar-item-visit)
- (const ,mh-tool-bar-item-prefs)
- (const ,mh-tool-bar-item-help)
- (const ,mh-tool-bar-item-widen)))
-
-(defun mh-tool-bar-letter-buttons-set (symbol value)
- "Update the `mh-tool-bar-letter-buttons' variable, and rebuild the tool-bar.
-Sets the default for SYMBOL (e.g. `mh-tool-bar-letter-buttons') to VALUE (as
-set in customization). This is called after 'customize is used to alter
-`mh-tool-bar-letter-buttons'."
- (set-default symbol value)
- (mh-tool-bar-letter-set))
-
-(custom-declare-variable
- 'mh-tool-bar-letter-buttons
- '(list mh-tool-bar-item-send
- mh-tool-bar-item-attach
- mh-tool-bar-item-spell
- mh-tool-bar-item-save
- mh-tool-bar-item-undo-op
- mh-tool-bar-item-kill
- mh-tool-bar-item-copy
- mh-tool-bar-item-paste
- mh-tool-bar-item-kill-draft
- mh-tool-bar-item-comp-prefs
- mh-tool-bar-item-help)
- "Buttons to include in MH-E letter toolbar."
- :group 'mh-toolbar
- :set 'mh-tool-bar-letter-buttons-set
- :type `(set (const ,mh-tool-bar-item-send)
- (const ,mh-tool-bar-item-attach)
- (const ,mh-tool-bar-item-spell)
- (const ,mh-tool-bar-item-save)
- (const ,mh-tool-bar-item-undo-op)
- (const ,mh-tool-bar-item-kill)
- (const ,mh-tool-bar-item-copy)
- (const ,mh-tool-bar-item-paste)
- (const ,mh-tool-bar-item-kill-draft)
- (const ,mh-tool-bar-item-comp-prefs)
- (const ,mh-tool-bar-item-help)))
-
-\f
-
-;;; Speedbar and folder configuration (:group 'mh-speed)
-
-(defcustom mh-large-folder 200
- "The number of messages that indicates a large folder.
-If a folder is deemed to be large, that is the number of messages in it exceed
-this value, then confirmation is needed when it is visited. Even when
-`mh-show-threads-flag' is non-nil, the folder is not automatically threaded, if
-it is large. If set to nil all folders are treated as if they are small."
- :type '(choice (const :tag "No limit") integer)
- :group 'mh-speed)
-
-(defcustom mh-speed-flists-interval 60
- "Time between calls to flists in seconds.
-If 0, flists is not called repeatedly."
- :type 'integer
- :group 'mh-speed)
-
-(defcustom mh-speed-run-flists-flag t
- "Non-nil means flists is used.
-If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
-update the display of the number of unseen and total messages in each folder.
-If resources are limited, this can be set to nil and the speedbar display can
-be updated manually with the \\[mh-speed-flists] command."
- :type 'boolean
- :group 'mh-speed)
-
-;;; Options for controlling scan listing (:group 'mh-folder)
-
-(defcustom mh-adaptive-cmd-note-flag t
- "*Non-nil means that the message number width is determined dynamically.
-This is done once when a folder is first opened by running scan on the last
-message of the folder. The message number for the last message is extracted
-and its width calculated. This width is used when calling `mh-set-cmd-note'.
-
-If you prefer fixed-width message numbers, set this variable to nil and call
-`mh-set-cmd-note' with the width specified by the scan format in
-`mh-scan-format-file'. For example, the default width is 4, so you would use
-\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil."
- :type 'boolean
- :group 'mh-folder)
-
-(defcustom mh-auto-folder-collect-flag t
- "*Non-nil means to collect all folder names at startup in the background.
-Otherwise, the internal list of folder names is built as folders are
-referenced."
- :type 'boolean
- :group 'mh-folder)
-
-(defcustom mh-inc-prog "inc"
- "*Program to run to incorporate new mail into a folder.
-Normally \"inc\". This file is searched for relative to
-the `mh-progs' directory unless it is an absolute pathname."
- :type 'string
- :group 'mh-folder)
-
-(defcustom mh-lpr-command-format "lpr -J '%s'"
- "*Format for Unix command that prints a message.
-The string should be a Unix command line, with the string '%s' where
-the job's name (folder and message number) should appear. The formatted
-message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
- :type 'string
- :group 'mh-folder)
-
-(defcustom mh-mime-save-parts-default-directory t
- "Default directory to use for `mh-mime-save-parts'.
-If nil, prompt and set for next time the command is used during same session.
-If t, prompt always"
- :type '(choice (const :tag "Prompt the first time" nil)
- (const :tag "Prompt always" t)
- directory)
- :group 'mh-folder)
-
-(defcustom mh-recenter-summary-flag nil
- "*Non-nil means to recenter the summary window.
-Recenter the summary window when the show window is toggled off if non-nil."
- :type 'boolean
- :group 'mh-folder)
-
-(defcustom mh-print-background-flag nil
- "*Non-nil means messages should be printed in the background.
-WARNING: do not delete the messages until printing is finished;
-otherwise, your output may be truncated."
- :type 'boolean
- :group 'mh-folder)
-
-(defcustom mh-recursive-folders-flag nil
- "*Non-nil means that commands which operate on folders do so recursively."
- :type 'boolean
- :group 'mh-folder)
-
-(defcustom mh-scan-format-file t
- "Specifies the format file to pass to the scan program.
-If t, the format string will be taken from the either `mh-scan-format-mh'
-or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
-If nil, the default scan output will be used.
-
-If you customize the scan format, you may need to modify a few variables
-containing regexps that MH-E uses to identify specific portions of the output.
-Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
-may also have to call `mh-set-cmd-note' with the width of your message
-numbers. See also `mh-adaptive-cmd-note-flag'."
- :type '(choice (const :tag "Use MH-E scan format" t)
- (const :tag "Use default scan format" nil)
- (file :tag "Specify a scan format file"))
- :group 'mh-folder)
-
-(defcustom mh-scan-prog "scan"
- "*Program to run to generate one-line-per-message listing of a folder.
-Normally \"scan\" or a file name linked to scan. This file is searched
-for relative to the `mh-progs' directory unless it is an absolute pathname."
- :type 'string
- :group 'mh-folder)
-(make-variable-buffer-local 'mh-scan-prog)
-
-(defcustom mh-show-threads-flag nil
- "Non-nil means new folders start in threaded mode.
-Threading large number of messages can be time consuming. So if the flag is
-non-nil then threading will be done only if the number of messages being
-threaded is less than `mh-large-folder'."
- :type 'boolean
- :group 'mh-folder)
-
-(defcustom mh-store-default-directory nil
- "*Last directory used by \\[mh-store-msg]; default for next store.
-A directory name string, or nil to use current directory."
- :type '(choice (const :tag "Current" nil)
- directory)
- :group 'mh-folder)
-
-(defcustom mh-update-sequences-after-mh-show-flag t
- "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'.
-If set, `mh-update-sequence' is run every time a message is shown, telling
-MH or nmh that this is your current message. It's useful, for example, to
-display MIME content using \"M-! mhshow RET\""
- :type 'boolean
- :group 'mh-folder)
-
-;;; Message display (:group 'mh-show)
-
-(defcustom mh-bury-show-buffer-flag t
- "*Non-nil means that the displayed show buffer for a folder is buried."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-clean-message-header-flag t
- "*Non-nil means clean headers of messages that are displayed or inserted.
-The variables `mh-invisible-headers' and `mh-visible-headers' control
-what is removed."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode")))
- "*Non-nil means that Gnus is used to show MIME attachments with Gnus."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-decode-quoted-printable-flag
- (not (null (and (fboundp 'executable-find)(executable-find "mimedecode"))))
- "Non-nil means decode quoted-printable MIME part with `mimedecode'.
-
-Quoted-printable message parts are translated to 8-bit characters by the
-`mimedecode' command. However, unless there is only one quoted-printable body
-part, Gnus will have already decoded the quoted-printable parts.
-
-This variable is initialized t if `mimedecode' is available.
-
-The source code for `mimedecode' can be obtained from
-http://www.freesoft.org/CIE/FAQ/mimedeco.c."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-display-buttons-for-inline-parts-flag nil
- "*Non-nil means display buttons for all inline MIME parts.
-If non-nil, buttons are displayed for all MIME parts. Inline parts start off
-in displayed state but they can be hidden by clicking the button. If nil no
-buttons are shown for inline parts."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-do-not-confirm-flag nil
- "*Non-nil means do not prompt for confirmation.
-Commands such as `mh-pack-folder' prompt to confirm whether to process
-outstanding moves and deletes or not before continuing. A non-nil setting will
-perform the action--which is usually desired but cannot be retracted--without
-question."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-graphical-smileys-flag t
- "*Non-nil means graphical smileys are displayed.
-Non-nil means that small graphics will be used in the show buffer instead of
-patterns like :-), ;-) etc. The setting only has effect if
-`mh-decode-mime-flag' is non-nil."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-graphical-emphasis-flag t
- "*Non-nil means graphical emphasis is displayed.
-Non-nil means that _underline_ will be underlined, *bold* will appear in bold,
-/italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole
-list. The setting only has effect if `mh-decode-mime-flag' is non-nil."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-highlight-citation-p 'gnus
- "How to highlight citations in show buffers.
-The gnus method uses a different color for each indentation."
- :type '(choice (const :tag "Use gnus" gnus)
- (const :tag "Use font-lock" font-lock)
- (const :tag "Don't fontify" nil))
- :group 'mh-show)
-
-(defcustom mh-max-inline-image-height nil
- "*Maximum inline image height if Content-Disposition is not present.
-If nil, image will be displayed if its height is smaller than the height of
-the window."
- :type '(choice (const nil) integer)
- :group 'mh-show)
-
-(defcustom mh-max-inline-image-width nil
- "*Maximum inline image width if Content-Disposition is not present.
-If nil, image will be displayed if its width is smaller than the width of the
-window."
- :type '(choice (const nil) integer)
- :group 'mh-show)
-
-(defcustom mh-show-maximum-size 0
- "*Maximum size of message (in bytes) to display automatically.
-Provides an opportunity to skip over large messages which may be slow to load.
-Use a value of 0 to display all messages automatically regardless of size."
- :type 'integer
- :group 'mh-show)
-
-;; Use goto-addr if it was already loaded (which probably sets this
-;; variable to t), or if this variable is otherwise set to t.
-(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p)
- goto-address-highlight-p)
- "*Non-nil means highlight URLs and email addresses.
-The `goto-addr' module is used."
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-show-use-xface-flag
- (and window-system
- (not (null (cond
- (mh-xemacs-flag
- (locate-library "x-face"))
- ((>= emacs-major-version 21)
- (locate-library "x-face-e21"))
- (t ;Emacs20
- nil))))
- (not (null (and (fboundp 'executable-find)
- (executable-find
- "uncompface")))))
- "*Non-nil means display faces in `mh-show-mode' with external x-face package.
-It is available from ftp://ftp.jpl.org/pub/elisp/. Download it and put its
-files in the Emacs `load-path' and MH-E will invoke it automatically for you if
-this variable is non-nil.
-
-The `uncompface' binary is also required to be in the execute PATH. It can
-be obtained from: ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z"
- :type 'boolean
- :group 'mh-show)
-
-(defcustom mh-summary-height (or (and (fboundp 'frame-height)
- (> (frame-height) 24)
- (min 10 (/ (frame-height) 6)))
- 4)
- "*Number of lines in MH-Folder window (including the mode line)."
- :type 'integer
- :group 'mh-show)
-
-(defcustom mh-visible-headers nil
- "*Contains a regexp specifying the headers to keep when cleaning.
-Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides
-the variable `mh-invisible-headers'."
- :type '(choice (const nil) regexp)
- :group 'mh-show)
-
-(defcustom mhl-formfile nil
- "*Name of format file to be used by mhl to show and print messages.
-A value of t means use the default format file.
-nil means don't use mhl to format messages when showing; mhl is still used,
-with the default format file, to format messages when printing them.
-The format used should specify a non-zero value for overflowoffset so
-the message continues to conform to RFC 822 and MH-E can parse the headers."
- :type '(choice (const nil) (const t) string)
- :group 'mh-show)
-(put 'mhl-formfile 'info-file "mh-e")
-
-(defvar mh-invisible-headers nil
- "*Regexp matching lines in a message header that are not to be shown.
-If `mh-visible-headers' is non-nil, it is used instead to specify what
-to keep.")
-
-(defun mh-invisible-headers ()
- "Make or remake the variable `mh-invisible-headers'.
-Done using `mh-invisible-header-fields' as input."
- (setq mh-invisible-headers
- (concat
- "^"
- (let ((max-specpdl-size 1000)) ;workaround for insufficient default
- (regexp-opt
- (append
- (if (not mh-show-use-xface-flag)
- '("X-Face: "))
- mh-invisible-header-fields))))))
-
-(defun mh-invisible-header-fields-set (symbol value)
- "Update `mh-invisible-header-fields'.
-The function is called with SYMBOL bound to `mh-invisible-header-fields' and
-VALUE is the the list of headers that are invisible. As a side effect, the
-variable `mh-invisible-fields' is set."
- (set-default symbol value)
- (mh-invisible-headers))
-
-;; Keep fields alphabetized. Mention source, if known.
-(defcustom mh-invisible-header-fields
- '("Autoforwarded: "
- "Bestservhost: "
- "Content-" ; RFC 2045
- "Delivered-To: " ; Egroups/yahoogroups mailing list manager
- "Delivery-Date: " ; MH
- "Delivery: "
- "Encoding: "
- "Errors-To: "
- "Forwarded: " ; MH
- "From " ; sendmail
- "Importance: " ; MS Outlook
- "In-Reply-To: " ; MH
- "Lines: "
- "List-" ; Mailman mailing list manager
- "List-" ; Unknown mailing list managers
- "List-Subscribe: " ; Unknown mailing list managers
- "List-Unsubscribe: " ; Unknown mailing list managers
- "Mail-from: " ; MH
- "Mailing-List: " ; Egroups/yahoogroups mailing list manager
- "Message-Id: " ; RFC 822
- "Mime-Version" ; RFC 2045
- "NNTP-" ; News
- "Old-Return-Path: "
- "Original-Encoded-Information-Types: " ; X400
- "P1-Content-Type: " ; X400
- "P1-Message-Id: " ; X400
- "P1-Recipient: " ; X400
- "Path: "
- "Precedence: "
- "Prev-Resent" ; MH
- "Priority: "
- "Received: " ; RFC 822
- "References: "
- "Remailed-" ; MH
- "Replied: " ; MH
- "Resent" ; MH
- "Return-Path: " ; RFC 822
- "Sensitivity: " ; MS Outlook
- "Status: " ; sendmail
- "Ua-Content-Id: " ; X400
- "User-Agent: "
- "Via: " ; MH
- "X-Abuse-Info: "
- "X-Accept-Language: "
- "X-Accept-Language: " ; Netscape/Mozilla
- "X-Ack: "
- "X-Apparently-From: " ; MS Outlook
- "X-Apparently-To: " ; Egroups/yahoogroups mailing list manager
- "X-Authentication-Warning: " ; sendmail
- "X-Beenthere: " ; Mailman mailing list manager
- "X-Complaints-To: "
- "X-Cron-Env: "
- "X-Delivered"
- "X-Envelope-Sender: "
- "X-Envelope-To: "
- "X-Folder: " ; Spam
- "X-From-Line"
- "X-Gnus-Mail-Source: " ; gnus
- "X-Habeas-SWE-1: " ; Spam
- "X-Habeas-SWE-2: " ; Spam
- "X-Habeas-SWE-3: " ; Spam
- "X-Habeas-SWE-4: " ; Spam
- "X-Habeas-SWE-5: " ; Spam
- "X-Habeas-SWE-6: " ; Spam
- "X-Habeas-SWE-7: " ; Spam
- "X-Habeas-SWE-8: " ; Spam
- "X-Habeas-SWE-9: " ; Spam
- "X-Info: " ; NTMail
- "X-Juno-" ; Juno
- "X-List-Host: " ; Unknown mailing list managers
- "X-List-Subscribe: " ; Unknown mailing list managers
- "X-List-Unsubscribe: " ; Unknown mailing list managers
- "X-Listserver: " ; Unknown mailing list managers
- "X-Loop: " ; Unknown mailing list managers
- "X-MIME-Autoconverted: " ; sendmail
- "X-MIMETrack: "
- "X-MS-TNEF-Correlator: " ; MS Outlook
- "X-Mailing-List: " ; Unknown mailing list managers
- "X-Mailman-Version: " ; Mailman mailing list manager
- "X-Message-Id"
- "X-MimeOLE: " ; MS Outlook
- "X-Mozilla-Status: " ; Netscape/Mozilla
- "X-Msmail-" ; MS Outlook
- "X-News: " ; News
- "X-No-Archive: "
- "X-Orcl-Content-Type: "
- "X-Original-Complaints-To: "
- "X-Original-Date: " ; SourceForge mailing list manager
- "X-Original-Trace: "
- "X-OriginalArrivalTime: " ; Hotmail
- "X-Originating-IP: " ; Hotmail
- "X-Priority: " ; MS Outlook
- "X-Qotd-" ; User added
- "X-Received-Date: "
- "X-Received: "
- "X-Request-"
- "X-SBClass: " ; Spam
- "X-SBNote: " ; Spam
- "X-SBPass: " ; Spam
- "X-SBRule: " ; Spam
- "X-Scanned-By"
- "X-Sender: "
- "X-Server-Date: "
- "X-Server-Uuid: "
- "X-Sieve: " ; Sieve filtering
- "X-Spam-Level: " ; Spam
- "X-Spam-Score: " ; Spam
- "X-Spam-Status: " ; Spam
- "X-SpamBouncer: " ; Spam
- "X-Trace: "
- "X-UIDL: "
- "X-UserInfo1: "
- "X-VSMLoop: " ; NTMail
- "X-Vms-To: "
- "X-Wss-Id: " ; Worldtalk gateways
- "X-eGroups-" ; Egroups/yahoogroups mailing list manager
- "X-pgp: "
- "X-submission-address: "
- "X400-" ; X400
- "Xref: ")
-"*List of header fields that are not to be shown.
-Regexps are not allowed. Unique fields should have a \": \" suffix;
-otherwise, the element can be used to render an entire class of fields
-that start with the same prefix invisible.
-This variable is ignored if `mh-visible-headers' is set."
- :type '(repeat (string :tag "Header field"))
- :set 'mh-invisible-header-fields-set
- :group 'mh-show)
-
-;;; Composing messages (:group 'mh-letter)
-
-(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
- "Use either 'gnus or 'mhn to insert MIME message directives in messages."
- :type '(choice (const :tag "Use gnus" gnus)
- (const :tag "Use mhn" mhn))
- :group 'mh-letter)
-
-(defcustom mh-compose-letter-function nil
- "Invoked when setting up a letter draft.
-It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
- :type '(choice (const nil) function)
- :group 'mh-letter)
-
-(defcustom mh-delete-yanked-msg-window-flag nil
- "*Non-nil means delete any window displaying the message.
-Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
-If non-nil, yanking the current message into a draft letter deletes any
-windows displaying the message."
- :type 'boolean
- :group 'mh-letter)
-
-(defcustom mh-extract-from-attribution-verb "wrote:"
- "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
- :type '(choice (const "wrote:")
- (const "a écrit :")
- (string :tag "Custom string"))
- :group 'mh-letter)
-
-(defcustom mh-forward-subject-format "%s: %s"
- "*Format to generate the Subject: line contents for a forwarded message.
-The two string arguments to the format are the sender of the original
-message and the original subject line."
- :type 'string
- :group 'mh-letter)
-
-(defcustom mh-ins-buf-prefix "> "
- "*String to put before each non-blank line of a yanked or inserted message.
-\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
-by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
- :type 'string
- :group 'mh-letter)
-
-(defcustom mh-insert-mail-followup-to-flag t
- "Non-nil means maybe append a Mail-Followup-To field to the header.
-The insertion is done if the To: or Cc: fields matches an entry in
-`mh-insert-mail-followup-to-list'."
- :type 'boolean
- :group 'mh-letter)
-
-(defcustom mh-insert-mail-followup-to-list nil
- "Alist of addresses for which a Mail-Followup-To field is inserted.
-Each element has the form (REGEXP ADDRESS).
-When the REGEXP appears in the To or cc fields of a message, the corresponding
-ADDRESS is inserted in a Mail-Followup-To field.
-
-Here's a customization example:
-
- regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net
- address: mh-e-users@lists.sourceforge.net
-
-This corresponds to:
-
- (setq mh-insert-mail-followup-to-list
- '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\"
- \"mh-e-users@lists.sourceforge.net\")))
-
-While it might be tempting to add a descriptive name to the mailing list
-address, consider that this field will appear in other people's outgoing
-mail in their To: field. It might be best to keep it simple."
- :type '(repeat (list (string :tag "regexp") (string :tag "address")))
- :group 'mh-letter)
-
-(defcustom mh-insert-x-mailer-flag t
- "*Non-nil means append an X-Mailer field to the header."
- :type 'boolean
- :group 'mh-letter)
-
-(defcustom mh-letter-fill-column 72
- "*Fill column to use in `mh-letter-mode'.
-This is usually less than in other text modes because email messages get
-quoted by some prefix (sometimes many times) when they are replied to,
-and it's best to avoid quoted lines that span more than 80 columns."
- :type 'integer
- :group 'mh-letter)
-
-(defcustom mh-reply-default-reply-to nil
- "*Sets the person or persons to whom a reply will be sent.
-If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
-value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
-The values \"cc\" and \"all\" do the same thing."
- :type '(choice (const :tag "Prompt" nil)
- (const "from") (const "to")
- (const "cc") (const "all"))
- :group 'mh-letter)
-
-(defcustom mh-reply-show-message-flag t
- "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
-
-The setting of this variable determines whether the MH `show-buffer' is
-displayed with the current message when using `mh-reply' without a prefix
-argument. Set it to nil if you already include the message automatically
-in your draft using
- repl: -filter repl.filter
-in your ~/.mh_profile file."
- :type 'boolean
- :group 'mh-letter)
-
-(defcustom mh-signature-file-name "~/.signature"
- "*Name of file containing the user's signature.
-Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
- :type 'file
- :group 'mh-letter)
-
-(defcustom mh-x-face-file "~/.face"
- "*File name containing the encoded X-Face string to insert in outgoing mail.
-If nil, or the file does not exist, nothing is added to message headers."
- :type 'file
- :group 'mh-letter)
-
-(defvar mh-x-mailer-string nil
- "*String containing the contents of the X-Mailer header field.
-If nil, this variable is initialized to show the version of MH-E, Emacs, and
-MH the first time a message is composed.")
-
-(defcustom mh-yank-from-start-of-msg 'attribution
- "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
-If t, include the entire message, with full headers. This is historically
-here for use with supercite, but is now deprecated in favor of the setting
-`supercite' below.
-
-If the symbol `body', then yank the message minus the header.
-
-If the symbol `supercite', include the entire message, with full headers.
-This also causes the invocation of `sc-cite-original' without the setting
-of `mail-citation-hook', now deprecated practice.
-
-If the symbol `autosupercite', do as for `supercite' automatically when
-show buffer matches the message being replied-to. When this option is used,
-the -noformat switch is passed to the repl program to override a -filter or
--format switch.
-
-If the symbol `attribution', then yank the message minus the header and add
-a simple attribution line at the top.
-
-If the symbol `autoattrib', do as for `attribution' automatically when show
-buffer matches the message being replied-to. You can make sure this is
-always the case by setting `mh-reply-show-message-flag' to t (which is the
-default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such
-that the show window is never displayed. When the `autoattrib' option is
-used, the -noformat switch is passed to the repl program to override a
--filter or -format switch.
-
-If nil, yank only the portion of the message following the point.
-
-If the show buffer has a region, this variable is ignored unless its value is
-one of `attribution' or `autoattrib' in which case the attribution is added
-to the yanked region."
- :type '(choice (const :tag "Below point" nil)
- (const :tag "Without header" body)
- (const :tag "Invoke supercite" supercite)
- (const :tag "Invoke supercite, automatically" autosupercite)
- (const :tag "Without header, with attribution" attribution)
- (const :tag "Without header, with attribution, automatically"
- autoattrib)
- (const :tag "Entire message with headers" t))
- :group 'mh-letter)
-
-(defcustom mh-letter-complete-function 'ispell-complete-word
- "*Function to call when completing outside of fields specific to aliases."
- :type '(choice function (const nil))
- :group 'mh-letter)
-
-;;; Alias handling (:group 'mh-alias)
-
-(defcustom mh-alias-system-aliases
- '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd")
- "*A list of system files from which to cull aliases.
-If these files are modified, they are automatically reread. This list need
-include only system aliases and the passwd file, since personal alias files
-listed in your \"AliasFile\" MH profile component are automatically included.
-You can update the alias list manually using \\[mh-alias-reload]."
- :group 'mh-alias
- :type '(choice (file) (repeat file)))
-
-(defcustom mh-alias-expand-aliases-flag nil
- "*Non-nil means to expand aliases entered in the minibuffer.
-In other words, aliases entered in the minibuffer will be expanded to the full
-address in the message draft. By default, this expansion is not performed."
- :group 'mh-alias
- :type 'boolean)
-
-(defcustom mh-alias-completion-ignore-case-flag t
- "*Non-nil means don't consider case significant in MH alias completion.
-This is the default in plain MH, so it is the default here as well. It
-can be useful to set this to t if, for example, you use lowercase
-aliases for people and uppercase for mailing lists."
- :group 'mh-alias
- :type 'boolean)
-
-(defcustom mh-alias-flash-on-comma t
- "*Specify whether to flash or warn on translation.
-When a [comma] is pressed while entering aliases or addresses, setting this
-variable to the following values has the listed effects:
-t Flash alias translation but don't warn if there is no translation.
-1 Flash alias translation and warn if there is no translation.
-nil Do not flash alias translation nor warn if there is no translation."
- :group 'mh-alias
- :type '(choice (const :tag "Flash but don't warn if no translation" t)
- (const :tag "Flash and warn if no translation" 1)
- (const :tag "Don't flash nor warn if no translation" nil)))
-
-(defcustom mh-alias-local-users t
- "*If t, local users are completed in MH-E To: and Cc: prompts.
-
-Users with a userid greater than some magic number (usually 200) are available
-for completion.
-
-If you set this variable to a string, it will be executed to generate a
-password file. A value of \"ypcat passwd\" is helpful if NIS is in use."
- :group 'mh-alias
- :type '(choice (boolean) (string)))
-
-(defcustom mh-alias-insert-file nil
- "*Filename to use to store new MH-E aliases.
-This variable can also be a list of filenames, in which case MH-E will prompt
-for one of them. If nil, the default, then MH-E will use the first file found
-in the \"AliasFile\" component of the MH profile."
- :group 'mh-alias
- :type '(choice (const :tag "Use AliasFile MH profile component" nil)
- (file :tag "Alias file")
- (repeat :tag "List of alias files" file)))
-
-(defcustom mh-alias-insertion-location 'sorted
- "Specifies where new aliases are entered in alias files.
-Options are sorted alphabetically, at the top of the file or at the bottom."
- :type '(choice (const :tag "Sorted alphabetically" sorted)
- (const :tag "At the top of file" top)
- (const :tag "At the bottom of file" bottom))
- :group 'mh-alias)
-
-;;; Indexed searching (:group 'mh-index)
-
-(defcustom mh-index-program nil
- "Indexing program that MH-E shall use.
-The possible choices are swish++, swish-e, namazu, glimpse and grep. By
-default this variable is nil which means that the programs are tried in order
-and the first one found is used."
- :type '(choice (const :tag "auto-detect" nil)
- (const :tag "swish++" swish++)
- (const :tag "swish-e" swish)
- (const :tag "namazu" namazu)
- (const :tag "glimpse" glimpse)
- (const :tag "grep" grep))
- :group 'mh-index)
-
-;;; Multiple personalities (:group 'mh-identity)
-
-(defcustom mh-identity-list nil
- "*List holding MH-E identity.
-Omit the colon and trailing space from the field names.
-The keyword name \"none\" is reversed for internal use.
-Use the keyname name \"signature\" to specify either a signature file or a
-function to call to insert a signature at point.
-
-Providing an empty Value (\"\") will cause the field to be deleted.
-
-Example entries using the customize interface:
- Keyword name: work
- From
- Value: John Doe <john@work.com>
- Organization
- Value: Acme Inc.
- Keyword name: home
- From
- Value: John Doe <johndoe@home.net>
- Organization
- Value:
-
-This would produce the equivalent of:
- (setq mh-identity-list
- '((\"work\"
- ((\"From\" . \"John Doe <john@work.com>\")
- (\"Organization\" . \"Acme Inc.\")))
- (\"home\"
- ((\"From\" . \"John Doe <johndoe@home.net>\")
- (\"Organization\" . \"\")))))"
- :type '(repeat (list :tag ""
- (string :tag "Keyword name")
- (repeat :tag "At least one pair from below"
- (choice (cons :tag "From field"
- (const "From")
- (string :tag "Value"))
- (cons :tag "Organization field"
- (const "Organization")
- (string :tag "Value"))
- (cons :tag "Signature"
- (const "signature")
- (choice (file) (function)))
- (cons :tag "Other field & value pair"
- (string :tag "Field")
- (string :tag "Value"))))))
- :set 'mh-identity-list-set
- :group 'mh-identity)
-
-(defcustom mh-identity-default nil
- "Default identity to use when `mh-letter-mode' is called."
- ;; Dynamically render :type corresponding to `mh-identity-list' entries,
- ;; e.g.:
- ;; :type '(radio (const :tag "none" nil)
- ;; (const "home")
- ;; (const "work"))
- :type (append
- '(radio)
- (cons '(const :tag "none" nil)
- (mapcar (function (lambda (arg) `(const ,arg)))
- (mapcar 'car mh-identity-list))))
- :group 'mh-identity)
-
-;;; Hooks (:group 'mh-hooks + group where hook defined)
-
-;;; These are alphabetized. All hooks should be placed in the 'mh-hook group;
-;;; in addition, add the group in which the hook is defined in the manual (or,
-;;; if it is new, where it would be defined).
-
-(defcustom mh-before-quit-hook nil
- "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E.
-See also `mh-quit-hook'."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-before-send-letter-hook nil
- "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-letter)
-
-(defcustom mh-delete-msg-hook nil
- "Invoked after marking each message for deletion."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-edit-mhn-hook nil
- "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-letter)
-
-(defcustom mh-find-path-hook nil
- "Invoked by `mh-find-path' after reading the user's MH profile."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-folder-list-change-hook nil
- "Invoked whenever the cached folder list `mh-folder-list' is changed."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-folder-mode-hook nil
- "Invoked in `mh-folder-mode' on a new folder."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-folder-updated-hook nil
- "Invoked when the folder actions (such as moves and deletes) are performed.
-Variables that are useful in this hook include `mh-delete-list' and
-`mh-refile-list' which can be used to see which changes are being made to
-current folder, `mh-current-folder'."
- :type 'hook
- :group 'mh-hooks)
-
-(defcustom mh-inc-folder-hook nil
- "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-index-show-hook nil
- "Invoked after the message has been displayed."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-index)
-
-(defcustom mh-letter-insert-signature-hook nil
- "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
-Can be used to determine which signature file to use based on message content.
-On return, if `mh-signature-file-name' is non-nil that file will be inserted at
-the current point in the buffer."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-letter)
-
-(defcustom mh-letter-mode-hook nil
- "Invoked in `mh-letter-mode' on a new letter."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-letter)
-
-(defcustom mh-pick-mode-hook nil
- "Invoked upon entry to `mh-pick-mode'."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-quit-hook nil
- "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E.
-See also `mh-before-quit-hook'."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-refile-msg-hook nil
- "Invoked after marking each message for refiling."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-(defcustom mh-show-hook nil
- "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-show)
-
-(defcustom mh-show-mode-hook nil
- "Invoked upon entry to `mh-show-mode'."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-show)
-
-(defcustom mh-unseen-updated-hook nil
- "Invoked after the unseen sequence has been updated.
-The variable `mh-seen-list' can be used to obtain the list of messages which
-will be removed from the unseen sequence."
- :type 'hook
- :group 'mh-hooks
- :group 'mh-folder)
-
-\f
-
-;;; Faces
-
-;;; Faces used in speedbar (:group mh-speed-faces)
-
-(defface mh-speedbar-folder-face
- '((((class color) (background light))
- (:foreground "blue4"))
- (((class color) (background dark))
- (:foreground "light blue")))
- "Face used for folders in the speedbar buffer."
- :group 'mh-speed-faces)
-
-(defface mh-speedbar-selected-folder-face
- '((((class color) (background light))
- (:foreground "red" :underline t))
- (((class color) (background dark))
- (:foreground "red" :underline t))
- (t (:underline t)))
- "Face used for the current folder."
- :group 'mh-speed-faces)
-
-(defface mh-speedbar-folder-with-unseen-messages-face
- '((t (:inherit mh-speedbar-folder-face :bold t)))
- "Face used for folders in the speedbar buffer which have unread messages."
- :group 'mh-speed-faces)
-
-(defface mh-speedbar-selected-folder-with-unseen-messages-face
- '((t (:inherit mh-speedbar-selected-folder-face :bold t)))
- "Face used for the current folder when it has unread messages."
- :group 'mh-speed-faces)
-
-;;; Faces used in scan listing (:group mh-folder-faces)
-
-(defvar mh-folder-body-face 'mh-folder-body-face
- "Face for highlighting body text in MH-Folder buffers.")
-(defface mh-folder-body-face
- '((((type tty) (class color)) (:foreground "green"))
- (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
- (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
- (((class color) (background light)) (:foreground "RosyBrown"))
- (((class color) (background dark)) (:foreground "LightSalmon"))
- (t (:italic t)))
- "Face for highlighting body text in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face
- "Face for the current message line in MH-Folder buffers.")
-(defface mh-folder-cur-msg-face
- '((((type tty pc) (class color))
- (:background "LightGreen"))
- (((class color) (background light))
- (:background "LightGreen") ;Use this for solid background colour
- ;; (:underline t) ;Use this for underlining
- )
- (((class color) (background dark))
- (:background "DarkOliveGreen4"))
- (t (:underline t)))
- "Face for the current message line in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face
- "Face for highlighting the current message in MH-Folder buffers.")
-(defface mh-folder-cur-msg-number-face
- '((((type tty) (class color)) (:foreground "cyan" :weight bold))
- (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
- (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
- (((class color) (background light)) (:foreground "Purple"))
- (((class color) (background dark)) (:foreground "Cyan"))
- (t (:bold t)))
- "Face for highlighting the current message in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-date-face 'mh-folder-date-face
- "Face for highlighting the date in MH-Folder buffers.")
-(defface mh-folder-date-face
- '((((class color) (background light))
- (:foreground "snow4"))
- (((class color) (background dark))
- (:foreground "snow3"))
- (t
- (:bold t)))
- "Face for highlighting the date in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-followup-face 'mh-folder-followup-face
- "Face for highlighting Re: (followup) subject text in MH-Folder buffers.")
-(defface mh-folder-followup-face
- '((((class color) (background light))
- (:foreground "blue3"))
- (((class color) (background dark))
- (:foreground "LightGoldenRod"))
- (t
- (:bold t)))
- "Face for highlighting Re: (followup) subject text in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-msg-number-face 'mh-folder-msg-number-face
- "Face for highlighting the message number in MH-Folder buffers.")
-(defface mh-folder-msg-number-face
- '((((class color) (background light))
- (:foreground "snow4"))
- (((class color) (background dark))
- (:foreground "snow3"))
- (t
- (:bold t)))
- "Face for highlighting the message number in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-deleted-face 'mh-folder-deleted-face
- "Face for highlighting deleted messages in MH-Folder buffers.")
-(copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face)
-
-(defvar mh-folder-refiled-face 'mh-folder-refiled-face
- "Face for highlighting refiled messages in MH-Folder buffers.")
-(defface mh-folder-refiled-face
- '((((type tty) (class color)) (:foreground "yellow" :weight light))
- (((class grayscale) (background light))
- (:foreground "Gray90" :bold t :italic t))
- (((class grayscale) (background dark))
- (:foreground "DimGray" :bold t :italic t))
- (((class color) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (background dark)) (:foreground "LightGoldenrod"))
- (t (:bold t :italic t)))
- "Face for highlighting refiled messages in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-subject-face 'mh-folder-subject-face
- "Face for highlighting subject text in MH-Folder buffers.")
-(if (boundp 'facemenu-unlisted-faces)
- (add-to-list 'facemenu-unlisted-faces "^mh-folder"))
-(defface mh-folder-subject-face
- '((((class color) (background light))
- (:foreground "blue4"))
- (((class color) (background dark))
- (:foreground "yellow"))
- (t
- (:bold t)))
- "Face for highlighting subject text in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-(defvar mh-folder-address-face 'mh-folder-address-face
- "Face for highlighting the address in MH-Folder buffers.")
-(copy-face 'mh-folder-subject-face 'mh-folder-address-face)
-
-(defvar mh-folder-scan-format-face 'mh-folder-scan-format-face
- "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.")
-(copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face)
-
-(defvar mh-folder-to-face 'mh-folder-to-face
- "Face for highlighting the To: string in MH-Folder buffers.")
-(defface mh-folder-to-face
- '((((type tty) (class color)) (:foreground "green"))
- (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
- (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
- (((class color) (background light)) (:foreground "RosyBrown"))
- (((class color) (background dark)) (:foreground "LightSalmon"))
- (t (:italic t)))
- "Face for highlighting the To: string in MH-Folder buffers."
- :group 'mh-folder-faces)
-
-;;; Faces used in message display (:group mh-show-faces)
-
-(defvar mh-show-cc-face 'mh-show-cc-face
- "Face for highlighting cc header fields.")
-(defface mh-show-cc-face
- '((((type tty) (class color)) (:foreground "yellow" :weight light))
- (((class grayscale) (background light))
- (:foreground "Gray90" :bold t :italic t))
- (((class grayscale) (background dark))
- (:foreground "DimGray" :bold t :italic t))
- (((class color) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (background dark)) (:foreground "LightGoldenrod"))
- (t (:bold t :italic t)))
- "Face for highlighting cc header fields."
- :group 'mh-show-faces)
-
-(defvar mh-show-date-face 'mh-show-date-face
- "Face for highlighting the Date header field.")
-(defface mh-show-date-face
- '((((type tty) (class color)) (:foreground "green"))
- (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
- (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
- (((class color) (background light)) (:foreground "ForestGreen"))
- (((class color) (background dark)) (:foreground "PaleGreen"))
- (t (:bold t :underline t)))
- "Face for highlighting the Date header field."
- :group 'mh-show-faces)
-
-(defvar mh-show-header-face 'mh-show-header-face
- "Face used to deemphasize unspecified header fields.")
-(defface mh-show-header-face
- '((((type tty) (class color)) (:foreground "green"))
- (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
- (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
- (((class color) (background light)) (:foreground "RosyBrown"))
- (((class color) (background dark)) (:foreground "LightSalmon"))
- (t (:italic t)))
- "Face used to deemphasize unspecified header fields."
- :group 'mh-show-faces)
-
-(defvar mh-show-to-face 'mh-show-to-face
- "Face for highlighting the To: header field.")
-(if (boundp 'facemenu-unlisted-faces)
- (add-to-list 'facemenu-unlisted-faces "^mh-show"))
-(defface mh-show-to-face
- '((((class grayscale) (background light))
- (:foreground "DimGray" :underline t))
- (((class grayscale) (background dark))
- (:foreground "LightGray" :underline t))
- (((class color) (background light)) (:foreground "SaddleBrown"))
- (((class color) (background dark)) (:foreground "burlywood"))
- (t (:underline t)))
- "Face for highlighting the To: header field."
- :group 'mh-show-faces)
-
-(defvar mh-show-from-face 'mh-show-from-face
- "Face for highlighting the From: header field.")
-(defface mh-show-from-face
- '((((class color) (background light))
- (:foreground "red3"))
- (((class color) (background dark))
- (:foreground "cyan"))
- (t
- (:bold t)))
- "Face for highlighting the From: header field."
- :group 'mh-show-faces)
-
-(defvar mh-show-subject-face 'mh-show-subject-face
- "Face for highlighting the Subject header field.")
-(copy-face 'mh-folder-subject-face 'mh-show-subject-face)
-
-;;; Faces used in indexed searches (:group mh-index-faces)
-
-(defvar mh-index-folder-face 'mh-index-folder-face
- "Face for highlighting folders in MH-Index buffers.")
-(defface mh-index-folder-face
- '((((class color) (background light))
- (:foreground "dark green" :bold t))
- (((class color) (background dark))
- (:foreground "indian red" :bold t))
- (t
- (:bold t)))
- "Face for highlighting folders in MH-Index buffers."
- :group 'mh-index-faces)
-
-(provide 'mh-customize)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-customize.el ends here
+++ /dev/null
-;;; mh-e.el --- GNU Emacs interface to the MH mail system
-
-;; Copyright (C) 1985,86,87,88,90,92,93,94,95,97,2000,2001,2002 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Version: 7.1
-;; Keywords: mail
-
-;; 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:
-
-;; How to Use:
-;; M-x mh-rmail to read mail. Type C-h m there for a list of commands.
-;; C-u M-x mh-rmail to visit any folder.
-;; M-x mh-smail to send mail. From within the mail reader, "m" works, too.
-
-;; Your .emacs might benefit from these bindings:
-;; (global-set-key "\C-cr" 'mh-rmail)
-;; (global-set-key "\C-xm" 'mh-smail)
-;; (global-set-key "\C-x4m" 'mh-smail-other-window)
-
-;; MH (Message Handler) is a powerful mail reader.
-
-;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu
-;; (send to mh-users-request to be added). See the monthly Frequently Asked
-;; Questions posting there for information on getting MH and MH-E:
-;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html
-
-;; N.B. MH must have been compiled with the MHE compiler flag or several
-;; features necessary for MH-E will be missing from MH commands, specifically
-;; the -build switch to repl and forw.
-
-;; MH-E is an Emacs interface to the MH mail system.
-
-;; MH-E is supported in GNU Emacs 20 and 21, with MH 6.8.4 and nmh 1.0.4.
-
-;; Mailing Lists:
-;; mh-e-users@lists.sourceforge.net
-;; mh-e-announce@lists.sourceforge.net
-;; mh-e-devel@lists.sourceforge.net
-;;
-;; Subscribe by sending a "subscribe" message to
-;; <list>-request@lists.sourceforge.net, or by using the web interface at
-;; https://sourceforge.net/mail/?group_id=13357
-
-;; Bug Reports:
-;; https://sourceforge.net/tracker/?group_id=13357&atid=113357
-;; Include the output of M-x mh-version in any bug report.
-
-;; Feature Requests:
-;; https://sourceforge.net/tracker/?atid=363357&group_id=13357&func=browse
-
-;; Support:
-;; https://sourceforge.net/tracker/?group_id=13357&atid=213357
-
-;;; Change Log:
-
-;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
-;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
-;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu
-;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
-;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
-;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
-
-;; $Id: mh-e.el,v 1.240 2003/01/08 00:46:25 wohler Exp $
-
-;;; Code:
-
-(require 'cl)
-
-(defvar recursive-load-depth-limit)
-(eval-when (compile load eval)
- (if (and (boundp 'recursive-load-depth-limit)
- (integerp recursive-load-depth-limit)
- (> 50 recursive-load-depth-limit))
- (setq recursive-load-depth-limit 50)))
-
-(require 'mh-utils)
-(require 'gnus-util)
-(require 'easymenu)
-(if mh-xemacs-flag
- (require 'mh-xemacs-compat))
-
-;; Shush the byte-compiler
-(defvar font-lock-auto-fontify)
-(defvar font-lock-defaults)
-
-(defconst mh-version "7.1" "Version number of MH-E.")
-
-;;; Autoloads
-(autoload 'Info-goto-node "info")
-
-\f
-
-(defvar mh-note-deleted "D"
- "String whose first character is used to notate deleted messages.")
-
-(defvar mh-note-refiled "^"
- "String whose first character is used to notate refiled messages.")
-
-(defvar mh-note-cur "+"
- "String whose first character is used to notate the current message.")
-
-(defvar mh-partial-folder-mode-line-annotation "select"
- "Annotation when displaying part of a folder.
-The string is displayed after the folder's name. nil for no annotation.")
-
-;;; Parameterize MH-E to work with different scan formats. The defaults work
-;;; with the standard MH scan listings, in which the first 4 characters on
-;;; the line are the message number, followed by two places for notations.
-
-;; The following scan formats are passed to the scan program if the
-;; setting of `mh-scan-format-file' above is nil. They are identical
-;; except the later one makes use of the nmh `decode' function to
-;; decode RFC 2047 encodings. If you just want to change the width of
-;; the msg number, use the `mh-set-cmd-note' function.
-
-(defvar mh-scan-format-mh
- (concat
- "%4(msg)"
- "%<(cur)+%| %>"
- "%<{replied}-"
- "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
- "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
- "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
- "%?(nonnull(comp{newsgroups}))n%>"
- "%<(zero) %>"
- "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
- "%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>"
- "%<(zero)%17(friendly{from})%> "
- "%{subject}%<{body}<<%{body}%>")
- "*Scan format string for MH, provided to the scan program via the -format arg.
-This format is identical to the default except that additional hints for
-fontification have been added to the fifth column (remember that in Emacs, the
-first column is 0).
-
-The values of the fifth column, in priority order, are: `-' if the
-message has been replied to, t if an address on the To: line matches
-one of the mailboxes of the current user, `c' if the Cc: line matches,
-`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
-is present.")
-
-(defvar mh-scan-format-nmh
- (concat
- "%4(msg)"
- "%<(cur)+%| %>"
- "%<{replied}-"
- "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
- "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
- "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
- "%?(nonnull(comp{newsgroups}))n%>"
- "%<(zero) %>"
- "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
- "%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>"
- "%<(zero)%17(decode(friendly{from}))%> "
- "%(decode{subject})%<{body}<<%{body}%>")
- "*Scan format string for nmh.
-This string is passed to the scan program via the -format arg.
-This format is identical to the default except that additional hints for
-fontification have been added to the fifth column (remember that in Emacs, the
-first column is 0).
-
-The values of the fifth column, in priority order, are: `-' if the
-message has been replied to, t if an address on the To: line matches
-one of the mailboxes of the current user, `c' if the Cc: line matches,
-`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
-is present.")
-
-(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
- "Regexp specifying the scan lines that are 'good' messages.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.")
-
-(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
- "Regexp matching scan lines of deleted messages.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.")
-
-(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
- "Regexp matching scan lines of refiled messages.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.")
-
-(defvar mh-scan-valid-regexp "^ *[0-9]"
- "Regexp matching scan lines for messages (not error messages).")
-
-(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
- "Regexp matching scan line for the current message.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.
-Don't disable this regexp as it's needed by non fontifying functions.")
-
-(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
- "Regexp matching scan line for the current message.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the whole line.
-To enable this feature, remove the string DISABLED from the regexp.")
-
-(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
- "Regexp matching a valid date in scan lines.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-only one parenthesized expression which matches the date field
-\(see `mh-scan-format-regexp').")
-
-(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
- "Regexp specifying the recipient in scan lines for messages we sent.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-two parenthesized expressions. The first is expected to match the To:
-that the default scan format file generates. The second is expected to match
-the recipient's name.")
-
-(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
- "Regexp matching the message body beginning displayed in scan lines.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the body text.")
-
-(defvar mh-scan-subject-regexp
- ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
- "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
- "*Regexp matching the subject string in MH folder mode.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least tree parenthesized expressions. The first is expected to match the Re:
-string, if any. The second matches an optional bracketed number after Re,
-such as in Re[2]: and the third is expected to match the subject line itself.")
-
-(defvar mh-scan-format-regexp
- (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
- "Regexp matching the output of scan.
-The default value is based upon the default values of either
-`mh-scan-format-mh' or `mh-scan-format-nmh'.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least three parenthesized expressions. The first should match the
-fontification hint, the second is found in `mh-scan-date-regexp', and the
-third should match the user name.")
-
-\f
-
-(defvar mh-folder-font-lock-keywords
- (list
- ;; Folders when displaying index buffer
- (list "^\\+.*"
- '(0 mh-index-folder-face))
- ;; Marked for deletion
- (list (concat mh-scan-deleted-msg-regexp ".*")
- '(0 mh-folder-deleted-face))
- ;; Marked for refile
- (list (concat mh-scan-refiled-msg-regexp ".*")
- '(0 mh-folder-refiled-face))
- ;;after subj
- (list mh-scan-body-regexp '(1 mh-folder-body-face nil t))
- '(mh-folder-font-lock-subject
- (1 mh-folder-followup-face append t)
- (2 mh-folder-subject-face append t))
- ;;current msg
- (list mh-scan-cur-msg-number-regexp
- '(1 mh-folder-cur-msg-number-face))
- (list mh-scan-good-msg-regexp
- '(1 mh-folder-msg-number-face)) ;; Msg number
- (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date
- (list mh-scan-rcpt-regexp
- '(1 mh-folder-to-face) ;; To:
- '(2 mh-folder-address-face)) ;; address
- ;; scan font-lock name
- (list mh-scan-format-regexp
- '(1 mh-folder-date-face)
- '(3 mh-folder-scan-format-face))
- ;; Current message line
- (list mh-scan-cur-msg-regexp
- '(1 mh-folder-cur-msg-face prepend t))
- ;; Unseen messages in bold
- '(mh-folder-font-lock-unseen (1 'bold append t)))
- "Regexp keywords used to fontify the MH-Folder buffer.")
-
-(defvar mh-scan-cmd-note-width 1
- "Number of columns consumed by the cmd-note field in `mh-scan-format'.
-This column will have one of the values: ` ', `D', `^', `+' and where
-` ' is the default value,
-`D' is the `mh-note-deleted' character,
-`^' is the `mh-note-refiled' character, and
-`+' is the `mh-note-cur' character.")
-
-(defvar mh-scan-destination-width 1
- "Number of columns consumed by the destination field in `mh-scan-format'.
-This column will have one of ' ', '%', '-', 't', 'c', 'b', or `n' in it.
-A ' ' blank space is the default character.
-A '%' indicates that the message in in a named MH sequence.
-A '-' indicates that the message has been annotated with a replied field.
-A 't' indicates that the message contains mymbox in the To: field.
-A 'c' indicates that the message contains mymbox in the Cc: field.
-A 'b' indicates that the message contains mymbox in the Bcc: field.
-A 'n' indicates that the message contains a Newsgroups: field.")
-
-(defvar mh-scan-date-width 5
- "Number of columns consumed by the date field in `mh-scan-format'.
-This column will typically be of the form mm/dd.")
-
-(defvar mh-scan-date-flag-width 1
- "Number of columns consumed to flag (in)valid dates in `mh-scan-format'.
-This column will have ` ' for valid and `*' for invalid or missing dates.")
-
-(defvar mh-scan-from-mbox-width 17
- "Number of columns consumed with the \"From:\" line in `mh-scan-format'.
-This column will have a friendly name or e-mail address of the
-originator, or a \"To: address\" for outgoing e-mail messages.")
-
-(defvar mh-scan-from-mbox-sep-width 2
- "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'.
-This column will only ever have spaces in it.")
-
-(defvar mh-scan-field-from-start-offset
- (+ mh-scan-cmd-note-width
- mh-scan-destination-width
- mh-scan-date-width
- mh-scan-date-flag-width)
- "The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
-
-(defvar mh-scan-field-from-end-offset
- (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
- "The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
-
-(defvar mh-scan-field-subject-start-offset
- (+ mh-scan-cmd-note-width
- mh-scan-destination-width
- mh-scan-date-width
- mh-scan-date-flag-width
- mh-scan-from-mbox-width
- mh-scan-from-mbox-sep-width)
- "The offset from the `mh-cmd-note' to find the start of the subject.")
-
-(defun mh-folder-font-lock-subject (limit)
- "Return MH-E scan subject strings to font-lock between point and LIMIT."
- (if (not (re-search-forward mh-scan-subject-regexp limit t))
- nil
- (if (match-beginning 1)
- (set-match-data (list (match-beginning 1) (match-end 3)
- (match-beginning 1) (match-end 3) nil nil))
- (set-match-data (list (match-beginning 3) (match-end 3)
- nil nil (match-beginning 3) (match-end 3))))
- t))
-
-\f
-
-;; Fontifify unseen mesages in bold.
-
-(defvar mh-folder-unseen-seq-name nil
- "Name of unseen sequence.
-The default for this is provided by the function `mh-folder-unseen-seq-name'
-On nmh systems.")
-
-(defun mh-folder-unseen-seq-name ()
- "Provide name of unseen sequence from mhparam."
- (or mh-progs (mh-find-path))
- (save-excursion
- (let ((unseen-seq-name "unseen"))
- (with-temp-buffer
- (unwind-protect
- (progn
- (call-process (expand-file-name "mhparam" mh-progs)
- nil '(t t) nil "-component" "Unseen-Sequence")
- (goto-char (point-min))
- (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
- (setq unseen-seq-name (match-string 1))))))
- unseen-seq-name)))
-
-(defun mh-folder-unseen-seq-list ()
- "Return a list of unseen message numbers for current folder."
- (if (not mh-folder-unseen-seq-name)
- (setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
- (cond
- ((not mh-folder-unseen-seq-name)
- nil)
- (t
- (let ((folder mh-current-folder))
- (save-excursion
- (with-temp-buffer
- (unwind-protect
- (progn
- (call-process (expand-file-name "mark" mh-progs)
- nil '(t t) nil
- folder "-seq" mh-folder-unseen-seq-name
- "-list")
- (goto-char (point-min))
- (sort (mh-read-msg-list) '<)))))))))
-
-(defvar mh-folder-unseen-seq-cache nil
- "Internal cache variable used for font-lock in MH-E.
-Should only be non-nil through font-lock stepping, and nil once font-lock
-is done highlighting.")
-(make-variable-buffer-local 'mh-folder-unseen-seq-cache)
-
-(defun mh-folder-font-lock-unseen (limit)
- "Return unseen message lines to font-lock between point and LIMIT."
- (if (not mh-folder-unseen-seq-cache)
- (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))
- (let ((cur-msg (mh-get-msg-num nil)))
- (cond
- ((not mh-folder-unseen-seq-cache)
- nil)
- ((not cur-msg) ;Presumably at end of buffer
- (setq mh-folder-unseen-seq-cache nil)
- nil)
- ((member cur-msg mh-folder-unseen-seq-cache)
- (let ((bpoint (progn (beginning-of-line)(point)))
- (epoint (progn (forward-line 1)(point))))
- (if (<= limit (point))
- (setq mh-folder-unseen-seq-cache nil))
- (set-match-data (list bpoint epoint bpoint epoint))
- t))
- (t
- ;; move forward one line at a time, checking each message number.
- (while (and
- (= 0 (forward-line 1))
- (> limit (point))
- (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))
- ;; Examine how we must have exited the loop...
- (let ((cur-msg (mh-get-msg-num nil)))
- (cond
- ((or (not cur-msg)
- (<= limit (point))
- (not (member cur-msg mh-folder-unseen-seq-cache)))
- (setq mh-folder-unseen-seq-cache nil)
- nil)
- ((member cur-msg mh-folder-unseen-seq-cache)
- (let ((bpoint (progn (beginning-of-line)(point)))
- (epoint (progn (forward-line 1)(point))))
- (if (<= limit (point))
- (setq mh-folder-unseen-seq-cache nil))
- (set-match-data (list bpoint epoint bpoint epoint))
- t))))))))
-
-\f
-
-;;; Internal variables:
-
-(defvar mh-last-destination nil) ;Destination of last refile or write
- ;command.
-(defvar mh-last-destination-folder nil) ;Destination of last refile command.
-(defvar mh-last-destination-write nil) ;Destination of last write command.
-
-(defvar mh-folder-mode-map (make-keymap)
- "Keymap for MH folders.")
-
-(defvar mh-delete-list nil) ;List of msg numbers to delete.
-
-(defvar mh-refile-list nil) ;List of folder names in mh-seq-list.
-
-(defvar mh-next-direction 'forward) ;Direction to move to next message.
-
-(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
- ;nil if not narrowed.
-
-(defvar mh-view-ops ()) ;Stack of ops that change the folder
- ;view (such as narrowing or threading).
-
-(defvar mh-index-data nil) ;Info about index search results
-(defvar mh-index-previous-search nil)
-(defvar mh-index-msg-checksum-map nil)
-(defvar mh-index-checksum-origin-map nil)
-
-(defvar mh-first-msg-num nil) ;Number of first msg in buffer.
-
-(defvar mh-last-msg-num nil) ;Number of last msg in buffer.
-
-(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
-
-;;; Macros and generic functions:
-
-(defun mh-mapc (function list)
- "Apply FUNCTION to each element of LIST for side effects only."
- (while list
- (funcall function (car list))
- (setq list (cdr list))))
-
-(defun mh-scan-format ()
- "Return \"-format\" argument for the scan program."
- (if (equal mh-scan-format-file t)
- (list "-format" (if mh-nmh-flag
- (list (mh-update-scan-format
- mh-scan-format-nmh mh-cmd-note))
- (list (mh-update-scan-format
- mh-scan-format-mh mh-cmd-note))))
- (if (not (equal mh-scan-format-file nil))
- (list "-format" mh-scan-format-file))))
-
-\f
-
-;;; Entry points:
-
-;;;###autoload
-(defun mh-rmail (&optional arg)
- "Inc(orporate) new mail with MH.
-Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
-the Emacs front end to the MH mail system."
- (interactive "P")
- (mh-find-path)
- (if arg
- (call-interactively 'mh-visit-folder)
- (mh-inc-folder)))
-
-;;;###autoload
-(defun mh-nmail (&optional arg)
- "Check for new mail in inbox folder.
-Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
-the Emacs front end to the MH mail system."
- (interactive "P")
- (mh-find-path) ; init mh-inbox
- (if arg
- (call-interactively 'mh-visit-folder)
- (mh-visit-folder mh-inbox)))
-
-\f
-
-;;; User executable MH-E commands:
-
-(defun mh-delete-msg (msg-or-seq)
- "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
-
-Default is the displayed message. If optional prefix argument is given then
-prompt for the message sequence. If variable `transient-mark-mode' is non-nil
-and the mark is active, then the selected region is marked for deletion."
- (interactive (list (cond
- ((mh-mark-active-p t)
- (mh-region-to-msg-list (region-beginning) (region-end)))
- (current-prefix-arg
- (mh-read-seq-default "Delete" t))
- (t
- (mh-get-msg-num t)))))
- (mh-delete-msg-no-motion msg-or-seq)
- (mh-next-msg))
-
-(defun mh-delete-msg-no-motion (msg-or-seq)
- "Mark the specified MSG-OR-SEQ for subsequent deletion.
-Default is the displayed message. If optional prefix argument is provided,
-then prompt for the message sequence."
- (interactive (list (if current-prefix-arg
- (mh-read-seq-default "Delete" t)
- (mh-get-msg-num t))))
- (if (numberp msg-or-seq)
- (mh-delete-a-msg msg-or-seq)
- (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
-
-(defun mh-execute-commands ()
- "Process outstanding delete and refile requests."
- (interactive)
- (if mh-narrowed-to-seq (mh-widen))
- (mh-process-commands mh-current-folder)
- (mh-set-scan-mode)
- (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
- (mh-make-folder-mode-line)
- t) ; return t for write-file-functions
-
-(defun mh-first-msg ()
- "Move to the first message."
- (interactive)
- (goto-char (point-min))
- (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp)))
- (forward-line 1)))
-
-(defun mh-header-display ()
- "Show the current message with all its headers.
-Displays headers that might have been suppressed by setting the
-variables `mh-clean-message-header-flag' or `mhl-formfile', or by the fallback
-behavior of scrolling uninteresting headers off the top of the window.
-Type \"\\[mh-show]\" to show the message normally again."
- (interactive)
- (and (not mh-showing-with-headers)
- (or mhl-formfile mh-clean-message-header-flag)
- (mh-invalidate-show-buffer))
- (let ((mh-decode-mime-flag nil)
- (mhl-formfile nil)
- (mh-clean-message-header-flag nil))
- (mh-show-msg nil)
- (mh-in-show-buffer (mh-show-buffer)
- (goto-char (point-min))
- (mh-recenter 0))
- (setq mh-showing-with-headers t)))
-
-(defun mh-inc-folder (&optional maildrop-name)
- "Inc(orporate)s new mail into the Inbox folder.
-Optional argument MAILDROP-NAME specifies an alternate maildrop from the
-default. If the prefix argument is given, incorporates mail into the current
-folder, otherwise uses the folder named by `mh-inbox'.
-The value of `mh-inc-folder-hook' is a list of functions to be called, with no
-arguments, after incorporating new mail.
-Do not call this function from outside MH-E; use \\[mh-rmail] instead."
- (interactive (list (if current-prefix-arg
- (expand-file-name
- (read-file-name "inc mail from file: "
- mh-user-path)))))
- (let ((threading-needed-flag nil))
- (let ((config (current-window-configuration)))
- (if (not maildrop-name)
- (cond ((not (get-buffer mh-inbox))
- (mh-make-folder mh-inbox)
- (setq threading-needed-flag mh-show-threads-flag)
- (setq mh-previous-window-config config))
- ((not (eq (current-buffer) (get-buffer mh-inbox)))
- (switch-to-buffer mh-inbox)
- (setq mh-previous-window-config config)))))
- (mh-get-new-mail maildrop-name)
- (when (and threading-needed-flag
- (save-excursion
- (goto-char (point-min))
- (or (null mh-large-folder)
- (not (equal (forward-line mh-large-folder) 0))
- (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
- nil))))
- (mh-toggle-threads))
- (if mh-showing-mode (mh-show))
- (run-hooks 'mh-inc-folder-hook)))
-
-(defun mh-last-msg ()
- "Move to the last message."
- (interactive)
- (goto-char (point-max))
- (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
- (forward-line -1))
- (mh-recenter nil))
-
-(defun mh-next-undeleted-msg (&optional arg)
- "Move to the next undeleted message ARG in window."
- (interactive "p")
- (setq mh-next-direction 'forward)
- (forward-line 1)
- (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg)
- (beginning-of-line)
- (mh-maybe-show))
- (t (forward-line -1)
- (message "No more undeleted messages"))))
-
-(defun mh-refile-msg (msg-or-seq folder)
- "Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
-If optional prefix argument provided, then prompt for message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is marked for refiling."
- (interactive
- (list (cond
- ((mh-mark-active-p t)
- (mh-region-to-msg-list (region-beginning) (region-end)))
- (current-prefix-arg
- (mh-read-seq-default "Refile" t))
- (t
- (mh-get-msg-num t)))
- (intern
- (mh-prompt-for-folder
- "Destination"
- (or (and mh-default-folder-for-message-function
- (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- (insert-file-contents refile-file)
- (let ((buffer-file-name refile-file))
- (funcall mh-default-folder-for-message-function)))))
- (and (eq 'refile (car mh-last-destination-folder))
- (symbol-name (cdr mh-last-destination-folder)))
- "")
- t))))
- (setq mh-last-destination (cons 'refile folder)
- mh-last-destination-folder mh-last-destination)
- (if (numberp msg-or-seq)
- (mh-refile-a-msg msg-or-seq folder)
- (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
- (mh-next-msg))
-
-(defun mh-refile-or-write-again (message)
- "Re-execute the last refile or write command on the given MESSAGE.
-Default is the displayed message. Use the same folder or file as the previous
-refile or write command."
- (interactive (list (mh-get-msg-num t)))
- (if (null mh-last-destination)
- (error "No previous refile or write"))
- (cond ((eq (car mh-last-destination) 'refile)
- (mh-refile-a-msg message (cdr mh-last-destination))
- (message "Destination folder: %s" (cdr mh-last-destination)))
- (t
- (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
- (message "Destination: %s" (cdr mh-last-destination))))
- (mh-next-msg))
-
-(defun mh-quit ()
- "Quit the current MH-E folder.
-Restore the previous window configuration, if one exists.
-The value of `mh-before-quit-hook' is a list of functions to be called, with
-no arguments, immediately upon entry to this function.
-The value of `mh-quit-hook' is a list of functions to be called, with no
-arguments, upon exit of this function."
- (interactive)
- (run-hooks 'mh-before-quit-hook)
- (let ((show-buffer (get-buffer mh-show-buffer)))
- (when show-buffer
- (kill-buffer show-buffer)))
- (mh-update-sequences)
- (mh-destroy-postponed-handles)
- (bury-buffer (current-buffer))
- (if (get-buffer mh-temp-buffer)
- (kill-buffer mh-temp-buffer))
- (if (get-buffer mh-temp-folders-buffer)
- (kill-buffer mh-temp-folders-buffer))
- (if (get-buffer mh-temp-sequences-buffer)
- (kill-buffer mh-temp-sequences-buffer))
- (if mh-previous-window-config
- (set-window-configuration mh-previous-window-config))
- (run-hooks 'mh-quit-hook))
-
-(defun mh-page-msg (&optional arg)
- "Page the displayed message forwards.
-Scrolls ARG lines or a full screen if no argument is supplied. Show buffer
-first if not displayed. Show the next undeleted message if looking at the
-bottom of the current message."
- (interactive "P")
- (if mh-showing-mode
- (if mh-page-to-next-msg-flag
- (if (equal mh-next-direction 'backward)
- (mh-previous-undeleted-msg)
- (mh-next-undeleted-msg))
- (if (mh-in-show-buffer (mh-show-buffer)
- (pos-visible-in-window-p (point-max)))
- (progn
- (message (format
- "End of message (Type %s to read %s undeleted message)"
- (single-key-description last-input-event)
- (if (equal mh-next-direction 'backward)
- "previous"
- "next")))
- (setq mh-page-to-next-msg-flag t))
- (scroll-other-window arg)))
- (mh-show)))
-
-(defun mh-previous-page (&optional arg)
- "Page the displayed message backwards.
-Scrolls ARG lines or a full screen if no argument is supplied."
- (interactive "P")
- (mh-in-show-buffer (mh-show-buffer)
- (scroll-down arg)))
-
-(defun mh-previous-undeleted-msg (&optional arg)
- "Move to the previous undeleted message ARG in window."
- (interactive "p")
- (setq mh-next-direction 'backward)
- (beginning-of-line)
- (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg)
- (mh-maybe-show))
- (t (message "No previous undeleted message"))))
-
-(defun mh-previous-unread-msg (&optional count)
- "Move to previous unread message.
-With optional argument COUNT, COUNT-1 unread messages before current message
-are skipped."
- (interactive "p")
- (unless (> count 0)
- (error "The function mh-previous-unread-msg expects positive argument"))
- (setq count (1- count))
- (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
- (cur-msg (mh-get-msg-num nil)))
- (cond ((and (not cur-msg) (not (bobp))
- ;; If we are at the end of the buffer back up one line and go
- ;; to unread message after that.
- (progn
- (forward-line -1)
- (setq cur-msg (mh-get-msg-num nil)))
- nil))
- ((or (null unread-sequence) (not cur-msg))
- ;; No unread message or there aren't any messages in buffer...
- (message "No more unread messages"))
- ((progn
- ;; Skip count messages...
- (while (and unread-sequence (>= (car unread-sequence) cur-msg))
- (setq unread-sequence (cdr unread-sequence)))
- (while (> count 0)
- (setq unread-sequence (cdr unread-sequence))
- (setq count (1- count)))
- (not (car unread-sequence)))
- (message "No more unread messages"))
- (t (mh-goto-msg (car unread-sequence))))))
-
-(defun mh-goto-next-button (backward-flag &optional criterion)
- "Search for next button satisfying criterion.
-If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If
-CRITERION is a function or a symbol which has a function binding then that
-function must return non-nil at the button we stop."
- (unless (or (and (symbolp criterion) (fboundp criterion))
- (functionp criterion))
- (setq criterion (lambda (x) t)))
- ;; Move to the next button in the buffer satisfying criterion
- (goto-char (or (save-excursion
- (beginning-of-line)
- ;; Find point before current button
- (let ((point-before-current-button
- (save-excursion
- (while (get-text-property (point) 'mh-data)
- (unless (= (forward-line
- (if backward-flag 1 -1))
- 0)
- (if backward-flag
- (goto-char (point-min))
- (goto-char (point-max)))))
- (point))))
- ;; Skip over current button
- (while (and (get-text-property (point) 'mh-data)
- (not (if backward-flag (bobp) (eobp))))
- (forward-line (if backward-flag -1 1)))
- ;; Stop at next MIME button if any exists.
- (block loop
- (while (/= (progn
- (unless (= (forward-line
- (if backward-flag -1 1))
- 0)
- (if backward-flag
- (goto-char (point-max))
- (goto-char (point-min)))
- (beginning-of-line))
- (point))
- point-before-current-button)
- (when (and (get-text-property (point) 'mh-data)
- (funcall criterion (point)))
- (return-from loop (point))))
- nil)))
- (point))))
-
-(defun mh-next-button (&optional backward-flag)
- "Go to the next MIME button.
-Advance point to the next MIME button in the show buffer. If the end
-of buffer is reached then the search wraps over to the start of the
-buffer. With prefix argument, BACKWARD-FLAG the point will move to the
-previous MIME button."
- (interactive (list current-prefix-arg))
- (unless mh-showing-mode
- (mh-show))
- (mh-in-show-buffer (mh-show-buffer)
- (mh-goto-next-button backward-flag)))
-
-(defun mh-prev-button ()
- "Go to the prev MIME button.
-Move point to the previous MIME button in the show buffer. If the beginning
-of the buffer is reached then the search wraps over to the end of the
-buffer."
- (interactive)
- (mh-next-button t))
-
-(defun mh-folder-mime-action (part-index action include-security-flag)
- "Go to PART-INDEX and carry out ACTION.
-If PART-INDEX is nil then go to the next part in the buffer. The search for
-the next buffer wraps around if end of buffer is reached. If argument
-INCLUDE-SECURITY-FLAG is non-nil then include security info buttons when
-searching for a suitable parts."
- (unless mh-showing-mode
- (mh-show))
- (mh-in-show-buffer (mh-show-buffer)
- (let ((criterion
- (cond (part-index
- (lambda (p)
- (let ((part (get-text-property p 'mh-part)))
- (and (integerp part) (= part part-index)))))
- (t (lambda (p)
- (if include-security-flag
- (get-text-property p 'mh-data)
- (integerp (get-text-property p 'mh-part)))))))
- (point (point)))
- (cond ((and (get-text-property point 'mh-part)
- (or (null part-index)
- (= (get-text-property point 'mh-part) part-index)))
- (funcall action))
- ((and (get-text-property point 'mh-data)
- include-security-flag
- (null part-index))
- (funcall action))
- (t
- (mh-goto-next-button nil criterion)
- (if (= (point) point)
- (message "No matching MIME part found")
- (funcall action)))))))
-
-(defun mh-folder-toggle-mime-part (part-index)
- "Toggle display of button.
-If point in show buffer is at a button then that part is toggled.
-If not at a button and PART-INDEX is non-nil point is moved to that part.
-With nil PART-INDEX find the first button after point (search wraps around if
-end of buffer is reached) and toggle it."
- (interactive "P")
- (when (consp part-index) (setq part-index (car part-index)))
- (mh-folder-mime-action part-index #'mh-press-button t))
-
-(defun mh-folder-inline-mime-part (part-index)
- "Show the raw bytes of MIME part inline.
-If point in show buffer is at a mime part then that part is inlined.
-If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
-With nil PART-INDEX find the first button after point (search wraps around if
-end of buffer is reached) and inline it."
- (interactive "P")
- (when (consp part-index) (setq part-index (car part-index)))
- (mh-folder-mime-action part-index #'mh-mime-inline-part nil))
-
-(defun mh-folder-save-mime-part (part-index)
- "Save MIME part.
-If point in show buffer is at a mime part then that part is saved.
-If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
-With nil PART-INDEX find the first button after point (search wraps around if
-end of buffer is reached) and save it."
- (interactive "P")
- (when (consp part-index) (setq part-index (car part-index)))
- (mh-folder-mime-action part-index #'mh-mime-save-part nil))
-
-(defun mh-reset-threads-and-narrowing ()
- "Reset all variables pertaining to threads and narrowing.
-Also removes all content from the folder buffer."
- (setq mh-view-ops ())
- (setq mh-narrowed-to-seq nil)
- (let ((buffer-read-only nil)) (erase-buffer)))
-
-(defun mh-rescan-folder (&optional range dont-exec-pending)
- "Rescan a folder after optionally processing the outstanding commands.
-If optional prefix argument RANGE is provided, prompt for the range of
-messages to display. Otherwise show the entire folder.
-If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
-refiles aren't carried out."
- (interactive (list (if current-prefix-arg
- (mh-read-msg-range mh-current-folder t)
- nil)))
- (setq mh-next-direction 'forward)
- (let ((threaded-flag (memq 'unthread mh-view-ops)))
- (mh-reset-threads-and-narrowing)
- (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
- (cond (threaded-flag (mh-toggle-threads))
- (mh-index-data (mh-index-insert-folder-headers)))))
-
-(defun mh-write-msg-to-file (msg file no-headers)
- "Append MSG to the end of a FILE.
-If prefix argument NO-HEADERS is provided, write only the message body.
-Otherwise send the entire message including the headers."
- (interactive
- (list (mh-get-msg-num t)
- (let ((default-dir (if (eq 'write (car mh-last-destination-write))
- (file-name-directory
- (car (cdr mh-last-destination-write)))
- default-directory)))
- (read-file-name (format "Save message%s in file: "
- (if current-prefix-arg " body" ""))
- default-dir
- (if (eq 'write (car mh-last-destination-write))
- (car (cdr mh-last-destination-write))
- (expand-file-name "mail.out" default-dir))))
- current-prefix-arg))
- (let ((msg-file-to-output (mh-msg-filename msg))
- (output-file (mh-expand-file-name file)))
- (setq mh-last-destination (list 'write file (if no-headers 'no-headers))
- mh-last-destination-write mh-last-destination)
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- (insert-file-contents msg-file-to-output)
- (goto-char (point-min))
- (if no-headers (search-forward "\n\n"))
- (append-to-file (point) (point-max) output-file))))
-
-(defun mh-toggle-showing ()
- "Toggle the scanning mode/showing mode of displaying messages."
- (interactive)
- (if mh-showing-mode
- (mh-set-scan-mode)
- (mh-show)))
-
-(defun mh-undo (msg-or-seq)
- "Undo the pending deletion or refile of the specified MSG-OR-SEQ.
-Default is the displayed message.
-If optional prefix argument is provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is unmarked."
- (interactive (list (cond
- ((mh-mark-active-p t)
- (mh-region-to-msg-list (region-beginning) (region-end)))
- (current-prefix-arg
- (mh-read-seq-default "Undo" t))
- (t
- (mh-get-msg-num t)))))
- (cond ((numberp msg-or-seq)
- (let ((original-position (point)))
- (beginning-of-line)
- (while (not (or (looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-refiled-msg-regexp)
- (and (eq mh-next-direction 'forward) (bobp))
- (and (eq mh-next-direction 'backward)
- (save-excursion (forward-line) (eobp)))))
- (forward-line (if (eq mh-next-direction 'forward) -1 1)))
- (if (or (looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-refiled-msg-regexp))
- (progn
- (mh-undo-msg (mh-get-msg-num t))
- (mh-maybe-show))
- (goto-char original-position)
- (error "Nothing to undo"))))
- (t
- (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
- (if (not (mh-outstanding-commands-p))
- (mh-set-folder-modified-p nil)))
-
-;;;###mh-autoload
-(defun mh-folder-line-matches-show-buffer-p ()
- "Return t if the message under point in folder-mode is in the show buffer.
-Return nil in any other circumstance (no message under point, no show buffer,
-the message in the show buffer doesn't match."
- (and (eq major-mode 'mh-folder-mode)
- (mh-get-msg-num nil)
- mh-show-buffer
- (get-buffer mh-show-buffer)
- (buffer-file-name (get-buffer mh-show-buffer))
- (string-match ".*/\\([0-9]+\\)$"
- (buffer-file-name (get-buffer mh-show-buffer)))
- (string-equal
- (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
- (int-to-string (mh-get-msg-num nil)))))
-
-(eval-when-compile (require 'gnus))
-
-(defmacro mh-macro-expansion-time-gnus-version ()
- "Return Gnus version available at macro expansion time.
-The macro evaluates the Gnus version at macro expansion time. If MH-E was
-compiled then macro expansion happens at compile time."
- gnus-version)
-
-(defun mh-run-time-gnus-version ()
- "Return Gnus version available at run time."
- (require 'gnus)
- gnus-version)
-
-;;;###autoload
-(defun mh-version ()
- "Display version information about MH-E and the MH mail handling system."
- (interactive)
- (mh-find-progs)
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- ;; MH-E version.
- (insert "MH-E " mh-version "\n\n")
- ;; MH-E compilation details.
- (insert "MH-E compilation details:\n")
- (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
- (gnus-compiled-version (if compiled-mhe
- (mh-macro-expansion-time-gnus-version)
- "N/A")))
- (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
- " Gnus (compile-time):\t" gnus-compiled-version "\n"
- " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
- ;; Emacs version.
- (insert (emacs-version) "\n\n")
- ;; MH version.
- (let ((help-start (point)))
- (condition-case err-data
- (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
- (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
- (goto-char help-start)
- (if mh-nmh-flag
- (search-forward "inc -- " nil t)
- (search-forward "version: " nil t))
- (delete-region help-start (point)))
- (goto-char (point-max))
- (insert " mh-progs:\t" mh-progs "\n"
- " mh-lib:\t" mh-lib "\n"
- " mh-lib-progs:\t" mh-lib-progs "\n\n")
- ;; Linux version.
- (condition-case ()
- (call-process "uname" nil t nil "-a")
- (file-error))
- (goto-char (point-min))
- (display-buffer mh-temp-buffer))
-
-(defun mh-parse-flist-output-line (line)
- "Parse LINE to generate folder name, unseen messages and total messages."
- (with-temp-buffer
- (insert line)
- (goto-char (point-max))
- (let (folder unseen total p)
- (when (search-backward " out of " (point-min) t)
- (setq total (read-from-string
- (buffer-substring-no-properties
- (match-end 0) (line-end-position))))
- (when (search-backward " in sequence " (point-min) t)
- (setq p (point))
- (when (search-backward " has " (point-min) t)
- (setq unseen (read-from-string (buffer-substring-no-properties
- (match-end 0) p)))
- (while (or (eq (char-after) ?+) (eq (char-after) ? ))
- (backward-char))
- (setq folder (buffer-substring-no-properties
- (point-min) (1+ (point))))
- (values (format "+%s" folder) (car unseen) (car total))))))))
-
-(defun mh-folder-size (folder)
- "Find size of FOLDER."
- (with-temp-buffer
- (call-process (expand-file-name "flist" mh-progs) nil t nil
- "-norecurse" folder)
- (goto-char (point-min))
- (multiple-value-bind (folder1 unseen total)
- (mh-parse-flist-output-line
- (buffer-substring (point) (line-end-position)))
- (unless (equal folder folder1)
- (error "Call to flist failed on folder %s" folder))
- (values total unseen))))
-
-(defun mh-visit-folder (folder &optional range index-data)
- "Visit FOLDER and display RANGE of messages.
-Do not call this function from outside MH-E; see \\[mh-rmail] instead.
-
-If RANGE is nil (the default if it is omitted when called non-interactively),
-then all messages in FOLDER are displayed.
-
-If an index buffer is being created then INDEX-DATA is used to initialize the
-index buffer specific data structures."
- (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
- (list folder-name (mh-read-msg-range folder-name))))
- (let ((config (current-window-configuration))
- (threaded-view-flag mh-show-threads-flag))
- (save-excursion
- (when (get-buffer folder)
- (set-buffer folder)
- (setq threaded-view-flag (memq 'unthread mh-view-ops))
- (mh-reset-threads-and-narrowing)))
- (when index-data
- (mh-make-folder folder)
- (setq mh-index-data (car index-data)
- mh-index-msg-checksum-map (make-hash-table :test #'equal)
- mh-index-checksum-origin-map (make-hash-table :test #'equal))
- (mh-index-update-maps folder (cadr index-data)))
- (mh-scan-folder folder (or range "all"))
- (cond ((and threaded-view-flag
- (save-excursion
- (goto-char (point-min))
- (or (null mh-large-folder)
- (not (equal (forward-line mh-large-folder) 0))
- (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
- nil))))
- (mh-toggle-threads))
- (mh-index-data
- (mh-index-insert-folder-headers)))
- (unless mh-showing-mode (delete-other-windows))
- (setq mh-previous-window-config config))
- nil)
-
-;;;###mh-autoload
-(defun mh-update-sequences ()
- "Update MH's Unseen-Sequence and current folder and message.
-Flush MH-E's state out to MH. The message at the cursor becomes current."
- (interactive)
- ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
- ;; which updates MH-E's state from MH.
- (let ((folder-set (mh-update-unseen))
- (new-cur (mh-get-msg-num nil)))
- (if new-cur
- (let ((seq-entry (mh-find-seq 'cur)))
- (mh-remove-cur-notation)
- (setcdr seq-entry
- (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
- (mh-define-sequence 'cur (list new-cur))
- (beginning-of-line)
- (if (looking-at mh-scan-good-msg-regexp)
- (mh-notate nil mh-note-cur mh-cmd-note)))
- (or folder-set
- (save-excursion
- ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
- ;; So I added this sanity check.
- (if (stringp mh-current-folder)
- (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
- (mh-exec-cmd-quiet t "folder" "-fast")))))))
-
-\f
-
-;;; Support routines.
-
-(defun mh-delete-a-msg (msg)
- "Delete the MSG.
-The value of `mh-delete-msg-hook' is a list of functions to be called, with no
-arguments, after the message has been deleted."
- (save-excursion
- (mh-goto-msg msg nil t)
- (if (looking-at mh-scan-refiled-msg-regexp)
- (error "Message %d is refiled. Undo refile before deleting" msg))
- (if (looking-at mh-scan-deleted-msg-regexp)
- nil
- (mh-set-folder-modified-p t)
- (setq mh-delete-list (cons msg mh-delete-list))
- (mh-notate msg mh-note-deleted mh-cmd-note)
- (run-hooks 'mh-delete-msg-hook))))
-
-(defun mh-refile-a-msg (msg folder)
- "Refile MSG in FOLDER.
-Folder is a symbol, not a string.
-The value of `mh-refile-msg-hook' is a list of functions to be called, with no
-arguments, after the message has been refiled."
- (save-excursion
- (mh-goto-msg msg nil t)
- (cond ((looking-at mh-scan-deleted-msg-regexp)
- (error "Message %d is deleted. Undo delete before moving" msg))
- ((looking-at mh-scan-refiled-msg-regexp)
- (if (y-or-n-p
- (format "Message %d already refiled. Copy to %s as well? "
- msg folder))
- (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
- "-src" mh-current-folder
- (symbol-name folder))
- (message "Message not copied.")))
- (t
- (mh-set-folder-modified-p t)
- (cond ((null (assoc folder mh-refile-list))
- (push (list folder msg) mh-refile-list))
- ((not (member msg (cdr (assoc folder mh-refile-list))))
- (push msg (cdr (assoc folder mh-refile-list)))))
- (mh-notate msg mh-note-refiled mh-cmd-note)
- (run-hooks 'mh-refile-msg-hook)))))
-
-(defun mh-next-msg ()
- "Move backward or forward to the next undeleted message in the buffer."
- (if (eq mh-next-direction 'forward)
- (mh-next-undeleted-msg 1)
- (mh-previous-undeleted-msg 1)))
-
-(defun mh-next-unread-msg (&optional count)
- "Move to next unread message.
-With optional argument COUNT, COUNT-1 unread messages are skipped."
- (interactive "p")
- (unless (> count 0)
- (error "The function mh-next-unread-msg expects positive argument"))
- (setq count (1- count))
- (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
- (cur-msg (mh-get-msg-num nil)))
- (cond ((and (not cur-msg) (not (bobp))
- ;; If we are at the end of the buffer back up one line and go
- ;; to unread message after that.
- (progn
- (forward-line -1)
- (setq cur-msg (mh-get-msg-num nil)))
- nil))
- ((or (null unread-sequence) (not cur-msg))
- ;; No unread message or there aren't any messages in buffer...
- (message "No more unread messages"))
- ((progn
- ;; Skip messages
- (while (and unread-sequence (>= cur-msg (car unread-sequence)))
- (setq unread-sequence (cdr unread-sequence)))
- (while (> count 0)
- (setq unread-sequence (cdr unread-sequence))
- (setq count (1- count)))
- (not (car unread-sequence)))
- (message "No more unread messages"))
- (t (mh-goto-msg (car unread-sequence))))))
-
-(defun mh-set-scan-mode ()
- "Display the scan listing buffer, but do not show a message."
- (if (get-buffer mh-show-buffer)
- (delete-windows-on mh-show-buffer))
- (mh-showing-mode 0)
- (force-mode-line-update)
- (if mh-recenter-summary-flag
- (mh-recenter nil)))
-
-(defun mh-undo-msg (msg)
- "Undo the deletion or refile of one MSG."
- (cond ((memq msg mh-delete-list)
- (setq mh-delete-list (delq msg mh-delete-list)))
- (t
- (dolist (folder-msg-list mh-refile-list)
- (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
- (setq mh-refile-list (loop for x in mh-refile-list
- unless (null (cdr x)) collect x))))
- (mh-notate msg ? mh-cmd-note))
-
-\f
-
-;;; The folder data abstraction.
-
-(defun mh-make-folder (name)
- "Create a new mail folder called NAME.
-Make it the current folder."
- (switch-to-buffer name)
- (setq buffer-read-only nil)
- (erase-buffer)
- (if mh-adaptive-cmd-note-flag
- (mh-set-cmd-note (mh-message-number-width name)))
- (setq buffer-read-only t)
- (mh-folder-mode)
- (mh-set-folder-modified-p nil)
- (setq buffer-file-name mh-folder-filename)
- (mh-make-folder-mode-line))
-
-;;; Ensure new buffers won't get this mode if default-major-mode is nil.
-(put 'mh-folder-mode 'mode-class 'special)
-
-\f
-
-;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
-;;; Menus for folder mode: folder, message, sequence (in that order)
-;;; folder-mode "Sequence" menu
-(easy-menu-define
- mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
- '("Sequence"
- ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
- ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
- ["Delete Message from Sequence..." mh-delete-msg-from-seq
- (mh-get-msg-num nil)]
- ["List Sequences in Folder..." mh-list-sequences t]
- ["Delete Sequence..." mh-delete-seq t]
- ["Narrow to Sequence..." mh-narrow-to-seq t]
- ["Widen from Sequence" mh-widen mh-narrowed-to-seq]
- "--"
- ["Narrow to Subject Sequence" mh-narrow-to-subject t]
- ["Delete Rest of Same Subject" mh-delete-subject t]
- "--"
- ["Push State Out to MH" mh-update-sequences t]))
-
-;;; folder-mode "Message" menu
-(easy-menu-define
- mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
- '("Message"
- ["Show Message" mh-show (mh-get-msg-num nil)]
- ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
- ["Next Message" mh-next-undeleted-msg t]
- ["Previous Message" mh-previous-undeleted-msg t]
- ["Go to First Message" mh-first-msg t]
- ["Go to Last Message" mh-last-msg t]
- ["Go to Message by Number..." mh-goto-msg t]
- ["Modify Message" mh-modify]
- ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
- ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
- ["Undo Delete/Refile" mh-undo t]
- ["Process Delete/Refile" mh-execute-commands
- (or mh-refile-list mh-delete-list)]
- "--"
- ["Compose a New Message" mh-send t]
- ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
- ["Forward Message..." mh-forward (mh-get-msg-num nil)]
- ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
- ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
- ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
- "--"
- ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
- ["Print Message" mh-print-msg (mh-get-msg-num nil)]
- ["Write Message to File..." mh-write-msg-to-file
- (mh-get-msg-num nil)]
- ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
- ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
- ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
-
-;;; folder-mode "Folder" menu
-(easy-menu-define
- mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
- '("Folder"
- ["Incorporate New Mail" mh-inc-folder t]
- ["Toggle Show/Folder" mh-toggle-showing t]
- ["Execute Delete/Refile" mh-execute-commands
- (or mh-refile-list mh-delete-list)]
- ["Rescan Folder" mh-rescan-folder t]
- ["Thread Folder" mh-toggle-threads
- (not (memq 'unthread mh-view-ops))]
- ["Pack Folder" mh-pack-folder t]
- ["Sort Folder" mh-sort-folder t]
- "--"
- ["List Folders" mh-list-folders t]
- ["Visit a Folder..." mh-visit-folder t]
- ["Search a Folder..." mh-search-folder t]
- ["Indexed Search..." mh-index-search t]
- "--"
- ["Quit MH-E" mh-quit t]))
-
-\f
-
-(defmacro mh-remove-xemacs-horizontal-scrollbar ()
- "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
- (when mh-xemacs-flag
- `(if (and (featurep 'scrollbar)
- (fboundp 'set-specifier))
- (set-specifier horizontal-scrollbar-visible-p nil
- (cons (current-buffer) nil)))))
-
-(defmacro mh-write-file-functions-compat ()
- "Return `write-file-functions' if it exists.
-Otherwise return `local-write-file-hooks'. This macro exists purely for
-compatibility. The former symbol is used in Emacs 21.4 onward while the latter
-is used in previous versions and XEmacs."
- (if (boundp 'write-file-functions)
- ''write-file-functions ;Emacs 21.4
- ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
-
-(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
- "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
-
-You can show the message the cursor is pointing to, and step through the
-messages. Messages can be marked for deletion or refiling into another
-folder; these commands are executed all at once with a separate command.
-
-A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
-applies the action to a message sequence. If `transient-mark-mode',
-is non-nil, the action is applied to the region.
-
-Options that control this mode can be changed with \\[customize-group];
-specify the \"mh\" group. In particular, please see the `mh-scan-format-file'
-option if you wish to modify scan's format.
-
-When a folder is visited, the hook `mh-folder-mode-hook' is run.
-
-\\{mh-folder-mode-map}"
-
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
- (mh-make-local-vars
- 'mh-current-folder (buffer-name) ; Name of folder, a string
- 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
- 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
- (file-name-as-directory (mh-expand-file-name (buffer-name)))
- 'mh-showing-mode nil ; Show message also?
- 'mh-delete-list nil ; List of msgs nums to delete
- 'mh-refile-list nil ; List of folder names in mh-seq-list
- 'mh-seq-list nil ; Alist of (seq . msgs) nums
- 'mh-seen-list nil ; List of displayed messages
- 'mh-next-direction 'forward ; Direction to move to next message
- 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
- 'mh-view-ops () ; Stack that keeps track of the order
- ; in which narrowing/threading has been
- ; carried out.
- 'mh-index-data nil ; If the folder was created by a call
- ; to mh-index-search this contains info
- ; about the search results.
- 'mh-index-previous-search nil ; Previous folder and search-regexp
- 'mh-index-msg-checksum-map nil ; msg -> checksum map
- 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
- 'mh-first-msg-num nil ; Number of first msg in buffer
- 'mh-last-msg-num nil ; Number of last msg in buffer
- 'mh-msg-count nil ; Number of msgs in buffer
- 'mh-mode-line-annotation nil ; Indicates message range
- 'mh-previous-window-config nil) ; Previous window configuration
- (mh-remove-xemacs-horizontal-scrollbar)
- (setq truncate-lines t)
- (auto-save-mode -1)
- (setq buffer-offer-save t)
- (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
- (make-local-variable 'revert-buffer-function)
- (make-local-variable 'hl-line-mode) ; avoid pollution
- (if (fboundp 'hl-line-mode)
- (hl-line-mode 1))
- (setq revert-buffer-function 'mh-undo-folder)
- (or (assq 'mh-showing-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(mh-showing-mode " Show") minor-mode-alist)))
- (easy-menu-add mh-folder-sequence-menu)
- (easy-menu-add mh-folder-message-menu)
- (easy-menu-add mh-folder-folder-menu)
- (if (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
- (if (and mh-xemacs-flag
- font-lock-auto-fontify)
- (turn-on-font-lock))) ; Force font-lock in XEmacs.
-
-(defun mh-make-local-vars (&rest pairs)
- "Initialize local variables according to the variable-value PAIRS."
-
- (while pairs
- (set (make-local-variable (car pairs)) (car (cdr pairs)))
- (setq pairs (cdr (cdr pairs)))))
-
-(defun mh-scan-folder (folder range &optional dont-exec-pending)
- "Scan the FOLDER over the RANGE.
-If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
-refiles aren't carried out.
-Return in the folder's buffer."
- (cond ((null (get-buffer folder))
- (mh-make-folder folder))
- (t
- (or dont-exec-pending (mh-process-or-undo-commands folder))
- (switch-to-buffer folder)))
- (mh-regenerate-headers range)
- (if (zerop (buffer-size))
- (if (equal range "all")
- (message "Folder %s is empty" folder)
- (message "No messages in %s, range %s" folder range))
- (mh-goto-cur-msg))
- (save-excursion
- (when dont-exec-pending
- ;; Re-annotate messages to be refiled...
- (dolist (folder-msg-list mh-refile-list)
- (dolist (msg (cdr folder-msg-list))
- (mh-notate msg mh-note-refiled mh-cmd-note)))
- ;; Re-annotate messages to be deleted...
- (dolist (msg mh-delete-list)
- (mh-notate msg mh-note-deleted mh-cmd-note)))))
-
-(defun mh-set-cmd-note (width)
- "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
-
-If `mh-scan-format-file' specifies nil or a filename, then this function
-will NOT update `mh-cmd-note'."
- ;; Add one to the width to always have whitespace in column zero.
- (setq width (max (1+ width) 2))
- (if (and (equal mh-scan-format-file t)
- (not (eq mh-cmd-note width)))
- (setq mh-cmd-note width))
- mh-cmd-note)
-
-(defun mh-regenerate-headers (range &optional update)
- "Scan folder over range RANGE.
-If UPDATE, append the scan lines, otherwise replace."
- (let ((folder mh-current-folder)
- (range (if (and range (atom range)) (list range) range))
- scan-start)
- (message "Scanning %s..." folder)
- (with-mh-folder-updating (nil)
- (if update
- (goto-char (point-max))
- (delete-region (point-min) (point-max))
- (if mh-adaptive-cmd-note-flag
- (mh-set-cmd-note (mh-message-number-width folder))))
- (setq scan-start (point))
- (apply #'mh-exec-cmd-output
- mh-scan-prog nil
- (mh-scan-format)
- "-noclear" "-noheader"
- "-width" (window-width)
- folder range)
- (goto-char scan-start)
- (cond ((looking-at "scan: no messages in")
- (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
- ((looking-at "scan: bad message list ")
- (keep-lines mh-scan-valid-regexp))
- ((looking-at "scan: ")) ; Keep error messages
- (t
- (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
- (setq mh-seq-list (mh-read-folder-sequences folder nil))
- (mh-notate-user-sequences)
- (or update
- (setq mh-mode-line-annotation
- (if (equal range '("all"))
- nil
- mh-partial-folder-mode-line-annotation)))
- (mh-make-folder-mode-line))
- (message "Scanning %s...done" folder)))
-
-(defun mh-generate-new-cmd-note (folder)
- "Fix the `mh-cmd-note' value for this FOLDER.
-
-After doing an `mh-get-new-mail' operation in this FOLDER, at least
-one line that looks like a truncated message number was found.
-
-Remove the text added by the last `mh-inc' command. It should be the
-messages cur-last. Call `mh-set-cmd-note' with the widest message number
-in FOLDER.
-
-Reformat the message number width on each line in the buffer and trim
-the line length to fit in the window.
-
-Rescan the FOLDER in the range cur-last in order to display the
-messages that were removed earlier. They should all fit in the scan
-line now with no message truncation."
- (save-excursion
- (let ((maxcol (1- (window-width)))
- (old-cmd-note mh-cmd-note)
- mh-cmd-note-fmt
- msgnum)
- ;; Nuke all of the lines just added by the last inc
- (delete-char (- (point-max) (point)))
- ;; Update the current buffer to reflect the new mh-cmd-note
- ;; value needed to display messages.
- (mh-set-cmd-note (mh-message-number-width folder))
- (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
- ;; Cleanup the messages that are in the buffer right now
- (goto-char (point-min))
- (cond ((memq 'unthread mh-view-ops)
- (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
- (t (while (re-search-forward mh-scan-msg-number-regexp nil 0 1)
- ;; reformat the number to fix in mh-cmd-note columns
- (setq msgnum (string-to-number
- (buffer-substring
- (match-beginning 1) (match-end 1))))
- (replace-match (format mh-cmd-note-fmt msgnum))
- ;; trim the line to fix in the window
- (end-of-line)
- (let ((eol (point)))
- (move-to-column maxcol)
- (if (<= (point) eol)
- (delete-char (- eol (point))))))))
- ;; now re-read the lost messages
- (goto-char (point-max))
- (prog1 (point)
- (mh-regenerate-headers "cur-last" t)))))
-
-(defun mh-get-new-mail (maildrop-name)
- "Read new mail from MAILDROP-NAME into the current buffer.
-Return in the current buffer."
- (let ((point-before-inc (point))
- (folder mh-current-folder)
- (new-mail-flag nil))
- (with-mh-folder-updating (t)
- (if maildrop-name
- (message "inc %s -file %s..." folder maildrop-name)
- (message "inc %s..." folder))
- (setq mh-next-direction 'forward)
- (goto-char (point-max))
- (let ((start-of-inc (point)))
- (mh-remove-cur-notation)
- (if maildrop-name
- ;; I think MH 5 used "-ms-file" instead of "-file",
- ;; which would make inc'ing from maildrops fail.
- (mh-exec-cmd-output mh-inc-prog nil folder
- (mh-scan-format)
- "-file" (expand-file-name maildrop-name)
- "-width" (window-width)
- "-truncate")
- (mh-exec-cmd-output mh-inc-prog nil
- (mh-scan-format)
- "-width" (window-width)))
- (if maildrop-name
- (message "inc %s -file %s...done" folder maildrop-name)
- (message "inc %s...done" folder))
- (goto-char start-of-inc)
- (cond ((save-excursion
- (re-search-forward "^inc: no mail" nil t))
- (message "No new mail%s%s" (if maildrop-name " in " "")
- (if maildrop-name maildrop-name "")))
- ((and (when mh-narrowed-to-seq
- (let ((saved-text (buffer-substring-no-properties
- start-of-inc (point-max))))
- (delete-region start-of-inc (point-max))
- (unwind-protect (mh-widen)
- (goto-char (point-max))
- (setq start-of-inc (point))
- (insert saved-text)
- (goto-char start-of-inc))))
- nil))
- ((re-search-forward "^inc:" nil t) ; Error messages
- (error "Error incorporating mail"))
- ((and
- (equal mh-scan-format-file t)
- mh-adaptive-cmd-note-flag
- ;; Have we reached an edge condition?
- (save-excursion
- (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
- (setq start-of-inc (mh-generate-new-cmd-note folder))
- nil))
- (t
- (setq new-mail-flag t)))
- (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
- (setq mh-seq-list (mh-read-folder-sequences folder t))
- (when (equal (point-max) start-of-inc)
- (mh-notate-seq 'cur mh-note-cur mh-cmd-note))
- (mh-notate-user-sequences)
- (if new-mail-flag
- (progn
- (mh-make-folder-mode-line)
- (when (memq 'unthread mh-view-ops)
- (mh-thread-inc folder start-of-inc))
- (mh-goto-cur-msg))
- (goto-char point-before-inc))))))
-
-(defun mh-make-folder-mode-line (&optional ignored)
- "Set the fields of the mode line for a folder buffer.
-The optional argument is now obsolete and IGNORED. It used to be used to pass
-in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
- (save-excursion
- (save-window-excursion
- (mh-first-msg)
- (let ((new-first-msg-num (mh-get-msg-num nil)))
- (when (or (not (memq 'unthread mh-view-ops))
- (null mh-first-msg-num)
- (null new-first-msg-num)
- (< new-first-msg-num mh-first-msg-num))
- (setq mh-first-msg-num new-first-msg-num)))
- (mh-last-msg)
- (let ((new-last-msg-num (mh-get-msg-num nil)))
- (when (or (not (memq 'unthread mh-view-ops))
- (null mh-last-msg-num)
- (null new-last-msg-num)
- (> new-last-msg-num mh-last-msg-num))
- (setq mh-last-msg-num new-last-msg-num)))
- (setq mh-msg-count (if mh-first-msg-num
- (count-lines (point-min) (point-max))
- 0))
- (setq mode-line-buffer-identification
- (list (format "{%%b%s} %s msg%s"
- (if mh-mode-line-annotation
- (format "/%s" mh-mode-line-annotation)
- "")
- (if (zerop mh-msg-count)
- "no"
- (format "%d" mh-msg-count))
- (if (zerop mh-msg-count)
- "s"
- (cond ((> mh-msg-count 1)
- (format "s (%d-%d)" mh-first-msg-num
- mh-last-msg-num))
- (mh-first-msg-num
- (format " (%d)" mh-first-msg-num))
- ("")))))))))
-
-(defun mh-unmark-all-headers (remove-all-flags)
- "Remove all '+' flags from the folder listing.
-With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
-Optimized for speed (i.e., no regular expressions)."
- (save-excursion
- (let ((case-fold-search nil)
- (last-line (1- (point-max)))
- char)
- (mh-first-msg)
- (while (<= (point) last-line)
- (forward-char mh-cmd-note)
- (setq char (following-char))
- (if (or (and remove-all-flags
- (or (= char (aref mh-note-deleted 0))
- (= char (aref mh-note-refiled 0))))
- (= char (aref mh-note-cur 0)))
- (progn
- (delete-char 1)
- (insert " ")))
- (if remove-all-flags
- (progn
- (forward-char 1)
- (if (= (following-char) (aref mh-note-seq 0))
- (progn
- (delete-char 1)
- (insert " ")))))
- (forward-line)))))
-
-(defun mh-remove-cur-notation ()
- "Remove old cur notation."
- (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
- (save-excursion
- (and cur-msg
- (mh-goto-msg cur-msg t t)
- (looking-at mh-scan-cur-msg-number-regexp)
- (mh-notate nil ? mh-cmd-note)))))
-
-(defun mh-remove-all-notation ()
- "Remove all notations on all scan lines that MH-E introduces."
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (unless (or (equal (char-after) ?+) (eolp))
- (mh-notate nil ? mh-cmd-note)
- (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
- (mh-notate nil ? (1+ mh-cmd-note))))
- (forward-line))))
-
-;;;###mh-autoload
-(defun mh-goto-cur-msg (&optional minimal-changes-flag)
- "Position the cursor at the current message.
-When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
-recenter the folder buffer."
- (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
- (cond ((and cur-msg
- (mh-goto-msg cur-msg t t))
- (unless minimal-changes-flag
- (mh-notate nil mh-note-cur mh-cmd-note)
- (mh-recenter 0)
- (mh-maybe-show cur-msg)))
- (t
- (message "No current message")))))
-
-(defun mh-process-or-undo-commands (folder)
- "If FOLDER has outstanding commands, then either process or discard them.
-Called by functions like `mh-sort-folder', so also invalidate show buffer."
- (set-buffer folder)
- (if (mh-outstanding-commands-p)
- (if (or mh-do-not-confirm-flag
- (y-or-n-p
- "Process outstanding deletes and refiles (or lose them)? "))
- (mh-process-commands folder)
- (mh-undo-folder)))
- (mh-update-unseen)
- (mh-invalidate-show-buffer))
-
-(defun mh-process-commands (folder)
- "Process outstanding commands for FOLDER.
-The value of `mh-folder-updated-hook' is a list of functions to be called,
-with no arguments, before the commands are processed."
- (message "Processing deletes and refiles for %s..." folder)
- (set-buffer folder)
- (with-mh-folder-updating (nil)
- ;; Run the hook while the lists are still valid
- (run-hooks 'mh-folder-updated-hook)
-
- ;; Update the unseen sequence if it exists
- (mh-update-unseen)
-
- (let ((redraw-needed-flag mh-index-data))
- ;; Remove invalid scan lines if we are in an index folder and then remove
- ;; the real messages
- (when mh-index-data
- (mh-index-delete-folder-headers)
- (mh-index-execute-commands))
-
- ;; Then refile messages
- (mh-mapc #'(lambda (folder-msg-list)
- (let ((dest-folder (symbol-name (car folder-msg-list)))
- (msgs (cdr folder-msg-list)))
- (setq redraw-needed-flag t)
- (apply #'mh-exec-cmd
- "refile" "-src" folder dest-folder
- (mh-coalesce-msg-list msgs))
- (mh-delete-scan-msgs msgs)))
- mh-refile-list)
- (setq mh-refile-list ())
-
- ;; Now delete messages
- (cond (mh-delete-list
- (setq redraw-needed-flag t)
- (apply 'mh-exec-cmd "rmm" folder
- (mh-coalesce-msg-list mh-delete-list))
- (mh-delete-scan-msgs mh-delete-list)
- (setq mh-delete-list nil)))
-
- ;; Don't need to remove sequences since delete and refile do so.
- ;; Mark cur message
- (if (> (buffer-size) 0)
- (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
-
- ;; Redraw folder buffer if needed
- (when (and redraw-needed-flag)
- (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
- (mh-index-data (mh-index-insert-folder-headers)))))
-
- (and (buffer-file-name (get-buffer mh-show-buffer))
- (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
- ;; If "inc" were to put a new msg in this file,
- ;; we would not notice, so mark it invalid now.
- (mh-invalidate-show-buffer))
-
- (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
- (mh-unmark-all-headers t)
- (mh-notate-user-sequences)
- (message "Processing deletes and refiles for %s...done" folder)))
-
-(defun mh-update-unseen ()
- "Synchronize the unseen sequence with MH.
-Return non-nil iff the MH folder was set.
-The value of `mh-unseen-updated-hook' is a list of functions to be called,
-with no arguments, after the unseen sequence is updated."
- (if mh-seen-list
- (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
- (unseen-msgs (mh-seq-msgs unseen-seq)))
- (if unseen-msgs
- (progn
- (mh-undefine-sequence mh-unseen-seq mh-seen-list)
- (run-hooks 'mh-unseen-updated-hook)
- (while mh-seen-list
- (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
- (setq mh-seen-list (cdr mh-seen-list)))
- (setcdr unseen-seq unseen-msgs)
- t) ;since we set the folder
- (setq mh-seen-list nil)))))
-
-(defun mh-delete-scan-msgs (msgs)
- "Delete the scan listing lines for MSGS."
- (save-excursion
- (while msgs
- (when (mh-goto-msg (car msgs) t t)
- (when (memq 'unthread mh-view-ops)
- (mh-thread-forget-message (car msgs)))
- (mh-delete-line 1))
- (setq msgs (cdr msgs)))))
-
-(defun mh-outstanding-commands-p ()
- "Return non-nil if there are outstanding deletes or refiles."
- (or mh-delete-list mh-refile-list))
-
-(defun mh-coalesce-msg-list (messages)
- "Give a list of MESSAGES, return a list of message number ranges.
-Sort of the opposite of `mh-read-msg-list', which expands ranges.
-Message lists passed to MH programs go through this so
-command line arguments won't exceed system limits."
- (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
- (range-high nil)
- (prev -1)
- (ranges nil))
- (while prev
- (if range-high
- (if (or (not (numberp prev))
- (not (equal (car msgs) (1- prev))))
- (progn ;non-sequential, flush old range
- (if (eq prev range-high)
- (setq ranges (cons range-high ranges))
- (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
- (setq range-high nil))))
- (or range-high
- (setq range-high (car msgs))) ;start new or first range
- (setq prev (car msgs))
- (setq msgs (cdr msgs)))
- ranges))
-
-(defun mh-greaterp (msg1 msg2)
- "Return the greater of two message indicators MSG1 and MSG2.
-Strings are \"smaller\" than numbers.
-Legal values are things like \"cur\", \"last\", 1, and 1820."
- (if (numberp msg1)
- (if (numberp msg2)
- (> msg1 msg2)
- t)
- (if (numberp msg2)
- nil
- (string-lessp msg2 msg1))))
-
-(defun mh-lessp (msg1 msg2)
- "Return the lesser of two message indicators MSG1 and MSG2.
-Strings are \"smaller\" than numbers.
-Legal values are things like \"cur\", \"last\", 1, and 1820."
- (not (mh-greaterp msg1 msg2)))
-
-\f
-
-;;; Basic sequence handling
-
-(defun mh-delete-seq-locally (seq)
- "Remove MH-E's record of SEQ."
- (let ((entry (mh-find-seq seq)))
- (setq mh-seq-list (delq entry mh-seq-list))))
-
-(defun mh-read-folder-sequences (folder save-refiles)
- "Read and return the predefined sequences for a FOLDER.
-If SAVE-REFILES is non-nil, then keep the sequences
-that note messages to be refiled."
- (let ((seqs ()))
- (cond (save-refiles
- (mh-mapc (function (lambda (seq) ; Save the refiling sequences
- (if (mh-folder-name-p (mh-seq-name seq))
- (setq seqs (cons seq seqs)))))
- mh-seq-list)))
- (save-excursion
- (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
- (progn
- ;; look for name in line of form "cur: 4" or "myseq (private): 23"
- (while (re-search-forward "^[^: ]+" nil t)
- (setq seqs (cons (mh-make-seq (intern (buffer-substring
- (match-beginning 0)
- (match-end 0)))
- (mh-read-msg-list))
- seqs)))
- (delete-region (point-min) (point))))) ; avoid race with
- ; mh-process-daemon
- seqs))
-
-(defun mh-read-msg-list ()
- "Return a list of message numbers from point to the end of the line.
-Expands ranges into set of individual numbers."
- (let ((msgs ())
- (end-of-line (save-excursion (end-of-line) (point)))
- num)
- (while (re-search-forward "[0-9]+" end-of-line t)
- (setq num (string-to-int (buffer-substring (match-beginning 0)
- (match-end 0))))
- (cond ((looking-at "-") ; Message range
- (forward-char 1)
- (re-search-forward "[0-9]+" end-of-line t)
- (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
- (match-end 0)))))
- (if (< num2 num)
- (error "Bad message range: %d-%d" num num2))
- (while (<= num num2)
- (setq msgs (cons num msgs))
- (setq num (1+ num)))))
- ((not (zerop num)) ;"pick" outputs "0" to mean no match
- (setq msgs (cons num msgs)))))
- msgs))
-
-(defun mh-notate-user-sequences ()
- "Mark the scan listing of all messages in user-defined sequences."
- (let ((seqs mh-seq-list)
- name)
- (while seqs
- (setq name (mh-seq-name (car seqs)))
- (if (not (mh-internal-seq name))
- (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
- (setq seqs (cdr seqs)))))
-
-(defun mh-internal-seq (name)
- "Return non-nil if NAME is the name of an internal MH-E sequence."
- (or (memq name '(answered cur deleted forwarded printed))
- (eq name mh-unseen-seq)
- (eq name mh-previous-seq)
- (mh-folder-name-p name)))
-
-(defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
- "Delete MESSAGE from SEQUENCE.
-MESSAGE defaults to displayed message. From Lisp, optional third arg
-INTERNAL-FLAG non-nil means do not inform MH of the change."
- (interactive (list (mh-get-msg-num t)
- (mh-read-seq-default "Delete from" t)
- nil))
- (let ((entry (mh-find-seq sequence)))
- (cond (entry
- (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence)
- (if (not internal-flag)
- (mh-undefine-sequence sequence (list message)))
- (setcdr entry (delq message (mh-seq-msgs entry)))))))
-
-(defun mh-undefine-sequence (seq msgs)
- "Remove from the SEQ the list of MSGS."
- (mh-exec-cmd "mark" mh-current-folder "-delete"
- "-sequence" (symbol-name seq)
- (mh-coalesce-msg-list msgs)))
-
-(defun mh-define-sequence (seq msgs)
- "Define the SEQ to contain the list of MSGS.
-Do not mark pseudo-sequences or empty sequences.
-Signals an error if SEQ is an illegal name."
- (if (and msgs
- (not (mh-folder-name-p seq)))
- (save-excursion
- (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
- "-sequence" (symbol-name seq)
- (mh-coalesce-msg-list msgs)))))
-
-(defun mh-map-over-seqs (function seq-list)
- "Apply FUNCTION to each sequence in SEQ-LIST.
-The sequence name and the list of messages are passed as arguments."
- (while seq-list
- (funcall function
- (mh-seq-name (car seq-list))
- (mh-seq-msgs (car seq-list)))
- (setq seq-list (cdr seq-list))))
-
-(defun mh-notate-if-in-one-seq (msg character offset seq)
- "Notate MSG.
-The CHARACTER is placed at the given OFFSET from the beginning of the listing.
-The notation is performed if the MSG is only in SEQ."
- (let ((in-seqs (mh-seq-containing-msg msg nil)))
- (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
- (mh-notate msg character offset))))
-
-(defun mh-seq-containing-msg (msg &optional include-internal-flag)
- "Return a list of the sequences containing MSG.
-If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
- (let ((l mh-seq-list)
- (seqs ()))
- (while l
- (and (memq msg (mh-seq-msgs (car l)))
- (or include-internal-flag
- (not (mh-internal-seq (mh-seq-name (car l)))))
- (setq seqs (cons (mh-seq-name (car l)) seqs)))
- (setq l (cdr l)))
- seqs))
-
-\f
-
-;;; User prompting commands.
-
-(defun mh-read-msg-range (folder &optional always-prompt-flag)
- "Prompt for message range from FOLDER.
-If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
-range."
- (multiple-value-bind (total unseen) (mh-folder-size folder)
- (cond
- ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
- (list (symbol-name mh-unseen-seq)))
- ((or (null mh-large-folder) (not (numberp total)))
- (list "all"))
- ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
- (let* ((prompt
- (format "Range or number of messages to read (default: %s): "
- total))
- (in (read-string prompt nil nil (number-to-string total))))
- (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
- (list (format "last:%s" (car (read-from-string in)))))
- ((equal in "") (list "all"))
- (t (split-string in)))))
- (t (list "all")))))
-
-\f
-
-;;; Build the folder-mode keymap:
-
-(suppress-keymap mh-folder-mode-map)
-
-;; Use defalias to make sure the documented primary key bindings
-;; appear in menu lists.
-(defalias 'mh-alt-show 'mh-show)
-(defalias 'mh-alt-refile-msg 'mh-refile-msg)
-(defalias 'mh-alt-send 'mh-send)
-(defalias 'mh-alt-visit-folder 'mh-visit-folder)
-
-;; Save the `b' binding for a future `back'. Maybe?
-(gnus-define-keys mh-folder-mode-map
- " " mh-page-msg
- "!" mh-refile-or-write-again
- "," mh-header-display
- "." mh-alt-show
- ">" mh-write-msg-to-file
- "?" mh-help
- "E" mh-extract-rejected-mail
- "M" mh-modify
- "\177" mh-previous-page
- "\C-d" mh-delete-msg-no-motion
- "\t" mh-index-next-folder
- [backtab] mh-index-previous-folder
- "\M-\t" mh-index-previous-folder
- "\e<" mh-first-msg
- "\e>" mh-last-msg
- "\ed" mh-redistribute
- "\r" mh-show
- "^" mh-alt-refile-msg
- "c" mh-copy-msg
- "d" mh-delete-msg
- "e" mh-edit-again
- "f" mh-forward
- "g" mh-goto-msg
- "i" mh-inc-folder
- "k" mh-delete-subject-or-thread
- "l" mh-print-msg
- "m" mh-alt-send
- "n" mh-next-undeleted-msg
- "\M-n" mh-next-unread-msg
- "o" mh-refile-msg
- "p" mh-previous-undeleted-msg
- "\M-p" mh-previous-unread-msg
- "q" mh-quit
- "r" mh-reply
- "s" mh-send
- "t" mh-toggle-showing
- "u" mh-undo
- "v" mh-index-visit-folder
- "x" mh-execute-commands
- "|" mh-pipe-msg)
-
-(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
- "?" mh-prefix-help
- "S" mh-sort-folder
- "f" mh-alt-visit-folder
- "i" mh-index-search
- "k" mh-kill-folder
- "l" mh-list-folders
- "o" mh-alt-visit-folder
- "p" mh-pack-folder
- "r" mh-rescan-folder
- "s" mh-search-folder
- "u" mh-undo-folder
- "v" mh-visit-folder)
-
-(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
- "?" mh-prefix-help
- "d" mh-delete-msg-from-seq
- "k" mh-delete-seq
- "l" mh-list-sequences
- "n" mh-narrow-to-seq
- "p" mh-put-msg-in-seq
- "s" mh-msg-is-in-seq
- "w" mh-widen)
-
-(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
- "?" mh-prefix-help
- "u" mh-thread-ancestor
- "p" mh-thread-previous-sibling
- "n" mh-thread-next-sibling
- "t" mh-toggle-threads
- "d" mh-thread-delete
- "o" mh-thread-refile)
-
-(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
- "?" mh-prefix-help
- "s" mh-narrow-to-subject
- "w" mh-widen)
-
-(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
- "?" mh-prefix-help
- "s" mh-store-msg ;shar
- "u" mh-store-msg) ;uuencode
-
-(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
- " " mh-page-digest
- "?" mh-prefix-help
- "\177" mh-page-digest-backwards
- "b" mh-burst-digest)
-
-(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
- "?" mh-prefix-help
- "a" mh-mime-save-parts
- "i" mh-folder-inline-mime-part
- "o" mh-folder-save-mime-part
- "v" mh-folder-toggle-mime-part
- "\t" mh-next-button
- [backtab] mh-prev-button
- "\M-\t" mh-prev-button)
-
-(cond
- (mh-xemacs-flag
- (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
- (t
- (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
-
-;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
-
-\f
-
-;;; Help Messages
-
-;;; If you add a new prefix, add appropriate text to the nil key.
-;;;
-;;; In general, messages are grouped logically. Taking the main commands for
-;;; example, the first line is "ways to view messages," the second line is
-;;; "things you can do with messages", and the third is "composing" messages.
-;;;
-;;; When adding a new prefix, ensure that the help message contains "what" the
-;;; prefix is for. For example, if the word "folder" were not present in the
-;;; `F' entry, it would not be clear what these commands operated upon.
-(defvar mh-help-messages
- '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
- "[d]elete, [o]refile, e[x]ecute,\n"
- "[s]end, [r]eply.\n"
- "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, "
- "[T]hread, / Limit, e[X]tract, [D]igest.")
-
- (?F "[l]ist, [v]isit folder;\n"
- "[t]hread; [s]earch; [i]ndexed search;\n"
- "[p]ack; [S]ort; [r]escan; [k]ill")
- (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
- "[s]equences, [l]ist,\n"
- "[d]elete message from sequence, [k]ill sequence")
- (?T "[t]oggle, [d]elete, [o]refile thread")
- (?/ "Limit to [s]ubject; [w]iden")
- (?X "un[s]har, [u]udecode message")
- (?D "[b]urst digest")
- (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
- "[TAB] next; [SHIFT-TAB] previous"))
- "Key binding cheat sheet.
-
-This is an associative array which is used to show the most common commands.
-The key is a prefix char. The value is one or more strings which are
-concatenated together and displayed in the minibuffer if ? is pressed after
-the prefix character. The special key nil is used to display the
-non-prefixed commands.
-
-The substitutions described in `substitute-command-keys' are performed as
-well.")
-
-\f
-
-(dolist (mess '("^Cursor not pointing to message$"
- "^There is no other window$"))
- (add-to-list 'debug-ignored-errors mess))
-
-(provide 'mh-e)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-e.el ends here
+++ /dev/null
-;;; mh-funcs.el --- MH-E functions not everyone will use right away
-
-;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Internal support for MH-E package.
-;; Putting these functions in a separate file lets MH-E start up faster,
-;; since less Lisp code needs to be loaded all at once.
-
-;;; Change Log:
-
-;; $Id: mh-funcs.el,v 1.36 2002/12/23 05:52:07 satyaki Exp $
-
-;;; Code:
-
-(require 'mh-e)
-
-;;; Customization
-
-(defvar mh-sortm-args nil
- "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
-The arguments are passed to sortm if \\[mh-sort-folder] is given a
-prefix argument. Normally default arguments to sortm are specified in the
-MH profile.
-For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
-
-(defvar mh-note-copied "C"
- "String whose first character is used to notate copied messages.")
-
-(defvar mh-note-printed "P"
- "String whose first character is used to notate printed messages.")
-
-;;; Functions
-
-;;;###mh-autoload
-(defun mh-burst-digest ()
- "Burst apart the current message, which should be a digest.
-The message is replaced by its table of contents and the messages from the
-digest are inserted into the folder after that message."
- (interactive)
- (let ((digest (mh-get-msg-num t)))
- (mh-process-or-undo-commands mh-current-folder)
- (mh-set-folder-modified-p t) ; lock folder while bursting
- (message "Bursting digest...")
- (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
- (with-mh-folder-updating (t)
- (beginning-of-line)
- (delete-region (point) (point-max)))
- (mh-regenerate-headers (format "%d-last" digest) t)
- (mh-goto-cur-msg)
- (message "Bursting digest...done")))
-
-;;;###mh-autoload
-(defun mh-copy-msg (msg-or-seq folder)
- "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
-Default is the displayed message. If optional prefix argument is provided,
-then prompt for the message sequence."
- (interactive (list (cond
- ((mh-mark-active-p t)
- (mh-region-to-msg-list (region-beginning) (region-end)))
- (current-prefix-arg
- (mh-read-seq-default "Copy" t))
- (t
- (mh-get-msg-num t)))
- (mh-prompt-for-folder "Copy to" "" t)))
- (mh-exec-cmd "refile"
- (cond ((numberp msg-or-seq) msg-or-seq)
- ((listp msg-or-seq) msg-or-seq)
- (t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq))))
- "-link" "-src" mh-current-folder folder)
- (if (numberp msg-or-seq)
- (mh-notate msg-or-seq mh-note-copied mh-cmd-note)
- (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
-
-;;;###mh-autoload
-(defun mh-kill-folder ()
- "Remove the current folder and all included messages.
-Removes all of the messages (files) within the specified current folder,
-and then removes the folder (directory) itself.
-The value of `mh-folder-list-change-hook' is a list of functions to be called,
-with no arguments, after the folders has been removed."
- (interactive)
- (if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
- mh-current-folder))
- (let ((folder mh-current-folder))
- (if (null mh-folder-list)
- (mh-set-folder-list))
- (mh-set-folder-modified-p t) ; lock folder to kill it
- (mh-exec-cmd-daemon "rmf" folder)
- (setq mh-folder-list
- (delq (assoc folder mh-folder-list) mh-folder-list))
- (when (boundp 'mh-speed-folder-map)
- (mh-speed-invalidate-map folder))
- (run-hooks 'mh-folder-list-change-hook)
- (message "Folder %s removed" folder)
- (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
- (if (get-buffer mh-show-buffer)
- (kill-buffer mh-show-buffer))
- (if (get-buffer folder)
- (kill-buffer folder)))
- (message "Folder not removed")))
-
-;; Avoid compiler warning...
-(defvar view-exit-action)
-
-;;;###mh-autoload
-(defun mh-list-folders ()
- "List mail folders."
- (interactive)
- (let ((temp-buffer mh-temp-folders-buffer))
- (with-output-to-temp-buffer temp-buffer
- (save-excursion
- (set-buffer temp-buffer)
- (erase-buffer)
- (message "Listing folders...")
- (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
- "-recurse"
- "-norecurse"))
- (goto-char (point-min))
- (view-mode 1)
- (setq view-exit-action 'kill-buffer)
- (message "Listing folders...done")))))
-
-;;;###mh-autoload
-(defun mh-pack-folder (range)
- "Renumber the messages of a folder to be 1..n.
-First, offer to execute any outstanding commands for the current folder. If
-optional prefix argument provided, prompt for the RANGE of messages to display
-after packing. Otherwise, show the entire folder."
- (interactive (list (if current-prefix-arg
- (mh-read-msg-range mh-current-folder t)
- '("all"))))
- (let ((threaded-flag (memq 'unthread mh-view-ops)))
- (mh-pack-folder-1 range)
- (mh-goto-cur-msg)
- (when mh-index-data
- (mh-index-update-maps mh-current-folder))
- (cond (threaded-flag (mh-toggle-threads))
- (mh-index-data (mh-index-insert-folder-headers))))
- (message "Packing folder...done"))
-
-(defun mh-pack-folder-1 (range)
- "Close and pack the current folder.
-Display the given RANGE of messages after packing. If RANGE is nil, show the
-entire folder."
- (mh-process-or-undo-commands mh-current-folder)
- (message "Packing folder...")
- (mh-set-folder-modified-p t) ; lock folder while packing
- (save-excursion
- (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
- "-norecurse" "-fast"))
- (mh-reset-threads-and-narrowing)
- (mh-regenerate-headers range))
-
-;;;###mh-autoload
-(defun mh-pipe-msg (command include-headers)
- "Pipe the current message through the given shell COMMAND.
-If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
-Otherwise just send the message's body without the headers."
- (interactive
- (list (read-string "Shell command on message: ") current-prefix-arg))
- (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
- (message-directory default-directory))
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- (insert-file-contents msg-file-to-pipe)
- (goto-char (point-min))
- (if (not include-headers) (search-forward "\n\n"))
- (let ((default-directory message-directory))
- (shell-command-on-region (point) (point-max) command nil)))))
-
-;;;###mh-autoload
-(defun mh-page-digest ()
- "Advance displayed message to next digested message."
- (interactive)
- (mh-in-show-buffer (mh-show-buffer)
- ;; Go to top of screen (in case user moved point).
- (move-to-window-line 0)
- (let ((case-fold-search nil))
- ;; Search for blank line and then for From:
- (or (and (search-forward "\n\n" nil t)
- (re-search-forward "^From:" nil t))
- (error "No more messages in digest")))
- ;; Go back to previous blank line, then forward to the first non-blank.
- (search-backward "\n\n" nil t)
- (forward-line 2)
- (mh-recenter 0)))
-
-;;;###mh-autoload
-(defun mh-page-digest-backwards ()
- "Back up displayed message to previous digested message."
- (interactive)
- (mh-in-show-buffer (mh-show-buffer)
- ;; Go to top of screen (in case user moved point).
- (move-to-window-line 0)
- (let ((case-fold-search nil))
- (beginning-of-line)
- (or (and (search-backward "\n\n" nil t)
- (re-search-backward "^From:" nil t))
- (error "No previous message in digest")))
- ;; Go back to previous blank line, then forward to the first non-blank.
- (if (search-backward "\n\n" nil t)
- (forward-line 2))
- (mh-recenter 0)))
-
-;;;###mh-autoload
-(defun mh-print-msg (msg-or-seq)
- "Print MSG-OR-SEQ (default: displayed message) on printer.
-If optional prefix argument provided, then prompt for the message sequence.
-The variable `mh-lpr-command-format' is used to generate the print command.
-The messages are formatted by mhl. See the variable `mhl-formfile'."
- (interactive (list (if current-prefix-arg
- (reverse (mh-seq-to-msgs
- (mh-read-seq-default "Print" t)))
- (mh-get-msg-num t))))
- (if (numberp msg-or-seq)
- (message "Printing message...")
- (message "Printing sequence..."))
- (let ((print-command
- (if (numberp msg-or-seq)
- (format "%s -nobell -clear %s %s | %s"
- (expand-file-name "mhl" mh-lib-progs)
- (mh-msg-filename msg-or-seq)
- (if (stringp mhl-formfile)
- (format "-form %s" mhl-formfile)
- "")
- (format mh-lpr-command-format
- (if (numberp msg-or-seq)
- (format "%s/%d" mh-current-folder
- msg-or-seq)
- (format "Sequence from %s" mh-current-folder))))
- (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
- (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
- (expand-file-name "mhl" mh-lib-progs)
- (if (stringp mhl-formfile)
- (format "-form %s" mhl-formfile)
- "")
- (mh-msg-filenames msg-or-seq)
- (format mh-lpr-command-format
- (if (numberp msg-or-seq)
- (format "%s/%d" mh-current-folder
- msg-or-seq)
- (format "Sequence from %s"
- mh-current-folder)))))))
- (if mh-print-background-flag
- (mh-exec-cmd-daemon shell-file-name "-c" print-command)
- (call-process shell-file-name nil nil nil "-c" print-command))
- (if (numberp msg-or-seq)
- (mh-notate msg-or-seq mh-note-printed mh-cmd-note)
- (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
- (mh-add-msgs-to-seq msg-or-seq 'printed t)
- (if (numberp msg-or-seq)
- (message "Printing message...done")
- (message "Printing sequence...done"))))
-
-(defun mh-msg-filenames (msgs &optional folder)
- "Return a list of file names for MSGS in FOLDER (default current folder)."
- (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
-
-;;;###mh-autoload
-(defun mh-sort-folder (&optional extra-args)
- "Sort the messages in the current folder by date.
-Calls the MH program sortm to do the work.
-The arguments in the list `mh-sortm-args' are passed to sortm if the optional
-argument EXTRA-ARGS is given."
- (interactive "P")
- (mh-process-or-undo-commands mh-current-folder)
- (setq mh-next-direction 'forward)
- (mh-set-folder-modified-p t) ; lock folder while sorting
- (message "Sorting folder...")
- (let ((threaded-flag (memq 'unthread mh-view-ops)))
- (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
- (when mh-index-data
- (mh-index-update-maps mh-current-folder))
- (message "Sorting folder...done")
- (mh-reset-threads-and-narrowing)
- (mh-scan-folder mh-current-folder "all")
- (cond (threaded-flag (mh-toggle-threads))
- (mh-index-data (mh-index-insert-folder-headers)))))
-
-;;;###mh-autoload
-(defun mh-undo-folder (&rest ignore)
- "Undo all pending deletes and refiles in current folder.
-Argument IGNORE is deprecated."
- (interactive)
- (cond ((or mh-do-not-confirm-flag
- (yes-or-no-p "Undo all commands in folder? "))
- (setq mh-delete-list nil
- mh-refile-list nil
- mh-seq-list nil
- mh-next-direction 'forward)
- (with-mh-folder-updating (nil)
- (mh-unmark-all-headers t)))
- (t
- (message "Commands not undone.")
- (sit-for 2))))
-
-;;;###mh-autoload
-(defun mh-store-msg (directory)
- "Store the file(s) contained in the current message into DIRECTORY.
-The message can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory."
- (interactive (list (let ((udir (or mh-store-default-directory
- default-directory)))
- (read-file-name "Store message in directory: "
- udir udir nil))))
- (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- (insert-file-contents msg-file-to-store)
- (mh-store-buffer directory))))
-
-;;;###mh-autoload
-(defun mh-store-buffer (directory)
- "Store the file(s) contained in the current buffer into DIRECTORY.
-The buffer can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory."
- (interactive (list (let ((udir (or mh-store-default-directory
- default-directory)))
- (read-file-name "Store buffer in directory: "
- udir udir nil))))
- (let ((store-directory (expand-file-name directory))
- (sh-start (save-excursion
- (goto-char (point-min))
- (if (re-search-forward
- "^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
- (progn
- ;; The "cut here" pattern was removed from above
- ;; because it seemed to hurt more than help.
- ;; But keep this to make it easier to put it back.
- (if (looking-at "^[^a-z0-9\"]*cut here\\b")
- (forward-line 1))
- (beginning-of-line)
- (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
- nil ;most likely end of a uuencode
- (point))))))
- (log-buffer (get-buffer-create "*Store Output*"))
- (command "sh")
- (uudecode-filename "(unknown filename)"))
- (if (not sh-start)
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^begin [0-7]+ " nil t)
- (setq uudecode-filename
- (buffer-substring (point)
- (progn (end-of-line) (point)))))))
- (save-excursion
- (set-buffer log-buffer)
- (erase-buffer)
- (if (not (file-directory-p store-directory))
- (progn
- (insert "mkdir " directory "\n")
- (call-process "mkdir" nil log-buffer t store-directory)))
- (insert "cd " directory "\n")
- (setq mh-store-default-directory directory)
- (if (not sh-start)
- (progn
- (setq command "uudecode")
- (insert uudecode-filename " being uudecoded...\n"))))
- (set-window-start (display-buffer log-buffer) 0) ;watch progress
- (let (value)
- (let ((default-directory (file-name-as-directory store-directory)))
- (setq value (call-process-region sh-start (point-max) command
- nil log-buffer t)))
- (set-buffer log-buffer)
- (mh-handle-process-error command value))
- (insert "\n(mh-store finished)\n")))
-
-\f
-
-;;; Help Functions
-
-(defun mh-ephem-message (string)
- "Display STRING in the minibuffer momentarily."
- (message "%s" string)
- (sit-for 5)
- (message ""))
-
-;;;###mh-autoload
-(defun mh-help ()
- "Display cheat sheet for the MH-Folder commands in minibuffer."
- (interactive)
- (mh-ephem-message
- (substitute-command-keys
- (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
-
-;;;###mh-autoload
-(defun mh-prefix-help ()
- "Display cheat sheet for the commands of the current prefix in minibuffer."
- (interactive)
- ;; We got here because the user pressed a `?', but he pressed a prefix key
- ;; before that. Since the the key vector starts at index 0, the index of the
- ;; last keystroke is length-1 and thus the second to last keystroke is at
- ;; length-2. We use that information to obtain a suitable prefix character
- ;; from the recent keys.
- (let* ((keys (recent-keys))
- (prefix-char (elt keys (- (length keys) 2))))
- (mh-ephem-message
- (substitute-command-keys
- (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
-
-(provide 'mh-funcs)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-funcs.el ends here
+++ /dev/null
-;;; mh-identity.el --- Multiple Identify support for MH-E.
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Author: Peter S. Galbraith <psg@debian.org>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Multiple identity support for MH-E.
-;;
-;; Used to easily set different fields such as From and Organization, as
-;; well as different signature files.
-;;
-;; Customize the variable `mh-identity-list' and an Identity menu will
-;; appear in mh-letter-mode. The command 'mh-insert-identity can be used
-;; from the command line.
-
-;;; Change Log:
-
-;; $Id: mh-identity.el,v 1.17 2002/12/03 15:54:27 psg Exp $
-
-;;; Code:
-
-
-(require 'cl)
-
-(eval-when (compile load eval)
- (defvar mh-comp-loaded nil)
- (unless mh-comp-loaded
- (setq mh-comp-loaded t)
- (require 'mh-comp))) ;Since we do this on sending
-
-(autoload 'mml-insert-tag "mml")
-
-;;;###mh-autoload
-(defun mh-identity-make-menu ()
- "Build (or rebuild) the Identity menu (e.g. after the list is modified)."
- (when (and mh-identity-list (boundp 'mh-letter-mode-map))
- (easy-menu-define mh-identity-menu mh-letter-mode-map
- "mh-e identity menu"
- (append
- '("Identity")
- ;; Dynamically render :type corresponding to `mh-identity-list'
- ;; e.g.:
- ;; ["home" (mh-insert-identity "home")
- ;; :style radio :active (not (equal mh-identity-local "home"))
- ;; :selected (equal mh-identity-local "home")]
- (mapcar (function
- (lambda (arg)
- `[,arg (mh-insert-identity ,arg) :style radio
- :active (not (equal mh-identity-local ,arg))
- :selected (equal mh-identity-local ,arg)]))
- (mapcar 'car mh-identity-list))
- '("--"
- ["none" (mh-insert-identity "none") mh-identity-local]
- ["Set Default for Session"
- (setq mh-identity-default mh-identity-local) t]
- ["Save as Default"
- (customize-save-variable
- 'mh-identity-default mh-identity-local) t]
- )))))
-
-;;;###mh-autoload
-(defun mh-identity-list-set (symbol value)
- "Update the `mh-identity-list' variable, and rebuild the menu.
-Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
-customization). This is called after 'customize is used to alter
-`mh-identity-list'."
- (set-default symbol value)
- (mh-identity-make-menu))
-
-(defvar mh-identity-local nil
- "Buffer-local variable holding the identity currently in use.")
-(make-variable-buffer-local 'mh-identity-local)
-
-(defun mh-header-field-delete (field value-only)
- "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
-Return t if anything is deleted."
- (when (mh-goto-header-field field)
- (if (not value-only)
- (beginning-of-line)
- (forward-char))
- (delete-region (point)
- (progn (mh-header-field-end)
- (if (not value-only) (forward-char 1))
- (point)))
- t))
-
-(defvar mh-identity-signature-start nil
- "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
-(defvar mh-identity-signature-end nil
- "Marker for the end of a signature inserted by `mh-insert-identity'.")
-
-;;;###mh-autoload
-(defun mh-insert-identity (identity)
- "Insert proper fields for given IDENTITY.
-Edit the `mh-identity-list' variable to define identity."
- (interactive
- (list (completing-read
- "Identity: "
- (if mh-identity-local
- (cons '("none")
- (mapcar 'list (mapcar 'car mh-identity-list)))
- (mapcar 'list (mapcar 'car mh-identity-list)))
- nil t)))
- (save-excursion
- ;;First remove old settings, if any.
- (when mh-identity-local
- (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
- (while pers-list
- (let ((field (concat (caar pers-list) ":")))
- (cond
- ((string-equal "signature:" field)
- (when (and (boundp 'mh-identity-signature-start)
- (markerp mh-identity-signature-start))
- (goto-char mh-identity-signature-start)
- (forward-char -1)
- (delete-region (point) mh-identity-signature-end)))
- ((mh-header-field-delete field nil))))
- (setq pers-list (cdr pers-list)))))
- ;; Then insert the replacement
- (when (not (equal "none" identity))
- (let ((pers-list (cadr (assoc identity mh-identity-list))))
- (while pers-list
- (let ((field (concat (caar pers-list) ":"))
- (value (cdar pers-list)))
- (cond
- ;; No value, remove field
- ((or (not value)
- (string= value ""))
- (mh-header-field-delete field nil))
- ;; Existing field, replace
- ((mh-header-field-delete field t)
- (insert value))
- ;; Handle "signature" special case. Insert file or call function.
- ((and (string-equal "signature:" field)
- (or (and (stringp value)
- (file-readable-p value))
- (fboundp value)))
- (goto-char (point-max))
- (if (not (looking-at "^$"))
- (insert "\n"))
- (insert "\n")
- (save-restriction
- (narrow-to-region (point) (point))
- (set (make-local-variable 'mh-identity-signature-start)
- (make-marker))
- (set-marker mh-identity-signature-start (point))
- (cond
- ;; If MIME composition done, insert signature at the end as
- ;; an inline MIME part.
- ((and (boundp 'mh-mhn-compose-insert-flag)
- mh-mhn-compose-insert-flag)
- (insert "#\n" "Content-Description: Signature\n"))
- ((and (boundp 'mh-mml-compose-insert-flag)
- mh-mml-compose-insert-flag)
- (mml-insert-tag 'part 'type "text/plain"
- 'disposition "inline"
- 'description "Signature")))
- (if (stringp value)
- (insert-file-contents value)
- (funcall value))
- (goto-char (point-min))
- (when (not (re-search-forward "^--" nil t))
- (if (and (boundp 'mh-mhn-compose-insert-flag)
- mh-mhn-compose-insert-flag)
- (forward-line 2))
- (if (and (boundp 'mh-mml-compose-insert-flag)
- mh-mml-compose-insert-flag)
- (forward-line 1))
- (insert "-- \n"))
- (set (make-local-variable 'mh-identity-signature-end)
- (make-marker))
- (set-marker mh-identity-signature-end (point-max))))
- ;; Handle "From" field differently, adding it at the beginning.
- ((string-equal "From:" field)
- (goto-char (point-min))
- (insert "From: " value "\n"))
- ;; Skip empty signature (Can't remove what we don't know)
- ((string-equal "signature:" field))
- ;; Other field, add at end
- (t ;Otherwise, add the end.
- (goto-char (point-min))
- (mh-goto-header-end 0)
- (mh-insert-fields field value))))
- (setq pers-list (cdr pers-list))))))
- ;; Remember what is in use in this buffer
- (if (equal "none" identity)
- (setq mh-identity-local nil)
- (setq mh-identity-local identity)))
-
-(provide 'mh-identity)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-identity.el ends here
+++ /dev/null
-;;; mh-index -- MH-E interface to indexing programs
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; (1) The following search engines are supported:
-;;; swish++
-;;; swish-e
-;;; namazu
-;;; glimpse
-;;; grep
-;;;
-;;; (2) To use this package, you first have to build an index. Please read
-;;; the documentation for `mh-index-search' to get started. That
-;;; documentation will direct you to the specific instructions for your
-;;; particular indexer.
-
-;;; Change Log:
-
-;; $Id: mh-index.el,v 1.73 2003/01/07 21:15:49 satyaki Exp $
-
-;;; Code:
-
-(require 'cl)
-(require 'mh-e)
-(require 'mh-mime)
-
-(autoload 'gnus-local-map-property "gnus-util")
-(autoload 'gnus-eval-format "gnus-spec")
-(autoload 'widget-convert-button "wid-edit")
-(autoload 'executable-find "executable")
-
-;; Support different indexing programs
-(defvar mh-indexer-choices
- '((swish++
- mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result)
- (swish
- mh-swish-binary mh-swish-execute-search mh-swish-next-result)
- (namazu
- mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result)
- (glimpse
- mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result)
- (grep
- mh-grep-binary mh-grep-execute-search mh-grep-next-result))
- "List of possible indexer choices.")
-(defvar mh-indexer nil
- "Chosen index program.")
-(defvar mh-index-execute-search-function nil
- "Function which executes the search program.")
-(defvar mh-index-next-result-function nil
- "Function to parse the next line of output.")
-
-;; FIXME: This should be a defcustom...
-(defvar mh-index-folder "+mhe-index"
- "Folder that contains the folders resulting from the index searches.")
-
-;; Temporary buffers for search results
-(defvar mh-index-temp-buffer " *mh-index-temp*")
-(defvar mh-checksum-buffer " *mh-checksum-buffer*")
-
-\f
-
-;;; A few different checksum programs are supported. The supported programs
-;;; are:
-;;; 1. md5sum
-;;; 2. md5
-;;; 3. openssl
-;;;
-;;; To add support for your favorite checksum program add a clause to the cond
-;;; statement in mh-checksum-choose. This should set the variable
-;;; mh-checksum-cmd to the command line needed to run the checsum program and
-;;; should set mh-checksum-parser to a function which returns a cons cell
-;;; containing the message number and checksum string.
-
-(defvar mh-checksum-cmd)
-(defvar mh-checksum-parser)
-
-(defun mh-checksum-choose ()
- "Check if a program to create a checksum is present."
- (unless (boundp 'mh-checksum-cmd)
- (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
- (cond ((executable-find "md5sum")
- (setq mh-checksum-cmd (list (executable-find "md5sum")))
- (setq mh-checksum-parser #'mh-md5sum-parser))
- ((executable-find "openssl")
- (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
- (setq mh-checksum-parser #'mh-openssl-parser))
- ((executable-find "md5")
- (setq mh-checksum-cmd (list (executable-find "md5")))
- (setq mh-checksum-parser #'mh-md5-parser))
- (t (error "No suitable checksum program"))))))
-
-(defun mh-md5sum-parser ()
- "Parse md5sum output."
- (let ((begin (line-beginning-position))
- (end (line-end-position))
- first-space last-slash)
- (setq first-space (search-forward " " end t))
- (goto-char end)
- (setq last-slash (search-backward "/" begin t))
- (cond ((and first-space last-slash)
- (cons (car (read-from-string (buffer-substring-no-properties
- (1+ last-slash) end)))
- (buffer-substring-no-properties begin (1- first-space))))
- (t (cons nil nil)))))
-
-(defun mh-openssl-parser ()
- "Parse openssl output."
- (let ((begin (line-beginning-position))
- (end (line-end-position))
- last-space last-slash)
- (goto-char end)
- (setq last-space (search-backward " " begin t))
- (setq last-slash (search-backward "/" begin t))
- (cond ((and last-slash last-space)
- (cons (car (read-from-string (buffer-substring-no-properties
- (1+ last-slash) (1- last-space))))
- (buffer-substring-no-properties (1+ last-space) end))))))
-
-(defalias 'mh-md5-parser 'mh-openssl-parser)
-
-\f
-
-;;; Make sure that we don't produce too long a command line.
-
-(defvar mh-index-max-cmdline-args 500
- "Maximum number of command line args.")
-
-(defun mh-index-execute (cmd &rest args)
- "Partial imitation of xargs.
-The current buffer contains a list of strings, one on each line. The function
-will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
-strings to it. This is repeated till all the strings have been used."
- (goto-char (point-min))
- (let ((out (get-buffer-create " *mh-xargs-output*")))
- (save-excursion
- (set-buffer out)
- (erase-buffer))
- (while (not (eobp))
- (let ((arg-list (reverse args))
- (count 0))
- (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
- (push (buffer-substring-no-properties (point) (line-end-position))
- arg-list)
- (incf count)
- (forward-line))
- (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
- (erase-buffer)
- (insert-buffer-substring out)))
-
-\f
-
-(defun mh-index-update-single-msg (msg checksum origin-map)
- "Update various maps for one message.
-MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
-non-nil, a hashtable containing which maps each message in the index folder to
-the folder and message that it was copied from. The function updates the hash
-tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
-
-This function should only be called in the appropriate index folder buffer."
- (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
- (let* ((intermediate (gethash msg origin-map))
- (ofolder (car intermediate))
- (omsg (cdr intermediate)))
- ;; This is most probably a duplicate. So eliminate it.
- (call-process "rm" nil nil nil
- (format "%s%s/%s" mh-user-path
- (substring mh-current-folder 1) msg))
- (remhash omsg (gethash ofolder mh-index-data))))
- (t
- (setf (gethash msg mh-index-msg-checksum-map) checksum)
- (when origin-map
- (setf (gethash checksum mh-index-checksum-origin-map)
- (gethash msg origin-map))))))
-
-;;;###mh-autoload
-(defun mh-index-update-maps (folder &optional origin-map)
- "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
-As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
-is a hashtable which maps each message in the index folder to the original
-folder and message from whence it was copied. If present the
-checksum -> (origin-folder, origin-index) map is updated too."
- (clrhash mh-index-msg-checksum-map)
- (save-excursion
- ;; Clear temp buffer
- (set-buffer (get-buffer-create mh-checksum-buffer))
- (erase-buffer)
- ;; Run scan to check if any messages needs MD5 annotations at all
- (with-temp-buffer
- (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
- "-format" "%(msg)\n%{x-mhe-checksum}\n"
- folder "all")
- (goto-char (point-min))
- (let (msg checksum)
- (while (not (eobp))
- (setq msg (buffer-substring-no-properties
- (point) (line-end-position)))
- (forward-line)
- (save-excursion
- (cond ((eolp)
- ;; need to compute checksum
- (set-buffer mh-checksum-buffer)
- (insert mh-user-path (substring folder 1) "/" msg "\n"))
- (t
- ;; update maps
- (setq checksum (buffer-substring-no-properties
- (point) (line-end-position)))
- (let ((msg (car (read-from-string msg))))
- (set-buffer folder)
- (mh-index-update-single-msg msg checksum origin-map)))))
- (forward-line))))
- ;; Run checksum program if needed
- (unless (and (eobp) (bobp))
- (apply #'mh-index-execute mh-checksum-cmd)
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((intermediate (funcall mh-checksum-parser))
- (msg (car intermediate))
- (checksum (cdr intermediate)))
- (when msg
- ;; annotate
- (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
- "-nodate" "-text" checksum "-inplace")
- ;; update maps
- (save-excursion
- (set-buffer folder)
- (mh-index-update-single-msg msg checksum origin-map)))
- (forward-line))))))
-
-(defun mh-index-generate-pretty-name (string)
- "Given STRING generate a name which is suitable for use as a folder name.
-White space from the beginning and end are removed. All spaces in the name are
-replaced with underscores and all / are replaced with $. If STRING is longer
-than 20 it is truncated too."
- (with-temp-buffer
- (insert string)
- (goto-char (point-min))
- (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r)))
- (delete-char 1))
- (goto-char (point-max))
- (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r)))
- (delete-backward-char 1))
- (subst-char-in-region (point-min) (point-max) ? ?_ t)
- (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
- (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
- (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
- (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
- (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
-
-;;;###mh-autoload
-(defun mh-index-search (redo-search-flag folder search-regexp)
- "Perform an indexed search in an MH mail folder.
-
-If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
-index search, then the search is repeated. Otherwise, FOLDER is searched with
-SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
-\"+\" then mail in all folders are searched.
-
-Four indexing programs are supported; if none of these are present, then grep
-is used. This function picks the first program that is available on your
-system. If you would prefer to use a different program, set the customization
-variable `mh-index-program' accordingly.
-
-The documentation for the following functions describes how to generate the
-index for each program:
-
- - `mh-swish++-execute-search'
- - `mh-swish-execute-search'
- - `mh-namazu-execute-search'
- - `mh-glimpse-execute-search'
-
-This and related functions use an X-MHE-Checksum header to cache the MD5
-checksum of a message. This means that already present X-MHE-Checksum headers
-in the incoming email could result in messages not being found. The following
-procmail recipe should avoid this:
-
- :0 wf
- | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
-
-This has the effect of renaming already present X-MHE-Checksum headers."
- (interactive
- (list current-prefix-arg
- (progn
- (unless mh-find-path-run (mh-find-path))
- (or (and current-prefix-arg (car mh-index-previous-search))
- (mh-prompt-for-folder "Search" "+" nil "all")))
- (progn
- ;; Yes, we do want to call mh-index-choose every time in case the
- ;; user has switched the indexer manually.
- (unless (mh-index-choose) (error "No indexing program found"))
- (or (and current-prefix-arg (cadr mh-index-previous-search))
- (read-string (format "%s regexp: "
- (upcase-initials
- (symbol-name mh-indexer))))))))
- (mh-checksum-choose)
- (let ((result-count 0)
- (old-window-config mh-previous-window-config)
- (previous-search mh-index-previous-search)
- (index-folder (format "%s/%s" mh-index-folder
- (mh-index-generate-pretty-name search-regexp))))
- ;; Create a new folder for the search results or recreate the old one...
- (if (and redo-search-flag mh-index-previous-search)
- (let ((buffer-name (buffer-name (current-buffer))))
- (mh-process-or-undo-commands buffer-name)
- (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
- (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
- (setq index-folder buffer-name))
- (setq index-folder (mh-index-new-folder index-folder)))
-
- (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
- (folder-results-map (make-hash-table :test #'equal))
- (origin-map (make-hash-table :test #'equal)))
- ;; Run search program...
- (message "Executing %s... " mh-indexer)
- (funcall mh-index-execute-search-function folder-path search-regexp)
-
- ;; Parse indexer output
- (message "Processing %s output... " mh-indexer)
- (goto-char (point-min))
- (loop for next-result = (funcall mh-index-next-result-function)
- when (null next-result) return nil
- do (unless (eq next-result 'error)
- (unless (gethash (car next-result) folder-results-map)
- (setf (gethash (car next-result) folder-results-map)
- (make-hash-table :test #'equal)))
- (setf (gethash (cadr next-result)
- (gethash (car next-result) folder-results-map))
- t)))
-
- ;; Copy the search results over
- (maphash #'(lambda (folder msgs)
- (let ((msgs (sort (loop for msg being the hash-keys of msgs
- collect msg)
- #'<)))
- (mh-exec-cmd "refile" msgs "-src" folder
- "-link" index-folder)
- (loop for msg in msgs
- do (incf result-count)
- (setf (gethash result-count origin-map)
- (cons folder msg)))))
- folder-results-map)
-
- ;; Generate scan lines for the hits.
- (let ((mh-show-threads-flag nil))
- (mh-visit-folder index-folder () (list folder-results-map origin-map)))
-
- (goto-char (point-min))
- (forward-line)
- (mh-update-sequences)
- (mh-recenter nil)
-
- ;; Maintain history
- (when (and redo-search-flag previous-search)
- (setq mh-previous-window-config old-window-config))
- (setq mh-index-previous-search (list folder search-regexp))
-
- (message "%s found %s matches in %s folders"
- (upcase-initials (symbol-name mh-indexer))
- (loop for msg-hash being hash-values of mh-index-data
- sum (hash-table-count msg-hash))
- (loop for msg-hash being hash-values of mh-index-data
- count (> (hash-table-count msg-hash) 0))))))
-
-;;;###mh-autoload
-(defun mh-index-next-folder (&optional backward-flag)
- "Jump to the next folder marker.
-The function is only applicable to folders displaying index search results.
-With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
-results."
- (interactive "P")
- (if (or (null mh-index-data)
- (memq 'unthread mh-view-ops))
- (message "Only applicable in an unthreaded MH-E index search buffer")
- (let ((point (point)))
- (forward-line (if backward-flag -1 1))
- (cond ((if backward-flag
- (re-search-backward "^+" (point-min) t)
- (re-search-forward "^+" (point-max) t))
- (beginning-of-line))
- ((and (if backward-flag
- (goto-char (point-max))
- (goto-char (point-min)))
- nil))
- ((if backward-flag
- (re-search-backward "^+" (point-min) t)
- (re-search-forward "^+" (point-max) t))
- (beginning-of-line))
- (t (goto-char point))))))
-
-;;;###mh-autoload
-(defun mh-index-previous-folder ()
- "Jump to the previous folder marker."
- (interactive)
- (mh-index-next-folder t))
-
-(defun mh-folder-exists-p (folder)
- "Check if FOLDER exists."
- (and (mh-folder-name-p folder)
- (save-excursion
- (with-temp-buffer
- (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
- (goto-char (point-min))
- (not (eobp))))))
-
-(defun mh-msg-exists-p (msg folder)
- "Check if MSG exists in FOLDER."
- (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
-
-(defun mh-index-new-folder (name)
- "Create and return an MH folder name based on NAME.
-If the folder NAME already exists then check if NAME<2> exists. If it doesn't
-then it is created and returned. Otherwise try NAME<3>. This is repeated till
-we find a new folder name."
- (unless (mh-folder-name-p name)
- (error "The argument should be a valid MH folder name"))
- (let ((chosen-name name))
- (block unique-name
- (unless (mh-folder-exists-p name)
- (return-from unique-name))
- (loop for index from 2
- do (let ((new-name (format "%s<%s>" name index)))
- (unless (mh-folder-exists-p new-name)
- (setq chosen-name new-name)
- (return-from unique-name)))))
- (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
- (when (boundp 'mh-speed-folder-map)
- (mh-speed-add-folder chosen-name))
- (push (list chosen-name) mh-folder-list)
- chosen-name))
-
-;;;###mh-autoload
-(defun mh-index-insert-folder-headers ()
- "Annotate the search results with original folder names."
- (let ((cur-msg (mh-get-msg-num nil))
- (old-buffer-modified-flag (buffer-modified-p))
- (buffer-read-only nil)
- current-folder last-folder)
- (goto-char (point-min))
- (while (not (eobp))
- (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
- mh-index-msg-checksum-map)
- mh-index-checksum-origin-map)))
- (when (and current-folder (not (eq current-folder last-folder)))
- (insert (if last-folder "\n" "") current-folder "\n")
- (setq last-folder current-folder))
- (forward-line))
- (when cur-msg (mh-goto-msg cur-msg t))
- (set-buffer-modified-p old-buffer-modified-flag)))
-
-;;;###mh-autoload
-(defun mh-index-delete-folder-headers ()
- "Delete the folder headers."
- (let ((cur-msg (mh-get-msg-num nil))
- (old-buffer-modified-flag (buffer-modified-p))
- (buffer-read-only nil))
- (goto-char (point-min))
- (while (not (eobp))
- (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
- (delete-region (point) (progn (forward-line) (point)))
- (forward-line)))
- (when cur-msg (mh-goto-msg cur-msg t t))
- (set-buffer-modified-p old-buffer-modified-flag)))
-
-;;;###mh-autoload
-(defun mh-index-visit-folder ()
- "Visit original folder from where the message at point was found."
- (interactive)
- (unless mh-index-data
- (error "Not in an index folder"))
- (let (folder msg)
- (save-excursion
- (cond ((and (bolp) (eolp))
- (ignore-errors (forward-line -1))
- (setq msg (mh-get-msg-num t)))
- ((equal (char-after (line-beginning-position)) ?+)
- (setq folder (buffer-substring-no-properties
- (line-beginning-position) (line-end-position))))
- (t (setq msg (mh-get-msg-num t)))))
- (when (not folder)
- (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
- mh-index-checksum-origin-map))))
- (mh-visit-folder
- folder (loop for x being the hash-keys of (gethash folder mh-index-data)
- when (mh-msg-exists-p x folder) collect x))))
-
-(defun mh-index-match-checksum (msg folder checksum)
- "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
- (with-temp-buffer
- (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
- "-format" "%{x-mhe-checksum}\n" folder msg)
- (goto-char (point-min))
- (string-equal (buffer-substring-no-properties (point) (line-end-position))
- checksum)))
-
-;;;###mh-autoload
-(defun mh-index-execute-commands ()
- "Delete/refile the actual messages.
-The copies in the searched folder are then deleted/refiled to get the desired
-result. Before deleting the messages we make sure that the message being
-deleted is identical to the one that the user has marked in the index buffer."
- (let ((message-table (make-hash-table :test #'equal)))
- (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
- (dolist (msg msg-list)
- (let* ((checksum (gethash msg mh-index-msg-checksum-map))
- (pair (gethash checksum mh-index-checksum-origin-map)))
- (when (and checksum (car pair) (cdr pair)
- (mh-index-match-checksum (cdr pair) (car pair) checksum))
- (push (cdr pair) (gethash (car pair) message-table))
- (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
- (maphash (lambda (folder msgs)
- (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
- message-table)))
-
-\f
-
-;; Glimpse interface
-
-(defvar mh-glimpse-binary (executable-find "glimpse"))
-(defvar mh-glimpse-directory ".glimpse")
-
-;;;###mh-autoload
-(defun mh-glimpse-execute-search (folder-path search-regexp)
- "Execute glimpse and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.glimpse. Then create the file
-/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
-
- */.*
- */#*
- */,*
- */*~
- ^/home/user/Mail/.glimpse
- ^/home/user/Mail/mhe-index
-
-If there are any directories you would like to ignore, append lines like the
-following to .glimpse_exclude:
-
- ^/home/user/Mail/scripts
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The configuration file above assumes that the results are found in sub-folders
-of `mh-index-folder' which is +mhe-index by default.
-
-Use the following command line to generate the glimpse index. Run this
-daily from cron:
-
- glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
- (set-buffer (get-buffer-create mh-index-temp-buffer))
- (erase-buffer)
- (call-process mh-glimpse-binary nil '(t nil) nil
- ;(format "-%s" fuzz)
- "-i" "-y"
- "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
- "-F" (format "^%s" folder-path)
- search-regexp)
- (goto-char (point-min)))
-
-(defun mh-glimpse-next-result ()
- "Read the next result.
-Parse it and return the message folder, message index and the match. If no
-other matches left then return nil. If the current record is invalid return
-'error."
- (prog1
- (block nil
- (when (eobp)
- (return nil))
- (let ((eol-pos (line-end-position))
- (bol-pos (line-beginning-position))
- folder-start msg-end)
- (goto-char bol-pos)
- (unless (search-forward mh-user-path eol-pos t)
- (return 'error))
- (setq folder-start (point))
- (unless (search-forward ": " eol-pos t)
- (return 'error))
- (let ((match (buffer-substring-no-properties (point) eol-pos)))
- (forward-char -2)
- (setq msg-end (point))
- (unless (search-backward "/" folder-start t)
- (return 'error))
- (list (format "+%s" (buffer-substring-no-properties
- folder-start (point)))
- (let ((val (ignore-errors (read-from-string
- (buffer-substring-no-properties
- (1+ (point)) msg-end)))))
- (if (and (consp val) (integerp (car val)))
- (car val)
- (return 'error)))
- match))))
- (forward-line)))
-
-\f
-
-;; Grep interface
-
-(defvar mh-grep-binary (executable-find "grep"))
-
-(defun mh-grep-execute-search (folder-path search-regexp)
- "Execute grep and read the results.
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
- (set-buffer (get-buffer-create mh-index-temp-buffer))
- (erase-buffer)
- (call-process mh-grep-binary nil '(t nil) nil
- "-i" "-r" search-regexp folder-path)
- (goto-char (point-min)))
-
-(defun mh-grep-next-result ()
- "Read the next result.
-Parse it and return the message folder, message index and the match. If no
-other matches left then return nil. If the current record is invalid return
-'error."
- (prog1
- (block nil
- (when (eobp)
- (return nil))
- (let ((eol-pos (line-end-position))
- (bol-pos (line-beginning-position))
- folder-start msg-end)
- (goto-char bol-pos)
- (unless (search-forward mh-user-path eol-pos t)
- (return 'error))
- (setq folder-start (point))
- (unless (search-forward ":" eol-pos t)
- (return 'error))
- (let ((match (buffer-substring-no-properties (point) eol-pos)))
- (forward-char -1)
- (setq msg-end (point))
- (unless (search-backward "/" folder-start t)
- (return 'error))
- (list (format "+%s" (buffer-substring-no-properties
- folder-start (point)))
- (let ((val (ignore-errors (read-from-string
- (buffer-substring-no-properties
- (1+ (point)) msg-end)))))
- (if (and (consp val) (integerp (car val)))
- (car val)
- (return 'error)))
- match))))
- (forward-line)))
-
-\f
-
-;; Swish interface
-
-(defvar mh-swish-binary (executable-find "swish-e"))
-(defvar mh-swish-directory ".swish")
-(defvar mh-swish-folder nil)
-
-;;;###mh-autoload
-(defun mh-swish-execute-search (folder-path search-regexp)
- "Execute swish-e and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.swish. Then create the file
-/home/user/Mail/.swish/config with the following contents:
-
- IndexDir /home/user/Mail
- IndexFile /home/user/Mail/.swish/index
- IndexName \"Mail Index\"
- IndexDescription \"Mail Index\"
- IndexPointer \"http://nowhere\"
- IndexAdmin \"nobody\"
- #MetaNames automatic
- IndexReport 3
- FollowSymLinks no
- UseStemming no
- IgnoreTotalWordCountWhenRanking yes
- WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
- BeginCharacters abcdefghijklmnopqrstuvwxyz
- EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
- IgnoreLimit 50 1000
- IndexComments 0
- FileRules pathname contains /home/user/Mail/.swish
- FileRules pathname contains /home/user/Mail/mhe-index
- FileRules filename is index
- FileRules filename is \..*
- FileRules filename is #.*
- FileRules filename is ,.*
- FileRules filename is .*~
-
-If there are any directories you would like to ignore, append lines like the
-following to config:
-
- FileRules pathname contains /home/user/Mail/scripts
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The configuration file above assumes that the results are found in sub-folders
-of `mh-index-folder' which is +mhe-index by default.
-
-Use the following command line to generate the swish index. Run this
-daily from cron:
-
- swish-e -c /home/user/Mail/.swish/config
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
- (set-buffer (get-buffer-create mh-index-temp-buffer))
- (erase-buffer)
- (unless mh-swish-binary
- (error "Set mh-swish-binary appropriately"))
- (call-process mh-swish-binary nil '(t nil) nil
- "-w" search-regexp
- "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
- (goto-char (point-min))
- (setq mh-swish-folder
- (let ((last-char (substring folder-path (1- (length folder-path)))))
- (if (equal last-char "/")
- folder-path
- (format "%s/" folder-path)))))
-
-(defun mh-swish-next-result ()
- "Get the next result from swish output."
- (prog1
- (block nil
- (when (or (eobp) (equal (char-after (point)) ?.))
- (return nil))
- (when (equal (char-after (point)) ?#)
- (return 'error))
- (let* ((start (search-forward " " (line-end-position) t))
- (end (search-forward " " (line-end-position) t)))
- (unless (and start end)
- (return 'error))
- (setq end (1- end))
- (unless (file-exists-p (buffer-substring-no-properties start end))
- (return 'error))
- (unless (search-backward "/" start t)
- (return 'error))
- (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
- (unless (string-match mh-swish-folder s)
- (return 'error))
- (if (string-match mh-user-path s)
- (format "+%s"
- (substring s (match-end 0) (1- (length s))))
- (return 'error)))
- (let* ((s (buffer-substring-no-properties (1+ (point)) end))
- (val (ignore-errors (read-from-string s))))
- (if (and (consp val) (numberp (car val)))
- (car val)
- (return 'error)))
- nil)))
- (forward-line)))
-
-\f
-
-;; Swish++ interface
-
-(defvar mh-swish++-binary (or (executable-find "search++")
- (executable-find "search")))
-(defvar mh-swish++-directory ".swish++")
-
-;;;###mh-autoload
-(defun mh-swish++-execute-search (folder-path search-regexp)
- "Execute swish++ and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.swish++. Then create the file
-/home/user/Mail/.swish++/swish++.conf with the following contents:
-
- IncludeMeta Bcc Cc Comments Content-Description From Keywords
- IncludeMeta Newsgroups Resent-To Subject To
- IncludeMeta Message-Id References In-Reply-To
- IncludeFile Mail *
- IndexFile /home/user/Mail/.swish++/swish++.index
-
-Use the following command line to generate the swish index. Run this
-daily from cron:
-
- find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
- -o -path /home/user/Mail/.swish++ -prune \\
- -o -name \"[0-9]*\" -print \\
- | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The command above assumes that the results are found in sub-folders of
-`mh-index-folder' which is +mhe-index by default.
-
-On some systems (Debian GNU/Linux, for example), use index++ instead of index.
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
- (set-buffer (get-buffer-create mh-index-temp-buffer))
- (erase-buffer)
- (unless mh-swish++-binary
- (error "Set mh-swish++-binary appropriately"))
- (call-process mh-swish++-binary nil '(t nil) nil
- "-m" "10000"
- (format "-i%s%s/swish++.index"
- mh-user-path mh-swish++-directory)
- search-regexp)
- (goto-char (point-min))
- (setq mh-swish-folder
- (let ((last-char (substring folder-path (1- (length folder-path)))))
- (if (equal last-char "/")
- folder-path
- (format "%s/" folder-path)))))
-
-(defalias 'mh-swish++-next-result 'mh-swish-next-result)
-
-\f
-
-;; Namazu interface
-
-(defvar mh-namazu-binary (executable-find "namazu"))
-(defvar mh-namazu-directory ".namazu")
-(defvar mh-namazu-folder nil)
-
-;;;###mh-autoload
-(defun mh-namazu-execute-search (folder-path search-regexp)
- "Execute namazu and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.namazu. Then create the file
-/home/user/Mail/.namazu/mknmzrc with the following contents:
-
- package conf; # Don't remove this line!
- $ADDRESS = 'user@localhost';
- $ALLOW_FILE = \"[0-9]*\";
- $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
-
-In the above example configuration, none of the mail files contained in the
-directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The configuration file above assumes that the results are found in sub-folders
-of `mh-index-folder' which is +mhe-index by default.
-
-Use the following command line to generate the namazu index. Run this
-daily from cron:
-
- mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
- /home/user/Mail
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
- (let ((namazu-index-directory
- (format "%s%s" mh-user-path mh-namazu-directory)))
- (unless (file-exists-p namazu-index-directory)
- (error "Namazu directory %s not present" namazu-index-directory))
- (unless (executable-find mh-namazu-binary)
- (error "Set mh-namazu-binary appropriately"))
- (set-buffer (get-buffer-create mh-index-temp-buffer))
- (erase-buffer)
- (call-process mh-namazu-binary nil '(t nil) nil
- "-alR" search-regexp namazu-index-directory)
- (goto-char (point-min))
- (setq mh-namazu-folder
- (let ((last (substring folder-path (1- (length folder-path)))))
- (if (equal last "/")
- folder-path
- (format "%s/" folder-path))))))
-
-(defun mh-namazu-next-result ()
- "Get the next result from namazu output."
- (prog1
- (block nil
- (when (eobp) (return nil))
- (let ((file-name (buffer-substring-no-properties
- (point) (line-end-position))))
- (unless (equal (string-match mh-namazu-folder file-name) 0)
- (return 'error))
- (unless (file-exists-p file-name)
- (return 'error))
- (string-match mh-user-path file-name)
- (let* ((folder/msg (substring file-name (match-end 0)))
- (mark (mh-search-from-end ?/ folder/msg)))
- (unless mark (return 'error))
- (list (format "+%s" (substring folder/msg 0 mark))
- (let ((n (ignore-errors (read-from-string
- (substring folder/msg (1+ mark))))))
- (if (and (consp n) (numberp (car n)))
- (car n)
- (return 'error)))
- nil))))
- (forward-line)))
-
-\f
-
-(defun mh-index-choose ()
- "Choose an indexing function.
-The side-effects of this function are that the variables `mh-indexer',
-`mh-index-execute-search-function', and `mh-index-next-result-function' are
-set according to the first indexer in `mh-indexer-choices' present on the
-system."
- (block nil
- ;; The following favors the user's preference; otherwise, the last
- ;; automatically chosen indexer is used for efficiency rather than going
- ;; through the list.
- (let ((program-alist (cond (mh-index-program
- (list
- (assoc mh-index-program mh-indexer-choices)))
- (mh-indexer
- (list (assoc mh-indexer mh-indexer-choices)))
- (t mh-indexer-choices))))
- (while program-alist
- (let* ((current (pop program-alist))
- (executable (symbol-value (cadr current))))
- (when executable
- (setq mh-indexer (car current))
- (setq mh-index-execute-search-function (caddr current))
- (setq mh-index-next-result-function (cadddr current))
- (return mh-indexer))))
- nil)))
-
-\f
-
-(provide 'mh-index)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-index ends here
+++ /dev/null
-;;; mh-loaddefs.el --- automatically extracted autoloads
-;;
-;;; Commentary:
-;;; Code:
-\f
-;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
-;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom
-;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
-;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
-;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
-;;;;;; (15899 19356))
-;;; Generated autoloads from mh-comp.el
-
-(autoload (quote mh-edit-again) "mh-comp" "\
-Clean up a draft or a message MSG previously sent and make it resendable.
-Default is the current message.
-The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
-See also documentation for `\\[mh-send]' function." t nil)
-
-(autoload (quote mh-extract-rejected-mail) "mh-comp" "\
-Extract message MSG returned by the mail system and make it resendable.
-Default is the current message. The variable `mh-new-draft-cleaned-headers'
-gives the headers to clean out of the original message.
-See also documentation for `\\[mh-send]' function." t nil)
-
-(autoload (quote mh-forward) "mh-comp" "\
-Forward one or more messages to the recipients TO and CC.
-
-Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
-
-Default is the displayed message. If optional prefix argument is given then
-prompt for the message sequence. If variable `transient-mark-mode' is non-nil
-and the mark is active, then the selected region is forwarded.
-See also documentation for `\\[mh-send]' function." t nil)
-
-(autoload (quote mh-redistribute) "mh-comp" "\
-Redistribute displayed message to recipients TO and CC.
-Use optional argument MSG to redistribute another message.
-Depending on how your copy of MH was compiled, you may need to change the
-setting of the variable `mh-redist-full-contents'. See its documentation." t nil)
-
-(autoload (quote mh-reply) "mh-comp" "\
-Reply to MESSAGE (default: current message).
-If the optional argument REPLY-TO is not given, prompts for type of addresses
-to reply to:
- from sender only,
- to sender and primary recipients,
- cc/all sender and all recipients.
-If optional prefix argument INCLUDEP provided, then include the message
-in the reply using filter `mhl.reply' in your MH directory.
-If the file named by `mh-repl-formfile' exists, it is used as a skeleton
-for the reply. See also documentation for `\\[mh-send]' function." t nil)
-
-(autoload (quote mh-send) "mh-comp" "\
-Compose and send a letter.
-
-Do not call this function from outside MH-E; use \\[mh-smail] instead.
-
-The file named by `mh-comp-formfile' will be used as the form.
-The letter is composed in `mh-letter-mode'; see its documentation for more
-details.
-If `mh-compose-letter-function' is defined, it is called on the draft and
-passed three arguments: TO, CC, and SUBJECT." t nil)
-
-(autoload (quote mh-send-other-window) "mh-comp" "\
-Compose and send a letter in another window.
-
-Do not call this function from outside MH-E; use \\[mh-smail-other-window]
-instead.
-
-The file named by `mh-comp-formfile' will be used as the form.
-The letter is composed in `mh-letter-mode'; see its documentation for more
-details.
-If `mh-compose-letter-function' is defined, it is called on the draft and
-passed three arguments: TO, CC, and SUBJECT." t nil)
-
-(autoload (quote mh-fill-paragraph-function) "mh-comp" "\
-Fill paragraph at or after point.
-Prefix ARG means justify as well. This function enables `fill-paragraph' to
-work better in MH-Letter mode." t nil)
-
-(autoload (quote mh-to-field) "mh-comp" "\
-Move point to the end of a specified header field.
-The field is indicated by the previous keystroke (the last keystroke
-of the command) according to the list in the variable `mh-to-field-choices'.
-Create the field if it does not exist. Set the mark to point before moving." t nil)
-
-(autoload (quote mh-to-fcc) "mh-comp" "\
-Insert an Fcc: FOLDER field in the current message.
-Prompt for the field name with a completion list of the current folders." t nil)
-
-(autoload (quote mh-insert-signature) "mh-comp" "\
-Insert the file named by `mh-signature-file-name' at point.
-The value of `mh-letter-insert-signature-hook' is a list of functions to be
-called, with no arguments, before the signature is actually inserted." t nil)
-
-(autoload (quote mh-check-whom) "mh-comp" "\
-Verify recipients of the current letter, showing expansion of any aliases." t nil)
-
-(autoload (quote mh-send-letter) "mh-comp" "\
-Send the draft letter in the current buffer.
-If optional prefix argument ARG is provided, monitor delivery.
-The value of `mh-before-send-letter-hook' is a list of functions to be called,
-with no arguments, before doing anything.
-Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
-Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
-Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
-Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil)
-
-(autoload (quote mh-insert-letter) "mh-comp" "\
-Insert a message into the current letter.
-Removes the header fields according to the variable `mh-invisible-headers'.
-Prefixes each non-blank line with `mh-ins-buf-prefix', unless
-`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
-used to format the message.
-Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
-not indent and do not delete headers. Leaves the mark before the letter
-and point after it." t nil)
-
-(autoload (quote mh-yank-cur-msg) "mh-comp" "\
-Insert the current message into the draft buffer.
-Prefix each non-blank line in the message with the string in
-`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
-only the region will be inserted. Otherwise, the entire message will
-be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
-is nil, the portion of the message following the point will be yanked.
-If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
-yanked message will be deleted." t nil)
-
-(autoload (quote mh-fully-kill-draft) "mh-comp" "\
-Kill the draft message file and the draft message buffer.
-Use \\[kill-buffer] if you don't want to delete the draft message file." t nil)
-
-(autoload (quote mh-open-line) "mh-comp" "\
-Insert a newline and leave point after it.
-In addition, insert newline and quoting characters before text after point.
-This is useful in breaking up paragraphs in replies." t nil)
-
-(autoload (quote mh-letter-complete) "mh-comp" "\
-Perform completion on header field or word preceding point.
-Alias completion is done within the mail header on selected fields and
-by the function designated by `mh-letter-complete-function' elsewhere,
-passing the prefix ARG if any." t nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set
-;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15899 29873))
-;;; Generated autoloads from mh-customize.el
-
-(autoload (quote mh-customize) "mh-customize" "\
-Customize MH-E variables." t nil)
-
-(autoload (quote mh-tool-bar-letter-set) "mh-customize" "\
-Construct toolbar for `mh-letter-mode'." nil nil)
-
-(autoload (quote mh-tool-bar-folder-set) "mh-customize" "\
-Construct toolbar for `mh-folder-mode'." nil nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
-;;;;;; "mh-e" "mh-e.el" (15899 29921))
-;;; Generated autoloads from mh-e.el
-
-(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
-Return t if the message under point in folder-mode is in the show buffer.
-Return nil in any other circumstance (no message under point, no show buffer,
-the message in the show buffer doesn't match." nil nil)
-
-(autoload (quote mh-update-sequences) "mh-e" "\
-Update MH's Unseen-Sequence and current folder and message.
-Flush MH-E's state out to MH. The message at the cursor becomes current." t nil)
-
-(autoload (quote mh-goto-cur-msg) "mh-e" "\
-Position the cursor at the current message.
-When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
-recenter the folder buffer." nil nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-prefix-help mh-help mh-store-buffer mh-store-msg
-;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
-;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
-;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
-;;;;;; (15886 19303))
-;;; Generated autoloads from mh-funcs.el
-
-(autoload (quote mh-burst-digest) "mh-funcs" "\
-Burst apart the current message, which should be a digest.
-The message is replaced by its table of contents and the messages from the
-digest are inserted into the folder after that message." t nil)
-
-(autoload (quote mh-copy-msg) "mh-funcs" "\
-Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
-Default is the displayed message. If optional prefix argument is provided,
-then prompt for the message sequence." t nil)
-
-(autoload (quote mh-kill-folder) "mh-funcs" "\
-Remove the current folder and all included messages.
-Removes all of the messages (files) within the specified current folder,
-and then removes the folder (directory) itself.
-The value of `mh-folder-list-change-hook' is a list of functions to be called,
-with no arguments, after the folders has been removed." t nil)
-
-(autoload (quote mh-list-folders) "mh-funcs" "\
-List mail folders." t nil)
-
-(autoload (quote mh-pack-folder) "mh-funcs" "\
-Renumber the messages of a folder to be 1..n.
-First, offer to execute any outstanding commands for the current folder. If
-optional prefix argument provided, prompt for the RANGE of messages to display
-after packing. Otherwise, show the entire folder." t nil)
-
-(autoload (quote mh-pipe-msg) "mh-funcs" "\
-Pipe the current message through the given shell COMMAND.
-If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
-Otherwise just send the message's body without the headers." t nil)
-
-(autoload (quote mh-page-digest) "mh-funcs" "\
-Advance displayed message to next digested message." t nil)
-
-(autoload (quote mh-page-digest-backwards) "mh-funcs" "\
-Back up displayed message to previous digested message." t nil)
-
-(autoload (quote mh-print-msg) "mh-funcs" "\
-Print MSG-OR-SEQ (default: displayed message) on printer.
-If optional prefix argument provided, then prompt for the message sequence.
-The variable `mh-lpr-command-format' is used to generate the print command.
-The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
-
-(autoload (quote mh-sort-folder) "mh-funcs" "\
-Sort the messages in the current folder by date.
-Calls the MH program sortm to do the work.
-The arguments in the list `mh-sortm-args' are passed to sortm if the optional
-argument EXTRA-ARGS is given." t nil)
-
-(autoload (quote mh-undo-folder) "mh-funcs" "\
-Undo all pending deletes and refiles in current folder.
-Argument IGNORE is deprecated." t nil)
-
-(autoload (quote mh-store-msg) "mh-funcs" "\
-Store the file(s) contained in the current message into DIRECTORY.
-The message can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory." t nil)
-
-(autoload (quote mh-store-buffer) "mh-funcs" "\
-Store the file(s) contained in the current buffer into DIRECTORY.
-The buffer can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory." t nil)
-
-(autoload (quote mh-help) "mh-funcs" "\
-Display cheat sheet for the MH-Folder commands in minibuffer." t nil)
-
-(autoload (quote mh-prefix-help) "mh-funcs" "\
-Display cheat sheet for the commands of the current prefix in minibuffer." t nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
-;;;;;; "mh-identity" "mh-identity.el" (15852 60439))
-;;; Generated autoloads from mh-identity.el
-
-(autoload (quote mh-identity-make-menu) "mh-identity" "\
-Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil)
-
-(autoload (quote mh-identity-list-set) "mh-identity" "\
-Update the `mh-identity-list' variable, and rebuild the menu.
-Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
-customization). This is called after 'customize is used to alter
-`mh-identity-list'." nil nil)
-
-(autoload (quote mh-insert-identity) "mh-identity" "\
-Insert proper fields for given IDENTITY.
-Edit the `mh-identity-list' variable to define identity." t nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search
-;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands
-;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers
-;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-search
-;;;;;; mh-index-update-maps) "mh-index" "mh-index.el" (15899 19358))
-;;; Generated autoloads from mh-index.el
-
-(autoload (quote mh-index-update-maps) "mh-index" "\
-Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
-As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
-is a hashtable which maps each message in the index folder to the original
-folder and message from whence it was copied. If present the
-checksum -> (origin-folder, origin-index) map is updated too." nil nil)
-
-(autoload (quote mh-index-search) "mh-index" "\
-Perform an indexed search in an MH mail folder.
-
-If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
-index search, then the search is repeated. Otherwise, FOLDER is searched with
-SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
-\"+\" then mail in all folders are searched.
-
-Four indexing programs are supported; if none of these are present, then grep
-is used. This function picks the first program that is available on your
-system. If you would prefer to use a different program, set the customization
-variable `mh-index-program' accordingly.
-
-The documentation for the following functions describes how to generate the
-index for each program:
-
- - `mh-swish++-execute-search'
- - `mh-swish-execute-search'
- - `mh-namazu-execute-search'
- - `mh-glimpse-execute-search'
-
-This and related functions use an X-MHE-Checksum header to cache the MD5
-checksum of a message. This means that already present X-MHE-Checksum headers
-in the incoming email could result in messages not being found. The following
-procmail recipe should avoid this:
-
- :0 wf
- | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
-
-This has the effect of renaming already present X-MHE-Checksum headers." t nil)
-
-(autoload (quote mh-index-next-folder) "mh-index" "\
-Jump to the next folder marker.
-The function is only applicable to folders displaying index search results.
-With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
-results." t nil)
-
-(autoload (quote mh-index-previous-folder) "mh-index" "\
-Jump to the previous folder marker." t nil)
-
-(autoload (quote mh-index-insert-folder-headers) "mh-index" "\
-Annotate the search results with original folder names." nil nil)
-
-(autoload (quote mh-index-delete-folder-headers) "mh-index" "\
-Delete the folder headers." nil nil)
-
-(autoload (quote mh-index-visit-folder) "mh-index" "\
-Visit original folder from where the message at point was found." t nil)
-
-(autoload (quote mh-index-execute-commands) "mh-index" "\
-Delete/refile the actual messages.
-The copies in the searched folder are then deleted/refiled to get the desired
-result. Before deleting the messages we make sure that the message being
-deleted is identical to the one that the user has marked in the index buffer." nil nil)
-
-(autoload (quote mh-glimpse-execute-search) "mh-index" "\
-Execute glimpse and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.glimpse. Then create the file
-/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
-
- */.*
- */#*
- */,*
- */*~
- ^/home/user/Mail/.glimpse
- ^/home/user/Mail/mhe-index
-
-If there are any directories you would like to ignore, append lines like the
-following to .glimpse_exclude:
-
- ^/home/user/Mail/scripts
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The configuration file above assumes that the results are found in sub-folders
-of `mh-index-folder' which is +mhe-index by default.
-
-Use the following command line to generate the glimpse index. Run this
-daily from cron:
-
- glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
-
-(autoload (quote mh-swish-execute-search) "mh-index" "\
-Execute swish-e and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.swish. Then create the file
-/home/user/Mail/.swish/config with the following contents:
-
- IndexDir /home/user/Mail
- IndexFile /home/user/Mail/.swish/index
- IndexName \"Mail Index\"
- IndexDescription \"Mail Index\"
- IndexPointer \"http://nowhere\"
- IndexAdmin \"nobody\"
- #MetaNames automatic
- IndexReport 3
- FollowSymLinks no
- UseStemming no
- IgnoreTotalWordCountWhenRanking yes
- WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
- BeginCharacters abcdefghijklmnopqrstuvwxyz
- EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
- IgnoreLimit 50 1000
- IndexComments 0
- FileRules pathname contains /home/user/Mail/.swish
- FileRules pathname contains /home/user/Mail/mhe-index
- FileRules filename is index
- FileRules filename is ..*
- FileRules filename is #.*
- FileRules filename is ,.*
- FileRules filename is .*~
-
-If there are any directories you would like to ignore, append lines like the
-following to config:
-
- FileRules pathname contains /home/user/Mail/scripts
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The configuration file above assumes that the results are found in sub-folders
-of `mh-index-folder' which is +mhe-index by default.
-
-Use the following command line to generate the swish index. Run this
-daily from cron:
-
- swish-e -c /home/user/Mail/.swish/config
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
-
-(autoload (quote mh-swish++-execute-search) "mh-index" "\
-Execute swish++ and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.swish++. Then create the file
-/home/user/Mail/.swish++/swish++.conf with the following contents:
-
- IncludeMeta Bcc Cc Comments Content-Description From Keywords
- IncludeMeta Newsgroups Resent-To Subject To
- IncludeMeta Message-Id References In-Reply-To
- IncludeFile Mail *
- IndexFile /home/user/Mail/.swish++/swish++.index
-
-Use the following command line to generate the swish index. Run this
-daily from cron:
-
- find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
- -o -path /home/user/Mail/.swish++ -prune \\
- -o -name \"[0-9]*\" -print \\
- | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The command above assumes that the results are found in sub-folders of
-`mh-index-folder' which is +mhe-index by default.
-
-On some systems (Debian GNU/Linux, for example), use index++ instead of index.
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
-
-(autoload (quote mh-namazu-execute-search) "mh-index" "\
-Execute namazu and read the results.
-
-In the examples below, replace /home/user/Mail with the path to your MH
-directory.
-
-First create the directory /home/user/Mail/.namazu. Then create the file
-/home/user/Mail/.namazu/mknmzrc with the following contents:
-
- package conf; # Don't remove this line!
- $ADDRESS = 'user@localhost';
- $ALLOW_FILE = \"[0-9]*\";
- $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
-
-In the above example configuration, none of the mail files contained in the
-directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
-
-You do not want to index the folders that hold the results of your searches
-since they tend to be ephemeral and the original messages are indexed anyway.
-The configuration file above assumes that the results are found in sub-folders
-of `mh-index-folder' which is +mhe-index by default.
-
-Use the following command line to generate the namazu index. Run this
-daily from cron:
-
- mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
- /home/user/Mail
-
-FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
-;;;;;; mh-press-button mh-mime-display mh-mime-save-parts mh-display-emphasis
-;;;;;; mh-display-smileys mh-add-missing-mime-version-header mh-destroy-postponed-handles
-;;;;;; mh-mime-cleanup mh-mml-secure-message-encrypt-pgpmime mh-mml-secure-message-sign-pgpmime
-;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime
-;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
-;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
-;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15858 6046))
-;;; Generated autoloads from mh-mime.el
-
-(autoload (quote mh-compose-insertion) "mh-mime" "\
-Add a directive to insert a MIME part from a file, using mhn or gnus.
-If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
-If it is set to 'gnus, then that will be used instead.
-Optional argument INLINE means make it an inline attachment." t nil)
-
-(autoload (quote mh-compose-forward) "mh-mime" "\
-Add a MIME directive to forward a message, using mhn or gnus.
-If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
-If it is set to 'gnus, then that will be used instead.
-Optional argument DESCRIPTION is a description of the attachment.
-Optional argument FOLDER is the folder from which the forwarded message should
-come.
-Optional argument MESSAGE is the message to forward.
-If any of the optional arguments are absent, they are prompted for." t nil)
-
-(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\
-Add a directive to insert a MIME message part from a file.
-This is the typical way to insert non-text parts in a message.
-
-Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
-content type, DESCRIPTION, a line of text for the Content-Description field.
-ATTRIBUTES is a comma separated list of name=value pairs that is appended to
-the Content-Type field of the attachment.
-
-See also \\[mh-edit-mhn]." t nil)
-
-(autoload (quote mh-mhn-compose-anon-ftp) "mh-mime" "\
-Add a directive for a MIME anonymous ftp external body part.
-This directive tells MH to include a reference to a message/external-body part
-retrievable by anonymous FTP.
-
-Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
-MIME content type, and DESCRIPTION, a line of text for the Content-description
-header.
-
-See also \\[mh-edit-mhn]." t nil)
-
-(autoload (quote mh-mhn-compose-external-compressed-tar) "mh-mime" "\
-Add a directive to include a MIME reference to a compressed tar file.
-The file should be available via anonymous ftp. This directive tells MH to
-include a reference to a message/external-body part.
-
-Arguments are HOST and FILENAME, which tell where to find the file, and
-DESCRIPTION, a line of text for the Content-description header.
-
-See also \\[mh-edit-mhn]." t nil)
-
-(autoload (quote mh-mhn-compose-forw) "mh-mime" "\
-Add a forw directive to this message, to forward a message with MIME.
-This directive tells MH to include the named messages in this one.
-
-Arguments are DESCRIPTION, a line of text for the Content-description header,
-and FOLDER and MESSAGES, which name the message(s) to be forwarded.
-
-See also \\[mh-edit-mhn]." t nil)
-
-(autoload (quote mh-edit-mhn) "mh-mime" "\
-Format the current draft for MIME, expanding any mhn directives.
-
-Process the current draft with the mhn program, which, using directives
-already inserted in the draft, fills in all the MIME components and header
-fields.
-
-This step should be done last just before sending the message.
-
-The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
-list `mh-mhn-args' are passed to mhn if this function is passed an optional
-prefix argument EXTRA-ARGS.
-
-For assistance with creating mhn directives to insert various types of
-components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
-from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
-anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] (reference to
-compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
-message). If these helper functions are used, `mh-edit-mhn' is run
-automatically when the draft is sent.
-
-The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
-arguments, after performing the conversion.
-
-The mhn program is part of MH version 6.8 or later." t nil)
-
-(autoload (quote mh-revert-mhn-edit) "mh-mime" "\
-Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
-Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil)
-
-(autoload (quote mh-mml-to-mime) "mh-mime" "\
-Compose MIME message from mml directives." t nil)
-
-(autoload (quote mh-mml-forward-message) "mh-mime" "\
-Forward a message as attachment.
-The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
-number." nil nil)
-
-(autoload (quote mh-mml-attach-file) "mh-mime" "\
-Attach a file to the outgoing MIME message.
-The file is not inserted or encoded until you send the message with
-`\\[mh-send-letter]'.
-Message disposition is \"inline\" or \"attachment\" and is prompted for if
-DISPOSITION is nil.
-
-This is basically `mml-attach-file' from gnus, modified such that a prefix
-argument yields an `inline' disposition and Content-Type is determined
-automatically." nil nil)
-
-(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\
-Add directive to encrypt/sign the entire message." t nil)
-
-(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\
-Add directive to encrypt and sign the entire message.
-If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil)
-
-(autoload (quote mh-mime-cleanup) "mh-mime" "\
-Free the decoded MIME parts." nil nil)
-
-(autoload (quote mh-destroy-postponed-handles) "mh-mime" "\
-Free MIME data for externally displayed mime parts." nil nil)
-
-(autoload (quote mh-add-missing-mime-version-header) "mh-mime" "\
-Some mail programs don't put a MIME-Version header.
-I have seen this only in spam, so maybe we shouldn't fix this ;-)" nil nil)
-
-(autoload (quote mh-display-smileys) "mh-mime" "\
-Function to display smileys." nil nil)
-
-(autoload (quote mh-display-emphasis) "mh-mime" "\
-Function to display graphical emphasis." nil nil)
-
-(autoload (quote mh-mime-save-parts) "mh-mime" "\
-Store the MIME parts of the current message.
-If ARG, prompt for directory, else use that specified by the variable
-`mh-mime-save-parts-default-directory'. These directories may be superseded by
-mh_profile directives, since this function calls on mhstore or mhn to do the
-actual storing." t nil)
-
-(autoload (quote mh-mime-display) "mh-mime" "\
-Display (and possibly decode) MIME handles.
-Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
-present they are displayed otherwise the buffer is parsed and then
-displayed." nil nil)
-
-(autoload (quote mh-press-button) "mh-mime" "\
-Press MIME button.
-If the MIME part is visible then it is removed. Otherwise the part is
-displayed." t nil)
-
-(autoload (quote mh-push-button) "mh-mime" "\
-Click MIME button for EVENT.
-If the MIME part is visible then it is removed. Otherwise the part is
-displayed. This function is called when the mouse is used to click the MIME
-button." t nil)
-
-(autoload (quote mh-mime-save-part) "mh-mime" "\
-Save MIME part at point." t nil)
-
-(autoload (quote mh-mime-inline-part) "mh-mime" "\
-Toggle display of the raw MIME part." t nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-do-pick-search mh-search-folder) "mh-pick"
-;;;;;; "mh-pick.el" (15854 20166))
-;;; Generated autoloads from mh-pick.el
-
-(autoload (quote mh-search-folder) "mh-pick" "\
-Search FOLDER for messages matching a pattern.
-This function uses the MH command `pick' to do the work.
-Add the messages found to the sequence named `search'." t nil)
-
-(autoload (quote mh-do-pick-search) "mh-pick" "\
-Find messages that match the qualifications in the current pattern buffer.
-Messages are searched for in the folder named in `mh-searching-folder'.
-Add the messages found to the sequence named `search'." t nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor
-;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message
-;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
-;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list
-;;;;;; mh-add-to-sequence mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
-;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
-;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (15899
-;;;;;; 19358))
-;;; Generated autoloads from mh-seq.el
-
-(autoload (quote mh-delete-seq) "mh-seq" "\
-Delete the SEQUENCE." t nil)
-
-(autoload (quote mh-list-sequences) "mh-seq" "\
-List the sequences defined in the folder being visited." t nil)
-
-(autoload (quote mh-msg-is-in-seq) "mh-seq" "\
-Display the sequences that contain MESSAGE (default: current message)." t nil)
-
-(autoload (quote mh-narrow-to-seq) "mh-seq" "\
-Restrict display of this folder to just messages in SEQUENCE.
-Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
-
-(autoload (quote mh-put-msg-in-seq) "mh-seq" "\
-Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
-If optional prefix argument provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then
-the selected region is added to the sequence." t nil)
-
-(autoload (quote mh-widen) "mh-seq" "\
-Remove restrictions from current folder, thereby showing all messages." t nil)
-
-(autoload (quote mh-rename-seq) "mh-seq" "\
-Rename SEQUENCE to have NEW-NAME." t nil)
-
-(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\
-Invoke the FUNC at each message in the SEQ.
-SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
-passed as arguments to FUNC." nil nil)
-
-(autoload (quote mh-notate-seq) "mh-seq" "\
-Mark the scan listing.
-All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
-the line." nil nil)
-
-(autoload (quote mh-add-to-sequence) "mh-seq" "\
-The sequence SEQ is augmented with the messages in MSGS." nil nil)
-
-(autoload (quote mh-region-to-msg-list) "mh-seq" "\
-Return a list of messages within the region between BEGIN and END." nil nil)
-
-(autoload (quote mh-narrow-to-subject) "mh-seq" "\
-Narrow to a sequence containing all following messages with same subject." t nil)
-
-(autoload (quote mh-delete-subject) "mh-seq" "\
-Mark all following messages with same subject to be deleted.
-This puts the messages in a sequence named subject. You can undo the last
-deletion marks using `mh-undo' with a prefix argument and then specifying the
-subject sequence." t nil)
-
-(autoload (quote mh-delete-subject-or-thread) "mh-seq" "\
-Mark messages for deletion intelligently.
-If the folder is threaded then `mh-thread-delete' is used to mark the current
-message and all its descendants for deletion. Otherwise `mh-delete-subject' is
-used to mark the current message and all messages following it with the same
-subject for deletion." t nil)
-
-(autoload (quote mh-thread-inc) "mh-seq" "\
-Update thread tree for FOLDER.
-All messages after START-POINT are added to the thread tree." nil nil)
-
-(autoload (quote mh-thread-add-spaces) "mh-seq" "\
-Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
-
-(autoload (quote mh-toggle-threads) "mh-seq" "\
-Toggle threaded view of folder.
-The conversion of normal view to threaded view is exact, that is the same
-messages are displayed in the folder buffer before and after threading. However
-the conversion from threaded view to normal view is inexact. So more messages
-than were originally present may be shown as a result." t nil)
-
-(autoload (quote mh-thread-forget-message) "mh-seq" "\
-Forget the message INDEX from the threading tables." nil nil)
-
-(autoload (quote mh-thread-next-sibling) "mh-seq" "\
-Jump to next sibling.
-With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." t nil)
-
-(autoload (quote mh-thread-previous-sibling) "mh-seq" "\
-Jump to previous sibling." t nil)
-
-(autoload (quote mh-thread-ancestor) "mh-seq" "\
-Jump to the ancestor of current message.
-If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
-thread tree the message belongs to." t nil)
-
-(autoload (quote mh-thread-delete) "mh-seq" "\
-Mark current message and all its children for subsequent deletion." t nil)
-
-(autoload (quote mh-thread-refile) "mh-seq" "\
-Mark current message and all its children for refiling to FOLDER." t nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
-;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
-;;;;;; "mh-speed" "mh-speed.el" (15899 19358))
-;;; Generated autoloads from mh-speed.el
-
-(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
-Interface function to create MH-E speedbar buffer.
-BUFFER is the MH-E buffer for which the speedbar buffer is to be created." nil nil)
-
-(defalias (quote mh-show-speedbar-buttons) (quote mh-folder-speedbar-buttons))
-
-(defalias (quote mh-letter-speedbar-buttons) (quote mh-folder-speedbar-buttons))
-
-(autoload (quote mh-speed-toggle) "mh-speed" "\
-Toggle the display of child folders.
-The otional ARGS are ignored and there for compatibilty with speedbar." t nil)
-
-(autoload (quote mh-speed-view) "mh-speed" "\
-View folder on current line.
-Optional ARGS are ignored." t nil)
-
-(autoload (quote mh-speed-flists) "mh-speed" "\
-Execute flists -recurse and update message counts.
-If FORCE is non-nil the timer is reset." t nil)
-
-(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
-Remove FOLDER from various optimization caches." t nil)
-
-(autoload (quote mh-speed-add-folder) "mh-speed" "\
-Add FOLDER since it is being created.
-The function invalidates the latest ancestor that is present." nil nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
-;;;;;; "mh-utils" "mh-utils.el" (15899 28827))
-;;; Generated autoloads from mh-utils.el
-
-(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
-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." nil nil)
-
-(autoload (quote mh-get-msg-num) "mh-utils" "\
-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." nil nil)
-
-;;;***
-\f
-;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field
-;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-letter-expand-alias
-;;;;;; mh-alias-minibuffer-confirm-address mh-read-address mh-alias-reload)
-;;;;;; "mh-alias" "mh-alias.el" (15899 29102))
-;;; Generated autoloads from mh-alias.el
-
-(autoload (quote mh-alias-reload) "mh-alias" "\
-Load MH aliases into `mh-alias-alist'." t nil)
-
-(autoload (quote mh-read-address) "mh-alias" "\
-Read an address from the minibuffer with PROMPT." nil nil)
-
-(autoload (quote mh-alias-minibuffer-confirm-address) "mh-alias" "\
-Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." t nil)
-
-(autoload (quote mh-alias-letter-expand-alias) "mh-alias" "\
-Expand mail alias before point." nil nil)
-
-(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
-Return t is From has no current alias set." nil nil)
-
-(autoload (quote mh-alias-add-alias) "mh-alias" "\
-*Add ALIAS for ADDRESS in personal alias file.
-Prompts for confirmation if the address already has an alias.
-If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil)
-
-(autoload (quote mh-alias-grab-from-field) "mh-alias" "\
-*Add ALIAS for ADDRESS in personal alias file.
-Prompts for confirmation if the alias is already in use or if the address
-already has an alias." t nil)
-
-(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
-Insert an alias for email address under point." t nil)
-
-;;;***
-\f
-(provide 'mh-loaddefs)
-;;; Local Variables:
-;;; version-control: never
-;;; no-byte-compile: t
-;;; no-update-autoloads: t
-;;; End:
-;;; mh-loaddefs.el ends here
+++ /dev/null
-;;; mh-mime.el --- MH-E support for composing MIME messages
-
-;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Internal support for MH-E package.
-;; Support for generating an mhn composition file.
-;; MIME is supported only by MH 6.8 or later.
-
-;;; Change Log:
-
-;; $Id: mh-mime.el,v 1.98 2002/12/06 03:33:47 satyaki Exp $
-
-;;; Code:
-
-(require 'cl)
-(require 'mh-comp)
-(require 'mh-utils)
-(load "mm-decode" t t) ; Non-fatal dependency
-(load "mm-uu" t t) ; Non-fatal dependency
-(load "mailcap" t t) ; Non-fatal dependency
-(load "smiley" t t) ; Non-fatal dependency
-(require 'gnus-util)
-
-(autoload 'gnus-article-goto-header "gnus-art")
-(autoload 'article-emphasize "gnus-art")
-(autoload 'gnus-get-buffer-create "gnus")
-(autoload 'gnus-eval-format "gnus-spec")
-(autoload 'widget-convert-button "wid-edit")
-(autoload 'message-options-set-recipient "message")
-(autoload 'mml-secure-message-sign-pgpmime "mml-sec")
-(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")
-(autoload 'mml-minibuffer-read-file "mml")
-(autoload 'mml-minibuffer-read-description "mml")
-(autoload 'mml-insert-empty-tag "mml")
-(autoload 'mml-to-mime "mml")
-(autoload 'mml-attach-file "mml")
-
-;;;###mh-autoload
-(defun mh-compose-insertion (&optional inline)
- "Add a directive to insert a MIME part from a file, using mhn or gnus.
-If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
-If it is set to 'gnus, then that will be used instead.
-Optional argument INLINE means make it an inline attachment."
- (interactive "P")
- (if (equal mh-compose-insertion 'gnus)
- (if inline
- (mh-mml-attach-file "inline")
- (mh-mml-attach-file))
- (call-interactively 'mh-mhn-compose-insertion)))
-
-;;;###mh-autoload
-(defun mh-compose-forward (&optional description folder message)
- "Add a MIME directive to forward a message, using mhn or gnus.
-If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
-If it is set to 'gnus, then that will be used instead.
-Optional argument DESCRIPTION is a description of the attachment.
-Optional argument FOLDER is the folder from which the forwarded message should
-come.
-Optional argument MESSAGE is the message to forward.
-If any of the optional arguments are absent, they are prompted for."
- (interactive (list
- (read-string "Forw Content-description: ")
- (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
- (read-string (format "Messages%s: "
- (if mh-sent-from-msg
- (format " [%d]" mh-sent-from-msg)
- "")))))
- (if (equal mh-compose-insertion 'gnus)
- (mh-mml-forward-message description folder message)
- (mh-mhn-compose-forw description folder message)))
-
-;; To do:
-;; paragraph code should not fill # lines if MIME enabled.
-;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
-;; invokes mh-edit-mhn automatically before sending.)
-;; actually, instead of mh-auto-edit-mhn,
-;; should read automhnproc from profile
-;; MIME option to mh-forward
-;; command to move to content-description insertion point
-
-(defvar mh-mhn-args nil
- "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command.
-The arguments are passed to mhn if \\[mh-edit-mhn] is given a
-prefix argument. Normally default arguments to mhn are specified in the
-MH profile.")
-
-(defvar mh-media-type-regexp
- (concat (regexp-opt '("text" "image" "audio" "video" "application"
- "multipart" "message") t)
- "/[-.+a-zA-Z0-9]+")
- "Regexp matching valid media types used in MIME attachment compositions.")
-
-;; Just defvar the variable to avoid compiler warning... This doesn't bind
-;; the variable, so things should work exactly as before.
-(defvar mh-have-file-command)
-
-(defun mh-have-file-command ()
- "Return t if 'file' command is on the system.
-'file -i' is used to get MIME type of composition insertion."
- (when (not (boundp 'mh-have-file-command))
- (load "executable" t t) ; executable-find not autoloaded in emacs20
- (setq mh-have-file-command
- (and (fboundp 'executable-find)
- (executable-find "file") ; file command exists
- ; and accepts -i and -b args.
- (zerop (call-process "file" nil nil nil "-i" "-b"
- (expand-file-name "inc" mh-progs))))))
- mh-have-file-command)
-
-(defvar mh-file-mime-type-substitutions
- '(("application/msword" "\.xls" "application/ms-excel")
- ("application/msword" "\.ppt" "application/ms-powerpoint"))
- "Substitutions to make for Content-Type returned from file command.
-The first element is the Content-Type returned by the file command.
-The second element is a regexp matching the file name, usually the extension.
-The third element is the Content-Type to replace with.")
-
-(defun mh-file-mime-type-substitute (content-type filename)
- "Return possibly changed CONTENT-TYPE on the FILENAME.
-Substitutions are made from the `mh-file-mime-type-substitutions' variable."
- (let ((subst mh-file-mime-type-substitutions)
- (type) (match) (answer content-type)
- (case-fold-search t))
- (while subst
- (setq type (car (car subst))
- match (elt (car subst) 1))
- (if (and (string-equal content-type type)
- (string-match match filename))
- (setq answer (elt (car subst) 2)
- subst nil)
- (setq subst (cdr subst))))
- answer))
-
-(defun mh-file-mime-type (filename)
- "Return MIME type of FILENAME from file command.
-Returns nil if file command not on system."
- (cond
- ((not (mh-have-file-command))
- nil) ;No file command, exit now.
- ((not (and (file-exists-p filename)(file-readable-p filename)))
- nil)
- (t
- (save-excursion
- (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
- (set-buffer tmp-buffer)
- (unwind-protect
- (progn
- (call-process "file" nil '(t nil) nil "-b" "-i"
- (expand-file-name filename))
- (goto-char (point-min))
- (if (not (re-search-forward mh-media-type-regexp nil t))
- nil
- (mh-file-mime-type-substitute (match-string 0) filename)))
- (kill-buffer tmp-buffer)))))))
-
-;;; This is needed for Emacs20 which doesn't have mailcap-mime-types.
-(defvar mh-mime-content-types
- '(("application/mac-binhex40") ("application/msword")
- ("application/octet-stream") ("application/pdf") ("application/pgp-keys")
- ("application/pgp-signature") ("application/pkcs7-signature")
- ("application/postscript") ("application/rtf")
- ("application/vnd.ms-excel") ("application/vnd.ms-powerpoint")
- ("application/vnd.ms-project") ("application/vnd.ms-tnef")
- ("application/wordperfect5.1") ("application/wordperfect6.0")
- ("application/zip")
-
- ("audio/basic") ("audio/mpeg")
-
- ("image/gif") ("image/jpeg") ("image/png")
-
- ("message/delivery-status")
- ("message/external-body") ("message/partial") ("message/rfc822")
-
- ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
- ("text/richtext") ("text/xml")
-
- ("video/mpeg") ("video/quicktime"))
- "Legal MIME content types.
-See documentation for \\[mh-edit-mhn].")
-
-;;;###mh-autoload
-(defun mh-mhn-compose-insertion (filename type description attributes)
- "Add a directive to insert a MIME message part from a file.
-This is the typical way to insert non-text parts in a message.
-
-Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
-content type, DESCRIPTION, a line of text for the Content-Description field.
-ATTRIBUTES is a comma separated list of name=value pairs that is appended to
-the Content-Type field of the attachment.
-
-See also \\[mh-edit-mhn]."
- (interactive (let ((filename (read-file-name "Insert contents of: ")))
- (list
- filename
- (or (mh-file-mime-type filename)
- (completing-read "Content-Type: "
- (if (fboundp 'mailcap-mime-types)
- (mapcar 'list (mailcap-mime-types))
- mh-mime-content-types)))
- (read-string "Content-Description: ")
- (read-string "Content-Attributes: "
- (concat "name=\""
- (file-name-nondirectory filename)
- "\"")))))
- (mh-mhn-compose-type filename type description attributes ))
-
-(defun mh-mhn-compose-type (filename type
- &optional description attributes comment)
- "Insert a mhn directive to insert a file.
-
-The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
-used as the Content-Description field, optional set of ATTRIBUTES and an
-optional COMMENT can also be included."
- (setq mh-mhn-compose-insert-flag t)
- (beginning-of-line)
- (insert "#" type)
- (and attributes
- (insert "; " attributes))
- (and comment
- (insert " (" comment ")"))
- (insert " [")
- (and description
- (insert description))
- (insert "] " (expand-file-name filename))
- (insert "\n"))
-
-
-;;;###mh-autoload
-(defun mh-mhn-compose-anon-ftp (host filename type description)
- "Add a directive for a MIME anonymous ftp external body part.
-This directive tells MH to include a reference to a message/external-body part
-retrievable by anonymous FTP.
-
-Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
-MIME content type, and DESCRIPTION, a line of text for the Content-description
-header.
-
-See also \\[mh-edit-mhn]."
- (interactive (list
- (read-string "Remote host: ")
- (read-string "Remote filename: ")
- (completing-read "External Content-Type: "
- (if (fboundp 'mailcap-mime-types)
- (mapcar 'list (mailcap-mime-types))
- mh-mime-content-types))
- (read-string "External Content-Description: ")))
- (mh-mhn-compose-external-type "anon-ftp" host filename
- type description))
-
-;;;###mh-autoload
-(defun mh-mhn-compose-external-compressed-tar (host filename description)
- "Add a directive to include a MIME reference to a compressed tar file.
-The file should be available via anonymous ftp. This directive tells MH to
-include a reference to a message/external-body part.
-
-Arguments are HOST and FILENAME, which tell where to find the file, and
-DESCRIPTION, a line of text for the Content-description header.
-
-See also \\[mh-edit-mhn]."
- (interactive (list
- (read-string "Remote host: ")
- (read-string "Remote filename: ")
- (read-string "Tar file Content-description: ")))
- (mh-mhn-compose-external-type "anon-ftp" host filename
- "application/octet-stream"
- description
- "type=tar; conversions=x-compress"
- "mode=image"))
-
-
-(defun mh-mhn-compose-external-type (access-type host filename type
- &optional description
- attributes extra-params
- comment)
- "Add a directive to include a MIME reference to a remote file.
-The file should be available via anonymous ftp. This directive tells MH to
-include a reference to a message/external-body part.
-
-Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the
-file and TYPE which is the MIME Content-Type. Optional arguments include
-DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
-EXTRA-PARAMS, and COMMENT.
-
-See also \\[mh-edit-mhn]."
- (setq mh-mhn-compose-insert-flag t)
- (beginning-of-line)
- (insert "#@" type)
- (and attributes
- (insert "; " attributes))
- (and comment
- (insert " (" comment ") "))
- (insert " [")
- (and description
- (insert description))
- (insert "] ")
- (insert "access-type=" access-type "; ")
- (insert "site=" host)
- (insert "; name=" (file-name-nondirectory filename))
- (insert "; directory=\"" (file-name-directory filename) "\"")
- (and extra-params
- (insert "; " extra-params))
- (insert "\n"))
-
-;;;###mh-autoload
-(defun mh-mhn-compose-forw (&optional description folder messages)
- "Add a forw directive to this message, to forward a message with MIME.
-This directive tells MH to include the named messages in this one.
-
-Arguments are DESCRIPTION, a line of text for the Content-description header,
-and FOLDER and MESSAGES, which name the message(s) to be forwarded.
-
-See also \\[mh-edit-mhn]."
- (interactive (list
- (read-string "Forw Content-description: ")
- (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
- (read-string (format "Messages%s: "
- (if mh-sent-from-msg
- (format " [%d]" mh-sent-from-msg)
- "")))))
- (setq mh-mhn-compose-insert-flag t)
- (beginning-of-line)
- (insert "#forw [")
- (and description
- (not (string= description ""))
- (insert description))
- (insert "]")
- (and folder
- (not (string= folder ""))
- (insert " " folder))
- (if (and messages
- (not (string= messages "")))
- (let ((start (point)))
- (insert " " messages)
- (subst-char-in-region start (point) ?, ? ))
- (if mh-sent-from-msg
- (insert " " (int-to-string mh-sent-from-msg))))
- (insert "\n"))
-
-;;;###mh-autoload
-(defun mh-edit-mhn (&optional extra-args)
- "Format the current draft for MIME, expanding any mhn directives.
-
-Process the current draft with the mhn program, which, using directives
-already inserted in the draft, fills in all the MIME components and header
-fields.
-
-This step should be done last just before sending the message.
-
-The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
-list `mh-mhn-args' are passed to mhn if this function is passed an optional
-prefix argument EXTRA-ARGS.
-
-For assistance with creating mhn directives to insert various types of
-components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
-from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
-anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
-compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
-message). If these helper functions are used, `mh-edit-mhn' is run
-automatically when the draft is sent.
-
-The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
-arguments, after performing the conversion.
-
-The mhn program is part of MH version 6.8 or later."
- (interactive "*P")
- (save-buffer)
- (message "mhn editing...")
- (cond
- (mh-nmh-flag
- (mh-exec-cmd-error nil
- "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
- (t
- (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
- "mhn" (if extra-args mh-mhn-args) buffer-file-name)))
- (setq mh-mhn-compose-insert-flag nil)
- (revert-buffer t t)
- (message "mhn editing...done")
- (run-hooks 'mh-edit-mhn-hook))
-
-;;;###mh-autoload
-(defun mh-revert-mhn-edit (noconfirm)
- "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
-Optional non-nil argument NOCONFIRM means don't ask for confirmation."
- (interactive "*P")
- (if (null buffer-file-name)
- (error "Buffer does not seem to be associated with any file"))
- (let ((backup-strings '("," "#"))
- backup-file)
- (while (and backup-strings
- (not (file-exists-p
- (setq backup-file
- (concat (file-name-directory buffer-file-name)
- (car backup-strings)
- (file-name-nondirectory buffer-file-name)
- ".orig")))))
- (setq backup-strings (cdr backup-strings)))
- (or backup-strings
- (error "Backup file for %s no longer exists!" buffer-file-name))
- (or noconfirm
- (yes-or-no-p (format "Revert buffer from file %s? "
- backup-file))
- (error "Revert not confirmed"))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (insert-file-contents backup-file))
- (after-find-file nil)))
-
-\f
-
-;;; MIME composition functions
-
-;;;###mh-autoload
-(defun mh-mml-to-mime ()
- "Compose MIME message from mml directives."
- (interactive)
- (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
- (message-options-set-recipient))
- (mml-to-mime)
- (setq mh-mml-compose-insert-flag nil))
-
-;;;###mh-autoload
-(defun mh-mml-forward-message (description folder message)
- "Forward a message as attachment.
-The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
-number."
- (let ((msg (if (equal message "")
- mh-sent-from-msg
- (car (read-from-string message)))))
- (cond ((integerp msg)
- (if (string= "" description)
- ;; Rationale: mml-attach-file constructs a malformed composition
- ;; if the description string is empty. This fixes SF #625168.
- (mml-attach-file (format "%s%s/%d"
- mh-user-path (substring folder 1) msg)
- "message/rfc822")
- (mml-attach-file (format "%s%s/%d"
- mh-user-path (substring folder 1) msg)
- "message/rfc822"
- description))
- (setq mh-mml-compose-insert-flag t))
- (t (error "The message number, %s is not a integer!" msg)))))
-
-;;;###mh-autoload
-(defun mh-mml-attach-file (&optional disposition)
- "Attach a file to the outgoing MIME message.
-The file is not inserted or encoded until you send the message with
-`\\[mh-send-letter]'.
-Message disposition is \"inline\" or \"attachment\" and is prompted for if
-DISPOSITION is nil.
-
-This is basically `mml-attach-file' from gnus, modified such that a prefix
-argument yields an `inline' disposition and Content-Type is determined
-automatically."
- (let* ((file (mml-minibuffer-read-file "Attach file: "))
- (type (or (mh-file-mime-type file)
- (completing-read "Content-Type: "
- (if (fboundp 'mailcap-mime-types)
- (mapcar 'list (mailcap-mime-types))
- mh-mime-content-types))))
- (description (mml-minibuffer-read-description))
- (dispos (or disposition
- (completing-read "Disposition: [attachment] "
- '(("attachment")("inline"))
- nil t nil nil
- "attachment"))))
- (mml-insert-empty-tag 'part 'type type 'filename file
- 'disposition dispos 'description description)
- (setq mh-mml-compose-insert-flag t)))
-
-;;;###mh-autoload
-(defun mh-mml-secure-message-sign-pgpmime ()
- "Add directive to encrypt/sign the entire message."
- (interactive)
- (if (not mh-gnus-pgp-support-flag)
- (error "Sorry. Your version of gnus does not support PGP/GPG")
- (mml-secure-message-sign-pgpmime)
- (setq mh-mml-compose-insert-flag t)))
-
-;;;###mh-autoload
-(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
- "Add directive to encrypt and sign the entire message.
-If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
- (interactive "P")
- (if (not mh-gnus-pgp-support-flag)
- (error "Sorry. Your version of gnus does not support PGP/GPG")
- (mml-secure-message-encrypt-pgpmime dontsign)
- (setq mh-mml-compose-insert-flag t)))
-
-\f
-
-;;; MIME decoding
-
-(defmacro mh-defun-compat (function arg-list &rest body)
- "This is a macro to define functions which are not defined.
-It is used for Gnus utility functions which were added recently. If FUNCTION
-is not defined then it is defined to have argument list, ARG-LIST and body,
-BODY."
- (let ((defined-p (fboundp function)))
- (unless defined-p
- `(defun ,function ,arg-list ,@body))))
-(put 'mh-defun-compat 'lisp-indent-function 'defun)
-
-;; Copy of original function from gnus-util.el
-(mh-defun-compat gnus-local-map-property (map)
- "Return a list suitable for a text property list specifying keymap MAP."
- (cond (mh-xemacs-flag (list 'keymap map))
- ((>= emacs-major-version 21) (list 'keymap map))
- (t (list 'local-map map))))
-
-;; Copy of original function from mm-decode.el
-(mh-defun-compat mm-merge-handles (handles1 handles2)
- (append (if (listp (car handles1)) handles1 (list handles1))
- (if (listp (car handles2)) handles2 (list handles2))))
-
-;; Copy of function from mm-decode.el
-(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
- ;; HANDLE could be a CTL.
- (if handle
- (put-text-property 0 (length (car handle)) parameter value
- (car handle))))
-
-;; Copy of original macro is in mm-decode.el
-(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
- (get-text-property 0 parameter (car handle)))
-
-;; Copy of original function in mm-decode.el
-(mh-defun-compat mm-readable-p (handle)
- "Say whether the content of HANDLE is readable."
- (and (< (with-current-buffer (mm-handle-buffer handle)
- (buffer-size)) 10000)
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (and (eq (mm-body-7-or-8) '7bit)
- (not (mm-long-lines-p 76))))))
-
-;; Copy of original function in mm-bodies.el
-(mh-defun-compat mm-long-lines-p (length)
- "Say whether any of the lines in the buffer is longer than LINES."
- (save-excursion
- (goto-char (point-min))
- (end-of-line)
- (while (and (not (eobp))
- (not (> (current-column) length)))
- (forward-line 1)
- (end-of-line))
- (and (> (current-column) length)
- (current-column))))
-
-(mh-defun-compat mm-keep-viewer-alive-p (handle)
- ;; Released Gnus doesn't keep handles associated with externally displayed
- ;; MIME parts. So this will always return nil.
- nil)
-
-(mh-defun-compat mm-destroy-parts (list)
- "Older emacs don't have this function."
- nil)
-
-;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
-;;; buggy (the args to read-file-name are incorrect). When all supported
-;;; versions of Emacs come with at least Gnus 5.10, we can delete this
-;;; function and rename calls to mh-mm-save-part to mm-save-part.
-(defun mh-mm-save-part (handle)
- "Write HANDLE to a file."
- (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
- (filename (mail-content-type-get
- (mm-handle-disposition handle) 'filename))
- file)
- (when filename
- (setq filename (file-name-nondirectory filename)))
- (setq file (read-file-name "Save MIME part to: "
- (or mm-default-directory
- default-directory)
- nil nil (or filename name "")))
- (setq mm-default-directory (file-name-directory file))
- (and (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? "
- file)))
- (mm-save-part-to-file handle file))))
-
-\f
-
-;;; MIME cleanup
-
-;;;###mh-autoload
-(defun mh-mime-cleanup ()
- "Free the decoded MIME parts."
- (let ((mime-data (gethash (current-buffer) mh-globals-hash)))
- ;; This is for Emacs, what about XEmacs?
- (cond ((fboundp 'remove-images)
- (remove-images (point-min) (point-max))))
- (when mime-data
- (mm-destroy-parts (mh-mime-handles mime-data))
- (remhash (current-buffer) mh-globals-hash))))
-
-;;;###mh-autoload
-(defun mh-destroy-postponed-handles ()
- "Free MIME data for externally displayed mime parts."
- (let ((mime-data (mh-buffer-data)))
- (when mime-data
- (mm-destroy-parts (mh-mime-handles mime-data)))
- (remhash (current-buffer) mh-globals-hash)))
-
-(defun mh-handle-set-external-undisplayer (folder handle function)
- "Replacement for `mm-handle-set-external-undisplayer'.
-This is only called in recent versions of Gnus. The MIME handles are stored
-in data structures corresponding to MH-E folder buffer FOLDER instead of in
-Gnus (as in the original). The MIME part, HANDLE is associated with the
-undisplayer FUNCTION."
- (if (mm-keep-viewer-alive-p handle)
- (let ((new-handle (copy-sequence handle)))
- (mm-handle-set-undisplayer new-handle function)
- (mm-handle-set-undisplayer handle nil)
- (save-excursion
- (set-buffer folder)
- (push new-handle (mh-mime-handles (mh-buffer-data)))))
- (mm-handle-set-undisplayer handle function)))
-
-\f
-
-;;; MIME transformations
-(eval-when-compile (require 'font-lock))
-
-;;;###mh-autoload
-(defun mh-add-missing-mime-version-header ()
- "Some mail programs don't put a MIME-Version header.
-I have seen this only in spam, so maybe we shouldn't fix this ;-)"
- (save-excursion
- (goto-char (point-min))
- (when (and (message-fetch-field "content-type")
- (not (message-fetch-field "mime-version")))
- (when (search-forward "\n\n" nil t)
- (forward-line -1)
- (insert "MIME-Version: 1.0\n")))))
-
-;;;###mh-autoload
-(defun mh-display-smileys ()
- "Function to display smileys."
- (when (and mh-graphical-smileys-flag
- (fboundp 'smiley-region)
- (boundp 'font-lock-maximum-size)
- (>= (/ font-lock-maximum-size 8) (buffer-size)))
- (smiley-region (point-min) (point-max))))
-
-;;;###mh-autoload
-(defun mh-display-emphasis ()
- "Function to display graphical emphasis."
- (when (and mh-graphical-emphasis-flag
- (boundp 'font-lock-maximum-size)
- (>= (/ font-lock-maximum-size 8) (buffer-size)))
- (flet ((article-goto-body ())) ; shadow this function to do nothing
- (save-excursion
- (goto-char (point-min))
- (article-emphasize)))))
-
-;; Copied from gnus-art.el (should be checked for other cool things that can
-;; be added to the buttons)
-(defvar mh-mime-button-commands
- '((mh-press-button "\r" "Toggle Display")))
-(defvar mh-mime-button-map
- (let ((map (make-sparse-keymap)))
- (unless (>= (string-to-number emacs-version) 21)
- ;; XEmacs doesn't care.
- (set-keymap-parent map mh-show-mode-map))
- (define-key map [mouse-2] 'mh-push-button)
- (dolist (c mh-mime-button-commands)
- (define-key map (cadr c) (car c)))
- map))
-(defvar mh-mime-button-line-format-alist
- '((?T long-type ?s)
- (?d description ?s)
- (?p index ?s)
- (?e dots ?s)))
-(defvar mh-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n")
-(defvar mh-mime-security-button-pressed nil)
-(defvar mh-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n")
-(defvar mh-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n")
-(defvar mh-mime-security-button-line-format-alist
- '((?t type ?s)
- (?i info ?s)
- (?d details ?s)
- (?D pressed-details ?s)))
-(defvar mh-mime-security-button-map
- (let ((map (make-sparse-keymap)))
- (unless (>= (string-to-number emacs-version) 21)
- (set-keymap-parent map mh-show-mode-map))
- (define-key map "\r" 'mh-press-button)
- (define-key map [mouse-2] 'mh-push-button)
- map))
-
-(defvar mh-mime-save-parts-directory nil
- "Default to use for `mh-mime-save-parts-default-directory'.
-Set from last use.")
-
-;;;###mh-autoload
-(defun mh-mime-save-parts (arg)
- "Store the MIME parts of the current message.
-If ARG, prompt for directory, else use that specified by the variable
-`mh-mime-save-parts-default-directory'. These directories may be superseded by
-mh_profile directives, since this function calls on mhstore or mhn to do the
-actual storing."
- (interactive "P")
- (let ((msg (if (eq major-mode 'mh-show-mode)
- (mh-show-buffer-message-number)
- (mh-get-msg-num t)))
- (folder (if (eq major-mode 'mh-show-mode)
- mh-show-folder-buffer
- mh-current-folder))
- (command (if mh-nmh-flag "mhstore" "mhn"))
- (directory
- (cond
- ((and (or arg
- (equal nil mh-mime-save-parts-default-directory)
- (equal t mh-mime-save-parts-default-directory))
- (not mh-mime-save-parts-directory))
- (read-file-name "Store in what directory? " nil nil t nil))
- ((and (or arg
- (equal t mh-mime-save-parts-default-directory))
- mh-mime-save-parts-directory)
- (read-file-name (format
- "Store in what directory? [%s] "
- mh-mime-save-parts-directory)
- "" mh-mime-save-parts-directory t ""))
- ((stringp mh-mime-save-parts-default-directory)
- mh-mime-save-parts-default-directory)
- (t
- mh-mime-save-parts-directory))))
- (if (and (equal directory "") mh-mime-save-parts-directory)
- (setq directory mh-mime-save-parts-directory))
- (if (not (file-directory-p directory))
- (message "No directory specified.")
- (if (equal nil mh-mime-save-parts-default-directory)
- (setq mh-mime-save-parts-directory directory))
- (save-excursion
- (set-buffer (get-buffer-create " *mh-store*"))
- (cd directory)
- (setq mh-mime-save-parts-directory directory)
- (erase-buffer)
- (apply 'call-process
- (expand-file-name command mh-progs) nil t nil
- (mh-list-to-string (list folder msg "-auto")))
- (if (> (buffer-size) 0)
- (save-window-excursion
- (switch-to-buffer-other-window " *mh-store*")
- (sit-for 3)))))))
-
-;; Avoid errors if gnus-sum isn't loaded yet...
-(defvar gnus-newsgroup-charset nil)
-(defvar gnus-newsgroup-name nil)
-
-;;;###mh-autoload
-(defun mh-mime-display (&optional pre-dissected-handles)
- "Display (and possibly decode) MIME handles.
-Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
-present they are displayed otherwise the buffer is parsed and then
-displayed."
- (let ((handles ())
- (folder mh-show-folder-buffer))
- (flet ((mm-handle-set-external-undisplayer
- (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- ;; If needed dissect the current buffer
- (if pre-dissected-handles
- (setq handles pre-dissected-handles)
- (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
- (setf (mh-mime-handles (mh-buffer-data))
- (mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))))
-
- (when (and handles (or (not (stringp (car handles))) (cdr handles)))
- ;; Goto start of message body
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (goto-char (point-max)))
-
- ;; Delete the body
- (delete-region (point) (point-max))
-
- ;; Display the MIME handles
- (mh-mime-display-part handles)))))
-
-(defun mh-mime-display-part (handle)
- "Decides the viewer to call based on the type of HANDLE."
- (cond ((null handle) nil)
- ((not (stringp (car handle)))
- (mh-mime-display-single handle))
- ((equal (car handle) "multipart/alternative")
- (mh-mime-display-alternative (cdr handle)))
- ((and mh-gnus-pgp-support-flag
- (or (equal (car handle) "multipart/signed")
- (equal (car handle) "multipart/encrypted")))
- (mh-mime-display-security handle))
- (t (mh-mime-display-mixed (cdr handle)))))
-
-(defun mh-mime-display-alternative (handles)
- "Choose among the alternatives, HANDLES the part that will be displayed.
-If no part is preferred then all the parts are displayed."
- (let ((preferred (mm-preferred-alternative handles)))
- (cond ((and preferred (stringp (car preferred)))
- (mh-mime-display-part preferred))
- (preferred
- (save-restriction
- (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
- (mh-mime-display-single preferred)
- (goto-char (point-max))))
- (t (mh-mime-display-mixed handles)))))
-
-(defun mh-mime-display-mixed (handles)
- "Display the list of MIME parts, HANDLES recursively."
- (mapcar #'mh-mime-display-part handles))
-
-(defun mh-mime-part-index (handle)
- "Generate the button number for MIME part, HANDLE.
-Notice that a hash table is used to display the same number when buttons need
-to be displayed multiple times (for instance when nested messages are
-opened)."
- (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
- (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
- (incf (mh-mime-parts-count (mh-buffer-data))))))
-
-;;; Avoid compiler warnings for XEmacs functions...
-(eval-when (compile)
- (loop for function in '(glyph-width window-pixel-width
- glyph-height window-pixel-height)
- do (or (fboundp function) (defalias function 'ignore))))
-
-(defun mh-small-image-p (handle)
- "Decide whether HANDLE is a \"small\" image that can be displayed inline.
-This is only useful if a Content-Disposition header is not present."
- (let ((media-test (caddr (assoc (car (mm-handle-type handle))
- mh-mm-inline-media-tests)))
- (mm-inline-large-images t))
- (and media-test
- (equal (mm-handle-media-supertype handle) "image")
- (funcall media-test handle) ; Since mm-inline-large-images is T,
- ; this only tells us if the image is
- ; something that emacs can display
- (let* ((image (mm-get-image handle)))
- (cond ((fboundp 'glyph-width)
- ;; XEmacs -- totally untested, copied from gnus
- (and (< (glyph-width image)
- (or mh-max-inline-image-width
- (window-pixel-width)))
- (< (glyph-height image)
- (or mh-max-inline-image-height
- (window-pixel-height)))))
- ((fboundp 'image-size)
- ;; Emacs21 -- copied from gnus
- (let ((size (image-size image)))
- (and (< (cdr size)
- (or mh-max-inline-image-height
- (1- (window-height))))
- (< (car size)
- (or mh-max-inline-image-width (window-width))))))
- (t
- ;; Can't show image inline
- nil))))))
-
-(defun mh-inline-vcard-p (handle)
- "Decide if HANDLE is a vcard that must be displayed inline."
- (let ((type (mm-handle-type handle)))
- (and (consp type)
- (equal (car type) "text/x-vcard")
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (not (re-search-forward "^-- $" nil t)))))))
-
-(defun mh-mime-display-single (handle)
- "Display a leaf node, HANDLE in the MIME tree."
- (let* ((type (mm-handle-media-type handle))
- (small-image-flag (mh-small-image-p handle))
- (attachmentp (equal (car (mm-handle-disposition handle))
- "attachment"))
- (inlinep (and (equal (car (mm-handle-disposition handle)) "inline")
- (mm-inlinable-p handle)
- (mm-inlined-p handle)))
- (displayp (or inlinep ; show if inline OR
- (mh-inline-vcard-p handle); inline vcard OR
- (and (not attachmentp) ; if not an attachment
- (or small-image-flag ; and small image
- ; and user wants inline
- (and (not (equal
- (mm-handle-media-supertype handle)
- "image"))
- (mm-inlinable-p handle)
- (mm-inlined-p handle)))))))
- (save-restriction
- (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
- (cond ((and mh-gnus-pgp-support-flag
- (equal type "application/pgp-signature"))
- nil) ; skip signatures as they are already handled...
- ((not displayp)
- (insert "\n")
- (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
- ((and displayp (not mh-display-buttons-for-inline-parts-flag))
- (or (mm-display-part handle) (mm-display-part handle)))
- ((and displayp mh-display-buttons-for-inline-parts-flag)
- (insert "\n")
- (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
- (forward-line -1)
- (mh-mm-display-part handle)))
- (goto-char (point-max)))))
-
-(defun mh-insert-mime-button (handle index displayed)
- "Insert MIME button for HANDLE.
-INDEX is the part number that will be DISPLAYED. It is also used by commands
-like \"K v\" which operate on individual MIME parts."
- ;; The button could be displayed by a previous decode. In that case
- ;; undisplay it if we need a hidden button.
- (when (and (mm-handle-displayed-p handle) (not displayed))
- (mm-display-part handle))
- (let ((name (or (mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-disposition handle)
- 'filename)
- (mail-content-type-get (mm-handle-type handle) 'url)
- ""))
- (type (mm-handle-media-type handle))
- (description (mail-decode-encoded-word-string
- (or (mm-handle-description handle) "")))
- (dots (if (or displayed (mm-handle-displayed-p handle)) " " "..."))
- long-type begin end)
- (if (string-match ".*/" name) (setq name (substring name (match-end 0))))
- (setq long-type (concat type (and (not (equal name ""))
- (concat "; " name))))
- (unless (equal description "")
- (setq long-type (concat " --- " long-type)))
- (unless (bolp) (insert "\n"))
- (setq begin (point))
- (gnus-eval-format
- mh-mime-button-line-format mh-mime-button-line-format-alist
- `(,@(gnus-local-map-property mh-mime-button-map)
- mh-callback mh-mm-display-part
- mh-part ,index
- mh-data ,handle))
- (setq end (point))
- (widget-convert-button
- 'link begin end
- :mime-handle handle
- :action 'mh-widget-press-button
- :button-keymap mh-mime-button-map
- :help-echo
- "Mouse-2 click or press RET (in show buffer) to toggle display")))
-
-;; There is a bug in Gnus inline image display due to which an extra line
-;; gets inserted every time it is viewed. To work around that problem we are
-;; using an extra property 'mh-region to remember the region that is added
-;; when the button is clicked. The region is then deleted to make sure that
-;; no extra lines get inserted.
-(defun mh-mm-display-part (handle)
- "Toggle display of button for MIME part, HANDLE."
- (beginning-of-line)
- (let ((id (get-text-property (point) 'mh-part))
- (point (point))
- (window (selected-window))
- (mail-parse-charset 'nil)
- (mail-parse-ignored-charsets nil)
- region buffer-read-only)
- (save-excursion
- (unwind-protect
- (let ((win (get-buffer-window (current-buffer) t)))
- (when win
- (select-window win))
- (goto-char point)
-
- (if (mm-handle-displayed-p handle)
- ;; This will remove the part.
- (progn
- ;; Delete the button and displayed part (if any)
- (let ((region (get-text-property point 'mh-region)))
- (when region
- (when (fboundp 'remove-images)
- (remove-images (car region) (cdr region))))
- (mm-display-part handle)
- (when region
- (delete-region (car region) (cdr region))))
- ;; Delete button (if it still remains). This happens for
- ;; externally displayed parts where the previous step does
- ;; nothing.
- (unless (eolp)
- (delete-region (point) (progn (forward-line) (point)))))
- (save-restriction
- (delete-region (point) (progn (forward-line 1) (point)))
- (narrow-to-region (point) (point))
- ;; Maybe we need another unwind-protect here.
- (when (equal (mm-handle-media-supertype handle) "image")
- (insert "\n"))
- (when (and (not (eq (ignore-errors (mm-display-part handle))
- 'inline))
- (equal (mm-handle-media-supertype handle)
- "image"))
- (goto-char (point-min))
- (delete-char 1))
- (when (equal (mm-handle-media-supertype handle) "text")
- (when (eq mh-highlight-citation-p 'gnus)
- (mh-gnus-article-highlight-citation))
- (mh-display-smileys)
- (mh-display-emphasis))
- (setq region (cons (progn (goto-char (point-min))
- (point-marker))
- (progn (goto-char (point-max))
- (point-marker)))))))
- (when (window-live-p window)
- (select-window window))
- (goto-char point)
- (beginning-of-line)
- (mh-insert-mime-button handle id (mm-handle-displayed-p handle))
- (goto-char point)
- (when region
- (add-text-properties (line-beginning-position) (line-end-position)
- `(mh-region ,region)))))))
-
-;;;###mh-autoload
-(defun mh-press-button ()
- "Press MIME button.
-If the MIME part is visible then it is removed. Otherwise the part is
-displayed."
- (interactive)
- (let ((mm-inline-media-tests mh-mm-inline-media-tests)
- (data (get-text-property (point) 'mh-data))
- (function (get-text-property (point) 'mh-callback))
- (buffer-read-only nil)
- (folder mh-show-folder-buffer))
- (flet ((mm-handle-set-external-undisplayer
- (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- (when (and function (eolp))
- (backward-char))
- (unwind-protect (and function (funcall function data))
- (set-buffer-modified-p nil)))))
-
-;;;###mh-autoload
-(defun mh-push-button (event)
- "Click MIME button for EVENT.
-If the MIME part is visible then it is removed. Otherwise the part is
-displayed. This function is called when the mouse is used to click the MIME
-button."
- (interactive "e")
- (set-buffer (window-buffer (posn-window (event-start event))))
- (select-window (posn-window (event-start event)))
- (let* ((pos (posn-point (event-start event)))
- (folder mh-show-folder-buffer)
- (mm-inline-media-tests mh-mm-inline-media-tests)
- (data (get-text-property pos 'mh-data))
- (function (get-text-property pos 'mh-callback))
- (buffer-read-only nil))
- (flet ((mm-handle-set-external-undisplayer
- (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- (goto-char pos)
- (unwind-protect (and function (funcall function data))
- (set-buffer-modified-p nil)))))
-
-;;;###mh-autoload
-(defun mh-mime-save-part ()
- "Save MIME part at point."
- (interactive)
- (let ((data (get-text-property (point) 'mh-data)))
- (when data
- (let ((mm-default-directory mh-mime-save-parts-directory))
- (mh-mm-save-part data)
- (setq mh-mime-save-parts-directory mm-default-directory)))))
-
-;;;###mh-autoload
-(defun mh-mime-inline-part ()
- "Toggle display of the raw MIME part."
- (interactive)
- (let* ((buffer-read-only nil)
- (data (get-text-property (point) 'mh-data))
- (inserted-flag (get-text-property (point) 'mh-mime-inserted))
- (displayed-flag (mm-handle-displayed-p data))
- (point (point))
- start end)
- (cond ((and data (not inserted-flag) (not displayed-flag))
- (let ((contents (mm-get-part data)))
- (add-text-properties (line-beginning-position) (line-end-position)
- '(mh-mime-inserted t))
- (setq start (point-marker))
- (forward-line 1)
- (mm-insert-inline data contents)
- (setq end (point-marker))
- (add-text-properties
- start (progn (goto-char start) (line-end-position))
- `(mh-region (,start . ,end)))))
- ((and data (or inserted-flag displayed-flag))
- (mh-press-button)
- (message "MIME part already inserted")))
- (goto-char point)
- (set-buffer-modified-p nil)))
-
-(defun mh-widget-press-button (widget el)
- "Callback for widget, WIDGET.
-Parameter EL is unused."
- (goto-char (widget-get widget :from))
- (mh-press-button))
-
-(defun mh-mime-display-security (handle)
- "Display PGP encrypted/signed message, HANDLE."
- (insert "\n")
- (save-restriction
- (narrow-to-region (point) (point))
- (mh-insert-mime-security-button handle)
- (mh-mime-display-mixed (cdr handle))
- (insert "\n")
- (let ((mh-mime-security-button-line-format
- mh-mime-security-button-end-line-format))
- (mh-insert-mime-security-button handle))
- (mm-set-handle-multipart-parameter
- handle 'mh-region
- (cons (set-marker (make-marker) (point-min))
- (set-marker (make-marker) (point-max))))))
-
-;;; I rewrote the security part because Gnus doesn't seem to ever minimize
-;;; the button. That is once the mime-security button is pressed there seems
-;;; to be no way of getting rid of the inserted text.
-(defun mh-mime-security-show-details (handle)
- "Toggle display of detailed security info for HANDLE."
- (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
- (when details
- (let ((mh-mime-security-button-pressed
- (not (get-text-property (point) 'mh-button-pressed)))
- (mh-mime-security-button-line-format
- (get-text-property (point) 'mh-line-format)))
- (forward-char -1)
- (while (eq (get-text-property (point) 'mh-line-format)
- mh-mime-security-button-line-format)
- (forward-char -1))
- (forward-char)
- (save-restriction
- (narrow-to-region (point) (point))
- (mh-insert-mime-security-button handle))
- (delete-region
- (point)
- (or (text-property-not-all
- (point) (point-max)
- 'mh-line-format mh-mime-security-button-line-format)
- (point-max)))
- (forward-line -1)))))
-
-(defun mh-mime-security-press-button (handle)
- "Callback from security button for part HANDLE."
- (when (mm-handle-multipart-ctl-parameter handle 'gnus-info)
- (mh-mime-security-show-details handle)))
-
-;; These variables should already be initialized in mm-decode.el if we have a
-;; recent enough Gnus. The defvars are here to avoid compiler warnings.
-(defvar mm-verify-function-alist nil)
-(defvar mm-decrypt-function-alist nil)
-
-(defvar pressed-details)
-
-(defun mh-insert-mime-security-button (handle)
- "Display buttons for PGP message, HANDLE."
- (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
- (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
- (nth 2 (assoc protocol mm-decrypt-function-alist))
- "Unknown"))
- (type (concat crypto-type
- (if (equal (car handle) "multipart/signed")
- " Signed" " Encrypted")
- " Part"))
- (info (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
- "Undecided"))
- (details (mm-handle-multipart-ctl-parameter handle 'gnus-details))
- pressed-details begin end)
- (setq details (if details (concat "\n" details) ""))
- (setq pressed-details (if mh-mime-security-button-pressed details ""))
- (unless (bolp) (insert "\n"))
- (setq begin (point))
- (gnus-eval-format
- mh-mime-security-button-line-format
- mh-mime-security-button-line-format-alist
- `(,@(gnus-local-map-property mh-mime-security-button-map)
- mh-button-pressed ,mh-mime-security-button-pressed
- mh-callback mh-mime-security-press-button
- mh-line-format ,mh-mime-security-button-line-format
- mh-data ,handle))
- (setq end (point))
- (widget-convert-button 'link begin end
- :mime-handle handle
- :action 'mh-widget-press-button
- :button-keymap mh-mime-security-button-map
- :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
- (when (equal info "Failed")
- (let* ((type (if (equal (car handle) "multipart/signed")
- "verification" "decryption"))
- (warning (if (equal type "decryption")
- "(passphrase may be incorrect)" "")))
- (message "%s %s failed %s" crypto-type type warning)))))
-
-(defun mh-mm-inline-message (handle)
- "Display message, HANDLE.
-The function decodes the message and displays it. It avoids decoding the same
-message multiple times."
- (let ((b (point))
- (charset (mail-content-type-get (mm-handle-type handle) 'charset))
- (clean-message-header mh-clean-message-header-flag)
- (invisible-headers mh-invisible-headers)
- (visible-headers mh-visible-headers))
- (when (and charset (stringp charset))
- (setq charset (intern (downcase charset)))
- (when (eq charset 'us-ascii)
- (setq charset nil)))
- (save-excursion
- (save-restriction
- (narrow-to-region b b)
- (mm-insert-part handle)
- (mh-mime-display
- (or (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
- (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
- (let ((handles (or (mm-dissect-buffer nil)
- (mm-uu-dissect))))
- (setf (mh-mime-handles (mh-buffer-data))
- (mm-merge-handles
- handles (mh-mime-handles (mh-buffer-data))))
- handles))))
-
- (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-show-xface)
- (mh-show-addr)
- ;; The other highlighting types don't need anything special
- (when (eq mh-highlight-citation-p 'gnus)
- (mh-gnus-article-highlight-citation))
- (goto-char (point-min))
- (insert "\n------- Forwarded Message\n\n")
- (mh-display-smileys)
- (mh-display-emphasis)
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (if (fboundp 'remove-specifier)
- ;; This is only valid on XEmacs.
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop) (current-buffer)))
- '(background background-pixmap foreground)))
- (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
-
-(provide 'mh-mime)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-mime.el ends here
+++ /dev/null
-;;; mh-pick.el --- make a search pattern and search for a message in MH-E
-
-;; Copyright (C) 1993, 1995, 2001 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Internal support for MH-E package.
-
-;;; Change Log:
-
-;; $Id: mh-pick.el,v 1.25 2002/12/04 18:51:50 wohler Exp $
-
-;;; Code:
-
-(require 'mh-e)
-(require 'easymenu)
-(require 'gnus-util)
-
-;;; Internal variables:
-
-(defvar mh-pick-mode-map (make-sparse-keymap)
- "Keymap for searching folder.")
-
-(defvar mh-searching-folder nil) ;Folder this pick is searching.
-
-;;;###mh-autoload
-(defun mh-search-folder (folder)
- "Search FOLDER for messages matching a pattern.
-This function uses the MH command `pick' to do the work.
-Add the messages found to the sequence named `search'."
- (interactive (list (mh-prompt-for-folder "Search"
- mh-current-folder
- t)))
- (switch-to-buffer-other-window "pick-pattern")
- (if (or (zerop (buffer-size))
- (not (y-or-n-p "Reuse pattern? ")))
- (mh-make-pick-template)
- (message ""))
- (setq mh-searching-folder folder)
- (message "%s" (substitute-command-keys
- (concat "Type \\[mh-do-pick-search] to search messages, "
- "\\[mh-help] for help."))))
-
-(defun mh-make-pick-template ()
- "Initialize the current buffer with a template for a pick pattern."
- (erase-buffer)
- (insert "From: \n"
- "To: \n"
- "Cc: \n"
- "Date: \n"
- "Subject: \n"
- "---------\n")
- (mh-pick-mode)
- (goto-char (point-min))
- (end-of-line))
-
-;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
-(easy-menu-define
- mh-pick-menu mh-pick-mode-map "Menu for MH-E pick-mode"
- '("Pick"
- ["Execute the Search" mh-do-pick-search t]))
-
-
-;;; Help Messages
-;;; Group messages logically, more or less.
-(defvar mh-pick-mode-help-messages
- '((nil
- "Search messages: \\[mh-do-pick-search]\n"
- "Move to a field by typing C-c C-f C-<field>\n"
- "where <field> is the first letter of the desired field."))
- "Key binding cheat sheet.
-
-This is an associative array which is used to show the most common commands.
-The key is a prefix char. The value is one or more strings which are
-concatenated together and displayed in the minibuffer if ? is pressed after
-the prefix character. The special key nil is used to display the
-non-prefixed commands.
-
-The substitutions described in `substitute-command-keys' are performed as
-well.")
-
-(put 'mh-pick-mode 'mode-class 'special)
-
-(define-derived-mode mh-pick-mode fundamental-mode "MH-Pick"
- "Mode for creating search templates in MH-E.\\<mh-pick-mode-map>
-
-After each field name, enter the pattern to search for. If a field's
-value does not matter for the search, leave it empty. To search the
-entire message, supply the pattern in the \"body\" of the template.
-Each non-empty field must be matched for a message to be selected.
-To effect a logical \"or\", use \\[mh-search-folder] multiple times.
-When you have finished, type \\[mh-do-pick-search] to do the search.
-
-The value of `mh-pick-mode-hook' is a list of functions to be called,
-with no arguments, upon entry to this mode.
-
-\\{mh-pick-mode-map}"
-
- (make-local-variable 'mh-searching-folder)
- (easy-menu-add mh-pick-menu)
- (make-local-variable 'mh-help-messages)
- (setq mh-help-messages mh-pick-mode-help-messages)
- (run-hooks 'mh-pick-mode-hook))
-
-;;;###mh-autoload
-(defun mh-do-pick-search ()
- "Find messages that match the qualifications in the current pattern buffer.
-Messages are searched for in the folder named in `mh-searching-folder'.
-Add the messages found to the sequence named `search'."
- (interactive)
- (let ((pattern-buffer (buffer-name))
- (searching-buffer mh-searching-folder)
- range
- msgs
- (pattern nil)
- (new-buffer nil))
- (save-excursion
- (cond ((get-buffer searching-buffer)
- (set-buffer searching-buffer)
- (setq range (list (format "%d-%d"
- mh-first-msg-num mh-last-msg-num))))
- (t
- (mh-make-folder searching-buffer)
- (setq range '("all"))
- (setq new-buffer t))))
- (message "Searching...")
- (goto-char (point-min))
- (while (and range
- (setq pattern (mh-next-pick-field pattern-buffer)))
- (setq msgs (mh-seq-from-command searching-buffer
- 'search
- (mh-list-to-string
- (list "pick" pattern searching-buffer
- "-list"
- (mh-coalesce-msg-list range)))))
- (setq range msgs)) ;restrict the pick range for next pass
- (message "Searching...done")
- (if new-buffer
- (mh-scan-folder searching-buffer msgs)
- (switch-to-buffer searching-buffer))
- (mh-add-msgs-to-seq msgs 'search)
- (delete-other-windows)))
-
-(defun mh-seq-from-command (folder seq command)
- "In FOLDER, make a sequence named SEQ by executing COMMAND.
-COMMAND is a list. The first element is a program name
-and the subsequent elements are its arguments, all strings."
- (let ((msg)
- (msgs ())
- (case-fold-search t))
- (save-excursion
- (save-window-excursion
- (if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
- ;; "pick" outputs one number per line
- (while (setq msg (car (mh-read-msg-list)))
- (setq msgs (cons msg msgs))
- (forward-line 1))))
- (set-buffer folder)
- (setq msgs (nreverse msgs)) ;put in ascending order
- msgs)))
-
-(defun mh-next-pick-field (buffer)
- "Return the next piece of a pick argument extracted from BUFFER.
-Return a list like (\"--fieldname\" \"pattern\") or (\"-search\" \"bodypat\")
-or nil if no pieces remain."
- (set-buffer buffer)
- (let ((case-fold-search t))
- (cond ((eobp)
- nil)
- ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
- nil t)
- (let* ((component
- (format "--%s"
- (downcase (buffer-substring (match-beginning 1)
- (match-end 1)))))
- (pat (buffer-substring (match-beginning 2) (match-end 2))))
- (forward-line 1)
- (list component pat)))
- ((re-search-forward "^-*$" nil t)
- (forward-char 1)
- (let ((body (buffer-substring (point) (point-max))))
- (if (and (> (length body) 0) (not (equal body "\n")))
- (list "-search" body)
- nil)))
- (t
- nil))))
-
-\f
-
-;;; Build the pick-mode keymap:
-;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
-(gnus-define-keys mh-pick-mode-map
- "\C-c?" mh-help
- "\C-c\C-c" mh-do-pick-search
- "\C-c\C-f\C-b" mh-to-field
- "\C-c\C-f\C-c" mh-to-field
- "\C-c\C-f\C-d" mh-to-field
- "\C-c\C-f\C-f" mh-to-field
- "\C-c\C-f\C-r" mh-to-field
- "\C-c\C-f\C-s" mh-to-field
- "\C-c\C-f\C-t" mh-to-field
- "\C-c\C-fb" mh-to-field
- "\C-c\C-fc" mh-to-field
- "\C-c\C-fd" mh-to-field
- "\C-c\C-ff" mh-to-field
- "\C-c\C-fr" mh-to-field
- "\C-c\C-fs" mh-to-field
- "\C-c\C-ft" mh-to-field)
-
-(provide 'mh-pick)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-pick.el ends here
+++ /dev/null
-;;; mh-seq.el --- MH-E sequences support
-
-;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-;; This tries to implement the algorithm described at:
-;; http://www.jwz.org/doc/threading.html
-;; It is also a start to implementing the IMAP Threading extension RFC. The
-;; implementation lacks the reference and subject canonicalization of the
-;; RFC.
-;;
-;; In the presentation buffer, children messages are shown indented with
-;; either [ ] or < > around them. Square brackets ([ ]) denote that the
-;; algorithm can point out some headers which when taken together implies
-;; that the unindented message is an ancestor of the indented message. If
-;; no such proof exists then angles (< >) are used.
-;;
-;; Some issues and problems are as follows:
-;;
-;; (1) Scan truncates the fields at length 512. So longer references:
-;; headers get mutilated. The same kind of MH format string works when
-;; composing messages. Is there a way to avoid this? My scan command
-;; is as follows:
-;; scan +folder -width 10000 \
-;; -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
-;; I would really appreciate it if someone would help me with this.
-;;
-;; (2) Implement heuristics to recognize message-id's in In-Reply-To:
-;; header. Right now it just assumes that the last text between angles
-;; (< and >) is the message-id. There is the chance that this will
-;; incorrectly use an email address like a message-id.
-;;
-;; (3) Error checking of found message-id's should be done.
-;;
-;; (4) Since this breaks the assumption that message indices increase as
-;; one goes down the buffer, the binary search based mh-goto-msg
-;; doesn't work. I have a simpler replacement which may be less
-;; efficient.
-;;
-;; (5) Better canonicalizing for message-id and subject strings.
-;;
-
-;; Internal support for MH-E package.
-
-;;; Change Log:
-
-;; $Id: mh-seq.el,v 1.84 2003/01/07 21:15:33 satyaki Exp $
-
-;;; Code:
-
-(require 'cl)
-(require 'mh-e)
-
-;; Shush the byte-compiler
-(defvar tool-bar-mode)
-
-;;; Data structures (used in message threading)...
-(defstruct (mh-thread-message (:conc-name mh-message-)
- (:constructor mh-thread-make-message))
- (id nil)
- (references ())
- (subject "")
- (subject-re-p nil))
-
-(defstruct (mh-thread-container (:conc-name mh-container-)
- (:constructor mh-thread-make-container))
- message parent children
- (real-child-p t))
-
-
-;;; Internal variables:
-(defvar mh-last-seq-used nil
- "Name of seq to which a msg was last added.")
-
-(defvar mh-non-seq-mode-line-annotation nil
- "Saved value of `mh-mode-line-annotation' when narrowed to a seq.")
-
-;;; Maps and hashes...
-(defvar mh-thread-id-hash nil
- "Hashtable used to canonicalize message-id strings.")
-(defvar mh-thread-subject-hash nil
- "Hashtable used to canonicalize subject strings.")
-(defvar mh-thread-id-table nil
- "Thread ID table maps from message-id's to message containers.")
-(defvar mh-thread-id-index-map nil
- "Table to lookup message index number from message-id.")
-(defvar mh-thread-index-id-map nil
- "Table to lookup message-id from message index.")
-(defvar mh-thread-scan-line-map nil
- "Map of message index to various parts of the scan line.")
-(defvar mh-thread-old-scan-line-map nil
- "Old map of message index to various parts of the scan line.
-This is the original map that is stored when the folder is narrowed.")
-(defvar mh-thread-subject-container-hash nil
- "Hashtable used to group messages by subject.")
-(defvar mh-thread-duplicates nil
- "Hashtable used to remember multiple messages with the same message-id.")
-(defvar mh-thread-history ()
- "Variable to remember the transformations to the thread tree.
-When new messages are added, these transformations are rewound, then the
-links are added from the newly seen messages. Finally the transformations are
-redone to get the new thread tree. This makes incremental threading easier.")
-(defvar mh-thread-body-width nil
- "Width of scan substring that contains subject and body of message.")
-
-(make-variable-buffer-local 'mh-thread-id-hash)
-(make-variable-buffer-local 'mh-thread-subject-hash)
-(make-variable-buffer-local 'mh-thread-id-table)
-(make-variable-buffer-local 'mh-thread-id-index-map)
-(make-variable-buffer-local 'mh-thread-index-id-map)
-(make-variable-buffer-local 'mh-thread-scan-line-map)
-(make-variable-buffer-local 'mh-thread-old-scan-line-map)
-(make-variable-buffer-local 'mh-thread-subject-container-hash)
-(make-variable-buffer-local 'mh-thread-duplicates)
-(make-variable-buffer-local 'mh-thread-history)
-
-;;;###mh-autoload
-(defun mh-delete-seq (sequence)
- "Delete the SEQUENCE."
- (interactive (list (mh-read-seq-default "Delete" t)))
- (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
- sequence)
- (mh-undefine-sequence sequence '("all"))
- (mh-delete-seq-locally sequence))
-
-;; Avoid compiler warnings
-(defvar view-exit-action)
-
-;;;###mh-autoload
-(defun mh-list-sequences ()
- "List the sequences defined in the folder being visited."
- (interactive)
- (let ((folder mh-current-folder)
- (temp-buffer mh-temp-sequences-buffer)
- (seq-list mh-seq-list)
- (max-len 0))
- (with-output-to-temp-buffer temp-buffer
- (save-excursion
- (set-buffer temp-buffer)
- (erase-buffer)
- (message "Listing sequences ...")
- (insert "Sequences in folder " folder ":\n")
- (let ((seq-list seq-list))
- (while seq-list
- (setq max-len
- (max (length (symbol-name (mh-seq-name (pop seq-list))))
- max-len)))
- (setq max-len (+ 2 max-len)))
- (while seq-list
- (let ((name (mh-seq-name (car seq-list)))
- (sorted-seq-msgs
- (mh-coalesce-msg-list
- (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
- name-spec)
- (insert (setq name-spec (format (format "%%%ss:" max-len) name)))
- (while sorted-seq-msgs
- (let ((next-element (format " %s" (pop sorted-seq-msgs))))
- (when (>= (+ (current-column) (length next-element))
- (window-width))
- (insert "\n")
- (insert (format (format "%%%ss" (length name-spec)) "")))
- (insert next-element)))
- (insert "\n"))
- (setq seq-list (cdr seq-list)))
- (goto-char (point-min))
- (view-mode 1)
- (setq view-exit-action 'kill-buffer)
- (message "Listing sequences...done")))))
-
-;;;###mh-autoload
-(defun mh-msg-is-in-seq (message)
- "Display the sequences that contain MESSAGE (default: current message)."
- (interactive (list (mh-get-msg-num t)))
- (let* ((dest-folder (loop for seq in mh-refile-list
- when (member message (cdr seq)) return (car seq)))
- (deleted-flag (unless dest-folder (member message mh-delete-list))))
- (message "Message %d%s is in sequences: %s"
- message
- (cond (dest-folder (format " (to be refiled to %s)" dest-folder))
- (deleted-flag (format " (to be deleted)"))
- (t ""))
- (mapconcat 'concat
- (mh-list-to-string (mh-seq-containing-msg message t))
- " "))))
-
-;;;###mh-autoload
-(defun mh-narrow-to-seq (sequence)
- "Restrict display of this folder to just messages in SEQUENCE.
-Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
- (interactive (list (mh-read-seq "Narrow to" t)))
- (with-mh-folder-updating (t)
- (cond ((mh-seq-to-msgs sequence)
- (mh-widen)
- (mh-remove-all-notation)
- (let ((eob (point-max))
- (msg-at-cursor (mh-get-msg-num nil)))
- (setq mh-thread-old-scan-line-map mh-thread-scan-line-map)
- (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
- (mh-copy-seq-to-eob sequence)
- (narrow-to-region eob (point-max))
- (mh-notate-user-sequences)
- (mh-notate-deleted-and-refiled)
- (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
- (when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
- (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
- (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
- (setq mh-mode-line-annotation (symbol-name sequence))
- (mh-make-folder-mode-line)
- (mh-recenter nil)
- (if (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map)
- mh-folder-seq-tool-bar-map))
- (setq mh-narrowed-to-seq sequence)
- (push 'widen mh-view-ops)))
- (t
- (error "No messages in sequence `%s'" (symbol-name sequence))))))
-
-;;;###mh-autoload
-(defun mh-put-msg-in-seq (msg-or-seq sequence)
- "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
-If optional prefix argument provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then
-the selected region is added to the sequence."
- (interactive (list (cond
- ((mh-mark-active-p t)
- (mh-region-to-msg-list (region-beginning) (region-end)))
- (current-prefix-arg
- (mh-read-seq-default "Add messages from" t))
- (t
- (mh-get-msg-num t)))
- (mh-read-seq-default "Add to" nil)))
- (if (not (mh-internal-seq sequence))
- (setq mh-last-seq-used sequence))
- (mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq))
- ((listp msg-or-seq) msg-or-seq)
- (t (mh-seq-to-msgs msg-or-seq)))
- sequence))
-
-(defun mh-valid-view-change-operation-p (op)
- "Check if the view change operation can be performed.
-OP is one of 'widen and 'unthread."
- (cond ((eq (car mh-view-ops) op)
- (pop mh-view-ops))
- (t nil)))
-
-;;;###mh-autoload
-(defun mh-widen ()
- "Remove restrictions from current folder, thereby showing all messages."
- (interactive)
- (let ((msg (mh-get-msg-num nil)))
- (when mh-narrowed-to-seq
- (cond ((mh-valid-view-change-operation-p 'widen) nil)
- ((memq 'widen mh-view-ops)
- (while (not (eq (car mh-view-ops) 'widen))
- (setq mh-view-ops (cdr mh-view-ops)))
- (pop mh-view-ops))
- (t (error "Widening is not applicable")))
- (when (memq 'unthread mh-view-ops)
- (setq mh-thread-scan-line-map mh-thread-old-scan-line-map))
- (with-mh-folder-updating (t)
- (delete-region (point-min) (point-max))
- (widen)
- (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
- (mh-make-folder-mode-line))
- (if msg
- (mh-goto-msg msg t t))
- (mh-notate-deleted-and-refiled)
- (mh-notate-user-sequences)
- (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
- (mh-recenter nil)))
- (if (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
- (setq mh-narrowed-to-seq nil))
-
-;; FIXME? We may want to clear all notations and add one for current-message
-;; and process user sequences.
-(defun mh-notate-deleted-and-refiled ()
- "Notate messages marked for deletion or refiling.
-Messages to be deleted are given by `mh-delete-list' while messages to be
-refiled are present in `mh-refile-list'."
- (mh-mapc #'(lambda (msg) (mh-notate msg mh-note-deleted mh-cmd-note))
- mh-delete-list)
- (mh-mapc #'(lambda (dest-msg-list)
- ;; foreach folder name, get the keyed sequence from mh-seq-list
- (let ((msg-list (cdr dest-msg-list)))
- (mh-mapc #'(lambda (msg)
- (mh-notate msg mh-note-refiled mh-cmd-note))
- msg-list)))
- mh-refile-list))
-
-\f
-
-;;; Commands to manipulate sequences. Sequences are stored in an alist
-;;; of the form:
-;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
-
-(defun mh-read-seq-default (prompt not-empty)
- "Read and return sequence name with default narrowed or previous sequence.
-PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
-non-empty sequence is read."
- (mh-read-seq prompt not-empty
- (or mh-narrowed-to-seq
- mh-last-seq-used
- (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
-
-(defun mh-read-seq (prompt not-empty &optional default)
- "Read and return a sequence name.
-Prompt with PROMPT, raise an error if the sequence is empty and the NOT-EMPTY
-flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%'
-defaults to the first sequence containing the current message."
- (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
- (if default
- (format "[%s] " default)
- ""))
- (mh-seq-names mh-seq-list)))
- (seq (cond ((equal input "%")
- (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
- ((equal input "") default)
- (t (intern input))))
- (msgs (mh-seq-to-msgs seq)))
- (if (and (null msgs) not-empty)
- (error "No messages in sequence `%s'" seq))
- seq))
-
-(defun mh-seq-names (seq-list)
- "Return an alist containing the names of the SEQ-LIST."
- (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
- seq-list))
-
-;;;###mh-autoload
-(defun mh-rename-seq (sequence new-name)
- "Rename SEQUENCE to have NEW-NAME."
- (interactive (list (mh-read-seq "Old" t)
- (intern (read-string "New sequence name: "))))
- (let ((old-seq (mh-find-seq sequence)))
- (or old-seq
- (error "Sequence %s does not exist" sequence))
- ;; create new sequence first, since it might raise an error.
- (mh-define-sequence new-name (mh-seq-msgs old-seq))
- (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
- (rplaca old-seq new-name)))
-
-;;;###mh-autoload
-(defun mh-map-to-seq-msgs (func seq &rest args)
- "Invoke the FUNC at each message in the SEQ.
-SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
-passed as arguments to FUNC."
- (save-excursion
- (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
- (while msgs
- (if (mh-goto-msg (car msgs) t t)
- (apply func (car msgs) args))
- (setq msgs (cdr msgs))))))
-
-;;;###mh-autoload
-(defun mh-notate-seq (seq notation offset)
- "Mark the scan listing.
-All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
-the line."
- (mh-map-to-seq-msgs 'mh-notate seq notation offset))
-
-;;;###mh-autoload
-(defun mh-add-to-sequence (seq msgs)
- "The sequence SEQ is augmented with the messages in MSGS."
- ;; Add to a SEQUENCE each message the list of MSGS.
- (if (not (mh-folder-name-p seq))
- (if msgs
- (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
- "-sequence" (symbol-name seq)
- (mh-coalesce-msg-list msgs)))))
-
-;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
-;; that the folder buffer is sorted. However in this case that assumption
-;; doesn't hold. So we will do this the dumb way.
-;(defun mh-copy-seq-to-point (seq location)
-; ;; Copy the scan listing of the messages in SEQUENCE to after the point
-; ;; LOCATION in the current buffer.
-; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
-
-(defun mh-copy-seq-to-eob (seq)
- "Copy SEQ to the end of the buffer."
- ;; It is quite involved to write something which will work at any place in
- ;; the buffer, so we will write something which works only at the end of
- ;; the buffer. If we ever need to insert sequences in the middle of the
- ;; buffer, this will need to be fixed.
- (save-excursion
- (let* ((msgs (mh-seq-to-msgs seq))
- (coalesced-msgs (mh-coalesce-msg-list msgs)))
- (goto-char (point-max))
- (save-restriction
- (narrow-to-region (point) (point))
- (mh-regenerate-headers coalesced-msgs t)
- (cond ((memq 'unthread mh-view-ops)
- ;; Populate restricted scan-line map
- (goto-char (point-min))
- (while (not (eobp))
- (let ((msg (mh-get-msg-num nil)))
- (when (numberp msg)
- (setf (gethash msg mh-thread-scan-line-map)
- (mh-thread-parse-scan-line))))
- (forward-line))
- ;; Remove scan lines and read results from pre-computed tree
- (delete-region (point-min) (point-max))
- (let ((thread-tree (mh-thread-generate mh-current-folder ()))
- (mh-thread-body-width
- (- (window-width) mh-cmd-note
- (1- mh-scan-field-subject-start-offset)))
- (mh-thread-last-ancestor nil))
- (mh-thread-generate-scan-lines thread-tree -2)))
- (mh-index-data
- (mh-index-insert-folder-headers)))))))
-
-(defun mh-copy-line-to-point (msg location)
- "Copy current message line to a specific location.
-The argument MSG is not used. The message in the current line is copied to
-LOCATION."
- ;; msg is not used?
- ;; Copy the current line to the LOCATION in the current buffer.
- (beginning-of-line)
- (save-excursion
- (let ((beginning-of-line (point))
- end)
- (forward-line 1)
- (setq end (point))
- (goto-char location)
- (insert-buffer-substring (current-buffer) beginning-of-line end))))
-
-;;;###mh-autoload
-(defun mh-region-to-msg-list (begin end)
- "Return a list of messages within the region between BEGIN and END."
- (save-excursion
- ;; If end is end of buffer back up one position
- (setq end (if (equal end (point-max)) (1- end) end))
- (goto-char begin)
- (let ((result ()))
- (while (<= (point) end)
- (let ((index (mh-get-msg-num nil)))
- (when (numberp index) (push index result)))
- (forward-line 1))
- result)))
-
-\f
-
-;;; Commands to handle new 'subject sequence.
-;;; Or "Poor man's threading" by psg.
-
-(defun mh-subject-to-sequence (all)
- "Put all following messages with same subject in sequence 'subject.
-If arg ALL is t, move to beginning of folder buffer to collect all messages.
-If arg ALL is nil, collect only messages fron current one on forward.
-
-Return number of messages put in the sequence:
-
- nil -> there was no subject line.
- 0 -> there were no later messages with the same subject (sequence not made)
- >1 -> the total number of messages including current one."
- (if (not (eq major-mode 'mh-folder-mode))
- (error "Not in a folder buffer"))
- (save-excursion
- (beginning-of-line)
- (if (or (not (looking-at mh-scan-subject-regexp))
- (not (match-string 3))
- (string-equal "" (match-string 3)))
- (progn (message "No subject line.")
- nil)
- (let ((subject (match-string-no-properties 3))
- (list))
- (if (> (length subject) 41)
- (setq subject (substring subject 0 41)))
- (save-excursion
- (if all
- (goto-char (point-min)))
- (while (re-search-forward mh-scan-subject-regexp nil t)
- (let ((this-subject (match-string-no-properties 3)))
- (if (> (length this-subject) 41)
- (setq this-subject (substring this-subject 0 41)))
- (if (string-equal this-subject subject)
- (setq list (cons (mh-get-msg-num t) list))))))
- (cond
- (list
- ;; If we created a new sequence, add the initial message to it too.
- (if (not (member (mh-get-msg-num t) list))
- (setq list (cons (mh-get-msg-num t) list)))
- (if (member '("subject") (mh-seq-names mh-seq-list))
- (mh-delete-seq 'subject))
- ;; sort the result into a sequence
- (let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
- (while sorted-list
- (mh-add-msgs-to-seq (car sorted-list) 'subject nil)
- (setq sorted-list (cdr sorted-list)))
- (safe-length list)))
- (t
- 0))))))
-
-;;;###mh-autoload
-(defun mh-narrow-to-subject ()
- "Narrow to a sequence containing all following messages with same subject."
- (interactive)
- (let ((num (mh-get-msg-num nil))
- (count (mh-subject-to-sequence t)))
- (cond
- ((not count) ; No subject line, delete msg anyway
- nil)
- ((= 0 count) ; No other msgs, delete msg anyway.
- (message "No other messages with same Subject following this one.")
- nil)
- (t ; We have a subject sequence.
- (message "Found %d messages for subject sequence." count)
- (mh-narrow-to-seq 'subject)
- (if (numberp num)
- (mh-goto-msg num t t))))))
-
-;;;###mh-autoload
-(defun mh-delete-subject ()
- "Mark all following messages with same subject to be deleted.
-This puts the messages in a sequence named subject. You can undo the last
-deletion marks using `mh-undo' with a prefix argument and then specifying the
-subject sequence."
- (interactive)
- (let ((count (mh-subject-to-sequence nil)))
- (cond
- ((not count) ; No subject line, delete msg anyway
- (mh-delete-msg (mh-get-msg-num t)))
- ((= 0 count) ; No other msgs, delete msg anyway.
- (message "No other messages with same Subject following this one.")
- (mh-delete-msg (mh-get-msg-num t)))
- (t ; We have a subject sequence.
- (message "Marked %d messages for deletion" count)
- (mh-delete-msg 'subject)))))
-
-;;;###mh-autoload
-(defun mh-delete-subject-or-thread ()
- "Mark messages for deletion intelligently.
-If the folder is threaded then `mh-thread-delete' is used to mark the current
-message and all its descendants for deletion. Otherwise `mh-delete-subject' is
-used to mark the current message and all messages following it with the same
-subject for deletion."
- (interactive)
- (if (memq 'unthread mh-view-ops)
- (mh-thread-delete)
- (mh-delete-subject)))
-
-;;; Message threading:
-
-(defun mh-thread-initialize ()
- "Make hash tables, otherwise clear them."
- (cond
- (mh-thread-id-hash
- (clrhash mh-thread-id-hash)
- (clrhash mh-thread-subject-hash)
- (clrhash mh-thread-id-table)
- (clrhash mh-thread-id-index-map)
- (clrhash mh-thread-index-id-map)
- (clrhash mh-thread-scan-line-map)
- (clrhash mh-thread-subject-container-hash)
- (clrhash mh-thread-duplicates)
- (setq mh-thread-history ()))
- (t (setq mh-thread-id-hash (make-hash-table :test #'equal))
- (setq mh-thread-subject-hash (make-hash-table :test #'equal))
- (setq mh-thread-id-table (make-hash-table :test #'eq))
- (setq mh-thread-id-index-map (make-hash-table :test #'eq))
- (setq mh-thread-index-id-map (make-hash-table :test #'eql))
- (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
- (setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
- (setq mh-thread-duplicates (make-hash-table :test #'eq))
- (setq mh-thread-history ()))))
-
-(defsubst mh-thread-id-container (id)
- "Given ID, return the corresponding container in `mh-thread-id-table'.
-If no container exists then a suitable container is created and the id-table
-is updated."
- (when (not id)
- (error "1"))
- (or (gethash id mh-thread-id-table)
- (setf (gethash id mh-thread-id-table)
- (let ((message (mh-thread-make-message :id id)))
- (mh-thread-make-container :message message)))))
-
-(defsubst mh-thread-remove-parent-link (child)
- "Remove parent link of CHILD if it exists."
- (let* ((child-container (if (mh-thread-container-p child)
- child (mh-thread-id-container child)))
- (parent-container (mh-container-parent child-container)))
- (when parent-container
- (setf (mh-container-children parent-container)
- (loop for elem in (mh-container-children parent-container)
- unless (eq child-container elem) collect elem))
- (setf (mh-container-parent child-container) nil))))
-
-(defsubst mh-thread-add-link (parent child &optional at-end-p)
- "Add links so that PARENT becomes a parent of CHILD.
-Doesn't make any changes if CHILD is already an ancestor of PARENT. If
-optional argument AT-END-P is non-nil, the CHILD is added to the end of the
-children list of PARENT."
- (let ((parent-container (cond ((null parent) nil)
- ((mh-thread-container-p parent) parent)
- (t (mh-thread-id-container parent))))
- (child-container (if (mh-thread-container-p child)
- child (mh-thread-id-container child))))
- (when (and parent-container
- (not (mh-thread-ancestor-p child-container parent-container))
- (not (mh-thread-ancestor-p parent-container child-container)))
- (mh-thread-remove-parent-link child-container)
- (cond ((not at-end-p)
- (push child-container (mh-container-children parent-container)))
- ((null (mh-container-children parent-container))
- (push child-container (mh-container-children parent-container)))
- (t (let ((last-child (mh-container-children parent-container)))
- (while (cdr last-child)
- (setq last-child (cdr last-child)))
- (setcdr last-child (cons child-container nil)))))
- (setf (mh-container-parent child-container) parent-container))
- (unless parent-container
- (mh-thread-remove-parent-link child-container))))
-
-(defun mh-thread-ancestor-p (ancestor successor)
- "Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise.
-In the limit, the function returns t if ANCESTOR and SUCCESSOR are the same
-containers."
- (block nil
- (while successor
- (when (eq ancestor successor) (return t))
- (setq successor (mh-container-parent successor)))
- nil))
-
-(defsubst mh-thread-get-message-container (message)
- "Return container which has MESSAGE in it.
-If there is no container present then a new container is allocated."
- (let* ((id (mh-message-id message))
- (container (gethash id mh-thread-id-table)))
- (cond (container (setf (mh-container-message container) message)
- container)
- (t (setf (gethash id mh-thread-id-table)
- (mh-thread-make-container :message message))))))
-
-(defsubst mh-thread-get-message (id subject-re-p subject refs)
- "Return appropriate message.
-Otherwise update message already present to have the proper ID, SUBJECT-RE-P,
-SUBJECT and REFS fields."
- (let* ((container (gethash id mh-thread-id-table))
- (message (if container (mh-container-message container) nil)))
- (cond (message
- (setf (mh-message-subject-re-p message) subject-re-p)
- (setf (mh-message-subject message) subject)
- (setf (mh-message-id message) id)
- (setf (mh-message-references message) refs)
- message)
- (container
- (setf (mh-container-message container)
- (mh-thread-make-message :subject subject
- :subject-re-p subject-re-p
- :id id :references refs)))
- (t (let ((message (mh-thread-make-message
- :subject subject
- :subject-re-p subject-re-p
- :id id :references refs)))
- (prog1 message
- (mh-thread-get-message-container message)))))))
-
-(defsubst mh-thread-canonicalize-id (id)
- "Produce canonical string representation for ID.
-This allows cheap string comparison with EQ."
- (or (and (equal id "") (copy-sequence ""))
- (gethash id mh-thread-id-hash)
- (setf (gethash id mh-thread-id-hash) id)))
-
-(defsubst mh-thread-prune-subject (subject)
- "Prune leading Re:'s, Fwd:'s etc. and trailing (fwd)'s from SUBJECT.
-If the result after pruning is not the empty string then it is canonicalized
-so that subjects can be tested for equality with eq. This is done so that all
-the messages without a subject are not put into a single thread."
- (let ((case-fold-search t)
- (subject-pruned-flag nil))
- ;; Prune subject leader
- (while (or (string-match "^[ \t]*\\(re\\|fwd?\\)\\(\\[[0-9]*\\]\\)?:[ \t]*"
- subject)
- (string-match "^[ \t]*\\[[^\\]][ \t]*" subject))
- (setq subject-pruned-flag t)
- (setq subject (substring subject (match-end 0))))
- ;; Prune subject trailer
- (while (or (string-match "(fwd)$" subject)
- (string-match "[ \t]+$" subject))
- (setq subject-pruned-flag t)
- (setq subject (substring subject 0 (match-beginning 0))))
- ;; Canonicalize subject only if it is non-empty
- (cond ((equal subject "") (values subject subject-pruned-flag))
- (t (values
- (or (gethash subject mh-thread-subject-hash)
- (setf (gethash subject mh-thread-subject-hash) subject))
- subject-pruned-flag)))))
-
-(defun mh-thread-container-subject (container)
- "Return the subject of CONTAINER.
-If CONTAINER is empty return the subject info of one of its children."
- (cond ((and (mh-container-message container)
- (mh-message-id (mh-container-message container)))
- (mh-message-subject (mh-container-message container)))
- (t (block nil
- (dolist (kid (mh-container-children container))
- (when (and (mh-container-message kid)
- (mh-message-id (mh-container-message kid)))
- (let ((kid-message (mh-container-message kid)))
- (return (mh-message-subject kid-message)))))
- (error "This can't happen!")))))
-
-(defun mh-thread-rewind-pruning ()
- "Restore the thread tree to its state before pruning."
- (while mh-thread-history
- (let ((action (pop mh-thread-history)))
- (cond ((eq (car action) 'DROP)
- (mh-thread-remove-parent-link (cadr action))
- (mh-thread-add-link (caddr action) (cadr action)))
- ((eq (car action) 'PROMOTE)
- (let ((node (cadr action))
- (parent (caddr action))
- (children (cdddr action)))
- (dolist (child children)
- (mh-thread-remove-parent-link child)
- (mh-thread-add-link node child))
- (mh-thread-add-link parent node)))
- ((eq (car action) 'SUBJECT)
- (let ((node (cadr action)))
- (mh-thread-remove-parent-link node)
- (setf (mh-container-real-child-p node) t)))))))
-
-(defun mh-thread-prune-containers (roots)
- "Prune empty containers in the containers ROOTS."
- (let ((dfs-ordered-nodes ())
- (work-list roots))
- (while work-list
- (let ((node (pop work-list)))
- (dolist (child (mh-container-children node))
- (push child work-list))
- (push node dfs-ordered-nodes)))
- (while dfs-ordered-nodes
- (let ((node (pop dfs-ordered-nodes)))
- (cond ((gethash (mh-message-id (mh-container-message node))
- mh-thread-id-index-map)
- ;; Keep it
- (setf (mh-container-children node)
- (mh-thread-sort-containers (mh-container-children node))))
- ((and (mh-container-children node)
- (or (null (cdr (mh-container-children node)))
- (mh-container-parent node)))
- ;; Promote kids
- (let ((children ()))
- (dolist (kid (mh-container-children node))
- (mh-thread-remove-parent-link kid)
- (mh-thread-add-link (mh-container-parent node) kid)
- (push kid children))
- (push `(PROMOTE ,node ,(mh-container-parent node) ,@children)
- mh-thread-history)
- (mh-thread-remove-parent-link node)))
- ((mh-container-children node)
- ;; Promote the first orphan to parent and add the other kids as
- ;; his children
- (setf (mh-container-children node)
- (mh-thread-sort-containers (mh-container-children node)))
- (let ((new-parent (car (mh-container-children node)))
- (other-kids (cdr (mh-container-children node))))
- (mh-thread-remove-parent-link new-parent)
- (dolist (kid other-kids)
- (mh-thread-remove-parent-link kid)
- (setf (mh-container-real-child-p kid) nil)
- (mh-thread-add-link new-parent kid t))
- (push `(PROMOTE ,node ,(mh-container-parent node)
- ,new-parent ,@other-kids)
- mh-thread-history)
- (mh-thread-remove-parent-link node)))
- (t
- ;; Drop it
- (push `(DROP ,node ,(mh-container-parent node))
- mh-thread-history)
- (mh-thread-remove-parent-link node)))))
- (let ((results ()))
- (maphash #'(lambda (k v)
- (declare (ignore k))
- (when (and (null (mh-container-parent v))
- (gethash (mh-message-id (mh-container-message v))
- mh-thread-id-index-map))
- (push v results)))
- mh-thread-id-table)
- (mh-thread-sort-containers results))))
-
-(defun mh-thread-sort-containers (containers)
- "Sort a list of message CONTAINERS to be in ascending order wrt index."
- (sort containers
- #'(lambda (x y)
- (when (and (mh-container-message x) (mh-container-message y))
- (let* ((id-x (mh-message-id (mh-container-message x)))
- (id-y (mh-message-id (mh-container-message y)))
- (index-x (gethash id-x mh-thread-id-index-map))
- (index-y (gethash id-y mh-thread-id-index-map)))
- (and (integerp index-x) (integerp index-y)
- (< index-x index-y)))))))
-
-(defsubst mh-thread-group-by-subject (roots)
- "Group the set of message containers, ROOTS based on subject.
-Bug: Check for and make sure that something without Re: is made the parent in
-preference to something that has it."
- (clrhash mh-thread-subject-container-hash)
- (let ((results ()))
- (dolist (root roots)
- (let* ((subject (mh-thread-container-subject root))
- (parent (gethash subject mh-thread-subject-container-hash)))
- (cond (parent (mh-thread-remove-parent-link root)
- (mh-thread-add-link parent root t)
- (setf (mh-container-real-child-p root) nil)
- (push `(SUBJECT ,root) mh-thread-history))
- (t
- (setf (gethash subject mh-thread-subject-container-hash) root)
- (push root results)))))
- (nreverse results)))
-
-(defsubst mh-thread-process-in-reply-to (reply-to-header)
- "Extract message id's from REPLY-TO-HEADER.
-Ideally this should have some regexp which will try to guess if a string
-between < and > is a message id and not an email address. For now it will
-take the last string inside angles."
- (let ((end (mh-search-from-end ?> reply-to-header)))
- (when (numberp end)
- (let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end))))
- (when (numberp begin)
- (list (substring reply-to-header begin (1+ end))))))))
-
-(defun mh-thread-set-tables (folder)
- "Use the tables of FOLDER in current buffer."
- (flet ((mh-get-table (symbol)
- (save-excursion
- (set-buffer folder)
- (symbol-value symbol))))
- (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
- (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
- (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
- (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
- (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
- (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
- (setq mh-thread-subject-container-hash
- (mh-get-table 'mh-thread-subject-container-hash))
- (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
- (setq mh-thread-history (mh-get-table 'mh-thread-history))))
-
-(defsubst mh-thread-update-id-index-maps (id index)
- "Message with id, ID is the message in INDEX.
-The function also checks for duplicate messages (that is multiple messages
-with the same ID). These messages are put in the `mh-thread-duplicates' hash
-table."
- (let ((old-index (gethash id mh-thread-id-index-map)))
- (when old-index (push old-index (gethash id mh-thread-duplicates)))
- (setf (gethash id mh-thread-id-index-map) index)
- (setf (gethash index mh-thread-index-id-map) id)))
-
-\f
-
-;;; Generate Threads...
-
-(defun mh-thread-generate (folder msg-list)
- "Scan FOLDER to get info for threading.
-Only information about messages in MSG-LIST are added to the tree."
- (save-excursion
- (set-buffer (get-buffer-create "*mh-thread*"))
- (mh-thread-set-tables folder)
- (erase-buffer)
- (when msg-list
- (apply
- #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
- "-width" "10000" "-format"
- "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
- folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
- (goto-char (point-min))
- (let ((roots ())
- (case-fold-search t))
- (block nil
- (while (not (eobp))
- (block process-message
- (let* ((index-line
- (prog1 (buffer-substring (point) (line-end-position))
- (forward-line)))
- (index (car (read-from-string index-line)))
- (id (prog1 (buffer-substring (point) (line-end-position))
- (forward-line)))
- (refs (prog1 (buffer-substring (point) (line-end-position))
- (forward-line)))
- (in-reply-to (prog1 (buffer-substring (point)
- (line-end-position))
- (forward-line)))
- (subject (prog1
- (buffer-substring (point) (line-end-position))
- (forward-line)))
- (subject-re-p nil))
- (unless (gethash index mh-thread-scan-line-map)
- (return-from process-message))
- (unless (integerp index) (return)) ;Error message here
- (multiple-value-setq (subject subject-re-p)
- (mh-thread-prune-subject subject))
- (setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
- (setq refs (append (split-string refs) in-reply-to))
- (setq id (mh-thread-canonicalize-id id))
- (mh-thread-update-id-index-maps id index)
- (setq refs (mapcar #'mh-thread-canonicalize-id refs))
- (mh-thread-get-message id subject-re-p subject refs)
- (do ((ancestors refs (cdr ancestors)))
- ((null (cdr ancestors))
- (when (car ancestors)
- (mh-thread-remove-parent-link id)
- (mh-thread-add-link (car ancestors) id)))
- (mh-thread-add-link (car ancestors) (cadr ancestors)))))))
- (maphash #'(lambda (k v)
- (declare (ignore k))
- (when (null (mh-container-parent v))
- (push v roots)))
- mh-thread-id-table)
- (setq roots (mh-thread-prune-containers roots))
- (prog1 (setq roots (mh-thread-group-by-subject roots))
- (let ((history mh-thread-history))
- (set-buffer folder)
- (setq mh-thread-history history))))))
-
-;;;###mh-autoload
-(defun mh-thread-inc (folder start-point)
- "Update thread tree for FOLDER.
-All messages after START-POINT are added to the thread tree."
- (mh-thread-rewind-pruning)
- (goto-char start-point)
- (let ((msg-list ()))
- (while (not (eobp))
- (let ((index (mh-get-msg-num nil)))
- (when (numberp index)
- (push index msg-list)
- (setf (gethash index mh-thread-scan-line-map)
- (mh-thread-parse-scan-line)))
- (forward-line)))
- (let ((thread-tree (mh-thread-generate folder msg-list))
- (buffer-read-only nil)
- (old-buffer-modified-flag (buffer-modified-p)))
- (delete-region (point-min) (point-max))
- (let ((mh-thread-body-width (- (window-width) mh-cmd-note
- (1- mh-scan-field-subject-start-offset)))
- (mh-thread-last-ancestor nil))
- (mh-thread-generate-scan-lines thread-tree -2))
- (mh-notate-user-sequences)
- (mh-notate-deleted-and-refiled)
- (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
- (set-buffer-modified-p old-buffer-modified-flag))))
-
-(defvar mh-thread-last-ancestor)
-
-(defun mh-thread-generate-scan-lines (tree level)
- "Generate scan lines.
-TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices
-to the corresponding scan lines and LEVEL used to determine indentation of
-the message."
- (cond ((null tree) nil)
- ((mh-thread-container-p tree)
- (let* ((message (mh-container-message tree))
- (id (mh-message-id message))
- (index (gethash id mh-thread-id-index-map))
- (duplicates (gethash id mh-thread-duplicates))
- (new-level (+ level 2))
- (dupl-flag t)
- (force-angle-flag nil)
- (increment-level-flag nil))
- (dolist (scan-line (mapcar (lambda (x)
- (gethash x mh-thread-scan-line-map))
- (reverse (cons index duplicates))))
- (when scan-line
- (when (and dupl-flag (equal level 0)
- (mh-thread-ancestor-p mh-thread-last-ancestor tree))
- (setq level (+ level 2)
- new-level (+ new-level 2)
- force-angle-flag t))
- (when (equal level 0)
- (setq mh-thread-last-ancestor tree)
- (while (mh-container-parent mh-thread-last-ancestor)
- (setq mh-thread-last-ancestor
- (mh-container-parent mh-thread-last-ancestor))))
- (insert (car scan-line)
- (format (format "%%%ss"
- (if dupl-flag level new-level)) "")
- (if (and (mh-container-real-child-p tree) dupl-flag
- (not force-angle-flag))
- "[" "<")
- (cadr scan-line)
- (if (and (mh-container-real-child-p tree) dupl-flag
- (not force-angle-flag))
- "]" ">")
- (truncate-string-to-width
- (caddr scan-line) (- mh-thread-body-width
- (if dupl-flag level new-level)))
- "\n")
- (setq increment-level-flag t)
- (setq dupl-flag nil)))
- (unless increment-level-flag (setq new-level level))
- (dolist (child (mh-container-children tree))
- (mh-thread-generate-scan-lines child new-level))))
- (t (let ((nlevel (+ level 2)))
- (dolist (ch tree)
- (mh-thread-generate-scan-lines ch nlevel))))))
-
-;; Another and may be better approach would be to generate all the info from
-;; the scan which generates the threading info. For now this will have to do.
-(defun mh-thread-parse-scan-line (&optional string)
- "Parse a scan line.
-If optional argument STRING is given then that is assumed to be the scan line.
-Otherwise uses the line at point as the scan line to parse."
- (let* ((string (or string
- (buffer-substring-no-properties (line-beginning-position)
- (line-end-position))))
- (first-string (substring string 0 (+ mh-cmd-note 8))))
- (setf (elt first-string mh-cmd-note) ? )
- (when (equal (elt first-string (1+ mh-cmd-note)) (elt mh-note-seq 0))
- (setf (elt first-string (1+ mh-cmd-note)) ? ))
- (list first-string
- (substring string
- (+ mh-cmd-note mh-scan-field-from-start-offset)
- (+ mh-cmd-note mh-scan-field-from-end-offset -2))
- (substring string (+ mh-cmd-note mh-scan-field-from-end-offset))
- string)))
-
-;;;###mh-autoload
-(defun mh-thread-add-spaces (count)
- "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
- (let ((spaces (format (format "%%%ss" count) "")))
- (while (not (eobp))
- (let* ((msg-num (mh-get-msg-num nil))
- (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map))))
- (when (numberp msg-num)
- (setf (gethash msg-num mh-thread-scan-line-map)
- (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
- (forward-line 1))))
-
-(defun mh-thread-folder ()
- "Generate thread view of folder."
- (message "Threading %s..." (buffer-name))
- (mh-thread-initialize)
- (goto-char (point-min))
- (while (not (eobp))
- (let ((index (mh-get-msg-num nil)))
- (when (numberp index)
- (setf (gethash index mh-thread-scan-line-map)
- (mh-thread-parse-scan-line))))
- (forward-line))
- (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num))
- (thread-tree (mh-thread-generate (buffer-name) (list range))))
- (delete-region (point-min) (point-max))
- (let ((mh-thread-body-width (- (window-width) mh-cmd-note
- (1- mh-scan-field-subject-start-offset)))
- (mh-thread-last-ancestor nil))
- (mh-thread-generate-scan-lines thread-tree -2))
- (mh-notate-user-sequences)
- (mh-notate-deleted-and-refiled)
- (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
- (message "Threading %s...done" (buffer-name))))
-
-;;;###mh-autoload
-(defun mh-toggle-threads ()
- "Toggle threaded view of folder.
-The conversion of normal view to threaded view is exact, that is the same
-messages are displayed in the folder buffer before and after threading. However
-the conversion from threaded view to normal view is inexact. So more messages
-than were originally present may be shown as a result."
- (interactive)
- (let ((msg-at-point (mh-get-msg-num nil))
- (old-buffer-modified-flag (buffer-modified-p))
- (buffer-read-only nil))
- (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq)
- (unless (mh-valid-view-change-operation-p 'unthread)
- (error "Can't unthread folder"))
- (mh-scan-folder mh-current-folder
- (format "%s" mh-narrowed-to-seq)
- t)
- (when mh-index-data
- (mh-index-insert-folder-headers)))
- ((memq 'unthread mh-view-ops)
- (unless (mh-valid-view-change-operation-p 'unthread)
- (error "Can't unthread folder"))
- (mh-scan-folder mh-current-folder
- (format "%s-%s" mh-first-msg-num mh-last-msg-num)
- t)
- (when mh-index-data
- (mh-index-insert-folder-headers)))
- (t (mh-thread-folder)
- (push 'unthread mh-view-ops)))
- (when msg-at-point (mh-goto-msg msg-at-point t t))
- (set-buffer-modified-p old-buffer-modified-flag)
- (mh-recenter nil)))
-
-;;;###mh-autoload
-(defun mh-thread-forget-message (index)
- "Forget the message INDEX from the threading tables."
- (let* ((id (gethash index mh-thread-index-id-map))
- (id-index (gethash id mh-thread-id-index-map))
- (duplicates (gethash id mh-thread-duplicates)))
- (remhash index mh-thread-index-id-map)
- (cond ((and (eql index id-index) (null duplicates))
- (remhash id mh-thread-id-index-map))
- ((eql index id-index)
- (setf (gethash id mh-thread-id-index-map) (car duplicates))
- (setf (gethash (car duplicates) mh-thread-index-id-map) id)
- (setf (gethash id mh-thread-duplicates) (cdr duplicates)))
- (t
- (setf (gethash id mh-thread-duplicates)
- (remove index duplicates))))))
-
-\f
-
-;;; Operations on threads
-
-(defun mh-thread-current-indentation-level ()
- "Find the number of spaces by which current message is indented."
- (save-excursion
- (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
- mh-scan-date-width 1))
- (level 0))
- (beginning-of-line)
- (forward-char address-start-offset)
- (while (char-equal (char-after) ? )
- (incf level)
- (forward-char))
- level)))
-
-;;;###mh-autoload
-(defun mh-thread-next-sibling (&optional previous-flag)
- "Jump to next sibling.
-With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling."
- (interactive)
- (cond ((not (memq 'unthread mh-view-ops))
- (error "Folder isn't threaded"))
- ((eobp)
- (error "No message at point")))
- (beginning-of-line)
- (let ((point (point))
- (done nil)
- (my-level (mh-thread-current-indentation-level)))
- (while (and (not done)
- (equal (forward-line (if previous-flag -1 1)) 0)
- (not (eobp)))
- (let ((level (mh-thread-current-indentation-level)))
- (cond ((equal level my-level)
- (setq done 'success))
- ((< level my-level)
- (message "No %s sibling" (if previous-flag "previous" "next"))
- (setq done 'failure)))))
- (cond ((eq done 'success) (mh-maybe-show))
- ((eq done 'failure) (goto-char point))
- (t (message "No %s sibling" (if previous-flag "previous" "next"))
- (goto-char point)))))
-
-;;;###mh-autoload
-(defun mh-thread-previous-sibling ()
- "Jump to previous sibling."
- (interactive)
- (mh-thread-next-sibling t))
-
-(defun mh-thread-immediate-ancestor ()
- "Jump to immediate ancestor in thread tree."
- (beginning-of-line)
- (let ((point (point))
- (ancestor-level (- (mh-thread-current-indentation-level) 2))
- (done nil))
- (if (< ancestor-level 0)
- nil
- (while (and (not done) (equal (forward-line -1) 0))
- (when (equal ancestor-level (mh-thread-current-indentation-level))
- (setq done t)))
- (unless done
- (goto-char point))
- done)))
-
-;;;###mh-autoload
-(defun mh-thread-ancestor (&optional thread-root-flag)
- "Jump to the ancestor of current message.
-If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
-thread tree the message belongs to."
- (interactive "P")
- (beginning-of-line)
- (cond ((not (memq 'unthread mh-view-ops))
- (error "Folder isn't threaded"))
- ((eobp)
- (error "No message at point")))
- (let ((current-level (mh-thread-current-indentation-level)))
- (cond (thread-root-flag
- (while (mh-thread-immediate-ancestor))
- (mh-maybe-show))
- ((equal current-level 1)
- (message "Message has no ancestor"))
- (t (mh-thread-immediate-ancestor)
- (mh-maybe-show)))))
-
-(defun mh-thread-find-children ()
- "Return a region containing the current message and its children.
-The result is returned as a list of two elements. The first is the point at the
-start of the region and the second is the point at the end."
- (beginning-of-line)
- (if (eobp)
- nil
- (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
- mh-scan-date-width 1))
- (level (mh-thread-current-indentation-level))
- spaces begin)
- (setq begin (point))
- (setq spaces (format (format "%%%ss" (1+ level)) ""))
- (forward-line)
- (block nil
- (while (not (eobp))
- (forward-char address-start-offset)
- (unless (equal (string-match spaces (buffer-substring-no-properties
- (point) (line-end-position)))
- 0)
- (beginning-of-line)
- (backward-char)
- (return))
- (forward-line)))
- (list begin (point)))))
-
-;;;###mh-autoload
-(defun mh-thread-delete ()
- "Mark current message and all its children for subsequent deletion."
- (interactive)
- (cond ((not (memq 'unthread mh-view-ops))
- (error "Folder isn't threaded"))
- ((eobp)
- (error "No message at point"))
- (t (mh-delete-msg
- (apply #'mh-region-to-msg-list (mh-thread-find-children))))))
-
-;; This doesn't handle mh-default-folder-for-message-function. We should
-;; refactor that code so that we don't copy it.
-;;;###mh-autoload
-(defun mh-thread-refile (folder)
- "Mark current message and all its children for refiling to FOLDER."
- (interactive (list
- (intern (mh-prompt-for-folder
- "Destination"
- (cond ((eq 'refile (car mh-last-destination-folder))
- (symbol-name (cdr mh-last-destination-folder)))
- (t ""))
- t))))
- (cond ((not (memq 'unthread mh-view-ops))
- (error "Folder isn't threaded"))
- ((eobp)
- (error "No message at point"))
- (t (mh-refile-msg
- (apply #'mh-region-to-msg-list (mh-thread-find-children))
- folder))))
-
-(provide 'mh-seq)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-seq.el ends here
+++ /dev/null
-;;; mh-speed.el --- Speedbar interface for MH-E.
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; Future versions should only use flists.
-
-;; Speedbar support for MH-E package.
-
-;;; Change Log:
-
-;; $Id: mh-speed.el,v 1.34 2003/01/07 21:15:20 satyaki Exp $
-
-;;; Code:
-
-;; Requires
-(require 'cl)
-(require 'mh-e)
-(require 'speedbar)
-
-;; Global variables
-(defvar mh-speed-refresh-flag nil)
-(defvar mh-speed-last-selected-folder nil)
-(defvar mh-speed-folder-map (make-hash-table :test #'equal))
-(defvar mh-speed-folders-cache (make-hash-table :test #'equal))
-(defvar mh-speed-flists-cache (make-hash-table :test #'equal))
-(defvar mh-speed-flists-process nil)
-(defvar mh-speed-flists-timer nil)
-(defvar mh-speed-partial-line "")
-
-;; Add our stealth update function
-(unless (member 'mh-speed-stealth-update
- (cdr (assoc "files" speedbar-stealthy-function-list)))
- ;; Is changing constant lists in elisp safe?
- (setq speedbar-stealthy-function-list
- (copy-tree speedbar-stealthy-function-list))
- (push 'mh-speed-stealth-update
- (cdr (assoc "files" speedbar-stealthy-function-list))))
-
-;; Functions called by speedbar to initialize display...
-;;;###mh-autoload
-(defun mh-folder-speedbar-buttons (buffer)
- "Interface function to create MH-E speedbar buffer.
-BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
- (unless (get-text-property (point-min) 'mh-level)
- (erase-buffer)
- (clrhash mh-speed-folder-map)
- (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil
- 'mh-speedbar-folder-face 0)
- (forward-line -1)
- (setf (gethash nil mh-speed-folder-map)
- (set-marker (make-marker) (1+ (line-beginning-position))))
- (add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
- `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
- (mh-speed-stealth-update t)
- (when mh-speed-run-flists-flag
- (mh-speed-flists nil))))
-
-;;;###mh-autoload
-(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
-;;;###mh-autoload
-(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
-
-;; Keymaps for speedbar...
-(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
- "Specialized speedbar keymap for MH-E buffers.")
-(gnus-define-keys mh-folder-speedbar-key-map
- "+" mh-speed-expand-folder
- "-" mh-speed-contract-folder
- "\r" mh-speed-view
- "f" mh-speed-flists
- "i" mh-speed-invalidate-map)
-
-(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
-(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
-
-;; Menus for speedbar...
-(defvar mh-folder-speedbar-menu-items
- '(["Visit Folder" mh-speed-view
- (save-excursion
- (set-buffer speedbar-buffer)
- (get-text-property (line-beginning-position) 'mh-folder))]
- ["Expand nested folders" mh-speed-expand-folder
- (and (get-text-property (line-beginning-position) 'mh-children-p)
- (not (get-text-property (line-beginning-position) 'mh-expanded)))]
- ["Contract nested folders" mh-speed-contract-folder
- (and (get-text-property (line-beginning-position) 'mh-children-p)
- (get-text-property (line-beginning-position) 'mh-expanded))]
- ["Run Flists" mh-speed-flists t]
- ["Invalidate cached folders" mh-speed-invalidate-map t])
- "Extra menu items for speedbar.")
-
-(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
-(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
-
-(defmacro mh-speed-select-attached-frame ()
- "Compatibility macro to handle speedbar versions 0.11a and 0.14beta4."
- (cond ((fboundp 'dframe-select-attached-frame)
- '(dframe-select-attached-frame speedbar-frame))
- ((boundp 'speedbar-attached-frame)
- '(select-frame speedbar-attached-frame))
- (t (error "Installed speedbar version not supported by MH-E"))))
-
-(defun mh-speed-update-current-folder (force)
- "Update speedbar highlighting of the current folder.
-The function tries to be smart so that work done is minimized. The currently
-highlighted folder is cached and no highlighting happens unless it changes.
-Also highlighting is suspended while the speedbar frame is selected.
-Otherwise you get the disconcerting behavior of folders popping open on their
-own when you are trying to navigate around in the speedbar buffer.
-
-The update is always carried out if FORCE is non-nil."
- (let* ((lastf (selected-frame))
- (newcf (save-excursion
- (mh-speed-select-attached-frame)
- (prog1 (mh-speed-extract-folder-name (buffer-name))
- (select-frame lastf))))
- (lastb (current-buffer))
- (case-fold-search t))
- (when (or force
- (and mh-speed-refresh-flag (not (eq lastf speedbar-frame)))
- (and (stringp newcf)
- (equal (substring newcf 0 1) "+")
- (not (equal newcf mh-speed-last-selected-folder))))
- (setq mh-speed-refresh-flag nil)
- (select-frame speedbar-frame)
- (set-buffer speedbar-buffer)
-
- ;; Remove highlight from previous match...
- (mh-speed-highlight mh-speed-last-selected-folder
- 'mh-speedbar-folder-face)
-
- ;; If we found a match highlight it...
- (when (mh-speed-goto-folder newcf)
- (mh-speed-highlight newcf 'mh-speedbar-selected-folder-face))
-
- (setq mh-speed-last-selected-folder newcf)
- (speedbar-position-cursor-on-line)
- (set-window-point (frame-first-window speedbar-frame) (point))
- (set-buffer lastb)
- (select-frame lastf))
- (when (eq lastf speedbar-frame)
- (setq mh-speed-refresh-flag t))))
-
-(defun mh-speed-normal-face (face)
- "Return normal face for given FACE."
- (cond ((eq face 'mh-speedbar-folder-with-unseen-messages-face)
- 'mh-speedbar-folder-face)
- ((eq face 'mh-speedbar-selected-folder-with-unseen-messages-face)
- 'mh-speedbar-selected-folder-face)
- (t face)))
-
-(defun mh-speed-bold-face (face)
- "Return bold face for given FACE."
- (cond ((eq face 'mh-speedbar-folder-face)
- 'mh-speedbar-folder-with-unseen-messages-face)
- ((eq face 'mh-speedbar-selected-folder-face)
- 'mh-speedbar-selected-folder-with-unseen-messages-face)
- (t face)))
-
-(defun mh-speed-highlight (folder face)
- "Set FOLDER to FACE."
- (save-excursion
- (speedbar-with-writable
- (goto-char (gethash folder mh-speed-folder-map (point)))
- (beginning-of-line)
- (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
- (setq face (mh-speed-bold-face face))
- (setq face (mh-speed-normal-face face)))
- (beginning-of-line)
- (when (re-search-forward "\\[.\\] " (line-end-position) t)
- (put-text-property (point) (line-end-position) 'face face)))))
-
-(defun mh-speed-stealth-update (&optional force)
- "Do stealth update.
-With non-nil FORCE, the update is always carried out."
- (cond ((save-excursion (set-buffer speedbar-buffer)
- (get-text-property (point-min) 'mh-level))
- ;; Execute this hook and *don't* run anything else
- (mh-speed-update-current-folder force)
- nil)
- ;; Otherwise on to your regular programming
- (t t)))
-
-(defun mh-speed-goto-folder (folder)
- "Move point to line containing FOLDER.
-The function will expand out parent folders of FOLDER if needed."
- (let ((prefix folder)
- (suffix-list ())
- (last-slash t))
- (while (and (not (gethash prefix mh-speed-folder-map)) last-slash)
- (setq last-slash (mh-search-from-end ?/ prefix))
- (when (integerp last-slash)
- (push (substring prefix (1+ last-slash)) suffix-list)
- (setq prefix (substring prefix 0 last-slash))))
- (let ((prefix-position (gethash prefix mh-speed-folder-map)))
- (if prefix-position
- (goto-char prefix-position)
- (goto-char (point-min))
- (mh-speed-toggle)
- (unless (get-text-property (point) 'mh-expanded)
- (mh-speed-toggle))
- (goto-char (gethash prefix mh-speed-folder-map))))
- (while suffix-list
- ;; We always need atleast one toggle. We need two if the directory list
- ;; is stale since a folder was added.
- (when (equal prefix (get-text-property (line-beginning-position)
- 'mh-folder))
- (mh-speed-toggle)
- (unless (get-text-property (point) 'mh-expanded)
- (mh-speed-toggle)))
- (setq prefix (format "%s/%s" prefix (pop suffix-list)))
- (goto-char (gethash prefix mh-speed-folder-map (point))))
- (beginning-of-line)
- (equal folder (get-text-property (point) 'mh-folder))))
-
-(defun mh-speed-extract-folder-name (buffer)
- "Given an MH-E BUFFER find the folder that should be highlighted.
-Do the right thing for the different kinds of buffers that MH-E uses."
- (save-excursion
- (set-buffer buffer)
- (cond ((eq major-mode 'mh-folder-mode)
- mh-current-folder)
- ((eq major-mode 'mh-show-mode)
- (set-buffer mh-show-folder-buffer)
- mh-current-folder)
- ((eq major-mode 'mh-letter-mode)
- (when (string-match mh-user-path buffer-file-name)
- (let* ((rel-path (substring buffer-file-name (match-end 0)))
- (directory-end (mh-search-from-end ?/ rel-path)))
- (when directory-end
- (format "+%s" (substring rel-path 0 directory-end)))))))))
-
-(defun mh-speed-add-buttons (folder level)
- "Add speedbar button for FOLDER which is at indented by LEVEL amount."
- (let ((folder-list (mh-speed-folders folder)))
- (mapc
- (lambda (f)
- (let* ((folder-name (format "%s%s%s" (or folder "+")
- (if folder "/" "") (car f)))
- (counts (gethash folder-name mh-speed-flists-cache)))
- (speedbar-with-writable
- (speedbar-make-tag-line
- 'bracket (if (cdr f) ?+ ? )
- 'mh-speed-toggle nil
- (format "%s%s"
- (car f)
- (if counts
- (format " (%s/%s)" (car counts) (cdr counts))
- ""))
- 'mh-speed-view nil
- (if (and counts (> (car counts) 0))
- 'mh-speedbar-folder-with-unseen-messages-face
- 'mh-speedbar-folder-face)
- level)
- (save-excursion
- (forward-line -1)
- (setf (gethash folder-name mh-speed-folder-map)
- (set-marker (make-marker) (1+ (line-beginning-position))))
- (add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
- `(mh-folder ,folder-name
- mh-expanded nil
- mh-children-p ,(not (not (cdr f)))
- ,@(if counts `(mh-count
- (,(car counts) . ,(cdr counts))) ())
- mh-level ,level))))))
- folder-list)))
-
-;;;###mh-autoload
-(defun mh-speed-toggle (&rest args)
- "Toggle the display of child folders.
-The otional ARGS are ignored and there for compatibilty with speedbar."
- (interactive)
- (declare (ignore args))
- (beginning-of-line)
- (let ((parent (get-text-property (point) 'mh-folder))
- (kids-p (get-text-property (point) 'mh-children-p))
- (expanded (get-text-property (point) 'mh-expanded))
- (level (get-text-property (point) 'mh-level))
- (point (point))
- start-region)
- (speedbar-with-writable
- (cond ((not kids-p) nil)
- (expanded
- (forward-line)
- (setq start-region (point))
- (while (and (get-text-property (point) 'mh-level)
- (> (get-text-property (point) 'mh-level) level))
- (remhash (get-text-property (point) 'mh-folder)
- mh-speed-folder-map)
- (forward-line))
- (delete-region start-region (point))
- (forward-line -1)
- (speedbar-change-expand-button-char ?+)
- (add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
- '(mh-expanded nil)))
- (t
- (forward-line)
- (mh-speed-add-buttons parent (1+ level))
- (goto-char point)
- (speedbar-change-expand-button-char ?-)
- (add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
- `(mh-expanded t)))))))
-
-(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
-(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
-
-;;;###mh-autoload
-(defun mh-speed-view (&rest args)
- "View folder on current line.
-Optional ARGS are ignored."
- (interactive)
- (declare (ignore args))
- (let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
- (range (and (stringp folder) (mh-read-msg-range folder))))
- (when (stringp folder)
- (speedbar-with-attached-buffer
- (mh-visit-folder folder range)
- (delete-other-windows)))))
-
-(defun mh-speed-folders (folder)
- "Find the subfolders of FOLDER.
-The function avoids running folders unnecessarily by caching the results of
-the actual folders call."
- (let ((match (gethash folder mh-speed-folders-cache 'no-result)))
- (cond ((eq match 'no-result)
- (setf (gethash folder mh-speed-folders-cache)
- (mh-speed-folders-actual folder)))
- (t match))))
-
-(defun mh-speed-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* ((folder (cond ((and (stringp folder)
- (equal (substring folder 0 1) "+"))
- folder)
- (t nil)))
- (arg-list `(,(expand-file-name "folders" mh-progs)
- nil (t nil) nil "-noheader" "-norecurse"
- ,@(if (stringp folder) (list folder) ())))
- (results ()))
- (with-temp-buffer
- (apply #'call-process arg-list)
- (goto-char (point-min))
- (while (not (and (eolp) (bolp)))
- (goto-char (line-end-position))
- (let ((has-pos (search-backward " has " (line-beginning-position) t)))
- (when (integerp has-pos)
- (while (or (equal (char-after has-pos) ? )
- (equal (char-after has-pos) ?+))
- (decf has-pos))
- (incf has-pos)
- (let ((name (buffer-substring (line-beginning-position) has-pos)))
- (let ((first-char (substring name 0 1)))
- (unless (or (string-equal first-char ".")
- (string-equal first-char "#")
- (string-equal first-char ","))
- (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))
-
-;;;###mh-autoload
-(defun mh-speed-flists (force)
- "Execute flists -recurse and update message counts.
-If FORCE is non-nil the timer is reset."
- (interactive (list t))
- (when force
- (when (timerp mh-speed-flists-timer)
- (cancel-timer mh-speed-flists-timer))
- (setq mh-speed-flists-timer nil)
- (when (and (processp mh-speed-flists-process)
- (not (eq (process-status mh-speed-flists-process) 'exit)))
- (kill-process mh-speed-flists-process)
- (setq mh-speed-flists-process nil)))
- (unless mh-speed-flists-timer
- (setq mh-speed-flists-timer
- (run-at-time
- nil mh-speed-flists-interval
- (lambda ()
- (unless (and (processp mh-speed-flists-process)
- (not (eq (process-status mh-speed-flists-process)
- 'exit)))
- (setq mh-speed-flists-process
- (start-process (expand-file-name "flists" mh-progs) nil
- "flists" "-recurse"
- "-sequence" (symbol-name mh-unseen-seq)))
- (set-process-filter mh-speed-flists-process
- 'mh-speed-parse-flists-output)))))))
-
-;; Copied from mh-make-folder-list-filter...
-(defun mh-speed-parse-flists-output (process output)
- "Parse the incremental results from flists.
-PROCESS is the flists process and OUTPUT is the results that must be handled
-next."
- (let ((prevailing-match-data (match-data))
- (position 0)
- line-end line folder unseen total)
- (unwind-protect
- (while (setq line-end (string-match "\n" output position))
- (setq line (format "%s%s"
- mh-speed-partial-line
- (substring output position line-end))
- mh-speed-partial-line "")
- (multiple-value-setq (folder unseen total)
- (mh-parse-flist-output-line line))
- (when (and folder unseen total)
- (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
- (save-excursion
- (when (buffer-live-p (get-buffer speedbar-buffer))
- (set-buffer speedbar-buffer)
- (speedbar-with-writable
- (when (get-text-property (point-min) 'mh-level)
- (let ((pos (gethash folder mh-speed-folder-map))
- face)
- (when pos
- (goto-char pos)
- (goto-char (line-beginning-position))
- (cond
- ((null (get-text-property (point) 'mh-count))
- (goto-char (line-end-position))
- (setq face (get-text-property (1- (point)) 'face))
- (insert (format " (%s/%s)" unseen total))
- (mh-speed-highlight 'unknown face)
- (goto-char (line-beginning-position))
- (add-text-properties (point) (1+ (point))
- `(mh-count (,unseen . ,total))))
- ((not (equal (get-text-property (point) 'mh-count)
- (cons unseen total)))
- (goto-char (line-end-position))
- (setq face (get-text-property (1- (point)) 'face))
- (re-search-backward " " (line-beginning-position) t)
- (delete-region (point) (line-end-position))
- (insert (format " (%s/%s)" unseen total))
- (mh-speed-highlight 'unknown face)
- (goto-char (line-beginning-position))
- (add-text-properties
- (point) (1+ (point))
- `(mh-count (,unseen . ,total))))))))))))
- (setq position (1+ line-end)))
- (set-match-data prevailing-match-data))
- (setq mh-speed-partial-line (substring output position))))
-
-;;;###mh-autoload
-(defun mh-speed-invalidate-map (folder)
- "Remove FOLDER from various optimization caches."
- (interactive (list ""))
- (save-excursion
- (set-buffer speedbar-buffer)
- (let* ((speedbar-update-flag nil)
- (last-slash (mh-search-from-end ?/ folder))
- (parent (if last-slash (substring folder 0 last-slash) nil))
- (parent-position (gethash parent mh-speed-folder-map))
- (parent-change nil))
- (remhash parent mh-speed-folders-cache)
- (remhash folder mh-speed-folders-cache)
- (when parent-position
- (let ((parent-kids (mh-speed-folders parent)))
- (cond ((null parent-kids)
- (setq parent-change ?+))
- ((and (null (cdr parent-kids))
- (equal (if last-slash
- (substring folder (1+ last-slash))
- (substring folder 1))
- (caar parent-kids)))
- (setq parent-change ? ))))
- (goto-char parent-position)
- (when (equal (get-text-property (line-beginning-position) 'mh-folder)
- parent)
- (when (get-text-property (line-beginning-position) 'mh-expanded)
- (mh-speed-toggle))
- (when parent-change
- (speedbar-with-writable
- (mh-speedbar-change-expand-button-char parent-change)
- (add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
- `(mh-children-p ,(equal parent-change ?+)))))
- (mh-speed-highlight mh-speed-last-selected-folder
- 'mh-speedbar-folder-face)
- (setq mh-speed-last-selected-folder nil)
- (setq mh-speed-refresh-flag t)))
- (when (equal folder "")
- (clrhash mh-speed-folders-cache)))))
-
-;;;###mh-autoload
-(defun mh-speed-add-folder (folder)
- "Add FOLDER since it is being created.
-The function invalidates the latest ancestor that is present."
- (save-excursion
- (set-buffer speedbar-buffer)
- (let ((speedbar-update-flag nil)
- (last-slash (mh-search-from-end ?/ folder))
- (ancestor folder)
- (ancestor-pos nil))
- (block while-loop
- (while last-slash
- (setq ancestor (substring ancestor 0 last-slash))
- (setq ancestor-pos (gethash ancestor mh-speed-folder-map))
- (when ancestor-pos
- (return-from while-loop))
- (setq last-slash (mh-search-from-end ?/ ancestor))))
- (unless ancestor-pos (setq ancestor nil))
- (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
- (speedbar-with-writable
- (mh-speedbar-change-expand-button-char ?+)
- (add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
- `(mh-children-p t)))
- (when (get-text-property (line-beginning-position) 'mh-expanded)
- (mh-speed-toggle))
- (remhash ancestor mh-speed-folders-cache)
- (setq mh-speed-refresh-flag t))))
-
-;; Make it slightly more general to allow for [ ] buttons to be changed to
-;; [+].
-(defun mh-speedbar-change-expand-button-char (char)
- "Change the expansion button character to CHAR for the current line."
- (save-excursion
- (beginning-of-line)
- (if (re-search-forward "\\[.\\]" (line-end-position) t)
- (speedbar-with-writable
- (backward-char 2)
- (delete-char 1)
- (insert-char char 1 t)
- (put-text-property (point) (1- (point)) 'invisible nil)
- ;; make sure we fix the image on the text here.
- (speedbar-insert-image-button-maybe (- (point) 2) 3)))))
-
-(provide 'mh-speed)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-speed.el ends here
+++ /dev/null
-;;; mh-utils.el --- MH-E code needed for both sending and reading
-
-;; Copyright (C) 1993, 1995, 1997, 2000, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Bill Wohler <wohler@newt.com>
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Internal support for MH-E package.
-
-;;; Change Log:
-
-;; $Id: mh-utils.el,v 1.193 2003/01/08 00:27:31 satyaki Exp $
-
-;;; Code:
-
-;; Is this XEmacs-land? Located here since needed by mh-customize.el.
-(defvar mh-xemacs-flag (featurep 'xemacs)
- "Non-nil means the current Emacs is XEmacs.")
-
-(require 'cl)
-(require 'gnus-util)
-(require 'font-lock)
-(require 'mh-loaddefs)
-(require 'mh-customize)
-
-(load "mm-decode" t t) ; Non-fatal dependency
-(load "mm-view" 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)
-(defvar tool-bar-mode)
-
-;;; Autoloads
-(autoload 'gnus-article-highlight-citation "gnus-cite")
-(autoload 'mail-header-end "sendmail")
-(autoload 'Info-goto-node "info")
-(unless (fboundp 'make-hash-table)
- (autoload 'make-hash-table "cl"))
-
-;;; Set for local environment:
-;;; mh-progs and mh-lib used to be set in paths.el, which tried to
-;;; figure out at build time which of several possible directories MH
-;;; was installed into. But if you installed MH after building Emacs,
-;;; this would almost certainly be wrong, so now we do it at run time.
-
-(defvar mh-progs nil
- "Directory containing MH commands, such as inc, repl, and rmm.")
-
-(defvar mh-lib nil
- "Directory containing the MH library.
-This directory contains, among other things, the components file.")
-
-(defvar mh-lib-progs nil
- "Directory containing MH helper programs.
-This directory contains, among other things, the mhl program.")
-
-(defvar mh-nmh-flag nil
- "Non-nil means nmh is installed on this system instead of MH.")
-
-;;;###autoload
-(put 'mh-progs 'risky-local-variable t)
-;;;###autoload
-(put 'mh-lib 'risky-local-variable t)
-;;;###autoload
-(put 'mh-lib-progs 'risky-local-variable t)
-;;;###autoload
-(put 'mh-nmh-flag 'risky-local-variable t)
-
-;;; 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))
-
-;;; Macro to generate correct code for different emacs variants
-
-(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
- "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
-In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
-variable `transient-mark-mode' is active."
- (cond (mh-xemacs-flag ;XEmacs
- `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
- ((not check-transient-mark-mode-flag) ;GNU Emacs
- `(and (boundp 'mark-active) mark-active))
- (t ;GNU Emacs
- `(and (boundp 'transient-mark-mode) transient-mark-mode
- (boundp 'mark-active) mark-active))))
-
-;;; Additional header fields that might someday be added:
-;;; "Sender: " "Reply-to: "
-
-(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
- "Regexp to find the number of a message in a scan line.
-The message's number must be surrounded with \\( \\)")
-
-(defvar mh-scan-msg-overflow-regexp "^\\?[0-9]"
- "Regexp to find a scan line in which the message number overflowed.
-The message's number is left truncated in this case.")
-
-(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
- "Regexp to find message number width in an scan format.
-The message number width must be surrounded with \\( \\).")
-
-(defvar mh-scan-msg-format-string "%d"
- "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]"
- "Format string containing a regexp matching the scan listing for a message.
-The desired message's number will be an argument to format.")
-
-(defvar mh-default-folder-for-message-function nil
- "Function to select a default folder for refiling or Fcc.
-If set to a function, that function is called with no arguments by
-`\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when
-prompting the user for a folder. The function is called from within a
-`save-excursion', with point at the start of the message. It should
-return the folder to offer as the refile or Fcc folder, as a string
-with a leading `+' sign. It can also return an empty string to use no
-default, or nil to calculate the default the usual way.
-NOTE: This variable is not an ordinary hook;
-It may not be a list of functions.")
-
-(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-cmd-note 4
- "Column to insert notation.
-Use `mh-set-cmd-note' to modify it.
-This value may be dynamically updated if `mh-adaptive-cmd-note-flag' is
-non-nil and `mh-scan-format-file' is t.
-Note that the first column is column number 0.")
-(make-variable-buffer-local 'mh-cmd-note)
-
-(defvar mh-note-seq "%"
- "String whose first character is used to notate messages in a sequence.")
-
-(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'.")
-
-;; Variables for MIME display
-
-;; Structure to keep track of MIME handles on a per buffer basis.
-(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.")
-
-;; Needed by mh-comp.el and mh-mime.el
-(defvar mh-mhn-compose-insert-flag nil
- "Non-nil means MIME insertion was done.
-Triggers an automatic call to `mh-edit-mhn' in `mh-send-letter'.
-This variable is buffer-local.")
-(make-variable-buffer-local 'mh-mhn-compose-insert-flag)
-
-(defvar mh-mml-compose-insert-flag nil
- "Non-nil means that a MIME insertion was done.
-This buffer-local variable is used to remember if a MIME insertion was done.
-Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.")
-(make-variable-buffer-local 'mh-mml-compose-insert-flag)
-
-;; Copy of `goto-address-mail-regexp'
-(defvar mh-address-mail-regexp
- "[-a-zA-Z0-9._]+@[-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.
-;;;###mh-autoload
-(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-in-header-p ()
- "Return non-nil if the point is in the header of a draft message."
- (< (point) (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 (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 (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 "0-9_.@-`'\"")))
- (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.")
-
-(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 (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:
-
-;; The value of `mh-folder-list-change-hook' is called whenever
-;; mh-folder-list variable is set.
-;; List of folder names for completion.
-(defvar mh-folder-list nil)
-
-;; 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)
-
-;; Name of MH-E scratch buffer.
-(defconst mh-temp-buffer " *mh-temp*")
-
-;; Name of the MH-E folder list buffer.
-(defconst mh-temp-folders-buffer "*Folders*")
-
-;; Name of the MH-E sequences list buffer.
-(defconst mh-temp-sequences-buffer "*Sequences*")
-
-;; 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.")
-
-;;; 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 1)
-
-(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 1)
-
-(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))
-
-;;;###mh-autoload
-(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)
- (and (fboundp 'deactivate-mark) (deactivate-mark))
- (unwind-protect
- (prog1 (call-interactively (function ,original-function))
- (setq normal-exit t))
- (and (fboundp 'deactivate-mark) (deactivate-mark))
- (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-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)
-
-;;; Populate mh-show-mode-map
-(gnus-define-keys mh-show-mode-map
- " " mh-show-page-msg
- "!" mh-show-refile-or-write-again
- "," 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
- "l" mh-show-print-msg
- "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
- "S" mh-show-sort-folder
- "f" mh-show-visit-folder
- "i" mh-index-search
- "k" mh-show-kill-folder
- "l" mh-show-list-folders
- "o" mh-show-visit-folder
- "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-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)
-
-(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-prefix-help
- "s" mh-show-narrow-to-subject
- "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
- "v" mh-show-toggle-mime-part
- "o" mh-show-save-mime-part
- "i" mh-show-inline-mime-part
- "\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]
- ["Delete Rest of Same Subject" mh-show-delete-subject 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]
- ["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)
-
-(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."
- (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)
- (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))
- (if (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
- (when mh-decode-mime-flag
- (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))))
-
-(defvar mh-show-xface-function
- (cond ((and mh-xemacs-flag (locate-library "x-face"))
- (load "x-face" t t)
- (if (fboundp 'x-face-xmas-wl-display-x-face)
- #'x-face-xmas-wl-display-x-face
- #'ignore))
- ((and (not mh-xemacs-flag) (>= emacs-major-version 21))
- (load "x-face-e21" t t)
- (if (fboundp 'x-face-decode-message-header)
- #'x-face-decode-message-header
- #'ignore))
- (t #'ignore))
- "Determine at run time what function should be called to display X-Face.")
-
-(defun mh-show-xface ()
- "Display X-Face."
- (when (and mh-show-use-xface-flag
- (or mh-decode-mime-flag mhl-formfile
- mh-clean-message-header-flag))
- (funcall mh-show-xface-function)))
-
-(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)
- "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
-`mh-summary-height') and the show buffer below it.
-If the message is already visible, display the start of the 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)
- (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-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)
- (clean-message-header mh-clean-message-header-flag)
- (show-window (get-buffer-window mh-show-buffer)))
- (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)
- (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) mh-summary-height)))
- (mh-recenter nil)
- (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))
- (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
-`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-decode-quoted-printable ()
- "Run mimedecode on current buffer, replacing its contents."
- (let ((case-fold-search t))
- (goto-char (point-min))
- (when (and (re-search-forward
- "^content-transfer-encoding:[ \t]*quoted-printable"
- (if mh-decode-mime-flag (mail-header-end) nil) t)
- (search-forward "\n\n" nil t))
- (message "Converting quoted-printable characters...")
- (let ((modified (buffer-modified-p))
- (command "mimedecode"))
- (shell-command-on-region (point-min) (point-max) command t t)
- (if (fboundp 'deactivate-mark)
- (deactivate-mark))
- (set-buffer-modified-p modified))
- (message "Converting quoted-printable characters... done."))))
-
-(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 (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-headers)
- (visible-headers mh-visible-headers)
- (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 msg-filename))
- (if mh-decode-quoted-printable-flag
- (mh-decode-quoted-printable))
- ;; 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))
- ;; 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)))
- ;; 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)
- (mh-show-mode)
- (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)))
- (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."
- (let ((case-fold-search t)
- (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))))
- (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."
- (save-excursion
- (if (or (null msg)
- (mh-goto-msg msg t t))
- (with-mh-folder-updating (t)
- (beginning-of-line)
- (forward-char offset)
- (delete-char 1)
- (insert notation)))))
-
-(defun mh-find-msg-get-num (step)
- "Return the message number of the message nearest the cursor.
-Jumps over non-message lines, such as inc errors.
-If we have to search, STEP tells whether to search forward or backward."
- (or (mh-get-msg-num nil)
- (let ((msg-num nil)
- (nreverses 0))
- (while (and (not msg-num)
- (< nreverses 2))
- (cond ((eobp)
- (setq step -1)
- (setq nreverses (1+ nreverses)))
- ((bobp)
- (setq step 1)
- (setq nreverses (1+ nreverses))))
- (forward-line step)
- (setq msg-num (mh-get-msg-num nil)))
- msg-num)))
-
-(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-msg-search-pat (n)
- "Return a search pattern for message N in the scan listing."
- (format mh-scan-msg-search-regexp n))
-
-(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 mail-user-agent)
-(defvar read-mail-command)
-
-(defvar mh-find-path-run nil
- "Non-nil if `mh-find-path' has been run already.")
-
-(defun mh-find-path ()
- "Set `mh-progs', `mh-lib', and `mh-lib-progs' variables.
-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-find-progs)
- (unless mh-find-path-run
- (setq mh-find-path-run t)
- (setq read-mail-command 'mh-rmail)
- (setq mail-user-agent 'mh-e-user-agent))
- (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 "~"))))
- (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)))
- (and mh-auto-folder-collect-flag
- (let ((mh-no-install t)) ;only get folders if MH installed
- (condition-case err
- (mh-make-folder-list-background)
- (file-error))))) ;so don't complain if not installed
-
-(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)))
-
-(defun mh-find-progs ()
- "Find the directories for the installed MH/nmh binaries and config files.
-Set the `mh-progs' and `mh-lib', and `mh-lib-progs' variables to the
-directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
- (unless (and mh-progs mh-lib mh-lib-progs)
- (let ((path (or (mh-path-search exec-path "mhparam")
- (mh-path-search '("/usr/local/nmh/bin" ; nmh default
- "/usr/local/bin/mh/"
- "/usr/local/mh/"
- "/usr/bin/mh/" ;Ultrix 4.2, Linux
- "/usr/new/mh/" ;Ultrix <4.2
- "/usr/contrib/mh/bin/" ;BSDI
- "/usr/pkg/bin/" ; NetBSD
- "/usr/local/bin/"
- )
- "mhparam"))))
- (if (not path)
- (error "Unable to find the `mhparam' command"))
- (save-excursion
- (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
- (set-buffer tmp-buffer)
- (unwind-protect
- (progn
- (call-process (expand-file-name "mhparam" path)
- nil '(t nil) nil "libdir" "etcdir")
- (goto-char (point-min))
- (if (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$"
- nil t)
- (setq mh-lib-progs (match-string 1)
- mh-lib mh-lib-progs
- mh-progs path))
- (goto-char (point-min))
- (if (search-forward-regexp "^etcdir:\\s-\\(\\S-+\\)\\s-*$"
- nil t)
- (setq mh-lib (match-string 1)
- mh-nmh-flag t)))
- (kill-buffer tmp-buffer))))
- (unless (and mh-progs mh-lib mh-lib-progs)
- (error "Unable to determine paths from `mhparam' command")))))
-
-(defun mh-path-search (path file)
- "Search PATH, a list of directory names, for FILE.
-Returns the element of PATH that contains FILE, or nil if not found."
- (while (and path
- (not (funcall 'mh-file-command-p
- (expand-file-name file (car path)))))
- (setq path (cdr path)))
- (car path))
-
-(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 "scan" 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)
- "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."
- (let ((entry (mh-find-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))))))
- (cond ((not internal-flag)
- (mh-add-to-sequence seq msgs)
- (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))
-
-(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-folder-hist nil)
-(defvar mh-speed-folder-map)
-
-(defun mh-prompt-for-folder (prompt default can-create
- &optional default-string)
- "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.
-The value of `mh-folder-list-change-hook' is a list of functions to be called,
-with no arguments, whenever the cached folder list `mh-folder-list' is
-changed."
- (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))
- read-name folder-name)
- (if (null mh-folder-list)
- (mh-set-folder-list))
- (while (and (setq read-name (completing-read prompt mh-folder-list nil nil
- "+" 'mh-folder-hist))
- (equal read-name "")
- (equal default "")))
- (cond ((or (equal read-name "") (equal read-name "+"))
- (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 ((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)
- (when (boundp 'mh-speed-folder-map)
- (mh-speed-add-folder folder-name))
- (message "Creating %s...done" folder-name)
- (setq mh-folder-list (cons (list read-name) mh-folder-list))
- (run-hooks 'mh-folder-list-change-hook))
- (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)))
- ((and (null (assoc read-name mh-folder-list))
- (null (assoc (concat read-name "/") mh-folder-list)))
- (setq mh-folder-list (cons (list read-name) mh-folder-list))
- (run-hooks 'mh-folder-list-change-hook))))
- folder-name))
-
-(defvar mh-make-folder-list-process nil) ;The background process collecting
- ;the folder list.
-
-(defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built.
-
-(defvar mh-folder-list-partial-line "") ;Start of last incomplete line from
- ;folder process.
-
-(defun mh-set-folder-list ()
- "Set `mh-folder-list' correctly.
-A useful function for the command line or for when you need to
-sync by hand. Format is in a form suitable for completing read.
-The value of `mh-folder-list-change-hook' is a list of functions to be called,
-with no arguments, once the list of folders has been created."
- (message "Collecting folder names...")
- (if (not mh-make-folder-list-process)
- (mh-make-folder-list-background))
- (while (eq (process-status mh-make-folder-list-process) 'run)
- (accept-process-output mh-make-folder-list-process))
- (setq mh-folder-list mh-folder-list-temp)
- (run-hooks 'mh-folder-list-change-hook)
- (setq mh-folder-list-temp nil)
- (delete-process mh-make-folder-list-process)
- (setq mh-make-folder-list-process nil)
- (message "Collecting folder names...done"))
-
-(defun mh-make-folder-list-background ()
- "Start a background process to compute a list of the user's folders.
-Call `mh-set-folder-list' to wait for the result."
- (cond
- ((not mh-make-folder-list-process)
- (unless mh-inbox
- (mh-find-path))
- (let ((process-connection-type nil))
- (setq mh-make-folder-list-process
- (start-process "folders" nil (expand-file-name "folders" mh-progs)
- "-fast"
- (if mh-recursive-folders-flag
- "-recurse"
- "-norecurse")))
- (set-process-filter mh-make-folder-list-process
- 'mh-make-folder-list-filter)
- (process-kill-without-query mh-make-folder-list-process)))))
-
-(defun mh-make-folder-list-filter (process output)
- "Given the PROCESS \"folders -fast\", parse OUTPUT.
-See also `set-process-filter'."
- (let ((position 0)
- line-end
- new-folder
- (prevailing-match-data (match-data)))
- (unwind-protect
- ;; make sure got complete line
- (while (setq line-end (string-match "\n" output position))
- (setq new-folder (format "+%s%s"
- mh-folder-list-partial-line
- (substring output position line-end)))
- (setq mh-folder-list-partial-line "")
- ;; is new folder a subfolder of previous?
- (if (and mh-folder-list-temp
- (string-match
- (regexp-quote
- (concat (car (car mh-folder-list-temp)) "/"))
- new-folder))
- ;; append slash to parent folder for better completion
- ;; (undone by mh-prompt-for-folder)
- (setq mh-folder-list-temp
- (cons
- (list new-folder)
- (cons
- (list (concat (car (car mh-folder-list-temp)) "/"))
- (cdr mh-folder-list-temp))))
- (setq mh-folder-list-temp
- (cons (list new-folder)
- mh-folder-list-temp)))
- (setq position (1+ line-end)))
- (set-match-data prevailing-match-data))
- (setq mh-folder-list-partial-line (substring output position))))
-
-;;; 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-temp-buffer))
- (erase-buffer)
- (apply 'call-process
- (expand-file-name command mh-progs) nil t nil
- (mh-list-to-string args))
- (if (> (buffer-size) 0)
- (save-window-excursion
- (switch-to-buffer-other-window mh-temp-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 ((status
- (if env
- ;; the shell hacks necessary here shows just how broken Unix is
- (apply 'call-process "/bin/sh" nil t nil "-c"
- (format "%s %s ${1+\"$@\"}"
- env
- (expand-file-name command mh-progs))
- command
- (mh-list-to-string args))
- (apply 'call-process
- (expand-file-name command mh-progs) nil t nil
- (mh-list-to-string args)))))
- (mh-handle-process-error command status))))
-
-(defun mh-exec-cmd-daemon (command &rest args)
- "Execute MH command COMMAND with ARGS in the background.
-Any output from command is displayed in an asynchronous pop-up window."
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-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 'mh-process-daemon)))
-
-(defun mh-process-daemon (process output)
- "PROCESS daemon that puts OUTPUT into a temporary buffer."
- (set-buffer (get-buffer-create mh-temp-buffer))
- (insert-before-markers output)
- (display-buffer mh-temp-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.
-STATUS is return value from `call-process'.
-Program output is in current buffer.
-If output is too long to include in error message, display the buffer."
- (cond ((eq status 0) ;success
- status)
- ((stringp status) ;kill string
- (error "%s: %s" command status))
- (t ;exit code
- (cond
- ((= (buffer-size) 0) ;program produced no error message
- (error "%s: exit code %d" command status))
- (t
- ;; will error message fit on one line?
- (goto-line 2)
- (if (and (< (buffer-size) (frame-width))
- (eobp))
- (error "%s"
- (buffer-substring 1 (progn (goto-char 1)
- (end-of-line)
- (point))))
- (display-buffer (current-buffer))
- (error "%s failed with status %d. See error message in other window"
- command status)))))))
-
-(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))
-
-(provide 'mh-utils)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-utils.el ends here
+++ /dev/null
-;;; mh-xemacs-compat.el --- GNU Emacs Functions needed by XEmacs
-
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: FSF
-;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Keywords: mail
-;; See: mh-e.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Change Log:
-
-;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $
-
-;;; Code:
-
-;;; Some requires:
-(require 'rfc822)
-
-;;; Simple compatibility:
-
-(unless (fboundp 'match-string-no-properties)
- (defsubst match-string-no-properties (match)
- (buffer-substring-no-properties
- (match-beginning match) (match-end match))))
-
-(unless (fboundp 'line-beginning-position)
- (defalias 'line-beginning-position 'point-at-bol))
-(unless (fboundp 'line-end-position)
- (defalias 'line-end-position 'point-at-eol))
-
-(unless (fboundp 'timerp)
- (defalias 'timerp 'itimerp))
-(unless (fboundp 'cancel-timer)
- (defalias 'cancel-timer 'delete-itimer))
-
-(provide 'mh-xemacs-compat)
-
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
-
-;;; mh-xemacs-compat.el ends here
international \
language \
mail \
+ mh-e \
net \
play \
progmodes \
international \
language \
mail \
+ mh-e \
net \
obsolete \
play \
--- /dev/null
+;;; mh-alias.el --- MH-E mail alias completion and expansion
+;;
+;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Peter S. Galbraith <psg@debian.org>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; [To be deleted when documented in MH-E manual.]
+;;
+;; This module provides mail alias completion when entering addresses.
+;;
+;; Use the TAB key to complete aliases (and optionally local usernames) when
+;; initially composing a message in the To: and Cc: minibuffer prompts. You
+;; may enter multiple addressees separated with a comma (but do *not* add any
+;; space after the comma).
+;;
+;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
+;; complete aliases. This is useful when you want to add an addressee as an
+;; afterthought when creating a message, or when adding an additional
+;; addressee to a reply.
+;;
+;; By default, completion is case-insensitive. This can be changed by
+;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
+;; useful, for example, to differentiate between people aliases in lowercase
+;; such as:
+;;
+;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
+;;
+;; and lists in uppercase such as:
+;;
+;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
+;;
+;; Note that this variable affects minibuffer completion only. If you have an
+;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
+;; be expanded in the letter buffer because MH is case-insensitive.
+;;
+;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
+;; the minibuffer, the expansion for the previous mail alias appears briefly.
+;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
+;;
+;; The addresses and aliases entered in the minibuffer are added to the
+;; message draft. To expand the aliases before they are added to the draft,
+;; customize the variable `mh-alias-expand-aliases-flag'.
+;;
+;; Completion is also performed on usernames extracted from the /etc/passwd
+;; file. This can be a handy tool on a machine where you and co-workers
+;; exchange messages, but should probably be disabled on a system with
+;; thousands of users you don't know. This is done by customizing the
+;; variable `mh-alias-local-users'. This variable also takes a string which
+;; is executed to generate the password file. For example, you'd use "ypcat
+;; passwd" for NIS.
+;;
+;; Aliases are loaded the first time you send mail and get the "To:" prompt
+;; and whenever a source of aliases changes. Sources of system aliases are
+;; defined in the customization variable `mh-alias-system-aliases' and
+;; include:
+;;
+;; /etc/nmh/MailAliases
+;; /usr/lib/mh/MailAliases
+;; /etc/passwd
+;;
+;; Sources of personal aliases are read from the files listed in your MH
+;; profile component Aliasfile. Multiple files are separated by white space
+;; and are relative to your mail directory.
+;;
+;; Alias Insertions
+;; ~~~~~~~~~~~~~~~~
+;; There are commands to insert new aliases into your alias file(s) (defined
+;; by the `Aliasfile' component in the .mh_profile file or by the variable
+;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
+;; an alias from the From line of the current message.
+
+;;; Code:
+
+(require 'mh-e)
+(load "cmr" t t) ; Non-fatal dependency for
+ ; completing-read-multiple.
+(eval-when-compile (defvar mail-abbrev-syntax-table))
+
+;;; Autoloads
+(autoload 'mail-abbrev-complete-alias "mailabbrev")
+(autoload 'multi-prompt "multi-prompt")
+
+(defvar mh-alias-alist nil
+ "Alist of MH aliases.")
+(defvar mh-alias-blind-alist nil
+ "Alist of MH aliases that are blind lists.")
+(defvar mh-alias-passwd-alist nil
+ "Alist of aliases extracted from passwd file and their expansions.")
+(defvar mh-alias-tstamp nil
+ "Time aliases were last loaded.")
+(defvar mh-alias-read-address-map nil)
+(if mh-alias-read-address-map
+ ()
+ (setq mh-alias-read-address-map
+ (copy-keymap minibuffer-local-completion-map))
+ (if mh-alias-flash-on-comma
+ (define-key mh-alias-read-address-map
+ "," 'mh-alias-minibuffer-confirm-address))
+ (define-key mh-alias-read-address-map " " 'self-insert-command))
+
+\f
+;;; Alias Loading
+
+(defun mh-alias-tstamp (arg)
+ "Check whether alias files have been modified.
+Return t if any file listed in the MH profile component Aliasfile has been
+modified since the timestamp.
+If ARG is non-nil, set timestamp with the current time."
+ (if arg
+ (let ((time (current-time)))
+ (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
+ (let ((stamp))
+ (car (memq t (mapcar
+ (function
+ (lambda (file)
+ (when (and file (file-exists-p file))
+ (setq stamp (nth 5 (file-attributes file)))
+ (or (> (car stamp) (car mh-alias-tstamp))
+ (and (= (car stamp) (car mh-alias-tstamp))
+ (> (cadr stamp) (cadr mh-alias-tstamp)))))))
+ (mh-alias-filenames t)))))))
+
+(defun mh-alias-filenames (arg)
+ "Return list of filenames that contain aliases.
+The filenames come from the MH profile component Aliasfile and are expanded.
+If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
+ (or mh-progs (mh-find-path))
+ (save-excursion
+ (let* ((filename (mh-profile-component "Aliasfile"))
+ (filelist (and filename (split-string filename "[ \t]+")))
+ (userlist
+ (mapcar
+ (function
+ (lambda (file)
+ (if (and mh-user-path file
+ (file-exists-p (expand-file-name file mh-user-path)))
+ (expand-file-name file mh-user-path))))
+ filelist)))
+ (if arg
+ (if (stringp mh-alias-system-aliases)
+ (append userlist (list mh-alias-system-aliases))
+ (append userlist mh-alias-system-aliases))
+ userlist))))
+
+(defun mh-alias-local-users ()
+ "Return an alist of local users from /etc/passwd."
+ (let (passwd-alist)
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ (cond
+ ((eq mh-alias-local-users t)
+ (if (file-readable-p "/etc/passwd")
+ (insert-file-contents "/etc/passwd")))
+ ((stringp mh-alias-local-users)
+ (insert mh-alias-local-users "\n")
+ (shell-command-on-region (point-min)(point-max) mh-alias-local-users t)
+ (goto-char (point-min))))
+ (while (< (point) (point-max))
+ (cond
+ ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]")
+ (when (> (string-to-int (match-string 2)) 200)
+ (let* ((username (match-string 1))
+ (gecos-name (match-string 3))
+ (realname
+ (if (string-match "&" gecos-name)
+ (concat
+ (substring gecos-name 0 (match-beginning 0))
+ (capitalize username)
+ (substring gecos-name (match-end 0)))
+ gecos-name)))
+ (setq passwd-alist
+ (cons (list username
+ (if (string-equal "" realname)
+ (concat "<" username ">")
+ (concat realname " <" username ">")))
+ passwd-alist))))))
+ (forward-line 1)))
+ passwd-alist))
+
+;;;###mh-autoload
+(defun mh-alias-reload ()
+ "Load MH aliases into `mh-alias-alist'."
+ (interactive)
+ (save-excursion
+ (message "Loading MH aliases...")
+ (mh-alias-tstamp t)
+ (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
+ (setq mh-alias-alist nil)
+ (setq mh-alias-blind-alist nil)
+ (while (< (point) (point-max))
+ (cond
+ ((looking-at "^[ \t]")) ;Continuation line
+ ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
+ (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist))
+ (setq mh-alias-blind-alist
+ (cons (list (match-string 1)) mh-alias-blind-alist))
+ (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
+ ((looking-at "\\(.+\\): .*$") ; A new MH alias
+ (when (not (assoc-ignore-case (match-string 1) mh-alias-alist))
+ (setq mh-alias-alist
+ (cons (list (match-string 1)) mh-alias-alist)))))
+ (forward-line 1)))
+ (when mh-alias-local-users
+ (setq mh-alias-passwd-alist (mh-alias-local-users))
+ ;; Update aliases with local users, but leave existing aliases alone.
+ (let ((local-users mh-alias-passwd-alist)
+ user)
+ (while local-users
+ (setq user (car local-users))
+ (if (not (assoc-ignore-case (car user) mh-alias-alist))
+ (setq mh-alias-alist (append mh-alias-alist (list user))))
+ (setq local-users (cdr local-users)))))
+ (message "Loading MH aliases...done"))
+
+(defun mh-alias-reload-maybe ()
+ "Load new MH aliases."
+ (if (or (not mh-alias-alist) ; Doesn't exist, so create it.
+ (mh-alias-tstamp nil)) ; Out of date, so recreate it.
+ (mh-alias-reload)))
+
+\f
+;;; Alias Expansion
+
+(defun mh-alias-ali (alias &optional user)
+ "Return ali expansion for ALIAS.
+ALIAS must be a string for a single alias.
+If USER is t, then assume ALIAS is an address and call ali -user.
+ali returns the string unchanged if not defined. The same is done here."
+ (save-excursion
+ (let ((user-arg (if user "-user" "-nouser")))
+ (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
+ (goto-char (point-max))
+ (if (looking-at "^$") (delete-backward-char 1))
+ (buffer-substring (point-min)(point-max))))
+
+(defun mh-alias-expand (alias)
+ "Return expansion for ALIAS.
+Blind aliases or users from /etc/passwd are not expanded."
+ (cond
+ ((assoc-ignore-case alias mh-alias-blind-alist)
+ alias) ; Don't expand a blind alias
+ ((assoc-ignore-case alias mh-alias-passwd-alist)
+ (cadr (assoc-ignore-case alias mh-alias-passwd-alist)))
+ (t
+ (mh-alias-ali alias))))
+
+;;;###mh-autoload
+(defun mh-read-address (prompt)
+ "Read an address from the minibuffer with PROMPT."
+ (mh-alias-reload-maybe)
+ (if (not mh-alias-alist) ; If still no aliases, just prompt
+ (read-string prompt)
+ (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
+ (completion-ignore-case mh-alias-completion-ignore-case-flag)
+ (the-answer
+ (or (cond
+ ((fboundp 'completing-read-multiple)
+ (completing-read-multiple prompt mh-alias-alist nil nil))
+ ((featurep 'multi-prompt)
+ (multi-prompt "," nil prompt mh-alias-alist nil nil))
+ (t
+ (split-string
+ (completing-read "To: " mh-alias-alist nil nil)
+ ","))))))
+ (if (not mh-alias-expand-aliases-flag)
+ (mapconcat 'identity the-answer ", ")
+ ;; Loop over all elements, checking if in passwd aliast or blind first
+ (mapconcat 'mh-alias-expand the-answer ",\n ")))))
+
+;;;###mh-autoload
+(defun mh-alias-minibuffer-confirm-address ()
+ "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
+ (interactive)
+ (if (not mh-alias-flash-on-comma)
+ ()
+ (save-excursion
+ (let* ((case-fold-search t)
+ (the-name (buffer-substring
+ (progn (skip-chars-backward " \t")(point))
+ ;; This moves over to previous comma, if any
+ (progn (or (and (not (= 0 (skip-chars-backward "^,")))
+ ;; the skips over leading whitespace
+ (skip-chars-forward " "))
+ ;; no comma, then to beginning of word
+ (skip-chars-backward "^ \t"))
+ ;; In Emacs21, the beginning of the prompt
+ ;; line is accessible, which wasn't the case
+ ;; in emacs20. Skip over it.
+ (if (looking-at "^[^ \t]+:")
+ (skip-chars-forward "^ \t"))
+ (skip-chars-forward " ")
+ (point)))))
+ (if (assoc-ignore-case the-name mh-alias-alist)
+ (message "%s -> %s" the-name (mh-alias-expand the-name))
+ ;; Check if if was a single word likely to be an alias
+ (if (and (equal mh-alias-flash-on-comma 1)
+ (not (string-match " " the-name)))
+ (message "No alias for %s" the-name))))))
+ (self-insert-command 1))
+
+;;;###mh-autoload
+(defun mh-alias-letter-expand-alias ()
+ "Expand mail alias before point."
+ (mh-alias-reload-maybe)
+ (let ((mail-abbrevs mh-alias-alist))
+ (mail-abbrev-complete-alias))
+ (when mh-alias-expand-aliases-flag
+ (let* ((end (point))
+ (syntax-table (syntax-table))
+ (beg (unwind-protect
+ (save-excursion
+ (set-syntax-table mail-abbrev-syntax-table)
+ (backward-word 1)
+ (point))
+ (set-syntax-table syntax-table)))
+ (alias (buffer-substring beg end))
+ (expansion (mh-alias-expand alias)))
+ (delete-region beg end)
+ (insert expansion))))
+\f
+;;; Adding addresses to alias file.
+
+(defun mh-alias-suggest-alias (string)
+ "Suggest an alias for STRING."
+ (cond
+ ((string-match "^\\sw+$" string)
+ ;; One word -> downcase it.
+ (downcase string))
+ ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
+ ;; Two words -> first.last
+ (downcase
+ (format "%s.%s" (match-string 1 string) (match-string 2 string))))
+ ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
+ string)
+ ;; email only -> downcase username
+ (downcase (match-string 1 string)))
+ ((string-match "^\"\\(.*\\)\".*" string)
+ ;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
+ (mh-alias-suggest-alias (match-string 1 string)))
+ ((string-match "^\\(.*\\) +<.*>$" string)
+ ;; Some name <somename@foo.bar> -> recurse -> Some name
+ (mh-alias-suggest-alias (match-string 1 string)))
+ ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
+ ;; somename@foo.bar (Some name) -> recurse -> Some name
+ (mh-alias-suggest-alias (match-string 1 string)))
+ ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
+ ;; Strip out title
+ (mh-alias-suggest-alias (match-string 2 string)))
+ ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
+ ;; Strip out tails with comma
+ (mh-alias-suggest-alias (match-string 1 string)))
+ ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
+ ;; Strip out tails
+ (mh-alias-suggest-alias (match-string 1 string)))
+ ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
+ ;; Strip out initials
+ (mh-alias-suggest-alias
+ (format "%s %s" (match-string 1 string) (match-string 2 string))))
+ ((string-match "^\\([^,]+\\), +\\(.*\\)$" string)
+ ;; Reverse order of comma-separated fields
+ (mh-alias-suggest-alias
+ (format "%s %s" (match-string 2 string) (match-string 1 string))))
+ (t
+ ;; Output string, with spaces replaced by dots.
+ (downcase (replace-regexp-in-string
+ "\\.\\.+" "."
+ (replace-regexp-in-string " +" "." string))))))
+
+(defun mh-alias-which-file-has-alias (alias file-list)
+ "Return the name of writable file which defines ALIAS from list FILE-LIST."
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (let ((the-list file-list)
+ (found))
+ (while the-list
+ (erase-buffer)
+ (when (file-writable-p (car file-list))
+ (insert-file-contents (car file-list))
+ (if (re-search-forward (concat "^" (regexp-quote alias) ":"))
+ (setq found (car file-list)
+ the-list nil)
+ (setq the-list (cdr the-list)))))
+ found)))
+
+(defun mh-alias-insert-file (&optional alias)
+ "Return the alias file to write a new entry for ALIAS in.
+Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component
+value.
+If ALIAS is specified and it already exists, try to return the file that
+contains it."
+ (cond
+ ((and mh-alias-insert-file (listp mh-alias-insert-file))
+ (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
+ (car mh-alias-insert-file)
+ (if (or (not alias)
+ (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
+ (completing-read "Alias file [press Tab]: "
+ (mapcar 'list mh-alias-insert-file) nil t)
+ (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
+ (completing-read "Alias file [press Tab]: "
+ (mapcar 'list mh-alias-insert-file) nil t)))))
+ ((and mh-alias-insert-file (stringp mh-alias-insert-file))
+ mh-alias-insert-file)
+ (t
+ ;; writable ones returned from (mh-alias-filenames):
+ (let ((autolist (delq nil (mapcar (lambda (file)
+ (if (and (file-writable-p file)
+ (not (string-equal
+ file "/etc/passwd")))
+ file))
+ (mh-alias-filenames t)))))
+ (cond
+ ((not autolist)
+ (error "No writable alias file.
+Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
+ ((not (elt autolist 1)) ; Only one entry, use it
+ (car autolist))
+ ((or (not alias)
+ (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
+ (completing-read "Alias file [press Tab]: "
+ (mapcar 'list autolist) nil t))
+ (t
+ (or (mh-alias-which-file-has-alias alias autolist)
+ (completing-read "Alias file [press Tab]: "
+ (mapcar 'list autolist) nil t))))))))
+
+(defun mh-alias-address-to-alias (address)
+ "Return the ADDRESS alias if defined, or nil."
+ (let* ((aliases (mh-alias-ali address t)))
+ (if (string-equal aliases address)
+ nil ; ali returned same string -> no.
+ ;; For the comma-separated aliases reyurned by ali, check that one of
+ ;; them doesn't expand into a list. e.g. we do have an individual
+ ;; alias for that adress.
+ (car (delq nil (mapcar
+ (function
+ (lambda (alias)
+ (let ((recurse (mh-alias-ali alias nil)))
+ (if (string-match ".*,.*" recurse)
+ nil
+ alias))))
+ (split-string aliases ", +")))))))
+
+;;;###mh-autoload
+(defun mh-alias-from-has-no-alias-p ()
+ "Return t is From has no current alias set."
+ (mh-alias-reload-maybe)
+ (save-excursion
+ (if (not (mh-folder-line-matches-show-buffer-p))
+ nil ;No corresponding show buffer
+ (if (eq major-mode 'mh-folder-mode)
+ (set-buffer mh-show-buffer))
+ (not (mh-alias-address-to-alias (mh-extract-from-header-value))))))
+
+(defun mh-alias-add-alias-to-file (alias address &optional file)
+ "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
+Prompt for alias file if not provided and there is more than one candidate.
+If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend
+after it."
+ (if (not file)
+ (setq file (mh-alias-insert-file alias)))
+ (save-excursion
+ (set-buffer (find-file-noselect file))
+ (goto-char (point-min))
+ (let ((alias-search (concat alias ":"))
+ (letter)
+ (here (point))
+ (case-fold-search t))
+ (cond
+ ;; Search for exact match (if we had the same alias before)
+ ((re-search-forward
+ (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
+ (let ((answer (read-string
+ (format "Exists for %s; [i]nsert, [a]ppend: "
+ (match-string 1))))
+ (case-fold-search t))
+ (cond ((string-match "^i" answer))
+ ((string-match "^a" answer)
+ (forward-line 1))
+ (t
+ error "Quitting."))))
+ ;; No, so sort-in at the right place
+ ;; search for "^alias", then "^alia", etc.
+ ((eq mh-alias-insertion-location 'sorted)
+ (setq letter (substring alias-search -1)
+ alias-search (substring alias-search 0 -1))
+ (while (and (not (equal alias-search ""))
+ (not (re-search-forward
+ (concat "^" (regexp-quote alias-search)) nil t)))
+ (setq letter (substring alias-search -1)
+ alias-search (substring alias-search 0 -1)))
+ ;; Next, move forward to sort alphabetically for following letters
+ (beginning-of-line)
+ (while (re-search-forward
+ (concat "^" (regexp-quote alias-search) "[a-" letter "]")
+ nil t)
+ (forward-line 1)))
+ ((eq mh-alias-insertion-location 'bottom)
+ (goto-char (point-max)))
+ ((eq mh-alias-insertion-location 'top)
+ (goto-char (point-min)))))
+ (beginning-of-line)
+ (insert (format "%s: %s\n" alias address))
+ (save-buffer)))
+
+;;;###mh-autoload
+(defun mh-alias-add-alias (alias address)
+ "*Add ALIAS for ADDRESS in personal alias file.
+Prompts for confirmation if the address already has an alias.
+If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
+ (interactive "P\nP")
+ (mh-alias-reload-maybe)
+ (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
+ (setq address (read-string "Address: " address))
+ (let ((address-alias (mh-alias-address-to-alias address))
+ (alias-address (mh-alias-expand alias)))
+ (if (string-equal alias-address alias)
+ (setq alias-address nil))
+ (cond
+ ((and (equal alias address-alias)
+ (equal address alias-address))
+ (message "Already defined as: %s" alias-address))
+ (address-alias
+ (if (y-or-n-p (format "Address has alias %s; set new one? "
+ address-alias))
+ (mh-alias-add-alias-to-file alias address)))
+ (t
+ (mh-alias-add-alias-to-file alias address)))))
+
+;;;###mh-autoload
+(defun mh-alias-grab-from-field ()
+ "*Add ALIAS for ADDRESS in personal alias file.
+Prompts for confirmation if the alias is already in use or if the address
+already has an alias."
+ (interactive)
+ (mh-alias-reload-maybe)
+ (save-excursion
+ (cond
+ ((mh-folder-line-matches-show-buffer-p)
+ (set-buffer mh-show-buffer))
+ ((and (eq major-mode 'mh-folder-mode)
+ (mh-get-msg-num nil))
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
+ ((eq major-mode 'mh-folder-mode)
+ (error "Cursor not pointing to a message")))
+ (let* ((address (mh-extract-from-header-value))
+ (alias (mh-alias-suggest-alias address)))
+ (mh-alias-add-alias alias address))))
+
+;;;###mh-autoload
+(defun mh-alias-add-address-under-point ()
+ "Insert an alias for email address under point."
+ (interactive)
+ (let ((address (mh-goto-address-find-address-at-point)))
+ (if address
+ (mh-alias-add-alias nil address)
+ (message "No email address found under point."))))
+
+(provide 'mh-alias)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-alias.el ends here
--- /dev/null
+;;; mh-comp.el --- MH-E functions for composing messages
+
+;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Internal support for MH-E package.
+
+;;; Change Log:
+
+;; $Id: mh-comp.el,v 1.26 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+(require 'mh-e)
+(require 'gnus-util)
+(require 'easymenu)
+(require 'cl)
+
+;; Shush the byte-compiler
+(defvar adaptive-fill-first-line-regexp)
+(defvar font-lock-defaults)
+(defvar mark-active)
+(defvar sendmail-coding-system)
+(defvar mh-identity-list)
+(defvar mh-identity-default)
+(defvar mh-identity-menu)
+
+;;; Autoloads
+(autoload 'Info-goto-node "info")
+(autoload 'mail-mode-fill-paragraph "sendmail")
+(autoload 'mm-handle-displayed-p "mm-decode")
+
+(autoload 'sc-cite-original "sc"
+ "Workhorse citing function which performs the initial citation.
+This is callable from the various mail and news readers' reply
+function according to the agreed upon standard. See `\\[sc-describe]'
+for more details. `sc-cite-original' does not do any yanking of the
+original message but it does require a few things:
+
+ 1) The reply buffer is the current buffer.
+
+ 2) The original message has been yanked and inserted into the
+ reply buffer.
+
+ 3) Verbose mail headers from the original message have been
+ inserted into the reply buffer directly before the text of the
+ original message.
+
+ 4) Point is at the beginning of the verbose headers.
+
+ 5) Mark is at the end of the body of text to be cited.
+
+For Emacs 19's, the region need not be active (and typically isn't
+when this function is called. Also, the hook `sc-pre-hook' is run
+before, and `sc-post-hook' is run after the guts of this function.")
+
+;;; Site customization (see also mh-utils.el):
+
+(defvar mh-send-prog "send"
+ "Name of the MH send program.
+Some sites need to change this because of a name conflict.")
+
+(defvar mh-redist-full-contents nil
+ "Non-nil if the `dist' command needs whole letter for redistribution.
+This is the case only when `send' is compiled with the BERK option.
+If MH will not allow you to redist a previously redist'd msg, set to nil.")
+
+(defvar mh-redist-background nil
+ "If non-nil redist will be done in background like send.
+This allows transaction log to be visible if -watch, -verbose or -snoop are
+used.")
+
+(defvar mh-note-repl "-"
+ "String whose first character is used to notate replied to messages.")
+
+(defvar mh-note-forw "F"
+ "String whose first character is used to notate forwarded messages.")
+
+(defvar mh-note-dist "R"
+ "String whose first character is used to notate redistributed messages.")
+
+(defvar mh-yank-hooks nil
+ "Obsolete hook for modifying a citation just inserted in the mail buffer.
+Each hook function can find the citation between point and mark.
+And each hook function should leave point and mark around the citation
+text as modified.
+
+This is a normal hook, misnamed for historical reasons.
+It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
+
+(defvar mail-citation-hook nil
+ "*Hook for modifying a citation just inserted in the mail buffer.
+Each hook function can find the citation between point and mark.
+And each hook function should leave point and mark around the citation
+text as modified.
+
+If this hook is entirely empty (nil), the text of the message is inserted
+with `mh-ins-buf-prefix' prefixed to each line.
+
+See also the variable `mh-yank-from-start-of-msg', which controls how
+much of the message passed to the hook.
+
+This hook was historically provided to set up supercite. You may now leave
+this nil and set up supercite by setting the variable
+`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
+to 'autosupercite.")
+
+(defvar mh-comp-formfile "components"
+ "Name of file to be used as a skeleton for composing messages.
+Default is \"components\". If not an absolute file name, the file
+is searched for first in the user's MH directory, then in the
+system MH lib directory.")
+
+(defvar mh-repl-formfile "replcomps"
+ "Name of file to be used as a skeleton for replying to messages.
+Default is \"replcomps\". If not an absolute file name, the file
+is searched for first in the user's MH directory, then in the
+system MH lib directory.")
+
+(defvar mh-repl-group-formfile "replgroupcomps"
+ "Name of file to be used as a skeleton for replying to messages.
+This file is used to form replies to the sender and all recipients of a
+message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
+If not an absolute file name, the file is searched for first in the user's MH
+directory, then in the system MH lib directory.")
+
+(defvar mh-rejected-letter-start
+ (format "^%s$"
+ (regexp-opt
+ '("Content-Type: message/rfc822" ;MIME MDN
+ " ----- Unsent message follows -----" ;from sendmail V5
+ " --------Unsent Message below:" ; from sendmail at BU
+ " ----- Original message follows -----" ;from sendmail V8
+ "------- Unsent Draft" ;from MH itself
+ "---------- Original Message ----------" ;from zmailer
+ " --- The unsent message follows ---" ;from AIX mail system
+ " Your message follows:" ;from MMDF-II
+ "Content-Description: Returned Content" ;1993 KJ sendmail
+ ))))
+
+(defvar mh-new-draft-cleaned-headers
+ "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
+ "Regexp of header lines to remove before offering a message as a new draft.
+Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
+
+(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
+ ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
+ ("d" . "Dcc:"))
+ "Alist of (final-character . field-name) choices for `mh-to-field'.")
+
+(defvar mh-letter-mode-map (copy-keymap text-mode-map)
+ "Keymap for composing mail.")
+
+(defvar mh-letter-mode-syntax-table nil
+ "Syntax table used by MH-E while in MH-Letter mode.")
+
+(if mh-letter-mode-syntax-table
+ ()
+ (setq mh-letter-mode-syntax-table
+ (make-syntax-table text-mode-syntax-table))
+ (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
+
+(defvar mh-sent-from-folder nil
+ "Folder of msg assoc with this letter.")
+
+(defvar mh-sent-from-msg nil
+ "Number of msg assoc with this letter.")
+
+(defvar mh-send-args nil
+ "Extra args to pass to \"send\" command.")
+
+(defvar mh-annotate-char nil
+ "Character to use to annotate `mh-sent-from-msg'.")
+
+(defvar mh-annotate-field nil
+ "Field name for message annotation.")
+
+;;;###autoload
+(defun mh-smail ()
+ "Compose and send mail with the MH mail system.
+This function is an entry point to MH-E, the Emacs front end
+to the MH mail system.
+
+See documentation of `\\[mh-send]' for more details on composing mail."
+ (interactive)
+ (mh-find-path)
+ (call-interactively 'mh-send))
+
+(defvar mh-error-if-no-draft nil) ;raise error over using old draft
+
+;;;###autoload
+(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
+ "Set up a mail composition draft with the MH mail system.
+This function is an entry point to MH-E, the Emacs front end
+to the MH mail system. This function does not prompt the user
+for any header fields, and thus is suitable for use by programs
+that want to create a mail buffer.
+Users should use `\\[mh-smail]' to compose mail.
+Optional arguments for setting certain fields include TO, SUBJECT, and
+OTHER-HEADERS. Additional arguments are IGNORED."
+ (mh-find-path)
+ (let ((mh-error-if-no-draft t))
+ (mh-send (or to "") "" (or subject ""))))
+
+;; XEmacs needs this:
+;;;###autoload
+(defun mh-user-agent-compose (&optional to subject other-headers continue
+ switch-function yank-action
+ send-actions)
+ "Set up mail composition draft with the MH mail system.
+This is `mail-user-agent' entry point to MH-E.
+
+The optional arguments TO and SUBJECT specify recipients and the
+initial Subject field, respectively.
+
+OTHER-HEADERS is an alist specifying additional
+header fields. Elements look like (HEADER . VALUE) where both
+HEADER and VALUE are strings.
+
+CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
+ (mh-find-path)
+ (let ((mh-error-if-no-draft t))
+ (mh-send to "" subject)
+ (while other-headers
+ (mh-insert-fields (concat (car (car other-headers)) ":")
+ (cdr (car other-headers)))
+ (setq other-headers (cdr other-headers)))))
+
+;;;###mh-autoload
+(defun mh-edit-again (msg)
+ "Clean up a draft or a message MSG previously sent and make it resendable.
+Default is the current message.
+The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
+See also documentation for `\\[mh-send]' function."
+ (interactive (list (mh-get-msg-num t)))
+ (let* ((from-folder mh-current-folder)
+ (config (current-window-configuration))
+ (draft
+ (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
+ (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
+ (rename-buffer (format "draft-%d" msg))
+ ;; Make buffer writable...
+ (setq buffer-read-only nil)
+ ;; If buffer was being used to display the message reinsert
+ ;; from file...
+ (when (eq major-mode 'mh-show-mode)
+ (erase-buffer)
+ (insert-file-contents buffer-file-name))
+ (buffer-name))
+ (t
+ (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
+ (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
+ (mh-insert-header-separator)
+ (goto-char (point-min))
+ (save-buffer)
+ (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
+ config)
+ (mh-letter-mode-message)))
+
+;;;###mh-autoload
+(defun mh-extract-rejected-mail (msg)
+ "Extract message MSG returned by the mail system and make it resendable.
+Default is the current message. The variable `mh-new-draft-cleaned-headers'
+gives the headers to clean out of the original message.
+See also documentation for `\\[mh-send]' function."
+ (interactive (list (mh-get-msg-num t)))
+ (let ((from-folder mh-current-folder)
+ (config (current-window-configuration))
+ (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
+ (goto-char (point-min))
+ (cond ((re-search-forward mh-rejected-letter-start nil t)
+ (skip-chars-forward " \t\n")
+ (delete-region (point-min) (point))
+ (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
+ (t
+ (message "Does not appear to be a rejected letter.")))
+ (mh-insert-header-separator)
+ (goto-char (point-min))
+ (save-buffer)
+ (mh-compose-and-send-mail draft "" from-folder msg
+ (mh-get-header-field "To:")
+ (mh-get-header-field "From:")
+ (mh-get-header-field "Cc:")
+ nil nil config)
+ (mh-letter-mode-message)))
+
+;;;###mh-autoload
+(defun mh-forward (to cc &optional msg-or-seq)
+ "Forward one or more messages to the recipients TO and CC.
+
+Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
+
+Default is the displayed message. If optional prefix argument is given then
+prompt for the message sequence. If variable `transient-mark-mode' is non-nil
+and the mark is active, then the selected region is forwarded.
+See also documentation for `\\[mh-send]' function."
+ (interactive (list (mh-read-address "To: ")
+ (mh-read-address "Cc: ")
+ (cond
+ ((mh-mark-active-p t)
+ (mh-region-to-msg-list (region-beginning) (region-end)))
+ (current-prefix-arg
+ (mh-read-seq-default "Forward" t))
+ (t
+ (mh-get-msg-num t)))))
+ (let* ((folder mh-current-folder)
+ (msgs (cond ((numberp msg-or-seq) (list msg-or-seq))
+ ((listp msg-or-seq) msg-or-seq)
+ (t (mh-seq-to-msgs msg-or-seq))))
+ (config (current-window-configuration))
+ (fwd-msg-file (mh-msg-filename (car msgs) folder))
+ ;; forw always leaves file in "draft" since it doesn't have -draft
+ (draft-name (expand-file-name "draft" mh-user-path))
+ (draft (cond ((or (not (file-exists-p draft-name))
+ (y-or-n-p "The file 'draft' exists. Discard it? "))
+ (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
+ mh-current-folder msgs)
+ (prog1
+ (mh-read-draft "" draft-name t)
+ (mh-insert-fields "To:" to "Cc:" cc)
+ (save-buffer)))
+ (t
+ (mh-read-draft "" draft-name nil)))))
+ (let (orig-from
+ orig-subject)
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ (insert-file-contents fwd-msg-file)
+ (setq orig-from (mh-get-header-field "From:"))
+ (setq orig-subject (mh-get-header-field "Subject:")))
+ (let ((forw-subject
+ (mh-forwarded-letter-subject orig-from orig-subject))
+ (compose))
+ (mh-insert-fields "Subject:" forw-subject)
+ (goto-char (point-min))
+ ;; If using MML, translate mhn
+ (if (equal mh-compose-insertion 'gnus)
+ (save-excursion
+ (setq compose t)
+ (re-search-forward (format "^\\(%s\\)?$"
+ mh-mail-header-separator))
+ (while
+ (re-search-forward
+ "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
+ (point-max) t)
+ (let ((description (if (equal (match-string 1)
+ "forwarded messages")
+ "forwarded message %d"
+ (match-string 1)))
+ (msgs (split-string (match-string 3)))
+ (i 0))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (dolist (msg msgs)
+ (setq i (1+ i))
+ (mh-mml-forward-message (format description i)
+ folder msg))))))
+ ;; Postition just before forwarded message
+ (if (re-search-forward "^------- Forwarded Message" nil t)
+ (forward-line -1)
+ (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator))
+ (forward-line 1))
+ (delete-other-windows)
+ (mh-add-msgs-to-seq msgs 'forwarded t)
+ (mh-compose-and-send-mail draft "" folder msg-or-seq
+ to forw-subject cc
+ mh-note-forw "Forwarded:"
+ config)
+ (if compose
+ (setq mh-mml-compose-insert-flag t))
+ (mh-letter-mode-message)))))
+
+(defun mh-forwarded-letter-subject (from subject)
+ "Return a Subject suitable for a forwarded message.
+Original message has headers FROM and SUBJECT."
+ (let ((addr-start (string-match "<" from))
+ (comment (string-match "(" from)))
+ (cond ((and addr-start (> addr-start 0))
+ ;; Full Name <luser@host>
+ (setq from (substring from 0 (1- addr-start))))
+ (comment
+ ;; luser@host (Full Name)
+ (setq from (substring from (1+ comment) (1- (length from)))))))
+ (format mh-forward-subject-format from subject))
+
+;;;###autoload
+(defun mh-smail-other-window ()
+ "Compose and send mail in other window with the MH mail system.
+This function is an entry point to MH-E, the Emacs front end
+to the MH mail system.
+
+See documentation of `\\[mh-send]' for more details on composing mail."
+ (interactive)
+ (mh-find-path)
+ (call-interactively 'mh-send-other-window))
+
+;;;###mh-autoload
+(defun mh-redistribute (to cc &optional msg)
+ "Redistribute displayed message to recipients TO and CC.
+Use optional argument MSG to redistribute another message.
+Depending on how your copy of MH was compiled, you may need to change the
+setting of the variable `mh-redist-full-contents'. See its documentation."
+ (interactive (list (mh-read-address "Redist-To: ")
+ (mh-read-address "Redist-Cc: ")
+ (mh-get-msg-num t)))
+ (or msg
+ (setq msg (mh-get-msg-num t)))
+ (save-window-excursion
+ (let ((folder mh-current-folder)
+ (draft (mh-read-draft "redistribution"
+ (if mh-redist-full-contents
+ (mh-msg-filename msg)
+ nil)
+ nil)))
+ (mh-goto-header-end 0)
+ (insert "Resent-To: " to "\n")
+ (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
+ (mh-clean-msg-header (point-min)
+ "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
+ nil)
+ (save-buffer)
+ (message "Redistributing...")
+ (if (not mh-redist-background)
+ (if mh-redist-full-contents
+ (call-process "/bin/sh" nil 0 nil "-c"
+ (format "mhdist=1 mhaltmsg=%s %s -push %s"
+ buffer-file-name
+ (expand-file-name mh-send-prog mh-progs)
+ buffer-file-name))
+ (call-process "/bin/sh" nil 0 nil "-c"
+ (format
+ "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
+ (mh-msg-filename msg folder)
+ (expand-file-name mh-send-prog mh-progs)
+ buffer-file-name))))
+ (mh-annotate-msg msg folder mh-note-dist
+ "-component" "Resent:"
+ "-text" (format "\"%s %s\"" to cc))
+ (if mh-redist-background
+ (mh-exec-cmd-daemon "/bin/sh" "-c"
+ (format "mhdist=1 mhaltmsg=%s %s %s %s"
+ (if mh-redist-full-contents
+ buffer-file-name
+ (mh-msg-filename msg folder))
+ (if mh-redist-full-contents
+ ""
+ "mhannotate=1")
+ (mh-expand-file-name "send" mh-progs)
+ buffer-file-name)))
+ (kill-buffer draft)
+ (message "Redistributing...done"))))
+
+(defun mh-show-buffer-message-number (&optional buffer)
+ "Message number of displayed message in corresponding show buffer.
+Return nil if show buffer not displayed.
+If in `mh-letter-mode', don't display the message number being replied to,
+but rather the message number of the show buffer associated with our
+originating folder buffer.
+Optional argument BUFFER can be used to specify the buffer."
+ (save-excursion
+ (if buffer
+ (set-buffer buffer))
+ (cond ((eq major-mode 'mh-show-mode)
+ (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
+ (car (read-from-string (substring buffer-file-name
+ (1+ number-start))))))
+ ((and (eq major-mode 'mh-folder-mode)
+ mh-show-buffer
+ (get-buffer mh-show-buffer))
+ (mh-show-buffer-message-number mh-show-buffer))
+ ((and (eq major-mode 'mh-letter-mode)
+ mh-sent-from-folder
+ (get-buffer mh-sent-from-folder))
+ (mh-show-buffer-message-number mh-sent-from-folder))
+ (t
+ nil))))
+
+;;;###mh-autoload
+(defun mh-reply (message &optional reply-to includep)
+ "Reply to MESSAGE (default: current message).
+If the optional argument REPLY-TO is not given, prompts for type of addresses
+to reply to:
+ from sender only,
+ to sender and primary recipients,
+ cc/all sender and all recipients.
+If optional prefix argument INCLUDEP provided, then include the message
+in the reply using filter `mhl.reply' in your MH directory.
+If the file named by `mh-repl-formfile' exists, it is used as a skeleton
+for the reply. See also documentation for `\\[mh-send]' function."
+ (interactive (list
+ (mh-get-msg-num t)
+ (let ((minibuffer-help-form
+ "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
+ (or mh-reply-default-reply-to
+ (completing-read "Reply to whom? (from, to, all) [from]: "
+ '(("from") ("to") ("cc") ("all"))
+ nil
+ t)))
+ current-prefix-arg))
+ (let* ((folder mh-current-folder)
+ (show-buffer mh-show-buffer)
+ (config (current-window-configuration))
+ (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
+ (form-file (cond ((and mh-nmh-flag group-reply
+ (stringp mh-repl-group-formfile))
+ mh-repl-group-formfile)
+ ((stringp mh-repl-formfile) mh-repl-formfile)
+ (t nil))))
+ (message "Composing a reply...")
+ (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
+ (if form-file
+ (list "-form" form-file))
+ mh-current-folder message
+ (cond ((or (equal reply-to "from") (equal reply-to ""))
+ '("-nocc" "all"))
+ ((equal reply-to "to")
+ '("-cc" "to"))
+ (group-reply (if mh-nmh-flag
+ '("-group" "-nocc" "me")
+ '("-cc" "all" "-nocc" "me"))))
+ (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
+ (eq mh-yank-from-start-of-msg 'autoattrib))
+ '("-noformat"))
+ (includep '("-filter" "mhl.reply"))
+ (t '())))
+ (let ((draft (mh-read-draft "reply"
+ (expand-file-name "reply" mh-user-path)
+ t)))
+ (delete-other-windows)
+ (save-buffer)
+
+ (let ((to (mh-get-header-field "To:"))
+ (subject (mh-get-header-field "Subject:"))
+ (cc (mh-get-header-field "Cc:")))
+ (goto-char (point-min))
+ (mh-goto-header-end 1)
+ (or includep
+ (not mh-reply-show-message-flag)
+ (mh-in-show-buffer (show-buffer)
+ (mh-display-msg message folder)))
+ (mh-add-msgs-to-seq message 'answered t)
+ (message "Composing a reply...done")
+ (mh-compose-and-send-mail draft "" folder message to subject cc
+ mh-note-repl "Replied:" config))
+ (when (and (or (eq 'autosupercite mh-yank-from-start-of-msg)
+ (eq 'autoattrib mh-yank-from-start-of-msg))
+ (eq (mh-show-buffer-message-number) mh-sent-from-msg))
+ (undo-boundary)
+ (mh-yank-cur-msg))
+ (mh-letter-mode-message))))
+
+;;;###mh-autoload
+(defun mh-send (to cc subject)
+ "Compose and send a letter.
+
+Do not call this function from outside MH-E; use \\[mh-smail] instead.
+
+The file named by `mh-comp-formfile' will be used as the form.
+The letter is composed in `mh-letter-mode'; see its documentation for more
+details.
+If `mh-compose-letter-function' is defined, it is called on the draft and
+passed three arguments: TO, CC, and SUBJECT."
+ (interactive (list
+ (mh-read-address "To: ")
+ (mh-read-address "Cc: ")
+ (read-string "Subject: ")))
+ (let ((config (current-window-configuration)))
+ (delete-other-windows)
+ (mh-send-sub to cc subject config)))
+
+;;;###mh-autoload
+(defun mh-send-other-window (to cc subject)
+ "Compose and send a letter in another window.
+
+Do not call this function from outside MH-E; use \\[mh-smail-other-window]
+instead.
+
+The file named by `mh-comp-formfile' will be used as the form.
+The letter is composed in `mh-letter-mode'; see its documentation for more
+details.
+If `mh-compose-letter-function' is defined, it is called on the draft and
+passed three arguments: TO, CC, and SUBJECT."
+ (interactive (list
+ (mh-read-address "To: ")
+ (mh-read-address "Cc: ")
+ (read-string "Subject: ")))
+ (let ((pop-up-windows t))
+ (mh-send-sub to cc subject (current-window-configuration))))
+
+(defun mh-send-sub (to cc subject config)
+ "Do the real work of composing and sending a letter.
+Expects the TO, CC, and SUBJECT fields as arguments.
+CONFIG is the window configuration before sending mail."
+ (let ((folder mh-current-folder)
+ (msg-num (mh-get-msg-num nil)))
+ (message "Composing a message...")
+ (let ((draft (mh-read-draft
+ "message"
+ (let (components)
+ (cond
+ ((file-exists-p
+ (setq components
+ (expand-file-name mh-comp-formfile mh-user-path)))
+ components)
+ ((file-exists-p
+ (setq components
+ (expand-file-name mh-comp-formfile mh-lib)))
+ components)
+ ((file-exists-p
+ (setq components
+ (expand-file-name mh-comp-formfile
+ ;; What is this mh-etc ?? -sm
+ ;; This is dead code, so
+ ;; remove it.
+ ;(and (boundp 'mh-etc) mh-etc)
+ )))
+ components)
+ (t
+ (error (format "Can't find components file \"%s\""
+ components)))))
+ nil)))
+ (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
+ (goto-char (point-max))
+ (mh-compose-and-send-mail draft "" folder msg-num
+ to subject cc
+ nil nil config)
+ (mh-letter-mode-message))))
+
+(defun mh-read-draft (use initial-contents delete-contents-file)
+ "Read draft file into a draft buffer and make that buffer the current one.
+USE is a message used for prompting about the intended use of the message.
+INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
+if buffer should not be modified. Delete the initial-contents file if
+DELETE-CONTENTS-FILE flag is set.
+Returns the draft folder's name.
+If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
+used each time and saved in the draft folder. The draft file can then be
+reused."
+ (cond (mh-draft-folder
+ (let ((orig-default-dir default-directory)
+ (draft-file-name (mh-new-draft-name)))
+ (pop-to-buffer (generate-new-buffer
+ (format "draft-%s"
+ (file-name-nondirectory draft-file-name))))
+ (condition-case ()
+ (insert-file-contents draft-file-name t)
+ (file-error))
+ (setq default-directory orig-default-dir)))
+ (t
+ (let ((draft-name (expand-file-name "draft" mh-user-path)))
+ (pop-to-buffer "draft") ; Create if necessary
+ (if (buffer-modified-p)
+ (if (y-or-n-p "Draft has been modified; kill anyway? ")
+ (set-buffer-modified-p nil)
+ (error "Draft preserved")))
+ (setq buffer-file-name draft-name)
+ (clear-visited-file-modtime)
+ (unlock-buffer)
+ (cond ((and (file-exists-p draft-name)
+ (not (equal draft-name initial-contents)))
+ (insert-file-contents draft-name)
+ (delete-file draft-name))))))
+ (cond ((and initial-contents
+ (or (zerop (buffer-size))
+ (if (y-or-n-p
+ (format "A draft exists. Use for %s? " use))
+ (if mh-error-if-no-draft
+ (error "A prior draft exists"))
+ t)))
+ (erase-buffer)
+ (insert-file-contents initial-contents)
+ (if delete-contents-file (delete-file initial-contents))))
+ (auto-save-mode 1)
+ (if mh-draft-folder
+ (save-buffer)) ; Do not reuse draft name
+ (buffer-name))
+
+(defun mh-new-draft-name ()
+ "Return the pathname of folder for draft messages."
+ (save-excursion
+ (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
+ (buffer-substring (point-min) (1- (point-max)))))
+
+(defun mh-annotate-msg (msg buffer note &rest args)
+ "Mark MSG in BUFFER with character NOTE and annotate message with ARGS."
+ (apply 'mh-exec-cmd "anno" buffer msg args)
+ (save-excursion
+ (cond ((get-buffer buffer) ; Buffer may be deleted
+ (set-buffer buffer)
+ (if (numberp msg)
+ (mh-notate msg note (1+ mh-cmd-note))
+ (mh-notate-seq msg note (1+ mh-cmd-note)))))))
+
+(defun mh-insert-fields (&rest name-values)
+ "Insert the NAME-VALUES pairs in the current buffer.
+If the field exists, append the value to it.
+Do not insert any pairs whose value is the empty string."
+ (let ((case-fold-search t))
+ (while name-values
+ (let ((field-name (car name-values))
+ (value (car (cdr name-values))))
+ (cond ((equal value "")
+ nil)
+ ((mh-position-on-field field-name)
+ (insert " " (or value "")))
+ (t
+ (insert field-name " " value "\n")))
+ (setq name-values (cdr (cdr name-values)))))))
+
+(defun mh-position-on-field (field &optional ignored)
+ "Move to the end of the FIELD in the header.
+Move to end of entire header if FIELD not found.
+Returns non-nil iff FIELD was found.
+The optional second arg is for pre-version 4 compatibility and is IGNORED."
+ (cond ((mh-goto-header-field field)
+ (mh-header-field-end)
+ t)
+ ((mh-goto-header-end 0)
+ nil)))
+
+(defun mh-get-header-field (field)
+ "Find and return the body of FIELD in the mail header.
+Returns the empty string if the field is not in the header of the
+current buffer."
+ (if (mh-goto-header-field field)
+ (progn
+ (skip-chars-forward " \t") ;strip leading white space in body
+ (let ((start (point)))
+ (mh-header-field-end)
+ (buffer-substring-no-properties start (point))))
+ ""))
+
+(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
+
+(defun mh-goto-header-field (field)
+ "Move to FIELD in the message header.
+Move to the end of the FIELD name, which should end in a colon.
+Returns t if found, nil if not."
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (headers-end (save-excursion
+ (mh-goto-header-end 0)
+ (point))))
+ (re-search-forward (format "^%s" field) headers-end t)))
+
+(defun mh-goto-header-end (arg)
+ "Move the cursor ARG lines after the header."
+ (if (re-search-forward "^-*$" nil nil)
+ (forward-line arg)))
+
+(defun mh-extract-from-header-value ()
+ "Extract From: string from header."
+ (save-excursion
+ (if (not (mh-goto-header-field "From:"))
+ (error "No From header line found")
+ (skip-chars-forward " \t")
+ (buffer-substring-no-properties
+ (point) (progn (mh-header-field-end)(point))))))
+
+\f
+
+;;; Mode for composing and sending a draft message.
+
+(put 'mh-letter-mode 'mode-class 'special)
+
+;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
+(eval-when-compile (defvar mh-letter-menu nil))
+(cond
+ ((fboundp 'easy-menu-define)
+ (easy-menu-define
+ mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
+ '("Letter"
+ ["Send This Draft" mh-send-letter t]
+ ["Split Current Line" mh-open-line t]
+ ["Check Recipient" mh-check-whom t]
+ ["Yank Current Message" mh-yank-cur-msg t]
+ ["Insert a Message..." mh-insert-letter t]
+ ["Insert Signature" mh-insert-signature t]
+ ["GPG Sign message"
+ mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
+ ["GPG Encrypt message"
+ mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
+ ["Compose Insertion (MIME)..." mh-compose-insertion t]
+ ;; ["Compose Compressed tar (MIME)..."
+ ;;mh-mhn-compose-external-compressed-tar t]
+ ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
+ ["Compose Forward (MIME)..." mh-compose-forward t]
+ ;; The next two will have to be merged. But I also need to make sure the
+ ;; user can't mix directives of both types.
+ ["Pull in All Compositions (mhn)"
+ mh-edit-mhn mh-mhn-compose-insert-flag]
+ ["Pull in All Compositions (gnus)"
+ mh-mml-to-mime mh-mml-compose-insert-flag]
+ ["Revert to Non-MIME Edit (mhn)"
+ mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
+ ["Kill This Draft" mh-fully-kill-draft t]))))
+
+;;; Help Messages
+;;; Group messages logically, more or less.
+(defvar mh-letter-mode-help-messages
+ '((nil
+ "Send letter: \\[mh-send-letter]"
+ "\t\tOpen line: \\[mh-open-line]\n"
+ "Kill letter: \\[mh-fully-kill-draft]"
+ "\t\tInsert:\n"
+ "Check recipients: \\[mh-check-whom]"
+ "\t\t Current message: \\[mh-yank-cur-msg]\n"
+ "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]"
+ "\t\t Attachment: \\[mh-compose-insertion]\n"
+ "Sign message: \\[mh-mml-secure-message-sign-pgpmime]"
+ "\t\t Message to forward: \\[mh-compose-forward]\n"
+ " "
+ "\t\t Signature: \\[mh-insert-signature]"))
+ "Key binding cheat sheet.
+
+This is an associative array which is used to show the most common commands.
+The key is a prefix char. The value is one or more strings which are
+concatenated together and displayed in the minibuffer if ? is pressed after
+the prefix character. The special key nil is used to display the
+non-prefixed commands.
+
+The substitutions described in `substitute-command-keys' are performed as
+well.")
+
+;;;###mh-autoload
+(defun mh-fill-paragraph-function (arg)
+ "Fill paragraph at or after point.
+Prefix ARG means justify as well. This function enables `fill-paragraph' to
+work better in MH-Letter mode."
+ (interactive "P")
+ (let ((fill-paragraph-function) (fill-prefix))
+ (if (mh-in-header-p)
+ (mail-mode-fill-paragraph arg)
+ (fill-paragraph arg))))
+
+;;;###autoload
+(define-derived-mode mh-letter-mode text-mode "MH-Letter"
+ "Mode for composing letters in MH-E.\\<mh-letter-mode-map>
+
+When you have finished composing, type \\[mh-send-letter] to send the message
+using the MH mail handling system.
+
+There are two types of MIME directives used by MH-E: Gnus and MH. The option
+`mh-compose-insertion' controls what type of directives are inserted by MH-E
+commands. These directives can be converted to MIME body parts by running
+\\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives.
+This step is mandatory if these directives are added manually. If the
+directives are inserted with MH-E commands such as \\[mh-compose-insertion],
+the directives are expanded automatically when the letter is sent.
+
+Options that control this mode can be changed with
+\\[customize-group]; specify the \"mh-compose\" group.
+
+When a message is composed, the hooks `text-mode-hook' and
+`mh-letter-mode-hook' are run.
+
+\\{mh-letter-mode-map}"
+
+ (or mh-user-path (mh-find-path))
+ (make-local-variable 'mh-send-args)
+ (make-local-variable 'mh-annotate-char)
+ (make-local-variable 'mh-annotate-field)
+ (make-local-variable 'mh-previous-window-config)
+ (make-local-variable 'mh-sent-from-folder)
+ (make-local-variable 'mh-sent-from-msg)
+ (make-local-variable 'mail-header-separator)
+ (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
+ (make-local-variable 'mh-help-messages)
+ (setq mh-help-messages mh-letter-mode-help-messages)
+
+ ;; From sendmail.el for proper paragraph fill
+ ;; sendmail.el also sets a normal-auto-fill-function (not done here)
+ (make-local-variable 'paragraph-separate)
+ (make-local-variable 'paragraph-start)
+ (make-local-variable 'fill-paragraph-function)
+ (setq fill-paragraph-function 'mh-fill-paragraph-function)
+ (make-local-variable 'adaptive-fill-regexp)
+ (setq adaptive-fill-regexp
+ (concat adaptive-fill-regexp
+ "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
+ (make-local-variable 'adaptive-fill-first-line-regexp)
+ (setq adaptive-fill-first-line-regexp
+ (concat adaptive-fill-first-line-regexp
+ "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
+ ;; `-- ' precedes the signature. `-----' appears at the start of the
+ ;; lines that delimit forwarded messages.
+ ;; Lines containing just >= 3 dashes, perhaps after whitespace,
+ ;; are also sometimes used and should be separators.
+ (setq paragraph-start (concat (regexp-quote mail-header-separator)
+ "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
+ "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
+ "-- $\\|---+$\\|"
+ page-delimiter))
+ (setq paragraph-separate paragraph-start)
+ ;; --- End of code from sendmail.el ---
+
+ (if (and (boundp 'tool-bar-mode) tool-bar-mode)
+ (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
+ (make-local-variable 'font-lock-defaults)
+ (cond
+ ((or (equal mh-highlight-citation-p 'font-lock)
+ (equal mh-highlight-citation-p 'gnus))
+ ;; Let's use font-lock even if gnus is used in show-mode. The reason
+ ;; is that gnus uses static text properties which are not appropriate
+ ;; for a buffer that will be edited. So the choice here is either fontify
+ ;; the citations and header...
+ (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
+ (t
+ ;; ...or the header only
+ (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
+ (easy-menu-add mh-letter-menu)
+ ;; See if a "forw: -mime" message containing a MIME composition.
+ ;; Mode clears local vars, so can't do this in mh-forward.
+ (save-excursion
+ (goto-char (point-min))
+ (when (and (re-search-forward
+ (format "^\\(%s\\)?$" mail-header-separator) nil t)
+ (= 0 (forward-line 1))
+ (looking-at "^#forw"))
+ (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var
+ (setq mh-mhn-compose-insert-flag t)))
+ (setq fill-column mh-letter-fill-column)
+ ;; If text-mode-hook turned on auto-fill, tune it for messages
+ (when auto-fill-function
+ (make-local-variable 'auto-fill-function)
+ (setq auto-fill-function 'mh-auto-fill-for-letter)))
+
+(defun mh-auto-fill-for-letter ()
+ "Perform auto-fill for message.
+Header is treated specially by inserting a tab before continuation lines."
+ (if (mh-in-header-p)
+ (let ((fill-prefix "\t"))
+ (do-auto-fill))
+ (do-auto-fill)))
+
+(defun mh-insert-header-separator ()
+ "Insert `mh-mail-header-separator', if absent."
+ (save-excursion
+ (goto-char (point-min))
+ (rfc822-goto-eoh)
+ (if (looking-at "$")
+ (insert mh-mail-header-separator))))
+
+;;;###mh-autoload
+(defun mh-to-field ()
+ "Move point to the end of a specified header field.
+The field is indicated by the previous keystroke (the last keystroke
+of the command) according to the list in the variable `mh-to-field-choices'.
+Create the field if it does not exist. Set the mark to point before moving."
+ (interactive)
+ (expand-abbrev)
+ (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
+ mh-to-field-choices)
+ ;; also look for a char for version 4 compat
+ (assoc (logior last-input-char ?`)
+ mh-to-field-choices))))
+ (case-fold-search t))
+ (push-mark)
+ (cond ((mh-position-on-field target)
+ (let ((eol (point)))
+ (skip-chars-backward " \t")
+ (delete-region (point) eol))
+ (if (and (not (eq (logior last-input-char ?`) ?s))
+ (save-excursion
+ (backward-char 1)
+ (not (looking-at "[:,]"))))
+ (insert ", ")
+ (insert " ")))
+ (t
+ (if (mh-position-on-field "To:")
+ (forward-line 1))
+ (insert (format "%s \n" target))
+ (backward-char 1)))))
+
+;;;###mh-autoload
+(defun mh-to-fcc (&optional folder)
+ "Insert an Fcc: FOLDER field in the current message.
+Prompt for the field name with a completion list of the current folders."
+ (interactive)
+ (or folder
+ (setq folder (mh-prompt-for-folder
+ "Fcc"
+ (or (and mh-default-folder-for-message-function
+ (save-excursion
+ (goto-char (point-min))
+ (funcall
+ mh-default-folder-for-message-function)))
+ "")
+ t)))
+ (let ((last-input-char ?\C-f))
+ (expand-abbrev)
+ (save-excursion
+ (mh-to-field)
+ (insert (if (mh-folder-name-p folder)
+ (substring folder 1)
+ folder)))))
+
+;;;###mh-autoload
+(defun mh-insert-signature ()
+ "Insert the file named by `mh-signature-file-name' at point.
+The value of `mh-letter-insert-signature-hook' is a list of functions to be
+called, with no arguments, before the signature is actually inserted."
+ (interactive)
+ (let ((mh-signature-file-name mh-signature-file-name))
+ (run-hooks 'mh-letter-insert-signature-hook)
+ (if mh-signature-file-name
+ (insert-file-contents mh-signature-file-name)))
+ (force-mode-line-update))
+
+;;;###mh-autoload
+(defun mh-check-whom ()
+ "Verify recipients of the current letter, showing expansion of any aliases."
+ (interactive)
+ (let ((file-name buffer-file-name))
+ (save-buffer)
+ (message "Checking recipients...")
+ (mh-in-show-buffer ("*Recipients*")
+ (bury-buffer (current-buffer))
+ (erase-buffer)
+ (mh-exec-cmd-output "whom" t file-name))
+ (message "Checking recipients...done")))
+
+\f
+
+;;; Routines to compose and send a letter.
+
+(defun mh-insert-x-face ()
+ "Append X-Face field to header.
+If the field already exists, this function does nothing."
+ (when (and (file-exists-p mh-x-face-file)
+ (file-readable-p mh-x-face-file))
+ (save-excursion
+ (when (null (mh-position-on-field "X-Face"))
+ (insert "X-Face: ")
+ (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
+ (if (not (looking-at "^"))
+ (insert "\n"))))))
+
+(defun mh-insert-x-mailer ()
+ "Append an X-Mailer field to the header.
+The versions of MH-E, Emacs, and MH are shown."
+
+ ;; Lazily initialize mh-x-mailer-string.
+ (when (null mh-x-mailer-string)
+ (save-window-excursion
+ (mh-version)
+ (set-buffer mh-temp-buffer)
+ (if mh-nmh-flag
+ (search-forward-regexp "^nmh-\\(\\S +\\)")
+ (search-forward-regexp "^MH \\(\\S +\\)" nil t))
+ (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1))))
+ (setq mh-x-mailer-string
+ (format "MH-E %s; %s %s; %s %d.%d"
+ mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
+ (if mh-xemacs-flag
+ "XEmacs"
+ "Emacs")
+ emacs-major-version emacs-minor-version)))
+ (kill-buffer mh-temp-buffer)))
+ ;; Insert X-Mailer, but only if it doesn't already exist.
+ (save-excursion
+ (when (null (mh-goto-header-field "X-Mailer"))
+ (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
+
+(defun mh-regexp-in-field-p (regexp &rest fields)
+ "Non-nil means REGEXP was found in FIELDS."
+ (save-excursion
+ (let ((search-result nil)
+ (field))
+ (while fields
+ (setq field (car fields))
+ (if (and (mh-goto-header-field field)
+ (re-search-forward
+ regexp (save-excursion (mh-header-field-end)(point)) t))
+ (setq fields nil
+ search-result t)
+ (setq fields (cdr fields))))
+ search-result)))
+
+(defun mh-insert-mail-followup-to ()
+ "Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'."
+ (save-excursion
+ (if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))
+ (not (mh-goto-header-field "Mail-Followup-To: ")))
+ (let ((list mh-insert-mail-followup-to-list))
+ (while list
+ (let ((regexp (nth 0 (car list)))
+ (entry (nth 1 (car list))))
+ (when (mh-regexp-in-field-p regexp "To:" "cc:")
+ (if (mh-goto-header-field "Mail-Followup-To: ")
+ (insert entry ", ")
+ (mh-goto-header-end 0)
+ (insert "Mail-Followup-To: " entry "\n")))
+ (setq list (cdr list))))))))
+
+(defun mh-compose-and-send-mail (draft send-args
+ sent-from-folder sent-from-msg
+ to subject cc
+ annotate-char annotate-field
+ config)
+ "Edit and compose a draft message in buffer DRAFT and send or save it.
+SEND-ARGS is the argument passed to the send command.
+SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
+nil if none exists.
+SENT-FROM-MSG is the message number or sequence name or nil.
+The TO, SUBJECT, and CC fields are passed to the
+`mh-compose-letter-function'.
+If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
+message. In that case, the ANNOTATE-FIELD is used to build a string
+for `mh-annotate-msg'.
+CONFIG is the window configuration to restore after sending the letter."
+ (pop-to-buffer draft)
+ (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to))
+ (mh-letter-mode)
+
+ ;; mh-identity support
+ (if (and (boundp 'mh-identity-default)
+ mh-identity-default)
+ (mh-insert-identity mh-identity-default))
+ (when (and (boundp 'mh-identity-list)
+ mh-identity-list)
+ (mh-identity-make-menu)
+ (easy-menu-add mh-identity-menu))
+
+ (setq mh-sent-from-folder sent-from-folder)
+ (setq mh-sent-from-msg sent-from-msg)
+ (setq mh-send-args send-args)
+ (setq mh-annotate-char annotate-char)
+ (setq mh-annotate-field annotate-field)
+ (setq mh-previous-window-config config)
+ (setq mode-line-buffer-identification (list "{%b}"))
+ (if (and (boundp 'mh-compose-letter-function)
+ mh-compose-letter-function)
+ ;; run-hooks will not pass arguments.
+ (let ((value mh-compose-letter-function))
+ (if (and (listp value) (not (eq (car value) 'lambda)))
+ (while value
+ (funcall (car value) to subject cc)
+ (setq value (cdr value)))
+ (funcall mh-compose-letter-function to subject cc)))))
+
+(defun mh-letter-mode-message ()
+ "Display a help message for users of `mh-letter-mode'.
+This should be the last function called when composing the draft."
+ (message "%s" (substitute-command-keys
+ (concat "Type \\[mh-send-letter] to send message, "
+ "\\[mh-help] for help."))))
+
+;;;###mh-autoload
+(defun mh-send-letter (&optional arg)
+ "Send the draft letter in the current buffer.
+If optional prefix argument ARG is provided, monitor delivery.
+The value of `mh-before-send-letter-hook' is a list of functions to be called,
+with no arguments, before doing anything.
+Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
+Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
+Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
+Insert X-Face field if the file specified by `mh-x-face-file' exists."
+ (interactive "P")
+ (run-hooks 'mh-before-send-letter-hook)
+ (cond
+ ((and (boundp 'mh-mhn-compose-insert-flag)
+ mh-mhn-compose-insert-flag)
+ (mh-edit-mhn))
+ ((and (boundp 'mh-mml-compose-insert-flag)
+ mh-mml-compose-insert-flag)
+ (mh-mml-to-mime)))
+ (if mh-insert-x-mailer-flag (mh-insert-x-mailer))
+ (mh-insert-x-face)
+ (save-buffer)
+ (message "Sending...")
+ (let ((draft-buffer (current-buffer))
+ (file-name buffer-file-name)
+ (config mh-previous-window-config)
+ (coding-system-for-write
+ (if (and (local-variable-p 'buffer-file-coding-system
+ (current-buffer)) ;XEmacs needs two args
+ ;; We're not sure why, but buffer-file-coding-system
+ ;; tends to get set to undecided-unix.
+ (not (memq buffer-file-coding-system
+ '(undecided undecided-unix undecided-dos))))
+ buffer-file-coding-system
+ (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
+ (and (boundp 'default-buffer-file-coding-system )
+ default-buffer-file-coding-system)
+ 'iso-latin-1))))
+ ;; The default BCC encapsulation will make a MIME message unreadable.
+ ;; With nmh use the -mime arg to prevent this.
+ (if (and mh-nmh-flag
+ (mh-goto-header-field "Bcc:")
+ (mh-goto-header-field "Content-Type:"))
+ (setq mh-send-args (format "-mime %s" mh-send-args)))
+ (cond (arg
+ (pop-to-buffer "MH mail delivery")
+ (erase-buffer)
+ (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
+ "-nodraftfolder" mh-send-args file-name)
+ (goto-char (point-max)) ; show the interesting part
+ (recenter -1)
+ (set-buffer draft-buffer)) ; for annotation below
+ (t
+ (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
+ mh-send-args file-name)))
+ (if mh-annotate-char
+ (mh-annotate-msg mh-sent-from-msg
+ mh-sent-from-folder
+ mh-annotate-char
+ "-component" mh-annotate-field
+ "-text" (format "\"%s %s\""
+ (mh-get-header-field "To:")
+ (mh-get-header-field "Cc:"))))
+
+ (cond ((or (not arg)
+ (y-or-n-p "Kill draft buffer? "))
+ (kill-buffer draft-buffer)
+ (if config
+ (set-window-configuration config))))
+ (if arg
+ (message "Sending...done")
+ (message "Sending...backgrounded"))))
+
+;;;###mh-autoload
+(defun mh-insert-letter (folder message verbatim)
+ "Insert a message into the current letter.
+Removes the header fields according to the variable `mh-invisible-headers'.
+Prefixes each non-blank line with `mh-ins-buf-prefix', unless
+`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
+used to format the message.
+Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
+not indent and do not delete headers. Leaves the mark before the letter
+and point after it."
+ (interactive
+ (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
+ (read-input (format "Message number%s: "
+ (if (numberp mh-sent-from-msg)
+ (format " [%d]" mh-sent-from-msg)
+ "")))
+ current-prefix-arg))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (let ((start (point-min)))
+ (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
+ (insert-file-contents
+ (expand-file-name message (mh-expand-file-name folder)))
+ (when (not verbatim)
+ (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
+ (goto-char (point-max)) ;Needed for sc-cite-original
+ (push-mark) ;Needed for sc-cite-original
+ (goto-char (point-min)) ;Needed for sc-cite-original
+ (mh-insert-prefix-string mh-ins-buf-prefix)))))
+
+(defun mh-extract-from-attribution ()
+ "Extract phrase or comment from From header field."
+ (save-excursion
+ (if (not (mh-goto-header-field "From: "))
+ nil
+ (skip-chars-forward " ")
+ (cond
+ ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
+ (format "%s %s %s" (match-string 1)(match-string 2)
+ mh-extract-from-attribution-verb))
+ ((looking-at "\\([^<\n]+<.+>\\)$")
+ (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))
+ ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
+ (format "%s <%s> %s" (match-string 2)(match-string 1)
+ mh-extract-from-attribution-verb))
+ ((looking-at " *\\(.+\\)$")
+ (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
+
+;;;###mh-autoload
+(defun mh-yank-cur-msg ()
+ "Insert the current message into the draft buffer.
+Prefix each non-blank line in the message with the string in
+`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
+only the region will be inserted. Otherwise, the entire message will
+be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
+is nil, the portion of the message following the point will be yanked.
+If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
+yanked message will be deleted."
+ (interactive)
+ (if (and mh-sent-from-folder
+ (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
+ (save-excursion (set-buffer mh-sent-from-folder)
+ (get-buffer mh-show-buffer))
+ mh-sent-from-msg)
+ (let ((to-point (point))
+ (to-buffer (current-buffer)))
+ (set-buffer mh-sent-from-folder)
+ (if mh-delete-yanked-msg-window-flag
+ (delete-windows-on mh-show-buffer))
+ (set-buffer mh-show-buffer) ; Find displayed message
+ (let* ((from-attr (mh-extract-from-attribution))
+ (yank-region (mh-mark-active-p nil))
+ (mh-ins-str
+ (cond ((and yank-region
+ (or (eq 'supercite mh-yank-from-start-of-msg)
+ (eq 'autosupercite mh-yank-from-start-of-msg)
+ (eq t mh-yank-from-start-of-msg)))
+ ;; supercite needs the full header
+ (concat
+ (buffer-substring (point-min) (mail-header-end))
+ "\n"
+ (buffer-substring (region-beginning) (region-end))))
+ (yank-region
+ (buffer-substring (region-beginning) (region-end)))
+ ((or (eq 'body mh-yank-from-start-of-msg)
+ (eq 'attribution
+ mh-yank-from-start-of-msg)
+ (eq 'autoattrib
+ mh-yank-from-start-of-msg))
+ (buffer-substring
+ (save-excursion
+ (goto-char (point-min))
+ (mh-goto-header-end 1)
+ (point))
+ (point-max)))
+ ((or (eq 'supercite mh-yank-from-start-of-msg)
+ (eq 'autosupercite mh-yank-from-start-of-msg)
+ (eq t mh-yank-from-start-of-msg))
+ (buffer-substring (point-min) (point-max)))
+ (t
+ (buffer-substring (point) (point-max))))))
+ (set-buffer to-buffer)
+ (save-restriction
+ (narrow-to-region to-point to-point)
+ (insert (mh-filter-out-non-text mh-ins-str))
+ (goto-char (point-max)) ;Needed for sc-cite-original
+ (push-mark) ;Needed for sc-cite-original
+ (goto-char (point-min)) ;Needed for sc-cite-original
+ (mh-insert-prefix-string mh-ins-buf-prefix)
+ (if (or (eq 'attribution mh-yank-from-start-of-msg)
+ (eq 'autoattrib mh-yank-from-start-of-msg))
+ (insert from-attr "\n\n"))
+ ;; If the user has selected a region, he has already "edited" the
+ ;; text, so leave the cursor at the end of the yanked text. In
+ ;; either case, leave a mark at the opposite end of the included
+ ;; text to make it easy to jump or delete to the other end of the
+ ;; text.
+ (push-mark)
+ (goto-char (point-max))
+ (if (null yank-region)
+ (mh-exchange-point-and-mark-preserving-active-mark)))))
+ (error "There is no current message")))
+
+(defun mh-filter-out-non-text (string)
+ "Return STRING but without adornments such as MIME buttons and smileys."
+ (with-temp-buffer
+ ;; Insert the string to filter
+ (insert string)
+ (goto-char (point-min))
+
+ ;; Remove the MIME buttons
+ (let ((can-move-forward t)
+ (in-button nil))
+ (while can-move-forward
+ (cond ((and (not (get-text-property (point) 'mh-data))
+ in-button)
+ (delete-region (1- (point)) (point))
+ (setq in-button nil))
+ ((get-text-property (point) 'mh-data)
+ (delete-region (point)
+ (save-excursion (forward-line) (point)))
+ (setq in-button t))
+ (t (setq can-move-forward (= (forward-line) 0))))))
+
+ ;; Return the contents without properties... This gets rid of emphasis
+ ;; and smileys
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun mh-insert-prefix-string (mh-ins-string)
+ "Insert prefix string before each line in buffer.
+The inserted letter is cited using `sc-cite-original' if
+`mh-yank-from-start-of-msg' is one of 'supercite or 'autosupercite. Otherwise,
+simply insert MH-INS-STRING before each line."
+ (goto-char (point-min))
+ (cond ((or (eq mh-yank-from-start-of-msg 'supercite)
+ (eq mh-yank-from-start-of-msg 'autosupercite))
+ (sc-cite-original))
+ (mail-citation-hook
+ (run-hooks 'mail-citation-hook))
+ (mh-yank-hooks ;old hook name
+ (run-hooks 'mh-yank-hooks))
+ (t
+ (or (bolp) (forward-line 1))
+ (while (< (point) (point-max))
+ (insert mh-ins-string)
+ (forward-line 1))
+ (goto-char (point-min))))) ;leave point like sc-cite-original
+
+;;;###mh-autoload
+(defun mh-fully-kill-draft ()
+ "Kill the draft message file and the draft message buffer.
+Use \\[kill-buffer] if you don't want to delete the draft message file."
+ (interactive)
+ (if (y-or-n-p "Kill draft message? ")
+ (let ((config mh-previous-window-config))
+ (if (file-exists-p buffer-file-name)
+ (delete-file buffer-file-name))
+ (set-buffer-modified-p nil)
+ (kill-buffer (buffer-name))
+ (message "")
+ (if config
+ (set-window-configuration config)))
+ (error "Message not killed")))
+
+(defun mh-current-fill-prefix ()
+ "Return the `fill-prefix' on the current line as a string."
+ (save-excursion
+ (beginning-of-line)
+ ;; This assumes that the major-mode sets up adaptive-fill-regexp
+ ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
+ ;; perhaps I should use the variable and simply inserts its value here,
+ ;; and set it locally in a let scope. --psg
+ (if (re-search-forward adaptive-fill-regexp nil t)
+ (match-string 0)
+ "")))
+
+;;;###mh-autoload
+(defun mh-open-line ()
+ "Insert a newline and leave point after it.
+In addition, insert newline and quoting characters before text after point.
+This is useful in breaking up paragraphs in replies."
+ (interactive)
+ (let ((column (current-column))
+ (prefix (mh-current-fill-prefix)))
+ (if (> (length prefix) column)
+ (message "Sorry, point seems to be within the line prefix")
+ (newline 2)
+ (insert prefix)
+ (while (> column (current-column))
+ (insert " "))
+ (forward-line -1))))
+
+;;;###mh-autoload
+(defun mh-letter-complete (arg)
+ "Perform completion on header field or word preceding point.
+Alias completion is done within the mail header on selected fields and
+by the function designated by `mh-letter-complete-function' elsewhere,
+passing the prefix ARG if any."
+ (interactive "P")
+ (let ((case-fold-search t))
+ (if (and (mh-in-header-p)
+ (save-excursion
+ (mh-header-field-beginning)
+ (looking-at "^.*\\(to\\|cc\\|from\\):")))
+ (mh-alias-letter-expand-alias)
+ (funcall mh-letter-complete-function arg))))
+
+;;; Build the letter-mode keymap:
+;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
+(gnus-define-keys mh-letter-mode-map
+ "\C-c?" mh-help
+ "\C-c\C-c" mh-send-letter
+ "\C-c\C-d" mh-insert-identity
+ "\C-c\C-e" mh-edit-mhn
+ "\C-c\C-f\C-b" mh-to-field
+ "\C-c\C-f\C-c" mh-to-field
+ "\C-c\C-f\C-d" mh-to-field
+ "\C-c\C-f\C-f" mh-to-fcc
+ "\C-c\C-f\C-r" mh-to-field
+ "\C-c\C-f\C-s" mh-to-field
+ "\C-c\C-f\C-t" mh-to-field
+ "\C-c\C-fb" mh-to-field
+ "\C-c\C-fc" mh-to-field
+ "\C-c\C-fd" mh-to-field
+ "\C-c\C-ff" mh-to-fcc
+ "\C-c\C-fr" mh-to-field
+ "\C-c\C-fs" mh-to-field
+ "\C-c\C-ft" mh-to-field
+ "\C-c\C-i" mh-insert-letter
+ "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime
+ "\C-c\C-m\C-f" mh-compose-forward
+ "\C-c\C-m\C-i" mh-compose-insertion
+ "\C-c\C-m\C-m" mh-mml-to-mime
+ "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime
+ "\C-c\C-m\C-u" mh-revert-mhn-edit
+ "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime
+ "\C-c\C-mf" mh-compose-forward
+ "\C-c\C-mi" mh-compose-insertion
+ "\C-c\C-mm" mh-mml-to-mime
+ "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime
+ "\C-c\C-mu" mh-revert-mhn-edit
+ "\C-c\C-o" mh-open-line
+ "\C-c\C-q" mh-fully-kill-draft
+ "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
+ "\C-c\C-s" mh-insert-signature
+ "\C-c\C-^" mh-insert-signature ;if no C-s
+ "\C-c\C-w" mh-check-whom
+ "\C-c\C-y" mh-yank-cur-msg
+ "\M-\t" mh-letter-complete)
+
+;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
+
+(provide 'mh-comp)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-comp.el ends here
--- /dev/null
+;;; mh-customize.el --- MH-E customization
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; All of the defgroups, defcustoms, and deffaces in MH-E are found here. This
+;; makes it possible to customize modules that aren't loaded yet. It also
+;; makes it easier to organize the customization groups.
+
+;; This file contains the following sections:
+;;
+;; 1. MH-E Customization Groups
+;;
+;; These are the customization group definitions. These are organized in a
+;; logical order. High-level, windows and toolbar, folder, message,
+;; composing and hooks.
+;;
+;; 2. MH-E Customization
+;;
+;; Here are the actual customization variables. There is a sub-section for
+;; each group in the MH-E Customization Groups section. Within each
+;; section, variables are sorted alphabetically. The manual section
+;; dictates which group a variable should be placed. New variables should
+;; be placed in the section where they would most likely be defined.
+;;
+;; All hooks should be placed in the 'mh-hook group; in addition, add the
+;; group in which the hook is defined in the manual (or, if it is new,
+;; where it would be defined). These two actions insures that the hooks
+;; appear last in each group.
+;;
+;; 3. Faces
+
+;;; Change Log:
+
+;; $Id: mh-customize.el,v 1.1 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+;;;###mh-autoload
+(defun mh-customize ()
+ "Customize MH-E variables."
+ (interactive)
+ (customize-group 'mh))
+
+;;; MH-E Customization Groups
+
+(defgroup mh nil
+ "GNU Emacs interface to the MH mail system."
+ :link '(custom-manual "(mh-e)Top")
+ :group 'mail)
+
+(defgroup mh-toolbar nil
+ "Toolbar configuration."
+ :prefix "mh-"
+ :group 'mh)
+
+(defgroup mh-speed nil
+ "Speedbar and folder configuration."
+ :prefix "mh-"
+ :link '(custom-manual "(mh-e)Customizing Moving Mail")
+ :group 'mh)
+
+(defgroup mh-folder nil
+ "Options for controlling scan listing."
+ :prefix "mh-"
+ :link '(custom-manual "(mh-e)Customizing Moving Mail")
+ :group 'mh)
+
+(defgroup mh-show nil
+ "Message display."
+ :prefix "mh-"
+ :link '(custom-manual "(mh-e)Customizing Reading")
+ :group 'mh)
+
+(defgroup mh-letter nil
+ "Composing messages."
+ :prefix "mh-"
+ :link '(custom-manual "(mh-e)Customizing Sending")
+ :group 'mh)
+
+(defgroup mh-alias nil
+ "Alias handling."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-alias-"
+ :group 'mh)
+
+(defgroup mh-index nil
+ "Indexed searching."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'mh)
+
+(defgroup mh-identity nil
+ "Multiple personalities."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'mh)
+
+(defgroup mh-faces nil
+ "Faces used in MH-E."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'faces
+ :group 'mh)
+
+(defgroup mh-hooks nil
+ "MH-E hooks."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'mh)
+
+;;; Faces
+
+(defgroup mh-speed-faces nil
+ "Faces used in speedbar."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'mh-faces
+ :group 'mh-speed)
+
+(defgroup mh-folder-faces nil
+ "Faces used in scan listing."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'mh-faces
+ :group 'mh-folder)
+
+(defgroup mh-show-faces nil
+ "Faces used in message display."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'mh-faces
+ :group 'mh-show)
+
+(defgroup mh-index-faces nil
+ "Faces used in indexed searches."
+ :link '(custom-manual "(mh-e)Customizing mh-e")
+ :prefix "mh-"
+ :group 'mh-faces
+ :group 'mh-index)
+
+\f
+
+;;; MH-E Customization (:group mh)
+
+;;; Toolbar configuration (:group 'mh-toolbar)
+
+(defconst mh-tool-bar-item-inc "Incorporate new mail in Inbox")
+(defconst mh-tool-bar-item-save-mime "Save MIME parts")
+(defconst mh-tool-bar-item-prev-msg "Previous message")
+(defconst mh-tool-bar-item-page-msg "Page this message")
+(defconst mh-tool-bar-item-next-msg "Next message")
+(defconst mh-tool-bar-item-delete "Mark for deletion")
+(defconst mh-tool-bar-item-refile "Refile this message")
+(defconst mh-tool-bar-item-undo "Undo this mark")
+(defconst mh-tool-bar-item-perform "Perform moves and deletes")
+(defconst mh-tool-bar-item-toggle-show "Toggle showing message")
+(defconst mh-tool-bar-item-reply-from "Reply to \"from\"")
+(defconst mh-tool-bar-item-reply-to "Reply to \"to\"")
+(defconst mh-tool-bar-item-reply-all "Reply to \"all\"")
+(defconst mh-tool-bar-item-reply "Reply to this message")
+(defconst mh-tool-bar-item-alias "Grab From alias")
+(defconst mh-tool-bar-item-compose "Compose new message")
+(defconst mh-tool-bar-item-rescan "Rescan this folder")
+(defconst mh-tool-bar-item-repack "Repack this folder")
+(defconst mh-tool-bar-item-search "Search")
+(defconst mh-tool-bar-item-visit "Visit other folder")
+(defconst mh-tool-bar-item-prefs "MH-E preferences")
+(defconst mh-tool-bar-item-help "Help")
+(defconst mh-tool-bar-item-widen "Widen from this sequence")
+
+(defconst mh-tool-bar-item-send "Send this letter")
+(defconst mh-tool-bar-item-attach "Insert attachment")
+(defconst mh-tool-bar-item-spell "Check spelling")
+(defconst mh-tool-bar-item-save "Save current buffer to its file")
+(defconst mh-tool-bar-item-undo-op "Undo last operation")
+(defconst mh-tool-bar-item-kill
+ "Cut (kill) text in region between mark and current position")
+(defconst mh-tool-bar-item-copy
+ "Copy text in region between mark and current position")
+(defconst mh-tool-bar-item-paste
+ "Paste (yank) text cut or copied earlier")
+(defconst mh-tool-bar-item-kill-draft "Kill this draft")
+(defconst mh-tool-bar-item-comp-prefs "MH-E composition preferences")
+
+(defcustom mh-tool-bar-reply-3-buttons-flag nil
+ "*Non-nil means use three buttons for reply commands in tool-bar.
+If you have room on your tool-bar because you are using a large font, you
+may set this variable to expand the single reply button into three buttons
+that won't lead to minibuffer prompt about who to reply to."
+ :type 'boolean
+ :group 'mh-toolbar)
+
+(defcustom mh-tool-bar-search-function 'mh-search-folder
+ "*Function called by the tool-bar search button.
+See `mh-search-folder' and `mh-index-search' for details."
+ :type '(choice (const mh-search-folder)
+ (const mh-index-search)
+ (function :tag "Other function"))
+ :group 'mh-toolbar)
+
+(eval-when-compile (defvar tool-bar-map))
+(defvar mh-show-tool-bar-map nil)
+(defun mh-tool-bar-show-set ()
+ "Construct toolbar for `mh-show-mode'."
+ (when (fboundp 'tool-bar-add-item)
+ (setq
+ mh-show-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder
+ :help mh-tool-bar-item-inc))
+ (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "attach" 'mh-mime-save-parts
+ 'mh-showtoolbar-mime-save-parts
+ :help mh-tool-bar-item-save-mime))
+ (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg
+ 'mh-showtoolbar-prev
+ :help mh-tool-bar-item-prev-msg))
+ (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page
+ :help mh-tool-bar-item-page-msg))
+ (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg
+ 'mh-showtoolbar-next
+ :help mh-tool-bar-item-next-msg))
+ (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "close" 'mh-show-delete-msg
+ 'mh-showtoolbar-delete
+ :help mh-tool-bar-item-delete))
+ (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "refile" 'mh-show-refile-msg
+ 'mh-showtoolbar-refile
+ :help mh-tool-bar-item-refile))
+ (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo
+ :help mh-tool-bar-item-undo))
+ (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "execute" 'mh-show-execute-commands
+ 'mh-showtoolbar-exec
+ :help mh-tool-bar-item-perform))
+ (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "show" 'mh-show-toggle-showing
+ 'mh-showtoolbar-toggle-show
+ :help mh-tool-bar-item-toggle-show))
+ (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "reply-from"
+ (lambda (&optional arg)
+ (interactive "P")
+ (set-buffer mh-show-folder-buffer)
+ (mh-reply (mh-get-msg-num nil) "from" arg))
+ 'mh-showtoolbar-reply-from
+ :help mh-tool-bar-item-reply-from))
+ (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "reply-to"
+ (lambda (&optional arg)
+ (interactive "P")
+ (set-buffer mh-show-folder-buffer)
+ (mh-reply (mh-get-msg-num nil) "to" arg))
+ 'mh-showtoolbar-reply-to
+ :help mh-tool-bar-item-reply-to))
+ (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "reply-all"
+ (lambda (&optional arg)
+ (interactive "P")
+ (set-buffer mh-show-folder-buffer)
+ (mh-reply (mh-get-msg-num nil) "all" arg))
+ 'mh-showtoolbar-reply-all
+ :help mh-tool-bar-item-reply-all))
+ (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "mail/reply2" 'mh-show-reply
+ 'mh-showtoolbar-reply
+ :help mh-tool-bar-item-reply))
+ (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "alias" 'mh-alias-grab-from-field
+ 'mh-showtoolbar-alias
+ :help mh-tool-bar-item-alias
+ :enable '(mh-alias-from-has-no-alias-p)))
+ (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose
+ :help mh-tool-bar-item-compose))
+ (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "rescan" 'mh-show-rescan-folder
+ 'mh-showtoolbar-rescan
+ :help mh-tool-bar-item-rescan))
+ (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "repack" 'mh-show-pack-folder
+ 'mh-showtoolbar-pack
+ :help mh-tool-bar-item-repack))
+ (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "search"
+ (lambda (&optional arg)
+ (interactive "P")
+ (call-interactively
+ mh-tool-bar-search-function))
+ 'mh-showtoolbar-search
+ :help mh-tool-bar-item-search))
+ (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "fld_open" 'mh-visit-folder
+ 'mh-showtoolbar-visit
+ :help mh-tool-bar-item-visit))
+ (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "preferences" (lambda ()
+ (interactive)
+ (customize-group "mh"))
+ 'mh-showtoolbar-customize
+ :help mh-tool-bar-item-prefs))
+ (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "help" (lambda ()
+ (interactive)
+ (Info-goto-node "(mh-e)Top"))
+ 'mh-showtoolbar-help
+ :help mh-tool-bar-item-help))
+ tool-bar-map))))
+
+(defvar mh-letter-tool-bar-map nil)
+;;;###mh-autoload
+(defun mh-tool-bar-letter-set ()
+ "Construct toolbar for `mh-letter-mode'."
+ (when (fboundp 'tool-bar-add-item)
+ (setq
+ mh-letter-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ (if (member mh-tool-bar-item-send mh-tool-bar-letter-buttons)
+ (tool-bar-add-item "mail_send" 'mh-send-letter
+ 'mh-lettertoolbar-send
+ :help mh-tool-bar-item-send))
+ (if (member mh-tool-bar-item-attach mh-tool-bar-letter-buttons)
+ (tool-bar-add-item "attach" 'mh-compose-insertion
+ 'mh-lettertoolbar-compose
+ :help mh-tool-bar-item-attach))
+ (if (member mh-tool-bar-item-spell mh-tool-bar-letter-buttons)
+ (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell
+ :help mh-tool-bar-item-spell))
+ (if (member mh-tool-bar-item-save mh-tool-bar-letter-buttons)
+ (tool-bar-add-item-from-menu 'save-buffer "save"))
+ (if (member mh-tool-bar-item-undo-op mh-tool-bar-letter-buttons)
+ (tool-bar-add-item-from-menu 'undo "undo"))
+ (if (member mh-tool-bar-item-kill mh-tool-bar-letter-buttons)
+ (tool-bar-add-item-from-menu 'kill-region "cut"))
+ (if (member mh-tool-bar-item-copy mh-tool-bar-letter-buttons)
+ (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy"))
+ (if (member mh-tool-bar-item-paste mh-tool-bar-letter-buttons)
+ (tool-bar-add-item-from-menu 'yank "paste"))
+ (if (member mh-tool-bar-item-kill-draft mh-tool-bar-letter-buttons)
+ (tool-bar-add-item "close" 'mh-fully-kill-draft
+ 'mh-lettertoolbar-kill
+ :help mh-tool-bar-item-kill-draft))
+ (if (member mh-tool-bar-item-comp-prefs mh-tool-bar-letter-buttons)
+ (tool-bar-add-item "preferences" (lambda ()
+ (interactive)
+ (customize-group "mh-compose"))
+ 'mh-lettertoolbar-customize
+ :help mh-tool-bar-item-comp-prefs))
+ (if (member mh-tool-bar-item-help mh-tool-bar-letter-buttons)
+ (tool-bar-add-item "help" (lambda ()
+ (interactive)
+ (Info-goto-node "(mh-e)Draft Editing"))
+ 'mh-lettertoolbar-help
+ :help mh-tool-bar-item-help))
+ tool-bar-map))))
+
+(defvar mh-folder-tool-bar-map nil)
+(defvar mh-folder-seq-tool-bar-map nil
+ "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.")
+;;;###mh-autoload
+(defun mh-tool-bar-folder-set ()
+ "Construct toolbar for `mh-folder-mode'."
+ (when (fboundp 'tool-bar-add-item)
+ (setq
+ mh-folder-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "mail" 'mh-inc-folder
+ 'mh-foldertoolbar-inc-folder
+ :help mh-tool-bar-item-inc))
+ (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "attach" 'mh-mime-save-parts
+ 'mh-foldertoolbar-mime-save-parts
+ :help mh-tool-bar-item-save-mime))
+ (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg
+ 'mh-foldertoolbar-prev
+ :help mh-tool-bar-item-prev-msg))
+ (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page
+ :help mh-tool-bar-item-page-msg))
+ (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg
+ 'mh-foldertoolbar-next
+ :help mh-tool-bar-item-next-msg))
+ (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete
+ :help mh-tool-bar-item-delete))
+ (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile
+ :help mh-tool-bar-item-refile))
+ (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo
+ :help mh-tool-bar-item-undo))
+ (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "execute" 'mh-execute-commands
+ 'mh-foldertoolbar-exec
+ :help mh-tool-bar-item-perform))
+ (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "show" 'mh-toggle-showing
+ 'mh-foldertoolbar-toggle-show
+ :help mh-tool-bar-item-toggle-show))
+ (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "reply-from"
+ (lambda (&optional arg)
+ (interactive "P")
+ (mh-reply (mh-get-msg-num nil) "from" arg))
+ 'mh-foldertoolbar-reply-from
+ :help mh-tool-bar-item-reply-from))
+ (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "reply-to"
+ (lambda (&optional arg)
+ (interactive "P")
+ (mh-reply (mh-get-msg-num nil) "to" arg))
+ 'mh-foldertoolbar-reply-to
+ :help mh-tool-bar-item-reply-to))
+ (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "reply-all"
+ (lambda (&optional arg)
+ (interactive "P")
+ (mh-reply (mh-get-msg-num nil) "all" arg))
+ 'mh-foldertoolbar-reply-all
+ :help mh-tool-bar-item-reply-all))
+ (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "mail/reply2" 'mh-reply
+ 'mh-foldertoolbar-reply
+ :help mh-tool-bar-item-reply))
+ (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "alias" 'mh-alias-grab-from-field
+ 'mh-foldertoolbar-alias
+ :help mh-tool-bar-item-alias
+ :enable '(mh-alias-from-has-no-alias-p)))
+ (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose
+ :help mh-tool-bar-item-compose))
+ (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "rescan" 'mh-rescan-folder
+ 'mh-foldertoolbar-rescan
+ :help mh-tool-bar-item-rescan))
+ (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack
+ :help mh-tool-bar-item-repack))
+ (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "search"
+ (lambda (&optional arg)
+ (interactive "P")
+ (call-interactively
+ mh-tool-bar-search-function))
+ 'mh-foldertoolbar-search
+ :help mh-tool-bar-item-search))
+ (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "fld_open" 'mh-visit-folder
+ 'mh-foldertoolbar-visit
+ :help mh-tool-bar-item-visit))
+ (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "preferences" (lambda ()
+ (interactive)
+ (customize-group "mh"))
+ 'mh-foldertoolbar-customize
+ :help mh-tool-bar-item-prefs))
+ (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "help" (lambda ()
+ (interactive)
+ (Info-goto-node "(mh-e)Top"))
+ 'mh-foldertoolbar-help
+ :help mh-tool-bar-item-help))
+ tool-bar-map))
+
+ (setq mh-folder-seq-tool-bar-map
+ (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
+ (if (member mh-tool-bar-item-widen mh-tool-bar-folder-buttons)
+ (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen
+ :help mh-tool-bar-item-widen))
+ tool-bar-map))))
+
+(defun mh-tool-bar-folder-buttons-set (symbol value)
+ "Update the `mh-tool-bar-folder-buttons' variable, and rebuild the tool-bar.
+Sets the default for SYMBOL (e.g. `mh-tool-bar-folder-buttons') to VALUE (as
+set in customization). This is called after 'customize is used to alter
+`mh-tool-bar-folder-buttons'."
+ (set-default symbol value)
+ (mh-tool-bar-show-set)
+ (mh-tool-bar-folder-set))
+
+(custom-declare-variable
+ 'mh-tool-bar-folder-buttons
+ '(append
+ (list mh-tool-bar-item-inc
+ mh-tool-bar-item-save-mime
+ mh-tool-bar-item-prev-msg
+ mh-tool-bar-item-page-msg
+ mh-tool-bar-item-next-msg
+ mh-tool-bar-item-delete
+ mh-tool-bar-item-refile
+ mh-tool-bar-item-undo
+ mh-tool-bar-item-perform
+;;; mh-tool-bar-item-toggle-show
+ )
+ (if mh-tool-bar-reply-3-buttons-flag
+ (list mh-tool-bar-item-reply-from
+ mh-tool-bar-item-reply-to
+ mh-tool-bar-item-reply-all)
+ (list mh-tool-bar-item-reply))
+ (list mh-tool-bar-item-alias
+ mh-tool-bar-item-compose
+ mh-tool-bar-item-rescan
+;;; mh-tool-bar-item-repack
+ mh-tool-bar-item-search
+ mh-tool-bar-item-visit
+ mh-tool-bar-item-prefs
+ mh-tool-bar-item-help
+ mh-tool-bar-item-widen))
+ "Buttons to include in MH-E folder/show toolbar."
+ :group 'mh-toolbar
+ :set 'mh-tool-bar-folder-buttons-set
+ :type `(set (const ,mh-tool-bar-item-inc)
+ (const ,mh-tool-bar-item-save-mime)
+ (const ,mh-tool-bar-item-prev-msg)
+ (const ,mh-tool-bar-item-page-msg)
+ (const ,mh-tool-bar-item-next-msg)
+ (const ,mh-tool-bar-item-delete)
+ (const ,mh-tool-bar-item-refile)
+ (const ,mh-tool-bar-item-undo)
+ (const ,mh-tool-bar-item-perform)
+ (const ,mh-tool-bar-item-toggle-show)
+ (const ,mh-tool-bar-item-reply-from)
+ (const ,mh-tool-bar-item-reply-to)
+ (const ,mh-tool-bar-item-reply-all)
+ (const ,mh-tool-bar-item-reply)
+ (const ,mh-tool-bar-item-alias)
+ (const ,mh-tool-bar-item-compose)
+ (const ,mh-tool-bar-item-rescan)
+ (const ,mh-tool-bar-item-repack)
+ (const ,mh-tool-bar-item-search)
+ (const ,mh-tool-bar-item-visit)
+ (const ,mh-tool-bar-item-prefs)
+ (const ,mh-tool-bar-item-help)
+ (const ,mh-tool-bar-item-widen)))
+
+(defun mh-tool-bar-letter-buttons-set (symbol value)
+ "Update the `mh-tool-bar-letter-buttons' variable, and rebuild the tool-bar.
+Sets the default for SYMBOL (e.g. `mh-tool-bar-letter-buttons') to VALUE (as
+set in customization). This is called after 'customize is used to alter
+`mh-tool-bar-letter-buttons'."
+ (set-default symbol value)
+ (mh-tool-bar-letter-set))
+
+(custom-declare-variable
+ 'mh-tool-bar-letter-buttons
+ '(list mh-tool-bar-item-send
+ mh-tool-bar-item-attach
+ mh-tool-bar-item-spell
+ mh-tool-bar-item-save
+ mh-tool-bar-item-undo-op
+ mh-tool-bar-item-kill
+ mh-tool-bar-item-copy
+ mh-tool-bar-item-paste
+ mh-tool-bar-item-kill-draft
+ mh-tool-bar-item-comp-prefs
+ mh-tool-bar-item-help)
+ "Buttons to include in MH-E letter toolbar."
+ :group 'mh-toolbar
+ :set 'mh-tool-bar-letter-buttons-set
+ :type `(set (const ,mh-tool-bar-item-send)
+ (const ,mh-tool-bar-item-attach)
+ (const ,mh-tool-bar-item-spell)
+ (const ,mh-tool-bar-item-save)
+ (const ,mh-tool-bar-item-undo-op)
+ (const ,mh-tool-bar-item-kill)
+ (const ,mh-tool-bar-item-copy)
+ (const ,mh-tool-bar-item-paste)
+ (const ,mh-tool-bar-item-kill-draft)
+ (const ,mh-tool-bar-item-comp-prefs)
+ (const ,mh-tool-bar-item-help)))
+
+\f
+
+;;; Speedbar and folder configuration (:group 'mh-speed)
+
+(defcustom mh-large-folder 200
+ "The number of messages that indicates a large folder.
+If a folder is deemed to be large, that is the number of messages in it exceed
+this value, then confirmation is needed when it is visited. Even when
+`mh-show-threads-flag' is non-nil, the folder is not automatically threaded, if
+it is large. If set to nil all folders are treated as if they are small."
+ :type '(choice (const :tag "No limit") integer)
+ :group 'mh-speed)
+
+(defcustom mh-speed-flists-interval 60
+ "Time between calls to flists in seconds.
+If 0, flists is not called repeatedly."
+ :type 'integer
+ :group 'mh-speed)
+
+(defcustom mh-speed-run-flists-flag t
+ "Non-nil means flists is used.
+If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
+update the display of the number of unseen and total messages in each folder.
+If resources are limited, this can be set to nil and the speedbar display can
+be updated manually with the \\[mh-speed-flists] command."
+ :type 'boolean
+ :group 'mh-speed)
+
+;;; Options for controlling scan listing (:group 'mh-folder)
+
+(defcustom mh-adaptive-cmd-note-flag t
+ "*Non-nil means that the message number width is determined dynamically.
+This is done once when a folder is first opened by running scan on the last
+message of the folder. The message number for the last message is extracted
+and its width calculated. This width is used when calling `mh-set-cmd-note'.
+
+If you prefer fixed-width message numbers, set this variable to nil and call
+`mh-set-cmd-note' with the width specified by the scan format in
+`mh-scan-format-file'. For example, the default width is 4, so you would use
+\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil."
+ :type 'boolean
+ :group 'mh-folder)
+
+(defcustom mh-auto-folder-collect-flag t
+ "*Non-nil means to collect all folder names at startup in the background.
+Otherwise, the internal list of folder names is built as folders are
+referenced."
+ :type 'boolean
+ :group 'mh-folder)
+
+(defcustom mh-inc-prog "inc"
+ "*Program to run to incorporate new mail into a folder.
+Normally \"inc\". This file is searched for relative to
+the `mh-progs' directory unless it is an absolute pathname."
+ :type 'string
+ :group 'mh-folder)
+
+(defcustom mh-lpr-command-format "lpr -J '%s'"
+ "*Format for Unix command that prints a message.
+The string should be a Unix command line, with the string '%s' where
+the job's name (folder and message number) should appear. The formatted
+message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
+ :type 'string
+ :group 'mh-folder)
+
+(defcustom mh-mime-save-parts-default-directory t
+ "Default directory to use for `mh-mime-save-parts'.
+If nil, prompt and set for next time the command is used during same session.
+If t, prompt always"
+ :type '(choice (const :tag "Prompt the first time" nil)
+ (const :tag "Prompt always" t)
+ directory)
+ :group 'mh-folder)
+
+(defcustom mh-recenter-summary-flag nil
+ "*Non-nil means to recenter the summary window.
+Recenter the summary window when the show window is toggled off if non-nil."
+ :type 'boolean
+ :group 'mh-folder)
+
+(defcustom mh-print-background-flag nil
+ "*Non-nil means messages should be printed in the background.
+WARNING: do not delete the messages until printing is finished;
+otherwise, your output may be truncated."
+ :type 'boolean
+ :group 'mh-folder)
+
+(defcustom mh-recursive-folders-flag nil
+ "*Non-nil means that commands which operate on folders do so recursively."
+ :type 'boolean
+ :group 'mh-folder)
+
+(defcustom mh-scan-format-file t
+ "Specifies the format file to pass to the scan program.
+If t, the format string will be taken from the either `mh-scan-format-mh'
+or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
+If nil, the default scan output will be used.
+
+If you customize the scan format, you may need to modify a few variables
+containing regexps that MH-E uses to identify specific portions of the output.
+Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
+may also have to call `mh-set-cmd-note' with the width of your message
+numbers. See also `mh-adaptive-cmd-note-flag'."
+ :type '(choice (const :tag "Use MH-E scan format" t)
+ (const :tag "Use default scan format" nil)
+ (file :tag "Specify a scan format file"))
+ :group 'mh-folder)
+
+(defcustom mh-scan-prog "scan"
+ "*Program to run to generate one-line-per-message listing of a folder.
+Normally \"scan\" or a file name linked to scan. This file is searched
+for relative to the `mh-progs' directory unless it is an absolute pathname."
+ :type 'string
+ :group 'mh-folder)
+(make-variable-buffer-local 'mh-scan-prog)
+
+(defcustom mh-show-threads-flag nil
+ "Non-nil means new folders start in threaded mode.
+Threading large number of messages can be time consuming. So if the flag is
+non-nil then threading will be done only if the number of messages being
+threaded is less than `mh-large-folder'."
+ :type 'boolean
+ :group 'mh-folder)
+
+(defcustom mh-store-default-directory nil
+ "*Last directory used by \\[mh-store-msg]; default for next store.
+A directory name string, or nil to use current directory."
+ :type '(choice (const :tag "Current" nil)
+ directory)
+ :group 'mh-folder)
+
+(defcustom mh-update-sequences-after-mh-show-flag t
+ "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'.
+If set, `mh-update-sequence' is run every time a message is shown, telling
+MH or nmh that this is your current message. It's useful, for example, to
+display MIME content using \"M-! mhshow RET\""
+ :type 'boolean
+ :group 'mh-folder)
+
+;;; Message display (:group 'mh-show)
+
+(defcustom mh-bury-show-buffer-flag t
+ "*Non-nil means that the displayed show buffer for a folder is buried."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-clean-message-header-flag t
+ "*Non-nil means clean headers of messages that are displayed or inserted.
+The variables `mh-invisible-headers' and `mh-visible-headers' control
+what is removed."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode")))
+ "*Non-nil means that Gnus is used to show MIME attachments with Gnus."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-decode-quoted-printable-flag
+ (not (null (and (fboundp 'executable-find)(executable-find "mimedecode"))))
+ "Non-nil means decode quoted-printable MIME part with `mimedecode'.
+
+Quoted-printable message parts are translated to 8-bit characters by the
+`mimedecode' command. However, unless there is only one quoted-printable body
+part, Gnus will have already decoded the quoted-printable parts.
+
+This variable is initialized t if `mimedecode' is available.
+
+The source code for `mimedecode' can be obtained from
+http://www.freesoft.org/CIE/FAQ/mimedeco.c."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-display-buttons-for-inline-parts-flag nil
+ "*Non-nil means display buttons for all inline MIME parts.
+If non-nil, buttons are displayed for all MIME parts. Inline parts start off
+in displayed state but they can be hidden by clicking the button. If nil no
+buttons are shown for inline parts."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-do-not-confirm-flag nil
+ "*Non-nil means do not prompt for confirmation.
+Commands such as `mh-pack-folder' prompt to confirm whether to process
+outstanding moves and deletes or not before continuing. A non-nil setting will
+perform the action--which is usually desired but cannot be retracted--without
+question."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-graphical-smileys-flag t
+ "*Non-nil means graphical smileys are displayed.
+Non-nil means that small graphics will be used in the show buffer instead of
+patterns like :-), ;-) etc. The setting only has effect if
+`mh-decode-mime-flag' is non-nil."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-graphical-emphasis-flag t
+ "*Non-nil means graphical emphasis is displayed.
+Non-nil means that _underline_ will be underlined, *bold* will appear in bold,
+/italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole
+list. The setting only has effect if `mh-decode-mime-flag' is non-nil."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-highlight-citation-p 'gnus
+ "How to highlight citations in show buffers.
+The gnus method uses a different color for each indentation."
+ :type '(choice (const :tag "Use gnus" gnus)
+ (const :tag "Use font-lock" font-lock)
+ (const :tag "Don't fontify" nil))
+ :group 'mh-show)
+
+(defcustom mh-max-inline-image-height nil
+ "*Maximum inline image height if Content-Disposition is not present.
+If nil, image will be displayed if its height is smaller than the height of
+the window."
+ :type '(choice (const nil) integer)
+ :group 'mh-show)
+
+(defcustom mh-max-inline-image-width nil
+ "*Maximum inline image width if Content-Disposition is not present.
+If nil, image will be displayed if its width is smaller than the width of the
+window."
+ :type '(choice (const nil) integer)
+ :group 'mh-show)
+
+(defcustom mh-show-maximum-size 0
+ "*Maximum size of message (in bytes) to display automatically.
+Provides an opportunity to skip over large messages which may be slow to load.
+Use a value of 0 to display all messages automatically regardless of size."
+ :type 'integer
+ :group 'mh-show)
+
+;; Use goto-addr if it was already loaded (which probably sets this
+;; variable to t), or if this variable is otherwise set to t.
+(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p)
+ goto-address-highlight-p)
+ "*Non-nil means highlight URLs and email addresses.
+The `goto-addr' module is used."
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-show-use-xface-flag
+ (and window-system
+ (not (null (cond
+ (mh-xemacs-flag
+ (locate-library "x-face"))
+ ((>= emacs-major-version 21)
+ (locate-library "x-face-e21"))
+ (t ;Emacs20
+ nil))))
+ (not (null (and (fboundp 'executable-find)
+ (executable-find
+ "uncompface")))))
+ "*Non-nil means display faces in `mh-show-mode' with external x-face package.
+It is available from ftp://ftp.jpl.org/pub/elisp/. Download it and put its
+files in the Emacs `load-path' and MH-E will invoke it automatically for you if
+this variable is non-nil.
+
+The `uncompface' binary is also required to be in the execute PATH. It can
+be obtained from: ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z"
+ :type 'boolean
+ :group 'mh-show)
+
+(defcustom mh-summary-height (or (and (fboundp 'frame-height)
+ (> (frame-height) 24)
+ (min 10 (/ (frame-height) 6)))
+ 4)
+ "*Number of lines in MH-Folder window (including the mode line)."
+ :type 'integer
+ :group 'mh-show)
+
+(defcustom mh-visible-headers nil
+ "*Contains a regexp specifying the headers to keep when cleaning.
+Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides
+the variable `mh-invisible-headers'."
+ :type '(choice (const nil) regexp)
+ :group 'mh-show)
+
+(defcustom mhl-formfile nil
+ "*Name of format file to be used by mhl to show and print messages.
+A value of t means use the default format file.
+nil means don't use mhl to format messages when showing; mhl is still used,
+with the default format file, to format messages when printing them.
+The format used should specify a non-zero value for overflowoffset so
+the message continues to conform to RFC 822 and MH-E can parse the headers."
+ :type '(choice (const nil) (const t) string)
+ :group 'mh-show)
+(put 'mhl-formfile 'info-file "mh-e")
+
+(defvar mh-invisible-headers nil
+ "*Regexp matching lines in a message header that are not to be shown.
+If `mh-visible-headers' is non-nil, it is used instead to specify what
+to keep.")
+
+(defun mh-invisible-headers ()
+ "Make or remake the variable `mh-invisible-headers'.
+Done using `mh-invisible-header-fields' as input."
+ (setq mh-invisible-headers
+ (concat
+ "^"
+ (let ((max-specpdl-size 1000)) ;workaround for insufficient default
+ (regexp-opt
+ (append
+ (if (not mh-show-use-xface-flag)
+ '("X-Face: "))
+ mh-invisible-header-fields))))))
+
+(defun mh-invisible-header-fields-set (symbol value)
+ "Update `mh-invisible-header-fields'.
+The function is called with SYMBOL bound to `mh-invisible-header-fields' and
+VALUE is the the list of headers that are invisible. As a side effect, the
+variable `mh-invisible-fields' is set."
+ (set-default symbol value)
+ (mh-invisible-headers))
+
+;; Keep fields alphabetized. Mention source, if known.
+(defcustom mh-invisible-header-fields
+ '("Autoforwarded: "
+ "Bestservhost: "
+ "Content-" ; RFC 2045
+ "Delivered-To: " ; Egroups/yahoogroups mailing list manager
+ "Delivery-Date: " ; MH
+ "Delivery: "
+ "Encoding: "
+ "Errors-To: "
+ "Forwarded: " ; MH
+ "From " ; sendmail
+ "Importance: " ; MS Outlook
+ "In-Reply-To: " ; MH
+ "Lines: "
+ "List-" ; Mailman mailing list manager
+ "List-" ; Unknown mailing list managers
+ "List-Subscribe: " ; Unknown mailing list managers
+ "List-Unsubscribe: " ; Unknown mailing list managers
+ "Mail-from: " ; MH
+ "Mailing-List: " ; Egroups/yahoogroups mailing list manager
+ "Message-Id: " ; RFC 822
+ "Mime-Version" ; RFC 2045
+ "NNTP-" ; News
+ "Old-Return-Path: "
+ "Original-Encoded-Information-Types: " ; X400
+ "P1-Content-Type: " ; X400
+ "P1-Message-Id: " ; X400
+ "P1-Recipient: " ; X400
+ "Path: "
+ "Precedence: "
+ "Prev-Resent" ; MH
+ "Priority: "
+ "Received: " ; RFC 822
+ "References: "
+ "Remailed-" ; MH
+ "Replied: " ; MH
+ "Resent" ; MH
+ "Return-Path: " ; RFC 822
+ "Sensitivity: " ; MS Outlook
+ "Status: " ; sendmail
+ "Ua-Content-Id: " ; X400
+ "User-Agent: "
+ "Via: " ; MH
+ "X-Abuse-Info: "
+ "X-Accept-Language: "
+ "X-Accept-Language: " ; Netscape/Mozilla
+ "X-Ack: "
+ "X-Apparently-From: " ; MS Outlook
+ "X-Apparently-To: " ; Egroups/yahoogroups mailing list manager
+ "X-Authentication-Warning: " ; sendmail
+ "X-Beenthere: " ; Mailman mailing list manager
+ "X-Complaints-To: "
+ "X-Cron-Env: "
+ "X-Delivered"
+ "X-Envelope-Sender: "
+ "X-Envelope-To: "
+ "X-Folder: " ; Spam
+ "X-From-Line"
+ "X-Gnus-Mail-Source: " ; gnus
+ "X-Habeas-SWE-1: " ; Spam
+ "X-Habeas-SWE-2: " ; Spam
+ "X-Habeas-SWE-3: " ; Spam
+ "X-Habeas-SWE-4: " ; Spam
+ "X-Habeas-SWE-5: " ; Spam
+ "X-Habeas-SWE-6: " ; Spam
+ "X-Habeas-SWE-7: " ; Spam
+ "X-Habeas-SWE-8: " ; Spam
+ "X-Habeas-SWE-9: " ; Spam
+ "X-Info: " ; NTMail
+ "X-Juno-" ; Juno
+ "X-List-Host: " ; Unknown mailing list managers
+ "X-List-Subscribe: " ; Unknown mailing list managers
+ "X-List-Unsubscribe: " ; Unknown mailing list managers
+ "X-Listserver: " ; Unknown mailing list managers
+ "X-Loop: " ; Unknown mailing list managers
+ "X-MIME-Autoconverted: " ; sendmail
+ "X-MIMETrack: "
+ "X-MS-TNEF-Correlator: " ; MS Outlook
+ "X-Mailing-List: " ; Unknown mailing list managers
+ "X-Mailman-Version: " ; Mailman mailing list manager
+ "X-Message-Id"
+ "X-MimeOLE: " ; MS Outlook
+ "X-Mozilla-Status: " ; Netscape/Mozilla
+ "X-Msmail-" ; MS Outlook
+ "X-News: " ; News
+ "X-No-Archive: "
+ "X-Orcl-Content-Type: "
+ "X-Original-Complaints-To: "
+ "X-Original-Date: " ; SourceForge mailing list manager
+ "X-Original-Trace: "
+ "X-OriginalArrivalTime: " ; Hotmail
+ "X-Originating-IP: " ; Hotmail
+ "X-Priority: " ; MS Outlook
+ "X-Qotd-" ; User added
+ "X-Received-Date: "
+ "X-Received: "
+ "X-Request-"
+ "X-SBClass: " ; Spam
+ "X-SBNote: " ; Spam
+ "X-SBPass: " ; Spam
+ "X-SBRule: " ; Spam
+ "X-Scanned-By"
+ "X-Sender: "
+ "X-Server-Date: "
+ "X-Server-Uuid: "
+ "X-Sieve: " ; Sieve filtering
+ "X-Spam-Level: " ; Spam
+ "X-Spam-Score: " ; Spam
+ "X-Spam-Status: " ; Spam
+ "X-SpamBouncer: " ; Spam
+ "X-Trace: "
+ "X-UIDL: "
+ "X-UserInfo1: "
+ "X-VSMLoop: " ; NTMail
+ "X-Vms-To: "
+ "X-Wss-Id: " ; Worldtalk gateways
+ "X-eGroups-" ; Egroups/yahoogroups mailing list manager
+ "X-pgp: "
+ "X-submission-address: "
+ "X400-" ; X400
+ "Xref: ")
+"*List of header fields that are not to be shown.
+Regexps are not allowed. Unique fields should have a \": \" suffix;
+otherwise, the element can be used to render an entire class of fields
+that start with the same prefix invisible.
+This variable is ignored if `mh-visible-headers' is set."
+ :type '(repeat (string :tag "Header field"))
+ :set 'mh-invisible-header-fields-set
+ :group 'mh-show)
+
+;;; Composing messages (:group 'mh-letter)
+
+(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
+ "Use either 'gnus or 'mhn to insert MIME message directives in messages."
+ :type '(choice (const :tag "Use gnus" gnus)
+ (const :tag "Use mhn" mhn))
+ :group 'mh-letter)
+
+(defcustom mh-compose-letter-function nil
+ "Invoked when setting up a letter draft.
+It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
+ :type '(choice (const nil) function)
+ :group 'mh-letter)
+
+(defcustom mh-delete-yanked-msg-window-flag nil
+ "*Non-nil means delete any window displaying the message.
+Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
+If non-nil, yanking the current message into a draft letter deletes any
+windows displaying the message."
+ :type 'boolean
+ :group 'mh-letter)
+
+(defcustom mh-extract-from-attribution-verb "wrote:"
+ "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
+ :type '(choice (const "wrote:")
+ (const "a écrit :")
+ (string :tag "Custom string"))
+ :group 'mh-letter)
+
+(defcustom mh-forward-subject-format "%s: %s"
+ "*Format to generate the Subject: line contents for a forwarded message.
+The two string arguments to the format are the sender of the original
+message and the original subject line."
+ :type 'string
+ :group 'mh-letter)
+
+(defcustom mh-ins-buf-prefix "> "
+ "*String to put before each non-blank line of a yanked or inserted message.
+\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
+by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
+ :type 'string
+ :group 'mh-letter)
+
+(defcustom mh-insert-mail-followup-to-flag t
+ "Non-nil means maybe append a Mail-Followup-To field to the header.
+The insertion is done if the To: or Cc: fields matches an entry in
+`mh-insert-mail-followup-to-list'."
+ :type 'boolean
+ :group 'mh-letter)
+
+(defcustom mh-insert-mail-followup-to-list nil
+ "Alist of addresses for which a Mail-Followup-To field is inserted.
+Each element has the form (REGEXP ADDRESS).
+When the REGEXP appears in the To or cc fields of a message, the corresponding
+ADDRESS is inserted in a Mail-Followup-To field.
+
+Here's a customization example:
+
+ regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net
+ address: mh-e-users@lists.sourceforge.net
+
+This corresponds to:
+
+ (setq mh-insert-mail-followup-to-list
+ '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\"
+ \"mh-e-users@lists.sourceforge.net\")))
+
+While it might be tempting to add a descriptive name to the mailing list
+address, consider that this field will appear in other people's outgoing
+mail in their To: field. It might be best to keep it simple."
+ :type '(repeat (list (string :tag "regexp") (string :tag "address")))
+ :group 'mh-letter)
+
+(defcustom mh-insert-x-mailer-flag t
+ "*Non-nil means append an X-Mailer field to the header."
+ :type 'boolean
+ :group 'mh-letter)
+
+(defcustom mh-letter-fill-column 72
+ "*Fill column to use in `mh-letter-mode'.
+This is usually less than in other text modes because email messages get
+quoted by some prefix (sometimes many times) when they are replied to,
+and it's best to avoid quoted lines that span more than 80 columns."
+ :type 'integer
+ :group 'mh-letter)
+
+(defcustom mh-reply-default-reply-to nil
+ "*Sets the person or persons to whom a reply will be sent.
+If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
+value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
+The values \"cc\" and \"all\" do the same thing."
+ :type '(choice (const :tag "Prompt" nil)
+ (const "from") (const "to")
+ (const "cc") (const "all"))
+ :group 'mh-letter)
+
+(defcustom mh-reply-show-message-flag t
+ "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
+
+The setting of this variable determines whether the MH `show-buffer' is
+displayed with the current message when using `mh-reply' without a prefix
+argument. Set it to nil if you already include the message automatically
+in your draft using
+ repl: -filter repl.filter
+in your ~/.mh_profile file."
+ :type 'boolean
+ :group 'mh-letter)
+
+(defcustom mh-signature-file-name "~/.signature"
+ "*Name of file containing the user's signature.
+Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
+ :type 'file
+ :group 'mh-letter)
+
+(defcustom mh-x-face-file "~/.face"
+ "*File name containing the encoded X-Face string to insert in outgoing mail.
+If nil, or the file does not exist, nothing is added to message headers."
+ :type 'file
+ :group 'mh-letter)
+
+(defvar mh-x-mailer-string nil
+ "*String containing the contents of the X-Mailer header field.
+If nil, this variable is initialized to show the version of MH-E, Emacs, and
+MH the first time a message is composed.")
+
+(defcustom mh-yank-from-start-of-msg 'attribution
+ "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
+If t, include the entire message, with full headers. This is historically
+here for use with supercite, but is now deprecated in favor of the setting
+`supercite' below.
+
+If the symbol `body', then yank the message minus the header.
+
+If the symbol `supercite', include the entire message, with full headers.
+This also causes the invocation of `sc-cite-original' without the setting
+of `mail-citation-hook', now deprecated practice.
+
+If the symbol `autosupercite', do as for `supercite' automatically when
+show buffer matches the message being replied-to. When this option is used,
+the -noformat switch is passed to the repl program to override a -filter or
+-format switch.
+
+If the symbol `attribution', then yank the message minus the header and add
+a simple attribution line at the top.
+
+If the symbol `autoattrib', do as for `attribution' automatically when show
+buffer matches the message being replied-to. You can make sure this is
+always the case by setting `mh-reply-show-message-flag' to t (which is the
+default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such
+that the show window is never displayed. When the `autoattrib' option is
+used, the -noformat switch is passed to the repl program to override a
+-filter or -format switch.
+
+If nil, yank only the portion of the message following the point.
+
+If the show buffer has a region, this variable is ignored unless its value is
+one of `attribution' or `autoattrib' in which case the attribution is added
+to the yanked region."
+ :type '(choice (const :tag "Below point" nil)
+ (const :tag "Without header" body)
+ (const :tag "Invoke supercite" supercite)
+ (const :tag "Invoke supercite, automatically" autosupercite)
+ (const :tag "Without header, with attribution" attribution)
+ (const :tag "Without header, with attribution, automatically"
+ autoattrib)
+ (const :tag "Entire message with headers" t))
+ :group 'mh-letter)
+
+(defcustom mh-letter-complete-function 'ispell-complete-word
+ "*Function to call when completing outside of fields specific to aliases."
+ :type '(choice function (const nil))
+ :group 'mh-letter)
+
+;;; Alias handling (:group 'mh-alias)
+
+(defcustom mh-alias-system-aliases
+ '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd")
+ "*A list of system files from which to cull aliases.
+If these files are modified, they are automatically reread. This list need
+include only system aliases and the passwd file, since personal alias files
+listed in your \"AliasFile\" MH profile component are automatically included.
+You can update the alias list manually using \\[mh-alias-reload]."
+ :group 'mh-alias
+ :type '(choice (file) (repeat file)))
+
+(defcustom mh-alias-expand-aliases-flag nil
+ "*Non-nil means to expand aliases entered in the minibuffer.
+In other words, aliases entered in the minibuffer will be expanded to the full
+address in the message draft. By default, this expansion is not performed."
+ :group 'mh-alias
+ :type 'boolean)
+
+(defcustom mh-alias-completion-ignore-case-flag t
+ "*Non-nil means don't consider case significant in MH alias completion.
+This is the default in plain MH, so it is the default here as well. It
+can be useful to set this to t if, for example, you use lowercase
+aliases for people and uppercase for mailing lists."
+ :group 'mh-alias
+ :type 'boolean)
+
+(defcustom mh-alias-flash-on-comma t
+ "*Specify whether to flash or warn on translation.
+When a [comma] is pressed while entering aliases or addresses, setting this
+variable to the following values has the listed effects:
+t Flash alias translation but don't warn if there is no translation.
+1 Flash alias translation and warn if there is no translation.
+nil Do not flash alias translation nor warn if there is no translation."
+ :group 'mh-alias
+ :type '(choice (const :tag "Flash but don't warn if no translation" t)
+ (const :tag "Flash and warn if no translation" 1)
+ (const :tag "Don't flash nor warn if no translation" nil)))
+
+(defcustom mh-alias-local-users t
+ "*If t, local users are completed in MH-E To: and Cc: prompts.
+
+Users with a userid greater than some magic number (usually 200) are available
+for completion.
+
+If you set this variable to a string, it will be executed to generate a
+password file. A value of \"ypcat passwd\" is helpful if NIS is in use."
+ :group 'mh-alias
+ :type '(choice (boolean) (string)))
+
+(defcustom mh-alias-insert-file nil
+ "*Filename to use to store new MH-E aliases.
+This variable can also be a list of filenames, in which case MH-E will prompt
+for one of them. If nil, the default, then MH-E will use the first file found
+in the \"AliasFile\" component of the MH profile."
+ :group 'mh-alias
+ :type '(choice (const :tag "Use AliasFile MH profile component" nil)
+ (file :tag "Alias file")
+ (repeat :tag "List of alias files" file)))
+
+(defcustom mh-alias-insertion-location 'sorted
+ "Specifies where new aliases are entered in alias files.
+Options are sorted alphabetically, at the top of the file or at the bottom."
+ :type '(choice (const :tag "Sorted alphabetically" sorted)
+ (const :tag "At the top of file" top)
+ (const :tag "At the bottom of file" bottom))
+ :group 'mh-alias)
+
+;;; Indexed searching (:group 'mh-index)
+
+(defcustom mh-index-program nil
+ "Indexing program that MH-E shall use.
+The possible choices are swish++, swish-e, namazu, glimpse and grep. By
+default this variable is nil which means that the programs are tried in order
+and the first one found is used."
+ :type '(choice (const :tag "auto-detect" nil)
+ (const :tag "swish++" swish++)
+ (const :tag "swish-e" swish)
+ (const :tag "namazu" namazu)
+ (const :tag "glimpse" glimpse)
+ (const :tag "grep" grep))
+ :group 'mh-index)
+
+;;; Multiple personalities (:group 'mh-identity)
+
+(defcustom mh-identity-list nil
+ "*List holding MH-E identity.
+Omit the colon and trailing space from the field names.
+The keyword name \"none\" is reversed for internal use.
+Use the keyname name \"signature\" to specify either a signature file or a
+function to call to insert a signature at point.
+
+Providing an empty Value (\"\") will cause the field to be deleted.
+
+Example entries using the customize interface:
+ Keyword name: work
+ From
+ Value: John Doe <john@work.com>
+ Organization
+ Value: Acme Inc.
+ Keyword name: home
+ From
+ Value: John Doe <johndoe@home.net>
+ Organization
+ Value:
+
+This would produce the equivalent of:
+ (setq mh-identity-list
+ '((\"work\"
+ ((\"From\" . \"John Doe <john@work.com>\")
+ (\"Organization\" . \"Acme Inc.\")))
+ (\"home\"
+ ((\"From\" . \"John Doe <johndoe@home.net>\")
+ (\"Organization\" . \"\")))))"
+ :type '(repeat (list :tag ""
+ (string :tag "Keyword name")
+ (repeat :tag "At least one pair from below"
+ (choice (cons :tag "From field"
+ (const "From")
+ (string :tag "Value"))
+ (cons :tag "Organization field"
+ (const "Organization")
+ (string :tag "Value"))
+ (cons :tag "Signature"
+ (const "signature")
+ (choice (file) (function)))
+ (cons :tag "Other field & value pair"
+ (string :tag "Field")
+ (string :tag "Value"))))))
+ :set 'mh-identity-list-set
+ :group 'mh-identity)
+
+(defcustom mh-identity-default nil
+ "Default identity to use when `mh-letter-mode' is called."
+ ;; Dynamically render :type corresponding to `mh-identity-list' entries,
+ ;; e.g.:
+ ;; :type '(radio (const :tag "none" nil)
+ ;; (const "home")
+ ;; (const "work"))
+ :type (append
+ '(radio)
+ (cons '(const :tag "none" nil)
+ (mapcar (function (lambda (arg) `(const ,arg)))
+ (mapcar 'car mh-identity-list))))
+ :group 'mh-identity)
+
+;;; Hooks (:group 'mh-hooks + group where hook defined)
+
+;;; These are alphabetized. All hooks should be placed in the 'mh-hook group;
+;;; in addition, add the group in which the hook is defined in the manual (or,
+;;; if it is new, where it would be defined).
+
+(defcustom mh-before-quit-hook nil
+ "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E.
+See also `mh-quit-hook'."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-before-send-letter-hook nil
+ "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-letter)
+
+(defcustom mh-delete-msg-hook nil
+ "Invoked after marking each message for deletion."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-edit-mhn-hook nil
+ "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-letter)
+
+(defcustom mh-find-path-hook nil
+ "Invoked by `mh-find-path' after reading the user's MH profile."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-folder-list-change-hook nil
+ "Invoked whenever the cached folder list `mh-folder-list' is changed."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-folder-mode-hook nil
+ "Invoked in `mh-folder-mode' on a new folder."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-folder-updated-hook nil
+ "Invoked when the folder actions (such as moves and deletes) are performed.
+Variables that are useful in this hook include `mh-delete-list' and
+`mh-refile-list' which can be used to see which changes are being made to
+current folder, `mh-current-folder'."
+ :type 'hook
+ :group 'mh-hooks)
+
+(defcustom mh-inc-folder-hook nil
+ "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-index-show-hook nil
+ "Invoked after the message has been displayed."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-index)
+
+(defcustom mh-letter-insert-signature-hook nil
+ "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
+Can be used to determine which signature file to use based on message content.
+On return, if `mh-signature-file-name' is non-nil that file will be inserted at
+the current point in the buffer."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-letter)
+
+(defcustom mh-letter-mode-hook nil
+ "Invoked in `mh-letter-mode' on a new letter."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-letter)
+
+(defcustom mh-pick-mode-hook nil
+ "Invoked upon entry to `mh-pick-mode'."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-quit-hook nil
+ "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E.
+See also `mh-before-quit-hook'."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-refile-msg-hook nil
+ "Invoked after marking each message for refiling."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+(defcustom mh-show-hook nil
+ "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-show)
+
+(defcustom mh-show-mode-hook nil
+ "Invoked upon entry to `mh-show-mode'."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-show)
+
+(defcustom mh-unseen-updated-hook nil
+ "Invoked after the unseen sequence has been updated.
+The variable `mh-seen-list' can be used to obtain the list of messages which
+will be removed from the unseen sequence."
+ :type 'hook
+ :group 'mh-hooks
+ :group 'mh-folder)
+
+\f
+
+;;; Faces
+
+;;; Faces used in speedbar (:group mh-speed-faces)
+
+(defface mh-speedbar-folder-face
+ '((((class color) (background light))
+ (:foreground "blue4"))
+ (((class color) (background dark))
+ (:foreground "light blue")))
+ "Face used for folders in the speedbar buffer."
+ :group 'mh-speed-faces)
+
+(defface mh-speedbar-selected-folder-face
+ '((((class color) (background light))
+ (:foreground "red" :underline t))
+ (((class color) (background dark))
+ (:foreground "red" :underline t))
+ (t (:underline t)))
+ "Face used for the current folder."
+ :group 'mh-speed-faces)
+
+(defface mh-speedbar-folder-with-unseen-messages-face
+ '((t (:inherit mh-speedbar-folder-face :bold t)))
+ "Face used for folders in the speedbar buffer which have unread messages."
+ :group 'mh-speed-faces)
+
+(defface mh-speedbar-selected-folder-with-unseen-messages-face
+ '((t (:inherit mh-speedbar-selected-folder-face :bold t)))
+ "Face used for the current folder when it has unread messages."
+ :group 'mh-speed-faces)
+
+;;; Faces used in scan listing (:group mh-folder-faces)
+
+(defvar mh-folder-body-face 'mh-folder-body-face
+ "Face for highlighting body text in MH-Folder buffers.")
+(defface mh-folder-body-face
+ '((((type tty) (class color)) (:foreground "green"))
+ (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
+ (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
+ (((class color) (background light)) (:foreground "RosyBrown"))
+ (((class color) (background dark)) (:foreground "LightSalmon"))
+ (t (:italic t)))
+ "Face for highlighting body text in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face
+ "Face for the current message line in MH-Folder buffers.")
+(defface mh-folder-cur-msg-face
+ '((((type tty pc) (class color))
+ (:background "LightGreen"))
+ (((class color) (background light))
+ (:background "LightGreen") ;Use this for solid background colour
+ ;; (:underline t) ;Use this for underlining
+ )
+ (((class color) (background dark))
+ (:background "DarkOliveGreen4"))
+ (t (:underline t)))
+ "Face for the current message line in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face
+ "Face for highlighting the current message in MH-Folder buffers.")
+(defface mh-folder-cur-msg-number-face
+ '((((type tty) (class color)) (:foreground "cyan" :weight bold))
+ (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (((class color) (background light)) (:foreground "Purple"))
+ (((class color) (background dark)) (:foreground "Cyan"))
+ (t (:bold t)))
+ "Face for highlighting the current message in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-date-face 'mh-folder-date-face
+ "Face for highlighting the date in MH-Folder buffers.")
+(defface mh-folder-date-face
+ '((((class color) (background light))
+ (:foreground "snow4"))
+ (((class color) (background dark))
+ (:foreground "snow3"))
+ (t
+ (:bold t)))
+ "Face for highlighting the date in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-followup-face 'mh-folder-followup-face
+ "Face for highlighting Re: (followup) subject text in MH-Folder buffers.")
+(defface mh-folder-followup-face
+ '((((class color) (background light))
+ (:foreground "blue3"))
+ (((class color) (background dark))
+ (:foreground "LightGoldenRod"))
+ (t
+ (:bold t)))
+ "Face for highlighting Re: (followup) subject text in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-msg-number-face 'mh-folder-msg-number-face
+ "Face for highlighting the message number in MH-Folder buffers.")
+(defface mh-folder-msg-number-face
+ '((((class color) (background light))
+ (:foreground "snow4"))
+ (((class color) (background dark))
+ (:foreground "snow3"))
+ (t
+ (:bold t)))
+ "Face for highlighting the message number in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-deleted-face 'mh-folder-deleted-face
+ "Face for highlighting deleted messages in MH-Folder buffers.")
+(copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face)
+
+(defvar mh-folder-refiled-face 'mh-folder-refiled-face
+ "Face for highlighting refiled messages in MH-Folder buffers.")
+(defface mh-folder-refiled-face
+ '((((type tty) (class color)) (:foreground "yellow" :weight light))
+ (((class grayscale) (background light))
+ (:foreground "Gray90" :bold t :italic t))
+ (((class grayscale) (background dark))
+ (:foreground "DimGray" :bold t :italic t))
+ (((class color) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (background dark)) (:foreground "LightGoldenrod"))
+ (t (:bold t :italic t)))
+ "Face for highlighting refiled messages in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-subject-face 'mh-folder-subject-face
+ "Face for highlighting subject text in MH-Folder buffers.")
+(if (boundp 'facemenu-unlisted-faces)
+ (add-to-list 'facemenu-unlisted-faces "^mh-folder"))
+(defface mh-folder-subject-face
+ '((((class color) (background light))
+ (:foreground "blue4"))
+ (((class color) (background dark))
+ (:foreground "yellow"))
+ (t
+ (:bold t)))
+ "Face for highlighting subject text in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+(defvar mh-folder-address-face 'mh-folder-address-face
+ "Face for highlighting the address in MH-Folder buffers.")
+(copy-face 'mh-folder-subject-face 'mh-folder-address-face)
+
+(defvar mh-folder-scan-format-face 'mh-folder-scan-format-face
+ "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.")
+(copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face)
+
+(defvar mh-folder-to-face 'mh-folder-to-face
+ "Face for highlighting the To: string in MH-Folder buffers.")
+(defface mh-folder-to-face
+ '((((type tty) (class color)) (:foreground "green"))
+ (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
+ (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
+ (((class color) (background light)) (:foreground "RosyBrown"))
+ (((class color) (background dark)) (:foreground "LightSalmon"))
+ (t (:italic t)))
+ "Face for highlighting the To: string in MH-Folder buffers."
+ :group 'mh-folder-faces)
+
+;;; Faces used in message display (:group mh-show-faces)
+
+(defvar mh-show-cc-face 'mh-show-cc-face
+ "Face for highlighting cc header fields.")
+(defface mh-show-cc-face
+ '((((type tty) (class color)) (:foreground "yellow" :weight light))
+ (((class grayscale) (background light))
+ (:foreground "Gray90" :bold t :italic t))
+ (((class grayscale) (background dark))
+ (:foreground "DimGray" :bold t :italic t))
+ (((class color) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (background dark)) (:foreground "LightGoldenrod"))
+ (t (:bold t :italic t)))
+ "Face for highlighting cc header fields."
+ :group 'mh-show-faces)
+
+(defvar mh-show-date-face 'mh-show-date-face
+ "Face for highlighting the Date header field.")
+(defface mh-show-date-face
+ '((((type tty) (class color)) (:foreground "green"))
+ (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (((class color) (background light)) (:foreground "ForestGreen"))
+ (((class color) (background dark)) (:foreground "PaleGreen"))
+ (t (:bold t :underline t)))
+ "Face for highlighting the Date header field."
+ :group 'mh-show-faces)
+
+(defvar mh-show-header-face 'mh-show-header-face
+ "Face used to deemphasize unspecified header fields.")
+(defface mh-show-header-face
+ '((((type tty) (class color)) (:foreground "green"))
+ (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
+ (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
+ (((class color) (background light)) (:foreground "RosyBrown"))
+ (((class color) (background dark)) (:foreground "LightSalmon"))
+ (t (:italic t)))
+ "Face used to deemphasize unspecified header fields."
+ :group 'mh-show-faces)
+
+(defvar mh-show-to-face 'mh-show-to-face
+ "Face for highlighting the To: header field.")
+(if (boundp 'facemenu-unlisted-faces)
+ (add-to-list 'facemenu-unlisted-faces "^mh-show"))
+(defface mh-show-to-face
+ '((((class grayscale) (background light))
+ (:foreground "DimGray" :underline t))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" :underline t))
+ (((class color) (background light)) (:foreground "SaddleBrown"))
+ (((class color) (background dark)) (:foreground "burlywood"))
+ (t (:underline t)))
+ "Face for highlighting the To: header field."
+ :group 'mh-show-faces)
+
+(defvar mh-show-from-face 'mh-show-from-face
+ "Face for highlighting the From: header field.")
+(defface mh-show-from-face
+ '((((class color) (background light))
+ (:foreground "red3"))
+ (((class color) (background dark))
+ (:foreground "cyan"))
+ (t
+ (:bold t)))
+ "Face for highlighting the From: header field."
+ :group 'mh-show-faces)
+
+(defvar mh-show-subject-face 'mh-show-subject-face
+ "Face for highlighting the Subject header field.")
+(copy-face 'mh-folder-subject-face 'mh-show-subject-face)
+
+;;; Faces used in indexed searches (:group mh-index-faces)
+
+(defvar mh-index-folder-face 'mh-index-folder-face
+ "Face for highlighting folders in MH-Index buffers.")
+(defface mh-index-folder-face
+ '((((class color) (background light))
+ (:foreground "dark green" :bold t))
+ (((class color) (background dark))
+ (:foreground "indian red" :bold t))
+ (t
+ (:bold t)))
+ "Face for highlighting folders in MH-Index buffers."
+ :group 'mh-index-faces)
+
+(provide 'mh-customize)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-customize.el ends here
--- /dev/null
+;;; mh-e.el --- GNU Emacs interface to the MH mail system
+
+;; Copyright (C) 1985,86,87,88,90,92,93,94,95,97,2000,2001,2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Version: 7.1
+;; Keywords: mail
+
+;; 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:
+
+;; How to Use:
+;; M-x mh-rmail to read mail. Type C-h m there for a list of commands.
+;; C-u M-x mh-rmail to visit any folder.
+;; M-x mh-smail to send mail. From within the mail reader, "m" works, too.
+
+;; Your .emacs might benefit from these bindings:
+;; (global-set-key "\C-cr" 'mh-rmail)
+;; (global-set-key "\C-xm" 'mh-smail)
+;; (global-set-key "\C-x4m" 'mh-smail-other-window)
+
+;; MH (Message Handler) is a powerful mail reader.
+
+;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu
+;; (send to mh-users-request to be added). See the monthly Frequently Asked
+;; Questions posting there for information on getting MH and MH-E:
+;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html
+
+;; N.B. MH must have been compiled with the MHE compiler flag or several
+;; features necessary for MH-E will be missing from MH commands, specifically
+;; the -build switch to repl and forw.
+
+;; MH-E is an Emacs interface to the MH mail system.
+
+;; MH-E is supported in GNU Emacs 20 and 21, with MH 6.8.4 and nmh 1.0.4.
+
+;; Mailing Lists:
+;; mh-e-users@lists.sourceforge.net
+;; mh-e-announce@lists.sourceforge.net
+;; mh-e-devel@lists.sourceforge.net
+;;
+;; Subscribe by sending a "subscribe" message to
+;; <list>-request@lists.sourceforge.net, or by using the web interface at
+;; https://sourceforge.net/mail/?group_id=13357
+
+;; Bug Reports:
+;; https://sourceforge.net/tracker/?group_id=13357&atid=113357
+;; Include the output of M-x mh-version in any bug report.
+
+;; Feature Requests:
+;; https://sourceforge.net/tracker/?atid=363357&group_id=13357&func=browse
+
+;; Support:
+;; https://sourceforge.net/tracker/?group_id=13357&atid=213357
+
+;;; Change Log:
+
+;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
+;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
+;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu
+;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
+;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
+;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
+
+;; $Id: mh-e.el,v 1.34 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+(require 'cl)
+
+(defvar recursive-load-depth-limit)
+(eval-when (compile load eval)
+ (if (and (boundp 'recursive-load-depth-limit)
+ (integerp recursive-load-depth-limit)
+ (> 50 recursive-load-depth-limit))
+ (setq recursive-load-depth-limit 50)))
+
+(require 'mh-utils)
+(require 'gnus-util)
+(require 'easymenu)
+(if mh-xemacs-flag
+ (require 'mh-xemacs-compat))
+
+;; Shush the byte-compiler
+(defvar font-lock-auto-fontify)
+(defvar font-lock-defaults)
+
+(defconst mh-version "7.1" "Version number of MH-E.")
+
+;;; Autoloads
+(autoload 'Info-goto-node "info")
+
+\f
+
+(defvar mh-note-deleted "D"
+ "String whose first character is used to notate deleted messages.")
+
+(defvar mh-note-refiled "^"
+ "String whose first character is used to notate refiled messages.")
+
+(defvar mh-note-cur "+"
+ "String whose first character is used to notate the current message.")
+
+(defvar mh-partial-folder-mode-line-annotation "select"
+ "Annotation when displaying part of a folder.
+The string is displayed after the folder's name. nil for no annotation.")
+
+;;; Parameterize MH-E to work with different scan formats. The defaults work
+;;; with the standard MH scan listings, in which the first 4 characters on
+;;; the line are the message number, followed by two places for notations.
+
+;; The following scan formats are passed to the scan program if the
+;; setting of `mh-scan-format-file' above is nil. They are identical
+;; except the later one makes use of the nmh `decode' function to
+;; decode RFC 2047 encodings. If you just want to change the width of
+;; the msg number, use the `mh-set-cmd-note' function.
+
+(defvar mh-scan-format-mh
+ (concat
+ "%4(msg)"
+ "%<(cur)+%| %>"
+ "%<{replied}-"
+ "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
+ "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
+ "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
+ "%?(nonnull(comp{newsgroups}))n%>"
+ "%<(zero) %>"
+ "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
+ "%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>"
+ "%<(zero)%17(friendly{from})%> "
+ "%{subject}%<{body}<<%{body}%>")
+ "*Scan format string for MH, provided to the scan program via the -format arg.
+This format is identical to the default except that additional hints for
+fontification have been added to the fifth column (remember that in Emacs, the
+first column is 0).
+
+The values of the fifth column, in priority order, are: `-' if the
+message has been replied to, t if an address on the To: line matches
+one of the mailboxes of the current user, `c' if the Cc: line matches,
+`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
+is present.")
+
+(defvar mh-scan-format-nmh
+ (concat
+ "%4(msg)"
+ "%<(cur)+%| %>"
+ "%<{replied}-"
+ "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
+ "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
+ "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
+ "%?(nonnull(comp{newsgroups}))n%>"
+ "%<(zero) %>"
+ "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
+ "%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>"
+ "%<(zero)%17(decode(friendly{from}))%> "
+ "%(decode{subject})%<{body}<<%{body}%>")
+ "*Scan format string for nmh.
+This string is passed to the scan program via the -format arg.
+This format is identical to the default except that additional hints for
+fontification have been added to the fifth column (remember that in Emacs, the
+first column is 0).
+
+The values of the fifth column, in priority order, are: `-' if the
+message has been replied to, t if an address on the To: line matches
+one of the mailboxes of the current user, `c' if the Cc: line matches,
+`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
+is present.")
+
+(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
+ "Regexp specifying the scan lines that are 'good' messages.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least one parenthesized expression which matches the message number.")
+
+(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
+ "Regexp matching scan lines of deleted messages.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least one parenthesized expression which matches the message number.")
+
+(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
+ "Regexp matching scan lines of refiled messages.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least one parenthesized expression which matches the message number.")
+
+(defvar mh-scan-valid-regexp "^ *[0-9]"
+ "Regexp matching scan lines for messages (not error messages).")
+
+(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
+ "Regexp matching scan line for the current message.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least one parenthesized expression which matches the message number.
+Don't disable this regexp as it's needed by non fontifying functions.")
+
+(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
+ "Regexp matching scan line for the current message.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least one parenthesized expression which matches the whole line.
+To enable this feature, remove the string DISABLED from the regexp.")
+
+(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
+ "Regexp matching a valid date in scan lines.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+only one parenthesized expression which matches the date field
+\(see `mh-scan-format-regexp').")
+
+(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
+ "Regexp specifying the recipient in scan lines for messages we sent.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+two parenthesized expressions. The first is expected to match the To:
+that the default scan format file generates. The second is expected to match
+the recipient's name.")
+
+(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
+ "Regexp matching the message body beginning displayed in scan lines.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least one parenthesized expression which matches the body text.")
+
+(defvar mh-scan-subject-regexp
+ ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
+ "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
+ "*Regexp matching the subject string in MH folder mode.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least tree parenthesized expressions. The first is expected to match the Re:
+string, if any. The second matches an optional bracketed number after Re,
+such as in Re[2]: and the third is expected to match the subject line itself.")
+
+(defvar mh-scan-format-regexp
+ (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
+ "Regexp matching the output of scan.
+The default value is based upon the default values of either
+`mh-scan-format-mh' or `mh-scan-format-nmh'.
+The default `mh-folder-font-lock-keywords' expects this expression to contain
+at least three parenthesized expressions. The first should match the
+fontification hint, the second is found in `mh-scan-date-regexp', and the
+third should match the user name.")
+
+\f
+
+(defvar mh-folder-font-lock-keywords
+ (list
+ ;; Folders when displaying index buffer
+ (list "^\\+.*"
+ '(0 mh-index-folder-face))
+ ;; Marked for deletion
+ (list (concat mh-scan-deleted-msg-regexp ".*")
+ '(0 mh-folder-deleted-face))
+ ;; Marked for refile
+ (list (concat mh-scan-refiled-msg-regexp ".*")
+ '(0 mh-folder-refiled-face))
+ ;;after subj
+ (list mh-scan-body-regexp '(1 mh-folder-body-face nil t))
+ '(mh-folder-font-lock-subject
+ (1 mh-folder-followup-face append t)
+ (2 mh-folder-subject-face append t))
+ ;;current msg
+ (list mh-scan-cur-msg-number-regexp
+ '(1 mh-folder-cur-msg-number-face))
+ (list mh-scan-good-msg-regexp
+ '(1 mh-folder-msg-number-face)) ;; Msg number
+ (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date
+ (list mh-scan-rcpt-regexp
+ '(1 mh-folder-to-face) ;; To:
+ '(2 mh-folder-address-face)) ;; address
+ ;; scan font-lock name
+ (list mh-scan-format-regexp
+ '(1 mh-folder-date-face)
+ '(3 mh-folder-scan-format-face))
+ ;; Current message line
+ (list mh-scan-cur-msg-regexp
+ '(1 mh-folder-cur-msg-face prepend t))
+ ;; Unseen messages in bold
+ '(mh-folder-font-lock-unseen (1 'bold append t)))
+ "Regexp keywords used to fontify the MH-Folder buffer.")
+
+(defvar mh-scan-cmd-note-width 1
+ "Number of columns consumed by the cmd-note field in `mh-scan-format'.
+This column will have one of the values: ` ', `D', `^', `+' and where
+` ' is the default value,
+`D' is the `mh-note-deleted' character,
+`^' is the `mh-note-refiled' character, and
+`+' is the `mh-note-cur' character.")
+
+(defvar mh-scan-destination-width 1
+ "Number of columns consumed by the destination field in `mh-scan-format'.
+This column will have one of ' ', '%', '-', 't', 'c', 'b', or `n' in it.
+A ' ' blank space is the default character.
+A '%' indicates that the message in in a named MH sequence.
+A '-' indicates that the message has been annotated with a replied field.
+A 't' indicates that the message contains mymbox in the To: field.
+A 'c' indicates that the message contains mymbox in the Cc: field.
+A 'b' indicates that the message contains mymbox in the Bcc: field.
+A 'n' indicates that the message contains a Newsgroups: field.")
+
+(defvar mh-scan-date-width 5
+ "Number of columns consumed by the date field in `mh-scan-format'.
+This column will typically be of the form mm/dd.")
+
+(defvar mh-scan-date-flag-width 1
+ "Number of columns consumed to flag (in)valid dates in `mh-scan-format'.
+This column will have ` ' for valid and `*' for invalid or missing dates.")
+
+(defvar mh-scan-from-mbox-width 17
+ "Number of columns consumed with the \"From:\" line in `mh-scan-format'.
+This column will have a friendly name or e-mail address of the
+originator, or a \"To: address\" for outgoing e-mail messages.")
+
+(defvar mh-scan-from-mbox-sep-width 2
+ "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'.
+This column will only ever have spaces in it.")
+
+(defvar mh-scan-field-from-start-offset
+ (+ mh-scan-cmd-note-width
+ mh-scan-destination-width
+ mh-scan-date-width
+ mh-scan-date-flag-width)
+ "The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
+
+(defvar mh-scan-field-from-end-offset
+ (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
+ "The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
+
+(defvar mh-scan-field-subject-start-offset
+ (+ mh-scan-cmd-note-width
+ mh-scan-destination-width
+ mh-scan-date-width
+ mh-scan-date-flag-width
+ mh-scan-from-mbox-width
+ mh-scan-from-mbox-sep-width)
+ "The offset from the `mh-cmd-note' to find the start of the subject.")
+
+(defun mh-folder-font-lock-subject (limit)
+ "Return MH-E scan subject strings to font-lock between point and LIMIT."
+ (if (not (re-search-forward mh-scan-subject-regexp limit t))
+ nil
+ (if (match-beginning 1)
+ (set-match-data (list (match-beginning 1) (match-end 3)
+ (match-beginning 1) (match-end 3) nil nil))
+ (set-match-data (list (match-beginning 3) (match-end 3)
+ nil nil (match-beginning 3) (match-end 3))))
+ t))
+
+\f
+
+;; Fontifify unseen mesages in bold.
+
+(defvar mh-folder-unseen-seq-name nil
+ "Name of unseen sequence.
+The default for this is provided by the function `mh-folder-unseen-seq-name'
+On nmh systems.")
+
+(defun mh-folder-unseen-seq-name ()
+ "Provide name of unseen sequence from mhparam."
+ (or mh-progs (mh-find-path))
+ (save-excursion
+ (let ((unseen-seq-name "unseen"))
+ (with-temp-buffer
+ (unwind-protect
+ (progn
+ (call-process (expand-file-name "mhparam" mh-progs)
+ nil '(t t) nil "-component" "Unseen-Sequence")
+ (goto-char (point-min))
+ (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
+ (setq unseen-seq-name (match-string 1))))))
+ unseen-seq-name)))
+
+(defun mh-folder-unseen-seq-list ()
+ "Return a list of unseen message numbers for current folder."
+ (if (not mh-folder-unseen-seq-name)
+ (setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
+ (cond
+ ((not mh-folder-unseen-seq-name)
+ nil)
+ (t
+ (let ((folder mh-current-folder))
+ (save-excursion
+ (with-temp-buffer
+ (unwind-protect
+ (progn
+ (call-process (expand-file-name "mark" mh-progs)
+ nil '(t t) nil
+ folder "-seq" mh-folder-unseen-seq-name
+ "-list")
+ (goto-char (point-min))
+ (sort (mh-read-msg-list) '<)))))))))
+
+(defvar mh-folder-unseen-seq-cache nil
+ "Internal cache variable used for font-lock in MH-E.
+Should only be non-nil through font-lock stepping, and nil once font-lock
+is done highlighting.")
+(make-variable-buffer-local 'mh-folder-unseen-seq-cache)
+
+(defun mh-folder-font-lock-unseen (limit)
+ "Return unseen message lines to font-lock between point and LIMIT."
+ (if (not mh-folder-unseen-seq-cache)
+ (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))
+ (let ((cur-msg (mh-get-msg-num nil)))
+ (cond
+ ((not mh-folder-unseen-seq-cache)
+ nil)
+ ((not cur-msg) ;Presumably at end of buffer
+ (setq mh-folder-unseen-seq-cache nil)
+ nil)
+ ((member cur-msg mh-folder-unseen-seq-cache)
+ (let ((bpoint (progn (beginning-of-line)(point)))
+ (epoint (progn (forward-line 1)(point))))
+ (if (<= limit (point))
+ (setq mh-folder-unseen-seq-cache nil))
+ (set-match-data (list bpoint epoint bpoint epoint))
+ t))
+ (t
+ ;; move forward one line at a time, checking each message number.
+ (while (and
+ (= 0 (forward-line 1))
+ (> limit (point))
+ (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))
+ ;; Examine how we must have exited the loop...
+ (let ((cur-msg (mh-get-msg-num nil)))
+ (cond
+ ((or (not cur-msg)
+ (<= limit (point))
+ (not (member cur-msg mh-folder-unseen-seq-cache)))
+ (setq mh-folder-unseen-seq-cache nil)
+ nil)
+ ((member cur-msg mh-folder-unseen-seq-cache)
+ (let ((bpoint (progn (beginning-of-line)(point)))
+ (epoint (progn (forward-line 1)(point))))
+ (if (<= limit (point))
+ (setq mh-folder-unseen-seq-cache nil))
+ (set-match-data (list bpoint epoint bpoint epoint))
+ t))))))))
+
+\f
+
+;;; Internal variables:
+
+(defvar mh-last-destination nil) ;Destination of last refile or write
+ ;command.
+(defvar mh-last-destination-folder nil) ;Destination of last refile command.
+(defvar mh-last-destination-write nil) ;Destination of last write command.
+
+(defvar mh-folder-mode-map (make-keymap)
+ "Keymap for MH folders.")
+
+(defvar mh-delete-list nil) ;List of msg numbers to delete.
+
+(defvar mh-refile-list nil) ;List of folder names in mh-seq-list.
+
+(defvar mh-next-direction 'forward) ;Direction to move to next message.
+
+(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
+ ;nil if not narrowed.
+
+(defvar mh-view-ops ()) ;Stack of ops that change the folder
+ ;view (such as narrowing or threading).
+
+(defvar mh-index-data nil) ;Info about index search results
+(defvar mh-index-previous-search nil)
+(defvar mh-index-msg-checksum-map nil)
+(defvar mh-index-checksum-origin-map nil)
+
+(defvar mh-first-msg-num nil) ;Number of first msg in buffer.
+
+(defvar mh-last-msg-num nil) ;Number of last msg in buffer.
+
+(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
+
+;;; Macros and generic functions:
+
+(defun mh-mapc (function list)
+ "Apply FUNCTION to each element of LIST for side effects only."
+ (while list
+ (funcall function (car list))
+ (setq list (cdr list))))
+
+(defun mh-scan-format ()
+ "Return \"-format\" argument for the scan program."
+ (if (equal mh-scan-format-file t)
+ (list "-format" (if mh-nmh-flag
+ (list (mh-update-scan-format
+ mh-scan-format-nmh mh-cmd-note))
+ (list (mh-update-scan-format
+ mh-scan-format-mh mh-cmd-note))))
+ (if (not (equal mh-scan-format-file nil))
+ (list "-format" mh-scan-format-file))))
+
+\f
+
+;;; Entry points:
+
+;;;###autoload
+(defun mh-rmail (&optional arg)
+ "Inc(orporate) new mail with MH.
+Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
+the Emacs front end to the MH mail system."
+ (interactive "P")
+ (mh-find-path)
+ (if arg
+ (call-interactively 'mh-visit-folder)
+ (mh-inc-folder)))
+
+;;;###autoload
+(defun mh-nmail (&optional arg)
+ "Check for new mail in inbox folder.
+Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
+the Emacs front end to the MH mail system."
+ (interactive "P")
+ (mh-find-path) ; init mh-inbox
+ (if arg
+ (call-interactively 'mh-visit-folder)
+ (mh-visit-folder mh-inbox)))
+
+\f
+
+;;; User executable MH-E commands:
+
+(defun mh-delete-msg (msg-or-seq)
+ "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
+
+Default is the displayed message. If optional prefix argument is given then
+prompt for the message sequence. If variable `transient-mark-mode' is non-nil
+and the mark is active, then the selected region is marked for deletion."
+ (interactive (list (cond
+ ((mh-mark-active-p t)
+ (mh-region-to-msg-list (region-beginning) (region-end)))
+ (current-prefix-arg
+ (mh-read-seq-default "Delete" t))
+ (t
+ (mh-get-msg-num t)))))
+ (mh-delete-msg-no-motion msg-or-seq)
+ (mh-next-msg))
+
+(defun mh-delete-msg-no-motion (msg-or-seq)
+ "Mark the specified MSG-OR-SEQ for subsequent deletion.
+Default is the displayed message. If optional prefix argument is provided,
+then prompt for the message sequence."
+ (interactive (list (if current-prefix-arg
+ (mh-read-seq-default "Delete" t)
+ (mh-get-msg-num t))))
+ (if (numberp msg-or-seq)
+ (mh-delete-a-msg msg-or-seq)
+ (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
+
+(defun mh-execute-commands ()
+ "Process outstanding delete and refile requests."
+ (interactive)
+ (if mh-narrowed-to-seq (mh-widen))
+ (mh-process-commands mh-current-folder)
+ (mh-set-scan-mode)
+ (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
+ (mh-make-folder-mode-line)
+ t) ; return t for write-file-functions
+
+(defun mh-first-msg ()
+ "Move to the first message."
+ (interactive)
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp)))
+ (forward-line 1)))
+
+(defun mh-header-display ()
+ "Show the current message with all its headers.
+Displays headers that might have been suppressed by setting the
+variables `mh-clean-message-header-flag' or `mhl-formfile', or by the fallback
+behavior of scrolling uninteresting headers off the top of the window.
+Type \"\\[mh-show]\" to show the message normally again."
+ (interactive)
+ (and (not mh-showing-with-headers)
+ (or mhl-formfile mh-clean-message-header-flag)
+ (mh-invalidate-show-buffer))
+ (let ((mh-decode-mime-flag nil)
+ (mhl-formfile nil)
+ (mh-clean-message-header-flag nil))
+ (mh-show-msg nil)
+ (mh-in-show-buffer (mh-show-buffer)
+ (goto-char (point-min))
+ (mh-recenter 0))
+ (setq mh-showing-with-headers t)))
+
+(defun mh-inc-folder (&optional maildrop-name)
+ "Inc(orporate)s new mail into the Inbox folder.
+Optional argument MAILDROP-NAME specifies an alternate maildrop from the
+default. If the prefix argument is given, incorporates mail into the current
+folder, otherwise uses the folder named by `mh-inbox'.
+The value of `mh-inc-folder-hook' is a list of functions to be called, with no
+arguments, after incorporating new mail.
+Do not call this function from outside MH-E; use \\[mh-rmail] instead."
+ (interactive (list (if current-prefix-arg
+ (expand-file-name
+ (read-file-name "inc mail from file: "
+ mh-user-path)))))
+ (let ((threading-needed-flag nil))
+ (let ((config (current-window-configuration)))
+ (if (not maildrop-name)
+ (cond ((not (get-buffer mh-inbox))
+ (mh-make-folder mh-inbox)
+ (setq threading-needed-flag mh-show-threads-flag)
+ (setq mh-previous-window-config config))
+ ((not (eq (current-buffer) (get-buffer mh-inbox)))
+ (switch-to-buffer mh-inbox)
+ (setq mh-previous-window-config config)))))
+ (mh-get-new-mail maildrop-name)
+ (when (and threading-needed-flag
+ (save-excursion
+ (goto-char (point-min))
+ (or (null mh-large-folder)
+ (not (equal (forward-line mh-large-folder) 0))
+ (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
+ nil))))
+ (mh-toggle-threads))
+ (if mh-showing-mode (mh-show))
+ (run-hooks 'mh-inc-folder-hook)))
+
+(defun mh-last-msg ()
+ "Move to the last message."
+ (interactive)
+ (goto-char (point-max))
+ (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
+ (forward-line -1))
+ (mh-recenter nil))
+
+(defun mh-next-undeleted-msg (&optional arg)
+ "Move to the next undeleted message ARG in window."
+ (interactive "p")
+ (setq mh-next-direction 'forward)
+ (forward-line 1)
+ (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg)
+ (beginning-of-line)
+ (mh-maybe-show))
+ (t (forward-line -1)
+ (message "No more undeleted messages"))))
+
+(defun mh-refile-msg (msg-or-seq folder)
+ "Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
+If optional prefix argument provided, then prompt for message sequence.
+If variable `transient-mark-mode' is non-nil and the mark is active, then the
+selected region is marked for refiling."
+ (interactive
+ (list (cond
+ ((mh-mark-active-p t)
+ (mh-region-to-msg-list (region-beginning) (region-end)))
+ (current-prefix-arg
+ (mh-read-seq-default "Refile" t))
+ (t
+ (mh-get-msg-num t)))
+ (intern
+ (mh-prompt-for-folder
+ "Destination"
+ (or (and mh-default-folder-for-message-function
+ (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ (insert-file-contents refile-file)
+ (let ((buffer-file-name refile-file))
+ (funcall mh-default-folder-for-message-function)))))
+ (and (eq 'refile (car mh-last-destination-folder))
+ (symbol-name (cdr mh-last-destination-folder)))
+ "")
+ t))))
+ (setq mh-last-destination (cons 'refile folder)
+ mh-last-destination-folder mh-last-destination)
+ (if (numberp msg-or-seq)
+ (mh-refile-a-msg msg-or-seq folder)
+ (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
+ (mh-next-msg))
+
+(defun mh-refile-or-write-again (message)
+ "Re-execute the last refile or write command on the given MESSAGE.
+Default is the displayed message. Use the same folder or file as the previous
+refile or write command."
+ (interactive (list (mh-get-msg-num t)))
+ (if (null mh-last-destination)
+ (error "No previous refile or write"))
+ (cond ((eq (car mh-last-destination) 'refile)
+ (mh-refile-a-msg message (cdr mh-last-destination))
+ (message "Destination folder: %s" (cdr mh-last-destination)))
+ (t
+ (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
+ (message "Destination: %s" (cdr mh-last-destination))))
+ (mh-next-msg))
+
+(defun mh-quit ()
+ "Quit the current MH-E folder.
+Restore the previous window configuration, if one exists.
+The value of `mh-before-quit-hook' is a list of functions to be called, with
+no arguments, immediately upon entry to this function.
+The value of `mh-quit-hook' is a list of functions to be called, with no
+arguments, upon exit of this function."
+ (interactive)
+ (run-hooks 'mh-before-quit-hook)
+ (let ((show-buffer (get-buffer mh-show-buffer)))
+ (when show-buffer
+ (kill-buffer show-buffer)))
+ (mh-update-sequences)
+ (mh-destroy-postponed-handles)
+ (bury-buffer (current-buffer))
+ (if (get-buffer mh-temp-buffer)
+ (kill-buffer mh-temp-buffer))
+ (if (get-buffer mh-temp-folders-buffer)
+ (kill-buffer mh-temp-folders-buffer))
+ (if (get-buffer mh-temp-sequences-buffer)
+ (kill-buffer mh-temp-sequences-buffer))
+ (if mh-previous-window-config
+ (set-window-configuration mh-previous-window-config))
+ (run-hooks 'mh-quit-hook))
+
+(defun mh-page-msg (&optional arg)
+ "Page the displayed message forwards.
+Scrolls ARG lines or a full screen if no argument is supplied. Show buffer
+first if not displayed. Show the next undeleted message if looking at the
+bottom of the current message."
+ (interactive "P")
+ (if mh-showing-mode
+ (if mh-page-to-next-msg-flag
+ (if (equal mh-next-direction 'backward)
+ (mh-previous-undeleted-msg)
+ (mh-next-undeleted-msg))
+ (if (mh-in-show-buffer (mh-show-buffer)
+ (pos-visible-in-window-p (point-max)))
+ (progn
+ (message (format
+ "End of message (Type %s to read %s undeleted message)"
+ (single-key-description last-input-event)
+ (if (equal mh-next-direction 'backward)
+ "previous"
+ "next")))
+ (setq mh-page-to-next-msg-flag t))
+ (scroll-other-window arg)))
+ (mh-show)))
+
+(defun mh-previous-page (&optional arg)
+ "Page the displayed message backwards.
+Scrolls ARG lines or a full screen if no argument is supplied."
+ (interactive "P")
+ (mh-in-show-buffer (mh-show-buffer)
+ (scroll-down arg)))
+
+(defun mh-previous-undeleted-msg (&optional arg)
+ "Move to the previous undeleted message ARG in window."
+ (interactive "p")
+ (setq mh-next-direction 'backward)
+ (beginning-of-line)
+ (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg)
+ (mh-maybe-show))
+ (t (message "No previous undeleted message"))))
+
+(defun mh-previous-unread-msg (&optional count)
+ "Move to previous unread message.
+With optional argument COUNT, COUNT-1 unread messages before current message
+are skipped."
+ (interactive "p")
+ (unless (> count 0)
+ (error "The function mh-previous-unread-msg expects positive argument"))
+ (setq count (1- count))
+ (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
+ (cur-msg (mh-get-msg-num nil)))
+ (cond ((and (not cur-msg) (not (bobp))
+ ;; If we are at the end of the buffer back up one line and go
+ ;; to unread message after that.
+ (progn
+ (forward-line -1)
+ (setq cur-msg (mh-get-msg-num nil)))
+ nil))
+ ((or (null unread-sequence) (not cur-msg))
+ ;; No unread message or there aren't any messages in buffer...
+ (message "No more unread messages"))
+ ((progn
+ ;; Skip count messages...
+ (while (and unread-sequence (>= (car unread-sequence) cur-msg))
+ (setq unread-sequence (cdr unread-sequence)))
+ (while (> count 0)
+ (setq unread-sequence (cdr unread-sequence))
+ (setq count (1- count)))
+ (not (car unread-sequence)))
+ (message "No more unread messages"))
+ (t (mh-goto-msg (car unread-sequence))))))
+
+(defun mh-goto-next-button (backward-flag &optional criterion)
+ "Search for next button satisfying criterion.
+If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If
+CRITERION is a function or a symbol which has a function binding then that
+function must return non-nil at the button we stop."
+ (unless (or (and (symbolp criterion) (fboundp criterion))
+ (functionp criterion))
+ (setq criterion (lambda (x) t)))
+ ;; Move to the next button in the buffer satisfying criterion
+ (goto-char (or (save-excursion
+ (beginning-of-line)
+ ;; Find point before current button
+ (let ((point-before-current-button
+ (save-excursion
+ (while (get-text-property (point) 'mh-data)
+ (unless (= (forward-line
+ (if backward-flag 1 -1))
+ 0)
+ (if backward-flag
+ (goto-char (point-min))
+ (goto-char (point-max)))))
+ (point))))
+ ;; Skip over current button
+ (while (and (get-text-property (point) 'mh-data)
+ (not (if backward-flag (bobp) (eobp))))
+ (forward-line (if backward-flag -1 1)))
+ ;; Stop at next MIME button if any exists.
+ (block loop
+ (while (/= (progn
+ (unless (= (forward-line
+ (if backward-flag -1 1))
+ 0)
+ (if backward-flag
+ (goto-char (point-max))
+ (goto-char (point-min)))
+ (beginning-of-line))
+ (point))
+ point-before-current-button)
+ (when (and (get-text-property (point) 'mh-data)
+ (funcall criterion (point)))
+ (return-from loop (point))))
+ nil)))
+ (point))))
+
+(defun mh-next-button (&optional backward-flag)
+ "Go to the next MIME button.
+Advance point to the next MIME button in the show buffer. If the end
+of buffer is reached then the search wraps over to the start of the
+buffer. With prefix argument, BACKWARD-FLAG the point will move to the
+previous MIME button."
+ (interactive (list current-prefix-arg))
+ (unless mh-showing-mode
+ (mh-show))
+ (mh-in-show-buffer (mh-show-buffer)
+ (mh-goto-next-button backward-flag)))
+
+(defun mh-prev-button ()
+ "Go to the prev MIME button.
+Move point to the previous MIME button in the show buffer. If the beginning
+of the buffer is reached then the search wraps over to the end of the
+buffer."
+ (interactive)
+ (mh-next-button t))
+
+(defun mh-folder-mime-action (part-index action include-security-flag)
+ "Go to PART-INDEX and carry out ACTION.
+If PART-INDEX is nil then go to the next part in the buffer. The search for
+the next buffer wraps around if end of buffer is reached. If argument
+INCLUDE-SECURITY-FLAG is non-nil then include security info buttons when
+searching for a suitable parts."
+ (unless mh-showing-mode
+ (mh-show))
+ (mh-in-show-buffer (mh-show-buffer)
+ (let ((criterion
+ (cond (part-index
+ (lambda (p)
+ (let ((part (get-text-property p 'mh-part)))
+ (and (integerp part) (= part part-index)))))
+ (t (lambda (p)
+ (if include-security-flag
+ (get-text-property p 'mh-data)
+ (integerp (get-text-property p 'mh-part)))))))
+ (point (point)))
+ (cond ((and (get-text-property point 'mh-part)
+ (or (null part-index)
+ (= (get-text-property point 'mh-part) part-index)))
+ (funcall action))
+ ((and (get-text-property point 'mh-data)
+ include-security-flag
+ (null part-index))
+ (funcall action))
+ (t
+ (mh-goto-next-button nil criterion)
+ (if (= (point) point)
+ (message "No matching MIME part found")
+ (funcall action)))))))
+
+(defun mh-folder-toggle-mime-part (part-index)
+ "Toggle display of button.
+If point in show buffer is at a button then that part is toggled.
+If not at a button and PART-INDEX is non-nil point is moved to that part.
+With nil PART-INDEX find the first button after point (search wraps around if
+end of buffer is reached) and toggle it."
+ (interactive "P")
+ (when (consp part-index) (setq part-index (car part-index)))
+ (mh-folder-mime-action part-index #'mh-press-button t))
+
+(defun mh-folder-inline-mime-part (part-index)
+ "Show the raw bytes of MIME part inline.
+If point in show buffer is at a mime part then that part is inlined.
+If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
+With nil PART-INDEX find the first button after point (search wraps around if
+end of buffer is reached) and inline it."
+ (interactive "P")
+ (when (consp part-index) (setq part-index (car part-index)))
+ (mh-folder-mime-action part-index #'mh-mime-inline-part nil))
+
+(defun mh-folder-save-mime-part (part-index)
+ "Save MIME part.
+If point in show buffer is at a mime part then that part is saved.
+If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
+With nil PART-INDEX find the first button after point (search wraps around if
+end of buffer is reached) and save it."
+ (interactive "P")
+ (when (consp part-index) (setq part-index (car part-index)))
+ (mh-folder-mime-action part-index #'mh-mime-save-part nil))
+
+(defun mh-reset-threads-and-narrowing ()
+ "Reset all variables pertaining to threads and narrowing.
+Also removes all content from the folder buffer."
+ (setq mh-view-ops ())
+ (setq mh-narrowed-to-seq nil)
+ (let ((buffer-read-only nil)) (erase-buffer)))
+
+(defun mh-rescan-folder (&optional range dont-exec-pending)
+ "Rescan a folder after optionally processing the outstanding commands.
+If optional prefix argument RANGE is provided, prompt for the range of
+messages to display. Otherwise show the entire folder.
+If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
+refiles aren't carried out."
+ (interactive (list (if current-prefix-arg
+ (mh-read-msg-range mh-current-folder t)
+ nil)))
+ (setq mh-next-direction 'forward)
+ (let ((threaded-flag (memq 'unthread mh-view-ops)))
+ (mh-reset-threads-and-narrowing)
+ (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
+ (cond (threaded-flag (mh-toggle-threads))
+ (mh-index-data (mh-index-insert-folder-headers)))))
+
+(defun mh-write-msg-to-file (msg file no-headers)
+ "Append MSG to the end of a FILE.
+If prefix argument NO-HEADERS is provided, write only the message body.
+Otherwise send the entire message including the headers."
+ (interactive
+ (list (mh-get-msg-num t)
+ (let ((default-dir (if (eq 'write (car mh-last-destination-write))
+ (file-name-directory
+ (car (cdr mh-last-destination-write)))
+ default-directory)))
+ (read-file-name (format "Save message%s in file: "
+ (if current-prefix-arg " body" ""))
+ default-dir
+ (if (eq 'write (car mh-last-destination-write))
+ (car (cdr mh-last-destination-write))
+ (expand-file-name "mail.out" default-dir))))
+ current-prefix-arg))
+ (let ((msg-file-to-output (mh-msg-filename msg))
+ (output-file (mh-expand-file-name file)))
+ (setq mh-last-destination (list 'write file (if no-headers 'no-headers))
+ mh-last-destination-write mh-last-destination)
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ (insert-file-contents msg-file-to-output)
+ (goto-char (point-min))
+ (if no-headers (search-forward "\n\n"))
+ (append-to-file (point) (point-max) output-file))))
+
+(defun mh-toggle-showing ()
+ "Toggle the scanning mode/showing mode of displaying messages."
+ (interactive)
+ (if mh-showing-mode
+ (mh-set-scan-mode)
+ (mh-show)))
+
+(defun mh-undo (msg-or-seq)
+ "Undo the pending deletion or refile of the specified MSG-OR-SEQ.
+Default is the displayed message.
+If optional prefix argument is provided, then prompt for the message sequence.
+If variable `transient-mark-mode' is non-nil and the mark is active, then the
+selected region is unmarked."
+ (interactive (list (cond
+ ((mh-mark-active-p t)
+ (mh-region-to-msg-list (region-beginning) (region-end)))
+ (current-prefix-arg
+ (mh-read-seq-default "Undo" t))
+ (t
+ (mh-get-msg-num t)))))
+ (cond ((numberp msg-or-seq)
+ (let ((original-position (point)))
+ (beginning-of-line)
+ (while (not (or (looking-at mh-scan-deleted-msg-regexp)
+ (looking-at mh-scan-refiled-msg-regexp)
+ (and (eq mh-next-direction 'forward) (bobp))
+ (and (eq mh-next-direction 'backward)
+ (save-excursion (forward-line) (eobp)))))
+ (forward-line (if (eq mh-next-direction 'forward) -1 1)))
+ (if (or (looking-at mh-scan-deleted-msg-regexp)
+ (looking-at mh-scan-refiled-msg-regexp))
+ (progn
+ (mh-undo-msg (mh-get-msg-num t))
+ (mh-maybe-show))
+ (goto-char original-position)
+ (error "Nothing to undo"))))
+ (t
+ (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
+ (if (not (mh-outstanding-commands-p))
+ (mh-set-folder-modified-p nil)))
+
+;;;###mh-autoload
+(defun mh-folder-line-matches-show-buffer-p ()
+ "Return t if the message under point in folder-mode is in the show buffer.
+Return nil in any other circumstance (no message under point, no show buffer,
+the message in the show buffer doesn't match."
+ (and (eq major-mode 'mh-folder-mode)
+ (mh-get-msg-num nil)
+ mh-show-buffer
+ (get-buffer mh-show-buffer)
+ (buffer-file-name (get-buffer mh-show-buffer))
+ (string-match ".*/\\([0-9]+\\)$"
+ (buffer-file-name (get-buffer mh-show-buffer)))
+ (string-equal
+ (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
+ (int-to-string (mh-get-msg-num nil)))))
+
+(eval-when-compile (require 'gnus))
+
+(defmacro mh-macro-expansion-time-gnus-version ()
+ "Return Gnus version available at macro expansion time.
+The macro evaluates the Gnus version at macro expansion time. If MH-E was
+compiled then macro expansion happens at compile time."
+ gnus-version)
+
+(defun mh-run-time-gnus-version ()
+ "Return Gnus version available at run time."
+ (require 'gnus)
+ gnus-version)
+
+;;;###autoload
+(defun mh-version ()
+ "Display version information about MH-E and the MH mail handling system."
+ (interactive)
+ (mh-find-progs)
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ ;; MH-E version.
+ (insert "MH-E " mh-version "\n\n")
+ ;; MH-E compilation details.
+ (insert "MH-E compilation details:\n")
+ (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
+ (gnus-compiled-version (if compiled-mhe
+ (mh-macro-expansion-time-gnus-version)
+ "N/A")))
+ (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
+ " Gnus (compile-time):\t" gnus-compiled-version "\n"
+ " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
+ ;; Emacs version.
+ (insert (emacs-version) "\n\n")
+ ;; MH version.
+ (let ((help-start (point)))
+ (condition-case err-data
+ (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
+ (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
+ (goto-char help-start)
+ (if mh-nmh-flag
+ (search-forward "inc -- " nil t)
+ (search-forward "version: " nil t))
+ (delete-region help-start (point)))
+ (goto-char (point-max))
+ (insert " mh-progs:\t" mh-progs "\n"
+ " mh-lib:\t" mh-lib "\n"
+ " mh-lib-progs:\t" mh-lib-progs "\n\n")
+ ;; Linux version.
+ (condition-case ()
+ (call-process "uname" nil t nil "-a")
+ (file-error))
+ (goto-char (point-min))
+ (display-buffer mh-temp-buffer))
+
+(defun mh-parse-flist-output-line (line)
+ "Parse LINE to generate folder name, unseen messages and total messages."
+ (with-temp-buffer
+ (insert line)
+ (goto-char (point-max))
+ (let (folder unseen total p)
+ (when (search-backward " out of " (point-min) t)
+ (setq total (read-from-string
+ (buffer-substring-no-properties
+ (match-end 0) (line-end-position))))
+ (when (search-backward " in sequence " (point-min) t)
+ (setq p (point))
+ (when (search-backward " has " (point-min) t)
+ (setq unseen (read-from-string (buffer-substring-no-properties
+ (match-end 0) p)))
+ (while (or (eq (char-after) ?+) (eq (char-after) ? ))
+ (backward-char))
+ (setq folder (buffer-substring-no-properties
+ (point-min) (1+ (point))))
+ (values (format "+%s" folder) (car unseen) (car total))))))))
+
+(defun mh-folder-size (folder)
+ "Find size of FOLDER."
+ (with-temp-buffer
+ (call-process (expand-file-name "flist" mh-progs) nil t nil
+ "-norecurse" folder)
+ (goto-char (point-min))
+ (multiple-value-bind (folder1 unseen total)
+ (mh-parse-flist-output-line
+ (buffer-substring (point) (line-end-position)))
+ (unless (equal folder folder1)
+ (error "Call to flist failed on folder %s" folder))
+ (values total unseen))))
+
+(defun mh-visit-folder (folder &optional range index-data)
+ "Visit FOLDER and display RANGE of messages.
+Do not call this function from outside MH-E; see \\[mh-rmail] instead.
+
+If RANGE is nil (the default if it is omitted when called non-interactively),
+then all messages in FOLDER are displayed.
+
+If an index buffer is being created then INDEX-DATA is used to initialize the
+index buffer specific data structures."
+ (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
+ (list folder-name (mh-read-msg-range folder-name))))
+ (let ((config (current-window-configuration))
+ (threaded-view-flag mh-show-threads-flag))
+ (save-excursion
+ (when (get-buffer folder)
+ (set-buffer folder)
+ (setq threaded-view-flag (memq 'unthread mh-view-ops))
+ (mh-reset-threads-and-narrowing)))
+ (when index-data
+ (mh-make-folder folder)
+ (setq mh-index-data (car index-data)
+ mh-index-msg-checksum-map (make-hash-table :test #'equal)
+ mh-index-checksum-origin-map (make-hash-table :test #'equal))
+ (mh-index-update-maps folder (cadr index-data)))
+ (mh-scan-folder folder (or range "all"))
+ (cond ((and threaded-view-flag
+ (save-excursion
+ (goto-char (point-min))
+ (or (null mh-large-folder)
+ (not (equal (forward-line mh-large-folder) 0))
+ (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
+ nil))))
+ (mh-toggle-threads))
+ (mh-index-data
+ (mh-index-insert-folder-headers)))
+ (unless mh-showing-mode (delete-other-windows))
+ (setq mh-previous-window-config config))
+ nil)
+
+;;;###mh-autoload
+(defun mh-update-sequences ()
+ "Update MH's Unseen-Sequence and current folder and message.
+Flush MH-E's state out to MH. The message at the cursor becomes current."
+ (interactive)
+ ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
+ ;; which updates MH-E's state from MH.
+ (let ((folder-set (mh-update-unseen))
+ (new-cur (mh-get-msg-num nil)))
+ (if new-cur
+ (let ((seq-entry (mh-find-seq 'cur)))
+ (mh-remove-cur-notation)
+ (setcdr seq-entry
+ (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
+ (mh-define-sequence 'cur (list new-cur))
+ (beginning-of-line)
+ (if (looking-at mh-scan-good-msg-regexp)
+ (mh-notate nil mh-note-cur mh-cmd-note)))
+ (or folder-set
+ (save-excursion
+ ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
+ ;; So I added this sanity check.
+ (if (stringp mh-current-folder)
+ (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
+ (mh-exec-cmd-quiet t "folder" "-fast")))))))
+
+\f
+
+;;; Support routines.
+
+(defun mh-delete-a-msg (msg)
+ "Delete the MSG.
+The value of `mh-delete-msg-hook' is a list of functions to be called, with no
+arguments, after the message has been deleted."
+ (save-excursion
+ (mh-goto-msg msg nil t)
+ (if (looking-at mh-scan-refiled-msg-regexp)
+ (error "Message %d is refiled. Undo refile before deleting" msg))
+ (if (looking-at mh-scan-deleted-msg-regexp)
+ nil
+ (mh-set-folder-modified-p t)
+ (setq mh-delete-list (cons msg mh-delete-list))
+ (mh-notate msg mh-note-deleted mh-cmd-note)
+ (run-hooks 'mh-delete-msg-hook))))
+
+(defun mh-refile-a-msg (msg folder)
+ "Refile MSG in FOLDER.
+Folder is a symbol, not a string.
+The value of `mh-refile-msg-hook' is a list of functions to be called, with no
+arguments, after the message has been refiled."
+ (save-excursion
+ (mh-goto-msg msg nil t)
+ (cond ((looking-at mh-scan-deleted-msg-regexp)
+ (error "Message %d is deleted. Undo delete before moving" msg))
+ ((looking-at mh-scan-refiled-msg-regexp)
+ (if (y-or-n-p
+ (format "Message %d already refiled. Copy to %s as well? "
+ msg folder))
+ (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
+ "-src" mh-current-folder
+ (symbol-name folder))
+ (message "Message not copied.")))
+ (t
+ (mh-set-folder-modified-p t)
+ (cond ((null (assoc folder mh-refile-list))
+ (push (list folder msg) mh-refile-list))
+ ((not (member msg (cdr (assoc folder mh-refile-list))))
+ (push msg (cdr (assoc folder mh-refile-list)))))
+ (mh-notate msg mh-note-refiled mh-cmd-note)
+ (run-hooks 'mh-refile-msg-hook)))))
+
+(defun mh-next-msg ()
+ "Move backward or forward to the next undeleted message in the buffer."
+ (if (eq mh-next-direction 'forward)
+ (mh-next-undeleted-msg 1)
+ (mh-previous-undeleted-msg 1)))
+
+(defun mh-next-unread-msg (&optional count)
+ "Move to next unread message.
+With optional argument COUNT, COUNT-1 unread messages are skipped."
+ (interactive "p")
+ (unless (> count 0)
+ (error "The function mh-next-unread-msg expects positive argument"))
+ (setq count (1- count))
+ (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
+ (cur-msg (mh-get-msg-num nil)))
+ (cond ((and (not cur-msg) (not (bobp))
+ ;; If we are at the end of the buffer back up one line and go
+ ;; to unread message after that.
+ (progn
+ (forward-line -1)
+ (setq cur-msg (mh-get-msg-num nil)))
+ nil))
+ ((or (null unread-sequence) (not cur-msg))
+ ;; No unread message or there aren't any messages in buffer...
+ (message "No more unread messages"))
+ ((progn
+ ;; Skip messages
+ (while (and unread-sequence (>= cur-msg (car unread-sequence)))
+ (setq unread-sequence (cdr unread-sequence)))
+ (while (> count 0)
+ (setq unread-sequence (cdr unread-sequence))
+ (setq count (1- count)))
+ (not (car unread-sequence)))
+ (message "No more unread messages"))
+ (t (mh-goto-msg (car unread-sequence))))))
+
+(defun mh-set-scan-mode ()
+ "Display the scan listing buffer, but do not show a message."
+ (if (get-buffer mh-show-buffer)
+ (delete-windows-on mh-show-buffer))
+ (mh-showing-mode 0)
+ (force-mode-line-update)
+ (if mh-recenter-summary-flag
+ (mh-recenter nil)))
+
+(defun mh-undo-msg (msg)
+ "Undo the deletion or refile of one MSG."
+ (cond ((memq msg mh-delete-list)
+ (setq mh-delete-list (delq msg mh-delete-list)))
+ (t
+ (dolist (folder-msg-list mh-refile-list)
+ (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
+ (setq mh-refile-list (loop for x in mh-refile-list
+ unless (null (cdr x)) collect x))))
+ (mh-notate msg ? mh-cmd-note))
+
+\f
+
+;;; The folder data abstraction.
+
+(defun mh-make-folder (name)
+ "Create a new mail folder called NAME.
+Make it the current folder."
+ (switch-to-buffer name)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (if mh-adaptive-cmd-note-flag
+ (mh-set-cmd-note (mh-message-number-width name)))
+ (setq buffer-read-only t)
+ (mh-folder-mode)
+ (mh-set-folder-modified-p nil)
+ (setq buffer-file-name mh-folder-filename)
+ (mh-make-folder-mode-line))
+
+;;; Ensure new buffers won't get this mode if default-major-mode is nil.
+(put 'mh-folder-mode 'mode-class 'special)
+
+\f
+
+;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
+;;; Menus for folder mode: folder, message, sequence (in that order)
+;;; folder-mode "Sequence" menu
+(easy-menu-define
+ mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
+ '("Sequence"
+ ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
+ ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
+ ["Delete Message from Sequence..." mh-delete-msg-from-seq
+ (mh-get-msg-num nil)]
+ ["List Sequences in Folder..." mh-list-sequences t]
+ ["Delete Sequence..." mh-delete-seq t]
+ ["Narrow to Sequence..." mh-narrow-to-seq t]
+ ["Widen from Sequence" mh-widen mh-narrowed-to-seq]
+ "--"
+ ["Narrow to Subject Sequence" mh-narrow-to-subject t]
+ ["Delete Rest of Same Subject" mh-delete-subject t]
+ "--"
+ ["Push State Out to MH" mh-update-sequences t]))
+
+;;; folder-mode "Message" menu
+(easy-menu-define
+ mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
+ '("Message"
+ ["Show Message" mh-show (mh-get-msg-num nil)]
+ ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
+ ["Next Message" mh-next-undeleted-msg t]
+ ["Previous Message" mh-previous-undeleted-msg t]
+ ["Go to First Message" mh-first-msg t]
+ ["Go to Last Message" mh-last-msg t]
+ ["Go to Message by Number..." mh-goto-msg t]
+ ["Modify Message" mh-modify]
+ ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
+ ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
+ ["Undo Delete/Refile" mh-undo t]
+ ["Process Delete/Refile" mh-execute-commands
+ (or mh-refile-list mh-delete-list)]
+ "--"
+ ["Compose a New Message" mh-send t]
+ ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
+ ["Forward Message..." mh-forward (mh-get-msg-num nil)]
+ ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
+ ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
+ ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
+ "--"
+ ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
+ ["Print Message" mh-print-msg (mh-get-msg-num nil)]
+ ["Write Message to File..." mh-write-msg-to-file
+ (mh-get-msg-num nil)]
+ ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
+ ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
+ ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
+
+;;; folder-mode "Folder" menu
+(easy-menu-define
+ mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
+ '("Folder"
+ ["Incorporate New Mail" mh-inc-folder t]
+ ["Toggle Show/Folder" mh-toggle-showing t]
+ ["Execute Delete/Refile" mh-execute-commands
+ (or mh-refile-list mh-delete-list)]
+ ["Rescan Folder" mh-rescan-folder t]
+ ["Thread Folder" mh-toggle-threads
+ (not (memq 'unthread mh-view-ops))]
+ ["Pack Folder" mh-pack-folder t]
+ ["Sort Folder" mh-sort-folder t]
+ "--"
+ ["List Folders" mh-list-folders t]
+ ["Visit a Folder..." mh-visit-folder t]
+ ["Search a Folder..." mh-search-folder t]
+ ["Indexed Search..." mh-index-search t]
+ "--"
+ ["Quit MH-E" mh-quit t]))
+
+\f
+
+(defmacro mh-remove-xemacs-horizontal-scrollbar ()
+ "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
+ (when mh-xemacs-flag
+ `(if (and (featurep 'scrollbar)
+ (fboundp 'set-specifier))
+ (set-specifier horizontal-scrollbar-visible-p nil
+ (cons (current-buffer) nil)))))
+
+(defmacro mh-write-file-functions-compat ()
+ "Return `write-file-functions' if it exists.
+Otherwise return `local-write-file-hooks'. This macro exists purely for
+compatibility. The former symbol is used in Emacs 21.4 onward while the latter
+is used in previous versions and XEmacs."
+ (if (boundp 'write-file-functions)
+ ''write-file-functions ;Emacs 21.4
+ ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
+
+(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
+ "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
+
+You can show the message the cursor is pointing to, and step through the
+messages. Messages can be marked for deletion or refiling into another
+folder; these commands are executed all at once with a separate command.
+
+A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
+applies the action to a message sequence. If `transient-mark-mode',
+is non-nil, the action is applied to the region.
+
+Options that control this mode can be changed with \\[customize-group];
+specify the \"mh\" group. In particular, please see the `mh-scan-format-file'
+option if you wish to modify scan's format.
+
+When a folder is visited, the hook `mh-folder-mode-hook' is run.
+
+\\{mh-folder-mode-map}"
+
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
+ (mh-make-local-vars
+ 'mh-current-folder (buffer-name) ; Name of folder, a string
+ 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
+ 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
+ (file-name-as-directory (mh-expand-file-name (buffer-name)))
+ 'mh-showing-mode nil ; Show message also?
+ 'mh-delete-list nil ; List of msgs nums to delete
+ 'mh-refile-list nil ; List of folder names in mh-seq-list
+ 'mh-seq-list nil ; Alist of (seq . msgs) nums
+ 'mh-seen-list nil ; List of displayed messages
+ 'mh-next-direction 'forward ; Direction to move to next message
+ 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
+ 'mh-view-ops () ; Stack that keeps track of the order
+ ; in which narrowing/threading has been
+ ; carried out.
+ 'mh-index-data nil ; If the folder was created by a call
+ ; to mh-index-search this contains info
+ ; about the search results.
+ 'mh-index-previous-search nil ; Previous folder and search-regexp
+ 'mh-index-msg-checksum-map nil ; msg -> checksum map
+ 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
+ 'mh-first-msg-num nil ; Number of first msg in buffer
+ 'mh-last-msg-num nil ; Number of last msg in buffer
+ 'mh-msg-count nil ; Number of msgs in buffer
+ 'mh-mode-line-annotation nil ; Indicates message range
+ 'mh-previous-window-config nil) ; Previous window configuration
+ (mh-remove-xemacs-horizontal-scrollbar)
+ (setq truncate-lines t)
+ (auto-save-mode -1)
+ (setq buffer-offer-save t)
+ (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
+ (make-local-variable 'revert-buffer-function)
+ (make-local-variable 'hl-line-mode) ; avoid pollution
+ (if (fboundp 'hl-line-mode)
+ (hl-line-mode 1))
+ (setq revert-buffer-function 'mh-undo-folder)
+ (or (assq 'mh-showing-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(mh-showing-mode " Show") minor-mode-alist)))
+ (easy-menu-add mh-folder-sequence-menu)
+ (easy-menu-add mh-folder-message-menu)
+ (easy-menu-add mh-folder-folder-menu)
+ (if (and (boundp 'tool-bar-mode) tool-bar-mode)
+ (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
+ (if (and mh-xemacs-flag
+ font-lock-auto-fontify)
+ (turn-on-font-lock))) ; Force font-lock in XEmacs.
+
+(defun mh-make-local-vars (&rest pairs)
+ "Initialize local variables according to the variable-value PAIRS."
+
+ (while pairs
+ (set (make-local-variable (car pairs)) (car (cdr pairs)))
+ (setq pairs (cdr (cdr pairs)))))
+
+(defun mh-scan-folder (folder range &optional dont-exec-pending)
+ "Scan the FOLDER over the RANGE.
+If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
+refiles aren't carried out.
+Return in the folder's buffer."
+ (cond ((null (get-buffer folder))
+ (mh-make-folder folder))
+ (t
+ (or dont-exec-pending (mh-process-or-undo-commands folder))
+ (switch-to-buffer folder)))
+ (mh-regenerate-headers range)
+ (if (zerop (buffer-size))
+ (if (equal range "all")
+ (message "Folder %s is empty" folder)
+ (message "No messages in %s, range %s" folder range))
+ (mh-goto-cur-msg))
+ (save-excursion
+ (when dont-exec-pending
+ ;; Re-annotate messages to be refiled...
+ (dolist (folder-msg-list mh-refile-list)
+ (dolist (msg (cdr folder-msg-list))
+ (mh-notate msg mh-note-refiled mh-cmd-note)))
+ ;; Re-annotate messages to be deleted...
+ (dolist (msg mh-delete-list)
+ (mh-notate msg mh-note-deleted mh-cmd-note)))))
+
+(defun mh-set-cmd-note (width)
+ "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
+
+If `mh-scan-format-file' specifies nil or a filename, then this function
+will NOT update `mh-cmd-note'."
+ ;; Add one to the width to always have whitespace in column zero.
+ (setq width (max (1+ width) 2))
+ (if (and (equal mh-scan-format-file t)
+ (not (eq mh-cmd-note width)))
+ (setq mh-cmd-note width))
+ mh-cmd-note)
+
+(defun mh-regenerate-headers (range &optional update)
+ "Scan folder over range RANGE.
+If UPDATE, append the scan lines, otherwise replace."
+ (let ((folder mh-current-folder)
+ (range (if (and range (atom range)) (list range) range))
+ scan-start)
+ (message "Scanning %s..." folder)
+ (with-mh-folder-updating (nil)
+ (if update
+ (goto-char (point-max))
+ (delete-region (point-min) (point-max))
+ (if mh-adaptive-cmd-note-flag
+ (mh-set-cmd-note (mh-message-number-width folder))))
+ (setq scan-start (point))
+ (apply #'mh-exec-cmd-output
+ mh-scan-prog nil
+ (mh-scan-format)
+ "-noclear" "-noheader"
+ "-width" (window-width)
+ folder range)
+ (goto-char scan-start)
+ (cond ((looking-at "scan: no messages in")
+ (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
+ ((looking-at "scan: bad message list ")
+ (keep-lines mh-scan-valid-regexp))
+ ((looking-at "scan: ")) ; Keep error messages
+ (t
+ (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
+ (setq mh-seq-list (mh-read-folder-sequences folder nil))
+ (mh-notate-user-sequences)
+ (or update
+ (setq mh-mode-line-annotation
+ (if (equal range '("all"))
+ nil
+ mh-partial-folder-mode-line-annotation)))
+ (mh-make-folder-mode-line))
+ (message "Scanning %s...done" folder)))
+
+(defun mh-generate-new-cmd-note (folder)
+ "Fix the `mh-cmd-note' value for this FOLDER.
+
+After doing an `mh-get-new-mail' operation in this FOLDER, at least
+one line that looks like a truncated message number was found.
+
+Remove the text added by the last `mh-inc' command. It should be the
+messages cur-last. Call `mh-set-cmd-note' with the widest message number
+in FOLDER.
+
+Reformat the message number width on each line in the buffer and trim
+the line length to fit in the window.
+
+Rescan the FOLDER in the range cur-last in order to display the
+messages that were removed earlier. They should all fit in the scan
+line now with no message truncation."
+ (save-excursion
+ (let ((maxcol (1- (window-width)))
+ (old-cmd-note mh-cmd-note)
+ mh-cmd-note-fmt
+ msgnum)
+ ;; Nuke all of the lines just added by the last inc
+ (delete-char (- (point-max) (point)))
+ ;; Update the current buffer to reflect the new mh-cmd-note
+ ;; value needed to display messages.
+ (mh-set-cmd-note (mh-message-number-width folder))
+ (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
+ ;; Cleanup the messages that are in the buffer right now
+ (goto-char (point-min))
+ (cond ((memq 'unthread mh-view-ops)
+ (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
+ (t (while (re-search-forward mh-scan-msg-number-regexp nil 0 1)
+ ;; reformat the number to fix in mh-cmd-note columns
+ (setq msgnum (string-to-number
+ (buffer-substring
+ (match-beginning 1) (match-end 1))))
+ (replace-match (format mh-cmd-note-fmt msgnum))
+ ;; trim the line to fix in the window
+ (end-of-line)
+ (let ((eol (point)))
+ (move-to-column maxcol)
+ (if (<= (point) eol)
+ (delete-char (- eol (point))))))))
+ ;; now re-read the lost messages
+ (goto-char (point-max))
+ (prog1 (point)
+ (mh-regenerate-headers "cur-last" t)))))
+
+(defun mh-get-new-mail (maildrop-name)
+ "Read new mail from MAILDROP-NAME into the current buffer.
+Return in the current buffer."
+ (let ((point-before-inc (point))
+ (folder mh-current-folder)
+ (new-mail-flag nil))
+ (with-mh-folder-updating (t)
+ (if maildrop-name
+ (message "inc %s -file %s..." folder maildrop-name)
+ (message "inc %s..." folder))
+ (setq mh-next-direction 'forward)
+ (goto-char (point-max))
+ (let ((start-of-inc (point)))
+ (mh-remove-cur-notation)
+ (if maildrop-name
+ ;; I think MH 5 used "-ms-file" instead of "-file",
+ ;; which would make inc'ing from maildrops fail.
+ (mh-exec-cmd-output mh-inc-prog nil folder
+ (mh-scan-format)
+ "-file" (expand-file-name maildrop-name)
+ "-width" (window-width)
+ "-truncate")
+ (mh-exec-cmd-output mh-inc-prog nil
+ (mh-scan-format)
+ "-width" (window-width)))
+ (if maildrop-name
+ (message "inc %s -file %s...done" folder maildrop-name)
+ (message "inc %s...done" folder))
+ (goto-char start-of-inc)
+ (cond ((save-excursion
+ (re-search-forward "^inc: no mail" nil t))
+ (message "No new mail%s%s" (if maildrop-name " in " "")
+ (if maildrop-name maildrop-name "")))
+ ((and (when mh-narrowed-to-seq
+ (let ((saved-text (buffer-substring-no-properties
+ start-of-inc (point-max))))
+ (delete-region start-of-inc (point-max))
+ (unwind-protect (mh-widen)
+ (goto-char (point-max))
+ (setq start-of-inc (point))
+ (insert saved-text)
+ (goto-char start-of-inc))))
+ nil))
+ ((re-search-forward "^inc:" nil t) ; Error messages
+ (error "Error incorporating mail"))
+ ((and
+ (equal mh-scan-format-file t)
+ mh-adaptive-cmd-note-flag
+ ;; Have we reached an edge condition?
+ (save-excursion
+ (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
+ (setq start-of-inc (mh-generate-new-cmd-note folder))
+ nil))
+ (t
+ (setq new-mail-flag t)))
+ (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
+ (setq mh-seq-list (mh-read-folder-sequences folder t))
+ (when (equal (point-max) start-of-inc)
+ (mh-notate-seq 'cur mh-note-cur mh-cmd-note))
+ (mh-notate-user-sequences)
+ (if new-mail-flag
+ (progn
+ (mh-make-folder-mode-line)
+ (when (memq 'unthread mh-view-ops)
+ (mh-thread-inc folder start-of-inc))
+ (mh-goto-cur-msg))
+ (goto-char point-before-inc))))))
+
+(defun mh-make-folder-mode-line (&optional ignored)
+ "Set the fields of the mode line for a folder buffer.
+The optional argument is now obsolete and IGNORED. It used to be used to pass
+in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
+ (save-excursion
+ (save-window-excursion
+ (mh-first-msg)
+ (let ((new-first-msg-num (mh-get-msg-num nil)))
+ (when (or (not (memq 'unthread mh-view-ops))
+ (null mh-first-msg-num)
+ (null new-first-msg-num)
+ (< new-first-msg-num mh-first-msg-num))
+ (setq mh-first-msg-num new-first-msg-num)))
+ (mh-last-msg)
+ (let ((new-last-msg-num (mh-get-msg-num nil)))
+ (when (or (not (memq 'unthread mh-view-ops))
+ (null mh-last-msg-num)
+ (null new-last-msg-num)
+ (> new-last-msg-num mh-last-msg-num))
+ (setq mh-last-msg-num new-last-msg-num)))
+ (setq mh-msg-count (if mh-first-msg-num
+ (count-lines (point-min) (point-max))
+ 0))
+ (setq mode-line-buffer-identification
+ (list (format "{%%b%s} %s msg%s"
+ (if mh-mode-line-annotation
+ (format "/%s" mh-mode-line-annotation)
+ "")
+ (if (zerop mh-msg-count)
+ "no"
+ (format "%d" mh-msg-count))
+ (if (zerop mh-msg-count)
+ "s"
+ (cond ((> mh-msg-count 1)
+ (format "s (%d-%d)" mh-first-msg-num
+ mh-last-msg-num))
+ (mh-first-msg-num
+ (format " (%d)" mh-first-msg-num))
+ ("")))))))))
+
+(defun mh-unmark-all-headers (remove-all-flags)
+ "Remove all '+' flags from the folder listing.
+With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
+Optimized for speed (i.e., no regular expressions)."
+ (save-excursion
+ (let ((case-fold-search nil)
+ (last-line (1- (point-max)))
+ char)
+ (mh-first-msg)
+ (while (<= (point) last-line)
+ (forward-char mh-cmd-note)
+ (setq char (following-char))
+ (if (or (and remove-all-flags
+ (or (= char (aref mh-note-deleted 0))
+ (= char (aref mh-note-refiled 0))))
+ (= char (aref mh-note-cur 0)))
+ (progn
+ (delete-char 1)
+ (insert " ")))
+ (if remove-all-flags
+ (progn
+ (forward-char 1)
+ (if (= (following-char) (aref mh-note-seq 0))
+ (progn
+ (delete-char 1)
+ (insert " ")))))
+ (forward-line)))))
+
+(defun mh-remove-cur-notation ()
+ "Remove old cur notation."
+ (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
+ (save-excursion
+ (and cur-msg
+ (mh-goto-msg cur-msg t t)
+ (looking-at mh-scan-cur-msg-number-regexp)
+ (mh-notate nil ? mh-cmd-note)))))
+
+(defun mh-remove-all-notation ()
+ "Remove all notations on all scan lines that MH-E introduces."
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (or (equal (char-after) ?+) (eolp))
+ (mh-notate nil ? mh-cmd-note)
+ (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
+ (mh-notate nil ? (1+ mh-cmd-note))))
+ (forward-line))))
+
+;;;###mh-autoload
+(defun mh-goto-cur-msg (&optional minimal-changes-flag)
+ "Position the cursor at the current message.
+When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
+recenter the folder buffer."
+ (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
+ (cond ((and cur-msg
+ (mh-goto-msg cur-msg t t))
+ (unless minimal-changes-flag
+ (mh-notate nil mh-note-cur mh-cmd-note)
+ (mh-recenter 0)
+ (mh-maybe-show cur-msg)))
+ (t
+ (message "No current message")))))
+
+(defun mh-process-or-undo-commands (folder)
+ "If FOLDER has outstanding commands, then either process or discard them.
+Called by functions like `mh-sort-folder', so also invalidate show buffer."
+ (set-buffer folder)
+ (if (mh-outstanding-commands-p)
+ (if (or mh-do-not-confirm-flag
+ (y-or-n-p
+ "Process outstanding deletes and refiles (or lose them)? "))
+ (mh-process-commands folder)
+ (mh-undo-folder)))
+ (mh-update-unseen)
+ (mh-invalidate-show-buffer))
+
+(defun mh-process-commands (folder)
+ "Process outstanding commands for FOLDER.
+The value of `mh-folder-updated-hook' is a list of functions to be called,
+with no arguments, before the commands are processed."
+ (message "Processing deletes and refiles for %s..." folder)
+ (set-buffer folder)
+ (with-mh-folder-updating (nil)
+ ;; Run the hook while the lists are still valid
+ (run-hooks 'mh-folder-updated-hook)
+
+ ;; Update the unseen sequence if it exists
+ (mh-update-unseen)
+
+ (let ((redraw-needed-flag mh-index-data))
+ ;; Remove invalid scan lines if we are in an index folder and then remove
+ ;; the real messages
+ (when mh-index-data
+ (mh-index-delete-folder-headers)
+ (mh-index-execute-commands))
+
+ ;; Then refile messages
+ (mh-mapc #'(lambda (folder-msg-list)
+ (let ((dest-folder (symbol-name (car folder-msg-list)))
+ (msgs (cdr folder-msg-list)))
+ (setq redraw-needed-flag t)
+ (apply #'mh-exec-cmd
+ "refile" "-src" folder dest-folder
+ (mh-coalesce-msg-list msgs))
+ (mh-delete-scan-msgs msgs)))
+ mh-refile-list)
+ (setq mh-refile-list ())
+
+ ;; Now delete messages
+ (cond (mh-delete-list
+ (setq redraw-needed-flag t)
+ (apply 'mh-exec-cmd "rmm" folder
+ (mh-coalesce-msg-list mh-delete-list))
+ (mh-delete-scan-msgs mh-delete-list)
+ (setq mh-delete-list nil)))
+
+ ;; Don't need to remove sequences since delete and refile do so.
+ ;; Mark cur message
+ (if (> (buffer-size) 0)
+ (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
+
+ ;; Redraw folder buffer if needed
+ (when (and redraw-needed-flag)
+ (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
+ (mh-index-data (mh-index-insert-folder-headers)))))
+
+ (and (buffer-file-name (get-buffer mh-show-buffer))
+ (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
+ ;; If "inc" were to put a new msg in this file,
+ ;; we would not notice, so mark it invalid now.
+ (mh-invalidate-show-buffer))
+
+ (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
+ (mh-unmark-all-headers t)
+ (mh-notate-user-sequences)
+ (message "Processing deletes and refiles for %s...done" folder)))
+
+(defun mh-update-unseen ()
+ "Synchronize the unseen sequence with MH.
+Return non-nil iff the MH folder was set.
+The value of `mh-unseen-updated-hook' is a list of functions to be called,
+with no arguments, after the unseen sequence is updated."
+ (if mh-seen-list
+ (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
+ (unseen-msgs (mh-seq-msgs unseen-seq)))
+ (if unseen-msgs
+ (progn
+ (mh-undefine-sequence mh-unseen-seq mh-seen-list)
+ (run-hooks 'mh-unseen-updated-hook)
+ (while mh-seen-list
+ (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
+ (setq mh-seen-list (cdr mh-seen-list)))
+ (setcdr unseen-seq unseen-msgs)
+ t) ;since we set the folder
+ (setq mh-seen-list nil)))))
+
+(defun mh-delete-scan-msgs (msgs)
+ "Delete the scan listing lines for MSGS."
+ (save-excursion
+ (while msgs
+ (when (mh-goto-msg (car msgs) t t)
+ (when (memq 'unthread mh-view-ops)
+ (mh-thread-forget-message (car msgs)))
+ (mh-delete-line 1))
+ (setq msgs (cdr msgs)))))
+
+(defun mh-outstanding-commands-p ()
+ "Return non-nil if there are outstanding deletes or refiles."
+ (or mh-delete-list mh-refile-list))
+
+(defun mh-coalesce-msg-list (messages)
+ "Give a list of MESSAGES, return a list of message number ranges.
+Sort of the opposite of `mh-read-msg-list', which expands ranges.
+Message lists passed to MH programs go through this so
+command line arguments won't exceed system limits."
+ (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
+ (range-high nil)
+ (prev -1)
+ (ranges nil))
+ (while prev
+ (if range-high
+ (if (or (not (numberp prev))
+ (not (equal (car msgs) (1- prev))))
+ (progn ;non-sequential, flush old range
+ (if (eq prev range-high)
+ (setq ranges (cons range-high ranges))
+ (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
+ (setq range-high nil))))
+ (or range-high
+ (setq range-high (car msgs))) ;start new or first range
+ (setq prev (car msgs))
+ (setq msgs (cdr msgs)))
+ ranges))
+
+(defun mh-greaterp (msg1 msg2)
+ "Return the greater of two message indicators MSG1 and MSG2.
+Strings are \"smaller\" than numbers.
+Legal values are things like \"cur\", \"last\", 1, and 1820."
+ (if (numberp msg1)
+ (if (numberp msg2)
+ (> msg1 msg2)
+ t)
+ (if (numberp msg2)
+ nil
+ (string-lessp msg2 msg1))))
+
+(defun mh-lessp (msg1 msg2)
+ "Return the lesser of two message indicators MSG1 and MSG2.
+Strings are \"smaller\" than numbers.
+Legal values are things like \"cur\", \"last\", 1, and 1820."
+ (not (mh-greaterp msg1 msg2)))
+
+\f
+
+;;; Basic sequence handling
+
+(defun mh-delete-seq-locally (seq)
+ "Remove MH-E's record of SEQ."
+ (let ((entry (mh-find-seq seq)))
+ (setq mh-seq-list (delq entry mh-seq-list))))
+
+(defun mh-read-folder-sequences (folder save-refiles)
+ "Read and return the predefined sequences for a FOLDER.
+If SAVE-REFILES is non-nil, then keep the sequences
+that note messages to be refiled."
+ (let ((seqs ()))
+ (cond (save-refiles
+ (mh-mapc (function (lambda (seq) ; Save the refiling sequences
+ (if (mh-folder-name-p (mh-seq-name seq))
+ (setq seqs (cons seq seqs)))))
+ mh-seq-list)))
+ (save-excursion
+ (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
+ (progn
+ ;; look for name in line of form "cur: 4" or "myseq (private): 23"
+ (while (re-search-forward "^[^: ]+" nil t)
+ (setq seqs (cons (mh-make-seq (intern (buffer-substring
+ (match-beginning 0)
+ (match-end 0)))
+ (mh-read-msg-list))
+ seqs)))
+ (delete-region (point-min) (point))))) ; avoid race with
+ ; mh-process-daemon
+ seqs))
+
+(defun mh-read-msg-list ()
+ "Return a list of message numbers from point to the end of the line.
+Expands ranges into set of individual numbers."
+ (let ((msgs ())
+ (end-of-line (save-excursion (end-of-line) (point)))
+ num)
+ (while (re-search-forward "[0-9]+" end-of-line t)
+ (setq num (string-to-int (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ (cond ((looking-at "-") ; Message range
+ (forward-char 1)
+ (re-search-forward "[0-9]+" end-of-line t)
+ (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
+ (match-end 0)))))
+ (if (< num2 num)
+ (error "Bad message range: %d-%d" num num2))
+ (while (<= num num2)
+ (setq msgs (cons num msgs))
+ (setq num (1+ num)))))
+ ((not (zerop num)) ;"pick" outputs "0" to mean no match
+ (setq msgs (cons num msgs)))))
+ msgs))
+
+(defun mh-notate-user-sequences ()
+ "Mark the scan listing of all messages in user-defined sequences."
+ (let ((seqs mh-seq-list)
+ name)
+ (while seqs
+ (setq name (mh-seq-name (car seqs)))
+ (if (not (mh-internal-seq name))
+ (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
+ (setq seqs (cdr seqs)))))
+
+(defun mh-internal-seq (name)
+ "Return non-nil if NAME is the name of an internal MH-E sequence."
+ (or (memq name '(answered cur deleted forwarded printed))
+ (eq name mh-unseen-seq)
+ (eq name mh-previous-seq)
+ (mh-folder-name-p name)))
+
+(defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
+ "Delete MESSAGE from SEQUENCE.
+MESSAGE defaults to displayed message. From Lisp, optional third arg
+INTERNAL-FLAG non-nil means do not inform MH of the change."
+ (interactive (list (mh-get-msg-num t)
+ (mh-read-seq-default "Delete from" t)
+ nil))
+ (let ((entry (mh-find-seq sequence)))
+ (cond (entry
+ (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence)
+ (if (not internal-flag)
+ (mh-undefine-sequence sequence (list message)))
+ (setcdr entry (delq message (mh-seq-msgs entry)))))))
+
+(defun mh-undefine-sequence (seq msgs)
+ "Remove from the SEQ the list of MSGS."
+ (mh-exec-cmd "mark" mh-current-folder "-delete"
+ "-sequence" (symbol-name seq)
+ (mh-coalesce-msg-list msgs)))
+
+(defun mh-define-sequence (seq msgs)
+ "Define the SEQ to contain the list of MSGS.
+Do not mark pseudo-sequences or empty sequences.
+Signals an error if SEQ is an illegal name."
+ (if (and msgs
+ (not (mh-folder-name-p seq)))
+ (save-excursion
+ (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
+ "-sequence" (symbol-name seq)
+ (mh-coalesce-msg-list msgs)))))
+
+(defun mh-map-over-seqs (function seq-list)
+ "Apply FUNCTION to each sequence in SEQ-LIST.
+The sequence name and the list of messages are passed as arguments."
+ (while seq-list
+ (funcall function
+ (mh-seq-name (car seq-list))
+ (mh-seq-msgs (car seq-list)))
+ (setq seq-list (cdr seq-list))))
+
+(defun mh-notate-if-in-one-seq (msg character offset seq)
+ "Notate MSG.
+The CHARACTER is placed at the given OFFSET from the beginning of the listing.
+The notation is performed if the MSG is only in SEQ."
+ (let ((in-seqs (mh-seq-containing-msg msg nil)))
+ (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
+ (mh-notate msg character offset))))
+
+(defun mh-seq-containing-msg (msg &optional include-internal-flag)
+ "Return a list of the sequences containing MSG.
+If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
+ (let ((l mh-seq-list)
+ (seqs ()))
+ (while l
+ (and (memq msg (mh-seq-msgs (car l)))
+ (or include-internal-flag
+ (not (mh-internal-seq (mh-seq-name (car l)))))
+ (setq seqs (cons (mh-seq-name (car l)) seqs)))
+ (setq l (cdr l)))
+ seqs))
+
+\f
+
+;;; User prompting commands.
+
+(defun mh-read-msg-range (folder &optional always-prompt-flag)
+ "Prompt for message range from FOLDER.
+If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
+range."
+ (multiple-value-bind (total unseen) (mh-folder-size folder)
+ (cond
+ ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
+ (list (symbol-name mh-unseen-seq)))
+ ((or (null mh-large-folder) (not (numberp total)))
+ (list "all"))
+ ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
+ (let* ((prompt
+ (format "Range or number of messages to read (default: %s): "
+ total))
+ (in (read-string prompt nil nil (number-to-string total))))
+ (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
+ (list (format "last:%s" (car (read-from-string in)))))
+ ((equal in "") (list "all"))
+ (t (split-string in)))))
+ (t (list "all")))))
+
+\f
+
+;;; Build the folder-mode keymap:
+
+(suppress-keymap mh-folder-mode-map)
+
+;; Use defalias to make sure the documented primary key bindings
+;; appear in menu lists.
+(defalias 'mh-alt-show 'mh-show)
+(defalias 'mh-alt-refile-msg 'mh-refile-msg)
+(defalias 'mh-alt-send 'mh-send)
+(defalias 'mh-alt-visit-folder 'mh-visit-folder)
+
+;; Save the `b' binding for a future `back'. Maybe?
+(gnus-define-keys mh-folder-mode-map
+ " " mh-page-msg
+ "!" mh-refile-or-write-again
+ "," mh-header-display
+ "." mh-alt-show
+ ">" mh-write-msg-to-file
+ "?" mh-help
+ "E" mh-extract-rejected-mail
+ "M" mh-modify
+ "\177" mh-previous-page
+ "\C-d" mh-delete-msg-no-motion
+ "\t" mh-index-next-folder
+ [backtab] mh-index-previous-folder
+ "\M-\t" mh-index-previous-folder
+ "\e<" mh-first-msg
+ "\e>" mh-last-msg
+ "\ed" mh-redistribute
+ "\r" mh-show
+ "^" mh-alt-refile-msg
+ "c" mh-copy-msg
+ "d" mh-delete-msg
+ "e" mh-edit-again
+ "f" mh-forward
+ "g" mh-goto-msg
+ "i" mh-inc-folder
+ "k" mh-delete-subject-or-thread
+ "l" mh-print-msg
+ "m" mh-alt-send
+ "n" mh-next-undeleted-msg
+ "\M-n" mh-next-unread-msg
+ "o" mh-refile-msg
+ "p" mh-previous-undeleted-msg
+ "\M-p" mh-previous-unread-msg
+ "q" mh-quit
+ "r" mh-reply
+ "s" mh-send
+ "t" mh-toggle-showing
+ "u" mh-undo
+ "v" mh-index-visit-folder
+ "x" mh-execute-commands
+ "|" mh-pipe-msg)
+
+(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
+ "?" mh-prefix-help
+ "S" mh-sort-folder
+ "f" mh-alt-visit-folder
+ "i" mh-index-search
+ "k" mh-kill-folder
+ "l" mh-list-folders
+ "o" mh-alt-visit-folder
+ "p" mh-pack-folder
+ "r" mh-rescan-folder
+ "s" mh-search-folder
+ "u" mh-undo-folder
+ "v" mh-visit-folder)
+
+(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
+ "?" mh-prefix-help
+ "d" mh-delete-msg-from-seq
+ "k" mh-delete-seq
+ "l" mh-list-sequences
+ "n" mh-narrow-to-seq
+ "p" mh-put-msg-in-seq
+ "s" mh-msg-is-in-seq
+ "w" mh-widen)
+
+(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
+ "?" mh-prefix-help
+ "u" mh-thread-ancestor
+ "p" mh-thread-previous-sibling
+ "n" mh-thread-next-sibling
+ "t" mh-toggle-threads
+ "d" mh-thread-delete
+ "o" mh-thread-refile)
+
+(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
+ "?" mh-prefix-help
+ "s" mh-narrow-to-subject
+ "w" mh-widen)
+
+(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
+ "?" mh-prefix-help
+ "s" mh-store-msg ;shar
+ "u" mh-store-msg) ;uuencode
+
+(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
+ " " mh-page-digest
+ "?" mh-prefix-help
+ "\177" mh-page-digest-backwards
+ "b" mh-burst-digest)
+
+(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
+ "?" mh-prefix-help
+ "a" mh-mime-save-parts
+ "i" mh-folder-inline-mime-part
+ "o" mh-folder-save-mime-part
+ "v" mh-folder-toggle-mime-part
+ "\t" mh-next-button
+ [backtab] mh-prev-button
+ "\M-\t" mh-prev-button)
+
+(cond
+ (mh-xemacs-flag
+ (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
+ (t
+ (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
+
+;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
+
+\f
+
+;;; Help Messages
+
+;;; If you add a new prefix, add appropriate text to the nil key.
+;;;
+;;; In general, messages are grouped logically. Taking the main commands for
+;;; example, the first line is "ways to view messages," the second line is
+;;; "things you can do with messages", and the third is "composing" messages.
+;;;
+;;; When adding a new prefix, ensure that the help message contains "what" the
+;;; prefix is for. For example, if the word "folder" were not present in the
+;;; `F' entry, it would not be clear what these commands operated upon.
+(defvar mh-help-messages
+ '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
+ "[d]elete, [o]refile, e[x]ecute,\n"
+ "[s]end, [r]eply.\n"
+ "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, "
+ "[T]hread, / Limit, e[X]tract, [D]igest.")
+
+ (?F "[l]ist, [v]isit folder;\n"
+ "[t]hread; [s]earch; [i]ndexed search;\n"
+ "[p]ack; [S]ort; [r]escan; [k]ill")
+ (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
+ "[s]equences, [l]ist,\n"
+ "[d]elete message from sequence, [k]ill sequence")
+ (?T "[t]oggle, [d]elete, [o]refile thread")
+ (?/ "Limit to [s]ubject; [w]iden")
+ (?X "un[s]har, [u]udecode message")
+ (?D "[b]urst digest")
+ (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
+ "[TAB] next; [SHIFT-TAB] previous"))
+ "Key binding cheat sheet.
+
+This is an associative array which is used to show the most common commands.
+The key is a prefix char. The value is one or more strings which are
+concatenated together and displayed in the minibuffer if ? is pressed after
+the prefix character. The special key nil is used to display the
+non-prefixed commands.
+
+The substitutions described in `substitute-command-keys' are performed as
+well.")
+
+\f
+
+(dolist (mess '("^Cursor not pointing to message$"
+ "^There is no other window$"))
+ (add-to-list 'debug-ignored-errors mess))
+
+(provide 'mh-e)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-e.el ends here
--- /dev/null
+;;; mh-funcs.el --- MH-E functions not everyone will use right away
+
+;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Internal support for MH-E package.
+;; Putting these functions in a separate file lets MH-E start up faster,
+;; since less Lisp code needs to be loaded all at once.
+
+;;; Change Log:
+
+;; $Id: mh-funcs.el,v 1.9 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+(require 'mh-e)
+
+;;; Customization
+
+(defvar mh-sortm-args nil
+ "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
+The arguments are passed to sortm if \\[mh-sort-folder] is given a
+prefix argument. Normally default arguments to sortm are specified in the
+MH profile.
+For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
+
+(defvar mh-note-copied "C"
+ "String whose first character is used to notate copied messages.")
+
+(defvar mh-note-printed "P"
+ "String whose first character is used to notate printed messages.")
+
+;;; Functions
+
+;;;###mh-autoload
+(defun mh-burst-digest ()
+ "Burst apart the current message, which should be a digest.
+The message is replaced by its table of contents and the messages from the
+digest are inserted into the folder after that message."
+ (interactive)
+ (let ((digest (mh-get-msg-num t)))
+ (mh-process-or-undo-commands mh-current-folder)
+ (mh-set-folder-modified-p t) ; lock folder while bursting
+ (message "Bursting digest...")
+ (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
+ (with-mh-folder-updating (t)
+ (beginning-of-line)
+ (delete-region (point) (point-max)))
+ (mh-regenerate-headers (format "%d-last" digest) t)
+ (mh-goto-cur-msg)
+ (message "Bursting digest...done")))
+
+;;;###mh-autoload
+(defun mh-copy-msg (msg-or-seq folder)
+ "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
+Default is the displayed message. If optional prefix argument is provided,
+then prompt for the message sequence."
+ (interactive (list (cond
+ ((mh-mark-active-p t)
+ (mh-region-to-msg-list (region-beginning) (region-end)))
+ (current-prefix-arg
+ (mh-read-seq-default "Copy" t))
+ (t
+ (mh-get-msg-num t)))
+ (mh-prompt-for-folder "Copy to" "" t)))
+ (mh-exec-cmd "refile"
+ (cond ((numberp msg-or-seq) msg-or-seq)
+ ((listp msg-or-seq) msg-or-seq)
+ (t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq))))
+ "-link" "-src" mh-current-folder folder)
+ (if (numberp msg-or-seq)
+ (mh-notate msg-or-seq mh-note-copied mh-cmd-note)
+ (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
+
+;;;###mh-autoload
+(defun mh-kill-folder ()
+ "Remove the current folder and all included messages.
+Removes all of the messages (files) within the specified current folder,
+and then removes the folder (directory) itself.
+The value of `mh-folder-list-change-hook' is a list of functions to be called,
+with no arguments, after the folders has been removed."
+ (interactive)
+ (if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
+ mh-current-folder))
+ (let ((folder mh-current-folder))
+ (if (null mh-folder-list)
+ (mh-set-folder-list))
+ (mh-set-folder-modified-p t) ; lock folder to kill it
+ (mh-exec-cmd-daemon "rmf" folder)
+ (setq mh-folder-list
+ (delq (assoc folder mh-folder-list) mh-folder-list))
+ (when (boundp 'mh-speed-folder-map)
+ (mh-speed-invalidate-map folder))
+ (run-hooks 'mh-folder-list-change-hook)
+ (message "Folder %s removed" folder)
+ (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
+ (if (get-buffer mh-show-buffer)
+ (kill-buffer mh-show-buffer))
+ (if (get-buffer folder)
+ (kill-buffer folder)))
+ (message "Folder not removed")))
+
+;; Avoid compiler warning...
+(defvar view-exit-action)
+
+;;;###mh-autoload
+(defun mh-list-folders ()
+ "List mail folders."
+ (interactive)
+ (let ((temp-buffer mh-temp-folders-buffer))
+ (with-output-to-temp-buffer temp-buffer
+ (save-excursion
+ (set-buffer temp-buffer)
+ (erase-buffer)
+ (message "Listing folders...")
+ (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
+ "-recurse"
+ "-norecurse"))
+ (goto-char (point-min))
+ (view-mode 1)
+ (setq view-exit-action 'kill-buffer)
+ (message "Listing folders...done")))))
+
+;;;###mh-autoload
+(defun mh-pack-folder (range)
+ "Renumber the messages of a folder to be 1..n.
+First, offer to execute any outstanding commands for the current folder. If
+optional prefix argument provided, prompt for the RANGE of messages to display
+after packing. Otherwise, show the entire folder."
+ (interactive (list (if current-prefix-arg
+ (mh-read-msg-range mh-current-folder t)
+ '("all"))))
+ (let ((threaded-flag (memq 'unthread mh-view-ops)))
+ (mh-pack-folder-1 range)
+ (mh-goto-cur-msg)
+ (when mh-index-data
+ (mh-index-update-maps mh-current-folder))
+ (cond (threaded-flag (mh-toggle-threads))
+ (mh-index-data (mh-index-insert-folder-headers))))
+ (message "Packing folder...done"))
+
+(defun mh-pack-folder-1 (range)
+ "Close and pack the current folder.
+Display the given RANGE of messages after packing. If RANGE is nil, show the
+entire folder."
+ (mh-process-or-undo-commands mh-current-folder)
+ (message "Packing folder...")
+ (mh-set-folder-modified-p t) ; lock folder while packing
+ (save-excursion
+ (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
+ "-norecurse" "-fast"))
+ (mh-reset-threads-and-narrowing)
+ (mh-regenerate-headers range))
+
+;;;###mh-autoload
+(defun mh-pipe-msg (command include-headers)
+ "Pipe the current message through the given shell COMMAND.
+If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
+Otherwise just send the message's body without the headers."
+ (interactive
+ (list (read-string "Shell command on message: ") current-prefix-arg))
+ (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
+ (message-directory default-directory))
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ (insert-file-contents msg-file-to-pipe)
+ (goto-char (point-min))
+ (if (not include-headers) (search-forward "\n\n"))
+ (let ((default-directory message-directory))
+ (shell-command-on-region (point) (point-max) command nil)))))
+
+;;;###mh-autoload
+(defun mh-page-digest ()
+ "Advance displayed message to next digested message."
+ (interactive)
+ (mh-in-show-buffer (mh-show-buffer)
+ ;; Go to top of screen (in case user moved point).
+ (move-to-window-line 0)
+ (let ((case-fold-search nil))
+ ;; Search for blank line and then for From:
+ (or (and (search-forward "\n\n" nil t)
+ (re-search-forward "^From:" nil t))
+ (error "No more messages in digest")))
+ ;; Go back to previous blank line, then forward to the first non-blank.
+ (search-backward "\n\n" nil t)
+ (forward-line 2)
+ (mh-recenter 0)))
+
+;;;###mh-autoload
+(defun mh-page-digest-backwards ()
+ "Back up displayed message to previous digested message."
+ (interactive)
+ (mh-in-show-buffer (mh-show-buffer)
+ ;; Go to top of screen (in case user moved point).
+ (move-to-window-line 0)
+ (let ((case-fold-search nil))
+ (beginning-of-line)
+ (or (and (search-backward "\n\n" nil t)
+ (re-search-backward "^From:" nil t))
+ (error "No previous message in digest")))
+ ;; Go back to previous blank line, then forward to the first non-blank.
+ (if (search-backward "\n\n" nil t)
+ (forward-line 2))
+ (mh-recenter 0)))
+
+;;;###mh-autoload
+(defun mh-print-msg (msg-or-seq)
+ "Print MSG-OR-SEQ (default: displayed message) on printer.
+If optional prefix argument provided, then prompt for the message sequence.
+The variable `mh-lpr-command-format' is used to generate the print command.
+The messages are formatted by mhl. See the variable `mhl-formfile'."
+ (interactive (list (if current-prefix-arg
+ (reverse (mh-seq-to-msgs
+ (mh-read-seq-default "Print" t)))
+ (mh-get-msg-num t))))
+ (if (numberp msg-or-seq)
+ (message "Printing message...")
+ (message "Printing sequence..."))
+ (let ((print-command
+ (if (numberp msg-or-seq)
+ (format "%s -nobell -clear %s %s | %s"
+ (expand-file-name "mhl" mh-lib-progs)
+ (mh-msg-filename msg-or-seq)
+ (if (stringp mhl-formfile)
+ (format "-form %s" mhl-formfile)
+ "")
+ (format mh-lpr-command-format
+ (if (numberp msg-or-seq)
+ (format "%s/%d" mh-current-folder
+ msg-or-seq)
+ (format "Sequence from %s" mh-current-folder))))
+ (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
+ (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
+ (expand-file-name "mhl" mh-lib-progs)
+ (if (stringp mhl-formfile)
+ (format "-form %s" mhl-formfile)
+ "")
+ (mh-msg-filenames msg-or-seq)
+ (format mh-lpr-command-format
+ (if (numberp msg-or-seq)
+ (format "%s/%d" mh-current-folder
+ msg-or-seq)
+ (format "Sequence from %s"
+ mh-current-folder)))))))
+ (if mh-print-background-flag
+ (mh-exec-cmd-daemon shell-file-name "-c" print-command)
+ (call-process shell-file-name nil nil nil "-c" print-command))
+ (if (numberp msg-or-seq)
+ (mh-notate msg-or-seq mh-note-printed mh-cmd-note)
+ (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
+ (mh-add-msgs-to-seq msg-or-seq 'printed t)
+ (if (numberp msg-or-seq)
+ (message "Printing message...done")
+ (message "Printing sequence...done"))))
+
+(defun mh-msg-filenames (msgs &optional folder)
+ "Return a list of file names for MSGS in FOLDER (default current folder)."
+ (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
+
+;;;###mh-autoload
+(defun mh-sort-folder (&optional extra-args)
+ "Sort the messages in the current folder by date.
+Calls the MH program sortm to do the work.
+The arguments in the list `mh-sortm-args' are passed to sortm if the optional
+argument EXTRA-ARGS is given."
+ (interactive "P")
+ (mh-process-or-undo-commands mh-current-folder)
+ (setq mh-next-direction 'forward)
+ (mh-set-folder-modified-p t) ; lock folder while sorting
+ (message "Sorting folder...")
+ (let ((threaded-flag (memq 'unthread mh-view-ops)))
+ (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
+ (when mh-index-data
+ (mh-index-update-maps mh-current-folder))
+ (message "Sorting folder...done")
+ (mh-reset-threads-and-narrowing)
+ (mh-scan-folder mh-current-folder "all")
+ (cond (threaded-flag (mh-toggle-threads))
+ (mh-index-data (mh-index-insert-folder-headers)))))
+
+;;;###mh-autoload
+(defun mh-undo-folder (&rest ignore)
+ "Undo all pending deletes and refiles in current folder.
+Argument IGNORE is deprecated."
+ (interactive)
+ (cond ((or mh-do-not-confirm-flag
+ (yes-or-no-p "Undo all commands in folder? "))
+ (setq mh-delete-list nil
+ mh-refile-list nil
+ mh-seq-list nil
+ mh-next-direction 'forward)
+ (with-mh-folder-updating (nil)
+ (mh-unmark-all-headers t)))
+ (t
+ (message "Commands not undone.")
+ (sit-for 2))))
+
+;;;###mh-autoload
+(defun mh-store-msg (directory)
+ "Store the file(s) contained in the current message into DIRECTORY.
+The message can contain a shar file or uuencoded file.
+Default directory is the last directory used, or initially the value of
+`mh-store-default-directory' or the current directory."
+ (interactive (list (let ((udir (or mh-store-default-directory
+ default-directory)))
+ (read-file-name "Store message in directory: "
+ udir udir nil))))
+ (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ (insert-file-contents msg-file-to-store)
+ (mh-store-buffer directory))))
+
+;;;###mh-autoload
+(defun mh-store-buffer (directory)
+ "Store the file(s) contained in the current buffer into DIRECTORY.
+The buffer can contain a shar file or uuencoded file.
+Default directory is the last directory used, or initially the value of
+`mh-store-default-directory' or the current directory."
+ (interactive (list (let ((udir (or mh-store-default-directory
+ default-directory)))
+ (read-file-name "Store buffer in directory: "
+ udir udir nil))))
+ (let ((store-directory (expand-file-name directory))
+ (sh-start (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
+ (progn
+ ;; The "cut here" pattern was removed from above
+ ;; because it seemed to hurt more than help.
+ ;; But keep this to make it easier to put it back.
+ (if (looking-at "^[^a-z0-9\"]*cut here\\b")
+ (forward-line 1))
+ (beginning-of-line)
+ (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
+ nil ;most likely end of a uuencode
+ (point))))))
+ (log-buffer (get-buffer-create "*Store Output*"))
+ (command "sh")
+ (uudecode-filename "(unknown filename)"))
+ (if (not sh-start)
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "^begin [0-7]+ " nil t)
+ (setq uudecode-filename
+ (buffer-substring (point)
+ (progn (end-of-line) (point)))))))
+ (save-excursion
+ (set-buffer log-buffer)
+ (erase-buffer)
+ (if (not (file-directory-p store-directory))
+ (progn
+ (insert "mkdir " directory "\n")
+ (call-process "mkdir" nil log-buffer t store-directory)))
+ (insert "cd " directory "\n")
+ (setq mh-store-default-directory directory)
+ (if (not sh-start)
+ (progn
+ (setq command "uudecode")
+ (insert uudecode-filename " being uudecoded...\n"))))
+ (set-window-start (display-buffer log-buffer) 0) ;watch progress
+ (let (value)
+ (let ((default-directory (file-name-as-directory store-directory)))
+ (setq value (call-process-region sh-start (point-max) command
+ nil log-buffer t)))
+ (set-buffer log-buffer)
+ (mh-handle-process-error command value))
+ (insert "\n(mh-store finished)\n")))
+
+\f
+
+;;; Help Functions
+
+(defun mh-ephem-message (string)
+ "Display STRING in the minibuffer momentarily."
+ (message "%s" string)
+ (sit-for 5)
+ (message ""))
+
+;;;###mh-autoload
+(defun mh-help ()
+ "Display cheat sheet for the MH-Folder commands in minibuffer."
+ (interactive)
+ (mh-ephem-message
+ (substitute-command-keys
+ (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
+
+;;;###mh-autoload
+(defun mh-prefix-help ()
+ "Display cheat sheet for the commands of the current prefix in minibuffer."
+ (interactive)
+ ;; We got here because the user pressed a `?', but he pressed a prefix key
+ ;; before that. Since the the key vector starts at index 0, the index of the
+ ;; last keystroke is length-1 and thus the second to last keystroke is at
+ ;; length-2. We use that information to obtain a suitable prefix character
+ ;; from the recent keys.
+ (let* ((keys (recent-keys))
+ (prefix-char (elt keys (- (length keys) 2))))
+ (mh-ephem-message
+ (substitute-command-keys
+ (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
+
+(provide 'mh-funcs)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-funcs.el ends here
--- /dev/null
+;;; mh-identity.el --- Multiple Identify support for MH-E.
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Peter S. Galbraith <psg@debian.org>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Multiple identity support for MH-E.
+;;
+;; Used to easily set different fields such as From and Organization, as
+;; well as different signature files.
+;;
+;; Customize the variable `mh-identity-list' and an Identity menu will
+;; appear in mh-letter-mode. The command 'mh-insert-identity can be used
+;; from the command line.
+
+;;; Change Log:
+
+;; $Id: mh-identity.el,v 1.1 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+
+(require 'cl)
+
+(eval-when (compile load eval)
+ (defvar mh-comp-loaded nil)
+ (unless mh-comp-loaded
+ (setq mh-comp-loaded t)
+ (require 'mh-comp))) ;Since we do this on sending
+
+(autoload 'mml-insert-tag "mml")
+
+;;;###mh-autoload
+(defun mh-identity-make-menu ()
+ "Build (or rebuild) the Identity menu (e.g. after the list is modified)."
+ (when (and mh-identity-list (boundp 'mh-letter-mode-map))
+ (easy-menu-define mh-identity-menu mh-letter-mode-map
+ "mh-e identity menu"
+ (append
+ '("Identity")
+ ;; Dynamically render :type corresponding to `mh-identity-list'
+ ;; e.g.:
+ ;; ["home" (mh-insert-identity "home")
+ ;; :style radio :active (not (equal mh-identity-local "home"))
+ ;; :selected (equal mh-identity-local "home")]
+ (mapcar (function
+ (lambda (arg)
+ `[,arg (mh-insert-identity ,arg) :style radio
+ :active (not (equal mh-identity-local ,arg))
+ :selected (equal mh-identity-local ,arg)]))
+ (mapcar 'car mh-identity-list))
+ '("--"
+ ["none" (mh-insert-identity "none") mh-identity-local]
+ ["Set Default for Session"
+ (setq mh-identity-default mh-identity-local) t]
+ ["Save as Default"
+ (customize-save-variable
+ 'mh-identity-default mh-identity-local) t]
+ )))))
+
+;;;###mh-autoload
+(defun mh-identity-list-set (symbol value)
+ "Update the `mh-identity-list' variable, and rebuild the menu.
+Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
+customization). This is called after 'customize is used to alter
+`mh-identity-list'."
+ (set-default symbol value)
+ (mh-identity-make-menu))
+
+(defvar mh-identity-local nil
+ "Buffer-local variable holding the identity currently in use.")
+(make-variable-buffer-local 'mh-identity-local)
+
+(defun mh-header-field-delete (field value-only)
+ "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
+Return t if anything is deleted."
+ (when (mh-goto-header-field field)
+ (if (not value-only)
+ (beginning-of-line)
+ (forward-char))
+ (delete-region (point)
+ (progn (mh-header-field-end)
+ (if (not value-only) (forward-char 1))
+ (point)))
+ t))
+
+(defvar mh-identity-signature-start nil
+ "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
+(defvar mh-identity-signature-end nil
+ "Marker for the end of a signature inserted by `mh-insert-identity'.")
+
+;;;###mh-autoload
+(defun mh-insert-identity (identity)
+ "Insert proper fields for given IDENTITY.
+Edit the `mh-identity-list' variable to define identity."
+ (interactive
+ (list (completing-read
+ "Identity: "
+ (if mh-identity-local
+ (cons '("none")
+ (mapcar 'list (mapcar 'car mh-identity-list)))
+ (mapcar 'list (mapcar 'car mh-identity-list)))
+ nil t)))
+ (save-excursion
+ ;;First remove old settings, if any.
+ (when mh-identity-local
+ (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
+ (while pers-list
+ (let ((field (concat (caar pers-list) ":")))
+ (cond
+ ((string-equal "signature:" field)
+ (when (and (boundp 'mh-identity-signature-start)
+ (markerp mh-identity-signature-start))
+ (goto-char mh-identity-signature-start)
+ (forward-char -1)
+ (delete-region (point) mh-identity-signature-end)))
+ ((mh-header-field-delete field nil))))
+ (setq pers-list (cdr pers-list)))))
+ ;; Then insert the replacement
+ (when (not (equal "none" identity))
+ (let ((pers-list (cadr (assoc identity mh-identity-list))))
+ (while pers-list
+ (let ((field (concat (caar pers-list) ":"))
+ (value (cdar pers-list)))
+ (cond
+ ;; No value, remove field
+ ((or (not value)
+ (string= value ""))
+ (mh-header-field-delete field nil))
+ ;; Existing field, replace
+ ((mh-header-field-delete field t)
+ (insert value))
+ ;; Handle "signature" special case. Insert file or call function.
+ ((and (string-equal "signature:" field)
+ (or (and (stringp value)
+ (file-readable-p value))
+ (fboundp value)))
+ (goto-char (point-max))
+ (if (not (looking-at "^$"))
+ (insert "\n"))
+ (insert "\n")
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (set (make-local-variable 'mh-identity-signature-start)
+ (make-marker))
+ (set-marker mh-identity-signature-start (point))
+ (cond
+ ;; If MIME composition done, insert signature at the end as
+ ;; an inline MIME part.
+ ((and (boundp 'mh-mhn-compose-insert-flag)
+ mh-mhn-compose-insert-flag)
+ (insert "#\n" "Content-Description: Signature\n"))
+ ((and (boundp 'mh-mml-compose-insert-flag)
+ mh-mml-compose-insert-flag)
+ (mml-insert-tag 'part 'type "text/plain"
+ 'disposition "inline"
+ 'description "Signature")))
+ (if (stringp value)
+ (insert-file-contents value)
+ (funcall value))
+ (goto-char (point-min))
+ (when (not (re-search-forward "^--" nil t))
+ (if (and (boundp 'mh-mhn-compose-insert-flag)
+ mh-mhn-compose-insert-flag)
+ (forward-line 2))
+ (if (and (boundp 'mh-mml-compose-insert-flag)
+ mh-mml-compose-insert-flag)
+ (forward-line 1))
+ (insert "-- \n"))
+ (set (make-local-variable 'mh-identity-signature-end)
+ (make-marker))
+ (set-marker mh-identity-signature-end (point-max))))
+ ;; Handle "From" field differently, adding it at the beginning.
+ ((string-equal "From:" field)
+ (goto-char (point-min))
+ (insert "From: " value "\n"))
+ ;; Skip empty signature (Can't remove what we don't know)
+ ((string-equal "signature:" field))
+ ;; Other field, add at end
+ (t ;Otherwise, add the end.
+ (goto-char (point-min))
+ (mh-goto-header-end 0)
+ (mh-insert-fields field value))))
+ (setq pers-list (cdr pers-list))))))
+ ;; Remember what is in use in this buffer
+ (if (equal "none" identity)
+ (setq mh-identity-local nil)
+ (setq mh-identity-local identity)))
+
+(provide 'mh-identity)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-identity.el ends here
--- /dev/null
+;;; mh-index -- MH-E interface to indexing programs
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; (1) The following search engines are supported:
+;;; swish++
+;;; swish-e
+;;; namazu
+;;; glimpse
+;;; grep
+;;;
+;;; (2) To use this package, you first have to build an index. Please read
+;;; the documentation for `mh-index-search' to get started. That
+;;; documentation will direct you to the specific instructions for your
+;;; particular indexer.
+
+;;; Change Log:
+
+;; $Id: mh-index.el,v 1.2 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+(require 'cl)
+(require 'mh-e)
+(require 'mh-mime)
+
+(autoload 'gnus-local-map-property "gnus-util")
+(autoload 'gnus-eval-format "gnus-spec")
+(autoload 'widget-convert-button "wid-edit")
+(autoload 'executable-find "executable")
+
+;; Support different indexing programs
+(defvar mh-indexer-choices
+ '((swish++
+ mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result)
+ (swish
+ mh-swish-binary mh-swish-execute-search mh-swish-next-result)
+ (namazu
+ mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result)
+ (glimpse
+ mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result)
+ (grep
+ mh-grep-binary mh-grep-execute-search mh-grep-next-result))
+ "List of possible indexer choices.")
+(defvar mh-indexer nil
+ "Chosen index program.")
+(defvar mh-index-execute-search-function nil
+ "Function which executes the search program.")
+(defvar mh-index-next-result-function nil
+ "Function to parse the next line of output.")
+
+;; FIXME: This should be a defcustom...
+(defvar mh-index-folder "+mhe-index"
+ "Folder that contains the folders resulting from the index searches.")
+
+;; Temporary buffers for search results
+(defvar mh-index-temp-buffer " *mh-index-temp*")
+(defvar mh-checksum-buffer " *mh-checksum-buffer*")
+
+\f
+
+;;; A few different checksum programs are supported. The supported programs
+;;; are:
+;;; 1. md5sum
+;;; 2. md5
+;;; 3. openssl
+;;;
+;;; To add support for your favorite checksum program add a clause to the cond
+;;; statement in mh-checksum-choose. This should set the variable
+;;; mh-checksum-cmd to the command line needed to run the checsum program and
+;;; should set mh-checksum-parser to a function which returns a cons cell
+;;; containing the message number and checksum string.
+
+(defvar mh-checksum-cmd)
+(defvar mh-checksum-parser)
+
+(defun mh-checksum-choose ()
+ "Check if a program to create a checksum is present."
+ (unless (boundp 'mh-checksum-cmd)
+ (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
+ (cond ((executable-find "md5sum")
+ (setq mh-checksum-cmd (list (executable-find "md5sum")))
+ (setq mh-checksum-parser #'mh-md5sum-parser))
+ ((executable-find "openssl")
+ (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
+ (setq mh-checksum-parser #'mh-openssl-parser))
+ ((executable-find "md5")
+ (setq mh-checksum-cmd (list (executable-find "md5")))
+ (setq mh-checksum-parser #'mh-md5-parser))
+ (t (error "No suitable checksum program"))))))
+
+(defun mh-md5sum-parser ()
+ "Parse md5sum output."
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
+ first-space last-slash)
+ (setq first-space (search-forward " " end t))
+ (goto-char end)
+ (setq last-slash (search-backward "/" begin t))
+ (cond ((and first-space last-slash)
+ (cons (car (read-from-string (buffer-substring-no-properties
+ (1+ last-slash) end)))
+ (buffer-substring-no-properties begin (1- first-space))))
+ (t (cons nil nil)))))
+
+(defun mh-openssl-parser ()
+ "Parse openssl output."
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
+ last-space last-slash)
+ (goto-char end)
+ (setq last-space (search-backward " " begin t))
+ (setq last-slash (search-backward "/" begin t))
+ (cond ((and last-slash last-space)
+ (cons (car (read-from-string (buffer-substring-no-properties
+ (1+ last-slash) (1- last-space))))
+ (buffer-substring-no-properties (1+ last-space) end))))))
+
+(defalias 'mh-md5-parser 'mh-openssl-parser)
+
+\f
+
+;;; Make sure that we don't produce too long a command line.
+
+(defvar mh-index-max-cmdline-args 500
+ "Maximum number of command line args.")
+
+(defun mh-index-execute (cmd &rest args)
+ "Partial imitation of xargs.
+The current buffer contains a list of strings, one on each line. The function
+will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
+strings to it. This is repeated till all the strings have been used."
+ (goto-char (point-min))
+ (let ((out (get-buffer-create " *mh-xargs-output*")))
+ (save-excursion
+ (set-buffer out)
+ (erase-buffer))
+ (while (not (eobp))
+ (let ((arg-list (reverse args))
+ (count 0))
+ (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
+ (push (buffer-substring-no-properties (point) (line-end-position))
+ arg-list)
+ (incf count)
+ (forward-line))
+ (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
+ (erase-buffer)
+ (insert-buffer-substring out)))
+
+\f
+
+(defun mh-index-update-single-msg (msg checksum origin-map)
+ "Update various maps for one message.
+MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
+non-nil, a hashtable containing which maps each message in the index folder to
+the folder and message that it was copied from. The function updates the hash
+tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
+
+This function should only be called in the appropriate index folder buffer."
+ (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
+ (let* ((intermediate (gethash msg origin-map))
+ (ofolder (car intermediate))
+ (omsg (cdr intermediate)))
+ ;; This is most probably a duplicate. So eliminate it.
+ (call-process "rm" nil nil nil
+ (format "%s%s/%s" mh-user-path
+ (substring mh-current-folder 1) msg))
+ (remhash omsg (gethash ofolder mh-index-data))))
+ (t
+ (setf (gethash msg mh-index-msg-checksum-map) checksum)
+ (when origin-map
+ (setf (gethash checksum mh-index-checksum-origin-map)
+ (gethash msg origin-map))))))
+
+;;;###mh-autoload
+(defun mh-index-update-maps (folder &optional origin-map)
+ "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
+As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
+is a hashtable which maps each message in the index folder to the original
+folder and message from whence it was copied. If present the
+checksum -> (origin-folder, origin-index) map is updated too."
+ (clrhash mh-index-msg-checksum-map)
+ (save-excursion
+ ;; Clear temp buffer
+ (set-buffer (get-buffer-create mh-checksum-buffer))
+ (erase-buffer)
+ ;; Run scan to check if any messages needs MD5 annotations at all
+ (with-temp-buffer
+ (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
+ "-format" "%(msg)\n%{x-mhe-checksum}\n"
+ folder "all")
+ (goto-char (point-min))
+ (let (msg checksum)
+ (while (not (eobp))
+ (setq msg (buffer-substring-no-properties
+ (point) (line-end-position)))
+ (forward-line)
+ (save-excursion
+ (cond ((eolp)
+ ;; need to compute checksum
+ (set-buffer mh-checksum-buffer)
+ (insert mh-user-path (substring folder 1) "/" msg "\n"))
+ (t
+ ;; update maps
+ (setq checksum (buffer-substring-no-properties
+ (point) (line-end-position)))
+ (let ((msg (car (read-from-string msg))))
+ (set-buffer folder)
+ (mh-index-update-single-msg msg checksum origin-map)))))
+ (forward-line))))
+ ;; Run checksum program if needed
+ (unless (and (eobp) (bobp))
+ (apply #'mh-index-execute mh-checksum-cmd)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((intermediate (funcall mh-checksum-parser))
+ (msg (car intermediate))
+ (checksum (cdr intermediate)))
+ (when msg
+ ;; annotate
+ (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
+ "-nodate" "-text" checksum "-inplace")
+ ;; update maps
+ (save-excursion
+ (set-buffer folder)
+ (mh-index-update-single-msg msg checksum origin-map)))
+ (forward-line))))))
+
+(defun mh-index-generate-pretty-name (string)
+ "Given STRING generate a name which is suitable for use as a folder name.
+White space from the beginning and end are removed. All spaces in the name are
+replaced with underscores and all / are replaced with $. If STRING is longer
+than 20 it is truncated too."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r)))
+ (delete-char 1))
+ (goto-char (point-max))
+ (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r)))
+ (delete-backward-char 1))
+ (subst-char-in-region (point-min) (point-max) ? ?_ t)
+ (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
+ (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
+ (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
+ (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
+ (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
+
+;;;###mh-autoload
+(defun mh-index-search (redo-search-flag folder search-regexp)
+ "Perform an indexed search in an MH mail folder.
+
+If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
+index search, then the search is repeated. Otherwise, FOLDER is searched with
+SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
+\"+\" then mail in all folders are searched.
+
+Four indexing programs are supported; if none of these are present, then grep
+is used. This function picks the first program that is available on your
+system. If you would prefer to use a different program, set the customization
+variable `mh-index-program' accordingly.
+
+The documentation for the following functions describes how to generate the
+index for each program:
+
+ - `mh-swish++-execute-search'
+ - `mh-swish-execute-search'
+ - `mh-namazu-execute-search'
+ - `mh-glimpse-execute-search'
+
+This and related functions use an X-MHE-Checksum header to cache the MD5
+checksum of a message. This means that already present X-MHE-Checksum headers
+in the incoming email could result in messages not being found. The following
+procmail recipe should avoid this:
+
+ :0 wf
+ | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
+
+This has the effect of renaming already present X-MHE-Checksum headers."
+ (interactive
+ (list current-prefix-arg
+ (progn
+ (unless mh-find-path-run (mh-find-path))
+ (or (and current-prefix-arg (car mh-index-previous-search))
+ (mh-prompt-for-folder "Search" "+" nil "all")))
+ (progn
+ ;; Yes, we do want to call mh-index-choose every time in case the
+ ;; user has switched the indexer manually.
+ (unless (mh-index-choose) (error "No indexing program found"))
+ (or (and current-prefix-arg (cadr mh-index-previous-search))
+ (read-string (format "%s regexp: "
+ (upcase-initials
+ (symbol-name mh-indexer))))))))
+ (mh-checksum-choose)
+ (let ((result-count 0)
+ (old-window-config mh-previous-window-config)
+ (previous-search mh-index-previous-search)
+ (index-folder (format "%s/%s" mh-index-folder
+ (mh-index-generate-pretty-name search-regexp))))
+ ;; Create a new folder for the search results or recreate the old one...
+ (if (and redo-search-flag mh-index-previous-search)
+ (let ((buffer-name (buffer-name (current-buffer))))
+ (mh-process-or-undo-commands buffer-name)
+ (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
+ (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
+ (setq index-folder buffer-name))
+ (setq index-folder (mh-index-new-folder index-folder)))
+
+ (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
+ (folder-results-map (make-hash-table :test #'equal))
+ (origin-map (make-hash-table :test #'equal)))
+ ;; Run search program...
+ (message "Executing %s... " mh-indexer)
+ (funcall mh-index-execute-search-function folder-path search-regexp)
+
+ ;; Parse indexer output
+ (message "Processing %s output... " mh-indexer)
+ (goto-char (point-min))
+ (loop for next-result = (funcall mh-index-next-result-function)
+ when (null next-result) return nil
+ do (unless (eq next-result 'error)
+ (unless (gethash (car next-result) folder-results-map)
+ (setf (gethash (car next-result) folder-results-map)
+ (make-hash-table :test #'equal)))
+ (setf (gethash (cadr next-result)
+ (gethash (car next-result) folder-results-map))
+ t)))
+
+ ;; Copy the search results over
+ (maphash #'(lambda (folder msgs)
+ (let ((msgs (sort (loop for msg being the hash-keys of msgs
+ collect msg)
+ #'<)))
+ (mh-exec-cmd "refile" msgs "-src" folder
+ "-link" index-folder)
+ (loop for msg in msgs
+ do (incf result-count)
+ (setf (gethash result-count origin-map)
+ (cons folder msg)))))
+ folder-results-map)
+
+ ;; Generate scan lines for the hits.
+ (let ((mh-show-threads-flag nil))
+ (mh-visit-folder index-folder () (list folder-results-map origin-map)))
+
+ (goto-char (point-min))
+ (forward-line)
+ (mh-update-sequences)
+ (mh-recenter nil)
+
+ ;; Maintain history
+ (when (and redo-search-flag previous-search)
+ (setq mh-previous-window-config old-window-config))
+ (setq mh-index-previous-search (list folder search-regexp))
+
+ (message "%s found %s matches in %s folders"
+ (upcase-initials (symbol-name mh-indexer))
+ (loop for msg-hash being hash-values of mh-index-data
+ sum (hash-table-count msg-hash))
+ (loop for msg-hash being hash-values of mh-index-data
+ count (> (hash-table-count msg-hash) 0))))))
+
+;;;###mh-autoload
+(defun mh-index-next-folder (&optional backward-flag)
+ "Jump to the next folder marker.
+The function is only applicable to folders displaying index search results.
+With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
+results."
+ (interactive "P")
+ (if (or (null mh-index-data)
+ (memq 'unthread mh-view-ops))
+ (message "Only applicable in an unthreaded MH-E index search buffer")
+ (let ((point (point)))
+ (forward-line (if backward-flag -1 1))
+ (cond ((if backward-flag
+ (re-search-backward "^+" (point-min) t)
+ (re-search-forward "^+" (point-max) t))
+ (beginning-of-line))
+ ((and (if backward-flag
+ (goto-char (point-max))
+ (goto-char (point-min)))
+ nil))
+ ((if backward-flag
+ (re-search-backward "^+" (point-min) t)
+ (re-search-forward "^+" (point-max) t))
+ (beginning-of-line))
+ (t (goto-char point))))))
+
+;;;###mh-autoload
+(defun mh-index-previous-folder ()
+ "Jump to the previous folder marker."
+ (interactive)
+ (mh-index-next-folder t))
+
+(defun mh-folder-exists-p (folder)
+ "Check if FOLDER exists."
+ (and (mh-folder-name-p folder)
+ (save-excursion
+ (with-temp-buffer
+ (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
+ (goto-char (point-min))
+ (not (eobp))))))
+
+(defun mh-msg-exists-p (msg folder)
+ "Check if MSG exists in FOLDER."
+ (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
+
+(defun mh-index-new-folder (name)
+ "Create and return an MH folder name based on NAME.
+If the folder NAME already exists then check if NAME<2> exists. If it doesn't
+then it is created and returned. Otherwise try NAME<3>. This is repeated till
+we find a new folder name."
+ (unless (mh-folder-name-p name)
+ (error "The argument should be a valid MH folder name"))
+ (let ((chosen-name name))
+ (block unique-name
+ (unless (mh-folder-exists-p name)
+ (return-from unique-name))
+ (loop for index from 2
+ do (let ((new-name (format "%s<%s>" name index)))
+ (unless (mh-folder-exists-p new-name)
+ (setq chosen-name new-name)
+ (return-from unique-name)))))
+ (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
+ (when (boundp 'mh-speed-folder-map)
+ (mh-speed-add-folder chosen-name))
+ (push (list chosen-name) mh-folder-list)
+ chosen-name))
+
+;;;###mh-autoload
+(defun mh-index-insert-folder-headers ()
+ "Annotate the search results with original folder names."
+ (let ((cur-msg (mh-get-msg-num nil))
+ (old-buffer-modified-flag (buffer-modified-p))
+ (buffer-read-only nil)
+ current-folder last-folder)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
+ mh-index-msg-checksum-map)
+ mh-index-checksum-origin-map)))
+ (when (and current-folder (not (eq current-folder last-folder)))
+ (insert (if last-folder "\n" "") current-folder "\n")
+ (setq last-folder current-folder))
+ (forward-line))
+ (when cur-msg (mh-goto-msg cur-msg t))
+ (set-buffer-modified-p old-buffer-modified-flag)))
+
+;;;###mh-autoload
+(defun mh-index-delete-folder-headers ()
+ "Delete the folder headers."
+ (let ((cur-msg (mh-get-msg-num nil))
+ (old-buffer-modified-flag (buffer-modified-p))
+ (buffer-read-only nil))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
+ (delete-region (point) (progn (forward-line) (point)))
+ (forward-line)))
+ (when cur-msg (mh-goto-msg cur-msg t t))
+ (set-buffer-modified-p old-buffer-modified-flag)))
+
+;;;###mh-autoload
+(defun mh-index-visit-folder ()
+ "Visit original folder from where the message at point was found."
+ (interactive)
+ (unless mh-index-data
+ (error "Not in an index folder"))
+ (let (folder msg)
+ (save-excursion
+ (cond ((and (bolp) (eolp))
+ (ignore-errors (forward-line -1))
+ (setq msg (mh-get-msg-num t)))
+ ((equal (char-after (line-beginning-position)) ?+)
+ (setq folder (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))))
+ (t (setq msg (mh-get-msg-num t)))))
+ (when (not folder)
+ (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
+ mh-index-checksum-origin-map))))
+ (mh-visit-folder
+ folder (loop for x being the hash-keys of (gethash folder mh-index-data)
+ when (mh-msg-exists-p x folder) collect x))))
+
+(defun mh-index-match-checksum (msg folder checksum)
+ "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
+ (with-temp-buffer
+ (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
+ "-format" "%{x-mhe-checksum}\n" folder msg)
+ (goto-char (point-min))
+ (string-equal (buffer-substring-no-properties (point) (line-end-position))
+ checksum)))
+
+;;;###mh-autoload
+(defun mh-index-execute-commands ()
+ "Delete/refile the actual messages.
+The copies in the searched folder are then deleted/refiled to get the desired
+result. Before deleting the messages we make sure that the message being
+deleted is identical to the one that the user has marked in the index buffer."
+ (let ((message-table (make-hash-table :test #'equal)))
+ (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
+ (dolist (msg msg-list)
+ (let* ((checksum (gethash msg mh-index-msg-checksum-map))
+ (pair (gethash checksum mh-index-checksum-origin-map)))
+ (when (and checksum (car pair) (cdr pair)
+ (mh-index-match-checksum (cdr pair) (car pair) checksum))
+ (push (cdr pair) (gethash (car pair) message-table))
+ (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
+ (maphash (lambda (folder msgs)
+ (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
+ message-table)))
+
+\f
+
+;; Glimpse interface
+
+(defvar mh-glimpse-binary (executable-find "glimpse"))
+(defvar mh-glimpse-directory ".glimpse")
+
+;;;###mh-autoload
+(defun mh-glimpse-execute-search (folder-path search-regexp)
+ "Execute glimpse and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.glimpse. Then create the file
+/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
+
+ */.*
+ */#*
+ */,*
+ */*~
+ ^/home/user/Mail/.glimpse
+ ^/home/user/Mail/mhe-index
+
+If there are any directories you would like to ignore, append lines like the
+following to .glimpse_exclude:
+
+ ^/home/user/Mail/scripts
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The configuration file above assumes that the results are found in sub-folders
+of `mh-index-folder' which is +mhe-index by default.
+
+Use the following command line to generate the glimpse index. Run this
+daily from cron:
+
+ glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (call-process mh-glimpse-binary nil '(t nil) nil
+ ;(format "-%s" fuzz)
+ "-i" "-y"
+ "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
+ "-F" (format "^%s" folder-path)
+ search-regexp)
+ (goto-char (point-min)))
+
+(defun mh-glimpse-next-result ()
+ "Read the next result.
+Parse it and return the message folder, message index and the match. If no
+other matches left then return nil. If the current record is invalid return
+'error."
+ (prog1
+ (block nil
+ (when (eobp)
+ (return nil))
+ (let ((eol-pos (line-end-position))
+ (bol-pos (line-beginning-position))
+ folder-start msg-end)
+ (goto-char bol-pos)
+ (unless (search-forward mh-user-path eol-pos t)
+ (return 'error))
+ (setq folder-start (point))
+ (unless (search-forward ": " eol-pos t)
+ (return 'error))
+ (let ((match (buffer-substring-no-properties (point) eol-pos)))
+ (forward-char -2)
+ (setq msg-end (point))
+ (unless (search-backward "/" folder-start t)
+ (return 'error))
+ (list (format "+%s" (buffer-substring-no-properties
+ folder-start (point)))
+ (let ((val (ignore-errors (read-from-string
+ (buffer-substring-no-properties
+ (1+ (point)) msg-end)))))
+ (if (and (consp val) (integerp (car val)))
+ (car val)
+ (return 'error)))
+ match))))
+ (forward-line)))
+
+\f
+
+;; Grep interface
+
+(defvar mh-grep-binary (executable-find "grep"))
+
+(defun mh-grep-execute-search (folder-path search-regexp)
+ "Execute grep and read the results.
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (call-process mh-grep-binary nil '(t nil) nil
+ "-i" "-r" search-regexp folder-path)
+ (goto-char (point-min)))
+
+(defun mh-grep-next-result ()
+ "Read the next result.
+Parse it and return the message folder, message index and the match. If no
+other matches left then return nil. If the current record is invalid return
+'error."
+ (prog1
+ (block nil
+ (when (eobp)
+ (return nil))
+ (let ((eol-pos (line-end-position))
+ (bol-pos (line-beginning-position))
+ folder-start msg-end)
+ (goto-char bol-pos)
+ (unless (search-forward mh-user-path eol-pos t)
+ (return 'error))
+ (setq folder-start (point))
+ (unless (search-forward ":" eol-pos t)
+ (return 'error))
+ (let ((match (buffer-substring-no-properties (point) eol-pos)))
+ (forward-char -1)
+ (setq msg-end (point))
+ (unless (search-backward "/" folder-start t)
+ (return 'error))
+ (list (format "+%s" (buffer-substring-no-properties
+ folder-start (point)))
+ (let ((val (ignore-errors (read-from-string
+ (buffer-substring-no-properties
+ (1+ (point)) msg-end)))))
+ (if (and (consp val) (integerp (car val)))
+ (car val)
+ (return 'error)))
+ match))))
+ (forward-line)))
+
+\f
+
+;; Swish interface
+
+(defvar mh-swish-binary (executable-find "swish-e"))
+(defvar mh-swish-directory ".swish")
+(defvar mh-swish-folder nil)
+
+;;;###mh-autoload
+(defun mh-swish-execute-search (folder-path search-regexp)
+ "Execute swish-e and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.swish. Then create the file
+/home/user/Mail/.swish/config with the following contents:
+
+ IndexDir /home/user/Mail
+ IndexFile /home/user/Mail/.swish/index
+ IndexName \"Mail Index\"
+ IndexDescription \"Mail Index\"
+ IndexPointer \"http://nowhere\"
+ IndexAdmin \"nobody\"
+ #MetaNames automatic
+ IndexReport 3
+ FollowSymLinks no
+ UseStemming no
+ IgnoreTotalWordCountWhenRanking yes
+ WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
+ BeginCharacters abcdefghijklmnopqrstuvwxyz
+ EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
+ IgnoreLimit 50 1000
+ IndexComments 0
+ FileRules pathname contains /home/user/Mail/.swish
+ FileRules pathname contains /home/user/Mail/mhe-index
+ FileRules filename is index
+ FileRules filename is \..*
+ FileRules filename is #.*
+ FileRules filename is ,.*
+ FileRules filename is .*~
+
+If there are any directories you would like to ignore, append lines like the
+following to config:
+
+ FileRules pathname contains /home/user/Mail/scripts
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The configuration file above assumes that the results are found in sub-folders
+of `mh-index-folder' which is +mhe-index by default.
+
+Use the following command line to generate the swish index. Run this
+daily from cron:
+
+ swish-e -c /home/user/Mail/.swish/config
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (unless mh-swish-binary
+ (error "Set mh-swish-binary appropriately"))
+ (call-process mh-swish-binary nil '(t nil) nil
+ "-w" search-regexp
+ "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
+ (goto-char (point-min))
+ (setq mh-swish-folder
+ (let ((last-char (substring folder-path (1- (length folder-path)))))
+ (if (equal last-char "/")
+ folder-path
+ (format "%s/" folder-path)))))
+
+(defun mh-swish-next-result ()
+ "Get the next result from swish output."
+ (prog1
+ (block nil
+ (when (or (eobp) (equal (char-after (point)) ?.))
+ (return nil))
+ (when (equal (char-after (point)) ?#)
+ (return 'error))
+ (let* ((start (search-forward " " (line-end-position) t))
+ (end (search-forward " " (line-end-position) t)))
+ (unless (and start end)
+ (return 'error))
+ (setq end (1- end))
+ (unless (file-exists-p (buffer-substring-no-properties start end))
+ (return 'error))
+ (unless (search-backward "/" start t)
+ (return 'error))
+ (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
+ (unless (string-match mh-swish-folder s)
+ (return 'error))
+ (if (string-match mh-user-path s)
+ (format "+%s"
+ (substring s (match-end 0) (1- (length s))))
+ (return 'error)))
+ (let* ((s (buffer-substring-no-properties (1+ (point)) end))
+ (val (ignore-errors (read-from-string s))))
+ (if (and (consp val) (numberp (car val)))
+ (car val)
+ (return 'error)))
+ nil)))
+ (forward-line)))
+
+\f
+
+;; Swish++ interface
+
+(defvar mh-swish++-binary (or (executable-find "search++")
+ (executable-find "search")))
+(defvar mh-swish++-directory ".swish++")
+
+;;;###mh-autoload
+(defun mh-swish++-execute-search (folder-path search-regexp)
+ "Execute swish++ and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.swish++. Then create the file
+/home/user/Mail/.swish++/swish++.conf with the following contents:
+
+ IncludeMeta Bcc Cc Comments Content-Description From Keywords
+ IncludeMeta Newsgroups Resent-To Subject To
+ IncludeMeta Message-Id References In-Reply-To
+ IncludeFile Mail *
+ IndexFile /home/user/Mail/.swish++/swish++.index
+
+Use the following command line to generate the swish index. Run this
+daily from cron:
+
+ find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
+ -o -path /home/user/Mail/.swish++ -prune \\
+ -o -name \"[0-9]*\" -print \\
+ | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The command above assumes that the results are found in sub-folders of
+`mh-index-folder' which is +mhe-index by default.
+
+On some systems (Debian GNU/Linux, for example), use index++ instead of index.
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (unless mh-swish++-binary
+ (error "Set mh-swish++-binary appropriately"))
+ (call-process mh-swish++-binary nil '(t nil) nil
+ "-m" "10000"
+ (format "-i%s%s/swish++.index"
+ mh-user-path mh-swish++-directory)
+ search-regexp)
+ (goto-char (point-min))
+ (setq mh-swish-folder
+ (let ((last-char (substring folder-path (1- (length folder-path)))))
+ (if (equal last-char "/")
+ folder-path
+ (format "%s/" folder-path)))))
+
+(defalias 'mh-swish++-next-result 'mh-swish-next-result)
+
+\f
+
+;; Namazu interface
+
+(defvar mh-namazu-binary (executable-find "namazu"))
+(defvar mh-namazu-directory ".namazu")
+(defvar mh-namazu-folder nil)
+
+;;;###mh-autoload
+(defun mh-namazu-execute-search (folder-path search-regexp)
+ "Execute namazu and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.namazu. Then create the file
+/home/user/Mail/.namazu/mknmzrc with the following contents:
+
+ package conf; # Don't remove this line!
+ $ADDRESS = 'user@localhost';
+ $ALLOW_FILE = \"[0-9]*\";
+ $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
+
+In the above example configuration, none of the mail files contained in the
+directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The configuration file above assumes that the results are found in sub-folders
+of `mh-index-folder' which is +mhe-index by default.
+
+Use the following command line to generate the namazu index. Run this
+daily from cron:
+
+ mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
+ /home/user/Mail
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (let ((namazu-index-directory
+ (format "%s%s" mh-user-path mh-namazu-directory)))
+ (unless (file-exists-p namazu-index-directory)
+ (error "Namazu directory %s not present" namazu-index-directory))
+ (unless (executable-find mh-namazu-binary)
+ (error "Set mh-namazu-binary appropriately"))
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (call-process mh-namazu-binary nil '(t nil) nil
+ "-alR" search-regexp namazu-index-directory)
+ (goto-char (point-min))
+ (setq mh-namazu-folder
+ (let ((last (substring folder-path (1- (length folder-path)))))
+ (if (equal last "/")
+ folder-path
+ (format "%s/" folder-path))))))
+
+(defun mh-namazu-next-result ()
+ "Get the next result from namazu output."
+ (prog1
+ (block nil
+ (when (eobp) (return nil))
+ (let ((file-name (buffer-substring-no-properties
+ (point) (line-end-position))))
+ (unless (equal (string-match mh-namazu-folder file-name) 0)
+ (return 'error))
+ (unless (file-exists-p file-name)
+ (return 'error))
+ (string-match mh-user-path file-name)
+ (let* ((folder/msg (substring file-name (match-end 0)))
+ (mark (mh-search-from-end ?/ folder/msg)))
+ (unless mark (return 'error))
+ (list (format "+%s" (substring folder/msg 0 mark))
+ (let ((n (ignore-errors (read-from-string
+ (substring folder/msg (1+ mark))))))
+ (if (and (consp n) (numberp (car n)))
+ (car n)
+ (return 'error)))
+ nil))))
+ (forward-line)))
+
+\f
+
+(defun mh-index-choose ()
+ "Choose an indexing function.
+The side-effects of this function are that the variables `mh-indexer',
+`mh-index-execute-search-function', and `mh-index-next-result-function' are
+set according to the first indexer in `mh-indexer-choices' present on the
+system."
+ (block nil
+ ;; The following favors the user's preference; otherwise, the last
+ ;; automatically chosen indexer is used for efficiency rather than going
+ ;; through the list.
+ (let ((program-alist (cond (mh-index-program
+ (list
+ (assoc mh-index-program mh-indexer-choices)))
+ (mh-indexer
+ (list (assoc mh-indexer mh-indexer-choices)))
+ (t mh-indexer-choices))))
+ (while program-alist
+ (let* ((current (pop program-alist))
+ (executable (symbol-value (cadr current))))
+ (when executable
+ (setq mh-indexer (car current))
+ (setq mh-index-execute-search-function (caddr current))
+ (setq mh-index-next-result-function (cadddr current))
+ (return mh-indexer))))
+ nil)))
+
+\f
+
+(provide 'mh-index)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-index ends here
--- /dev/null
+;;; mh-loaddefs.el --- automatically extracted autoloads
+;;
+;;; Commentary:
+;;; Code:
+\f
+;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
+;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom
+;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
+;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
+;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
+;;;;;; (15899 19356))
+;;; Generated autoloads from mh-comp.el
+
+(autoload (quote mh-edit-again) "mh-comp" "\
+Clean up a draft or a message MSG previously sent and make it resendable.
+Default is the current message.
+The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
+See also documentation for `\\[mh-send]' function." t nil)
+
+(autoload (quote mh-extract-rejected-mail) "mh-comp" "\
+Extract message MSG returned by the mail system and make it resendable.
+Default is the current message. The variable `mh-new-draft-cleaned-headers'
+gives the headers to clean out of the original message.
+See also documentation for `\\[mh-send]' function." t nil)
+
+(autoload (quote mh-forward) "mh-comp" "\
+Forward one or more messages to the recipients TO and CC.
+
+Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
+
+Default is the displayed message. If optional prefix argument is given then
+prompt for the message sequence. If variable `transient-mark-mode' is non-nil
+and the mark is active, then the selected region is forwarded.
+See also documentation for `\\[mh-send]' function." t nil)
+
+(autoload (quote mh-redistribute) "mh-comp" "\
+Redistribute displayed message to recipients TO and CC.
+Use optional argument MSG to redistribute another message.
+Depending on how your copy of MH was compiled, you may need to change the
+setting of the variable `mh-redist-full-contents'. See its documentation." t nil)
+
+(autoload (quote mh-reply) "mh-comp" "\
+Reply to MESSAGE (default: current message).
+If the optional argument REPLY-TO is not given, prompts for type of addresses
+to reply to:
+ from sender only,
+ to sender and primary recipients,
+ cc/all sender and all recipients.
+If optional prefix argument INCLUDEP provided, then include the message
+in the reply using filter `mhl.reply' in your MH directory.
+If the file named by `mh-repl-formfile' exists, it is used as a skeleton
+for the reply. See also documentation for `\\[mh-send]' function." t nil)
+
+(autoload (quote mh-send) "mh-comp" "\
+Compose and send a letter.
+
+Do not call this function from outside MH-E; use \\[mh-smail] instead.
+
+The file named by `mh-comp-formfile' will be used as the form.
+The letter is composed in `mh-letter-mode'; see its documentation for more
+details.
+If `mh-compose-letter-function' is defined, it is called on the draft and
+passed three arguments: TO, CC, and SUBJECT." t nil)
+
+(autoload (quote mh-send-other-window) "mh-comp" "\
+Compose and send a letter in another window.
+
+Do not call this function from outside MH-E; use \\[mh-smail-other-window]
+instead.
+
+The file named by `mh-comp-formfile' will be used as the form.
+The letter is composed in `mh-letter-mode'; see its documentation for more
+details.
+If `mh-compose-letter-function' is defined, it is called on the draft and
+passed three arguments: TO, CC, and SUBJECT." t nil)
+
+(autoload (quote mh-fill-paragraph-function) "mh-comp" "\
+Fill paragraph at or after point.
+Prefix ARG means justify as well. This function enables `fill-paragraph' to
+work better in MH-Letter mode." t nil)
+
+(autoload (quote mh-to-field) "mh-comp" "\
+Move point to the end of a specified header field.
+The field is indicated by the previous keystroke (the last keystroke
+of the command) according to the list in the variable `mh-to-field-choices'.
+Create the field if it does not exist. Set the mark to point before moving." t nil)
+
+(autoload (quote mh-to-fcc) "mh-comp" "\
+Insert an Fcc: FOLDER field in the current message.
+Prompt for the field name with a completion list of the current folders." t nil)
+
+(autoload (quote mh-insert-signature) "mh-comp" "\
+Insert the file named by `mh-signature-file-name' at point.
+The value of `mh-letter-insert-signature-hook' is a list of functions to be
+called, with no arguments, before the signature is actually inserted." t nil)
+
+(autoload (quote mh-check-whom) "mh-comp" "\
+Verify recipients of the current letter, showing expansion of any aliases." t nil)
+
+(autoload (quote mh-send-letter) "mh-comp" "\
+Send the draft letter in the current buffer.
+If optional prefix argument ARG is provided, monitor delivery.
+The value of `mh-before-send-letter-hook' is a list of functions to be called,
+with no arguments, before doing anything.
+Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
+Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
+Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
+Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil)
+
+(autoload (quote mh-insert-letter) "mh-comp" "\
+Insert a message into the current letter.
+Removes the header fields according to the variable `mh-invisible-headers'.
+Prefixes each non-blank line with `mh-ins-buf-prefix', unless
+`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
+used to format the message.
+Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
+not indent and do not delete headers. Leaves the mark before the letter
+and point after it." t nil)
+
+(autoload (quote mh-yank-cur-msg) "mh-comp" "\
+Insert the current message into the draft buffer.
+Prefix each non-blank line in the message with the string in
+`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
+only the region will be inserted. Otherwise, the entire message will
+be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
+is nil, the portion of the message following the point will be yanked.
+If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
+yanked message will be deleted." t nil)
+
+(autoload (quote mh-fully-kill-draft) "mh-comp" "\
+Kill the draft message file and the draft message buffer.
+Use \\[kill-buffer] if you don't want to delete the draft message file." t nil)
+
+(autoload (quote mh-open-line) "mh-comp" "\
+Insert a newline and leave point after it.
+In addition, insert newline and quoting characters before text after point.
+This is useful in breaking up paragraphs in replies." t nil)
+
+(autoload (quote mh-letter-complete) "mh-comp" "\
+Perform completion on header field or word preceding point.
+Alias completion is done within the mail header on selected fields and
+by the function designated by `mh-letter-complete-function' elsewhere,
+passing the prefix ARG if any." t nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set
+;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15899 29873))
+;;; Generated autoloads from mh-customize.el
+
+(autoload (quote mh-customize) "mh-customize" "\
+Customize MH-E variables." t nil)
+
+(autoload (quote mh-tool-bar-letter-set) "mh-customize" "\
+Construct toolbar for `mh-letter-mode'." nil nil)
+
+(autoload (quote mh-tool-bar-folder-set) "mh-customize" "\
+Construct toolbar for `mh-folder-mode'." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
+;;;;;; "mh-e" "mh-e.el" (15899 29921))
+;;; Generated autoloads from mh-e.el
+
+(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
+Return t if the message under point in folder-mode is in the show buffer.
+Return nil in any other circumstance (no message under point, no show buffer,
+the message in the show buffer doesn't match." nil nil)
+
+(autoload (quote mh-update-sequences) "mh-e" "\
+Update MH's Unseen-Sequence and current folder and message.
+Flush MH-E's state out to MH. The message at the cursor becomes current." t nil)
+
+(autoload (quote mh-goto-cur-msg) "mh-e" "\
+Position the cursor at the current message.
+When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
+recenter the folder buffer." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-prefix-help mh-help mh-store-buffer mh-store-msg
+;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
+;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
+;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
+;;;;;; (15886 19303))
+;;; Generated autoloads from mh-funcs.el
+
+(autoload (quote mh-burst-digest) "mh-funcs" "\
+Burst apart the current message, which should be a digest.
+The message is replaced by its table of contents and the messages from the
+digest are inserted into the folder after that message." t nil)
+
+(autoload (quote mh-copy-msg) "mh-funcs" "\
+Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
+Default is the displayed message. If optional prefix argument is provided,
+then prompt for the message sequence." t nil)
+
+(autoload (quote mh-kill-folder) "mh-funcs" "\
+Remove the current folder and all included messages.
+Removes all of the messages (files) within the specified current folder,
+and then removes the folder (directory) itself.
+The value of `mh-folder-list-change-hook' is a list of functions to be called,
+with no arguments, after the folders has been removed." t nil)
+
+(autoload (quote mh-list-folders) "mh-funcs" "\
+List mail folders." t nil)
+
+(autoload (quote mh-pack-folder) "mh-funcs" "\
+Renumber the messages of a folder to be 1..n.
+First, offer to execute any outstanding commands for the current folder. If
+optional prefix argument provided, prompt for the RANGE of messages to display
+after packing. Otherwise, show the entire folder." t nil)
+
+(autoload (quote mh-pipe-msg) "mh-funcs" "\
+Pipe the current message through the given shell COMMAND.
+If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
+Otherwise just send the message's body without the headers." t nil)
+
+(autoload (quote mh-page-digest) "mh-funcs" "\
+Advance displayed message to next digested message." t nil)
+
+(autoload (quote mh-page-digest-backwards) "mh-funcs" "\
+Back up displayed message to previous digested message." t nil)
+
+(autoload (quote mh-print-msg) "mh-funcs" "\
+Print MSG-OR-SEQ (default: displayed message) on printer.
+If optional prefix argument provided, then prompt for the message sequence.
+The variable `mh-lpr-command-format' is used to generate the print command.
+The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
+
+(autoload (quote mh-sort-folder) "mh-funcs" "\
+Sort the messages in the current folder by date.
+Calls the MH program sortm to do the work.
+The arguments in the list `mh-sortm-args' are passed to sortm if the optional
+argument EXTRA-ARGS is given." t nil)
+
+(autoload (quote mh-undo-folder) "mh-funcs" "\
+Undo all pending deletes and refiles in current folder.
+Argument IGNORE is deprecated." t nil)
+
+(autoload (quote mh-store-msg) "mh-funcs" "\
+Store the file(s) contained in the current message into DIRECTORY.
+The message can contain a shar file or uuencoded file.
+Default directory is the last directory used, or initially the value of
+`mh-store-default-directory' or the current directory." t nil)
+
+(autoload (quote mh-store-buffer) "mh-funcs" "\
+Store the file(s) contained in the current buffer into DIRECTORY.
+The buffer can contain a shar file or uuencoded file.
+Default directory is the last directory used, or initially the value of
+`mh-store-default-directory' or the current directory." t nil)
+
+(autoload (quote mh-help) "mh-funcs" "\
+Display cheat sheet for the MH-Folder commands in minibuffer." t nil)
+
+(autoload (quote mh-prefix-help) "mh-funcs" "\
+Display cheat sheet for the commands of the current prefix in minibuffer." t nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
+;;;;;; "mh-identity" "mh-identity.el" (15852 60439))
+;;; Generated autoloads from mh-identity.el
+
+(autoload (quote mh-identity-make-menu) "mh-identity" "\
+Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil)
+
+(autoload (quote mh-identity-list-set) "mh-identity" "\
+Update the `mh-identity-list' variable, and rebuild the menu.
+Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
+customization). This is called after 'customize is used to alter
+`mh-identity-list'." nil nil)
+
+(autoload (quote mh-insert-identity) "mh-identity" "\
+Insert proper fields for given IDENTITY.
+Edit the `mh-identity-list' variable to define identity." t nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search
+;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands
+;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers
+;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-search
+;;;;;; mh-index-update-maps) "mh-index" "mh-index.el" (15899 19358))
+;;; Generated autoloads from mh-index.el
+
+(autoload (quote mh-index-update-maps) "mh-index" "\
+Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
+As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
+is a hashtable which maps each message in the index folder to the original
+folder and message from whence it was copied. If present the
+checksum -> (origin-folder, origin-index) map is updated too." nil nil)
+
+(autoload (quote mh-index-search) "mh-index" "\
+Perform an indexed search in an MH mail folder.
+
+If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
+index search, then the search is repeated. Otherwise, FOLDER is searched with
+SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
+\"+\" then mail in all folders are searched.
+
+Four indexing programs are supported; if none of these are present, then grep
+is used. This function picks the first program that is available on your
+system. If you would prefer to use a different program, set the customization
+variable `mh-index-program' accordingly.
+
+The documentation for the following functions describes how to generate the
+index for each program:
+
+ - `mh-swish++-execute-search'
+ - `mh-swish-execute-search'
+ - `mh-namazu-execute-search'
+ - `mh-glimpse-execute-search'
+
+This and related functions use an X-MHE-Checksum header to cache the MD5
+checksum of a message. This means that already present X-MHE-Checksum headers
+in the incoming email could result in messages not being found. The following
+procmail recipe should avoid this:
+
+ :0 wf
+ | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
+
+This has the effect of renaming already present X-MHE-Checksum headers." t nil)
+
+(autoload (quote mh-index-next-folder) "mh-index" "\
+Jump to the next folder marker.
+The function is only applicable to folders displaying index search results.
+With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
+results." t nil)
+
+(autoload (quote mh-index-previous-folder) "mh-index" "\
+Jump to the previous folder marker." t nil)
+
+(autoload (quote mh-index-insert-folder-headers) "mh-index" "\
+Annotate the search results with original folder names." nil nil)
+
+(autoload (quote mh-index-delete-folder-headers) "mh-index" "\
+Delete the folder headers." nil nil)
+
+(autoload (quote mh-index-visit-folder) "mh-index" "\
+Visit original folder from where the message at point was found." t nil)
+
+(autoload (quote mh-index-execute-commands) "mh-index" "\
+Delete/refile the actual messages.
+The copies in the searched folder are then deleted/refiled to get the desired
+result. Before deleting the messages we make sure that the message being
+deleted is identical to the one that the user has marked in the index buffer." nil nil)
+
+(autoload (quote mh-glimpse-execute-search) "mh-index" "\
+Execute glimpse and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.glimpse. Then create the file
+/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
+
+ */.*
+ */#*
+ */,*
+ */*~
+ ^/home/user/Mail/.glimpse
+ ^/home/user/Mail/mhe-index
+
+If there are any directories you would like to ignore, append lines like the
+following to .glimpse_exclude:
+
+ ^/home/user/Mail/scripts
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The configuration file above assumes that the results are found in sub-folders
+of `mh-index-folder' which is +mhe-index by default.
+
+Use the following command line to generate the glimpse index. Run this
+daily from cron:
+
+ glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
+
+(autoload (quote mh-swish-execute-search) "mh-index" "\
+Execute swish-e and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.swish. Then create the file
+/home/user/Mail/.swish/config with the following contents:
+
+ IndexDir /home/user/Mail
+ IndexFile /home/user/Mail/.swish/index
+ IndexName \"Mail Index\"
+ IndexDescription \"Mail Index\"
+ IndexPointer \"http://nowhere\"
+ IndexAdmin \"nobody\"
+ #MetaNames automatic
+ IndexReport 3
+ FollowSymLinks no
+ UseStemming no
+ IgnoreTotalWordCountWhenRanking yes
+ WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
+ BeginCharacters abcdefghijklmnopqrstuvwxyz
+ EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
+ IgnoreLimit 50 1000
+ IndexComments 0
+ FileRules pathname contains /home/user/Mail/.swish
+ FileRules pathname contains /home/user/Mail/mhe-index
+ FileRules filename is index
+ FileRules filename is ..*
+ FileRules filename is #.*
+ FileRules filename is ,.*
+ FileRules filename is .*~
+
+If there are any directories you would like to ignore, append lines like the
+following to config:
+
+ FileRules pathname contains /home/user/Mail/scripts
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The configuration file above assumes that the results are found in sub-folders
+of `mh-index-folder' which is +mhe-index by default.
+
+Use the following command line to generate the swish index. Run this
+daily from cron:
+
+ swish-e -c /home/user/Mail/.swish/config
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
+
+(autoload (quote mh-swish++-execute-search) "mh-index" "\
+Execute swish++ and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.swish++. Then create the file
+/home/user/Mail/.swish++/swish++.conf with the following contents:
+
+ IncludeMeta Bcc Cc Comments Content-Description From Keywords
+ IncludeMeta Newsgroups Resent-To Subject To
+ IncludeMeta Message-Id References In-Reply-To
+ IncludeFile Mail *
+ IndexFile /home/user/Mail/.swish++/swish++.index
+
+Use the following command line to generate the swish index. Run this
+daily from cron:
+
+ find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
+ -o -path /home/user/Mail/.swish++ -prune \\
+ -o -name \"[0-9]*\" -print \\
+ | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The command above assumes that the results are found in sub-folders of
+`mh-index-folder' which is +mhe-index by default.
+
+On some systems (Debian GNU/Linux, for example), use index++ instead of index.
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
+
+(autoload (quote mh-namazu-execute-search) "mh-index" "\
+Execute namazu and read the results.
+
+In the examples below, replace /home/user/Mail with the path to your MH
+directory.
+
+First create the directory /home/user/Mail/.namazu. Then create the file
+/home/user/Mail/.namazu/mknmzrc with the following contents:
+
+ package conf; # Don't remove this line!
+ $ADDRESS = 'user@localhost';
+ $ALLOW_FILE = \"[0-9]*\";
+ $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
+
+In the above example configuration, none of the mail files contained in the
+directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
+
+You do not want to index the folders that hold the results of your searches
+since they tend to be ephemeral and the original messages are indexed anyway.
+The configuration file above assumes that the results are found in sub-folders
+of `mh-index-folder' which is +mhe-index by default.
+
+Use the following command line to generate the namazu index. Run this
+daily from cron:
+
+ mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
+ /home/user/Mail
+
+FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
+;;;;;; mh-press-button mh-mime-display mh-mime-save-parts mh-display-emphasis
+;;;;;; mh-display-smileys mh-add-missing-mime-version-header mh-destroy-postponed-handles
+;;;;;; mh-mime-cleanup mh-mml-secure-message-encrypt-pgpmime mh-mml-secure-message-sign-pgpmime
+;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime
+;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
+;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
+;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15858 6046))
+;;; Generated autoloads from mh-mime.el
+
+(autoload (quote mh-compose-insertion) "mh-mime" "\
+Add a directive to insert a MIME part from a file, using mhn or gnus.
+If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
+If it is set to 'gnus, then that will be used instead.
+Optional argument INLINE means make it an inline attachment." t nil)
+
+(autoload (quote mh-compose-forward) "mh-mime" "\
+Add a MIME directive to forward a message, using mhn or gnus.
+If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
+If it is set to 'gnus, then that will be used instead.
+Optional argument DESCRIPTION is a description of the attachment.
+Optional argument FOLDER is the folder from which the forwarded message should
+come.
+Optional argument MESSAGE is the message to forward.
+If any of the optional arguments are absent, they are prompted for." t nil)
+
+(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\
+Add a directive to insert a MIME message part from a file.
+This is the typical way to insert non-text parts in a message.
+
+Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
+content type, DESCRIPTION, a line of text for the Content-Description field.
+ATTRIBUTES is a comma separated list of name=value pairs that is appended to
+the Content-Type field of the attachment.
+
+See also \\[mh-edit-mhn]." t nil)
+
+(autoload (quote mh-mhn-compose-anon-ftp) "mh-mime" "\
+Add a directive for a MIME anonymous ftp external body part.
+This directive tells MH to include a reference to a message/external-body part
+retrievable by anonymous FTP.
+
+Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
+MIME content type, and DESCRIPTION, a line of text for the Content-description
+header.
+
+See also \\[mh-edit-mhn]." t nil)
+
+(autoload (quote mh-mhn-compose-external-compressed-tar) "mh-mime" "\
+Add a directive to include a MIME reference to a compressed tar file.
+The file should be available via anonymous ftp. This directive tells MH to
+include a reference to a message/external-body part.
+
+Arguments are HOST and FILENAME, which tell where to find the file, and
+DESCRIPTION, a line of text for the Content-description header.
+
+See also \\[mh-edit-mhn]." t nil)
+
+(autoload (quote mh-mhn-compose-forw) "mh-mime" "\
+Add a forw directive to this message, to forward a message with MIME.
+This directive tells MH to include the named messages in this one.
+
+Arguments are DESCRIPTION, a line of text for the Content-description header,
+and FOLDER and MESSAGES, which name the message(s) to be forwarded.
+
+See also \\[mh-edit-mhn]." t nil)
+
+(autoload (quote mh-edit-mhn) "mh-mime" "\
+Format the current draft for MIME, expanding any mhn directives.
+
+Process the current draft with the mhn program, which, using directives
+already inserted in the draft, fills in all the MIME components and header
+fields.
+
+This step should be done last just before sending the message.
+
+The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
+list `mh-mhn-args' are passed to mhn if this function is passed an optional
+prefix argument EXTRA-ARGS.
+
+For assistance with creating mhn directives to insert various types of
+components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
+from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
+anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] (reference to
+compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
+message). If these helper functions are used, `mh-edit-mhn' is run
+automatically when the draft is sent.
+
+The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
+arguments, after performing the conversion.
+
+The mhn program is part of MH version 6.8 or later." t nil)
+
+(autoload (quote mh-revert-mhn-edit) "mh-mime" "\
+Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
+Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil)
+
+(autoload (quote mh-mml-to-mime) "mh-mime" "\
+Compose MIME message from mml directives." t nil)
+
+(autoload (quote mh-mml-forward-message) "mh-mime" "\
+Forward a message as attachment.
+The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
+number." nil nil)
+
+(autoload (quote mh-mml-attach-file) "mh-mime" "\
+Attach a file to the outgoing MIME message.
+The file is not inserted or encoded until you send the message with
+`\\[mh-send-letter]'.
+Message disposition is \"inline\" or \"attachment\" and is prompted for if
+DISPOSITION is nil.
+
+This is basically `mml-attach-file' from gnus, modified such that a prefix
+argument yields an `inline' disposition and Content-Type is determined
+automatically." nil nil)
+
+(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\
+Add directive to encrypt/sign the entire message." t nil)
+
+(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\
+Add directive to encrypt and sign the entire message.
+If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil)
+
+(autoload (quote mh-mime-cleanup) "mh-mime" "\
+Free the decoded MIME parts." nil nil)
+
+(autoload (quote mh-destroy-postponed-handles) "mh-mime" "\
+Free MIME data for externally displayed mime parts." nil nil)
+
+(autoload (quote mh-add-missing-mime-version-header) "mh-mime" "\
+Some mail programs don't put a MIME-Version header.
+I have seen this only in spam, so maybe we shouldn't fix this ;-)" nil nil)
+
+(autoload (quote mh-display-smileys) "mh-mime" "\
+Function to display smileys." nil nil)
+
+(autoload (quote mh-display-emphasis) "mh-mime" "\
+Function to display graphical emphasis." nil nil)
+
+(autoload (quote mh-mime-save-parts) "mh-mime" "\
+Store the MIME parts of the current message.
+If ARG, prompt for directory, else use that specified by the variable
+`mh-mime-save-parts-default-directory'. These directories may be superseded by
+mh_profile directives, since this function calls on mhstore or mhn to do the
+actual storing." t nil)
+
+(autoload (quote mh-mime-display) "mh-mime" "\
+Display (and possibly decode) MIME handles.
+Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
+present they are displayed otherwise the buffer is parsed and then
+displayed." nil nil)
+
+(autoload (quote mh-press-button) "mh-mime" "\
+Press MIME button.
+If the MIME part is visible then it is removed. Otherwise the part is
+displayed." t nil)
+
+(autoload (quote mh-push-button) "mh-mime" "\
+Click MIME button for EVENT.
+If the MIME part is visible then it is removed. Otherwise the part is
+displayed. This function is called when the mouse is used to click the MIME
+button." t nil)
+
+(autoload (quote mh-mime-save-part) "mh-mime" "\
+Save MIME part at point." t nil)
+
+(autoload (quote mh-mime-inline-part) "mh-mime" "\
+Toggle display of the raw MIME part." t nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-do-pick-search mh-search-folder) "mh-pick"
+;;;;;; "mh-pick.el" (15854 20166))
+;;; Generated autoloads from mh-pick.el
+
+(autoload (quote mh-search-folder) "mh-pick" "\
+Search FOLDER for messages matching a pattern.
+This function uses the MH command `pick' to do the work.
+Add the messages found to the sequence named `search'." t nil)
+
+(autoload (quote mh-do-pick-search) "mh-pick" "\
+Find messages that match the qualifications in the current pattern buffer.
+Messages are searched for in the folder named in `mh-searching-folder'.
+Add the messages found to the sequence named `search'." t nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor
+;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message
+;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
+;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list
+;;;;;; mh-add-to-sequence mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
+;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
+;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (15899
+;;;;;; 19358))
+;;; Generated autoloads from mh-seq.el
+
+(autoload (quote mh-delete-seq) "mh-seq" "\
+Delete the SEQUENCE." t nil)
+
+(autoload (quote mh-list-sequences) "mh-seq" "\
+List the sequences defined in the folder being visited." t nil)
+
+(autoload (quote mh-msg-is-in-seq) "mh-seq" "\
+Display the sequences that contain MESSAGE (default: current message)." t nil)
+
+(autoload (quote mh-narrow-to-seq) "mh-seq" "\
+Restrict display of this folder to just messages in SEQUENCE.
+Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
+
+(autoload (quote mh-put-msg-in-seq) "mh-seq" "\
+Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
+If optional prefix argument provided, then prompt for the message sequence.
+If variable `transient-mark-mode' is non-nil and the mark is active, then
+the selected region is added to the sequence." t nil)
+
+(autoload (quote mh-widen) "mh-seq" "\
+Remove restrictions from current folder, thereby showing all messages." t nil)
+
+(autoload (quote mh-rename-seq) "mh-seq" "\
+Rename SEQUENCE to have NEW-NAME." t nil)
+
+(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\
+Invoke the FUNC at each message in the SEQ.
+SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
+passed as arguments to FUNC." nil nil)
+
+(autoload (quote mh-notate-seq) "mh-seq" "\
+Mark the scan listing.
+All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
+the line." nil nil)
+
+(autoload (quote mh-add-to-sequence) "mh-seq" "\
+The sequence SEQ is augmented with the messages in MSGS." nil nil)
+
+(autoload (quote mh-region-to-msg-list) "mh-seq" "\
+Return a list of messages within the region between BEGIN and END." nil nil)
+
+(autoload (quote mh-narrow-to-subject) "mh-seq" "\
+Narrow to a sequence containing all following messages with same subject." t nil)
+
+(autoload (quote mh-delete-subject) "mh-seq" "\
+Mark all following messages with same subject to be deleted.
+This puts the messages in a sequence named subject. You can undo the last
+deletion marks using `mh-undo' with a prefix argument and then specifying the
+subject sequence." t nil)
+
+(autoload (quote mh-delete-subject-or-thread) "mh-seq" "\
+Mark messages for deletion intelligently.
+If the folder is threaded then `mh-thread-delete' is used to mark the current
+message and all its descendants for deletion. Otherwise `mh-delete-subject' is
+used to mark the current message and all messages following it with the same
+subject for deletion." t nil)
+
+(autoload (quote mh-thread-inc) "mh-seq" "\
+Update thread tree for FOLDER.
+All messages after START-POINT are added to the thread tree." nil nil)
+
+(autoload (quote mh-thread-add-spaces) "mh-seq" "\
+Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
+
+(autoload (quote mh-toggle-threads) "mh-seq" "\
+Toggle threaded view of folder.
+The conversion of normal view to threaded view is exact, that is the same
+messages are displayed in the folder buffer before and after threading. However
+the conversion from threaded view to normal view is inexact. So more messages
+than were originally present may be shown as a result." t nil)
+
+(autoload (quote mh-thread-forget-message) "mh-seq" "\
+Forget the message INDEX from the threading tables." nil nil)
+
+(autoload (quote mh-thread-next-sibling) "mh-seq" "\
+Jump to next sibling.
+With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." t nil)
+
+(autoload (quote mh-thread-previous-sibling) "mh-seq" "\
+Jump to previous sibling." t nil)
+
+(autoload (quote mh-thread-ancestor) "mh-seq" "\
+Jump to the ancestor of current message.
+If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
+thread tree the message belongs to." t nil)
+
+(autoload (quote mh-thread-delete) "mh-seq" "\
+Mark current message and all its children for subsequent deletion." t nil)
+
+(autoload (quote mh-thread-refile) "mh-seq" "\
+Mark current message and all its children for refiling to FOLDER." t nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
+;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
+;;;;;; "mh-speed" "mh-speed.el" (15899 19358))
+;;; Generated autoloads from mh-speed.el
+
+(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
+Interface function to create MH-E speedbar buffer.
+BUFFER is the MH-E buffer for which the speedbar buffer is to be created." nil nil)
+
+(defalias (quote mh-show-speedbar-buttons) (quote mh-folder-speedbar-buttons))
+
+(defalias (quote mh-letter-speedbar-buttons) (quote mh-folder-speedbar-buttons))
+
+(autoload (quote mh-speed-toggle) "mh-speed" "\
+Toggle the display of child folders.
+The otional ARGS are ignored and there for compatibilty with speedbar." t nil)
+
+(autoload (quote mh-speed-view) "mh-speed" "\
+View folder on current line.
+Optional ARGS are ignored." t nil)
+
+(autoload (quote mh-speed-flists) "mh-speed" "\
+Execute flists -recurse and update message counts.
+If FORCE is non-nil the timer is reset." t nil)
+
+(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
+Remove FOLDER from various optimization caches." t nil)
+
+(autoload (quote mh-speed-add-folder) "mh-speed" "\
+Add FOLDER since it is being created.
+The function invalidates the latest ancestor that is present." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
+;;;;;; "mh-utils" "mh-utils.el" (15899 28827))
+;;; Generated autoloads from mh-utils.el
+
+(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
+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." nil nil)
+
+(autoload (quote mh-get-msg-num) "mh-utils" "\
+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." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field
+;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-letter-expand-alias
+;;;;;; mh-alias-minibuffer-confirm-address mh-read-address mh-alias-reload)
+;;;;;; "mh-alias" "mh-alias.el" (15899 29102))
+;;; Generated autoloads from mh-alias.el
+
+(autoload (quote mh-alias-reload) "mh-alias" "\
+Load MH aliases into `mh-alias-alist'." t nil)
+
+(autoload (quote mh-read-address) "mh-alias" "\
+Read an address from the minibuffer with PROMPT." nil nil)
+
+(autoload (quote mh-alias-minibuffer-confirm-address) "mh-alias" "\
+Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." t nil)
+
+(autoload (quote mh-alias-letter-expand-alias) "mh-alias" "\
+Expand mail alias before point." nil nil)
+
+(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
+Return t is From has no current alias set." nil nil)
+
+(autoload (quote mh-alias-add-alias) "mh-alias" "\
+*Add ALIAS for ADDRESS in personal alias file.
+Prompts for confirmation if the address already has an alias.
+If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil)
+
+(autoload (quote mh-alias-grab-from-field) "mh-alias" "\
+*Add ALIAS for ADDRESS in personal alias file.
+Prompts for confirmation if the alias is already in use or if the address
+already has an alias." t nil)
+
+(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
+Insert an alias for email address under point." t nil)
+
+;;;***
+\f
+(provide 'mh-loaddefs)
+;;; Local Variables:
+;;; version-control: never
+;;; no-byte-compile: t
+;;; no-update-autoloads: t
+;;; End:
+;;; mh-loaddefs.el ends here
--- /dev/null
+;;; mh-mime.el --- MH-E support for composing MIME messages
+
+;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Internal support for MH-E package.
+;; Support for generating an mhn composition file.
+;; MIME is supported only by MH 6.8 or later.
+
+;;; Change Log:
+
+;; $Id: mh-mime.el,v 1.12 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+(require 'cl)
+(require 'mh-comp)
+(require 'mh-utils)
+(load "mm-decode" t t) ; Non-fatal dependency
+(load "mm-uu" t t) ; Non-fatal dependency
+(load "mailcap" t t) ; Non-fatal dependency
+(load "smiley" t t) ; Non-fatal dependency
+(require 'gnus-util)
+
+(autoload 'gnus-article-goto-header "gnus-art")
+(autoload 'article-emphasize "gnus-art")
+(autoload 'gnus-get-buffer-create "gnus")
+(autoload 'gnus-eval-format "gnus-spec")
+(autoload 'widget-convert-button "wid-edit")
+(autoload 'message-options-set-recipient "message")
+(autoload 'mml-secure-message-sign-pgpmime "mml-sec")
+(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")
+(autoload 'mml-minibuffer-read-file "mml")
+(autoload 'mml-minibuffer-read-description "mml")
+(autoload 'mml-insert-empty-tag "mml")
+(autoload 'mml-to-mime "mml")
+(autoload 'mml-attach-file "mml")
+
+;;;###mh-autoload
+(defun mh-compose-insertion (&optional inline)
+ "Add a directive to insert a MIME part from a file, using mhn or gnus.
+If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
+If it is set to 'gnus, then that will be used instead.
+Optional argument INLINE means make it an inline attachment."
+ (interactive "P")
+ (if (equal mh-compose-insertion 'gnus)
+ (if inline
+ (mh-mml-attach-file "inline")
+ (mh-mml-attach-file))
+ (call-interactively 'mh-mhn-compose-insertion)))
+
+;;;###mh-autoload
+(defun mh-compose-forward (&optional description folder message)
+ "Add a MIME directive to forward a message, using mhn or gnus.
+If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
+If it is set to 'gnus, then that will be used instead.
+Optional argument DESCRIPTION is a description of the attachment.
+Optional argument FOLDER is the folder from which the forwarded message should
+come.
+Optional argument MESSAGE is the message to forward.
+If any of the optional arguments are absent, they are prompted for."
+ (interactive (list
+ (read-string "Forw Content-description: ")
+ (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
+ (read-string (format "Messages%s: "
+ (if mh-sent-from-msg
+ (format " [%d]" mh-sent-from-msg)
+ "")))))
+ (if (equal mh-compose-insertion 'gnus)
+ (mh-mml-forward-message description folder message)
+ (mh-mhn-compose-forw description folder message)))
+
+;; To do:
+;; paragraph code should not fill # lines if MIME enabled.
+;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
+;; invokes mh-edit-mhn automatically before sending.)
+;; actually, instead of mh-auto-edit-mhn,
+;; should read automhnproc from profile
+;; MIME option to mh-forward
+;; command to move to content-description insertion point
+
+(defvar mh-mhn-args nil
+ "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command.
+The arguments are passed to mhn if \\[mh-edit-mhn] is given a
+prefix argument. Normally default arguments to mhn are specified in the
+MH profile.")
+
+(defvar mh-media-type-regexp
+ (concat (regexp-opt '("text" "image" "audio" "video" "application"
+ "multipart" "message") t)
+ "/[-.+a-zA-Z0-9]+")
+ "Regexp matching valid media types used in MIME attachment compositions.")
+
+;; Just defvar the variable to avoid compiler warning... This doesn't bind
+;; the variable, so things should work exactly as before.
+(defvar mh-have-file-command)
+
+(defun mh-have-file-command ()
+ "Return t if 'file' command is on the system.
+'file -i' is used to get MIME type of composition insertion."
+ (when (not (boundp 'mh-have-file-command))
+ (load "executable" t t) ; executable-find not autoloaded in emacs20
+ (setq mh-have-file-command
+ (and (fboundp 'executable-find)
+ (executable-find "file") ; file command exists
+ ; and accepts -i and -b args.
+ (zerop (call-process "file" nil nil nil "-i" "-b"
+ (expand-file-name "inc" mh-progs))))))
+ mh-have-file-command)
+
+(defvar mh-file-mime-type-substitutions
+ '(("application/msword" "\.xls" "application/ms-excel")
+ ("application/msword" "\.ppt" "application/ms-powerpoint"))
+ "Substitutions to make for Content-Type returned from file command.
+The first element is the Content-Type returned by the file command.
+The second element is a regexp matching the file name, usually the extension.
+The third element is the Content-Type to replace with.")
+
+(defun mh-file-mime-type-substitute (content-type filename)
+ "Return possibly changed CONTENT-TYPE on the FILENAME.
+Substitutions are made from the `mh-file-mime-type-substitutions' variable."
+ (let ((subst mh-file-mime-type-substitutions)
+ (type) (match) (answer content-type)
+ (case-fold-search t))
+ (while subst
+ (setq type (car (car subst))
+ match (elt (car subst) 1))
+ (if (and (string-equal content-type type)
+ (string-match match filename))
+ (setq answer (elt (car subst) 2)
+ subst nil)
+ (setq subst (cdr subst))))
+ answer))
+
+(defun mh-file-mime-type (filename)
+ "Return MIME type of FILENAME from file command.
+Returns nil if file command not on system."
+ (cond
+ ((not (mh-have-file-command))
+ nil) ;No file command, exit now.
+ ((not (and (file-exists-p filename)(file-readable-p filename)))
+ nil)
+ (t
+ (save-excursion
+ (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
+ (set-buffer tmp-buffer)
+ (unwind-protect
+ (progn
+ (call-process "file" nil '(t nil) nil "-b" "-i"
+ (expand-file-name filename))
+ (goto-char (point-min))
+ (if (not (re-search-forward mh-media-type-regexp nil t))
+ nil
+ (mh-file-mime-type-substitute (match-string 0) filename)))
+ (kill-buffer tmp-buffer)))))))
+
+;;; This is needed for Emacs20 which doesn't have mailcap-mime-types.
+(defvar mh-mime-content-types
+ '(("application/mac-binhex40") ("application/msword")
+ ("application/octet-stream") ("application/pdf") ("application/pgp-keys")
+ ("application/pgp-signature") ("application/pkcs7-signature")
+ ("application/postscript") ("application/rtf")
+ ("application/vnd.ms-excel") ("application/vnd.ms-powerpoint")
+ ("application/vnd.ms-project") ("application/vnd.ms-tnef")
+ ("application/wordperfect5.1") ("application/wordperfect6.0")
+ ("application/zip")
+
+ ("audio/basic") ("audio/mpeg")
+
+ ("image/gif") ("image/jpeg") ("image/png")
+
+ ("message/delivery-status")
+ ("message/external-body") ("message/partial") ("message/rfc822")
+
+ ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
+ ("text/richtext") ("text/xml")
+
+ ("video/mpeg") ("video/quicktime"))
+ "Legal MIME content types.
+See documentation for \\[mh-edit-mhn].")
+
+;;;###mh-autoload
+(defun mh-mhn-compose-insertion (filename type description attributes)
+ "Add a directive to insert a MIME message part from a file.
+This is the typical way to insert non-text parts in a message.
+
+Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
+content type, DESCRIPTION, a line of text for the Content-Description field.
+ATTRIBUTES is a comma separated list of name=value pairs that is appended to
+the Content-Type field of the attachment.
+
+See also \\[mh-edit-mhn]."
+ (interactive (let ((filename (read-file-name "Insert contents of: ")))
+ (list
+ filename
+ (or (mh-file-mime-type filename)
+ (completing-read "Content-Type: "
+ (if (fboundp 'mailcap-mime-types)
+ (mapcar 'list (mailcap-mime-types))
+ mh-mime-content-types)))
+ (read-string "Content-Description: ")
+ (read-string "Content-Attributes: "
+ (concat "name=\""
+ (file-name-nondirectory filename)
+ "\"")))))
+ (mh-mhn-compose-type filename type description attributes ))
+
+(defun mh-mhn-compose-type (filename type
+ &optional description attributes comment)
+ "Insert a mhn directive to insert a file.
+
+The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
+used as the Content-Description field, optional set of ATTRIBUTES and an
+optional COMMENT can also be included."
+ (setq mh-mhn-compose-insert-flag t)
+ (beginning-of-line)
+ (insert "#" type)
+ (and attributes
+ (insert "; " attributes))
+ (and comment
+ (insert " (" comment ")"))
+ (insert " [")
+ (and description
+ (insert description))
+ (insert "] " (expand-file-name filename))
+ (insert "\n"))
+
+
+;;;###mh-autoload
+(defun mh-mhn-compose-anon-ftp (host filename type description)
+ "Add a directive for a MIME anonymous ftp external body part.
+This directive tells MH to include a reference to a message/external-body part
+retrievable by anonymous FTP.
+
+Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
+MIME content type, and DESCRIPTION, a line of text for the Content-description
+header.
+
+See also \\[mh-edit-mhn]."
+ (interactive (list
+ (read-string "Remote host: ")
+ (read-string "Remote filename: ")
+ (completing-read "External Content-Type: "
+ (if (fboundp 'mailcap-mime-types)
+ (mapcar 'list (mailcap-mime-types))
+ mh-mime-content-types))
+ (read-string "External Content-Description: ")))
+ (mh-mhn-compose-external-type "anon-ftp" host filename
+ type description))
+
+;;;###mh-autoload
+(defun mh-mhn-compose-external-compressed-tar (host filename description)
+ "Add a directive to include a MIME reference to a compressed tar file.
+The file should be available via anonymous ftp. This directive tells MH to
+include a reference to a message/external-body part.
+
+Arguments are HOST and FILENAME, which tell where to find the file, and
+DESCRIPTION, a line of text for the Content-description header.
+
+See also \\[mh-edit-mhn]."
+ (interactive (list
+ (read-string "Remote host: ")
+ (read-string "Remote filename: ")
+ (read-string "Tar file Content-description: ")))
+ (mh-mhn-compose-external-type "anon-ftp" host filename
+ "application/octet-stream"
+ description
+ "type=tar; conversions=x-compress"
+ "mode=image"))
+
+
+(defun mh-mhn-compose-external-type (access-type host filename type
+ &optional description
+ attributes extra-params
+ comment)
+ "Add a directive to include a MIME reference to a remote file.
+The file should be available via anonymous ftp. This directive tells MH to
+include a reference to a message/external-body part.
+
+Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the
+file and TYPE which is the MIME Content-Type. Optional arguments include
+DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
+EXTRA-PARAMS, and COMMENT.
+
+See also \\[mh-edit-mhn]."
+ (setq mh-mhn-compose-insert-flag t)
+ (beginning-of-line)
+ (insert "#@" type)
+ (and attributes
+ (insert "; " attributes))
+ (and comment
+ (insert " (" comment ") "))
+ (insert " [")
+ (and description
+ (insert description))
+ (insert "] ")
+ (insert "access-type=" access-type "; ")
+ (insert "site=" host)
+ (insert "; name=" (file-name-nondirectory filename))
+ (insert "; directory=\"" (file-name-directory filename) "\"")
+ (and extra-params
+ (insert "; " extra-params))
+ (insert "\n"))
+
+;;;###mh-autoload
+(defun mh-mhn-compose-forw (&optional description folder messages)
+ "Add a forw directive to this message, to forward a message with MIME.
+This directive tells MH to include the named messages in this one.
+
+Arguments are DESCRIPTION, a line of text for the Content-description header,
+and FOLDER and MESSAGES, which name the message(s) to be forwarded.
+
+See also \\[mh-edit-mhn]."
+ (interactive (list
+ (read-string "Forw Content-description: ")
+ (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
+ (read-string (format "Messages%s: "
+ (if mh-sent-from-msg
+ (format " [%d]" mh-sent-from-msg)
+ "")))))
+ (setq mh-mhn-compose-insert-flag t)
+ (beginning-of-line)
+ (insert "#forw [")
+ (and description
+ (not (string= description ""))
+ (insert description))
+ (insert "]")
+ (and folder
+ (not (string= folder ""))
+ (insert " " folder))
+ (if (and messages
+ (not (string= messages "")))
+ (let ((start (point)))
+ (insert " " messages)
+ (subst-char-in-region start (point) ?, ? ))
+ (if mh-sent-from-msg
+ (insert " " (int-to-string mh-sent-from-msg))))
+ (insert "\n"))
+
+;;;###mh-autoload
+(defun mh-edit-mhn (&optional extra-args)
+ "Format the current draft for MIME, expanding any mhn directives.
+
+Process the current draft with the mhn program, which, using directives
+already inserted in the draft, fills in all the MIME components and header
+fields.
+
+This step should be done last just before sending the message.
+
+The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
+list `mh-mhn-args' are passed to mhn if this function is passed an optional
+prefix argument EXTRA-ARGS.
+
+For assistance with creating mhn directives to insert various types of
+components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
+from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
+anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
+compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
+message). If these helper functions are used, `mh-edit-mhn' is run
+automatically when the draft is sent.
+
+The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
+arguments, after performing the conversion.
+
+The mhn program is part of MH version 6.8 or later."
+ (interactive "*P")
+ (save-buffer)
+ (message "mhn editing...")
+ (cond
+ (mh-nmh-flag
+ (mh-exec-cmd-error nil
+ "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
+ (t
+ (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
+ "mhn" (if extra-args mh-mhn-args) buffer-file-name)))
+ (setq mh-mhn-compose-insert-flag nil)
+ (revert-buffer t t)
+ (message "mhn editing...done")
+ (run-hooks 'mh-edit-mhn-hook))
+
+;;;###mh-autoload
+(defun mh-revert-mhn-edit (noconfirm)
+ "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
+Optional non-nil argument NOCONFIRM means don't ask for confirmation."
+ (interactive "*P")
+ (if (null buffer-file-name)
+ (error "Buffer does not seem to be associated with any file"))
+ (let ((backup-strings '("," "#"))
+ backup-file)
+ (while (and backup-strings
+ (not (file-exists-p
+ (setq backup-file
+ (concat (file-name-directory buffer-file-name)
+ (car backup-strings)
+ (file-name-nondirectory buffer-file-name)
+ ".orig")))))
+ (setq backup-strings (cdr backup-strings)))
+ (or backup-strings
+ (error "Backup file for %s no longer exists!" buffer-file-name))
+ (or noconfirm
+ (yes-or-no-p (format "Revert buffer from file %s? "
+ backup-file))
+ (error "Revert not confirmed"))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (insert-file-contents backup-file))
+ (after-find-file nil)))
+
+\f
+
+;;; MIME composition functions
+
+;;;###mh-autoload
+(defun mh-mml-to-mime ()
+ "Compose MIME message from mml directives."
+ (interactive)
+ (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
+ (message-options-set-recipient))
+ (mml-to-mime)
+ (setq mh-mml-compose-insert-flag nil))
+
+;;;###mh-autoload
+(defun mh-mml-forward-message (description folder message)
+ "Forward a message as attachment.
+The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
+number."
+ (let ((msg (if (equal message "")
+ mh-sent-from-msg
+ (car (read-from-string message)))))
+ (cond ((integerp msg)
+ (if (string= "" description)
+ ;; Rationale: mml-attach-file constructs a malformed composition
+ ;; if the description string is empty. This fixes SF #625168.
+ (mml-attach-file (format "%s%s/%d"
+ mh-user-path (substring folder 1) msg)
+ "message/rfc822")
+ (mml-attach-file (format "%s%s/%d"
+ mh-user-path (substring folder 1) msg)
+ "message/rfc822"
+ description))
+ (setq mh-mml-compose-insert-flag t))
+ (t (error "The message number, %s is not a integer!" msg)))))
+
+;;;###mh-autoload
+(defun mh-mml-attach-file (&optional disposition)
+ "Attach a file to the outgoing MIME message.
+The file is not inserted or encoded until you send the message with
+`\\[mh-send-letter]'.
+Message disposition is \"inline\" or \"attachment\" and is prompted for if
+DISPOSITION is nil.
+
+This is basically `mml-attach-file' from gnus, modified such that a prefix
+argument yields an `inline' disposition and Content-Type is determined
+automatically."
+ (let* ((file (mml-minibuffer-read-file "Attach file: "))
+ (type (or (mh-file-mime-type file)
+ (completing-read "Content-Type: "
+ (if (fboundp 'mailcap-mime-types)
+ (mapcar 'list (mailcap-mime-types))
+ mh-mime-content-types))))
+ (description (mml-minibuffer-read-description))
+ (dispos (or disposition
+ (completing-read "Disposition: [attachment] "
+ '(("attachment")("inline"))
+ nil t nil nil
+ "attachment"))))
+ (mml-insert-empty-tag 'part 'type type 'filename file
+ 'disposition dispos 'description description)
+ (setq mh-mml-compose-insert-flag t)))
+
+;;;###mh-autoload
+(defun mh-mml-secure-message-sign-pgpmime ()
+ "Add directive to encrypt/sign the entire message."
+ (interactive)
+ (if (not mh-gnus-pgp-support-flag)
+ (error "Sorry. Your version of gnus does not support PGP/GPG")
+ (mml-secure-message-sign-pgpmime)
+ (setq mh-mml-compose-insert-flag t)))
+
+;;;###mh-autoload
+(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
+ "Add directive to encrypt and sign the entire message.
+If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
+ (interactive "P")
+ (if (not mh-gnus-pgp-support-flag)
+ (error "Sorry. Your version of gnus does not support PGP/GPG")
+ (mml-secure-message-encrypt-pgpmime dontsign)
+ (setq mh-mml-compose-insert-flag t)))
+
+\f
+
+;;; MIME decoding
+
+(defmacro mh-defun-compat (function arg-list &rest body)
+ "This is a macro to define functions which are not defined.
+It is used for Gnus utility functions which were added recently. If FUNCTION
+is not defined then it is defined to have argument list, ARG-LIST and body,
+BODY."
+ (let ((defined-p (fboundp function)))
+ (unless defined-p
+ `(defun ,function ,arg-list ,@body))))
+(put 'mh-defun-compat 'lisp-indent-function 'defun)
+
+;; Copy of original function from gnus-util.el
+(mh-defun-compat gnus-local-map-property (map)
+ "Return a list suitable for a text property list specifying keymap MAP."
+ (cond (mh-xemacs-flag (list 'keymap map))
+ ((>= emacs-major-version 21) (list 'keymap map))
+ (t (list 'local-map map))))
+
+;; Copy of original function from mm-decode.el
+(mh-defun-compat mm-merge-handles (handles1 handles2)
+ (append (if (listp (car handles1)) handles1 (list handles1))
+ (if (listp (car handles2)) handles2 (list handles2))))
+
+;; Copy of function from mm-decode.el
+(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
+ ;; HANDLE could be a CTL.
+ (if handle
+ (put-text-property 0 (length (car handle)) parameter value
+ (car handle))))
+
+;; Copy of original macro is in mm-decode.el
+(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
+ (get-text-property 0 parameter (car handle)))
+
+;; Copy of original function in mm-decode.el
+(mh-defun-compat mm-readable-p (handle)
+ "Say whether the content of HANDLE is readable."
+ (and (< (with-current-buffer (mm-handle-buffer handle)
+ (buffer-size)) 10000)
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (and (eq (mm-body-7-or-8) '7bit)
+ (not (mm-long-lines-p 76))))))
+
+;; Copy of original function in mm-bodies.el
+(mh-defun-compat mm-long-lines-p (length)
+ "Say whether any of the lines in the buffer is longer than LINES."
+ (save-excursion
+ (goto-char (point-min))
+ (end-of-line)
+ (while (and (not (eobp))
+ (not (> (current-column) length)))
+ (forward-line 1)
+ (end-of-line))
+ (and (> (current-column) length)
+ (current-column))))
+
+(mh-defun-compat mm-keep-viewer-alive-p (handle)
+ ;; Released Gnus doesn't keep handles associated with externally displayed
+ ;; MIME parts. So this will always return nil.
+ nil)
+
+(mh-defun-compat mm-destroy-parts (list)
+ "Older emacs don't have this function."
+ nil)
+
+;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
+;;; buggy (the args to read-file-name are incorrect). When all supported
+;;; versions of Emacs come with at least Gnus 5.10, we can delete this
+;;; function and rename calls to mh-mm-save-part to mm-save-part.
+(defun mh-mm-save-part (handle)
+ "Write HANDLE to a file."
+ (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
+ (filename (mail-content-type-get
+ (mm-handle-disposition handle) 'filename))
+ file)
+ (when filename
+ (setq filename (file-name-nondirectory filename)))
+ (setq file (read-file-name "Save MIME part to: "
+ (or mm-default-directory
+ default-directory)
+ nil nil (or filename name "")))
+ (setq mm-default-directory (file-name-directory file))
+ (and (or (not (file-exists-p file))
+ (yes-or-no-p (format "File %s already exists; overwrite? "
+ file)))
+ (mm-save-part-to-file handle file))))
+
+\f
+
+;;; MIME cleanup
+
+;;;###mh-autoload
+(defun mh-mime-cleanup ()
+ "Free the decoded MIME parts."
+ (let ((mime-data (gethash (current-buffer) mh-globals-hash)))
+ ;; This is for Emacs, what about XEmacs?
+ (cond ((fboundp 'remove-images)
+ (remove-images (point-min) (point-max))))
+ (when mime-data
+ (mm-destroy-parts (mh-mime-handles mime-data))
+ (remhash (current-buffer) mh-globals-hash))))
+
+;;;###mh-autoload
+(defun mh-destroy-postponed-handles ()
+ "Free MIME data for externally displayed mime parts."
+ (let ((mime-data (mh-buffer-data)))
+ (when mime-data
+ (mm-destroy-parts (mh-mime-handles mime-data)))
+ (remhash (current-buffer) mh-globals-hash)))
+
+(defun mh-handle-set-external-undisplayer (folder handle function)
+ "Replacement for `mm-handle-set-external-undisplayer'.
+This is only called in recent versions of Gnus. The MIME handles are stored
+in data structures corresponding to MH-E folder buffer FOLDER instead of in
+Gnus (as in the original). The MIME part, HANDLE is associated with the
+undisplayer FUNCTION."
+ (if (mm-keep-viewer-alive-p handle)
+ (let ((new-handle (copy-sequence handle)))
+ (mm-handle-set-undisplayer new-handle function)
+ (mm-handle-set-undisplayer handle nil)
+ (save-excursion
+ (set-buffer folder)
+ (push new-handle (mh-mime-handles (mh-buffer-data)))))
+ (mm-handle-set-undisplayer handle function)))
+
+\f
+
+;;; MIME transformations
+(eval-when-compile (require 'font-lock))
+
+;;;###mh-autoload
+(defun mh-add-missing-mime-version-header ()
+ "Some mail programs don't put a MIME-Version header.
+I have seen this only in spam, so maybe we shouldn't fix this ;-)"
+ (save-excursion
+ (goto-char (point-min))
+ (when (and (message-fetch-field "content-type")
+ (not (message-fetch-field "mime-version")))
+ (when (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (insert "MIME-Version: 1.0\n")))))
+
+;;;###mh-autoload
+(defun mh-display-smileys ()
+ "Function to display smileys."
+ (when (and mh-graphical-smileys-flag
+ (fboundp 'smiley-region)
+ (boundp 'font-lock-maximum-size)
+ (>= (/ font-lock-maximum-size 8) (buffer-size)))
+ (smiley-region (point-min) (point-max))))
+
+;;;###mh-autoload
+(defun mh-display-emphasis ()
+ "Function to display graphical emphasis."
+ (when (and mh-graphical-emphasis-flag
+ (boundp 'font-lock-maximum-size)
+ (>= (/ font-lock-maximum-size 8) (buffer-size)))
+ (flet ((article-goto-body ())) ; shadow this function to do nothing
+ (save-excursion
+ (goto-char (point-min))
+ (article-emphasize)))))
+
+;; Copied from gnus-art.el (should be checked for other cool things that can
+;; be added to the buttons)
+(defvar mh-mime-button-commands
+ '((mh-press-button "\r" "Toggle Display")))
+(defvar mh-mime-button-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= (string-to-number emacs-version) 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map mh-show-mode-map))
+ (define-key map [mouse-2] 'mh-push-button)
+ (dolist (c mh-mime-button-commands)
+ (define-key map (cadr c) (car c)))
+ map))
+(defvar mh-mime-button-line-format-alist
+ '((?T long-type ?s)
+ (?d description ?s)
+ (?p index ?s)
+ (?e dots ?s)))
+(defvar mh-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n")
+(defvar mh-mime-security-button-pressed nil)
+(defvar mh-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n")
+(defvar mh-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n")
+(defvar mh-mime-security-button-line-format-alist
+ '((?t type ?s)
+ (?i info ?s)
+ (?d details ?s)
+ (?D pressed-details ?s)))
+(defvar mh-mime-security-button-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= (string-to-number emacs-version) 21)
+ (set-keymap-parent map mh-show-mode-map))
+ (define-key map "\r" 'mh-press-button)
+ (define-key map [mouse-2] 'mh-push-button)
+ map))
+
+(defvar mh-mime-save-parts-directory nil
+ "Default to use for `mh-mime-save-parts-default-directory'.
+Set from last use.")
+
+;;;###mh-autoload
+(defun mh-mime-save-parts (arg)
+ "Store the MIME parts of the current message.
+If ARG, prompt for directory, else use that specified by the variable
+`mh-mime-save-parts-default-directory'. These directories may be superseded by
+mh_profile directives, since this function calls on mhstore or mhn to do the
+actual storing."
+ (interactive "P")
+ (let ((msg (if (eq major-mode 'mh-show-mode)
+ (mh-show-buffer-message-number)
+ (mh-get-msg-num t)))
+ (folder (if (eq major-mode 'mh-show-mode)
+ mh-show-folder-buffer
+ mh-current-folder))
+ (command (if mh-nmh-flag "mhstore" "mhn"))
+ (directory
+ (cond
+ ((and (or arg
+ (equal nil mh-mime-save-parts-default-directory)
+ (equal t mh-mime-save-parts-default-directory))
+ (not mh-mime-save-parts-directory))
+ (read-file-name "Store in what directory? " nil nil t nil))
+ ((and (or arg
+ (equal t mh-mime-save-parts-default-directory))
+ mh-mime-save-parts-directory)
+ (read-file-name (format
+ "Store in what directory? [%s] "
+ mh-mime-save-parts-directory)
+ "" mh-mime-save-parts-directory t ""))
+ ((stringp mh-mime-save-parts-default-directory)
+ mh-mime-save-parts-default-directory)
+ (t
+ mh-mime-save-parts-directory))))
+ (if (and (equal directory "") mh-mime-save-parts-directory)
+ (setq directory mh-mime-save-parts-directory))
+ (if (not (file-directory-p directory))
+ (message "No directory specified.")
+ (if (equal nil mh-mime-save-parts-default-directory)
+ (setq mh-mime-save-parts-directory directory))
+ (save-excursion
+ (set-buffer (get-buffer-create " *mh-store*"))
+ (cd directory)
+ (setq mh-mime-save-parts-directory directory)
+ (erase-buffer)
+ (apply 'call-process
+ (expand-file-name command mh-progs) nil t nil
+ (mh-list-to-string (list folder msg "-auto")))
+ (if (> (buffer-size) 0)
+ (save-window-excursion
+ (switch-to-buffer-other-window " *mh-store*")
+ (sit-for 3)))))))
+
+;; Avoid errors if gnus-sum isn't loaded yet...
+(defvar gnus-newsgroup-charset nil)
+(defvar gnus-newsgroup-name nil)
+
+;;;###mh-autoload
+(defun mh-mime-display (&optional pre-dissected-handles)
+ "Display (and possibly decode) MIME handles.
+Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
+present they are displayed otherwise the buffer is parsed and then
+displayed."
+ (let ((handles ())
+ (folder mh-show-folder-buffer))
+ (flet ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ ;; If needed dissect the current buffer
+ (if pre-dissected-handles
+ (setq handles pre-dissected-handles)
+ (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
+ (setf (mh-mime-handles (mh-buffer-data))
+ (mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))))
+
+ (when (and handles (or (not (stringp (car handles))) (cdr handles)))
+ ;; Goto start of message body
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (goto-char (point-max)))
+
+ ;; Delete the body
+ (delete-region (point) (point-max))
+
+ ;; Display the MIME handles
+ (mh-mime-display-part handles)))))
+
+(defun mh-mime-display-part (handle)
+ "Decides the viewer to call based on the type of HANDLE."
+ (cond ((null handle) nil)
+ ((not (stringp (car handle)))
+ (mh-mime-display-single handle))
+ ((equal (car handle) "multipart/alternative")
+ (mh-mime-display-alternative (cdr handle)))
+ ((and mh-gnus-pgp-support-flag
+ (or (equal (car handle) "multipart/signed")
+ (equal (car handle) "multipart/encrypted")))
+ (mh-mime-display-security handle))
+ (t (mh-mime-display-mixed (cdr handle)))))
+
+(defun mh-mime-display-alternative (handles)
+ "Choose among the alternatives, HANDLES the part that will be displayed.
+If no part is preferred then all the parts are displayed."
+ (let ((preferred (mm-preferred-alternative handles)))
+ (cond ((and preferred (stringp (car preferred)))
+ (mh-mime-display-part preferred))
+ (preferred
+ (save-restriction
+ (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
+ (mh-mime-display-single preferred)
+ (goto-char (point-max))))
+ (t (mh-mime-display-mixed handles)))))
+
+(defun mh-mime-display-mixed (handles)
+ "Display the list of MIME parts, HANDLES recursively."
+ (mapcar #'mh-mime-display-part handles))
+
+(defun mh-mime-part-index (handle)
+ "Generate the button number for MIME part, HANDLE.
+Notice that a hash table is used to display the same number when buttons need
+to be displayed multiple times (for instance when nested messages are
+opened)."
+ (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
+ (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
+ (incf (mh-mime-parts-count (mh-buffer-data))))))
+
+;;; Avoid compiler warnings for XEmacs functions...
+(eval-when (compile)
+ (loop for function in '(glyph-width window-pixel-width
+ glyph-height window-pixel-height)
+ do (or (fboundp function) (defalias function 'ignore))))
+
+(defun mh-small-image-p (handle)
+ "Decide whether HANDLE is a \"small\" image that can be displayed inline.
+This is only useful if a Content-Disposition header is not present."
+ (let ((media-test (caddr (assoc (car (mm-handle-type handle))
+ mh-mm-inline-media-tests)))
+ (mm-inline-large-images t))
+ (and media-test
+ (equal (mm-handle-media-supertype handle) "image")
+ (funcall media-test handle) ; Since mm-inline-large-images is T,
+ ; this only tells us if the image is
+ ; something that emacs can display
+ (let* ((image (mm-get-image handle)))
+ (cond ((fboundp 'glyph-width)
+ ;; XEmacs -- totally untested, copied from gnus
+ (and (< (glyph-width image)
+ (or mh-max-inline-image-width
+ (window-pixel-width)))
+ (< (glyph-height image)
+ (or mh-max-inline-image-height
+ (window-pixel-height)))))
+ ((fboundp 'image-size)
+ ;; Emacs21 -- copied from gnus
+ (let ((size (image-size image)))
+ (and (< (cdr size)
+ (or mh-max-inline-image-height
+ (1- (window-height))))
+ (< (car size)
+ (or mh-max-inline-image-width (window-width))))))
+ (t
+ ;; Can't show image inline
+ nil))))))
+
+(defun mh-inline-vcard-p (handle)
+ "Decide if HANDLE is a vcard that must be displayed inline."
+ (let ((type (mm-handle-type handle)))
+ (and (consp type)
+ (equal (car type) "text/x-vcard")
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (not (re-search-forward "^-- $" nil t)))))))
+
+(defun mh-mime-display-single (handle)
+ "Display a leaf node, HANDLE in the MIME tree."
+ (let* ((type (mm-handle-media-type handle))
+ (small-image-flag (mh-small-image-p handle))
+ (attachmentp (equal (car (mm-handle-disposition handle))
+ "attachment"))
+ (inlinep (and (equal (car (mm-handle-disposition handle)) "inline")
+ (mm-inlinable-p handle)
+ (mm-inlined-p handle)))
+ (displayp (or inlinep ; show if inline OR
+ (mh-inline-vcard-p handle); inline vcard OR
+ (and (not attachmentp) ; if not an attachment
+ (or small-image-flag ; and small image
+ ; and user wants inline
+ (and (not (equal
+ (mm-handle-media-supertype handle)
+ "image"))
+ (mm-inlinable-p handle)
+ (mm-inlined-p handle)))))))
+ (save-restriction
+ (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
+ (cond ((and mh-gnus-pgp-support-flag
+ (equal type "application/pgp-signature"))
+ nil) ; skip signatures as they are already handled...
+ ((not displayp)
+ (insert "\n")
+ (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
+ ((and displayp (not mh-display-buttons-for-inline-parts-flag))
+ (or (mm-display-part handle) (mm-display-part handle)))
+ ((and displayp mh-display-buttons-for-inline-parts-flag)
+ (insert "\n")
+ (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
+ (forward-line -1)
+ (mh-mm-display-part handle)))
+ (goto-char (point-max)))))
+
+(defun mh-insert-mime-button (handle index displayed)
+ "Insert MIME button for HANDLE.
+INDEX is the part number that will be DISPLAYED. It is also used by commands
+like \"K v\" which operate on individual MIME parts."
+ ;; The button could be displayed by a previous decode. In that case
+ ;; undisplay it if we need a hidden button.
+ (when (and (mm-handle-displayed-p handle) (not displayed))
+ (mm-display-part handle))
+ (let ((name (or (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename)
+ (mail-content-type-get (mm-handle-type handle) 'url)
+ ""))
+ (type (mm-handle-media-type handle))
+ (description (mail-decode-encoded-word-string
+ (or (mm-handle-description handle) "")))
+ (dots (if (or displayed (mm-handle-displayed-p handle)) " " "..."))
+ long-type begin end)
+ (if (string-match ".*/" name) (setq name (substring name (match-end 0))))
+ (setq long-type (concat type (and (not (equal name ""))
+ (concat "; " name))))
+ (unless (equal description "")
+ (setq long-type (concat " --- " long-type)))
+ (unless (bolp) (insert "\n"))
+ (setq begin (point))
+ (gnus-eval-format
+ mh-mime-button-line-format mh-mime-button-line-format-alist
+ `(,@(gnus-local-map-property mh-mime-button-map)
+ mh-callback mh-mm-display-part
+ mh-part ,index
+ mh-data ,handle))
+ (setq end (point))
+ (widget-convert-button
+ 'link begin end
+ :mime-handle handle
+ :action 'mh-widget-press-button
+ :button-keymap mh-mime-button-map
+ :help-echo
+ "Mouse-2 click or press RET (in show buffer) to toggle display")))
+
+;; There is a bug in Gnus inline image display due to which an extra line
+;; gets inserted every time it is viewed. To work around that problem we are
+;; using an extra property 'mh-region to remember the region that is added
+;; when the button is clicked. The region is then deleted to make sure that
+;; no extra lines get inserted.
+(defun mh-mm-display-part (handle)
+ "Toggle display of button for MIME part, HANDLE."
+ (beginning-of-line)
+ (let ((id (get-text-property (point) 'mh-part))
+ (point (point))
+ (window (selected-window))
+ (mail-parse-charset 'nil)
+ (mail-parse-ignored-charsets nil)
+ region buffer-read-only)
+ (save-excursion
+ (unwind-protect
+ (let ((win (get-buffer-window (current-buffer) t)))
+ (when win
+ (select-window win))
+ (goto-char point)
+
+ (if (mm-handle-displayed-p handle)
+ ;; This will remove the part.
+ (progn
+ ;; Delete the button and displayed part (if any)
+ (let ((region (get-text-property point 'mh-region)))
+ (when region
+ (when (fboundp 'remove-images)
+ (remove-images (car region) (cdr region))))
+ (mm-display-part handle)
+ (when region
+ (delete-region (car region) (cdr region))))
+ ;; Delete button (if it still remains). This happens for
+ ;; externally displayed parts where the previous step does
+ ;; nothing.
+ (unless (eolp)
+ (delete-region (point) (progn (forward-line) (point)))))
+ (save-restriction
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (narrow-to-region (point) (point))
+ ;; Maybe we need another unwind-protect here.
+ (when (equal (mm-handle-media-supertype handle) "image")
+ (insert "\n"))
+ (when (and (not (eq (ignore-errors (mm-display-part handle))
+ 'inline))
+ (equal (mm-handle-media-supertype handle)
+ "image"))
+ (goto-char (point-min))
+ (delete-char 1))
+ (when (equal (mm-handle-media-supertype handle) "text")
+ (when (eq mh-highlight-citation-p 'gnus)
+ (mh-gnus-article-highlight-citation))
+ (mh-display-smileys)
+ (mh-display-emphasis))
+ (setq region (cons (progn (goto-char (point-min))
+ (point-marker))
+ (progn (goto-char (point-max))
+ (point-marker)))))))
+ (when (window-live-p window)
+ (select-window window))
+ (goto-char point)
+ (beginning-of-line)
+ (mh-insert-mime-button handle id (mm-handle-displayed-p handle))
+ (goto-char point)
+ (when region
+ (add-text-properties (line-beginning-position) (line-end-position)
+ `(mh-region ,region)))))))
+
+;;;###mh-autoload
+(defun mh-press-button ()
+ "Press MIME button.
+If the MIME part is visible then it is removed. Otherwise the part is
+displayed."
+ (interactive)
+ (let ((mm-inline-media-tests mh-mm-inline-media-tests)
+ (data (get-text-property (point) 'mh-data))
+ (function (get-text-property (point) 'mh-callback))
+ (buffer-read-only nil)
+ (folder mh-show-folder-buffer))
+ (flet ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (when (and function (eolp))
+ (backward-char))
+ (unwind-protect (and function (funcall function data))
+ (set-buffer-modified-p nil)))))
+
+;;;###mh-autoload
+(defun mh-push-button (event)
+ "Click MIME button for EVENT.
+If the MIME part is visible then it is removed. Otherwise the part is
+displayed. This function is called when the mouse is used to click the MIME
+button."
+ (interactive "e")
+ (set-buffer (window-buffer (posn-window (event-start event))))
+ (select-window (posn-window (event-start event)))
+ (let* ((pos (posn-point (event-start event)))
+ (folder mh-show-folder-buffer)
+ (mm-inline-media-tests mh-mm-inline-media-tests)
+ (data (get-text-property pos 'mh-data))
+ (function (get-text-property pos 'mh-callback))
+ (buffer-read-only nil))
+ (flet ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (goto-char pos)
+ (unwind-protect (and function (funcall function data))
+ (set-buffer-modified-p nil)))))
+
+;;;###mh-autoload
+(defun mh-mime-save-part ()
+ "Save MIME part at point."
+ (interactive)
+ (let ((data (get-text-property (point) 'mh-data)))
+ (when data
+ (let ((mm-default-directory mh-mime-save-parts-directory))
+ (mh-mm-save-part data)
+ (setq mh-mime-save-parts-directory mm-default-directory)))))
+
+;;;###mh-autoload
+(defun mh-mime-inline-part ()
+ "Toggle display of the raw MIME part."
+ (interactive)
+ (let* ((buffer-read-only nil)
+ (data (get-text-property (point) 'mh-data))
+ (inserted-flag (get-text-property (point) 'mh-mime-inserted))
+ (displayed-flag (mm-handle-displayed-p data))
+ (point (point))
+ start end)
+ (cond ((and data (not inserted-flag) (not displayed-flag))
+ (let ((contents (mm-get-part data)))
+ (add-text-properties (line-beginning-position) (line-end-position)
+ '(mh-mime-inserted t))
+ (setq start (point-marker))
+ (forward-line 1)
+ (mm-insert-inline data contents)
+ (setq end (point-marker))
+ (add-text-properties
+ start (progn (goto-char start) (line-end-position))
+ `(mh-region (,start . ,end)))))
+ ((and data (or inserted-flag displayed-flag))
+ (mh-press-button)
+ (message "MIME part already inserted")))
+ (goto-char point)
+ (set-buffer-modified-p nil)))
+
+(defun mh-widget-press-button (widget el)
+ "Callback for widget, WIDGET.
+Parameter EL is unused."
+ (goto-char (widget-get widget :from))
+ (mh-press-button))
+
+(defun mh-mime-display-security (handle)
+ "Display PGP encrypted/signed message, HANDLE."
+ (insert "\n")
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mh-insert-mime-security-button handle)
+ (mh-mime-display-mixed (cdr handle))
+ (insert "\n")
+ (let ((mh-mime-security-button-line-format
+ mh-mime-security-button-end-line-format))
+ (mh-insert-mime-security-button handle))
+ (mm-set-handle-multipart-parameter
+ handle 'mh-region
+ (cons (set-marker (make-marker) (point-min))
+ (set-marker (make-marker) (point-max))))))
+
+;;; I rewrote the security part because Gnus doesn't seem to ever minimize
+;;; the button. That is once the mime-security button is pressed there seems
+;;; to be no way of getting rid of the inserted text.
+(defun mh-mime-security-show-details (handle)
+ "Toggle display of detailed security info for HANDLE."
+ (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
+ (when details
+ (let ((mh-mime-security-button-pressed
+ (not (get-text-property (point) 'mh-button-pressed)))
+ (mh-mime-security-button-line-format
+ (get-text-property (point) 'mh-line-format)))
+ (forward-char -1)
+ (while (eq (get-text-property (point) 'mh-line-format)
+ mh-mime-security-button-line-format)
+ (forward-char -1))
+ (forward-char)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mh-insert-mime-security-button handle))
+ (delete-region
+ (point)
+ (or (text-property-not-all
+ (point) (point-max)
+ 'mh-line-format mh-mime-security-button-line-format)
+ (point-max)))
+ (forward-line -1)))))
+
+(defun mh-mime-security-press-button (handle)
+ "Callback from security button for part HANDLE."
+ (when (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ (mh-mime-security-show-details handle)))
+
+;; These variables should already be initialized in mm-decode.el if we have a
+;; recent enough Gnus. The defvars are here to avoid compiler warnings.
+(defvar mm-verify-function-alist nil)
+(defvar mm-decrypt-function-alist nil)
+
+(defvar pressed-details)
+
+(defun mh-insert-mime-security-button (handle)
+ "Display buttons for PGP message, HANDLE."
+ (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
+ (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
+ (nth 2 (assoc protocol mm-decrypt-function-alist))
+ "Unknown"))
+ (type (concat crypto-type
+ (if (equal (car handle) "multipart/signed")
+ " Signed" " Encrypted")
+ " Part"))
+ (info (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ "Undecided"))
+ (details (mm-handle-multipart-ctl-parameter handle 'gnus-details))
+ pressed-details begin end)
+ (setq details (if details (concat "\n" details) ""))
+ (setq pressed-details (if mh-mime-security-button-pressed details ""))
+ (unless (bolp) (insert "\n"))
+ (setq begin (point))
+ (gnus-eval-format
+ mh-mime-security-button-line-format
+ mh-mime-security-button-line-format-alist
+ `(,@(gnus-local-map-property mh-mime-security-button-map)
+ mh-button-pressed ,mh-mime-security-button-pressed
+ mh-callback mh-mime-security-press-button
+ mh-line-format ,mh-mime-security-button-line-format
+ mh-data ,handle))
+ (setq end (point))
+ (widget-convert-button 'link begin end
+ :mime-handle handle
+ :action 'mh-widget-press-button
+ :button-keymap mh-mime-security-button-map
+ :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
+ (when (equal info "Failed")
+ (let* ((type (if (equal (car handle) "multipart/signed")
+ "verification" "decryption"))
+ (warning (if (equal type "decryption")
+ "(passphrase may be incorrect)" "")))
+ (message "%s %s failed %s" crypto-type type warning)))))
+
+(defun mh-mm-inline-message (handle)
+ "Display message, HANDLE.
+The function decodes the message and displays it. It avoids decoding the same
+message multiple times."
+ (let ((b (point))
+ (charset (mail-content-type-get (mm-handle-type handle) 'charset))
+ (clean-message-header mh-clean-message-header-flag)
+ (invisible-headers mh-invisible-headers)
+ (visible-headers mh-visible-headers))
+ (when (and charset (stringp charset))
+ (setq charset (intern (downcase charset)))
+ (when (eq charset 'us-ascii)
+ (setq charset nil)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region b b)
+ (mm-insert-part handle)
+ (mh-mime-display
+ (or (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
+ (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
+ (let ((handles (or (mm-dissect-buffer nil)
+ (mm-uu-dissect))))
+ (setf (mh-mime-handles (mh-buffer-data))
+ (mm-merge-handles
+ handles (mh-mime-handles (mh-buffer-data))))
+ handles))))
+
+ (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-show-xface)
+ (mh-show-addr)
+ ;; The other highlighting types don't need anything special
+ (when (eq mh-highlight-citation-p 'gnus)
+ (mh-gnus-article-highlight-citation))
+ (goto-char (point-min))
+ (insert "\n------- Forwarded Message\n\n")
+ (mh-display-smileys)
+ (mh-display-emphasis)
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (if (fboundp 'remove-specifier)
+ ;; This is only valid on XEmacs.
+ (mapcar (lambda (prop)
+ (remove-specifier
+ (face-property 'default prop) (current-buffer)))
+ '(background background-pixmap foreground)))
+ (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
+
+(provide 'mh-mime)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-mime.el ends here
--- /dev/null
+;;; mh-pick.el --- make a search pattern and search for a message in MH-E
+
+;; Copyright (C) 1993, 1995, 2001 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Internal support for MH-E package.
+
+;;; Change Log:
+
+;; $Id: mh-pick.el,v 1.10 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+(require 'mh-e)
+(require 'easymenu)
+(require 'gnus-util)
+
+;;; Internal variables:
+
+(defvar mh-pick-mode-map (make-sparse-keymap)
+ "Keymap for searching folder.")
+
+(defvar mh-searching-folder nil) ;Folder this pick is searching.
+
+;;;###mh-autoload
+(defun mh-search-folder (folder)
+ "Search FOLDER for messages matching a pattern.
+This function uses the MH command `pick' to do the work.
+Add the messages found to the sequence named `search'."
+ (interactive (list (mh-prompt-for-folder "Search"
+ mh-current-folder
+ t)))
+ (switch-to-buffer-other-window "pick-pattern")
+ (if (or (zerop (buffer-size))
+ (not (y-or-n-p "Reuse pattern? ")))
+ (mh-make-pick-template)
+ (message ""))
+ (setq mh-searching-folder folder)
+ (message "%s" (substitute-command-keys
+ (concat "Type \\[mh-do-pick-search] to search messages, "
+ "\\[mh-help] for help."))))
+
+(defun mh-make-pick-template ()
+ "Initialize the current buffer with a template for a pick pattern."
+ (erase-buffer)
+ (insert "From: \n"
+ "To: \n"
+ "Cc: \n"
+ "Date: \n"
+ "Subject: \n"
+ "---------\n")
+ (mh-pick-mode)
+ (goto-char (point-min))
+ (end-of-line))
+
+;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
+(easy-menu-define
+ mh-pick-menu mh-pick-mode-map "Menu for MH-E pick-mode"
+ '("Pick"
+ ["Execute the Search" mh-do-pick-search t]))
+
+
+;;; Help Messages
+;;; Group messages logically, more or less.
+(defvar mh-pick-mode-help-messages
+ '((nil
+ "Search messages: \\[mh-do-pick-search]\n"
+ "Move to a field by typing C-c C-f C-<field>\n"
+ "where <field> is the first letter of the desired field."))
+ "Key binding cheat sheet.
+
+This is an associative array which is used to show the most common commands.
+The key is a prefix char. The value is one or more strings which are
+concatenated together and displayed in the minibuffer if ? is pressed after
+the prefix character. The special key nil is used to display the
+non-prefixed commands.
+
+The substitutions described in `substitute-command-keys' are performed as
+well.")
+
+(put 'mh-pick-mode 'mode-class 'special)
+
+(define-derived-mode mh-pick-mode fundamental-mode "MH-Pick"
+ "Mode for creating search templates in MH-E.\\<mh-pick-mode-map>
+
+After each field name, enter the pattern to search for. If a field's
+value does not matter for the search, leave it empty. To search the
+entire message, supply the pattern in the \"body\" of the template.
+Each non-empty field must be matched for a message to be selected.
+To effect a logical \"or\", use \\[mh-search-folder] multiple times.
+When you have finished, type \\[mh-do-pick-search] to do the search.
+
+The value of `mh-pick-mode-hook' is a list of functions to be called,
+with no arguments, upon entry to this mode.
+
+\\{mh-pick-mode-map}"
+
+ (make-local-variable 'mh-searching-folder)
+ (easy-menu-add mh-pick-menu)
+ (make-local-variable 'mh-help-messages)
+ (setq mh-help-messages mh-pick-mode-help-messages)
+ (run-hooks 'mh-pick-mode-hook))
+
+;;;###mh-autoload
+(defun mh-do-pick-search ()
+ "Find messages that match the qualifications in the current pattern buffer.
+Messages are searched for in the folder named in `mh-searching-folder'.
+Add the messages found to the sequence named `search'."
+ (interactive)
+ (let ((pattern-buffer (buffer-name))
+ (searching-buffer mh-searching-folder)
+ range
+ msgs
+ (pattern nil)
+ (new-buffer nil))
+ (save-excursion
+ (cond ((get-buffer searching-buffer)
+ (set-buffer searching-buffer)
+ (setq range (list (format "%d-%d"
+ mh-first-msg-num mh-last-msg-num))))
+ (t
+ (mh-make-folder searching-buffer)
+ (setq range '("all"))
+ (setq new-buffer t))))
+ (message "Searching...")
+ (goto-char (point-min))
+ (while (and range
+ (setq pattern (mh-next-pick-field pattern-buffer)))
+ (setq msgs (mh-seq-from-command searching-buffer
+ 'search
+ (mh-list-to-string
+ (list "pick" pattern searching-buffer
+ "-list"
+ (mh-coalesce-msg-list range)))))
+ (setq range msgs)) ;restrict the pick range for next pass
+ (message "Searching...done")
+ (if new-buffer
+ (mh-scan-folder searching-buffer msgs)
+ (switch-to-buffer searching-buffer))
+ (mh-add-msgs-to-seq msgs 'search)
+ (delete-other-windows)))
+
+(defun mh-seq-from-command (folder seq command)
+ "In FOLDER, make a sequence named SEQ by executing COMMAND.
+COMMAND is a list. The first element is a program name
+and the subsequent elements are its arguments, all strings."
+ (let ((msg)
+ (msgs ())
+ (case-fold-search t))
+ (save-excursion
+ (save-window-excursion
+ (if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
+ ;; "pick" outputs one number per line
+ (while (setq msg (car (mh-read-msg-list)))
+ (setq msgs (cons msg msgs))
+ (forward-line 1))))
+ (set-buffer folder)
+ (setq msgs (nreverse msgs)) ;put in ascending order
+ msgs)))
+
+(defun mh-next-pick-field (buffer)
+ "Return the next piece of a pick argument extracted from BUFFER.
+Return a list like (\"--fieldname\" \"pattern\") or (\"-search\" \"bodypat\")
+or nil if no pieces remain."
+ (set-buffer buffer)
+ (let ((case-fold-search t))
+ (cond ((eobp)
+ nil)
+ ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
+ nil t)
+ (let* ((component
+ (format "--%s"
+ (downcase (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ (pat (buffer-substring (match-beginning 2) (match-end 2))))
+ (forward-line 1)
+ (list component pat)))
+ ((re-search-forward "^-*$" nil t)
+ (forward-char 1)
+ (let ((body (buffer-substring (point) (point-max))))
+ (if (and (> (length body) 0) (not (equal body "\n")))
+ (list "-search" body)
+ nil)))
+ (t
+ nil))))
+
+\f
+
+;;; Build the pick-mode keymap:
+;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
+(gnus-define-keys mh-pick-mode-map
+ "\C-c?" mh-help
+ "\C-c\C-c" mh-do-pick-search
+ "\C-c\C-f\C-b" mh-to-field
+ "\C-c\C-f\C-c" mh-to-field
+ "\C-c\C-f\C-d" mh-to-field
+ "\C-c\C-f\C-f" mh-to-field
+ "\C-c\C-f\C-r" mh-to-field
+ "\C-c\C-f\C-s" mh-to-field
+ "\C-c\C-f\C-t" mh-to-field
+ "\C-c\C-fb" mh-to-field
+ "\C-c\C-fc" mh-to-field
+ "\C-c\C-fd" mh-to-field
+ "\C-c\C-ff" mh-to-field
+ "\C-c\C-fr" mh-to-field
+ "\C-c\C-fs" mh-to-field
+ "\C-c\C-ft" mh-to-field)
+
+(provide 'mh-pick)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-pick.el ends here
--- /dev/null
+;;; mh-seq.el --- MH-E sequences support
+
+;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This tries to implement the algorithm described at:
+;; http://www.jwz.org/doc/threading.html
+;; It is also a start to implementing the IMAP Threading extension RFC. The
+;; implementation lacks the reference and subject canonicalization of the
+;; RFC.
+;;
+;; In the presentation buffer, children messages are shown indented with
+;; either [ ] or < > around them. Square brackets ([ ]) denote that the
+;; algorithm can point out some headers which when taken together implies
+;; that the unindented message is an ancestor of the indented message. If
+;; no such proof exists then angles (< >) are used.
+;;
+;; Some issues and problems are as follows:
+;;
+;; (1) Scan truncates the fields at length 512. So longer references:
+;; headers get mutilated. The same kind of MH format string works when
+;; composing messages. Is there a way to avoid this? My scan command
+;; is as follows:
+;; scan +folder -width 10000 \
+;; -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
+;; I would really appreciate it if someone would help me with this.
+;;
+;; (2) Implement heuristics to recognize message-id's in In-Reply-To:
+;; header. Right now it just assumes that the last text between angles
+;; (< and >) is the message-id. There is the chance that this will
+;; incorrectly use an email address like a message-id.
+;;
+;; (3) Error checking of found message-id's should be done.
+;;
+;; (4) Since this breaks the assumption that message indices increase as
+;; one goes down the buffer, the binary search based mh-goto-msg
+;; doesn't work. I have a simpler replacement which may be less
+;; efficient.
+;;
+;; (5) Better canonicalizing for message-id and subject strings.
+;;
+
+;; Internal support for MH-E package.
+
+;;; Change Log:
+
+;; $Id: mh-seq.el,v 1.10 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+(require 'cl)
+(require 'mh-e)
+
+;; Shush the byte-compiler
+(defvar tool-bar-mode)
+
+;;; Data structures (used in message threading)...
+(defstruct (mh-thread-message (:conc-name mh-message-)
+ (:constructor mh-thread-make-message))
+ (id nil)
+ (references ())
+ (subject "")
+ (subject-re-p nil))
+
+(defstruct (mh-thread-container (:conc-name mh-container-)
+ (:constructor mh-thread-make-container))
+ message parent children
+ (real-child-p t))
+
+
+;;; Internal variables:
+(defvar mh-last-seq-used nil
+ "Name of seq to which a msg was last added.")
+
+(defvar mh-non-seq-mode-line-annotation nil
+ "Saved value of `mh-mode-line-annotation' when narrowed to a seq.")
+
+;;; Maps and hashes...
+(defvar mh-thread-id-hash nil
+ "Hashtable used to canonicalize message-id strings.")
+(defvar mh-thread-subject-hash nil
+ "Hashtable used to canonicalize subject strings.")
+(defvar mh-thread-id-table nil
+ "Thread ID table maps from message-id's to message containers.")
+(defvar mh-thread-id-index-map nil
+ "Table to lookup message index number from message-id.")
+(defvar mh-thread-index-id-map nil
+ "Table to lookup message-id from message index.")
+(defvar mh-thread-scan-line-map nil
+ "Map of message index to various parts of the scan line.")
+(defvar mh-thread-old-scan-line-map nil
+ "Old map of message index to various parts of the scan line.
+This is the original map that is stored when the folder is narrowed.")
+(defvar mh-thread-subject-container-hash nil
+ "Hashtable used to group messages by subject.")
+(defvar mh-thread-duplicates nil
+ "Hashtable used to remember multiple messages with the same message-id.")
+(defvar mh-thread-history ()
+ "Variable to remember the transformations to the thread tree.
+When new messages are added, these transformations are rewound, then the
+links are added from the newly seen messages. Finally the transformations are
+redone to get the new thread tree. This makes incremental threading easier.")
+(defvar mh-thread-body-width nil
+ "Width of scan substring that contains subject and body of message.")
+
+(make-variable-buffer-local 'mh-thread-id-hash)
+(make-variable-buffer-local 'mh-thread-subject-hash)
+(make-variable-buffer-local 'mh-thread-id-table)
+(make-variable-buffer-local 'mh-thread-id-index-map)
+(make-variable-buffer-local 'mh-thread-index-id-map)
+(make-variable-buffer-local 'mh-thread-scan-line-map)
+(make-variable-buffer-local 'mh-thread-old-scan-line-map)
+(make-variable-buffer-local 'mh-thread-subject-container-hash)
+(make-variable-buffer-local 'mh-thread-duplicates)
+(make-variable-buffer-local 'mh-thread-history)
+
+;;;###mh-autoload
+(defun mh-delete-seq (sequence)
+ "Delete the SEQUENCE."
+ (interactive (list (mh-read-seq-default "Delete" t)))
+ (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
+ sequence)
+ (mh-undefine-sequence sequence '("all"))
+ (mh-delete-seq-locally sequence))
+
+;; Avoid compiler warnings
+(defvar view-exit-action)
+
+;;;###mh-autoload
+(defun mh-list-sequences ()
+ "List the sequences defined in the folder being visited."
+ (interactive)
+ (let ((folder mh-current-folder)
+ (temp-buffer mh-temp-sequences-buffer)
+ (seq-list mh-seq-list)
+ (max-len 0))
+ (with-output-to-temp-buffer temp-buffer
+ (save-excursion
+ (set-buffer temp-buffer)
+ (erase-buffer)
+ (message "Listing sequences ...")
+ (insert "Sequences in folder " folder ":\n")
+ (let ((seq-list seq-list))
+ (while seq-list
+ (setq max-len
+ (max (length (symbol-name (mh-seq-name (pop seq-list))))
+ max-len)))
+ (setq max-len (+ 2 max-len)))
+ (while seq-list
+ (let ((name (mh-seq-name (car seq-list)))
+ (sorted-seq-msgs
+ (mh-coalesce-msg-list
+ (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
+ name-spec)
+ (insert (setq name-spec (format (format "%%%ss:" max-len) name)))
+ (while sorted-seq-msgs
+ (let ((next-element (format " %s" (pop sorted-seq-msgs))))
+ (when (>= (+ (current-column) (length next-element))
+ (window-width))
+ (insert "\n")
+ (insert (format (format "%%%ss" (length name-spec)) "")))
+ (insert next-element)))
+ (insert "\n"))
+ (setq seq-list (cdr seq-list)))
+ (goto-char (point-min))
+ (view-mode 1)
+ (setq view-exit-action 'kill-buffer)
+ (message "Listing sequences...done")))))
+
+;;;###mh-autoload
+(defun mh-msg-is-in-seq (message)
+ "Display the sequences that contain MESSAGE (default: current message)."
+ (interactive (list (mh-get-msg-num t)))
+ (let* ((dest-folder (loop for seq in mh-refile-list
+ when (member message (cdr seq)) return (car seq)))
+ (deleted-flag (unless dest-folder (member message mh-delete-list))))
+ (message "Message %d%s is in sequences: %s"
+ message
+ (cond (dest-folder (format " (to be refiled to %s)" dest-folder))
+ (deleted-flag (format " (to be deleted)"))
+ (t ""))
+ (mapconcat 'concat
+ (mh-list-to-string (mh-seq-containing-msg message t))
+ " "))))
+
+;;;###mh-autoload
+(defun mh-narrow-to-seq (sequence)
+ "Restrict display of this folder to just messages in SEQUENCE.
+Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
+ (interactive (list (mh-read-seq "Narrow to" t)))
+ (with-mh-folder-updating (t)
+ (cond ((mh-seq-to-msgs sequence)
+ (mh-widen)
+ (mh-remove-all-notation)
+ (let ((eob (point-max))
+ (msg-at-cursor (mh-get-msg-num nil)))
+ (setq mh-thread-old-scan-line-map mh-thread-scan-line-map)
+ (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
+ (mh-copy-seq-to-eob sequence)
+ (narrow-to-region eob (point-max))
+ (mh-notate-user-sequences)
+ (mh-notate-deleted-and-refiled)
+ (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
+ (when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
+ (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
+ (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
+ (setq mh-mode-line-annotation (symbol-name sequence))
+ (mh-make-folder-mode-line)
+ (mh-recenter nil)
+ (if (and (boundp 'tool-bar-mode) tool-bar-mode)
+ (set (make-local-variable 'tool-bar-map)
+ mh-folder-seq-tool-bar-map))
+ (setq mh-narrowed-to-seq sequence)
+ (push 'widen mh-view-ops)))
+ (t
+ (error "No messages in sequence `%s'" (symbol-name sequence))))))
+
+;;;###mh-autoload
+(defun mh-put-msg-in-seq (msg-or-seq sequence)
+ "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
+If optional prefix argument provided, then prompt for the message sequence.
+If variable `transient-mark-mode' is non-nil and the mark is active, then
+the selected region is added to the sequence."
+ (interactive (list (cond
+ ((mh-mark-active-p t)
+ (mh-region-to-msg-list (region-beginning) (region-end)))
+ (current-prefix-arg
+ (mh-read-seq-default "Add messages from" t))
+ (t
+ (mh-get-msg-num t)))
+ (mh-read-seq-default "Add to" nil)))
+ (if (not (mh-internal-seq sequence))
+ (setq mh-last-seq-used sequence))
+ (mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq))
+ ((listp msg-or-seq) msg-or-seq)
+ (t (mh-seq-to-msgs msg-or-seq)))
+ sequence))
+
+(defun mh-valid-view-change-operation-p (op)
+ "Check if the view change operation can be performed.
+OP is one of 'widen and 'unthread."
+ (cond ((eq (car mh-view-ops) op)
+ (pop mh-view-ops))
+ (t nil)))
+
+;;;###mh-autoload
+(defun mh-widen ()
+ "Remove restrictions from current folder, thereby showing all messages."
+ (interactive)
+ (let ((msg (mh-get-msg-num nil)))
+ (when mh-narrowed-to-seq
+ (cond ((mh-valid-view-change-operation-p 'widen) nil)
+ ((memq 'widen mh-view-ops)
+ (while (not (eq (car mh-view-ops) 'widen))
+ (setq mh-view-ops (cdr mh-view-ops)))
+ (pop mh-view-ops))
+ (t (error "Widening is not applicable")))
+ (when (memq 'unthread mh-view-ops)
+ (setq mh-thread-scan-line-map mh-thread-old-scan-line-map))
+ (with-mh-folder-updating (t)
+ (delete-region (point-min) (point-max))
+ (widen)
+ (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
+ (mh-make-folder-mode-line))
+ (if msg
+ (mh-goto-msg msg t t))
+ (mh-notate-deleted-and-refiled)
+ (mh-notate-user-sequences)
+ (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
+ (mh-recenter nil)))
+ (if (and (boundp 'tool-bar-mode) tool-bar-mode)
+ (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
+ (setq mh-narrowed-to-seq nil))
+
+;; FIXME? We may want to clear all notations and add one for current-message
+;; and process user sequences.
+(defun mh-notate-deleted-and-refiled ()
+ "Notate messages marked for deletion or refiling.
+Messages to be deleted are given by `mh-delete-list' while messages to be
+refiled are present in `mh-refile-list'."
+ (mh-mapc #'(lambda (msg) (mh-notate msg mh-note-deleted mh-cmd-note))
+ mh-delete-list)
+ (mh-mapc #'(lambda (dest-msg-list)
+ ;; foreach folder name, get the keyed sequence from mh-seq-list
+ (let ((msg-list (cdr dest-msg-list)))
+ (mh-mapc #'(lambda (msg)
+ (mh-notate msg mh-note-refiled mh-cmd-note))
+ msg-list)))
+ mh-refile-list))
+
+\f
+
+;;; Commands to manipulate sequences. Sequences are stored in an alist
+;;; of the form:
+;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
+
+(defun mh-read-seq-default (prompt not-empty)
+ "Read and return sequence name with default narrowed or previous sequence.
+PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
+non-empty sequence is read."
+ (mh-read-seq prompt not-empty
+ (or mh-narrowed-to-seq
+ mh-last-seq-used
+ (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
+
+(defun mh-read-seq (prompt not-empty &optional default)
+ "Read and return a sequence name.
+Prompt with PROMPT, raise an error if the sequence is empty and the NOT-EMPTY
+flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%'
+defaults to the first sequence containing the current message."
+ (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
+ (if default
+ (format "[%s] " default)
+ ""))
+ (mh-seq-names mh-seq-list)))
+ (seq (cond ((equal input "%")
+ (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
+ ((equal input "") default)
+ (t (intern input))))
+ (msgs (mh-seq-to-msgs seq)))
+ (if (and (null msgs) not-empty)
+ (error "No messages in sequence `%s'" seq))
+ seq))
+
+(defun mh-seq-names (seq-list)
+ "Return an alist containing the names of the SEQ-LIST."
+ (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
+ seq-list))
+
+;;;###mh-autoload
+(defun mh-rename-seq (sequence new-name)
+ "Rename SEQUENCE to have NEW-NAME."
+ (interactive (list (mh-read-seq "Old" t)
+ (intern (read-string "New sequence name: "))))
+ (let ((old-seq (mh-find-seq sequence)))
+ (or old-seq
+ (error "Sequence %s does not exist" sequence))
+ ;; create new sequence first, since it might raise an error.
+ (mh-define-sequence new-name (mh-seq-msgs old-seq))
+ (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
+ (rplaca old-seq new-name)))
+
+;;;###mh-autoload
+(defun mh-map-to-seq-msgs (func seq &rest args)
+ "Invoke the FUNC at each message in the SEQ.
+SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
+passed as arguments to FUNC."
+ (save-excursion
+ (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
+ (while msgs
+ (if (mh-goto-msg (car msgs) t t)
+ (apply func (car msgs) args))
+ (setq msgs (cdr msgs))))))
+
+;;;###mh-autoload
+(defun mh-notate-seq (seq notation offset)
+ "Mark the scan listing.
+All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
+the line."
+ (mh-map-to-seq-msgs 'mh-notate seq notation offset))
+
+;;;###mh-autoload
+(defun mh-add-to-sequence (seq msgs)
+ "The sequence SEQ is augmented with the messages in MSGS."
+ ;; Add to a SEQUENCE each message the list of MSGS.
+ (if (not (mh-folder-name-p seq))
+ (if msgs
+ (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
+ "-sequence" (symbol-name seq)
+ (mh-coalesce-msg-list msgs)))))
+
+;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
+;; that the folder buffer is sorted. However in this case that assumption
+;; doesn't hold. So we will do this the dumb way.
+;(defun mh-copy-seq-to-point (seq location)
+; ;; Copy the scan listing of the messages in SEQUENCE to after the point
+; ;; LOCATION in the current buffer.
+; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
+
+(defun mh-copy-seq-to-eob (seq)
+ "Copy SEQ to the end of the buffer."
+ ;; It is quite involved to write something which will work at any place in
+ ;; the buffer, so we will write something which works only at the end of
+ ;; the buffer. If we ever need to insert sequences in the middle of the
+ ;; buffer, this will need to be fixed.
+ (save-excursion
+ (let* ((msgs (mh-seq-to-msgs seq))
+ (coalesced-msgs (mh-coalesce-msg-list msgs)))
+ (goto-char (point-max))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mh-regenerate-headers coalesced-msgs t)
+ (cond ((memq 'unthread mh-view-ops)
+ ;; Populate restricted scan-line map
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((msg (mh-get-msg-num nil)))
+ (when (numberp msg)
+ (setf (gethash msg mh-thread-scan-line-map)
+ (mh-thread-parse-scan-line))))
+ (forward-line))
+ ;; Remove scan lines and read results from pre-computed tree
+ (delete-region (point-min) (point-max))
+ (let ((thread-tree (mh-thread-generate mh-current-folder ()))
+ (mh-thread-body-width
+ (- (window-width) mh-cmd-note
+ (1- mh-scan-field-subject-start-offset)))
+ (mh-thread-last-ancestor nil))
+ (mh-thread-generate-scan-lines thread-tree -2)))
+ (mh-index-data
+ (mh-index-insert-folder-headers)))))))
+
+(defun mh-copy-line-to-point (msg location)
+ "Copy current message line to a specific location.
+The argument MSG is not used. The message in the current line is copied to
+LOCATION."
+ ;; msg is not used?
+ ;; Copy the current line to the LOCATION in the current buffer.
+ (beginning-of-line)
+ (save-excursion
+ (let ((beginning-of-line (point))
+ end)
+ (forward-line 1)
+ (setq end (point))
+ (goto-char location)
+ (insert-buffer-substring (current-buffer) beginning-of-line end))))
+
+;;;###mh-autoload
+(defun mh-region-to-msg-list (begin end)
+ "Return a list of messages within the region between BEGIN and END."
+ (save-excursion
+ ;; If end is end of buffer back up one position
+ (setq end (if (equal end (point-max)) (1- end) end))
+ (goto-char begin)
+ (let ((result ()))
+ (while (<= (point) end)
+ (let ((index (mh-get-msg-num nil)))
+ (when (numberp index) (push index result)))
+ (forward-line 1))
+ result)))
+
+\f
+
+;;; Commands to handle new 'subject sequence.
+;;; Or "Poor man's threading" by psg.
+
+(defun mh-subject-to-sequence (all)
+ "Put all following messages with same subject in sequence 'subject.
+If arg ALL is t, move to beginning of folder buffer to collect all messages.
+If arg ALL is nil, collect only messages fron current one on forward.
+
+Return number of messages put in the sequence:
+
+ nil -> there was no subject line.
+ 0 -> there were no later messages with the same subject (sequence not made)
+ >1 -> the total number of messages including current one."
+ (if (not (eq major-mode 'mh-folder-mode))
+ (error "Not in a folder buffer"))
+ (save-excursion
+ (beginning-of-line)
+ (if (or (not (looking-at mh-scan-subject-regexp))
+ (not (match-string 3))
+ (string-equal "" (match-string 3)))
+ (progn (message "No subject line.")
+ nil)
+ (let ((subject (match-string-no-properties 3))
+ (list))
+ (if (> (length subject) 41)
+ (setq subject (substring subject 0 41)))
+ (save-excursion
+ (if all
+ (goto-char (point-min)))
+ (while (re-search-forward mh-scan-subject-regexp nil t)
+ (let ((this-subject (match-string-no-properties 3)))
+ (if (> (length this-subject) 41)
+ (setq this-subject (substring this-subject 0 41)))
+ (if (string-equal this-subject subject)
+ (setq list (cons (mh-get-msg-num t) list))))))
+ (cond
+ (list
+ ;; If we created a new sequence, add the initial message to it too.
+ (if (not (member (mh-get-msg-num t) list))
+ (setq list (cons (mh-get-msg-num t) list)))
+ (if (member '("subject") (mh-seq-names mh-seq-list))
+ (mh-delete-seq 'subject))
+ ;; sort the result into a sequence
+ (let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
+ (while sorted-list
+ (mh-add-msgs-to-seq (car sorted-list) 'subject nil)
+ (setq sorted-list (cdr sorted-list)))
+ (safe-length list)))
+ (t
+ 0))))))
+
+;;;###mh-autoload
+(defun mh-narrow-to-subject ()
+ "Narrow to a sequence containing all following messages with same subject."
+ (interactive)
+ (let ((num (mh-get-msg-num nil))
+ (count (mh-subject-to-sequence t)))
+ (cond
+ ((not count) ; No subject line, delete msg anyway
+ nil)
+ ((= 0 count) ; No other msgs, delete msg anyway.
+ (message "No other messages with same Subject following this one.")
+ nil)
+ (t ; We have a subject sequence.
+ (message "Found %d messages for subject sequence." count)
+ (mh-narrow-to-seq 'subject)
+ (if (numberp num)
+ (mh-goto-msg num t t))))))
+
+;;;###mh-autoload
+(defun mh-delete-subject ()
+ "Mark all following messages with same subject to be deleted.
+This puts the messages in a sequence named subject. You can undo the last
+deletion marks using `mh-undo' with a prefix argument and then specifying the
+subject sequence."
+ (interactive)
+ (let ((count (mh-subject-to-sequence nil)))
+ (cond
+ ((not count) ; No subject line, delete msg anyway
+ (mh-delete-msg (mh-get-msg-num t)))
+ ((= 0 count) ; No other msgs, delete msg anyway.
+ (message "No other messages with same Subject following this one.")
+ (mh-delete-msg (mh-get-msg-num t)))
+ (t ; We have a subject sequence.
+ (message "Marked %d messages for deletion" count)
+ (mh-delete-msg 'subject)))))
+
+;;;###mh-autoload
+(defun mh-delete-subject-or-thread ()
+ "Mark messages for deletion intelligently.
+If the folder is threaded then `mh-thread-delete' is used to mark the current
+message and all its descendants for deletion. Otherwise `mh-delete-subject' is
+used to mark the current message and all messages following it with the same
+subject for deletion."
+ (interactive)
+ (if (memq 'unthread mh-view-ops)
+ (mh-thread-delete)
+ (mh-delete-subject)))
+
+;;; Message threading:
+
+(defun mh-thread-initialize ()
+ "Make hash tables, otherwise clear them."
+ (cond
+ (mh-thread-id-hash
+ (clrhash mh-thread-id-hash)
+ (clrhash mh-thread-subject-hash)
+ (clrhash mh-thread-id-table)
+ (clrhash mh-thread-id-index-map)
+ (clrhash mh-thread-index-id-map)
+ (clrhash mh-thread-scan-line-map)
+ (clrhash mh-thread-subject-container-hash)
+ (clrhash mh-thread-duplicates)
+ (setq mh-thread-history ()))
+ (t (setq mh-thread-id-hash (make-hash-table :test #'equal))
+ (setq mh-thread-subject-hash (make-hash-table :test #'equal))
+ (setq mh-thread-id-table (make-hash-table :test #'eq))
+ (setq mh-thread-id-index-map (make-hash-table :test #'eq))
+ (setq mh-thread-index-id-map (make-hash-table :test #'eql))
+ (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
+ (setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
+ (setq mh-thread-duplicates (make-hash-table :test #'eq))
+ (setq mh-thread-history ()))))
+
+(defsubst mh-thread-id-container (id)
+ "Given ID, return the corresponding container in `mh-thread-id-table'.
+If no container exists then a suitable container is created and the id-table
+is updated."
+ (when (not id)
+ (error "1"))
+ (or (gethash id mh-thread-id-table)
+ (setf (gethash id mh-thread-id-table)
+ (let ((message (mh-thread-make-message :id id)))
+ (mh-thread-make-container :message message)))))
+
+(defsubst mh-thread-remove-parent-link (child)
+ "Remove parent link of CHILD if it exists."
+ (let* ((child-container (if (mh-thread-container-p child)
+ child (mh-thread-id-container child)))
+ (parent-container (mh-container-parent child-container)))
+ (when parent-container
+ (setf (mh-container-children parent-container)
+ (loop for elem in (mh-container-children parent-container)
+ unless (eq child-container elem) collect elem))
+ (setf (mh-container-parent child-container) nil))))
+
+(defsubst mh-thread-add-link (parent child &optional at-end-p)
+ "Add links so that PARENT becomes a parent of CHILD.
+Doesn't make any changes if CHILD is already an ancestor of PARENT. If
+optional argument AT-END-P is non-nil, the CHILD is added to the end of the
+children list of PARENT."
+ (let ((parent-container (cond ((null parent) nil)
+ ((mh-thread-container-p parent) parent)
+ (t (mh-thread-id-container parent))))
+ (child-container (if (mh-thread-container-p child)
+ child (mh-thread-id-container child))))
+ (when (and parent-container
+ (not (mh-thread-ancestor-p child-container parent-container))
+ (not (mh-thread-ancestor-p parent-container child-container)))
+ (mh-thread-remove-parent-link child-container)
+ (cond ((not at-end-p)
+ (push child-container (mh-container-children parent-container)))
+ ((null (mh-container-children parent-container))
+ (push child-container (mh-container-children parent-container)))
+ (t (let ((last-child (mh-container-children parent-container)))
+ (while (cdr last-child)
+ (setq last-child (cdr last-child)))
+ (setcdr last-child (cons child-container nil)))))
+ (setf (mh-container-parent child-container) parent-container))
+ (unless parent-container
+ (mh-thread-remove-parent-link child-container))))
+
+(defun mh-thread-ancestor-p (ancestor successor)
+ "Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise.
+In the limit, the function returns t if ANCESTOR and SUCCESSOR are the same
+containers."
+ (block nil
+ (while successor
+ (when (eq ancestor successor) (return t))
+ (setq successor (mh-container-parent successor)))
+ nil))
+
+(defsubst mh-thread-get-message-container (message)
+ "Return container which has MESSAGE in it.
+If there is no container present then a new container is allocated."
+ (let* ((id (mh-message-id message))
+ (container (gethash id mh-thread-id-table)))
+ (cond (container (setf (mh-container-message container) message)
+ container)
+ (t (setf (gethash id mh-thread-id-table)
+ (mh-thread-make-container :message message))))))
+
+(defsubst mh-thread-get-message (id subject-re-p subject refs)
+ "Return appropriate message.
+Otherwise update message already present to have the proper ID, SUBJECT-RE-P,
+SUBJECT and REFS fields."
+ (let* ((container (gethash id mh-thread-id-table))
+ (message (if container (mh-container-message container) nil)))
+ (cond (message
+ (setf (mh-message-subject-re-p message) subject-re-p)
+ (setf (mh-message-subject message) subject)
+ (setf (mh-message-id message) id)
+ (setf (mh-message-references message) refs)
+ message)
+ (container
+ (setf (mh-container-message container)
+ (mh-thread-make-message :subject subject
+ :subject-re-p subject-re-p
+ :id id :references refs)))
+ (t (let ((message (mh-thread-make-message
+ :subject subject
+ :subject-re-p subject-re-p
+ :id id :references refs)))
+ (prog1 message
+ (mh-thread-get-message-container message)))))))
+
+(defsubst mh-thread-canonicalize-id (id)
+ "Produce canonical string representation for ID.
+This allows cheap string comparison with EQ."
+ (or (and (equal id "") (copy-sequence ""))
+ (gethash id mh-thread-id-hash)
+ (setf (gethash id mh-thread-id-hash) id)))
+
+(defsubst mh-thread-prune-subject (subject)
+ "Prune leading Re:'s, Fwd:'s etc. and trailing (fwd)'s from SUBJECT.
+If the result after pruning is not the empty string then it is canonicalized
+so that subjects can be tested for equality with eq. This is done so that all
+the messages without a subject are not put into a single thread."
+ (let ((case-fold-search t)
+ (subject-pruned-flag nil))
+ ;; Prune subject leader
+ (while (or (string-match "^[ \t]*\\(re\\|fwd?\\)\\(\\[[0-9]*\\]\\)?:[ \t]*"
+ subject)
+ (string-match "^[ \t]*\\[[^\\]][ \t]*" subject))
+ (setq subject-pruned-flag t)
+ (setq subject (substring subject (match-end 0))))
+ ;; Prune subject trailer
+ (while (or (string-match "(fwd)$" subject)
+ (string-match "[ \t]+$" subject))
+ (setq subject-pruned-flag t)
+ (setq subject (substring subject 0 (match-beginning 0))))
+ ;; Canonicalize subject only if it is non-empty
+ (cond ((equal subject "") (values subject subject-pruned-flag))
+ (t (values
+ (or (gethash subject mh-thread-subject-hash)
+ (setf (gethash subject mh-thread-subject-hash) subject))
+ subject-pruned-flag)))))
+
+(defun mh-thread-container-subject (container)
+ "Return the subject of CONTAINER.
+If CONTAINER is empty return the subject info of one of its children."
+ (cond ((and (mh-container-message container)
+ (mh-message-id (mh-container-message container)))
+ (mh-message-subject (mh-container-message container)))
+ (t (block nil
+ (dolist (kid (mh-container-children container))
+ (when (and (mh-container-message kid)
+ (mh-message-id (mh-container-message kid)))
+ (let ((kid-message (mh-container-message kid)))
+ (return (mh-message-subject kid-message)))))
+ (error "This can't happen!")))))
+
+(defun mh-thread-rewind-pruning ()
+ "Restore the thread tree to its state before pruning."
+ (while mh-thread-history
+ (let ((action (pop mh-thread-history)))
+ (cond ((eq (car action) 'DROP)
+ (mh-thread-remove-parent-link (cadr action))
+ (mh-thread-add-link (caddr action) (cadr action)))
+ ((eq (car action) 'PROMOTE)
+ (let ((node (cadr action))
+ (parent (caddr action))
+ (children (cdddr action)))
+ (dolist (child children)
+ (mh-thread-remove-parent-link child)
+ (mh-thread-add-link node child))
+ (mh-thread-add-link parent node)))
+ ((eq (car action) 'SUBJECT)
+ (let ((node (cadr action)))
+ (mh-thread-remove-parent-link node)
+ (setf (mh-container-real-child-p node) t)))))))
+
+(defun mh-thread-prune-containers (roots)
+ "Prune empty containers in the containers ROOTS."
+ (let ((dfs-ordered-nodes ())
+ (work-list roots))
+ (while work-list
+ (let ((node (pop work-list)))
+ (dolist (child (mh-container-children node))
+ (push child work-list))
+ (push node dfs-ordered-nodes)))
+ (while dfs-ordered-nodes
+ (let ((node (pop dfs-ordered-nodes)))
+ (cond ((gethash (mh-message-id (mh-container-message node))
+ mh-thread-id-index-map)
+ ;; Keep it
+ (setf (mh-container-children node)
+ (mh-thread-sort-containers (mh-container-children node))))
+ ((and (mh-container-children node)
+ (or (null (cdr (mh-container-children node)))
+ (mh-container-parent node)))
+ ;; Promote kids
+ (let ((children ()))
+ (dolist (kid (mh-container-children node))
+ (mh-thread-remove-parent-link kid)
+ (mh-thread-add-link (mh-container-parent node) kid)
+ (push kid children))
+ (push `(PROMOTE ,node ,(mh-container-parent node) ,@children)
+ mh-thread-history)
+ (mh-thread-remove-parent-link node)))
+ ((mh-container-children node)
+ ;; Promote the first orphan to parent and add the other kids as
+ ;; his children
+ (setf (mh-container-children node)
+ (mh-thread-sort-containers (mh-container-children node)))
+ (let ((new-parent (car (mh-container-children node)))
+ (other-kids (cdr (mh-container-children node))))
+ (mh-thread-remove-parent-link new-parent)
+ (dolist (kid other-kids)
+ (mh-thread-remove-parent-link kid)
+ (setf (mh-container-real-child-p kid) nil)
+ (mh-thread-add-link new-parent kid t))
+ (push `(PROMOTE ,node ,(mh-container-parent node)
+ ,new-parent ,@other-kids)
+ mh-thread-history)
+ (mh-thread-remove-parent-link node)))
+ (t
+ ;; Drop it
+ (push `(DROP ,node ,(mh-container-parent node))
+ mh-thread-history)
+ (mh-thread-remove-parent-link node)))))
+ (let ((results ()))
+ (maphash #'(lambda (k v)
+ (declare (ignore k))
+ (when (and (null (mh-container-parent v))
+ (gethash (mh-message-id (mh-container-message v))
+ mh-thread-id-index-map))
+ (push v results)))
+ mh-thread-id-table)
+ (mh-thread-sort-containers results))))
+
+(defun mh-thread-sort-containers (containers)
+ "Sort a list of message CONTAINERS to be in ascending order wrt index."
+ (sort containers
+ #'(lambda (x y)
+ (when (and (mh-container-message x) (mh-container-message y))
+ (let* ((id-x (mh-message-id (mh-container-message x)))
+ (id-y (mh-message-id (mh-container-message y)))
+ (index-x (gethash id-x mh-thread-id-index-map))
+ (index-y (gethash id-y mh-thread-id-index-map)))
+ (and (integerp index-x) (integerp index-y)
+ (< index-x index-y)))))))
+
+(defsubst mh-thread-group-by-subject (roots)
+ "Group the set of message containers, ROOTS based on subject.
+Bug: Check for and make sure that something without Re: is made the parent in
+preference to something that has it."
+ (clrhash mh-thread-subject-container-hash)
+ (let ((results ()))
+ (dolist (root roots)
+ (let* ((subject (mh-thread-container-subject root))
+ (parent (gethash subject mh-thread-subject-container-hash)))
+ (cond (parent (mh-thread-remove-parent-link root)
+ (mh-thread-add-link parent root t)
+ (setf (mh-container-real-child-p root) nil)
+ (push `(SUBJECT ,root) mh-thread-history))
+ (t
+ (setf (gethash subject mh-thread-subject-container-hash) root)
+ (push root results)))))
+ (nreverse results)))
+
+(defsubst mh-thread-process-in-reply-to (reply-to-header)
+ "Extract message id's from REPLY-TO-HEADER.
+Ideally this should have some regexp which will try to guess if a string
+between < and > is a message id and not an email address. For now it will
+take the last string inside angles."
+ (let ((end (mh-search-from-end ?> reply-to-header)))
+ (when (numberp end)
+ (let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end))))
+ (when (numberp begin)
+ (list (substring reply-to-header begin (1+ end))))))))
+
+(defun mh-thread-set-tables (folder)
+ "Use the tables of FOLDER in current buffer."
+ (flet ((mh-get-table (symbol)
+ (save-excursion
+ (set-buffer folder)
+ (symbol-value symbol))))
+ (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
+ (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
+ (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
+ (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
+ (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
+ (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
+ (setq mh-thread-subject-container-hash
+ (mh-get-table 'mh-thread-subject-container-hash))
+ (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
+ (setq mh-thread-history (mh-get-table 'mh-thread-history))))
+
+(defsubst mh-thread-update-id-index-maps (id index)
+ "Message with id, ID is the message in INDEX.
+The function also checks for duplicate messages (that is multiple messages
+with the same ID). These messages are put in the `mh-thread-duplicates' hash
+table."
+ (let ((old-index (gethash id mh-thread-id-index-map)))
+ (when old-index (push old-index (gethash id mh-thread-duplicates)))
+ (setf (gethash id mh-thread-id-index-map) index)
+ (setf (gethash index mh-thread-index-id-map) id)))
+
+\f
+
+;;; Generate Threads...
+
+(defun mh-thread-generate (folder msg-list)
+ "Scan FOLDER to get info for threading.
+Only information about messages in MSG-LIST are added to the tree."
+ (save-excursion
+ (set-buffer (get-buffer-create "*mh-thread*"))
+ (mh-thread-set-tables folder)
+ (erase-buffer)
+ (when msg-list
+ (apply
+ #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
+ "-width" "10000" "-format"
+ "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
+ folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
+ (goto-char (point-min))
+ (let ((roots ())
+ (case-fold-search t))
+ (block nil
+ (while (not (eobp))
+ (block process-message
+ (let* ((index-line
+ (prog1 (buffer-substring (point) (line-end-position))
+ (forward-line)))
+ (index (car (read-from-string index-line)))
+ (id (prog1 (buffer-substring (point) (line-end-position))
+ (forward-line)))
+ (refs (prog1 (buffer-substring (point) (line-end-position))
+ (forward-line)))
+ (in-reply-to (prog1 (buffer-substring (point)
+ (line-end-position))
+ (forward-line)))
+ (subject (prog1
+ (buffer-substring (point) (line-end-position))
+ (forward-line)))
+ (subject-re-p nil))
+ (unless (gethash index mh-thread-scan-line-map)
+ (return-from process-message))
+ (unless (integerp index) (return)) ;Error message here
+ (multiple-value-setq (subject subject-re-p)
+ (mh-thread-prune-subject subject))
+ (setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
+ (setq refs (append (split-string refs) in-reply-to))
+ (setq id (mh-thread-canonicalize-id id))
+ (mh-thread-update-id-index-maps id index)
+ (setq refs (mapcar #'mh-thread-canonicalize-id refs))
+ (mh-thread-get-message id subject-re-p subject refs)
+ (do ((ancestors refs (cdr ancestors)))
+ ((null (cdr ancestors))
+ (when (car ancestors)
+ (mh-thread-remove-parent-link id)
+ (mh-thread-add-link (car ancestors) id)))
+ (mh-thread-add-link (car ancestors) (cadr ancestors)))))))
+ (maphash #'(lambda (k v)
+ (declare (ignore k))
+ (when (null (mh-container-parent v))
+ (push v roots)))
+ mh-thread-id-table)
+ (setq roots (mh-thread-prune-containers roots))
+ (prog1 (setq roots (mh-thread-group-by-subject roots))
+ (let ((history mh-thread-history))
+ (set-buffer folder)
+ (setq mh-thread-history history))))))
+
+;;;###mh-autoload
+(defun mh-thread-inc (folder start-point)
+ "Update thread tree for FOLDER.
+All messages after START-POINT are added to the thread tree."
+ (mh-thread-rewind-pruning)
+ (goto-char start-point)
+ (let ((msg-list ()))
+ (while (not (eobp))
+ (let ((index (mh-get-msg-num nil)))
+ (when (numberp index)
+ (push index msg-list)
+ (setf (gethash index mh-thread-scan-line-map)
+ (mh-thread-parse-scan-line)))
+ (forward-line)))
+ (let ((thread-tree (mh-thread-generate folder msg-list))
+ (buffer-read-only nil)
+ (old-buffer-modified-flag (buffer-modified-p)))
+ (delete-region (point-min) (point-max))
+ (let ((mh-thread-body-width (- (window-width) mh-cmd-note
+ (1- mh-scan-field-subject-start-offset)))
+ (mh-thread-last-ancestor nil))
+ (mh-thread-generate-scan-lines thread-tree -2))
+ (mh-notate-user-sequences)
+ (mh-notate-deleted-and-refiled)
+ (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
+ (set-buffer-modified-p old-buffer-modified-flag))))
+
+(defvar mh-thread-last-ancestor)
+
+(defun mh-thread-generate-scan-lines (tree level)
+ "Generate scan lines.
+TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices
+to the corresponding scan lines and LEVEL used to determine indentation of
+the message."
+ (cond ((null tree) nil)
+ ((mh-thread-container-p tree)
+ (let* ((message (mh-container-message tree))
+ (id (mh-message-id message))
+ (index (gethash id mh-thread-id-index-map))
+ (duplicates (gethash id mh-thread-duplicates))
+ (new-level (+ level 2))
+ (dupl-flag t)
+ (force-angle-flag nil)
+ (increment-level-flag nil))
+ (dolist (scan-line (mapcar (lambda (x)
+ (gethash x mh-thread-scan-line-map))
+ (reverse (cons index duplicates))))
+ (when scan-line
+ (when (and dupl-flag (equal level 0)
+ (mh-thread-ancestor-p mh-thread-last-ancestor tree))
+ (setq level (+ level 2)
+ new-level (+ new-level 2)
+ force-angle-flag t))
+ (when (equal level 0)
+ (setq mh-thread-last-ancestor tree)
+ (while (mh-container-parent mh-thread-last-ancestor)
+ (setq mh-thread-last-ancestor
+ (mh-container-parent mh-thread-last-ancestor))))
+ (insert (car scan-line)
+ (format (format "%%%ss"
+ (if dupl-flag level new-level)) "")
+ (if (and (mh-container-real-child-p tree) dupl-flag
+ (not force-angle-flag))
+ "[" "<")
+ (cadr scan-line)
+ (if (and (mh-container-real-child-p tree) dupl-flag
+ (not force-angle-flag))
+ "]" ">")
+ (truncate-string-to-width
+ (caddr scan-line) (- mh-thread-body-width
+ (if dupl-flag level new-level)))
+ "\n")
+ (setq increment-level-flag t)
+ (setq dupl-flag nil)))
+ (unless increment-level-flag (setq new-level level))
+ (dolist (child (mh-container-children tree))
+ (mh-thread-generate-scan-lines child new-level))))
+ (t (let ((nlevel (+ level 2)))
+ (dolist (ch tree)
+ (mh-thread-generate-scan-lines ch nlevel))))))
+
+;; Another and may be better approach would be to generate all the info from
+;; the scan which generates the threading info. For now this will have to do.
+(defun mh-thread-parse-scan-line (&optional string)
+ "Parse a scan line.
+If optional argument STRING is given then that is assumed to be the scan line.
+Otherwise uses the line at point as the scan line to parse."
+ (let* ((string (or string
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))))
+ (first-string (substring string 0 (+ mh-cmd-note 8))))
+ (setf (elt first-string mh-cmd-note) ? )
+ (when (equal (elt first-string (1+ mh-cmd-note)) (elt mh-note-seq 0))
+ (setf (elt first-string (1+ mh-cmd-note)) ? ))
+ (list first-string
+ (substring string
+ (+ mh-cmd-note mh-scan-field-from-start-offset)
+ (+ mh-cmd-note mh-scan-field-from-end-offset -2))
+ (substring string (+ mh-cmd-note mh-scan-field-from-end-offset))
+ string)))
+
+;;;###mh-autoload
+(defun mh-thread-add-spaces (count)
+ "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
+ (let ((spaces (format (format "%%%ss" count) "")))
+ (while (not (eobp))
+ (let* ((msg-num (mh-get-msg-num nil))
+ (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map))))
+ (when (numberp msg-num)
+ (setf (gethash msg-num mh-thread-scan-line-map)
+ (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
+ (forward-line 1))))
+
+(defun mh-thread-folder ()
+ "Generate thread view of folder."
+ (message "Threading %s..." (buffer-name))
+ (mh-thread-initialize)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((index (mh-get-msg-num nil)))
+ (when (numberp index)
+ (setf (gethash index mh-thread-scan-line-map)
+ (mh-thread-parse-scan-line))))
+ (forward-line))
+ (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num))
+ (thread-tree (mh-thread-generate (buffer-name) (list range))))
+ (delete-region (point-min) (point-max))
+ (let ((mh-thread-body-width (- (window-width) mh-cmd-note
+ (1- mh-scan-field-subject-start-offset)))
+ (mh-thread-last-ancestor nil))
+ (mh-thread-generate-scan-lines thread-tree -2))
+ (mh-notate-user-sequences)
+ (mh-notate-deleted-and-refiled)
+ (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
+ (message "Threading %s...done" (buffer-name))))
+
+;;;###mh-autoload
+(defun mh-toggle-threads ()
+ "Toggle threaded view of folder.
+The conversion of normal view to threaded view is exact, that is the same
+messages are displayed in the folder buffer before and after threading. However
+the conversion from threaded view to normal view is inexact. So more messages
+than were originally present may be shown as a result."
+ (interactive)
+ (let ((msg-at-point (mh-get-msg-num nil))
+ (old-buffer-modified-flag (buffer-modified-p))
+ (buffer-read-only nil))
+ (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq)
+ (unless (mh-valid-view-change-operation-p 'unthread)
+ (error "Can't unthread folder"))
+ (mh-scan-folder mh-current-folder
+ (format "%s" mh-narrowed-to-seq)
+ t)
+ (when mh-index-data
+ (mh-index-insert-folder-headers)))
+ ((memq 'unthread mh-view-ops)
+ (unless (mh-valid-view-change-operation-p 'unthread)
+ (error "Can't unthread folder"))
+ (mh-scan-folder mh-current-folder
+ (format "%s-%s" mh-first-msg-num mh-last-msg-num)
+ t)
+ (when mh-index-data
+ (mh-index-insert-folder-headers)))
+ (t (mh-thread-folder)
+ (push 'unthread mh-view-ops)))
+ (when msg-at-point (mh-goto-msg msg-at-point t t))
+ (set-buffer-modified-p old-buffer-modified-flag)
+ (mh-recenter nil)))
+
+;;;###mh-autoload
+(defun mh-thread-forget-message (index)
+ "Forget the message INDEX from the threading tables."
+ (let* ((id (gethash index mh-thread-index-id-map))
+ (id-index (gethash id mh-thread-id-index-map))
+ (duplicates (gethash id mh-thread-duplicates)))
+ (remhash index mh-thread-index-id-map)
+ (cond ((and (eql index id-index) (null duplicates))
+ (remhash id mh-thread-id-index-map))
+ ((eql index id-index)
+ (setf (gethash id mh-thread-id-index-map) (car duplicates))
+ (setf (gethash (car duplicates) mh-thread-index-id-map) id)
+ (setf (gethash id mh-thread-duplicates) (cdr duplicates)))
+ (t
+ (setf (gethash id mh-thread-duplicates)
+ (remove index duplicates))))))
+
+\f
+
+;;; Operations on threads
+
+(defun mh-thread-current-indentation-level ()
+ "Find the number of spaces by which current message is indented."
+ (save-excursion
+ (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
+ mh-scan-date-width 1))
+ (level 0))
+ (beginning-of-line)
+ (forward-char address-start-offset)
+ (while (char-equal (char-after) ? )
+ (incf level)
+ (forward-char))
+ level)))
+
+;;;###mh-autoload
+(defun mh-thread-next-sibling (&optional previous-flag)
+ "Jump to next sibling.
+With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling."
+ (interactive)
+ (cond ((not (memq 'unthread mh-view-ops))
+ (error "Folder isn't threaded"))
+ ((eobp)
+ (error "No message at point")))
+ (beginning-of-line)
+ (let ((point (point))
+ (done nil)
+ (my-level (mh-thread-current-indentation-level)))
+ (while (and (not done)
+ (equal (forward-line (if previous-flag -1 1)) 0)
+ (not (eobp)))
+ (let ((level (mh-thread-current-indentation-level)))
+ (cond ((equal level my-level)
+ (setq done 'success))
+ ((< level my-level)
+ (message "No %s sibling" (if previous-flag "previous" "next"))
+ (setq done 'failure)))))
+ (cond ((eq done 'success) (mh-maybe-show))
+ ((eq done 'failure) (goto-char point))
+ (t (message "No %s sibling" (if previous-flag "previous" "next"))
+ (goto-char point)))))
+
+;;;###mh-autoload
+(defun mh-thread-previous-sibling ()
+ "Jump to previous sibling."
+ (interactive)
+ (mh-thread-next-sibling t))
+
+(defun mh-thread-immediate-ancestor ()
+ "Jump to immediate ancestor in thread tree."
+ (beginning-of-line)
+ (let ((point (point))
+ (ancestor-level (- (mh-thread-current-indentation-level) 2))
+ (done nil))
+ (if (< ancestor-level 0)
+ nil
+ (while (and (not done) (equal (forward-line -1) 0))
+ (when (equal ancestor-level (mh-thread-current-indentation-level))
+ (setq done t)))
+ (unless done
+ (goto-char point))
+ done)))
+
+;;;###mh-autoload
+(defun mh-thread-ancestor (&optional thread-root-flag)
+ "Jump to the ancestor of current message.
+If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
+thread tree the message belongs to."
+ (interactive "P")
+ (beginning-of-line)
+ (cond ((not (memq 'unthread mh-view-ops))
+ (error "Folder isn't threaded"))
+ ((eobp)
+ (error "No message at point")))
+ (let ((current-level (mh-thread-current-indentation-level)))
+ (cond (thread-root-flag
+ (while (mh-thread-immediate-ancestor))
+ (mh-maybe-show))
+ ((equal current-level 1)
+ (message "Message has no ancestor"))
+ (t (mh-thread-immediate-ancestor)
+ (mh-maybe-show)))))
+
+(defun mh-thread-find-children ()
+ "Return a region containing the current message and its children.
+The result is returned as a list of two elements. The first is the point at the
+start of the region and the second is the point at the end."
+ (beginning-of-line)
+ (if (eobp)
+ nil
+ (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
+ mh-scan-date-width 1))
+ (level (mh-thread-current-indentation-level))
+ spaces begin)
+ (setq begin (point))
+ (setq spaces (format (format "%%%ss" (1+ level)) ""))
+ (forward-line)
+ (block nil
+ (while (not (eobp))
+ (forward-char address-start-offset)
+ (unless (equal (string-match spaces (buffer-substring-no-properties
+ (point) (line-end-position)))
+ 0)
+ (beginning-of-line)
+ (backward-char)
+ (return))
+ (forward-line)))
+ (list begin (point)))))
+
+;;;###mh-autoload
+(defun mh-thread-delete ()
+ "Mark current message and all its children for subsequent deletion."
+ (interactive)
+ (cond ((not (memq 'unthread mh-view-ops))
+ (error "Folder isn't threaded"))
+ ((eobp)
+ (error "No message at point"))
+ (t (mh-delete-msg
+ (apply #'mh-region-to-msg-list (mh-thread-find-children))))))
+
+;; This doesn't handle mh-default-folder-for-message-function. We should
+;; refactor that code so that we don't copy it.
+;;;###mh-autoload
+(defun mh-thread-refile (folder)
+ "Mark current message and all its children for refiling to FOLDER."
+ (interactive (list
+ (intern (mh-prompt-for-folder
+ "Destination"
+ (cond ((eq 'refile (car mh-last-destination-folder))
+ (symbol-name (cdr mh-last-destination-folder)))
+ (t ""))
+ t))))
+ (cond ((not (memq 'unthread mh-view-ops))
+ (error "Folder isn't threaded"))
+ ((eobp)
+ (error "No message at point"))
+ (t (mh-refile-msg
+ (apply #'mh-region-to-msg-list (mh-thread-find-children))
+ folder))))
+
+(provide 'mh-seq)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-seq.el ends here
--- /dev/null
+;;; mh-speed.el --- Speedbar interface for MH-E.
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; Future versions should only use flists.
+
+;; Speedbar support for MH-E package.
+
+;;; Change Log:
+
+;; $Id: mh-speed.el,v 1.2 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+;; Requires
+(require 'cl)
+(require 'mh-e)
+(require 'speedbar)
+
+;; Global variables
+(defvar mh-speed-refresh-flag nil)
+(defvar mh-speed-last-selected-folder nil)
+(defvar mh-speed-folder-map (make-hash-table :test #'equal))
+(defvar mh-speed-folders-cache (make-hash-table :test #'equal))
+(defvar mh-speed-flists-cache (make-hash-table :test #'equal))
+(defvar mh-speed-flists-process nil)
+(defvar mh-speed-flists-timer nil)
+(defvar mh-speed-partial-line "")
+
+;; Add our stealth update function
+(unless (member 'mh-speed-stealth-update
+ (cdr (assoc "files" speedbar-stealthy-function-list)))
+ ;; Is changing constant lists in elisp safe?
+ (setq speedbar-stealthy-function-list
+ (copy-tree speedbar-stealthy-function-list))
+ (push 'mh-speed-stealth-update
+ (cdr (assoc "files" speedbar-stealthy-function-list))))
+
+;; Functions called by speedbar to initialize display...
+;;;###mh-autoload
+(defun mh-folder-speedbar-buttons (buffer)
+ "Interface function to create MH-E speedbar buffer.
+BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
+ (unless (get-text-property (point-min) 'mh-level)
+ (erase-buffer)
+ (clrhash mh-speed-folder-map)
+ (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil
+ 'mh-speedbar-folder-face 0)
+ (forward-line -1)
+ (setf (gethash nil mh-speed-folder-map)
+ (set-marker (make-marker) (1+ (line-beginning-position))))
+ (add-text-properties
+ (line-beginning-position) (1+ (line-beginning-position))
+ `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
+ (mh-speed-stealth-update t)
+ (when mh-speed-run-flists-flag
+ (mh-speed-flists nil))))
+
+;;;###mh-autoload
+(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
+;;;###mh-autoload
+(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
+
+;; Keymaps for speedbar...
+(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
+ "Specialized speedbar keymap for MH-E buffers.")
+(gnus-define-keys mh-folder-speedbar-key-map
+ "+" mh-speed-expand-folder
+ "-" mh-speed-contract-folder
+ "\r" mh-speed-view
+ "f" mh-speed-flists
+ "i" mh-speed-invalidate-map)
+
+(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
+(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
+
+;; Menus for speedbar...
+(defvar mh-folder-speedbar-menu-items
+ '(["Visit Folder" mh-speed-view
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ (get-text-property (line-beginning-position) 'mh-folder))]
+ ["Expand nested folders" mh-speed-expand-folder
+ (and (get-text-property (line-beginning-position) 'mh-children-p)
+ (not (get-text-property (line-beginning-position) 'mh-expanded)))]
+ ["Contract nested folders" mh-speed-contract-folder
+ (and (get-text-property (line-beginning-position) 'mh-children-p)
+ (get-text-property (line-beginning-position) 'mh-expanded))]
+ ["Run Flists" mh-speed-flists t]
+ ["Invalidate cached folders" mh-speed-invalidate-map t])
+ "Extra menu items for speedbar.")
+
+(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
+(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
+
+(defmacro mh-speed-select-attached-frame ()
+ "Compatibility macro to handle speedbar versions 0.11a and 0.14beta4."
+ (cond ((fboundp 'dframe-select-attached-frame)
+ '(dframe-select-attached-frame speedbar-frame))
+ ((boundp 'speedbar-attached-frame)
+ '(select-frame speedbar-attached-frame))
+ (t (error "Installed speedbar version not supported by MH-E"))))
+
+(defun mh-speed-update-current-folder (force)
+ "Update speedbar highlighting of the current folder.
+The function tries to be smart so that work done is minimized. The currently
+highlighted folder is cached and no highlighting happens unless it changes.
+Also highlighting is suspended while the speedbar frame is selected.
+Otherwise you get the disconcerting behavior of folders popping open on their
+own when you are trying to navigate around in the speedbar buffer.
+
+The update is always carried out if FORCE is non-nil."
+ (let* ((lastf (selected-frame))
+ (newcf (save-excursion
+ (mh-speed-select-attached-frame)
+ (prog1 (mh-speed-extract-folder-name (buffer-name))
+ (select-frame lastf))))
+ (lastb (current-buffer))
+ (case-fold-search t))
+ (when (or force
+ (and mh-speed-refresh-flag (not (eq lastf speedbar-frame)))
+ (and (stringp newcf)
+ (equal (substring newcf 0 1) "+")
+ (not (equal newcf mh-speed-last-selected-folder))))
+ (setq mh-speed-refresh-flag nil)
+ (select-frame speedbar-frame)
+ (set-buffer speedbar-buffer)
+
+ ;; Remove highlight from previous match...
+ (mh-speed-highlight mh-speed-last-selected-folder
+ 'mh-speedbar-folder-face)
+
+ ;; If we found a match highlight it...
+ (when (mh-speed-goto-folder newcf)
+ (mh-speed-highlight newcf 'mh-speedbar-selected-folder-face))
+
+ (setq mh-speed-last-selected-folder newcf)
+ (speedbar-position-cursor-on-line)
+ (set-window-point (frame-first-window speedbar-frame) (point))
+ (set-buffer lastb)
+ (select-frame lastf))
+ (when (eq lastf speedbar-frame)
+ (setq mh-speed-refresh-flag t))))
+
+(defun mh-speed-normal-face (face)
+ "Return normal face for given FACE."
+ (cond ((eq face 'mh-speedbar-folder-with-unseen-messages-face)
+ 'mh-speedbar-folder-face)
+ ((eq face 'mh-speedbar-selected-folder-with-unseen-messages-face)
+ 'mh-speedbar-selected-folder-face)
+ (t face)))
+
+(defun mh-speed-bold-face (face)
+ "Return bold face for given FACE."
+ (cond ((eq face 'mh-speedbar-folder-face)
+ 'mh-speedbar-folder-with-unseen-messages-face)
+ ((eq face 'mh-speedbar-selected-folder-face)
+ 'mh-speedbar-selected-folder-with-unseen-messages-face)
+ (t face)))
+
+(defun mh-speed-highlight (folder face)
+ "Set FOLDER to FACE."
+ (save-excursion
+ (speedbar-with-writable
+ (goto-char (gethash folder mh-speed-folder-map (point)))
+ (beginning-of-line)
+ (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
+ (setq face (mh-speed-bold-face face))
+ (setq face (mh-speed-normal-face face)))
+ (beginning-of-line)
+ (when (re-search-forward "\\[.\\] " (line-end-position) t)
+ (put-text-property (point) (line-end-position) 'face face)))))
+
+(defun mh-speed-stealth-update (&optional force)
+ "Do stealth update.
+With non-nil FORCE, the update is always carried out."
+ (cond ((save-excursion (set-buffer speedbar-buffer)
+ (get-text-property (point-min) 'mh-level))
+ ;; Execute this hook and *don't* run anything else
+ (mh-speed-update-current-folder force)
+ nil)
+ ;; Otherwise on to your regular programming
+ (t t)))
+
+(defun mh-speed-goto-folder (folder)
+ "Move point to line containing FOLDER.
+The function will expand out parent folders of FOLDER if needed."
+ (let ((prefix folder)
+ (suffix-list ())
+ (last-slash t))
+ (while (and (not (gethash prefix mh-speed-folder-map)) last-slash)
+ (setq last-slash (mh-search-from-end ?/ prefix))
+ (when (integerp last-slash)
+ (push (substring prefix (1+ last-slash)) suffix-list)
+ (setq prefix (substring prefix 0 last-slash))))
+ (let ((prefix-position (gethash prefix mh-speed-folder-map)))
+ (if prefix-position
+ (goto-char prefix-position)
+ (goto-char (point-min))
+ (mh-speed-toggle)
+ (unless (get-text-property (point) 'mh-expanded)
+ (mh-speed-toggle))
+ (goto-char (gethash prefix mh-speed-folder-map))))
+ (while suffix-list
+ ;; We always need atleast one toggle. We need two if the directory list
+ ;; is stale since a folder was added.
+ (when (equal prefix (get-text-property (line-beginning-position)
+ 'mh-folder))
+ (mh-speed-toggle)
+ (unless (get-text-property (point) 'mh-expanded)
+ (mh-speed-toggle)))
+ (setq prefix (format "%s/%s" prefix (pop suffix-list)))
+ (goto-char (gethash prefix mh-speed-folder-map (point))))
+ (beginning-of-line)
+ (equal folder (get-text-property (point) 'mh-folder))))
+
+(defun mh-speed-extract-folder-name (buffer)
+ "Given an MH-E BUFFER find the folder that should be highlighted.
+Do the right thing for the different kinds of buffers that MH-E uses."
+ (save-excursion
+ (set-buffer buffer)
+ (cond ((eq major-mode 'mh-folder-mode)
+ mh-current-folder)
+ ((eq major-mode 'mh-show-mode)
+ (set-buffer mh-show-folder-buffer)
+ mh-current-folder)
+ ((eq major-mode 'mh-letter-mode)
+ (when (string-match mh-user-path buffer-file-name)
+ (let* ((rel-path (substring buffer-file-name (match-end 0)))
+ (directory-end (mh-search-from-end ?/ rel-path)))
+ (when directory-end
+ (format "+%s" (substring rel-path 0 directory-end)))))))))
+
+(defun mh-speed-add-buttons (folder level)
+ "Add speedbar button for FOLDER which is at indented by LEVEL amount."
+ (let ((folder-list (mh-speed-folders folder)))
+ (mapc
+ (lambda (f)
+ (let* ((folder-name (format "%s%s%s" (or folder "+")
+ (if folder "/" "") (car f)))
+ (counts (gethash folder-name mh-speed-flists-cache)))
+ (speedbar-with-writable
+ (speedbar-make-tag-line
+ 'bracket (if (cdr f) ?+ ? )
+ 'mh-speed-toggle nil
+ (format "%s%s"
+ (car f)
+ (if counts
+ (format " (%s/%s)" (car counts) (cdr counts))
+ ""))
+ 'mh-speed-view nil
+ (if (and counts (> (car counts) 0))
+ 'mh-speedbar-folder-with-unseen-messages-face
+ 'mh-speedbar-folder-face)
+ level)
+ (save-excursion
+ (forward-line -1)
+ (setf (gethash folder-name mh-speed-folder-map)
+ (set-marker (make-marker) (1+ (line-beginning-position))))
+ (add-text-properties
+ (line-beginning-position) (1+ (line-beginning-position))
+ `(mh-folder ,folder-name
+ mh-expanded nil
+ mh-children-p ,(not (not (cdr f)))
+ ,@(if counts `(mh-count
+ (,(car counts) . ,(cdr counts))) ())
+ mh-level ,level))))))
+ folder-list)))
+
+;;;###mh-autoload
+(defun mh-speed-toggle (&rest args)
+ "Toggle the display of child folders.
+The otional ARGS are ignored and there for compatibilty with speedbar."
+ (interactive)
+ (declare (ignore args))
+ (beginning-of-line)
+ (let ((parent (get-text-property (point) 'mh-folder))
+ (kids-p (get-text-property (point) 'mh-children-p))
+ (expanded (get-text-property (point) 'mh-expanded))
+ (level (get-text-property (point) 'mh-level))
+ (point (point))
+ start-region)
+ (speedbar-with-writable
+ (cond ((not kids-p) nil)
+ (expanded
+ (forward-line)
+ (setq start-region (point))
+ (while (and (get-text-property (point) 'mh-level)
+ (> (get-text-property (point) 'mh-level) level))
+ (remhash (get-text-property (point) 'mh-folder)
+ mh-speed-folder-map)
+ (forward-line))
+ (delete-region start-region (point))
+ (forward-line -1)
+ (speedbar-change-expand-button-char ?+)
+ (add-text-properties
+ (line-beginning-position) (1+ (line-beginning-position))
+ '(mh-expanded nil)))
+ (t
+ (forward-line)
+ (mh-speed-add-buttons parent (1+ level))
+ (goto-char point)
+ (speedbar-change-expand-button-char ?-)
+ (add-text-properties
+ (line-beginning-position) (1+ (line-beginning-position))
+ `(mh-expanded t)))))))
+
+(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
+(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
+
+;;;###mh-autoload
+(defun mh-speed-view (&rest args)
+ "View folder on current line.
+Optional ARGS are ignored."
+ (interactive)
+ (declare (ignore args))
+ (let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
+ (range (and (stringp folder) (mh-read-msg-range folder))))
+ (when (stringp folder)
+ (speedbar-with-attached-buffer
+ (mh-visit-folder folder range)
+ (delete-other-windows)))))
+
+(defun mh-speed-folders (folder)
+ "Find the subfolders of FOLDER.
+The function avoids running folders unnecessarily by caching the results of
+the actual folders call."
+ (let ((match (gethash folder mh-speed-folders-cache 'no-result)))
+ (cond ((eq match 'no-result)
+ (setf (gethash folder mh-speed-folders-cache)
+ (mh-speed-folders-actual folder)))
+ (t match))))
+
+(defun mh-speed-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* ((folder (cond ((and (stringp folder)
+ (equal (substring folder 0 1) "+"))
+ folder)
+ (t nil)))
+ (arg-list `(,(expand-file-name "folders" mh-progs)
+ nil (t nil) nil "-noheader" "-norecurse"
+ ,@(if (stringp folder) (list folder) ())))
+ (results ()))
+ (with-temp-buffer
+ (apply #'call-process arg-list)
+ (goto-char (point-min))
+ (while (not (and (eolp) (bolp)))
+ (goto-char (line-end-position))
+ (let ((has-pos (search-backward " has " (line-beginning-position) t)))
+ (when (integerp has-pos)
+ (while (or (equal (char-after has-pos) ? )
+ (equal (char-after has-pos) ?+))
+ (decf has-pos))
+ (incf has-pos)
+ (let ((name (buffer-substring (line-beginning-position) has-pos)))
+ (let ((first-char (substring name 0 1)))
+ (unless (or (string-equal first-char ".")
+ (string-equal first-char "#")
+ (string-equal first-char ","))
+ (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))
+
+;;;###mh-autoload
+(defun mh-speed-flists (force)
+ "Execute flists -recurse and update message counts.
+If FORCE is non-nil the timer is reset."
+ (interactive (list t))
+ (when force
+ (when (timerp mh-speed-flists-timer)
+ (cancel-timer mh-speed-flists-timer))
+ (setq mh-speed-flists-timer nil)
+ (when (and (processp mh-speed-flists-process)
+ (not (eq (process-status mh-speed-flists-process) 'exit)))
+ (kill-process mh-speed-flists-process)
+ (setq mh-speed-flists-process nil)))
+ (unless mh-speed-flists-timer
+ (setq mh-speed-flists-timer
+ (run-at-time
+ nil mh-speed-flists-interval
+ (lambda ()
+ (unless (and (processp mh-speed-flists-process)
+ (not (eq (process-status mh-speed-flists-process)
+ 'exit)))
+ (setq mh-speed-flists-process
+ (start-process (expand-file-name "flists" mh-progs) nil
+ "flists" "-recurse"
+ "-sequence" (symbol-name mh-unseen-seq)))
+ (set-process-filter mh-speed-flists-process
+ 'mh-speed-parse-flists-output)))))))
+
+;; Copied from mh-make-folder-list-filter...
+(defun mh-speed-parse-flists-output (process output)
+ "Parse the incremental results from flists.
+PROCESS is the flists process and OUTPUT is the results that must be handled
+next."
+ (let ((prevailing-match-data (match-data))
+ (position 0)
+ line-end line folder unseen total)
+ (unwind-protect
+ (while (setq line-end (string-match "\n" output position))
+ (setq line (format "%s%s"
+ mh-speed-partial-line
+ (substring output position line-end))
+ mh-speed-partial-line "")
+ (multiple-value-setq (folder unseen total)
+ (mh-parse-flist-output-line line))
+ (when (and folder unseen total)
+ (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
+ (save-excursion
+ (when (buffer-live-p (get-buffer speedbar-buffer))
+ (set-buffer speedbar-buffer)
+ (speedbar-with-writable
+ (when (get-text-property (point-min) 'mh-level)
+ (let ((pos (gethash folder mh-speed-folder-map))
+ face)
+ (when pos
+ (goto-char pos)
+ (goto-char (line-beginning-position))
+ (cond
+ ((null (get-text-property (point) 'mh-count))
+ (goto-char (line-end-position))
+ (setq face (get-text-property (1- (point)) 'face))
+ (insert (format " (%s/%s)" unseen total))
+ (mh-speed-highlight 'unknown face)
+ (goto-char (line-beginning-position))
+ (add-text-properties (point) (1+ (point))
+ `(mh-count (,unseen . ,total))))
+ ((not (equal (get-text-property (point) 'mh-count)
+ (cons unseen total)))
+ (goto-char (line-end-position))
+ (setq face (get-text-property (1- (point)) 'face))
+ (re-search-backward " " (line-beginning-position) t)
+ (delete-region (point) (line-end-position))
+ (insert (format " (%s/%s)" unseen total))
+ (mh-speed-highlight 'unknown face)
+ (goto-char (line-beginning-position))
+ (add-text-properties
+ (point) (1+ (point))
+ `(mh-count (,unseen . ,total))))))))))))
+ (setq position (1+ line-end)))
+ (set-match-data prevailing-match-data))
+ (setq mh-speed-partial-line (substring output position))))
+
+;;;###mh-autoload
+(defun mh-speed-invalidate-map (folder)
+ "Remove FOLDER from various optimization caches."
+ (interactive (list ""))
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ (let* ((speedbar-update-flag nil)
+ (last-slash (mh-search-from-end ?/ folder))
+ (parent (if last-slash (substring folder 0 last-slash) nil))
+ (parent-position (gethash parent mh-speed-folder-map))
+ (parent-change nil))
+ (remhash parent mh-speed-folders-cache)
+ (remhash folder mh-speed-folders-cache)
+ (when parent-position
+ (let ((parent-kids (mh-speed-folders parent)))
+ (cond ((null parent-kids)
+ (setq parent-change ?+))
+ ((and (null (cdr parent-kids))
+ (equal (if last-slash
+ (substring folder (1+ last-slash))
+ (substring folder 1))
+ (caar parent-kids)))
+ (setq parent-change ? ))))
+ (goto-char parent-position)
+ (when (equal (get-text-property (line-beginning-position) 'mh-folder)
+ parent)
+ (when (get-text-property (line-beginning-position) 'mh-expanded)
+ (mh-speed-toggle))
+ (when parent-change
+ (speedbar-with-writable
+ (mh-speedbar-change-expand-button-char parent-change)
+ (add-text-properties
+ (line-beginning-position) (1+ (line-beginning-position))
+ `(mh-children-p ,(equal parent-change ?+)))))
+ (mh-speed-highlight mh-speed-last-selected-folder
+ 'mh-speedbar-folder-face)
+ (setq mh-speed-last-selected-folder nil)
+ (setq mh-speed-refresh-flag t)))
+ (when (equal folder "")
+ (clrhash mh-speed-folders-cache)))))
+
+;;;###mh-autoload
+(defun mh-speed-add-folder (folder)
+ "Add FOLDER since it is being created.
+The function invalidates the latest ancestor that is present."
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ (let ((speedbar-update-flag nil)
+ (last-slash (mh-search-from-end ?/ folder))
+ (ancestor folder)
+ (ancestor-pos nil))
+ (block while-loop
+ (while last-slash
+ (setq ancestor (substring ancestor 0 last-slash))
+ (setq ancestor-pos (gethash ancestor mh-speed-folder-map))
+ (when ancestor-pos
+ (return-from while-loop))
+ (setq last-slash (mh-search-from-end ?/ ancestor))))
+ (unless ancestor-pos (setq ancestor nil))
+ (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
+ (speedbar-with-writable
+ (mh-speedbar-change-expand-button-char ?+)
+ (add-text-properties
+ (line-beginning-position) (1+ (line-beginning-position))
+ `(mh-children-p t)))
+ (when (get-text-property (line-beginning-position) 'mh-expanded)
+ (mh-speed-toggle))
+ (remhash ancestor mh-speed-folders-cache)
+ (setq mh-speed-refresh-flag t))))
+
+;; Make it slightly more general to allow for [ ] buttons to be changed to
+;; [+].
+(defun mh-speedbar-change-expand-button-char (char)
+ "Change the expansion button character to CHAR for the current line."
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward "\\[.\\]" (line-end-position) t)
+ (speedbar-with-writable
+ (backward-char 2)
+ (delete-char 1)
+ (insert-char char 1 t)
+ (put-text-property (point) (1- (point)) 'invisible nil)
+ ;; make sure we fix the image on the text here.
+ (speedbar-insert-image-button-maybe (- (point) 2) 3)))))
+
+(provide 'mh-speed)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-speed.el ends here
--- /dev/null
+;;; mh-utils.el --- MH-E code needed for both sending and reading
+
+;; Copyright (C) 1993, 1995, 1997, 2000, 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <wohler@newt.com>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Internal support for MH-E package.
+
+;;; Change Log:
+
+;; $Id: mh-utils.el,v 1.34 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+;; Is this XEmacs-land? Located here since needed by mh-customize.el.
+(defvar mh-xemacs-flag (featurep 'xemacs)
+ "Non-nil means the current Emacs is XEmacs.")
+
+(require 'cl)
+(require 'gnus-util)
+(require 'font-lock)
+(require 'mh-loaddefs)
+(require 'mh-customize)
+
+(load "mm-decode" t t) ; Non-fatal dependency
+(load "mm-view" 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)
+(defvar tool-bar-mode)
+
+;;; Autoloads
+(autoload 'gnus-article-highlight-citation "gnus-cite")
+(autoload 'mail-header-end "sendmail")
+(autoload 'Info-goto-node "info")
+(unless (fboundp 'make-hash-table)
+ (autoload 'make-hash-table "cl"))
+
+;;; Set for local environment:
+;;; mh-progs and mh-lib used to be set in paths.el, which tried to
+;;; figure out at build time which of several possible directories MH
+;;; was installed into. But if you installed MH after building Emacs,
+;;; this would almost certainly be wrong, so now we do it at run time.
+
+(defvar mh-progs nil
+ "Directory containing MH commands, such as inc, repl, and rmm.")
+
+(defvar mh-lib nil
+ "Directory containing the MH library.
+This directory contains, among other things, the components file.")
+
+(defvar mh-lib-progs nil
+ "Directory containing MH helper programs.
+This directory contains, among other things, the mhl program.")
+
+(defvar mh-nmh-flag nil
+ "Non-nil means nmh is installed on this system instead of MH.")
+
+;;;###autoload
+(put 'mh-progs 'risky-local-variable t)
+;;;###autoload
+(put 'mh-lib 'risky-local-variable t)
+;;;###autoload
+(put 'mh-lib-progs 'risky-local-variable t)
+;;;###autoload
+(put 'mh-nmh-flag 'risky-local-variable t)
+
+;;; 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))
+
+;;; Macro to generate correct code for different emacs variants
+
+(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
+ "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
+In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
+variable `transient-mark-mode' is active."
+ (cond (mh-xemacs-flag ;XEmacs
+ `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
+ ((not check-transient-mark-mode-flag) ;GNU Emacs
+ `(and (boundp 'mark-active) mark-active))
+ (t ;GNU Emacs
+ `(and (boundp 'transient-mark-mode) transient-mark-mode
+ (boundp 'mark-active) mark-active))))
+
+;;; Additional header fields that might someday be added:
+;;; "Sender: " "Reply-to: "
+
+(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
+ "Regexp to find the number of a message in a scan line.
+The message's number must be surrounded with \\( \\)")
+
+(defvar mh-scan-msg-overflow-regexp "^\\?[0-9]"
+ "Regexp to find a scan line in which the message number overflowed.
+The message's number is left truncated in this case.")
+
+(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
+ "Regexp to find message number width in an scan format.
+The message number width must be surrounded with \\( \\).")
+
+(defvar mh-scan-msg-format-string "%d"
+ "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]"
+ "Format string containing a regexp matching the scan listing for a message.
+The desired message's number will be an argument to format.")
+
+(defvar mh-default-folder-for-message-function nil
+ "Function to select a default folder for refiling or Fcc.
+If set to a function, that function is called with no arguments by
+`\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when
+prompting the user for a folder. The function is called from within a
+`save-excursion', with point at the start of the message. It should
+return the folder to offer as the refile or Fcc folder, as a string
+with a leading `+' sign. It can also return an empty string to use no
+default, or nil to calculate the default the usual way.
+NOTE: This variable is not an ordinary hook;
+It may not be a list of functions.")
+
+(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-cmd-note 4
+ "Column to insert notation.
+Use `mh-set-cmd-note' to modify it.
+This value may be dynamically updated if `mh-adaptive-cmd-note-flag' is
+non-nil and `mh-scan-format-file' is t.
+Note that the first column is column number 0.")
+(make-variable-buffer-local 'mh-cmd-note)
+
+(defvar mh-note-seq "%"
+ "String whose first character is used to notate messages in a sequence.")
+
+(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'.")
+
+;; Variables for MIME display
+
+;; Structure to keep track of MIME handles on a per buffer basis.
+(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.")
+
+;; Needed by mh-comp.el and mh-mime.el
+(defvar mh-mhn-compose-insert-flag nil
+ "Non-nil means MIME insertion was done.
+Triggers an automatic call to `mh-edit-mhn' in `mh-send-letter'.
+This variable is buffer-local.")
+(make-variable-buffer-local 'mh-mhn-compose-insert-flag)
+
+(defvar mh-mml-compose-insert-flag nil
+ "Non-nil means that a MIME insertion was done.
+This buffer-local variable is used to remember if a MIME insertion was done.
+Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.")
+(make-variable-buffer-local 'mh-mml-compose-insert-flag)
+
+;; Copy of `goto-address-mail-regexp'
+(defvar mh-address-mail-regexp
+ "[-a-zA-Z0-9._]+@[-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.
+;;;###mh-autoload
+(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-in-header-p ()
+ "Return non-nil if the point is in the header of a draft message."
+ (< (point) (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 (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 (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 "0-9_.@-`'\"")))
+ (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.")
+
+(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 (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:
+
+;; The value of `mh-folder-list-change-hook' is called whenever
+;; mh-folder-list variable is set.
+;; List of folder names for completion.
+(defvar mh-folder-list nil)
+
+;; 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)
+
+;; Name of MH-E scratch buffer.
+(defconst mh-temp-buffer " *mh-temp*")
+
+;; Name of the MH-E folder list buffer.
+(defconst mh-temp-folders-buffer "*Folders*")
+
+;; Name of the MH-E sequences list buffer.
+(defconst mh-temp-sequences-buffer "*Sequences*")
+
+;; 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.")
+
+;;; 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 1)
+
+(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 1)
+
+(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))
+
+;;;###mh-autoload
+(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)
+ (and (fboundp 'deactivate-mark) (deactivate-mark))
+ (unwind-protect
+ (prog1 (call-interactively (function ,original-function))
+ (setq normal-exit t))
+ (and (fboundp 'deactivate-mark) (deactivate-mark))
+ (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-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)
+
+;;; Populate mh-show-mode-map
+(gnus-define-keys mh-show-mode-map
+ " " mh-show-page-msg
+ "!" mh-show-refile-or-write-again
+ "," 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
+ "l" mh-show-print-msg
+ "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
+ "S" mh-show-sort-folder
+ "f" mh-show-visit-folder
+ "i" mh-index-search
+ "k" mh-show-kill-folder
+ "l" mh-show-list-folders
+ "o" mh-show-visit-folder
+ "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-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)
+
+(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-prefix-help
+ "s" mh-show-narrow-to-subject
+ "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
+ "v" mh-show-toggle-mime-part
+ "o" mh-show-save-mime-part
+ "i" mh-show-inline-mime-part
+ "\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]
+ ["Delete Rest of Same Subject" mh-show-delete-subject 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]
+ ["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)
+
+(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."
+ (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)
+ (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))
+ (if (and (boundp 'tool-bar-mode) tool-bar-mode)
+ (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
+ (when mh-decode-mime-flag
+ (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))))
+
+(defvar mh-show-xface-function
+ (cond ((and mh-xemacs-flag (locate-library "x-face"))
+ (load "x-face" t t)
+ (if (fboundp 'x-face-xmas-wl-display-x-face)
+ #'x-face-xmas-wl-display-x-face
+ #'ignore))
+ ((and (not mh-xemacs-flag) (>= emacs-major-version 21))
+ (load "x-face-e21" t t)
+ (if (fboundp 'x-face-decode-message-header)
+ #'x-face-decode-message-header
+ #'ignore))
+ (t #'ignore))
+ "Determine at run time what function should be called to display X-Face.")
+
+(defun mh-show-xface ()
+ "Display X-Face."
+ (when (and mh-show-use-xface-flag
+ (or mh-decode-mime-flag mhl-formfile
+ mh-clean-message-header-flag))
+ (funcall mh-show-xface-function)))
+
+(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)
+ "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
+`mh-summary-height') and the show buffer below it.
+If the message is already visible, display the start of the 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)
+ (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-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)
+ (clean-message-header mh-clean-message-header-flag)
+ (show-window (get-buffer-window mh-show-buffer)))
+ (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)
+ (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) mh-summary-height)))
+ (mh-recenter nil)
+ (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))
+ (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
+`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-decode-quoted-printable ()
+ "Run mimedecode on current buffer, replacing its contents."
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (when (and (re-search-forward
+ "^content-transfer-encoding:[ \t]*quoted-printable"
+ (if mh-decode-mime-flag (mail-header-end) nil) t)
+ (search-forward "\n\n" nil t))
+ (message "Converting quoted-printable characters...")
+ (let ((modified (buffer-modified-p))
+ (command "mimedecode"))
+ (shell-command-on-region (point-min) (point-max) command t t)
+ (if (fboundp 'deactivate-mark)
+ (deactivate-mark))
+ (set-buffer-modified-p modified))
+ (message "Converting quoted-printable characters... done."))))
+
+(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 (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-headers)
+ (visible-headers mh-visible-headers)
+ (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 msg-filename))
+ (if mh-decode-quoted-printable-flag
+ (mh-decode-quoted-printable))
+ ;; 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))
+ ;; 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)))
+ ;; 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)
+ (mh-show-mode)
+ (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)))
+ (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."
+ (let ((case-fold-search t)
+ (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))))
+ (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."
+ (save-excursion
+ (if (or (null msg)
+ (mh-goto-msg msg t t))
+ (with-mh-folder-updating (t)
+ (beginning-of-line)
+ (forward-char offset)
+ (delete-char 1)
+ (insert notation)))))
+
+(defun mh-find-msg-get-num (step)
+ "Return the message number of the message nearest the cursor.
+Jumps over non-message lines, such as inc errors.
+If we have to search, STEP tells whether to search forward or backward."
+ (or (mh-get-msg-num nil)
+ (let ((msg-num nil)
+ (nreverses 0))
+ (while (and (not msg-num)
+ (< nreverses 2))
+ (cond ((eobp)
+ (setq step -1)
+ (setq nreverses (1+ nreverses)))
+ ((bobp)
+ (setq step 1)
+ (setq nreverses (1+ nreverses))))
+ (forward-line step)
+ (setq msg-num (mh-get-msg-num nil)))
+ msg-num)))
+
+(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-msg-search-pat (n)
+ "Return a search pattern for message N in the scan listing."
+ (format mh-scan-msg-search-regexp n))
+
+(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 mail-user-agent)
+(defvar read-mail-command)
+
+(defvar mh-find-path-run nil
+ "Non-nil if `mh-find-path' has been run already.")
+
+(defun mh-find-path ()
+ "Set `mh-progs', `mh-lib', and `mh-lib-progs' variables.
+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-find-progs)
+ (unless mh-find-path-run
+ (setq mh-find-path-run t)
+ (setq read-mail-command 'mh-rmail)
+ (setq mail-user-agent 'mh-e-user-agent))
+ (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 "~"))))
+ (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)))
+ (and mh-auto-folder-collect-flag
+ (let ((mh-no-install t)) ;only get folders if MH installed
+ (condition-case err
+ (mh-make-folder-list-background)
+ (file-error))))) ;so don't complain if not installed
+
+(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)))
+
+(defun mh-find-progs ()
+ "Find the directories for the installed MH/nmh binaries and config files.
+Set the `mh-progs' and `mh-lib', and `mh-lib-progs' variables to the
+directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
+ (unless (and mh-progs mh-lib mh-lib-progs)
+ (let ((path (or (mh-path-search exec-path "mhparam")
+ (mh-path-search '("/usr/local/nmh/bin" ; nmh default
+ "/usr/local/bin/mh/"
+ "/usr/local/mh/"
+ "/usr/bin/mh/" ;Ultrix 4.2, Linux
+ "/usr/new/mh/" ;Ultrix <4.2
+ "/usr/contrib/mh/bin/" ;BSDI
+ "/usr/pkg/bin/" ; NetBSD
+ "/usr/local/bin/"
+ )
+ "mhparam"))))
+ (if (not path)
+ (error "Unable to find the `mhparam' command"))
+ (save-excursion
+ (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
+ (set-buffer tmp-buffer)
+ (unwind-protect
+ (progn
+ (call-process (expand-file-name "mhparam" path)
+ nil '(t nil) nil "libdir" "etcdir")
+ (goto-char (point-min))
+ (if (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$"
+ nil t)
+ (setq mh-lib-progs (match-string 1)
+ mh-lib mh-lib-progs
+ mh-progs path))
+ (goto-char (point-min))
+ (if (search-forward-regexp "^etcdir:\\s-\\(\\S-+\\)\\s-*$"
+ nil t)
+ (setq mh-lib (match-string 1)
+ mh-nmh-flag t)))
+ (kill-buffer tmp-buffer))))
+ (unless (and mh-progs mh-lib mh-lib-progs)
+ (error "Unable to determine paths from `mhparam' command")))))
+
+(defun mh-path-search (path file)
+ "Search PATH, a list of directory names, for FILE.
+Returns the element of PATH that contains FILE, or nil if not found."
+ (while (and path
+ (not (funcall 'mh-file-command-p
+ (expand-file-name file (car path)))))
+ (setq path (cdr path)))
+ (car path))
+
+(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 "scan" 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)
+ "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."
+ (let ((entry (mh-find-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))))))
+ (cond ((not internal-flag)
+ (mh-add-to-sequence seq msgs)
+ (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))
+
+(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-folder-hist nil)
+(defvar mh-speed-folder-map)
+
+(defun mh-prompt-for-folder (prompt default can-create
+ &optional default-string)
+ "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.
+The value of `mh-folder-list-change-hook' is a list of functions to be called,
+with no arguments, whenever the cached folder list `mh-folder-list' is
+changed."
+ (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))
+ read-name folder-name)
+ (if (null mh-folder-list)
+ (mh-set-folder-list))
+ (while (and (setq read-name (completing-read prompt mh-folder-list nil nil
+ "+" 'mh-folder-hist))
+ (equal read-name "")
+ (equal default "")))
+ (cond ((or (equal read-name "") (equal read-name "+"))
+ (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 ((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)
+ (when (boundp 'mh-speed-folder-map)
+ (mh-speed-add-folder folder-name))
+ (message "Creating %s...done" folder-name)
+ (setq mh-folder-list (cons (list read-name) mh-folder-list))
+ (run-hooks 'mh-folder-list-change-hook))
+ (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)))
+ ((and (null (assoc read-name mh-folder-list))
+ (null (assoc (concat read-name "/") mh-folder-list)))
+ (setq mh-folder-list (cons (list read-name) mh-folder-list))
+ (run-hooks 'mh-folder-list-change-hook))))
+ folder-name))
+
+(defvar mh-make-folder-list-process nil) ;The background process collecting
+ ;the folder list.
+
+(defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built.
+
+(defvar mh-folder-list-partial-line "") ;Start of last incomplete line from
+ ;folder process.
+
+(defun mh-set-folder-list ()
+ "Set `mh-folder-list' correctly.
+A useful function for the command line or for when you need to
+sync by hand. Format is in a form suitable for completing read.
+The value of `mh-folder-list-change-hook' is a list of functions to be called,
+with no arguments, once the list of folders has been created."
+ (message "Collecting folder names...")
+ (if (not mh-make-folder-list-process)
+ (mh-make-folder-list-background))
+ (while (eq (process-status mh-make-folder-list-process) 'run)
+ (accept-process-output mh-make-folder-list-process))
+ (setq mh-folder-list mh-folder-list-temp)
+ (run-hooks 'mh-folder-list-change-hook)
+ (setq mh-folder-list-temp nil)
+ (delete-process mh-make-folder-list-process)
+ (setq mh-make-folder-list-process nil)
+ (message "Collecting folder names...done"))
+
+(defun mh-make-folder-list-background ()
+ "Start a background process to compute a list of the user's folders.
+Call `mh-set-folder-list' to wait for the result."
+ (cond
+ ((not mh-make-folder-list-process)
+ (unless mh-inbox
+ (mh-find-path))
+ (let ((process-connection-type nil))
+ (setq mh-make-folder-list-process
+ (start-process "folders" nil (expand-file-name "folders" mh-progs)
+ "-fast"
+ (if mh-recursive-folders-flag
+ "-recurse"
+ "-norecurse")))
+ (set-process-filter mh-make-folder-list-process
+ 'mh-make-folder-list-filter)
+ (process-kill-without-query mh-make-folder-list-process)))))
+
+(defun mh-make-folder-list-filter (process output)
+ "Given the PROCESS \"folders -fast\", parse OUTPUT.
+See also `set-process-filter'."
+ (let ((position 0)
+ line-end
+ new-folder
+ (prevailing-match-data (match-data)))
+ (unwind-protect
+ ;; make sure got complete line
+ (while (setq line-end (string-match "\n" output position))
+ (setq new-folder (format "+%s%s"
+ mh-folder-list-partial-line
+ (substring output position line-end)))
+ (setq mh-folder-list-partial-line "")
+ ;; is new folder a subfolder of previous?
+ (if (and mh-folder-list-temp
+ (string-match
+ (regexp-quote
+ (concat (car (car mh-folder-list-temp)) "/"))
+ new-folder))
+ ;; append slash to parent folder for better completion
+ ;; (undone by mh-prompt-for-folder)
+ (setq mh-folder-list-temp
+ (cons
+ (list new-folder)
+ (cons
+ (list (concat (car (car mh-folder-list-temp)) "/"))
+ (cdr mh-folder-list-temp))))
+ (setq mh-folder-list-temp
+ (cons (list new-folder)
+ mh-folder-list-temp)))
+ (setq position (1+ line-end)))
+ (set-match-data prevailing-match-data))
+ (setq mh-folder-list-partial-line (substring output position))))
+
+;;; 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-temp-buffer))
+ (erase-buffer)
+ (apply 'call-process
+ (expand-file-name command mh-progs) nil t nil
+ (mh-list-to-string args))
+ (if (> (buffer-size) 0)
+ (save-window-excursion
+ (switch-to-buffer-other-window mh-temp-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 ((status
+ (if env
+ ;; the shell hacks necessary here shows just how broken Unix is
+ (apply 'call-process "/bin/sh" nil t nil "-c"
+ (format "%s %s ${1+\"$@\"}"
+ env
+ (expand-file-name command mh-progs))
+ command
+ (mh-list-to-string args))
+ (apply 'call-process
+ (expand-file-name command mh-progs) nil t nil
+ (mh-list-to-string args)))))
+ (mh-handle-process-error command status))))
+
+(defun mh-exec-cmd-daemon (command &rest args)
+ "Execute MH command COMMAND with ARGS in the background.
+Any output from command is displayed in an asynchronous pop-up window."
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-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 'mh-process-daemon)))
+
+(defun mh-process-daemon (process output)
+ "PROCESS daemon that puts OUTPUT into a temporary buffer."
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (insert-before-markers output)
+ (display-buffer mh-temp-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.
+STATUS is return value from `call-process'.
+Program output is in current buffer.
+If output is too long to include in error message, display the buffer."
+ (cond ((eq status 0) ;success
+ status)
+ ((stringp status) ;kill string
+ (error "%s: %s" command status))
+ (t ;exit code
+ (cond
+ ((= (buffer-size) 0) ;program produced no error message
+ (error "%s: exit code %d" command status))
+ (t
+ ;; will error message fit on one line?
+ (goto-line 2)
+ (if (and (< (buffer-size) (frame-width))
+ (eobp))
+ (error "%s"
+ (buffer-substring 1 (progn (goto-char 1)
+ (end-of-line)
+ (point))))
+ (display-buffer (current-buffer))
+ (error "%s failed with status %d. See error message in other window"
+ command status)))))))
+
+(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))
+
+(provide 'mh-utils)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-utils.el ends here
--- /dev/null
+;;; mh-xemacs-compat.el --- GNU Emacs Functions needed by XEmacs
+
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: FSF
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Change Log:
+
+;; $Id: mh-xemacs-compat.el,v 1.3 2003/01/08 23:21:16 wohler Exp $
+
+;;; Code:
+
+;;; Some requires:
+(require 'rfc822)
+
+;;; Simple compatibility:
+
+(unless (fboundp 'match-string-no-properties)
+ (defsubst match-string-no-properties (match)
+ (buffer-substring-no-properties
+ (match-beginning match) (match-end match))))
+
+(unless (fboundp 'line-beginning-position)
+ (defalias 'line-beginning-position 'point-at-bol))
+(unless (fboundp 'line-end-position)
+ (defalias 'line-end-position 'point-at-eol))
+
+(unless (fboundp 'timerp)
+ (defalias 'timerp 'itimerp))
+(unless (fboundp 'cancel-timer)
+ (defalias 'cancel-timer 'delete-itimer))
+
+(provide 'mh-xemacs-compat)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-xemacs-compat.el ends here
projects / emacs.git / commitdiff