Mercurial > emacs
changeset 49120:30c4902b654d
Upgraded to MH-E version 7.1.
| author | Bill Wohler <wohler@newt.com> |
|---|---|
| date | Wed, 08 Jan 2003 23:21:16 +0000 |
| parents | 938f153410ae |
| children | b24e4fdd8b50 |
| files | etc/ChangeLog etc/MH-E-NEWS etc/NEWS lisp/ChangeLog 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 lisp/toolbar/alias.pbm lisp/toolbar/alias.xpm |
| diffstat | 20 files changed, 6738 insertions(+), 4334 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/ChangeLog Wed Jan 08 22:16:12 2003 +0000 +++ b/etc/ChangeLog Wed Jan 08 23:21:16 2003 +0000 @@ -1,3 +1,7 @@ +2003-01-08 Bill Wohler <wohler@newt.com> + + * MH-E-NEWS: Upgraded to MH-E version 7.1. + 2003-01-01 Steven Tamm <steventamm@mac.com> * MACHINES: Added pointer to Mac OS X install instructions.
--- a/etc/MH-E-NEWS Wed Jan 08 22:16:12 2003 +0000 +++ b/etc/MH-E-NEWS Wed Jan 08 23:21:16 2003 +0000 @@ -1,3 +1,209 @@ +* Changes in mh-e 7.1 + +This release includes the new features of multiple identities and +alias completion. In addition, indexed searching has been revamped. +Various other features have been added and a few bugs were fixed. + +** New Features in MH-E 7.1 + +*** Multiple Identities + +MH-E now supports multiple identities (closes SF #628782). That means +that you can have different From and Organization header fields (or +any other header field of your choice) as well as different signatures +depending on your context. Usually, the contexts are home and work. + +Add your identities to the variable `mh-identity-list' and set the +default identity with the variable `mh-identity-default'. Your +identity can be switched on the fly by using the Identity menu or by +calling "M-x mh-insert-identity RET". + +This functionality can be customized within the mh-identity group. + +*** Alias Completion and Harvesting + +The contributed file mh-alias.el has been rewritten and incorporated +into MH-E. + +By default, aliases are culled from the system files +"/etc/nmh/MailAliases," "/usr/lib/mh/MailAliases," and "/etc/passwd" +(see `mh-alias-system-aliases') and from your "AliasFile" MH profile +component. These aliases are then used for completion in the +minibuffer when entering addresses. Within the header of the message +draft, "M-TAB (mh-letter-complete)" is used to do alias completion. + +The package also provides for alias creation based upon the From +header field of the current message. Use the lasso button +(mh-alias-grab-from-field). + +This functionality can be customized within the mh-alias group. + +*** Index Folder Updates + +The results of an index search "F i (mh-index-search)" are now stored +in a bona fide folder so that you can refile messages and reply to +messages directly from the result folder. This folder is a sub-folder +of +mhe-index and the name is based upon the search string (closes SF +#623321). + +If a prefix argument is given then the search in the current index +buffer is redone. + +The index folder lists the names of the source folders as before. +However, instead of using RET on the name of the folder to visit the +folder, use "v (mh-show-index-visit-folder)" anywhere within the +results to visit that folder narrowed to the results of the search. +Additional functions have been added to navigate including "TAB +(mh-index-next-folder)", and "SHIFT-TAB (mh-index-previous-folder)." + +*** mh-visit-folder Interface Updated + +A change was made to the prompting of the message range. In general, +you can use the same format for messages and sequences as you can in +MH with a single exception: a single number means to scan that many +messages, rather than scan that message number. This turns out to be +much more useful than visiting a single message and is consistent with +Gnus and the MH-E speedbar (closes SF #655891). + +If mh-visit-folder is called non-interactively and RANGE is nil then +all messages are displayed. This behavior is now documented and +provides backwards compatibility. + +*** Threading Improvements + +After incorporating new mail into a threaded folder, unseen messages +can be spread about. Two new functions have been added to make it +easier to find them: these are "M-n (mh-next-unread-msg)" and "M-p +(mh-previous-unread-msg)" (closes SF #630328) + +Two new functions were added to delete and refile threads. They are "T +d (mh-thread-delete)" and "T o (mh-thread-refile)" respectively +(closes SF #630493). + +In addition, the key "k" used to be bound to the function +`mh-delete-subject': it is now bound to +`mh-show-delete-subject-or-thread'. + +New functions to navigate threads include "T u (mh-thread-ancestor)", +which can jump to the root message of the current thread given an +optional argument, "T n (mh-thread-next-sibling)", and "T p +(mh-thread-previous-sibling)" + +*** Refiling of Messages in Region + +If mark is active and `transient-mark-mode' is enabled then all the +messages in the region are refiled. + +*** vCard Handling + +If a signature cannot be identified, but there is a vCard attachment, +then that vCard will be presented as a signature (closes SF #649216). + +*** New Info Added to mh-version + +Information about Gnus versions available at both compile time and run +time has been added. + +** New Variables in MH-E 7.1 + +The defcustom groups were reorganized. Rather than iterate the +specific changes here, you are invited to browse the groups with "M-x +mh-customize RET". + +*** mh-alias-completion-ignore-case-flag + +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. + +*** mh-alias-expand-aliases-flag + +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. + +*** mh-alias-flash-on-comma + +Specify whether to flash the translation of the alias or warn if there +isn't a translation of the alias. + +*** mh-alias-insert-file + +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. + +*** mh-alias-insertion-location + +Specifies where new aliases are entered in alias files. Options are +sorted alphabetically (the default), at the top of the file or at the +bottom. + +*** mh-alias-local-users + +If t, local users are completed in MH-E To: and Cc: prompts. + +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. + +*** mh-alias-system-aliases + +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. + +*** mh-identity-default + +Default identity to use when `mh-letter-mode' is called. + +*** mh-identity-list + +List holding MH-E identity. + +*** mh-invisible-header-fields + +Simple user interface to change `mh-invisible-headers'. + +*** mh-letter-complete-function + +Function to call when completing outside of fields specific to +aliases. By default, it is bound to 'ispell-complete-word. + +*** mh-show-threads-flag + +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' (closes SF #646794). + +*** mh-tool-bar-folder-buttons + +Buttons to include in MH-E folder/show toolbar. + +*** mh-tool-bar-letter-buttons + +Buttons to include in MH-E letter toolbar. + +** Bug Fixes in MH-E 7.1 + +*** mh-get-new-mail + +Call new function `mh-add-cur-notation' to undo the work of +`mh-remove-cur-notation' if there was no new mail (closes SF #647681). + +*** mh-set-cmd-note + +No longer updates the default `mh-cmd-note' value. This resulted in +the misplacement of the current mark when the message number width +changed (closes SF #643701). + + + * Changes in mh-e 7.0 This is a major release which includes a lot of new features including @@ -62,7 +268,7 @@ Because of this, the MH-Show buffer is now read-only (closes SF #493749 and SF #527946) and you now have to use "M (mh-modify)" to edit a message. - + *** Better Scanning You no longer have to modify your scan format if your folders have
--- a/etc/NEWS Wed Jan 08 22:16:12 2003 +0000 +++ b/etc/NEWS Wed Jan 08 23:21:16 2003 +0000 @@ -90,7 +90,7 @@ ** MH-E changes. -Upgraded to mh-e version 7.0. There have been major changes since +Upgraded to MH-E version 7.1. There have been major changes since version 5.0.2; see MH-E-NEWS for details. +++
--- a/lisp/ChangeLog Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/ChangeLog Wed Jan 08 23:21:16 2003 +0000 @@ -1,3 +1,13 @@ +2003-01-08 Bill Wohler <wohler@newt.com> + + * mail/mh-alias.el, mail/mh-customize.el, mail/mh-identity.el, + mail/mh-loaddefs.el, toolbar/alias.pbm, toolbar/alias.xpm: Added. + + * mail/mh-comp.el, mail/mh-e.el, mail/mh-funcs.el, + mail/mh-index.el, mail/mh-mime.el, mail/mh-pick.el, + mail/mh-seq.el, mail/mh-speed.el, mail/mh-utils.el, + mail/mh-xemacs-compat.el: Upgraded to MH-E version 7.1. + 2003-01-08 Kim F. Storm <storm@cua.dk> * mail/undigest.el (unforward-rmail-message): Don't use global
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mail/mh-alias.el Wed Jan 08 23:21:16 2003 +0000 @@ -0,0 +1,590 @@ +;;; 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)) + + +;;; 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))) + + +;;; 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)))) + +;;; 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
--- a/lisp/mail/mh-comp.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-comp.el Wed Jan 08 23:21:16 2003 +0000 @@ -30,12 +30,11 @@ ;;; Change Log: -;; $Id: mh-comp.el,v 1.145 2002/11/29 16:49:43 wohler Exp $ +;; $Id: mh-comp.el,v 1.164 2003/01/07 21:16:25 satyaki Exp $ ;;; Code: (require 'mh-e) -(require 'mh-utils) (require 'gnus-util) (require 'easymenu) (require 'cl) @@ -45,94 +44,11 @@ (defvar font-lock-defaults) (defvar mark-active) (defvar sendmail-coding-system) -(defvar tool-bar-mode) - -;;; autoloads from mh-mime -(autoload 'mh-press-button "mh-mime") - -;;; autoloads for mh-seq -(autoload 'mh-notate-seq "mh-seq") - -(autoload 'mh-compose-insertion "mh-mime" - "Add a MIME directive to insert 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.") - -(autoload '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.") - -(autoload '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. -See also \\[mh-edit-mhn]." t) - -(autoload '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. -See also \\[mh-edit-mhn]." t) - -(autoload '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. -See also \\[mh-edit-mhn]." t) - -(autoload '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 another message in this one. -See also \\[mh-edit-mhn]." t) +(defvar mh-identity-list) +(defvar mh-identity-default) +(defvar mh-identity-menu) -(autoload '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 mhn program is part of MH version 6.8 or later. -The \\[mh-revert-mhn-edit] command undoes this command. -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)." t) - -(autoload 'mh-revert-mhn-edit "mh-mime" - "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. -Optional non-nil argument means don't ask for confirmation." t) - -(autoload 'mh-mml-to-mime "mh-mime" - "Compose MIME message from mml directives.") - -(autoload '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.") - -(autoload '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 -`\\[message-send-and-exit]' or `\\[message-send]'. - -Message dispostion is \"inline\" is INLINE is non-nil, else the default is -\"attachment\". -FILE is the name of the file to attach. TYPE is its content-type, a -string of the form \"type/subtype\". DESCRIPTION is a one-line -description of the attachment.") - -(autoload 'mh-mml-secure-message-sign-pgpmime "mh-mime" - "Add MML tag to encrypt/sign the entire message.") - -(autoload 'mh-mml-secure-message-encrypt-pgpmime "mh-mime" - "Add MML tag to encrypt and sign the entire message. -If called with a prefix argument, only encrypt (do NOT sign).") - -;;; Other Autoloads. - +;;; Autoloads (autoload 'Info-goto-node "info") (autoload 'mail-mode-fill-paragraph "sendmail") (autoload 'mm-handle-displayed-p "mm-decode") @@ -163,11 +79,6 @@ ;;; Site customization (see also mh-utils.el): -(defgroup mh-compose nil - "MH-E functions for composing messages." - :prefix "mh-" - :group 'mh) - (defvar mh-send-prog "send" "Name of the MH send program. Some sites need to change this because of a name conflict.") @@ -217,148 +128,6 @@ `mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, to 'autosupercite.") -;;; Personal preferences: - -(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-compose) - -(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-compose) - -(defcustom mh-insert-x-mailer-flag t - "*Non-nil means append an X-Mailer field to the header." - :type 'boolean - :group 'mh-compose) - -(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-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-compose) - -(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-compose) - -(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-compose) - -(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-compose) - -(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-compose) - -(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-compose) - -(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-compose) - -(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-compose) - -(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-compose) - (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 @@ -378,65 +147,19 @@ 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.") -(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-compose) - -(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-compose) - -;;; Hooks: - -(defcustom mh-letter-mode-hook nil - "Invoked in `mh-letter-mode' on a new letter." - :type 'hook - :group 'mh-compose) - -(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-compose) - -(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-compose) - -(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-compose) - (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 - )))) + (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:" @@ -444,8 +167,8 @@ 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:")) + ("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) @@ -456,9 +179,9 @@ (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)) + (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.") @@ -486,7 +209,7 @@ (mh-find-path) (call-interactively 'mh-send)) -(defvar mh-error-if-no-draft nil) ;raise error over using old draft +(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) @@ -505,8 +228,8 @@ ;; XEmacs needs this: ;;;###autoload (defun mh-user-agent-compose (&optional to subject other-headers continue - switch-function yank-action - send-actions) + 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. @@ -523,9 +246,10 @@ (mh-send to "" subject) (while other-headers (mh-insert-fields (concat (car (car other-headers)) ":") - (cdr (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. @@ -533,11 +257,11 @@ 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)) + (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 @@ -545,17 +269,18 @@ (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))))) + (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) + 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' @@ -563,27 +288,28 @@ 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))) + (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."))) + (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-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. + "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. @@ -592,90 +318,93 @@ 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-read-address "Cc: ") + (cond ((mh-mark-active-p t) - (mh-region-to-sequence (region-beginning) (region-end)) - 'region) + (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 (if (numberp msg-or-seq) - (list msg-or-seq) - (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))))) + (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) + 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:"))) + (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)) - (mail-header-separator mh-mail-header-separator) - (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\\)?$" 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\\)?$" 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))))) + (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))) + (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))))))) + ;; 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 @@ -689,57 +418,59 @@ (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))) + (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))) + (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) + "^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)))) + (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)) + "-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))) + (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")))) @@ -754,9 +485,9 @@ (if buffer (set-buffer buffer)) (cond ((eq major-mode 'mh-show-mode) - (let ((number-start (search "/" buffer-file-name :from-end t))) - (car (read-from-string (subseq buffer-file-name - (1+ number-start)))))) + (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)) @@ -768,6 +499,7 @@ (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 @@ -810,11 +542,11 @@ (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 '()))) + (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))) @@ -841,6 +573,7 @@ (mh-yank-cur-msg)) (mh-letter-mode-message)))) +;;;###mh-autoload (defun mh-send (to cc subject) "Compose and send a letter. @@ -852,13 +585,14 @@ 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: "))) + (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. @@ -871,9 +605,9 @@ 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: "))) + (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)))) @@ -882,38 +616,38 @@ 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))) + (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 + "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) + ;(and (boundp 'mh-etc) mh-etc) ))) - components) - (t - (error (format "Can't find components file \"%s\"" - components))))) - nil))) + 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) + to subject cc + nil nil config) (mh-letter-mode-message)))) (defun mh-read-draft (use initial-contents delete-contents-file) @@ -927,42 +661,42 @@ 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)))))) + (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)))) + (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 + (save-buffer)) ; Do not reuse draft name (buffer-name)) (defun mh-new-draft-name () @@ -975,11 +709,11 @@ "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 (symbolp msg) - (mh-notate-seq msg note (1+ mh-cmd-note)) - (mh-notate msg note (1+ mh-cmd-note))))))) + (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. @@ -988,14 +722,14 @@ (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))))))) + (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. @@ -1003,10 +737,10 @@ 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))) + (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. @@ -1014,10 +748,10 @@ 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 start (point)))) + (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 @@ -1028,9 +762,9 @@ 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)))) + (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) @@ -1038,11 +772,14 @@ (if (re-search-forward "^-*$" nil nil) (forward-line arg))) - -(defun mh-read-address (prompt) - "Read a To: or Cc: address, prompting in the minibuffer with PROMPT. -May someday do completion on aliases." - (read-string prompt)) +(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)))))) @@ -1050,37 +787,6 @@ (put 'mh-letter-mode 'mode-class 'special) -;;; Support for emacs21 toolbar using gnus/message.el icons (and code). -(eval-when-compile (defvar tool-bar-map)) -(defvar mh-letter-tool-bar-map nil) -(when (and (fboundp 'tool-bar-add-item) - tool-bar-mode) - (setq mh-letter-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - (tool-bar-add-item "mail_send" 'mh-send-letter 'mh-lettertoolbar-send - :help "Send this letter") - (tool-bar-add-item "attach" 'mh-compose-insertion - 'mh-lettertoolbar-compose - :help "Insert attachment") - (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell - :help "Check spelling") - (tool-bar-add-item-from-menu 'save-buffer "save") - (tool-bar-add-item-from-menu 'undo "undo") - (tool-bar-add-item-from-menu 'kill-region "cut") - (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy") - (tool-bar-add-item "close" 'mh-fully-kill-draft 'mh-lettertoolbar-kill - :help "Kill this draft") - (tool-bar-add-item "preferences" (lambda () - (interactive) - (customize-group "mh-compose")) - 'mh-lettertoolbar-customize - :help "MH-E composition preferences") - (tool-bar-add-item "help" (lambda () - (interactive) - (Info-goto-node "(mh-e)Draft Editing")) - 'mh-lettertoolbar-help :help "Help") - tool-bar-map))) - ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) (eval-when-compile (defvar mh-letter-menu nil)) (cond @@ -1094,17 +800,23 @@ ["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] + ["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 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)] + ;; 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 @@ -1134,7 +846,7 @@ 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 @@ -1152,10 +864,13 @@ When you have finished composing, type \\[mh-send-letter] to send the message using the MH mail handling system. -If MH MIME directives are added manually, you must first run \\[mh-edit-mhn] -before sending the message. MIME directives that are added by MH-E commands -such as \\[mh-mhn-compose-insertion] are processed automatically when the -message is sent. +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. @@ -1185,21 +900,21 @@ (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]*")) + (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]*")) + (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)) + "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" + "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" + "-- $\\|---+$\\|" + page-delimiter)) (setq paragraph-separate paragraph-start) ;; --- End of code from sendmail.el --- @@ -1219,16 +934,17 @@ (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. + ;; 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) + (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 + (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 + ;; 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))) @@ -1238,7 +954,7 @@ 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)) (do-auto-fill))) (defun mh-insert-header-separator () @@ -1247,8 +963,9 @@ (goto-char (point-min)) (rfc822-goto-eoh) (if (looking-at "$") - (insert mh-mail-header-separator)))) + (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 @@ -1257,48 +974,52 @@ (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)) + 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))))) + (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))) + "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))))) + (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 @@ -1307,9 +1028,10 @@ (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))) + (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) @@ -1348,21 +1070,21 @@ (mh-version) (set-buffer mh-temp-buffer) (if mh-nmh-flag - (search-forward-regexp "^nmh-\\(\\S +\\)") - (search-forward-regexp "^MH \\(\\S +\\)" nil t)) + (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 + (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))) + 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)))) + (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." @@ -1396,10 +1118,10 @@ (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) + 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 @@ -1414,6 +1136,16 @@ (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) @@ -1422,28 +1154,32 @@ (setq mh-previous-window-config config) (setq mode-line-buffer-identification (list "{%b}")) (if (and (boundp 'mh-compose-letter-function) - 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))))) + (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.")))) + (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-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 @@ -1458,70 +1194,72 @@ (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 + (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 ) + ;; 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)))) + '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))) + (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))) + (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:")))) + (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)))) + (y-or-n-p "Kill draft buffer? ")) + (kill-buffer draft-buffer) + (if config + (set-window-configuration config)))) (if arg - (message "Sending...done") + (message "Sending...done") (message "Sending...backgrounded")))) +;;;###mh-autoload (defun mh-insert-letter (folder message verbatim) "Insert a message into the current letter. -Removes the message's headers using `mh-invisible-headers'. Prefixes each -non-blank line with `mh-ins-buf-prefix', unless `mh-yank-from-start-of-msg' -is set for supercite and then use it to format the message. +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 mh-sent-from-msg - (format " [%d]" mh-sent-from-msg) - ""))) - current-prefix-arg)) + (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))) @@ -1530,9 +1268,9 @@ (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 + (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 () @@ -1553,6 +1291,7 @@ ((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 @@ -1569,13 +1308,13 @@ (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)) + (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) @@ -1605,26 +1344,26 @@ (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)) + (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 + (push-mark) ;Needed for sc-cite-original (goto-char (point-min)) ;Needed for sc-cite-original - (mh-insert-prefix-string mh-ins-buf-prefix) + (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))))) + ;; 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) @@ -1640,8 +1379,7 @@ (while can-move-forward (cond ((and (not (get-text-property (point) 'mh-data)) in-button) - (delete-region (save-excursion (forward-line -1) (point)) - (point)) + (delete-region (1- (point)) (point)) (setq in-button nil)) ((get-text-property (point) 'mh-data) (delete-region (point) @@ -1663,29 +1401,30 @@ (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)) + (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))) + (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 () @@ -1700,6 +1439,7 @@ (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. @@ -1715,57 +1455,70 @@ (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-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) + "\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. -(defun mh-customize () - "Customize MH-E variables." - (interactive) - (customize-group 'mh)) - (provide 'mh-comp) ;;; Local Variables: +;;; indent-tabs-mode: nil ;;; sentence-end-double-space: nil ;;; End:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mail/mh-customize.el Wed Jan 08 23:21:16 2003 +0000 @@ -0,0 +1,1751 @@ +;;; 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) + + + +;;; 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))) + + + +;;; 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) + + + +;;; 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
--- a/lisp/mail/mh-e.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-e.el Wed Jan 08 23:21:16 2003 +0000 @@ -4,7 +4,7 @@ ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 7.0 +;; Version: 7.1 ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -79,11 +79,19 @@ ;; 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.198 2002/11/29 15:33:37 wohler Exp $ +;; $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) @@ -93,160 +101,14 @@ ;; Shush the byte-compiler (defvar font-lock-auto-fontify) (defvar font-lock-defaults) -(defvar tool-bar-mode) - -(defconst mh-version "7.0" "Version number of MH-E.") -;;; Initial Autoloads -;;; The autoloads for mh-undo-folder, mh-widen and mh-reply are needed before -;;; they are used to avoid compiler warnings. -(autoload 'mh-undo-folder "mh-funcs" - "Undo all commands in current folder." t) -(autoload 'mh-widen "mh-seq" - "Remove restrictions from current folder, thereby showing all messages." t) -(autoload 'mh-reply "mh-comp" - "Reply to a MESSAGE (default: displayed message). -If optional prefix argument INCLUDEP provided, then include the message -in the reply using filter mhl.reply in your MH directory. -Prompts for type of addresses to reply to: - from sender only, - to sender and primary recipients, - cc/all sender and all recipients. -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) -(autoload 'mh-map-to-seq-msgs "mh-seq") -(autoload 'mh-notate-seq "mh-seq") -(autoload 'mh-destroy-postponed-handles "mh-mime") -(autoload 'mh-press-button "mh-mime") -(autoload 'mh-mime-save-part "mh-mime") -(autoload 'mh-mime-inline-part "mh-mime") -(autoload 'mh-mime-save-parts "mh-mime") -(autoload 'mh-thread-inc "mh-seq") -(autoload 'mh-thread-forget-message "mh-seq") -(autoload 'mh-thread-add-spaces "mh-seq") +(defconst mh-version "7.1" "Version number of MH-E.") +;;; Autoloads (autoload 'Info-goto-node "info") -;;; Hooks: - -(defgroup mh nil - "Emacs interface to the MH mail system." - :group 'mail) - -(defgroup mh-hook nil - "Hooks to MH-E mode." - :prefix "mh-" - :group 'mh) - -(defcustom mh-folder-mode-hook nil - "Invoked in `mh-folder-mode' on a new folder." - :type 'hook - :group 'mh-hook) - -(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-hook) - -(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-hook) - -(defcustom mh-delete-msg-hook nil - "Invoked after marking each message for deletion." - :type 'hook - :group 'mh-hook) - -(defcustom mh-refile-msg-hook nil - "Invoked after marking each message for refiling." - :type 'hook - :group 'mh-hook) - -(defcustom mh-folder-list-change-hook nil - "Invoked whenever the cached folder list `mh-folder-list' is changed." - :type 'hook - :group 'mh-hook) - -(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-hook) - -(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-hook) - -(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-hook) - -;;; Personal preferences: - -(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) - -(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) -(make-variable-buffer-local 'mh-scan-prog) - -(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) - -(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) - -(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) - -(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) - -(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) - (defvar mh-note-deleted "D" "String whose first character is used to notate deleted messages.") @@ -264,22 +126,6 @@ ;;; 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. -(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) - ;; 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 @@ -386,7 +232,7 @@ 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]:\\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 @@ -404,122 +250,13 @@ fontification hint, the second is found in `mh-scan-date-regexp', and the third should match the user name.") -(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) -(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-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) - -(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) - -(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-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) - -;;mh-folder-subject-face is defined in mh-utils since it's needed there -;;for mh-show-subject-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) - -(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) - -(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) - -(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) - (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)) @@ -535,11 +272,11 @@ (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 + '(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 + '(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) @@ -548,8 +285,7 @@ (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)) - ) + '(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 @@ -589,15 +325,15 @@ 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.") + (+ 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.") + (+ 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 @@ -634,13 +370,13 @@ (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)))))) + (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 () @@ -653,15 +389,15 @@ (t (let ((folder mh-current-folder)) (save-excursion - (with-temp-buffer - (unwind-protect - (progn - (call-process (expand-file-name "mark" mh-progs) + (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) '<))))))))) + "-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. @@ -713,31 +449,36 @@ ;;; Internal variables: -(defvar mh-last-destination nil) ;Destination of last refile or write - ;command. +(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-delete-list nil) ;List of msg numbers to delete. -(defvar mh-refile-list nil) ;List of folder names in mh-seq-list. +(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-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-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-first-msg-num nil) ;Number of first msg in buffer. +(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-last-msg-num nil) ;Number of last msg in buffer. +(defvar mh-first-msg-num nil) ;Number of first msg in buffer. -(defvar mh-mode-line-annotation nil) ;Message range displayed 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: @@ -751,12 +492,12 @@ "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)))) + (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)))) + (list "-format" mh-scan-format-file)))) @@ -771,7 +512,7 @@ (mh-find-path) (if arg (call-interactively 'mh-visit-folder) - (mh-inc-folder))) + (mh-inc-folder))) ;;;###autoload (defun mh-nmail (&optional arg) @@ -779,7 +520,7 @@ 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 + (mh-find-path) ; init mh-inbox (if arg (call-interactively 'mh-visit-folder) (mh-visit-folder mh-inbox))) @@ -788,7 +529,6 @@ ;;; 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. @@ -797,8 +537,7 @@ and the mark is active, then the selected region is marked for deletion." (interactive (list (cond ((mh-mark-active-p t) - (mh-region-to-sequence (region-beginning) (region-end)) - 'region) + (mh-region-to-msg-list (region-beginning) (region-end))) (current-prefix-arg (mh-read-seq-default "Delete" t)) (t @@ -811,11 +550,11 @@ 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)))) + (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))) + (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))) (defun mh-execute-commands () "Process outstanding delete and refile requests." @@ -823,9 +562,9 @@ (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-goto-cur-msg) ; after mh-set-scan-mode for efficiency (mh-make-folder-mode-line) - t) ; return t for write-file-functions + t) ; return t for write-file-functions (defun mh-first-msg () "Move to the first message." @@ -846,7 +585,7 @@ (mh-invalidate-show-buffer)) (let ((mh-decode-mime-flag nil) (mhl-formfile nil) - (mh-clean-message-header-flag nil)) + (mh-clean-message-header-flag nil)) (mh-show-msg nil) (mh-in-show-buffer (mh-show-buffer) (goto-char (point-min)) @@ -862,26 +601,36 @@ 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 ((config (current-window-configuration))) - (if (not maildrop-name) - (cond ((not (get-buffer mh-inbox)) - (mh-make-folder mh-inbox) - (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) - (if mh-showing-mode (mh-show)) - (run-hooks 'mh-inc-folder-hook)) + (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)) (looking-at "^$")) + (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp))) (forward-line -1)) (mh-recenter nil)) @@ -891,9 +640,9 @@ (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) + (beginning-of-line) + (mh-maybe-show)) + (t (forward-line -1) (message "No more undeleted messages")))) (defun mh-refile-msg (msg-or-seq folder) @@ -904,32 +653,31 @@ (interactive (list (cond ((mh-mark-active-p t) - (mh-region-to-sequence (region-beginning) (region-end)) - 'region) + (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)))) + (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) + 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-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)) (mh-next-msg)) (defun mh-refile-or-write-again (message) @@ -940,11 +688,11 @@ (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-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 () @@ -980,20 +728,20 @@ (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))) + (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) @@ -1009,8 +757,39 @@ (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")))) + (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. @@ -1025,35 +804,35 @@ (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))) + (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) @@ -1086,14 +865,14 @@ (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))))))) + (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) @@ -1153,11 +932,14 @@ 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 "Range to scan [all]? ") - nil))) + (mh-read-msg-range mh-current-folder t) + nil))) (setq mh-next-direction 'forward) - (mh-reset-threads-and-narrowing) - (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)) + (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. @@ -1165,21 +947,21 @@ 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 ((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))) + (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) + mh-last-destination-write mh-last-destination) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) @@ -1203,33 +985,61 @@ selected region is unmarked." (interactive (list (cond ((mh-mark-active-p t) - (mh-region-to-sequence (region-beginning) (region-end)) - 'region) + (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))) + (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." @@ -1237,22 +1047,33 @@ (mh-find-progs) (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) - ;; MH-E and Emacs versions. - (insert "MH-E " mh-version "\n\n" (emacs-version) "\n\n") + ;; 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")) + (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 "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\t" mh-lib "\n" - "mh-lib-progs:\t" mh-lib-progs "\n\n") + (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") @@ -1260,16 +1081,80 @@ (goto-char (point-min)) (display-buffer mh-temp-buffer)) -(defun mh-visit-folder (folder &optional range) +(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." - (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t) - (mh-read-msg-range "Range [all]? "))) - (let ((config (current-window-configuration))) +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." @@ -1277,17 +1162,18 @@ ;; 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))) + (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))) + (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 + (save-excursion ;; psg - mh-current-folder is nil if mh-summary-height < 4 ! ;; So I added this sanity check. (if (stringp mh-current-folder) @@ -1305,13 +1191,13 @@ (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)) + (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)))) + 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. @@ -1321,28 +1207,59 @@ (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) - (if (null (assoc folder mh-refile-list)) - (push (list folder msg) mh-refile-list) - (pushnew msg (cdr (assoc folder mh-refile-list)))) - (mh-notate msg mh-note-refiled mh-cmd-note) - (run-hooks 'mh-refile-msg-hook))))) + (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))) + (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." @@ -1356,12 +1273,12 @@ (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 + (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 (remove-if #'(lambda (x) (null (cdr x))) - mh-refile-list)))) + (setq mh-refile-list (loop for x in mh-refile-list + unless (null (cdr x)) collect x)))) (mh-notate msg ? mh-cmd-note)) @@ -1463,100 +1380,6 @@ -;;; Support for emacs21 toolbar using gnus/message.el icons (and code). -(eval-when-compile (defvar 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.") -(when (and (fboundp 'tool-bar-add-item) - tool-bar-mode) - (setq mh-folder-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - (tool-bar-add-item "mail" 'mh-inc-folder 'mh-foldertoolbar-inc-folder - :help "Incorporate new mail in Inbox") - (tool-bar-add-item "attach" 'mh-mime-save-parts - 'mh-foldertoolbar-mime-save-parts - :help "Save MIME parts") - - (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg - 'mh-foldertoolbar-prev :help "Previous message") - (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page - :help "Page this message") - (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg - 'mh-foldertoolbar-next :help "Next message") - - (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete - :help "Mark for deletion") - (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile - :help "Refile this message") - (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo - :help "Undo this mark") - (tool-bar-add-item "execute" 'mh-execute-commands 'mh-foldertoolbar-exec - :help "Perform moves and deletes") - - (tool-bar-add-item "show" 'mh-toggle-showing - 'mh-foldertoolbar-toggle-show - :help "Toggle showing message") - - (cond - (mh-tool-bar-reply-3-buttons-flag - (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 "Reply to \"from\"") - (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 "Reply to \"to\"") - (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 "Reply to \"all\"")) - (t - (tool-bar-add-item "mail/reply2" 'mh-reply 'mh-foldertoolbar-reply - :help "Reply to this message"))) - (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose - :help "Compose new message") - - (tool-bar-add-item "rescan" 'mh-rescan-folder 'mh-foldertoolbar-rescan - :help "Rescan this folder") - (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack - :help "Repack this folder") - - (tool-bar-add-item "search" - (lambda (&optional arg) - (interactive "P") - (call-interactively mh-tool-bar-search-function)) - 'mh-foldertoolbar-search :help "Search") - (tool-bar-add-item "fld_open" 'mh-visit-folder 'mh-foldertoolbar-visit - :help "Visit other folder") - - (tool-bar-add-item "preferences" (lambda () - (interactive) - (customize-group "mh")) - 'mh-foldertoolbar-customize - :help "mh-e preferences") - (tool-bar-add-item "help" (lambda () - (interactive) - (Info-goto-node "(mh-e)Top")) - 'mh-foldertoolbar-help :help "Help") - tool-bar-map)) - - (setq mh-folder-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) - (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen - :help "Widen from this sequence") - tool-bar-map)) - ) - - - (defmacro mh-remove-xemacs-horizontal-scrollbar () "Get rid of the horizontal scrollbar that XEmacs insists on putting in." (when mh-xemacs-flag @@ -1571,8 +1394,8 @@ 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 + ''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> @@ -1594,48 +1417,54 @@ \\{mh-folder-mode-map}" (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) + (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-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/" + '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-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-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 ; Indiction this is not the full folder - 'mh-previous-window-config nil) ; Previous window configuration + '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 + (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))) + (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. + 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." @@ -1650,15 +1479,15 @@ 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-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)) + (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 @@ -1670,19 +1499,31 @@ (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) + 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)))) + (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 @@ -1692,19 +1533,19 @@ 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 + (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))) + (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))) @@ -1727,8 +1568,8 @@ (save-excursion (let ((maxcol (1- (window-width))) (old-cmd-note mh-cmd-note) - mh-cmd-note-fmt - msgnum) + 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 @@ -1750,7 +1591,7 @@ (let ((eol (point))) (move-to-column maxcol) (if (<= (point) eol) - (delete-char (- eol (point)))))))) + (delete-char (- eol (point)))))))) ;; now re-read the lost messages (goto-char (point-max)) (prog1 (point) @@ -1760,36 +1601,36 @@ "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)) + (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)) + (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") + (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 + (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)) @@ -1800,27 +1641,29 @@ (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 + (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)) - (mh-notate-user-sequences) - (if new-mail-flag - (progn - (mh-make-folder-mode-line) + (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)))))) + (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. @@ -1830,37 +1673,37 @@ (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))) + (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))) + (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)) + (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)) - (""))))))))) + (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. @@ -1868,60 +1711,62 @@ Optimized for speed (i.e., no regular expressions)." (save-excursion (let ((case-fold-search nil) - (last-line (1- (point-max))) - char) + (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))))) + (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))))) + (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)) - (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))) + (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-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"))))) + (t + (message "No current message"))))) (defun mh-process-or-undo-commands (folder) "If FOLDER has outstanding commands, then either process or discard them. @@ -1929,10 +1774,10 @@ (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))) + (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)) @@ -1949,7 +1794,13 @@ ;; Update the unseen sequence if it exists (mh-update-unseen) - (let ((redraw-needed-flag nil)) + (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))) @@ -1973,17 +1824,18 @@ ;; 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")))) + (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) - ;; Redraw folder window if needed - (when (and (memq 'unthread mh-view-ops) redraw-needed-flag) - (mh-thread-inc folder (point-max)))) + ;; 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)) + (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) @@ -1997,17 +1849,17 @@ 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))))) + (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." @@ -2029,20 +1881,20 @@ 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)) + (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)))) + (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 range-high (car msgs))) ;start new or first range (setq prev (car msgs)) (setq msgs (cdr msgs))) ranges)) @@ -2052,11 +1904,11 @@ 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) + (> msg1 msg2) + t) (if (numberp msg2) - nil + nil (string-lessp msg2 msg1)))) (defun mh-lessp (msg1 msg2) @@ -2080,55 +1932,55 @@ 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))) + (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 + (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) + (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))))) + (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) + 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))) + (mh-notate-seq name mh-note-seq (1+ mh-cmd-note))) (setq seqs (cdr seqs))))) (defun mh-internal-seq (name) @@ -2143,39 +1995,39 @@ 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)) + (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))))))) + (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))) + "-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))) + (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))))) + (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))) + (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) @@ -2184,18 +2036,18 @@ 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)))) + (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 ())) + (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))) + (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)) @@ -2203,17 +2055,26 @@ ;;; User prompting commands. -(defun mh-read-msg-range (prompt) - "Read a list of blank-separated messages using the given PROMPT." - (let* ((buf (read-string prompt)) - (buf-size (length buf)) - (start 0) - (input ())) - (while (< start buf-size) - (let ((next (read-from-string buf start buf-size))) - (setq input (cons (car next) input)) - (setq start (cdr next)))) - (nreverse input))) +(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"))))) @@ -2230,91 +2091,99 @@ ;; 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 + " " 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-next-button - [backtab] mh-prev-button - "\M-\t" mh-prev-button - "\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 - "l" mh-print-msg - "m" mh-alt-send - "n" mh-next-undeleted-msg - "o" mh-refile-msg - "p" mh-previous-undeleted-msg - "q" mh-quit - "r" mh-reply - "s" mh-send - "t" mh-toggle-showing - "u" mh-undo - "x" mh-execute-commands - "|" mh-pipe-msg) + "\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 + "?" 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) + "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) + "?" 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 - "t" mh-toggle-threads) + "?" 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) + "?" 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 + "?" 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) + " " 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 + "?" 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 @@ -2345,23 +2214,23 @@ ;;; `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.") + "[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") + "[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 thread") + "[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")) + "[TAB] next; [SHIFT-TAB] previous")) "Key binding cheat sheet. This is an associative array which is used to show the most common commands. @@ -2375,175 +2244,14 @@ -;;; autoload the other MH-E parts - -;;; mh-comp - -(autoload 'mh-smail "mh-comp" - "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." t) - -(autoload 'mh-smail-other-window "mh-comp" - "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." t) - -(autoload 'mh-edit-again "mh-comp" - "Clean-up a draft or a message 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) - -(autoload 'mh-extract-rejected-mail "mh-comp" - "Extract a letter 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) - -(autoload 'mh-forward "mh-comp" - "Forward a message or message sequence. Defaults to displayed message. -If optional prefix argument provided, then prompt for the message sequence. -See also documentation for `\\[mh-send]' function." t) - -(autoload 'mh-redistribute "mh-comp" - "Redistribute a letter. -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) - -(autoload 'mh-send "mh-comp" - "Compose and send a letter. -The file named by `mh-comp-formfile' will be used as the form. -Do not call this function from outside MH-E; use \\[mh-smail] instead. -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, subject, and cc." t) - -(autoload '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. -See also documentation for `\\[mh-send]' function." t) - -(autoload 'mh-letter-mode "mh-comp" - "Mode for composing letters in MH-E. -For more details, type \\[describe-mode] while in MH-Letter mode." t) - -;;; mh-funcs - -(autoload '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) - -(autoload 'mh-copy-msg "mh-funcs" - "Copy to another FOLDER the specified MESSAGE(s) without deleting them. -Default is the displayed message. If optional prefix argument is -provided, then prompt for the message sequence." t) - -(autoload 'mh-kill-folder "mh-funcs" - "Remove the current folder." t) - -(autoload 'mh-list-folders "mh-funcs" - "List mail folders." t) - -(autoload '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) - -(autoload '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) - -(autoload 'mh-page-digest "mh-funcs" - "Advance displayed message to next digested message." t) - -(autoload 'mh-page-digest-backwards "mh-funcs" - "Back up displayed message to previous digested message." t) - -(autoload 'mh-print-msg "mh-funcs" - "Print MESSAGE(s) (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) - -(autoload '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 this function is passed an argument." t) - -(autoload '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) - -(autoload '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) - -(autoload 'mh-help "mh-funcs" - "Display cheat sheet for MH-E commands in minibuffer." t) - -(autoload 'mh-prefix-help "mh-funcs" - "Display cheat sheet for the commands of the current prefix in minibuffer." - t) - -;;; mh-pick - -(autoload 'mh-search-folder "mh-pick" - "Search FOLDER for messages matching a pattern. -Add the messages found to the sequence named `search'." t) - -;;; mh-seq - -(autoload 'mh-region-to-sequence "mh-seq" - "Define sequence 'region as the messages in selected region." t) -(autoload 'mh-delete-seq "mh-seq" - "Delete the SEQUENCE." t) -(autoload 'mh-list-sequences "mh-seq" - "List the sequences defined in FOLDER." t) -(autoload 'mh-msg-is-in-seq "mh-seq" - "Display the sequences that contain MESSAGE (default: displayed message)." t) -(autoload 'mh-narrow-to-seq "mh-seq" - "Restrict display of this folder to just messages in SEQUENCE -Use \\[mh-widen] to undo this command." t) -(autoload 'mh-put-msg-in-seq "mh-seq" - "Add MESSAGE(s) (default: displayed message) to SEQUENCE. -If optional prefix argument provided, then prompt for the message sequence." t) -(autoload 'mh-rename-seq "mh-seq" - "Rename SEQUENCE to have NEW-NAME." t) -(autoload 'mh-narrow-to-subject "mh-seq" - "Narrow to a sequence containing all following messages with same subject." - t) -(autoload 'mh-toggle-threads "mh-seq" - "Toggle threaded view of folder." t) -(autoload 'mh-delete-subject "mh-seq" - "Mark all following messages with same subject to be deleted." t) - -;;; mh-speed - -(autoload 'mh-folder-speedbar-buttons "mh-speed") -(autoload 'mh-show-speedbar-buttons "mh-speed") -(autoload 'mh-index-folder-speedbar-buttons "mh-speed") -(autoload 'mh-index-show-speedbar-buttons "mh-speed") -(autoload 'mh-letter-speedbar-buttons "mh-speed") - (dolist (mess '("^Cursor not pointing to message$" - "^There is no other window$")) + "^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:
--- a/lisp/mail/mh-funcs.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-funcs.el Wed Jan 08 23:21:16 2003 +0000 @@ -32,17 +32,13 @@ ;;; Change Log: -;; $Id: mh-funcs.el,v 1.28 2002/11/11 23:01:27 mbaushke Exp $ +;; $Id: mh-funcs.el,v 1.36 2002/12/23 05:52:07 satyaki Exp $ ;;; Code: (require 'mh-e) -;;; autoload -(autoload 'mh-notate-seq "mh-seq") -(autoload 'mh-speed-invalidate-map "mh-speed") - -;;; customization +;;; Customization (defvar mh-sortm-args nil "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. @@ -59,6 +55,7 @@ ;;; 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 @@ -66,7 +63,7 @@ (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 + (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) @@ -76,19 +73,29 @@ (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 (if current-prefix-arg - (mh-read-seq-default "Copy" t) - (mh-get-msg-num t)) - (mh-prompt-for-folder "Copy to" "" t))) - (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder) + (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-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, @@ -99,54 +106,60 @@ (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)) + (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"))) + (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"))))) + (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 - "Range to scan after packing [all]? ") - "all"))) - (mh-pack-folder-1 range) - (mh-goto-cur-msg) + (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) @@ -155,13 +168,14 @@ entire folder." (mh-process-or-undo-commands mh-current-folder) (message "Packing folder...") - (mh-set-folder-modified-p t) ; lock folder while packing + (mh-set-folder-modified-p t) ; lock folder while packing (save-excursion (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" - "-norecurse" "-fast")) + "-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. @@ -169,7 +183,7 @@ (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)) + (message-directory default-directory)) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) @@ -177,8 +191,9 @@ (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))))) + (shell-command-on-region (point) (point-max) command nil))))) +;;;###mh-autoload (defun mh-page-digest () "Advance displayed message to next digested message." (interactive) @@ -188,13 +203,14 @@ (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"))) + (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) @@ -204,66 +220,68 @@ (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"))) + (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)) + (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)))) + (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...")) + (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 (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) + (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-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")))) + (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. @@ -272,36 +290,45 @@ (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 + (mh-set-folder-modified-p t) ; lock folder while sorting (message "Sorting folder...") - (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) - (message "Sorting folder...done") - (mh-scan-folder mh-current-folder "all")) + (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)))) + (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)))) + (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)) @@ -309,58 +336,59 @@ (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)))) + 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)")) + (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 + (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))) + (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")))) + (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))) + (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"))) @@ -375,13 +403,15 @@ (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) @@ -391,7 +421,7 @@ ;; 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)))) + (prefix-char (elt keys (- (length keys) 2)))) (mh-ephem-message (substitute-command-keys (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) ""))))) @@ -399,6 +429,7 @@ (provide 'mh-funcs) ;;; Local Variables: +;;; indent-tabs-mode: nil ;;; sentence-end-double-space: nil ;;; End:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mail/mh-identity.el Wed Jan 08 23:21:16 2003 +0000 @@ -0,0 +1,219 @@ +;;; 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
--- a/lisp/mail/mh-index.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-index.el Wed Jan 08 23:21:16 2003 +0000 @@ -2,7 +2,7 @@ ;; Copyright (C) 2002 Free Software Foundation, Inc. -;; Author: Bill Wohler <wohler@newt.com> +;; Author: Satyaki Das <satyaki@theforce.stanford.edu> ;; Maintainer: Bill Wohler <wohler@newt.com> ;; Keywords: mail ;; See: mh-e.el @@ -37,14 +37,10 @@ ;;; the documentation for `mh-index-search' to get started. That ;;; documentation will direct you to the specific instructions for your ;;; particular indexer. -;;; -;;; (3) Right now only viewing messages and moving between messages works in -;;; the index buffer. With a little bit of work more stuff like -;;; replying or forwarding messages can be done. ;;; Change Log: -;; $Id: mh-index.el,v 1.51 2002/11/13 18:43:57 satyaki Exp $ +;; $Id: mh-index.el,v 1.73 2003/01/07 21:15:49 satyaki Exp $ ;;; Code: @@ -52,34 +48,11 @@ (require 'mh-e) (require 'mh-mime) -;; Shush the byte-compiler -(defvar font-lock-defaults) - (autoload 'gnus-local-map-property "gnus-util") (autoload 'gnus-eval-format "gnus-spec") (autoload 'widget-convert-button "wid-edit") (autoload 'executable-find "executable") -;;; User customizable -(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." - :group 'mh - :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))) - -;;; Hooks -(defcustom mh-index-show-hook nil - "Invoked after the message has been displayed." - :type 'hook - :group 'mh-hook) - ;; Support different indexing programs (defvar mh-indexer-choices '((swish++ @@ -100,118 +73,211 @@ (defvar mh-index-next-result-function nil "Function to parse the next line of output.") -;; Names for the default mh-index-buffers... -(defvar mh-index-buffer "*mh-index*") -(defvar mh-index-show-buffer "*mh-index-show*") - -;; For use with adaptive size setting... -(defvar mh-index-max-msg-index 0) +;; FIXME: This should be a defcustom... +(defvar mh-index-folder "+mhe-index" + "Folder that contains the folders resulting from the index searches.") -;; Buffer locals to allow multiple concurrent search folders. -(defvar mh-index-other-buffer nil - "Keeps track of other buffer associated with current buffer. -The value is the show buffer or the folder-buffer depending on whether we are -in a folder buffer or show buffer respectively.") -(defvar mh-index-matches nil - "Map of folder to messages which match.") -(defvar mh-index-previous-window-configuration nil - "Keep track of previous window configuration that is restored on exit.") -(defvar mh-index-current-msg nil - "Message index of message being shown.") - -;; Make variables buffer local ... -(make-variable-buffer-local 'mh-index-other-buffer) -(make-variable-buffer-local 'mh-index-matches) -(make-variable-buffer-local 'mh-index-previous-window-configuration) -(make-variable-buffer-local 'mh-current-folder) -(make-variable-buffer-local 'mh-index-current-msg) - -;; ... and arrange for them to not get slaughtered by a call to text-mode -;; (text-mode is called by mh-show-mode and mh-folder-mode). -(put 'mh-index-other-buffer 'permanent-local t) -(put 'mh-index-matches 'permanent-local t) -(put 'mh-index-previous-window-configuration 'permanent-local t) -(put 'mh-index-current-msg 'permanent-local t) -(put 'mh-current-folder 'permanent-local t) -(put 'mh-cmd-note 'permanent-local t) - -;; Temporary buffer where search results are output. +;; Temporary buffers for search results (defvar mh-index-temp-buffer " *mh-index-temp*") +(defvar mh-checksum-buffer " *mh-checksum-buffer*") -;; Keymaps + + +;;; 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")))))) -;; N.B. If this map were named mh-index-folder-mode-map, it would inherit the -;; keymap from mh-folder-mode. Since we want our own keymap, we tweak the name -;; to avoid this unwanted inheritance. -(defvar mh-index-folder-mode-keymap (make-sparse-keymap) - "Keymap for MH index folder.") -(suppress-keymap mh-index-folder-mode-keymap) -(gnus-define-keys mh-index-folder-mode-keymap - " " mh-index-page-msg - "," mh-index-header-display - "." mh-index-show - [mouse-2] mh-index-show - "?" mh-help - "\177" mh-index-previous-page - "\M-\t" mh-index-prev-button - [backtab] mh-index-prev-button - "\r" mh-index-show - "\t" mh-index-next-button - "i" mh-inc-folder - "m" mh-send ;alias - "n" mh-index-next - "p" mh-index-prev - "q" mh-index-quit - "s" mh-send) +(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) -(gnus-define-keys (mh-index-folder-map "F" mh-index-folder-mode-keymap) - "?" mh-prefix-help - "f" mh-visit-folder ;alias - "i" mh-index-search-again - "o" mh-visit-folder ;alias - "v" mh-visit-folder) + + +;;; 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.") -(defvar mh-index-button-map (make-sparse-keymap)) -(gnus-define-keys mh-index-button-map - "\r" mh-index-press-button) +(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))) -;;; Help Messages +(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)))))) -;;; 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-index-folder-mode-help-messages - '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" - "[s]end, [q]uit") - (?F "[v]isit folder; [i]ndexed search")) - "Key binding cheat sheet. +;;;###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)))))) -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. +(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))) -The substitutions described in `substitute-command-keys' are performed as -well.") - - - -(defun mh-index-search (folder search-regexp &optional new-buffer-flag) +;;;###mh-autoload +(defun mh-index-search (redo-search-flag folder search-regexp) "Perform an indexed search in an MH mail folder. -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. Optional -prefix argument NEW-BUFFER-FLAG decides whether the results are presented in a -new buffer. This allows multiple search results to coexist. +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 @@ -224,544 +290,249 @@ - `mh-swish++-execute-search' - `mh-swish-execute-search' - `mh-namazu-execute-search' - - `mh-glimpse-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 (progn + (list current-prefix-arg + (progn (unless mh-find-path-run (mh-find-path)) - (mh-prompt-for-folder "Search" "+" nil "all")) + (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")) - (read-string (format "%s regexp: " - (upcase-initials (symbol-name mh-indexer))))) - current-prefix-arg)) - (setq mh-index-max-msg-index 0) - (let ((config (current-window-configuration)) - (mh-index-buffer - (cond (new-buffer-flag - (buffer-name (generate-new-buffer mh-index-buffer))) - ((and (eq major-mode 'mh-index-folder-mode)) - (buffer-name (current-buffer))) - (t mh-index-buffer))) - (mh-index-show-buffer - (cond (new-buffer-flag - (buffer-name (generate-new-buffer mh-index-show-buffer))) - ((eq major-mode 'mh-index-folder-mode) - mh-index-other-buffer) - (t mh-index-show-buffer)))) - (when (buffer-live-p (get-buffer mh-index-show-buffer)) - (kill-buffer (get-buffer mh-index-show-buffer))) - (get-buffer-create mh-index-buffer) - (get-buffer-create mh-index-show-buffer) - (save-excursion - (set-buffer mh-index-buffer) - (setq mh-index-other-buffer mh-index-show-buffer)) - (save-excursion - (set-buffer mh-index-show-buffer) - (setq mh-index-other-buffer mh-index-buffer)) - (set-buffer mh-index-buffer) - (setq buffer-read-only nil) - (erase-buffer) - (let* ((folder-path (format "%s%s" mh-user-path (substring folder 1))) - (count 0) - (folder-count 0) - cur-folder last-folder cur-index last-index - parse-results button-start button-end) - (setq mh-index-matches (make-hash-table :test #'equal)) + (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 "%s searching... " (upcase-initials (symbol-name mh-indexer))) + (message "Executing %s... " mh-indexer) (funcall mh-index-execute-search-function folder-path search-regexp) - ;; Parse output and generate folder view + ;; Parse indexer output (message "Processing %s output... " mh-indexer) (goto-char (point-min)) - (while (setq parse-results (funcall mh-index-next-result-function)) - (unless (eq parse-results 'error) - (setq cur-folder (car parse-results) - cur-index (cadr parse-results)) - (setq mh-index-max-msg-index (max mh-index-max-msg-index cur-index)) - (cond ((and (equal cur-folder last-folder) - (= cur-index last-index)) - nil) - ((equal cur-folder last-folder) - (save-excursion - (set-buffer mh-index-buffer) - (push cur-index (gethash cur-folder mh-index-matches)))) - (t - (save-excursion - (set-buffer mh-index-buffer) - (unless (gethash cur-folder mh-index-matches) - (setq button-start (point)) - (gnus-eval-format "%T\n" '((?T cur-folder ?s)) - `(,@(gnus-local-map-property - mh-index-button-map) - mh-callback mh-index-callback - mh-data ,cur-folder)) - (setq button-end (point)) - (widget-convert-button - 'link button-start button-end - :button-keymap mh-index-button-map - :action 'mh-index-callback) - (insert "\n")) - (push cur-index (gethash cur-folder mh-index-matches))))) - (setq last-folder cur-folder) - (setq last-index cur-index))) + (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))) - ;; Get rid of extra line at end of the buffer if there were any hits. - (set-buffer mh-index-buffer) - (goto-char (point-max)) - (when (and (= (forward-line -1) 0) (bolp) (eolp)) - (delete-char 1)) - - ;; Set mh-cmd-note to a large enough value... - (when mh-adaptive-cmd-note-flag - (mh-set-cmd-note (mh-index-find-max-width mh-index-max-msg-index))) + ;; 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. - (message "Generating scan lines... ") - (goto-char (point-min)) - (while (not (eobp)) - (let ((folder (get-text-property (point) 'mh-data))) - (when folder - (incf folder-count) - (forward-line) - (incf count (mh-index-insert-scan folder)))) - (forward-line)) + (let ((mh-show-threads-flag nil)) + (mh-visit-folder index-folder () (list folder-results-map origin-map))) - ;; Go to the first hit (if any). (goto-char (point-min)) (forward-line) - - ;; Remember old window configuration - (setq mh-index-previous-window-configuration config) + (mh-update-sequences) + (mh-recenter nil) - ;; Setup folder buffer mode - (when mh-decode-mime-flag - (add-hook 'kill-buffer-hook 'mh-mime-cleanup)) - (mh-index-folder-mode) - (setq mh-show-buffer mh-index-show-buffer) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - (mh-index-configure-one-window) - (setq mh-current-folder nil mh-index-current-msg 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)) - count folder-count)))) - -(defun mh-index-find-max-width (max-index) - "Given MAX-INDEX find the number of digits necessary to print it." - (let ((result 1) - (max-int 9)) - (while (< max-int max-index) - (incf result) - (setq max-int (+ (* 10 max-int) 9))) - result)) - -(defun mh-index-search-again () - "Call `mh-index-search' from index search buffer." - (interactive) - (cond ((eq major-mode 'mh-index-show-mode) - (set-buffer mh-index-other-buffer)) - ((not (eq major-mode 'mh-index-folder-mode)) - (error "Should be called from one of the index buffers"))) - (let ((old-buffer (current-buffer)) - (window-config mh-index-previous-window-configuration)) - (unwind-protect (call-interactively 'mh-index-search) - (when (eq old-buffer (current-buffer)) - (setq mh-index-previous-window-configuration window-config))))) + (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)))))) -(defun mh-index-insert-scan (folder) - "Insert scan lines for hits in FOLDER that the indexing program found. -The only twist is to replace the subject/body field with the match (if -possible)." - (save-excursion - (apply #'mh-exec-cmd-output - mh-scan-prog nil (mh-scan-format) - "-noclear" "-noheader" "-width" (window-width) - folder (mh-coalesce-msg-list (gethash folder mh-index-matches)))) - (save-excursion - (let ((window-width (window-width)) - (count 0)) - (while (not (or (get-text-property (point) 'mh-data) (eobp))) - (beginning-of-line) - (unless (and (eolp) (bolp)) - (incf count) - (forward-char mh-cmd-note) - (delete-char 1) - (insert " ")) - (forward-line 1)) - count))) - -(defun mh-index-callback () - "Callback function for buttons in the index buffer." - (let* ((folder (save-excursion - (buffer-substring-no-properties - (progn (beginning-of-line) (point)) - (progn (end-of-line) (point))))) - (data (get-text-property (point) 'mh-data)) - (msg-list (gethash data mh-index-matches))) - (when msg-list - (mh-visit-folder folder msg-list)))) +;;;###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)))))) -(defmacro mh-defun-index (func args &rest body) - "Macro to generate a function callable both from index and show buffer. -FUNC is the function name, ARGS the argument list and BODY the function -body." - (let ((cur (gensym)) - interactive-spec doc-string) - (when (stringp (car body)) - (setq doc-string (car body)) - (setq body (cdr body))) - (when (and (listp (car body)) (eq (caar body) 'interactive)) - (setq interactive-spec (car body)) - (setq body (cdr body))) - `(defun ,func ,args - ,@(if doc-string (list doc-string) ()) - ,interactive-spec - (let* ((mh-index-buffer (if (eq major-mode 'mh-index-folder-mode) - (buffer-name (current-buffer)) - mh-index-other-buffer)) - (mh-index-show-buffer (if (eq major-mode 'mh-index-show-mode) - (buffer-name (current-buffer)) - mh-index-other-buffer)) - (,cur (cond ((eq (get-buffer mh-index-buffer) - (current-buffer)) - mh-index-buffer) - ((eq (get-buffer mh-index-show-buffer) - (current-buffer)) - mh-index-show-buffer) - (t (error "Not called from mh-index buffer"))))) - (flet ((mh-msg-folder (folder) mh-index-buffer) - (mh-msg-filename (msg-num folder) - (format "%s%s/%s" mh-user-path (subseq folder 1) msg-num))) - (cond ((eq ,cur mh-index-buffer) - (mh-index-goto-nearest-msg) - (when (and mh-current-folder mh-index-current-msg) - (mh-index-notate mh-current-folder - mh-index-current-msg " " mh-cmd-note)) - (setq mh-current-folder (mh-index-parse-folder)) - (setq mh-index-current-msg (mh-index-parse-msg-number))) - ((eq ,cur mh-index-show-buffer) - (set-buffer mh-index-buffer) - (mh-index-goto-msg mh-current-folder - mh-index-current-msg) - (mh-index-notate nil nil " " mh-cmd-note)) - (t (error "This can't happen!"))) - (unwind-protect - (progn ,@body) - (save-excursion - (set-buffer mh-index-buffer) - (mh-index-goto-msg mh-current-folder mh-index-current-msg) - (mh-recenter nil)) - (mh-index-configure-windows) - (pop-to-buffer ,cur))))))) +;;;###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-advance (steps) - "Advance STEPS messages in the folder buffer. -If there are less than STEPS messages left then an error message is printed." - (let* ((backward-flag (< steps 0)) - (steps (if backward-flag (- steps) steps)) - point) - (block body - (save-excursion - (while (> steps 0) - (unless (= (forward-line (if backward-flag -1 1)) 0) - (return-from body)) - (cond ((and (eolp) (bolp) (not backward-flag)) - (unless (= (forward-line 2) 0) (return-from body))) - ((and (get-text-property (point) 'mh-data) backward-flag) - (unless (= (forward-line -2) 0) (return-from body))) - ((or (and (eolp) (bolp)) - (get-text-property (point) 'mh-data)) - (error "Mh-index-buffer is inconsistent"))) - (decf steps)) - (setq point (point)))) - (cond (point (goto-char point) t) - (t nil)))) - -;; Details about message at point. These functions assume that we are on a -;; line which contains a message scan line and not on a blank line or a line -;; with a folder name. -(defun mh-index-parse-msg-number () - "Parse message number of message at point." - (save-excursion - (beginning-of-line) - (let* ((b (point)) - (e (progn (forward-char mh-cmd-note) (point))) - (data (ignore-errors - (read-from-string (buffer-substring-no-properties b e))))) - (unless (and (consp data) (integerp (car data))) - (error "Didn't find message number")) - (car data)))) - -(defun mh-index-parse-folder () - "Parse folder of message at point." - (save-excursion - (while (not (get-text-property (point) 'mh-data)) - (unless (eql (forward-line -1) 0) - (error "Reached beginning of buffer without seeing a folder"))) - (buffer-substring-no-properties (progn (beginning-of-line) (point)) - (progn (end-of-line) (point))))) - -(defun mh-index-goto-nearest-msg () - "If point is not at a message go to the closest line with a message on it." - (beginning-of-line) - (cond ((and (eolp) (bolp)) (forward-line -1)) - ((get-text-property (point) 'mh-data) (forward-line 1)))) - -;; Window configuration for mh-index... There should be similar functions -;; in MH-E but I couldn't find them. I got the idea of using next-window, -;; previous-window and minibuffer-window from MH-E code. -(defun mh-index-configure-windows () - "Configure windows." - (cond ((and (buffer-live-p (get-buffer mh-index-show-buffer)) - (buffer-live-p (get-buffer mh-index-buffer)) - (eq (save-excursion (set-buffer mh-index-show-buffer) major-mode) - 'mh-index-show-mode)) - (mh-index-configure-two-windows)) - ((buffer-live-p (get-buffer mh-index-buffer)) - (mh-index-configure-one-window)))) - -(defun mh-count-windows () - "Count the number of windows in the current frame. -The minibuffer window is excluded from the count." - (let* ((start-window (next-window nil t)) - (current-window (next-window start-window t)) - (count 0)) - (while (not (eq current-window start-window)) - (incf count) - (setq current-window (next-window current-window t))) - count)) +(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)) -(defun mh-index-configure-two-windows () - "Force a split view like that of MH-E." - (save-excursion - (unless (and (get-buffer mh-index-show-buffer) - (get-buffer mh-index-buffer)) - (error "We don't have both index buffers")) - (let ((window-count (mh-count-windows))) - (unless (and (= window-count 2) - (eq (window-buffer (next-window (minibuffer-window))) - (get-buffer mh-index-buffer)) - (eq (window-buffer (previous-window (minibuffer-window))) - (get-buffer mh-index-show-buffer))) - (unless (= window-count 2) - (delete-other-windows) - (split-window-vertically)) - (set-window-buffer (next-window (minibuffer-window)) - mh-index-buffer) - (set-window-buffer (previous-window (minibuffer-window)) - mh-index-show-buffer)) - (unless (and (get-buffer-window mh-index-buffer) - (= (window-height (get-buffer-window mh-index-buffer)) - mh-summary-height)) - (pop-to-buffer mh-index-buffer) - (shrink-window (- (window-height) mh-summary-height)))) - (set-window-point (previous-window (minibuffer-window)) - (progn (set-buffer mh-index-show-buffer) (point))) - (set-window-point (next-window (minibuffer-window)) - (progn (set-buffer mh-index-buffer) (point))))) - -(defun mh-index-configure-one-window () - "Single window view." - (save-excursion - (unless (buffer-live-p (get-buffer mh-index-buffer)) - (error "Should have mh-index-buffer")) - (switch-to-buffer mh-index-buffer) - (delete-other-windows) - (set-window-point (next-window (minibuffer-window)) - (progn (set-buffer mh-index-buffer) (point))))) +;;;###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))) -;; This is slightly more involved than normal MH-E since we may have multiple -;; folders in the same buffer. -(defun mh-index-goto-msg (folder msg) - "Move the cursor to the message specified by FOLDER and MSG." - (block body - (unless (buffer-live-p (get-buffer mh-index-buffer)) - (error "No index buffer to go to")) - (set-buffer mh-index-buffer) +;;;###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 (re-search-forward (format "^%s$" folder) nil t) - (forward-line) - (while (not (eolp)) - (when (= (mh-index-parse-msg-number) msg) - (return-from body)) + (while (not (eobp)) + (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10)) + (delete-region (point) (progn (forward-line) (point))) (forward-line))) - (error "Folder: %s, msg: %s doesn't exist" folder msg))) - -;; Can't use mh-notate directly since we could have more than one folder in -;; the same buffer -(defun mh-index-notate (folder msg notation offset) - "Add notation to scan line. -FOLDER is the message folder and MSG the message index. These arguments -specify the message to be notated. NOTATION is the character to be used to -notate and OFFSET is the number of chars from start of the line where -notation is to be placed." - (save-excursion - (set-buffer mh-index-buffer) - (let ((buffer-read-only nil) - (modified-p (buffer-modified-p)) - (found t)) - (setq found nil) - (when (and (stringp folder) (numberp msg)) - (block nil - (goto-char (point-min)) - (re-search-forward (format "^%s$" folder)) - (forward-line) - (while (not (eolp)) - (when (= (mh-index-parse-msg-number) msg) - (setq found t) - (return)) - (forward-line)))) - (when found - (beginning-of-line) - (forward-char offset) - (delete-char 1) - (insert notation) - (unless modified-p (set-buffer-modified-p nil)))))) - - - -;;; User functions + (when cur-msg (mh-goto-msg cur-msg t t)) + (set-buffer-modified-p old-buffer-modified-flag))) -(mh-defun-index mh-index-show (display-headers-flag) - "Display message at point. -If there are no messages at point then display the closest message. -The value of `mh-index-show-hook' is a list of functions to be called, -with no arguments, after the message has been displayed. -If DISPLAY-HEADERS-FLAG is non-nil then the raw message is shown." - (interactive (list nil)) - (when (or (and (bolp) (eolp)) (get-text-property (point) 'mh-data)) - (error "No message at point")) - (setq mh-current-folder (mh-index-parse-folder)) - (setq mh-index-current-msg (mh-index-parse-msg-number)) - ;; Do new notation - (when (and mh-current-folder mh-index-current-msg) - (mh-index-notate mh-current-folder mh-index-current-msg - mh-note-cur mh-cmd-note)) - (let ((mh-decode-mime-flag (and (not display-headers-flag) mh-decode-mime-flag)) - (mh-clean-message-header-flag - (and (not display-headers-flag) mh-clean-message-header-flag)) - (mhl-formfile (if display-headers-flag nil mhl-formfile)) - (msg mh-index-current-msg) - (folder mh-current-folder)) - (when (not (eq display-headers-flag mh-showing-with-headers)) - (mh-invalidate-show-buffer)) - (mh-in-show-buffer (mh-index-show-buffer) - (mh-display-msg msg folder)) - ;; Search for match in shown message - (select-window (get-buffer-window mh-index-show-buffer)) - (set-buffer mh-index-show-buffer) - (mh-index-show-mode)) - (run-hooks 'mh-index-show-hook)) - -(defun mh-index-header-display () - "Show the message with full headers." +;;;###mh-autoload +(defun mh-index-visit-folder () + "Visit original folder from where the message at point was found." (interactive) - (mh-index-show t) - (setq mh-showing-with-headers t)) - -(mh-defun-index mh-index-next (steps) - "Display next message. -Prefix argument STEPS specifies the number of messages to skip ahead." - (interactive "p") - (mh-index-goto-nearest-msg) - (if (mh-index-advance steps) - (mh-index-show nil) - (mh-index-show nil) - (message "Not enough messages"))) - -(mh-defun-index mh-index-prev (steps) - "Display previous message. -Prefix argument STEPS specifies the number of messages to skip backward." - (interactive "p") - (mh-index-goto-nearest-msg) - (if (mh-index-advance (- steps)) - (mh-index-show nil) - (mh-index-show nil) - (message "Not enough messages"))) + (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-page-msg (arg) - "Scroll the displayed message upward ARG lines." - (interactive "P") - (save-excursion - (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode) - mh-index-other-buffer) - ((eq major-mode 'mh-index-show-mode) - (buffer-name (current-buffer))) - (t (error "Don't use mh-index-page-msg")))) - (window (get-buffer-window show-buffer)) - (current-window (selected-window))) - (when (window-live-p window) - (select-window window) - (unwind-protect (scroll-up arg) - (select-window current-window)))))) - -(defun mh-index-previous-page (arg) - "Scroll the displayed message downward ARG lines." - (interactive "P") - (save-excursion - (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode) - mh-index-other-buffer) - ((eq major-mode 'mh-index-show-mode) - (buffer-name (current-buffer))) - (t (error "Don't use mh-index-previous-page")))) - (window (get-buffer-window show-buffer)) - (current-window (selected-window))) - (when (window-live-p window) - (select-window window) - (unwind-protect (scroll-down arg) - (select-window current-window)))))) - -(defun mh-index-press-button () - "Press index button." - (interactive) - (let ((function (get-text-property (point) 'mh-callback))) - (when function - (funcall function)))) +(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))) -(defun mh-index-quit () - "Quit the index 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) - (cond ((eq major-mode 'mh-index-show-mode) - (set-buffer mh-index-other-buffer)) - ((not (eq major-mode 'mh-index-folder-mode)) - (error "The function mh-index-quit shouldn't be called"))) - (run-hooks 'mh-before-quit-hook) - (let ((mh-index-buffer (buffer-name (current-buffer))) - (mh-index-show-buffer mh-index-other-buffer) - (window-config mh-index-previous-window-configuration)) - (when (buffer-live-p (get-buffer mh-index-buffer)) - (bury-buffer (get-buffer mh-index-buffer))) - (when (buffer-live-p (get-buffer mh-index-show-buffer)) - (bury-buffer (get-buffer mh-index-show-buffer))) - (when window-config - (set-window-configuration window-config))) - (run-hooks 'mh-quit-hook)) - -;; Can't quite use mh-next-button... This buffer has no concept of -;; folder-buffer or show-buffer. Maybe refactor mh-next-button? -(defun mh-index-next-button (&optional backward-flag) - "Go to the next button. -Advance point to the next button in the show buffer. If the end of buffer is -reached then the search wraps over to the start of the buffer. With optional -argument BACKWARD-FLAG the point will move to the previous button." - (interactive current-prefix-arg) - (mh-goto-next-button backward-flag)) - -(defun mh-index-prev-button () - "Go to the next button. -Move point to the previous button in the show buffer. If the beginning of -the buffer is reached then the search wraps over to the end." - (interactive) - (mh-index-next-button t)) +;;;###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))) @@ -770,6 +541,7 @@ (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. @@ -784,12 +556,18 @@ */,* */*~ ^/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: @@ -799,9 +577,9 @@ (set-buffer (get-buffer-create mh-index-temp-buffer)) (erase-buffer) (call-process mh-glimpse-binary nil '(t nil) nil - ;(format "-%s" fuzz) + ;(format "-%s" fuzz) "-i" "-y" - "-H" (format "%s%s" mh-user-path mh-glimpse-directory) + "-H" (format "%s%s" mh-user-path mh-glimpse-directory) "-F" (format "^%s" folder-path) search-regexp) (goto-char (point-min))) @@ -812,32 +590,32 @@ 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) + (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)) - (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)))) + (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))) @@ -861,32 +639,32 @@ 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) + (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)) - (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)))) + (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))) @@ -897,6 +675,7 @@ (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. @@ -923,6 +702,7 @@ 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 #.* @@ -934,6 +714,11 @@ 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: @@ -991,9 +776,10 @@ ;; Swish++ interface (defvar mh-swish++-binary (or (executable-find "search++") - (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. @@ -1003,15 +789,24 @@ 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 - IncludeFile Mail [0-9]* - IndexFile /home/user/Mail/.swish++/swish++.index + 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: - index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail + 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. @@ -1042,6 +837,7 @@ (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. @@ -1054,6 +850,15 @@ 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: @@ -1063,7 +868,7 @@ 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))) + (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) @@ -1092,7 +897,7 @@ (return 'error)) (string-match mh-user-path file-name) (let* ((folder/msg (substring file-name (match-end 0))) - (mark (search "/" folder/msg :from-end t))) + (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 @@ -1117,7 +922,7 @@ ;; through the list. (let ((program-alist (cond (mh-index-program (list - (assoc mh-index-program mh-indexer-choices))) + (assoc mh-index-program mh-indexer-choices))) (mh-indexer (list (assoc mh-indexer mh-indexer-choices))) (t mh-indexer-choices)))) @@ -1133,157 +938,10 @@ -;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) -;;; Menus for folder mode: folder, message (in that order) -;;; folder-mode "Message" menu -(easy-menu-define - mh-index-folder-message-menu mh-index-folder-mode-keymap - "Menu for MH-E folder-message." - '("Message" - ["Show Message" mh-index-show (mh-get-msg-num nil)] - ["Show Message with Header" mh-index-header-display (mh-get-msg-num nil)] - ["Next Message" mh-index-next t] - ["Previous Message" mh-index-prev t] - "--" - ["Compose a New Message" mh-send t])) - -;;; folder-mode "Folder" menu -(easy-menu-define - mh-index-folder-folder-menu mh-index-folder-mode-keymap - "Menu for MH-E folder." - '("Folder" - ["Incorporate New Mail" mh-inc-folder t] - "--" - ["Visit a Folder..." mh-visit-folder t] - ["Indexed Search..." mh-index-search-again t] - "--" - ["Quit Indexed Search" mh-index-quit t])) - - - -;;; Support for emacs21 toolbar using gnus/message.el icons (and code). -(eval-when-compile (defvar tool-bar-map)) -(defvar mh-index-folder-tool-bar-map nil) -(when (fboundp 'tool-bar-add-item) - (setq mh-index-folder-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - (tool-bar-add-item "mail" 'mh-inc-folder - 'mh-indexfoldertoolbar-inc-folder - :help "Incorporate new mail in Inbox") - (tool-bar-add-item "left_arrow" 'mh-index-prev - 'mh-indexfoldertoolbar-prev :help "Previous message") - (tool-bar-add-item "page-down" 'mh-index-page-msg - 'mh-indexfoldertoolbar-page - :help "Page this message") - (tool-bar-add-item "right_arrow" 'mh-index-next - 'mh-indexfoldertoolbar-next :help "Next message") - - (tool-bar-add-item "mail_compose" 'mh-send 'mh-indexfoldertoolbar-compose - :help "Compose new message") - - (tool-bar-add-item "search" - (lambda (&optional arg) - (interactive "P") - (call-interactively mh-tool-bar-search-function)) - 'mh-indexfoldertoolbar-search :help "Search") - (tool-bar-add-item "fld_open" 'mh-visit-folder - 'mh-indexfoldertoolbar-visit - :help "Visit other folder") - - (tool-bar-add-item "preferences" (lambda () - (interactive) - (customize-group "mh")) - 'mh-indexfoldertoolbar-customize - :help "MH-E preferences") - (tool-bar-add-item "help" (lambda () - (interactive) - (Info-goto-node "(mh-e)Top")) - 'mh-indexfoldertoolbar-help :help "Help") - tool-bar-map))) - -;; Modes for mh-index -(define-derived-mode mh-index-folder-mode mh-folder-mode "MH-Index-Folder" - "Major MH-E mode for displaying the results of searching.\\<mh-index-folder-mode-keymap> - -You can display the message the cursor is pointing to and step through the -messages. - -You can also jump to the folders narrowed to the search results by pressing -RET on the folder name. Many operations, such as replying to a message, -require that you do this first. - -\\{mh-index-folder-mode-keymap}" - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(mh-index-font-lock-keywords t)) - (use-local-map mh-index-folder-mode-keymap) - (make-local-variable 'mh-help-messages) - (easy-menu-add mh-index-folder-message-menu) - (easy-menu-add mh-index-folder-folder-menu) - (if (and (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) mh-index-folder-tool-bar-map)) - (setq mh-help-messages mh-index-folder-mode-help-messages)) - -(define-derived-mode mh-index-show-mode mh-show-mode "MH-Index-Show" - "Major mode for showing messages in MH-E index.\\<mh-index-folder-mode-keymap> -\\{mh-index-folder-mode-keymap}" - (use-local-map mh-index-folder-mode-keymap) - (setq mh-help-messages mh-index-folder-mode-help-messages)) - -;; Font lock support for mh-index-folder. This is the same as mh-folder -;; except that the folder line needs to be recognized and highlighted. -(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")) - (((class color) (background dark)) - (:foreground "indian red")) - (t - (:bold t))) - "Face for highlighting folders in MH-Index buffers." - :group 'mh) - -(eval-after-load "font-lock" - '(progn - (defvar mh-index-folder-face 'mh-index-folder-face - "Face for highlighting folders in MH-Index buffers.") - - (defvar mh-index-font-lock-keywords - (list - ;; Folder name - (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))) - "Regexp keywords used to fontify the MH-Index-Folder buffer."))) - (provide 'mh-index) ;;; Local Variables: +;;; indent-tabs-mode: nil ;;; sentence-end-double-space: nil ;;; End:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mail/mh-loaddefs.el Wed Jan 08 23:21:16 2003 +0000 @@ -0,0 +1,880 @@ +;;; mh-loaddefs.el --- automatically extracted autoloads +;; +;;; Commentary: +;;; Code: + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +;;;### (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) + +;;;*** + +(provide 'mh-loaddefs) +;;; Local Variables: +;;; version-control: never +;;; no-byte-compile: t +;;; no-update-autoloads: t +;;; End: +;;; mh-loaddefs.el ends here
--- a/lisp/mail/mh-mime.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-mime.el Wed Jan 08 23:21:16 2003 +0000 @@ -32,17 +32,17 @@ ;;; Change Log: -;; $Id: mh-mime.el,v 1.90 2002/11/22 20:00:48 satyaki Exp $ +;; $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 +(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") @@ -59,29 +59,7 @@ (autoload 'mml-to-mime "mml") (autoload 'mml-attach-file "mml") -;;; Hooks -(defcustom mh-edit-mhn-hook nil - "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]." - :type 'hook - :group 'mh-hook) - -;; Keeps assorted MIME data -(defstruct (mh-buffer-data (:conc-name mh-mime-) - (:constructor mh-make-buffer-data)) - ;; Structure to keep track of MIME handles on a per buffer basis. - (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)) - +;;;###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. @@ -94,6 +72,7 @@ (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. @@ -104,12 +83,12 @@ 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 + (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))) @@ -117,7 +96,7 @@ ;; 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.) +;; invokes mh-edit-mhn automatically before sending.) ;; actually, instead of mh-auto-edit-mhn, ;; should read automhnproc from profile ;; MIME option to mh-forward @@ -143,7 +122,7 @@ "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 + (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 @@ -223,6 +202,7 @@ "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. @@ -234,22 +214,22 @@ See also \\[mh-edit-mhn]." (interactive (let ((filename (read-file-name "Insert contents of: "))) - (list - filename + (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) - "\""))))) + (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) + &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 @@ -269,6 +249,7 @@ (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 @@ -280,16 +261,17 @@ 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: "))) + (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)) + 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 @@ -300,19 +282,20 @@ See also \\[mh-edit-mhn]." (interactive (list - (read-string "Remote host: ") - (read-string "Remote filename: ") - (read-string "Tar file Content-description: "))) + (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")) + "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) + &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. @@ -342,6 +325,7 @@ (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. @@ -351,12 +335,12 @@ 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) - ""))))) + (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 [") @@ -368,14 +352,15 @@ (not (string= folder "")) (insert " " folder)) (if (and messages - (not (string= messages ""))) + (not (string= messages ""))) (let ((start (point))) - (insert " " messages) - (subst-char-in-region start (point) ?, ? )) + (insert " " messages) + (subst-char-in-region start (point) ?, ? )) (if mh-sent-from-msg - (insert " " (int-to-string 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. @@ -416,6 +401,7 @@ (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." @@ -423,21 +409,21 @@ (if (null buffer-file-name) (error "Buffer does not seem to be associated with any file")) (let ((backup-strings '("," "#")) - backup-file) + 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"))))) + (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)) + (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")) + (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)) @@ -447,6 +433,7 @@ ;;; MIME composition functions +;;;###mh-autoload (defun mh-mml-to-mime () "Compose MIME message from mml directives." (interactive) @@ -455,6 +442,7 @@ (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 @@ -476,6 +464,7 @@ (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 @@ -502,6 +491,7 @@ '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) @@ -510,6 +500,7 @@ (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)." @@ -523,54 +514,6 @@ ;;; MIME decoding -(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-buffer) - -(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-buffer) - -;; Small image definition -(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-buffer) - -(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-buffer) - -(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-buffer) - -(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) - (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 @@ -579,6 +522,7 @@ (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) @@ -597,7 +541,7 @@ ;; HANDLE could be a CTL. (if handle (put-text-property 0 (length (car handle)) parameter value - (car handle)))) + (car handle)))) ;; Copy of original macro is in mm-decode.el (mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter) @@ -607,11 +551,11 @@ (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) + (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)))))) + (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) @@ -620,11 +564,11 @@ (goto-char (point-min)) (end-of-line) (while (and (not (eobp)) - (not (> (current-column) length))) + (not (> (current-column) length))) (forward-line 1) (end-of-line)) (and (> (current-column) length) - (current-column)))) + (current-column)))) (mh-defun-compat mm-keep-viewer-alive-p (handle) ;; Released Gnus doesn't keep handles associated with externally displayed @@ -642,25 +586,26 @@ (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) + (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 ""))) + (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)))) + (yes-or-no-p (format "File %s already exists; overwrite? " + file))) + (mm-save-part-to-file handle file)))) ;;; MIME cleanup +;;;###mh-autoload (defun mh-mime-cleanup () "Free the decoded MIME parts." (let ((mime-data (gethash (current-buffer) mh-globals-hash))) @@ -671,6 +616,7 @@ (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))) @@ -686,8 +632,8 @@ 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) + (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))))) @@ -696,7 +642,9 @@ ;;; 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 ;-)" @@ -708,15 +656,22 @@ (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)) + (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 mh-graphical-emphasis-flag - (flet ((article-goto-body ())) ; shadow this function to do nothing + (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))))) @@ -760,6 +715,7 @@ "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 @@ -815,6 +771,7 @@ (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 @@ -822,11 +779,12 @@ displayed." (let ((handles ()) (folder mh-show-folder-buffer)) - (flet ((mm-handle-set-external-undisplayer (handle function) - (mh-handle-set-external-undisplayer folder handle function))) + (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 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))))) @@ -864,7 +822,7 @@ (preferred (save-restriction (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) - (or (mm-display-part preferred) (mm-display-part preferred)) + (mh-mime-display-single preferred) (goto-char (point-max)))) (t (mh-mime-display-mixed handles))))) @@ -883,9 +841,9 @@ ;;; 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)))) + (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. @@ -895,9 +853,9 @@ (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 + (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 @@ -919,6 +877,17 @@ ;; 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)) @@ -928,10 +897,11 @@ (inlinep (and (equal (car (mm-handle-disposition handle)) "inline") (mm-inlinable-p handle) (mm-inlined-p handle))) - (displayp (or inlinep ; display if inline - (and (not attachmentp) ; if it is not an attachment - (or small-image-flag ; display if small image - ; or if user wants inline. + (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")) @@ -941,7 +911,7 @@ (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... + nil) ; skip signatures as they are already handled... ((not displayp) (insert "\n") (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) @@ -982,9 +952,9 @@ (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)) + mh-callback mh-mm-display-part + mh-part ,index + mh-data ,handle)) (setq end (point)) (widget-convert-button 'link begin end @@ -1062,6 +1032,7 @@ (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 @@ -1072,13 +1043,15 @@ (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))) + (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 @@ -1093,21 +1066,24 @@ (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))) + (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-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) @@ -1149,7 +1125,7 @@ (mh-mime-display-mixed (cdr handle)) (insert "\n") (let ((mh-mime-security-button-line-format - mh-mime-security-button-end-line-format)) + mh-mime-security-button-end-line-format)) (mh-insert-mime-security-button handle)) (mm-set-handle-multipart-parameter handle 'mh-region @@ -1164,9 +1140,9 @@ (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))) + (not (get-text-property (point) 'mh-button-pressed))) (mh-mime-security-button-line-format - (get-text-property (point) 'mh-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) @@ -1217,10 +1193,10 @@ 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)) + 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 @@ -1293,6 +1269,7 @@ (provide 'mh-mime) ;;; Local Variables: +;;; indent-tabs-mode: nil ;;; sentence-end-double-space: nil ;;; End:
--- a/lisp/mail/mh-pick.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-pick.el Wed Jan 08 23:21:16 2003 +0000 @@ -30,7 +30,7 @@ ;;; Change Log: -;; $Id: mh-pick.el,v 1.21 2002/11/05 21:43:16 wohler Exp $ +;; $Id: mh-pick.el,v 1.25 2002/12/04 18:51:50 wohler Exp $ ;;; Code: @@ -38,46 +38,40 @@ (require 'easymenu) (require 'gnus-util) -;;; Hooks - -(defcustom mh-pick-mode-hook nil - "Invoked upon entry to `mh-pick-mode'." - :type 'hook - :group 'mh-hook) - ;;; Internal variables: (defvar mh-pick-mode-map (make-sparse-keymap) "Keymap for searching folder.") -(defvar mh-searching-folder nil) ;Folder this pick is searching. +(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))) + mh-current-folder + t))) (switch-to-buffer-other-window "pick-pattern") (if (or (zerop (buffer-size)) - (not (y-or-n-p "Reuse pattern? "))) + (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.")))) + (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") + "To: \n" + "Cc: \n" + "Date: \n" + "Subject: \n" + "---------\n") (mh-pick-mode) (goto-char (point-min)) (end-of-line)) @@ -130,41 +124,42 @@ (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)) + (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)))) + (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 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 + '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-scan-folder searching-buffer msgs) + (switch-to-buffer searching-buffer)) (mh-add-msgs-to-seq msgs 'search) (delete-other-windows))) @@ -173,17 +168,17 @@ 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)) + (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)))) + (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 + (setq msgs (nreverse msgs)) ;put in ascending order msgs))) (defun mh-next-pick-field (buffer) @@ -193,50 +188,51 @@ (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)))) + 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)))) ;;; 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) + "\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:
--- a/lisp/mail/mh-seq.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-seq.el Wed Jan 08 23:21:16 2003 +0000 @@ -67,7 +67,7 @@ ;;; Change Log: -;; $Id: mh-seq.el,v 1.71 2002/11/14 20:41:12 wohler Exp $ +;; $Id: mh-seq.el,v 1.84 2003/01/07 21:15:33 satyaki Exp $ ;;; Code: @@ -137,56 +137,65 @@ (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) + sequence) (mh-undefine-sequence sequence '("all")) (mh-delete-seq-locally sequence)) ;; Avoid compiler warnings (defvar view-exit-action) -(defun mh-list-sequences (folder) - "List the sequences defined in FOLDER." - (interactive (list (mh-prompt-for-folder "List sequences in" - mh-current-folder t))) - (let ((temp-buffer mh-temp-sequences-buffer) - (seq-list mh-seq-list)) +;;;###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") - (while seq-list - (let ((name (mh-seq-name (car seq-list))) - (sorted-seq-msgs - (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)) - (last-col (- (window-width) 4)) - name-spec) - (insert (setq name-spec (format "%20s:" name))) - (while sorted-seq-msgs - (if (> (current-column) last-col) - (progn - (insert "\n") - (move-to-column (length name-spec)))) - (insert (format " %s" (car sorted-seq-msgs))) - (setq sorted-seq-msgs (cdr sorted-seq-msgs))) - (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"))))) + (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))) + 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 @@ -197,37 +206,39 @@ (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-widen) (mh-remove-all-notation) - (let ((eob (point-max)) + (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) + (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) + (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) + (setq mh-narrowed-to-seq sequence) (push 'widen mh-view-ops))) - (t - (error "No messages in sequence `%s'" (symbol-name sequence)))))) + (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. @@ -235,19 +246,18 @@ the selected region is added to the sequence." (interactive (list (cond ((mh-mark-active-p t) - (mh-region-to-sequence (region-beginning) (region-end)) - 'region) + (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))) + (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 (if (numberp msg-or-seq) - msg-or-seq - (mh-seq-to-msgs msg-or-seq)) - 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. @@ -256,6 +266,7 @@ (pop mh-view-ops)) (t nil))) +;;;###mh-autoload (defun mh-widen () "Remove restrictions from current folder, thereby showing all messages." (interactive) @@ -304,16 +315,16 @@ ;;; Commands to manipulate sequences. Sequences are stored in an alist ;;; of the form: -;;; ((seq-name msgs ...) (seq-name msgs ...) ...) +;;; ((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))))) + (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. @@ -321,60 +332,65 @@ 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 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)) + (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)) + 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: ")))) + (intern (read-string "New sequence name: ")))) (let ((old-seq (mh-find-seq sequence))) (or old-seq - (error "Sequence %s does not exist" sequence)) + (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. -The remaining ARGS are passed as arguments to FUNC." + "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 (mh-seq-to-msgs seq))) + (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)))))) + (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))))) + (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 @@ -397,20 +413,25 @@ (save-restriction (narrow-to-region (point) (point)) (mh-regenerate-headers coalesced-msgs t) - (when (memq 'unthread mh-view-ops) - ;; Populate restricted scan-line map - (goto-char (point-min)) - (while (not (eobp)) - (setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map) - (mh-thread-parse-scan-line)) - (forward-line)) - ;; Remove scan lines and read results from pre-computed thread 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-generate-scan-lines thread-tree -2))))))) + (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. @@ -421,24 +442,25 @@ (beginning-of-line) (save-excursion (let ((beginning-of-line (point)) - end) + end) (forward-line 1) (setq end (point)) (goto-char location) (insert-buffer-substring (current-buffer) beginning-of-line end)))) -(defun mh-region-to-sequence (begin end) - "Define sequence 'region as the messages between point and mark. -When called programmatically, use arguments BEGIN and END to define region." - (interactive "r") - (mh-delete-seq-locally 'region) +;;;###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) - (while (<= (point) end) - (mh-add-msgs-to-seq (mh-get-msg-num t) 'region t) - (forward-line 1)))) + (let ((result ())) + (while (<= (point) end) + (let ((index (mh-get-msg-num nil))) + (when (numberp index) (push index result))) + (forward-line 1)) + result))) @@ -493,6 +515,7 @@ (t 0)))))) +;;;###mh-autoload (defun mh-narrow-to-subject () "Narrow to a sequence containing all following messages with same subject." (interactive) @@ -510,6 +533,7 @@ (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 @@ -527,30 +551,42 @@ (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 ())))) + (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'. @@ -570,8 +606,8 @@ (parent-container (mh-container-parent child-container))) (when parent-container (setf (mh-container-children parent-container) - (remove* child-container (mh-container-children parent-container) - :test #'eq)) + (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) @@ -711,7 +747,7 @@ (setf (mh-container-real-child-p node) t))))))) (defun mh-thread-prune-containers (roots) -"Prune empty containers in the containers ROOTS." + "Prune empty containers in the containers ROOTS." (let ((dfs-ordered-nodes ()) (work-list roots)) (while work-list @@ -804,16 +840,18 @@ 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 (search ">" reply-to-header :from-end t))) + (let ((end (mh-search-from-end ?> reply-to-header))) (when (numberp end) - (let ((begin (search "<" reply-to-header :from-end t :end2 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)))) + (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)) @@ -851,7 +889,7 @@ #'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" - (mapcar #'(lambda (x) (format "%s" x)) msg-list))) + folder (mapcar #'(lambda (x) (format "%s" x)) msg-list))) (goto-char (point-min)) (let ((roots ()) (case-fold-search t)) @@ -859,8 +897,8 @@ (while (not (eobp)) (block process-message (let* ((index-line - (prog1 (buffer-substring (point) (line-end-position)) - (forward-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))) @@ -901,6 +939,7 @@ (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." @@ -909,22 +948,26 @@ (let ((msg-list ())) (while (not (eobp)) (let ((index (mh-get-msg-num nil))) - (push index msg-list) - (setf (gethash index mh-thread-scan-line-map) - (mh-thread-parse-scan-line)) + (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)))) + (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 @@ -938,18 +981,31 @@ (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) + (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) + (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 @@ -984,14 +1040,16 @@ (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)))) - (setf (gethash msg-num mh-thread-scan-line-map) - (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))) + (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 () @@ -1000,23 +1058,24 @@ (mh-thread-initialize) (goto-char (point-min)) (while (not (eobp)) - (setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map) - (mh-thread-parse-scan-line)) + (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))) - (buffer-read-only nil) - (old-buffer-modified-p (buffer-modified-p))) + (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)))) + (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-p) (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 @@ -1024,24 +1083,32 @@ 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))) + (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)) + 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)) + 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)) @@ -1058,9 +1125,152 @@ (setf (gethash id mh-thread-duplicates) (remove index duplicates)))))) + + +;;; 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:
--- a/lisp/mail/mh-speed.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-speed.el Wed Jan 08 23:21:16 2003 +0000 @@ -2,7 +2,7 @@ ;; Copyright (C) 2002 Free Software Foundation, Inc. -;; Author: Bill Wohler <wohler@newt.com> +;; Author: Satyaki Das <satyaki@theforce.stanford.edu> ;; Maintainer: Bill Wohler <wohler@newt.com> ;; Keywords: mail ;; See: mh-e.el @@ -31,71 +31,15 @@ ;;; Change Log: -;; $Id: mh-speed.el,v 1.26 2002/11/13 19:36:00 wohler Exp $ +;; $Id: mh-speed.el,v 1.34 2003/01/07 21:15:20 satyaki Exp $ ;;; Code: ;; Requires (require 'cl) -(require 'mh-utils) (require 'mh-e) (require 'speedbar) -;; Autoloads -(autoload 'mh-index-goto-nearest-msg "mh-index") -(autoload 'mh-index-parse-folder "mh-index") -(autoload 'mh-visit-folder "mh-e") - -;; User customizable -(defcustom mh-large-folder 200 - "The number of messages that indicates a large folder. -If the number of messages in a folder exceeds this value, confirmation is -required when the folder is visited from the speedbar." - :type 'integer - :group 'mh) - -(defcustom mh-speed-flists-interval 60 - "Time between calls to flists in seconds. -If 0, flists is not called repeatedly." - :type 'integer - :group 'mh) - -(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) - -(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) - -(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) - -(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) - -(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) - ;; Global variables (defvar mh-speed-refresh-flag nil) (defvar mh-speed-last-selected-folder nil) @@ -116,6 +60,7 @@ (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." @@ -134,24 +79,22 @@ (when mh-speed-run-flists-flag (mh-speed-flists nil)))) +;;;###mh-autoload (defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons) -(defalias 'mh-index-folder-speedbar-buttons 'mh-folder-speedbar-buttons) -(defalias 'mh-index-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) + "+" 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-index-folder-speedbar-key-map mh-folder-speedbar-key-map) -(defvar mh-index-show-speedbar-key-map mh-folder-speedbar-key-map) (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) ;; Menus for speedbar... @@ -171,8 +114,6 @@ "Extra menu items for speedbar.") (defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) -(defvar mh-index-folder-speedbar-menu-items mh-folder-speedbar-menu-items) -(defvar mh-index-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 () @@ -193,12 +134,12 @@ The update is always carried out if FORCE is non-nil." (let* ((lastf (selected-frame)) - (newcf (save-excursion + (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)) + (lastb (current-buffer)) + (case-fold-search t)) (when (or force (and mh-speed-refresh-flag (not (eq lastf speedbar-frame))) (and (stringp newcf) @@ -271,7 +212,7 @@ (suffix-list ()) (last-slash t)) (while (and (not (gethash prefix mh-speed-folder-map)) last-slash) - (setq last-slash (search "/" prefix :from-end t)) + (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)))) @@ -306,15 +247,10 @@ ((eq major-mode 'mh-show-mode) (set-buffer mh-show-folder-buffer) mh-current-folder) - ((eq major-mode 'mh-index-folder-mode) - (save-excursion - (mh-index-goto-nearest-msg) - (mh-index-parse-folder))) - ((or (eq major-mode 'mh-index-show-mode) - (eq major-mode 'mh-letter-mode)) + ((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 (search "/" rel-path :from-end t))) + (directory-end (mh-search-from-end ?/ rel-path))) (when directory-end (format "+%s" (substring rel-path 0 directory-end))))))))) @@ -347,12 +283,14 @@ (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)))))) + 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." @@ -393,45 +331,14 @@ (defalias 'mh-speed-expand-folder 'mh-speed-toggle) (defalias 'mh-speed-contract-folder 'mh-speed-toggle) -(defun mh-speed-folder-size () - "Find folder size if folder on current line." - (let ((folder (get-text-property (line-beginning-position) 'mh-folder))) - (or (cdr (get-text-property (line-beginning-position) 'mh-count)) - (and (null folder) 0) - (with-temp-buffer - (call-process (expand-file-name "flist" mh-progs) nil t nil - "-norecurse" folder) - (goto-char (point-min)) - (unless (re-search-forward "out of " (line-end-position) t) - (error "Call to flist failed on folder %s" folder)) - (car (read-from-string - (buffer-substring-no-properties (point) - (line-end-position)))))))) - +;;;###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 - (cond ((save-excursion - (beginning-of-line) - (re-search-forward "([1-9][0-9]*/[0-9]+)" - (line-end-position) t)) - mh-unseen-seq) - ((> (mh-speed-folder-size) mh-large-folder) - (let* ((size (mh-speed-folder-size)) - (prompt - (format "How many messages from %s (default: %s): " - folder size)) - (in (read-string prompt nil nil - (number-to-string size))) - (result (car (ignore-errors (read-from-string in))))) - (cond ((null result) (format "last:%s" size)) - ((numberp result) (format "last:%s" result)) - (t (format "%s" result))))) - (t nil)))) + (range (and (stringp folder) (mh-read-msg-range folder)))) (when (stringp folder) (speedbar-with-attached-buffer (mh-visit-folder folder range) @@ -463,19 +370,22 @@ (apply #'call-process arg-list) (goto-char (point-min)) (while (not (and (eolp) (bolp))) - (let ((folder-end (or (search-forward "+ " (line-end-position) t) - (search-forward " " (line-end-position) t)))) - (when (integerp folder-end) - (let ((name (buffer-substring (line-beginning-position) - (match-beginning 0)))) + (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))))) + (cons name + (search-forward "(others)" (line-end-position) t)) + results))))) (forward-line 1)))) (setq results (nreverse results)) (when (stringp folder) @@ -487,6 +397,7 @@ 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." @@ -509,7 +420,8 @@ 'exit))) (setq mh-speed-flists-process (start-process (expand-file-name "flists" mh-progs) nil - "flists" "-recurse")) + "flists" "-recurse" + "-sequence" (symbol-name mh-unseen-seq))) (set-process-filter mh-speed-flists-process 'mh-speed-parse-flists-output))))))) @@ -527,61 +439,53 @@ mh-speed-partial-line (substring output position line-end)) mh-speed-partial-line "") - (when (string-match "+? " line) - (setq folder (format "+%s" (subseq line 0 (match-beginning 0)))) - (when (string-match " has " line) - (setq unseen (car (read-from-string line (match-end 0)))) - (when (string-match "; out of " line) - (setq total (car (read-from-string line (match-end 0)))) - (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)))))))))))))) + (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 (subseq output position)))) + (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 (search "/" folder :from-end t)) + (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)) @@ -615,13 +519,14 @@ (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 (search "/" folder :from-end t)) + (last-slash (mh-search-from-end ?/ folder)) (ancestor folder) (ancestor-pos nil)) (block while-loop @@ -630,7 +535,7 @@ (setq ancestor-pos (gethash ancestor mh-speed-folder-map)) (when ancestor-pos (return-from while-loop)) - (setq last-slash (search "/" ancestor :from-end t)))) + (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 @@ -650,17 +555,18 @@ (save-excursion (beginning-of-line) (if (re-search-forward "\\[.\\]" (line-end-position) t) - (speedbar-with-writable + (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))))) + (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:
--- a/lisp/mail/mh-utils.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-utils.el Wed Jan 08 23:21:16 2003 +0000 @@ -30,12 +30,24 @@ ;;; Change Log: -;; $Id: mh-utils.el,v 1.177 2002/11/22 20:00:47 satyaki Exp $ +;; $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) @@ -43,188 +55,13 @@ (defvar mark-active) (defvar tool-bar-mode) -(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 - -;;; Autoload mh-seq -(autoload 'mh-add-to-sequence "mh-seq") -(autoload 'mh-notate-seq "mh-seq") -(autoload 'mh-read-seq-default "mh-seq") -(autoload 'mh-map-to-seq-msgs "mh-seq") - -;;; Autoload mh-e -(autoload 'mh-goto-cur-msg "mh-e") -(autoload 'mh-update-sequences "mh-e") - -;;; Autoload mh-mime -(autoload 'mh-add-missing-mime-version-header "mh-mime") -(autoload 'mh-mime-cleanup "mh-mime") -(autoload 'mh-buffer-data "mh-mime" nil nil t) -(autoload 'mh-make-buffer-data "mh-mime" nil nil) -(autoload 'mh-mime-display "mh-mime") -(autoload 'mh-display-smileys "mh-mime") -(autoload 'mh-display-emphasis "mh-mime") - -;;; Autoload mh-index -(autoload 'mh-index-search "mh-index" - "Perform an indexed search in an MH mail folder. - -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. Optional -prefix argument NEW-BUFFER-FLAG decides whether the results are presented in a -new buffer. This allows multiple search results to coexist. - -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'" - t) -;;; These are here since their docstrings are needed before loading mh-index. -(autoload '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 - IncludeFile Mail [0-9]* - IndexFile /home/user/Mail/.swish++/swish++.index - -Use the following command line to generate the swish index. Run this -daily from cron: - - index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail - -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." - t) -(autoload '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 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 - -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." - t) -(autoload '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]*\"; - -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." - t) -(autoload '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 - -If there are any directories you would like to ignore, append lines like the -following to .glimpse_exclude: - - ^/home/user/Mail/scripts - -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." - t) - -;;; Autoload mh-speed -(autoload 'mh-speed-add-folder "mh-speed") - -;;; Autoload mh-comp -(autoload 'mh-reply "mh-comp" nil t) - -;;; Other Autoloads +;;; Autoloads (autoload 'gnus-article-highlight-citation "gnus-cite") (autoload 'mail-header-end "sendmail") (autoload 'Info-goto-node "info") -(autoload 'font-lock-default-fontify-region "font-lock") (unless (fboundp 'make-hash-table) (autoload 'make-hash-table "cl")) -;; Is this XEmacs-land? -(defvar mh-xemacs-flag (featurep 'xemacs) - "Non-nil means the current Emacs is XEmacs.") - ;;; 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 @@ -254,217 +91,32 @@ ;;;###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 + (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 + (t ;GNU Emacs `(and (boundp 'transient-mark-mode) transient-mark-mode (boundp 'mark-active) mark-active)))) -;;; User preferences: - -(defgroup mh-buffer nil - "Layout of MH-E buffers" - :prefix "mh-" - :group 'mh) - -(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) - -(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) - -(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-buffer) - -(defcustom mh-auto-folder-collect-flag t - "*Non-nil means immediate collect folder names in the background. -If t, MH-E should start a background process to collect the names of all -folders as soon as MH-E is first used." - :type 'boolean - :group 'mh) - -(defcustom mh-recursive-folders-flag nil - "*Non-nil means that commands which operate on folders do so recursively." - :type 'boolean - :group 'mh) - -(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) - -(defcustom mh-clean-message-header-flag t - "*Non-nil means clean headers of messages that are displayed or inserted. -The variables `mh-visible-headers' and `mh-invisible-headers' control what -is removed." - :type 'boolean - :group 'mh-buffer) - -(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 this variable -overrides `mh-invisible-headers'." - :type '(choice (const nil) regexp) - :group 'mh-buffer) - -(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-buffer) - -(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-buffer) - -(defvar 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: ")) - '( ;; RFC 822 - "Received: " "Message-Id: " "Return-Path: " - ;; RFC 2045 - "Mime-Version" "Content-" - ;; sendmail - "X-Authentication-Warning: " "X-MIME-Autoconverted: " "From " - "Status: " - ;; X400 - "X400-" "P1-Message-Id: " "Original-Encoded-Information-Types: " - "P1-Recipient: " "P1-Content-Type: " "Ua-Content-Id: " - ;; MH - "Resent" "Prev-Resent" "Forwarded: " "Replied: " "Delivery-Date: " - "In-Reply-To: " "Remailed-" "Via: " "Mail-from: " - ;; gnus - "X-Gnus-Mail-Source: " - ;; MS Outlook - "X-Priority: " "X-Msmail-" "X-MimeOLE: " "X-Apparently-From: " - "Importance: " "Sensitivity: " "X-MS-TNEF-Correlator: " - ;; Juno - "X-Juno-" - ;; Hotmail - "X-OriginalArrivalTime: " "X-Originating-IP: " - ;; Netscape/Mozilla - "X-Accept-Language: " "X-Mozilla-Status: " - ;; NTMail - "X-Info: " "X-VSMLoop: " - ;; News - "NNTP-" "X-News: " - ;; Mailman mailing list manager - "List-" "X-Beenthere: " "X-Mailman-Version: " - ;; Egroups/yahoogroups mailing list manager - "X-eGroups-" "X-Apparently-To: " "Mailing-List: " "Delivered-To: " - ;; SourceForge mailing list manager - "X-Original-Date: " - ;; Unknown mailing list managers - "X-Mailing-List: " "X-Loop: " - "List-Subscribe: " "List-Unsubscribe: " - "X-List-Subscribe: " "X-List-Unsubscribe: " - "X-Listserver: " "List-" "X-List-Host: " - ;; Sieve filtering - "X-Sieve: " - ;; Spam - "X-Spam-Status: " "X-Spam-Level: " "X-Spam-Score: " - "X-SpamBouncer: " "X-SBClass: " "X-SBRule: " "X-SBNote: " - "X-SBPass: " "X-Folder: " - "X-Habeas-SWE-1: " "X-Habeas-SWE-2: " "X-Habeas-SWE-3: " - "X-Habeas-SWE-4: " "X-Habeas-SWE-5: " "X-Habeas-SWE-6: " - "X-Habeas-SWE-7: " "X-Habeas-SWE-8: " "X-Habeas-SWE-9: " - ;; Worldtalk gateways - "X-Wss-Id: " - ;; User added - "X-Qotd-" - ;; Miscellaneous - "X-Sender: " "X-Ack: " "Errors-To: " "Precedence: " "X-Message-Id" - "X-From-Line" "X-Cron-Env: " "Delivery: " "X-Delivered" - "X-Received: " "X-Vms-To: " "Xref: " "X-Request-" "X-UIDL: " - "X-Orcl-Content-Type: " "X-Server-Uuid: " "X-Envelope-Sender: " - "X-Envelope-To: " "Encoding: " "Old-Return-Path: " "Path: " - "References: " "Lines: " "Autoforwarded: " "Bestservhost: " - "X-pgp: " "X-Accept-Language: " "Priority: " "User-Agent: " - "X-MIMETrack: " "X-Abuse-Info: " "X-Complaints-To: " - "X-No-Archive: " "X-Original-Complaints-To: " - "X-Original-Trace: " "X-Received-Date: " "X-Server-Date: " - "X-Trace: " "X-UserInfo1: " "X-submission-address: " - "X-Scanned-By")) - t))) - "*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.") - ;;; Additional header fields that might someday be added: ;;; "Sender: " "Reply-to: " -(defcustom mh-bury-show-buffer-flag t - "*Non-nil means that the displayed show buffer for a folder is buried." - :type 'boolean - :group 'mh-buffer) - -(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-buffer) - -;; 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 URLs and e-mail addresses are highlighted using goto-addr while in `mh-show-mode'." - :type 'boolean - :group 'mh-buffer) - (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 \\( \\)") @@ -485,58 +137,6 @@ "Format string containing a regexp matching the scan listing for a message. The desired message's number will be an argument to format.") -(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) -(put 'mhl-formfile 'info-file "mh-e") - -(defvar mh-decode-quoted-printable-have-mimedecode - (not (null (and (fboundp 'executable-find)(executable-find "mimedecode")))) - "Whether the mimedecode command is installed on the system. -This sets the default value of variable `mh-decode-quoted-printable-flag' to -determine whether quoted-printable MIME parts are decoded by the mimedecode -command when viewed in `mh-show'. The source code for mimedecode can be -obtained from http://www.freesoft.org/CIE/FAQ/mimedeco.c") - -(defcustom mh-decode-quoted-printable-flag - mh-decode-quoted-printable-have-mimedecode - "Non-nil means decode quoted-printable MIME part using mimedecode. - -Determine whether to decode quoted-printable MIME parts in `mh-show' -using mimedecode. - -Quoted printable content is translated to 8-bit characters in `mh-show' by -the gnus' mm-decode library if it is available. Otherwise (and for certain -cases mm-decode can't handle) this can be done using the 'mimedecode' -command. Setting this variable indicates to use 'mimedecode' when -mm-decode is not available or as a helper to it. The source code for -mimedecode can usually be obtained from -http://www.freesoft.org/CIE/FAQ/mimedeco.c" - :type 'boolean - :group 'mh-buffer) - -(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-buffer) - -(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-buffer) - (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 @@ -575,24 +175,23 @@ passed through `regexp-quote' before being used by functions like `re-search-forward'.") -;;; Hooks - -(defcustom mh-find-path-hook nil - "Invoked by `mh-find-path' after reading the user's MH profile." - :type 'hook - :group 'mh-hook) +;; Variables for MIME display -(defcustom mh-show-hook nil - "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message." - :type 'hook - :group 'mh-hook) +;; 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)) -(defcustom mh-show-mode-hook nil - "Invoked upon entry to `mh-show-mode'." - :type 'hook - :group 'mh-hook) - -;; Variables for MIME display (defvar mh-globals-hash (make-hash-table) "Keeps track of MIME data on a per buffer basis.") @@ -661,8 +260,8 @@ (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) + ;;("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) @@ -701,17 +300,42 @@ 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 + (backward-char 1)) ;to end of previous line (defun mh-letter-header-font-lock (limit) "Return the entire mail header to font-lock. @@ -733,12 +357,12 @@ (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 + (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 + (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))) @@ -759,88 +383,6 @@ Argument LIMIT limits search." (mh-header-field-font-lock "Subject:" limit)) -(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-buffer) - -(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-buffer) - -(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) -(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) - -(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-buffer) - -(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-buffer) - -(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-buffer) - (eval-and-compile ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite' (defvar mh-show-font-lock-keywords @@ -848,12 +390,12 @@ (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)) + (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)) + (1 'default) (2 mh-show-cc-face)) ("^\\(In-reply-to\\|Date\\):\\(.*\\)$" - (1 'default) (2 mh-show-date-face)) + (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.")) @@ -895,9 +437,9 @@ (if mh-xemacs-flag (progn (eval-and-compile - (require 'gnus) - (require 'gnus-art) - (require 'gnus-cite)))) + (require 'gnus) + (require 'gnus-art) + (require 'gnus-cite)))) (defun mh-gnus-article-highlight-citation () "Highlight cited text in current buffer using gnus." @@ -914,9 +456,9 @@ ;; 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-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)))) @@ -993,9 +535,9 @@ "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)))) + (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) @@ -1020,14 +562,14 @@ (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))) + (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))))) + '((mh-set-folder-modified-p nil))))) (put 'with-mh-folder-updating 'lisp-indent-hook 1) @@ -1035,12 +577,12 @@ "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 + (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 + (progn ,@body) (select-window mh-in-show-buffer-saved-window)))) @@ -1089,20 +631,21 @@ "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)))) + (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 + (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))) + (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 @@ -1110,11 +653,11 @@ (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)))) + (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. @@ -1122,31 +665,31 @@ (if (symbolp name) (eq (aref (symbol-name name) 0) ?+) (and (> (length name) 0) - (eq (aref 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))) + (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))) + (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) + &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." @@ -1186,9 +729,9 @@ ;;; 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-previous-undeleted-msg) (mh-defun-show-buffer mh-show-next-undeleted-msg - mh-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) @@ -1199,22 +742,23 @@ (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-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-write-msg-to-file) (mh-defun-show-buffer mh-show-extract-rejected-mail - mh-extract-rejected-mail t) + mh-extract-rejected-mail t) (mh-defun-show-buffer mh-show-delete-msg-no-motion - mh-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 - mh-delete-subject) +(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) @@ -1228,7 +772,7 @@ (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-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) @@ -1236,11 +780,11 @@ (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-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-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) @@ -1251,7 +795,16 @@ (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 @@ -1276,18 +829,21 @@ "f" mh-show-forward "g" mh-show-goto-msg "i" mh-show-inc-folder - "k" mh-show-delete-subject + "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) @@ -1316,7 +872,12 @@ (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) "?" mh-prefix-help - "t" mh-show-toggle-threads) + "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 @@ -1331,13 +892,13 @@ ;; Untested... (gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map) "?" mh-prefix-help - " " mh-show-page-digest + " " mh-show-page-digest "\177" mh-show-page-digest-backwards - "b" mh-show-burst-digest) + "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 + "a" mh-mime-save-parts "v" mh-show-toggle-mime-part "o" mh-show-save-mime-part "i" mh-show-inline-mime-part @@ -1409,91 +970,6 @@ "--" ["Quit MH-E" mh-quit t])) -(eval-when-compile (defvar tool-bar-map)) -(defvar mh-show-tool-bar-map nil) -(when (and (fboundp 'tool-bar-add-item) - tool-bar-mode) - (setq mh-show-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder - :help "Incorporate new mail in Inbox") - (tool-bar-add-item "attach" 'mh-mime-save-parts - 'mh-showtoolbar-mime-save-parts - :help "Save MIME parts") - - (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg - 'mh-showtoolbar-prev :help "Previous message") - (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page - :help "Page this message") - (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg - 'mh-showtoolbar-next :help "Next message") - - (tool-bar-add-item "close" 'mh-show-delete-msg 'mh-showtoolbar-delete - :help "Mark for deletion") - (tool-bar-add-item "refile" 'mh-show-refile-msg 'mh-showtoolbar-refile - :help "Refile this message") - (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo - :help "Undo this mark") - (tool-bar-add-item "execute" 'mh-show-execute-commands - 'mh-showtoolbar-exec - :help "Perform moves and deletes") - - (tool-bar-add-item "show" 'mh-show-toggle-showing - 'mh-showtoolbar-toggle-show - :help "Toggle showing message") - - (cond - (mh-tool-bar-reply-3-buttons-flag - (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 "Reply to \"from\"") - (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 "Reply to \"to\"") - (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 "Reply to \"all\"")) - (t - (tool-bar-add-item "mail/reply2" 'mh-show-reply 'mh-showtoolbar-reply - :help "Reply to this message"))) - (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose - :help "Compose new message") - - (tool-bar-add-item "rescan" 'mh-show-rescan-folder - 'mh-showtoolbar-rescan :help "Rescan this folder") - (tool-bar-add-item "repack" 'mh-show-pack-folder 'mh-showtoolbar-pack - :help "Repack this folder") - - (tool-bar-add-item "search" - (lambda (&optional arg) - (interactive "P") - (call-interactively mh-tool-bar-search-function)) - 'mh-showtoolbar-search :help "Search") - (tool-bar-add-item "fld_open" 'mh-visit-folder 'mh-showtoolbar-visit - :help "Visit other folder") - - (tool-bar-add-item "preferences" (lambda () - (interactive) - (customize-group "mh")) - 'mh-showtoolbar-customize - :help "MH-E preferences") - (tool-bar-add-item "help" (lambda () - (interactive) - (Info-goto-node "(mh-e)Top")) - 'mh-showtoolbar-help :help "Help") - tool-bar-map))) ;;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-show-mode 'mode-class 'special) @@ -1508,7 +984,7 @@ (mh-show-xface) (mh-show-addr) (make-local-variable 'font-lock-defaults) - ;(set (make-local-variable 'font-lock-support-mode) nil) + ;;(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))) @@ -1521,7 +997,7 @@ (t (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) (if (and mh-xemacs-flag - font-lock-auto-fontify) + 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)) @@ -1550,7 +1026,7 @@ (if (fboundp 'x-face-xmas-wl-display-x-face) #'x-face-xmas-wl-display-x-face #'ignore)) - ((>= emacs-major-version 21) + ((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 @@ -1561,7 +1037,8 @@ (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)) + (or mh-decode-mime-flag mhl-formfile + mh-clean-message-header-flag)) (funcall mh-show-xface-function))) (defun mh-maybe-show (&optional msg) @@ -1601,22 +1078,23 @@ (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))) + (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 + (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)))) + (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))) + (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)) @@ -1706,16 +1184,16 @@ (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)) + (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)) + (> (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) @@ -1724,11 +1202,11 @@ ;; 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)) + (kill-local-variable 'write-contents-hooks)) (if formfile - (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" + (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" (if (stringp formfile) - (list "-form" formfile)) + (list "-form" formfile)) msg-filename) (insert-file-contents msg-filename)) (if mh-decode-quoted-printable-flag @@ -1781,27 +1259,27 @@ 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. + ;causing an endless loop. (save-restriction (goto-char start) (if (search-forward "\n\n" nil 'move) - (backward-char 1)) + (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)))) + (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) @@ -1813,12 +1291,12 @@ 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))))) + (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. @@ -1826,18 +1304,18 @@ 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))) + (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. @@ -1869,12 +1347,12 @@ (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))))))) + ((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) @@ -1897,44 +1375,44 @@ ;; 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 + (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))) + (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 "Mail")) (setq mh-user-path - (file-name-as-directory - (expand-file-name mh-user-path (expand-file-name "~")))) + (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))))) + (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-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-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))) + (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 + (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." @@ -1952,7 +1430,7 @@ "/usr/bin/mh/" ;Ultrix 4.2, Linux "/usr/new/mh/" ;Ultrix <4.2 "/usr/contrib/mh/bin/" ;BSDI - "/usr/pkg/bin/" ; NetBSD + "/usr/pkg/bin/" ; NetBSD "/usr/local/bin/" ) "mhparam")))) @@ -1978,29 +1456,29 @@ 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"))))) + (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))))) + (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 +(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) + (file-exists-p profile) + mh-no-install) (signal (car error-val) - (list (format "Cannot read MH profile \"%s\"" profile) - (car (cdr (cdr 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 @@ -2011,9 +1489,9 @@ (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)))))))) + (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." @@ -2042,37 +1520,21 @@ (substring fmt end)))) fmt)) -(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))) - (progn - (setq mh-cmd-note width) - ;; Rachet up the default value - (if (< (default-value 'mh-cmd-note) mh-cmd-note) - (setq-default mh-cmd-note mh-cmd-note)))) - mh-cmd-note) - (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)) + (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)")) + (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)))))) + (setq width (length (buffer-substring + (match-beginning 1) (match-end 1)))))) width)) (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag) @@ -2083,14 +1545,14 @@ (let ((entry (mh-find-seq seq))) (if (and msgs (atom msgs)) (setq msgs (list msgs))) (if (null entry) - (setq mh-seq-list + (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)))))) + (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." @@ -2122,54 +1584,54 @@ ((equal "" default) "? ") (t (format " [%s]? " default)))) (prompt (format "%s folder%s" prompt default-string)) - read-name folder-name) + read-name folder-name) (if (null mh-folder-list) - (mh-set-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 ""))) + "+" '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)))) + (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)))) + (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))))) + (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) + (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)))) + (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. + ;the folder list. -(defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built. +(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. +(defvar mh-folder-list-partial-line "") ;Start of last incomplete line from + ;folder process. (defun mh-set-folder-list () "Set `mh-folder-list' correctly. @@ -2198,47 +1660,47 @@ (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"))) + (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) + '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))) + 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))) + ;; 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)))) @@ -2253,12 +1715,12 @@ (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)) + (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))))) + (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. @@ -2268,17 +1730,17 @@ (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))))) + (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) @@ -2288,10 +1750,10 @@ (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)))) + (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) @@ -2309,14 +1771,20 @@ (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))) + (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) + (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 @@ -2338,8 +1806,8 @@ 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)) + (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 @@ -2358,26 +1826,26 @@ 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))))))) + (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." @@ -2388,22 +1856,23 @@ (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)))) + ((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:
--- a/lisp/mail/mh-xemacs-compat.el Wed Jan 08 22:16:12 2003 +0000 +++ b/lisp/mail/mh-xemacs-compat.el Wed Jan 08 23:21:16 2003 +0000 @@ -28,7 +28,7 @@ ;;; Change Log: -;; $Id: mh-xemacs-compat.el,v 1.12 2002/11/02 19:56:50 wohler Exp $ +;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $ ;;; Code: @@ -52,10 +52,10 @@ (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:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/toolbar/alias.pbm Wed Jan 08 23:21:16 2003 +0000 @@ -0,0 +1,3 @@ +P4 +24 24 +ÿÿÿÿÿÿÿÿÿýŸÿðÿïûÿÿüïÿÏÿÏïÿÏïÿïÏÿï÷ÿÿãÿçõÿ÷üÿþÿÙÿÿù÷ÿÿ÷ÿÿüÿÿÿÿÿÿÿÿÿ \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/toolbar/alias.xpm Wed Jan 08 23:21:16 2003 +0000 @@ -0,0 +1,33 @@ +/* XPM */ +static char * alias_xpm[] = { +/* columns rows colors chars-per-pixel */ +"24 24 4 1", +" c None", +". c #61b761b7600a", +"X c #a5d8a5d89550", +"o c black", +/* pixels */ +" ", +" ", +" ", +" ...... ", +" ...XXXX..XX ", +" o..ooooooo... ", +" ooo oooo..X ", +" o.X ooo... ", +" o.X ooo.XX ", +" o.X oo.. ", +" o.X oo. ", +" o... oo.. ", +" o.X o.. ", +" o.XX oX. ", +" o.... oo. ", +" o..XX oooo ", +" o...XXX XXoooo ", +" ooo........ooooo ", +" oooooXXooooo.oo ", +" ooo o..oo", +" o...", +" ooo", +" oo", +" "};