diff options
| author | Bill Wohler | 2003-01-08 23:21:16 +0000 |
|---|---|---|
| committer | Bill Wohler | 2003-01-08 23:21:16 +0000 |
| commit | c3d9274aea16845838647cf2a225e8f60709b3ff (patch) | |
| tree | ab2accdf078f99407b22d16a5a94017ffe02efe2 | |
| parent | 21bd170ddef47f963b71d5ad90285a4c2ccc89ca (diff) | |
| download | emacs-c3d9274aea16845838647cf2a225e8f60709b3ff.tar.gz emacs-c3d9274aea16845838647cf2a225e8f60709b3ff.zip | |
Upgraded to MH-E version 7.1.
| -rw-r--r-- | etc/ChangeLog | 4 | ||||
| -rw-r--r-- | etc/MH-E-NEWS | 208 | ||||
| -rw-r--r-- | etc/NEWS | 2 | ||||
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/mail/mh-alias.el | 590 | ||||
| -rw-r--r-- | lisp/mail/mh-comp.el | 1267 | ||||
| -rw-r--r-- | lisp/mail/mh-customize.el | 1751 | ||||
| -rw-r--r-- | lisp/mail/mh-e.el | 1888 | ||||
| -rw-r--r-- | lisp/mail/mh-funcs.el | 313 | ||||
| -rw-r--r-- | lisp/mail/mh-identity.el | 219 | ||||
| -rw-r--r-- | lisp/mail/mh-index.el | 1366 | ||||
| -rw-r--r-- | lisp/mail/mh-loaddefs.el | 880 | ||||
| -rw-r--r-- | lisp/mail/mh-mime.el | 347 | ||||
| -rw-r--r-- | lisp/mail/mh-pick.el | 160 | ||||
| -rw-r--r-- | lisp/mail/mh-seq.el | 508 | ||||
| -rw-r--r-- | lisp/mail/mh-speed.el | 266 | ||||
| -rw-r--r-- | lisp/mail/mh-utils.el | 1289 | ||||
| -rw-r--r-- | lisp/mail/mh-xemacs-compat.el | 4 | ||||
| -rw-r--r-- | lisp/toolbar/alias.pbm | 3 | ||||
| -rw-r--r-- | lisp/toolbar/alias.xpm | 33 |
20 files changed, 6756 insertions, 4352 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog index d8d1b256087..956f39a710c 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2003-01-08 Bill Wohler <wohler@newt.com> | ||
| 2 | |||
| 3 | * MH-E-NEWS: Upgraded to MH-E version 7.1. | ||
| 4 | |||
| 1 | 2003-01-01 Steven Tamm <steventamm@mac.com> | 5 | 2003-01-01 Steven Tamm <steventamm@mac.com> |
| 2 | 6 | ||
| 3 | * MACHINES: Added pointer to Mac OS X install instructions. | 7 | * MACHINES: Added pointer to Mac OS X install instructions. |
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS index 1dba2d48864..e73ec462a38 100644 --- a/etc/MH-E-NEWS +++ b/etc/MH-E-NEWS | |||
| @@ -1,3 +1,209 @@ | |||
| 1 | * Changes in mh-e 7.1 | ||
| 2 | |||
| 3 | This release includes the new features of multiple identities and | ||
| 4 | alias completion. In addition, indexed searching has been revamped. | ||
| 5 | Various other features have been added and a few bugs were fixed. | ||
| 6 | |||
| 7 | ** New Features in MH-E 7.1 | ||
| 8 | |||
| 9 | *** Multiple Identities | ||
| 10 | |||
| 11 | MH-E now supports multiple identities (closes SF #628782). That means | ||
| 12 | that you can have different From and Organization header fields (or | ||
| 13 | any other header field of your choice) as well as different signatures | ||
| 14 | depending on your context. Usually, the contexts are home and work. | ||
| 15 | |||
| 16 | Add your identities to the variable `mh-identity-list' and set the | ||
| 17 | default identity with the variable `mh-identity-default'. Your | ||
| 18 | identity can be switched on the fly by using the Identity menu or by | ||
| 19 | calling "M-x mh-insert-identity RET". | ||
| 20 | |||
| 21 | This functionality can be customized within the mh-identity group. | ||
| 22 | |||
| 23 | *** Alias Completion and Harvesting | ||
| 24 | |||
| 25 | The contributed file mh-alias.el has been rewritten and incorporated | ||
| 26 | into MH-E. | ||
| 27 | |||
| 28 | By default, aliases are culled from the system files | ||
| 29 | "/etc/nmh/MailAliases," "/usr/lib/mh/MailAliases," and "/etc/passwd" | ||
| 30 | (see `mh-alias-system-aliases') and from your "AliasFile" MH profile | ||
| 31 | component. These aliases are then used for completion in the | ||
| 32 | minibuffer when entering addresses. Within the header of the message | ||
| 33 | draft, "M-TAB (mh-letter-complete)" is used to do alias completion. | ||
| 34 | |||
| 35 | The package also provides for alias creation based upon the From | ||
| 36 | header field of the current message. Use the lasso button | ||
| 37 | (mh-alias-grab-from-field). | ||
| 38 | |||
| 39 | This functionality can be customized within the mh-alias group. | ||
| 40 | |||
| 41 | *** Index Folder Updates | ||
| 42 | |||
| 43 | The results of an index search "F i (mh-index-search)" are now stored | ||
| 44 | in a bona fide folder so that you can refile messages and reply to | ||
| 45 | messages directly from the result folder. This folder is a sub-folder | ||
| 46 | of +mhe-index and the name is based upon the search string (closes SF | ||
| 47 | #623321). | ||
| 48 | |||
| 49 | If a prefix argument is given then the search in the current index | ||
| 50 | buffer is redone. | ||
| 51 | |||
| 52 | The index folder lists the names of the source folders as before. | ||
| 53 | However, instead of using RET on the name of the folder to visit the | ||
| 54 | folder, use "v (mh-show-index-visit-folder)" anywhere within the | ||
| 55 | results to visit that folder narrowed to the results of the search. | ||
| 56 | Additional functions have been added to navigate including "TAB | ||
| 57 | (mh-index-next-folder)", and "SHIFT-TAB (mh-index-previous-folder)." | ||
| 58 | |||
| 59 | *** mh-visit-folder Interface Updated | ||
| 60 | |||
| 61 | A change was made to the prompting of the message range. In general, | ||
| 62 | you can use the same format for messages and sequences as you can in | ||
| 63 | MH with a single exception: a single number means to scan that many | ||
| 64 | messages, rather than scan that message number. This turns out to be | ||
| 65 | much more useful than visiting a single message and is consistent with | ||
| 66 | Gnus and the MH-E speedbar (closes SF #655891). | ||
| 67 | |||
| 68 | If mh-visit-folder is called non-interactively and RANGE is nil then | ||
| 69 | all messages are displayed. This behavior is now documented and | ||
| 70 | provides backwards compatibility. | ||
| 71 | |||
| 72 | *** Threading Improvements | ||
| 73 | |||
| 74 | After incorporating new mail into a threaded folder, unseen messages | ||
| 75 | can be spread about. Two new functions have been added to make it | ||
| 76 | easier to find them: these are "M-n (mh-next-unread-msg)" and "M-p | ||
| 77 | (mh-previous-unread-msg)" (closes SF #630328) | ||
| 78 | |||
| 79 | Two new functions were added to delete and refile threads. They are "T | ||
| 80 | d (mh-thread-delete)" and "T o (mh-thread-refile)" respectively | ||
| 81 | (closes SF #630493). | ||
| 82 | |||
| 83 | In addition, the key "k" used to be bound to the function | ||
| 84 | `mh-delete-subject': it is now bound to | ||
| 85 | `mh-show-delete-subject-or-thread'. | ||
| 86 | |||
| 87 | New functions to navigate threads include "T u (mh-thread-ancestor)", | ||
| 88 | which can jump to the root message of the current thread given an | ||
| 89 | optional argument, "T n (mh-thread-next-sibling)", and "T p | ||
| 90 | (mh-thread-previous-sibling)" | ||
| 91 | |||
| 92 | *** Refiling of Messages in Region | ||
| 93 | |||
| 94 | If mark is active and `transient-mark-mode' is enabled then all the | ||
| 95 | messages in the region are refiled. | ||
| 96 | |||
| 97 | *** vCard Handling | ||
| 98 | |||
| 99 | If a signature cannot be identified, but there is a vCard attachment, | ||
| 100 | then that vCard will be presented as a signature (closes SF #649216). | ||
| 101 | |||
| 102 | *** New Info Added to mh-version | ||
| 103 | |||
| 104 | Information about Gnus versions available at both compile time and run | ||
| 105 | time has been added. | ||
| 106 | |||
| 107 | ** New Variables in MH-E 7.1 | ||
| 108 | |||
| 109 | The defcustom groups were reorganized. Rather than iterate the | ||
| 110 | specific changes here, you are invited to browse the groups with "M-x | ||
| 111 | mh-customize RET". | ||
| 112 | |||
| 113 | *** mh-alias-completion-ignore-case-flag | ||
| 114 | |||
| 115 | Non-nil means don't consider case significant in MH alias completion. | ||
| 116 | This is the default in plain MH, so it is the default here as well. It | ||
| 117 | can be useful to set this to t if, for example, you use lowercase | ||
| 118 | aliases for people and uppercase for mailing lists. | ||
| 119 | |||
| 120 | *** mh-alias-expand-aliases-flag | ||
| 121 | |||
| 122 | Non-nil means to expand aliases entered in the minibuffer. In other | ||
| 123 | words, aliases entered in the minibuffer will be expanded to the full | ||
| 124 | address in the message draft. By default, this expansion is not | ||
| 125 | performed. | ||
| 126 | |||
| 127 | *** mh-alias-flash-on-comma | ||
| 128 | |||
| 129 | Specify whether to flash the translation of the alias or warn if there | ||
| 130 | isn't a translation of the alias. | ||
| 131 | |||
| 132 | *** mh-alias-insert-file | ||
| 133 | |||
| 134 | Filename to use to store new MH-E aliases. This variable can also be a | ||
| 135 | list of filenames, in which case MH-E will prompt for one of them. If | ||
| 136 | nil, the default, then MH-E will use the first file found in the | ||
| 137 | "AliasFile" component of the MH profile. | ||
| 138 | |||
| 139 | *** mh-alias-insertion-location | ||
| 140 | |||
| 141 | Specifies where new aliases are entered in alias files. Options are | ||
| 142 | sorted alphabetically (the default), at the top of the file or at the | ||
| 143 | bottom. | ||
| 144 | |||
| 145 | *** mh-alias-local-users | ||
| 146 | |||
| 147 | If t, local users are completed in MH-E To: and Cc: prompts. | ||
| 148 | |||
| 149 | If you set this variable to a string, it will be executed to generate | ||
| 150 | a password file. A value of "ypcat passwd" is helpful if NIS is in | ||
| 151 | use. | ||
| 152 | |||
| 153 | *** mh-alias-system-aliases | ||
| 154 | |||
| 155 | A list of system files from which to cull aliases. If these files are | ||
| 156 | modified, they are automatically reread. This list need include only | ||
| 157 | system aliases and the passwd file, since personal alias files listed | ||
| 158 | in your "AliasFile" MH profile component are automatically included. | ||
| 159 | |||
| 160 | *** mh-identity-default | ||
| 161 | |||
| 162 | Default identity to use when `mh-letter-mode' is called. | ||
| 163 | |||
| 164 | *** mh-identity-list | ||
| 165 | |||
| 166 | List holding MH-E identity. | ||
| 167 | |||
| 168 | *** mh-invisible-header-fields | ||
| 169 | |||
| 170 | Simple user interface to change `mh-invisible-headers'. | ||
| 171 | |||
| 172 | *** mh-letter-complete-function | ||
| 173 | |||
| 174 | Function to call when completing outside of fields specific to | ||
| 175 | aliases. By default, it is bound to 'ispell-complete-word. | ||
| 176 | |||
| 177 | *** mh-show-threads-flag | ||
| 178 | |||
| 179 | Non-nil means new folders start in threaded mode. Threading large | ||
| 180 | number of messages can be time consuming. So if the flag is non-nil | ||
| 181 | then threading will be done only if the number of messages being | ||
| 182 | threaded is less than `mh-large-folder' (closes SF #646794). | ||
| 183 | |||
| 184 | *** mh-tool-bar-folder-buttons | ||
| 185 | |||
| 186 | Buttons to include in MH-E folder/show toolbar. | ||
| 187 | |||
| 188 | *** mh-tool-bar-letter-buttons | ||
| 189 | |||
| 190 | Buttons to include in MH-E letter toolbar. | ||
| 191 | |||
| 192 | ** Bug Fixes in MH-E 7.1 | ||
| 193 | |||
| 194 | *** mh-get-new-mail | ||
| 195 | |||
| 196 | Call new function `mh-add-cur-notation' to undo the work of | ||
| 197 | `mh-remove-cur-notation' if there was no new mail (closes SF #647681). | ||
| 198 | |||
| 199 | *** mh-set-cmd-note | ||
| 200 | |||
| 201 | No longer updates the default `mh-cmd-note' value. This resulted in | ||
| 202 | the misplacement of the current mark when the message number width | ||
| 203 | changed (closes SF #643701). | ||
| 204 | |||
| 205 | |||
| 206 | |||
| 1 | * Changes in mh-e 7.0 | 207 | * Changes in mh-e 7.0 |
| 2 | 208 | ||
| 3 | This is a major release which includes a lot of new features including | 209 | This is a major release which includes a lot of new features including |
| @@ -62,7 +268,7 @@ You can now use the MH-Folder mode commands from the MH-Show buffer. | |||
| 62 | Because of this, the MH-Show buffer is now read-only (closes SF | 268 | Because of this, the MH-Show buffer is now read-only (closes SF |
| 63 | #493749 and SF #527946) and you now have to use "M (mh-modify)" to | 269 | #493749 and SF #527946) and you now have to use "M (mh-modify)" to |
| 64 | edit a message. | 270 | edit a message. |
| 65 | 271 | ||
| 66 | *** Better Scanning | 272 | *** Better Scanning |
| 67 | 273 | ||
| 68 | You no longer have to modify your scan format if your folders have | 274 | You no longer have to modify your scan format if your folders have |
| @@ -90,7 +90,7 @@ You can now put the init files .emacs and .emacs_SHELL under | |||
| 90 | 90 | ||
| 91 | ** MH-E changes. | 91 | ** MH-E changes. |
| 92 | 92 | ||
| 93 | Upgraded to mh-e version 7.0. There have been major changes since | 93 | Upgraded to MH-E version 7.1. There have been major changes since |
| 94 | version 5.0.2; see MH-E-NEWS for details. | 94 | version 5.0.2; see MH-E-NEWS for details. |
| 95 | 95 | ||
| 96 | +++ | 96 | +++ |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b4c1dd9cd5b..978e41a72da 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2003-01-08 Bill Wohler <wohler@newt.com> | ||
| 2 | |||
| 3 | * mail/mh-alias.el, mail/mh-customize.el, mail/mh-identity.el, | ||
| 4 | mail/mh-loaddefs.el, toolbar/alias.pbm, toolbar/alias.xpm: Added. | ||
| 5 | |||
| 6 | * mail/mh-comp.el, mail/mh-e.el, mail/mh-funcs.el, | ||
| 7 | mail/mh-index.el, mail/mh-mime.el, mail/mh-pick.el, | ||
| 8 | mail/mh-seq.el, mail/mh-speed.el, mail/mh-utils.el, | ||
| 9 | mail/mh-xemacs-compat.el: Upgraded to MH-E version 7.1. | ||
| 10 | |||
| 1 | 2003-01-08 Kim F. Storm <storm@cua.dk> | 11 | 2003-01-08 Kim F. Storm <storm@cua.dk> |
| 2 | 12 | ||
| 3 | * mail/undigest.el (unforward-rmail-message): Don't use global | 13 | * mail/undigest.el (unforward-rmail-message): Don't use global |
diff --git a/lisp/mail/mh-alias.el b/lisp/mail/mh-alias.el new file mode 100644 index 00000000000..b9f144fae02 --- /dev/null +++ b/lisp/mail/mh-alias.el | |||
| @@ -0,0 +1,590 @@ | |||
| 1 | ;;; mh-alias.el --- MH-E mail alias completion and expansion | ||
| 2 | ;; | ||
| 3 | ;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Peter S. Galbraith <psg@debian.org> | ||
| 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> | ||
| 7 | ;; Keywords: mail | ||
| 8 | ;; See: mh-e.el | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 15 | ;; any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 25 | ;; Boston, MA 02111-1307, USA. | ||
| 26 | |||
| 27 | ;;; Commentary: | ||
| 28 | |||
| 29 | ;; [To be deleted when documented in MH-E manual.] | ||
| 30 | ;; | ||
| 31 | ;; This module provides mail alias completion when entering addresses. | ||
| 32 | ;; | ||
| 33 | ;; Use the TAB key to complete aliases (and optionally local usernames) when | ||
| 34 | ;; initially composing a message in the To: and Cc: minibuffer prompts. You | ||
| 35 | ;; may enter multiple addressees separated with a comma (but do *not* add any | ||
| 36 | ;; space after the comma). | ||
| 37 | ;; | ||
| 38 | ;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to | ||
| 39 | ;; complete aliases. This is useful when you want to add an addressee as an | ||
| 40 | ;; afterthought when creating a message, or when adding an additional | ||
| 41 | ;; addressee to a reply. | ||
| 42 | ;; | ||
| 43 | ;; By default, completion is case-insensitive. This can be changed by | ||
| 44 | ;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is | ||
| 45 | ;; useful, for example, to differentiate between people aliases in lowercase | ||
| 46 | ;; such as: | ||
| 47 | ;; | ||
| 48 | ;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca> | ||
| 49 | ;; | ||
| 50 | ;; and lists in uppercase such as: | ||
| 51 | ;; | ||
| 52 | ;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net> | ||
| 53 | ;; | ||
| 54 | ;; Note that this variable affects minibuffer completion only. If you have an | ||
| 55 | ;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still | ||
| 56 | ;; be expanded in the letter buffer because MH is case-insensitive. | ||
| 57 | ;; | ||
| 58 | ;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in | ||
| 59 | ;; the minibuffer, the expansion for the previous mail alias appears briefly. | ||
| 60 | ;; To inhibit this, customize the variable `mh-alias-flash-on-comma'. | ||
| 61 | ;; | ||
| 62 | ;; The addresses and aliases entered in the minibuffer are added to the | ||
| 63 | ;; message draft. To expand the aliases before they are added to the draft, | ||
| 64 | ;; customize the variable `mh-alias-expand-aliases-flag'. | ||
| 65 | ;; | ||
| 66 | ;; Completion is also performed on usernames extracted from the /etc/passwd | ||
| 67 | ;; file. This can be a handy tool on a machine where you and co-workers | ||
| 68 | ;; exchange messages, but should probably be disabled on a system with | ||
| 69 | ;; thousands of users you don't know. This is done by customizing the | ||
| 70 | ;; variable `mh-alias-local-users'. This variable also takes a string which | ||
| 71 | ;; is executed to generate the password file. For example, you'd use "ypcat | ||
| 72 | ;; passwd" for NIS. | ||
| 73 | ;; | ||
| 74 | ;; Aliases are loaded the first time you send mail and get the "To:" prompt | ||
| 75 | ;; and whenever a source of aliases changes. Sources of system aliases are | ||
| 76 | ;; defined in the customization variable `mh-alias-system-aliases' and | ||
| 77 | ;; include: | ||
| 78 | ;; | ||
| 79 | ;; /etc/nmh/MailAliases | ||
| 80 | ;; /usr/lib/mh/MailAliases | ||
| 81 | ;; /etc/passwd | ||
| 82 | ;; | ||
| 83 | ;; Sources of personal aliases are read from the files listed in your MH | ||
| 84 | ;; profile component Aliasfile. Multiple files are separated by white space | ||
| 85 | ;; and are relative to your mail directory. | ||
| 86 | ;; | ||
| 87 | ;; Alias Insertions | ||
| 88 | ;; ~~~~~~~~~~~~~~~~ | ||
| 89 | ;; There are commands to insert new aliases into your alias file(s) (defined | ||
| 90 | ;; by the `Aliasfile' component in the .mh_profile file or by the variable | ||
| 91 | ;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab | ||
| 92 | ;; an alias from the From line of the current message. | ||
| 93 | |||
| 94 | ;;; Code: | ||
| 95 | |||
| 96 | (require 'mh-e) | ||
| 97 | (load "cmr" t t) ; Non-fatal dependency for | ||
| 98 | ; completing-read-multiple. | ||
| 99 | (eval-when-compile (defvar mail-abbrev-syntax-table)) | ||
| 100 | |||
| 101 | ;;; Autoloads | ||
| 102 | (autoload 'mail-abbrev-complete-alias "mailabbrev") | ||
| 103 | (autoload 'multi-prompt "multi-prompt") | ||
| 104 | |||
| 105 | (defvar mh-alias-alist nil | ||
| 106 | "Alist of MH aliases.") | ||
| 107 | (defvar mh-alias-blind-alist nil | ||
| 108 | "Alist of MH aliases that are blind lists.") | ||
| 109 | (defvar mh-alias-passwd-alist nil | ||
| 110 | "Alist of aliases extracted from passwd file and their expansions.") | ||
| 111 | (defvar mh-alias-tstamp nil | ||
| 112 | "Time aliases were last loaded.") | ||
| 113 | (defvar mh-alias-read-address-map nil) | ||
| 114 | (if mh-alias-read-address-map | ||
| 115 | () | ||
| 116 | (setq mh-alias-read-address-map | ||
| 117 | (copy-keymap minibuffer-local-completion-map)) | ||
| 118 | (if mh-alias-flash-on-comma | ||
| 119 | (define-key mh-alias-read-address-map | ||
| 120 | "," 'mh-alias-minibuffer-confirm-address)) | ||
| 121 | (define-key mh-alias-read-address-map " " 'self-insert-command)) | ||
| 122 | |||
| 123 | |||
| 124 | ;;; Alias Loading | ||
| 125 | |||
| 126 | (defun mh-alias-tstamp (arg) | ||
| 127 | "Check whether alias files have been modified. | ||
| 128 | Return t if any file listed in the MH profile component Aliasfile has been | ||
| 129 | modified since the timestamp. | ||
| 130 | If ARG is non-nil, set timestamp with the current time." | ||
| 131 | (if arg | ||
| 132 | (let ((time (current-time))) | ||
| 133 | (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time)))) | ||
| 134 | (let ((stamp)) | ||
| 135 | (car (memq t (mapcar | ||
| 136 | (function | ||
| 137 | (lambda (file) | ||
| 138 | (when (and file (file-exists-p file)) | ||
| 139 | (setq stamp (nth 5 (file-attributes file))) | ||
| 140 | (or (> (car stamp) (car mh-alias-tstamp)) | ||
| 141 | (and (= (car stamp) (car mh-alias-tstamp)) | ||
| 142 | (> (cadr stamp) (cadr mh-alias-tstamp))))))) | ||
| 143 | (mh-alias-filenames t))))))) | ||
| 144 | |||
| 145 | (defun mh-alias-filenames (arg) | ||
| 146 | "Return list of filenames that contain aliases. | ||
| 147 | The filenames come from the MH profile component Aliasfile and are expanded. | ||
| 148 | If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended." | ||
| 149 | (or mh-progs (mh-find-path)) | ||
| 150 | (save-excursion | ||
| 151 | (let* ((filename (mh-profile-component "Aliasfile")) | ||
| 152 | (filelist (and filename (split-string filename "[ \t]+"))) | ||
| 153 | (userlist | ||
| 154 | (mapcar | ||
| 155 | (function | ||
| 156 | (lambda (file) | ||
| 157 | (if (and mh-user-path file | ||
| 158 | (file-exists-p (expand-file-name file mh-user-path))) | ||
| 159 | (expand-file-name file mh-user-path)))) | ||
| 160 | filelist))) | ||
| 161 | (if arg | ||
| 162 | (if (stringp mh-alias-system-aliases) | ||
| 163 | (append userlist (list mh-alias-system-aliases)) | ||
| 164 | (append userlist mh-alias-system-aliases)) | ||
| 165 | userlist)))) | ||
| 166 | |||
| 167 | (defun mh-alias-local-users () | ||
| 168 | "Return an alist of local users from /etc/passwd." | ||
| 169 | (let (passwd-alist) | ||
| 170 | (save-excursion | ||
| 171 | (set-buffer (get-buffer-create mh-temp-buffer)) | ||
| 172 | (erase-buffer) | ||
| 173 | (cond | ||
| 174 | ((eq mh-alias-local-users t) | ||
| 175 | (if (file-readable-p "/etc/passwd") | ||
| 176 | (insert-file-contents "/etc/passwd"))) | ||
| 177 | ((stringp mh-alias-local-users) | ||
| 178 | (insert mh-alias-local-users "\n") | ||
| 179 | (shell-command-on-region (point-min)(point-max) mh-alias-local-users t) | ||
| 180 | (goto-char (point-min)))) | ||
| 181 | (while (< (point) (point-max)) | ||
| 182 | (cond | ||
| 183 | ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]") | ||
| 184 | (when (> (string-to-int (match-string 2)) 200) | ||
| 185 | (let* ((username (match-string 1)) | ||
| 186 | (gecos-name (match-string 3)) | ||
| 187 | (realname | ||
| 188 | (if (string-match "&" gecos-name) | ||
| 189 | (concat | ||
| 190 | (substring gecos-name 0 (match-beginning 0)) | ||
| 191 | (capitalize username) | ||
| 192 | (substring gecos-name (match-end 0))) | ||
| 193 | gecos-name))) | ||
| 194 | (setq passwd-alist | ||
| 195 | (cons (list username | ||
| 196 | (if (string-equal "" realname) | ||
| 197 | (concat "<" username ">") | ||
| 198 | (concat realname " <" username ">"))) | ||
| 199 | passwd-alist)))))) | ||
| 200 | (forward-line 1))) | ||
| 201 | passwd-alist)) | ||
| 202 | |||
| 203 | ;;;###mh-autoload | ||
| 204 | (defun mh-alias-reload () | ||
| 205 | "Load MH aliases into `mh-alias-alist'." | ||
| 206 | (interactive) | ||
| 207 | (save-excursion | ||
| 208 | (message "Loading MH aliases...") | ||
| 209 | (mh-alias-tstamp t) | ||
| 210 | (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") | ||
| 211 | (setq mh-alias-alist nil) | ||
| 212 | (setq mh-alias-blind-alist nil) | ||
| 213 | (while (< (point) (point-max)) | ||
| 214 | (cond | ||
| 215 | ((looking-at "^[ \t]")) ;Continuation line | ||
| 216 | ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias | ||
| 217 | (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist)) | ||
| 218 | (setq mh-alias-blind-alist | ||
| 219 | (cons (list (match-string 1)) mh-alias-blind-alist)) | ||
| 220 | (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) | ||
| 221 | ((looking-at "\\(.+\\): .*$") ; A new MH alias | ||
| 222 | (when (not (assoc-ignore-case (match-string 1) mh-alias-alist)) | ||
| 223 | (setq mh-alias-alist | ||
| 224 | (cons (list (match-string 1)) mh-alias-alist))))) | ||
| 225 | (forward-line 1))) | ||
| 226 | (when mh-alias-local-users | ||
| 227 | (setq mh-alias-passwd-alist (mh-alias-local-users)) | ||
| 228 | ;; Update aliases with local users, but leave existing aliases alone. | ||
| 229 | (let ((local-users mh-alias-passwd-alist) | ||
| 230 | user) | ||
| 231 | (while local-users | ||
| 232 | (setq user (car local-users)) | ||
| 233 | (if (not (assoc-ignore-case (car user) mh-alias-alist)) | ||
| 234 | (setq mh-alias-alist (append mh-alias-alist (list user)))) | ||
| 235 | (setq local-users (cdr local-users))))) | ||
| 236 | (message "Loading MH aliases...done")) | ||
| 237 | |||
| 238 | (defun mh-alias-reload-maybe () | ||
| 239 | "Load new MH aliases." | ||
| 240 | (if (or (not mh-alias-alist) ; Doesn't exist, so create it. | ||
| 241 | (mh-alias-tstamp nil)) ; Out of date, so recreate it. | ||
| 242 | (mh-alias-reload))) | ||
| 243 | |||
| 244 | |||
| 245 | ;;; Alias Expansion | ||
| 246 | |||
| 247 | (defun mh-alias-ali (alias &optional user) | ||
| 248 | "Return ali expansion for ALIAS. | ||
| 249 | ALIAS must be a string for a single alias. | ||
| 250 | If USER is t, then assume ALIAS is an address and call ali -user. | ||
| 251 | ali returns the string unchanged if not defined. The same is done here." | ||
| 252 | (save-excursion | ||
| 253 | (let ((user-arg (if user "-user" "-nouser"))) | ||
| 254 | (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias)) | ||
| 255 | (goto-char (point-max)) | ||
| 256 | (if (looking-at "^$") (delete-backward-char 1)) | ||
| 257 | (buffer-substring (point-min)(point-max)))) | ||
| 258 | |||
| 259 | (defun mh-alias-expand (alias) | ||
| 260 | "Return expansion for ALIAS. | ||
| 261 | Blind aliases or users from /etc/passwd are not expanded." | ||
| 262 | (cond | ||
| 263 | ((assoc-ignore-case alias mh-alias-blind-alist) | ||
| 264 | alias) ; Don't expand a blind alias | ||
| 265 | ((assoc-ignore-case alias mh-alias-passwd-alist) | ||
| 266 | (cadr (assoc-ignore-case alias mh-alias-passwd-alist))) | ||
| 267 | (t | ||
| 268 | (mh-alias-ali alias)))) | ||
| 269 | |||
| 270 | ;;;###mh-autoload | ||
| 271 | (defun mh-read-address (prompt) | ||
| 272 | "Read an address from the minibuffer with PROMPT." | ||
| 273 | (mh-alias-reload-maybe) | ||
| 274 | (if (not mh-alias-alist) ; If still no aliases, just prompt | ||
| 275 | (read-string prompt) | ||
| 276 | (let* ((minibuffer-local-completion-map mh-alias-read-address-map) | ||
| 277 | (completion-ignore-case mh-alias-completion-ignore-case-flag) | ||
| 278 | (the-answer | ||
| 279 | (or (cond | ||
| 280 | ((fboundp 'completing-read-multiple) | ||
| 281 | (completing-read-multiple prompt mh-alias-alist nil nil)) | ||
| 282 | ((featurep 'multi-prompt) | ||
| 283 | (multi-prompt "," nil prompt mh-alias-alist nil nil)) | ||
| 284 | (t | ||
| 285 | (split-string | ||
| 286 | (completing-read "To: " mh-alias-alist nil nil) | ||
| 287 | ",")))))) | ||
| 288 | (if (not mh-alias-expand-aliases-flag) | ||
| 289 | (mapconcat 'identity the-answer ", ") | ||
| 290 | ;; Loop over all elements, checking if in passwd aliast or blind first | ||
| 291 | (mapconcat 'mh-alias-expand the-answer ",\n "))))) | ||
| 292 | |||
| 293 | ;;;###mh-autoload | ||
| 294 | (defun mh-alias-minibuffer-confirm-address () | ||
| 295 | "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." | ||
| 296 | (interactive) | ||
| 297 | (if (not mh-alias-flash-on-comma) | ||
| 298 | () | ||
| 299 | (save-excursion | ||
| 300 | (let* ((case-fold-search t) | ||
| 301 | (the-name (buffer-substring | ||
| 302 | (progn (skip-chars-backward " \t")(point)) | ||
| 303 | ;; This moves over to previous comma, if any | ||
| 304 | (progn (or (and (not (= 0 (skip-chars-backward "^,"))) | ||
| 305 | ;; the skips over leading whitespace | ||
| 306 | (skip-chars-forward " ")) | ||
| 307 | ;; no comma, then to beginning of word | ||
| 308 | (skip-chars-backward "^ \t")) | ||
| 309 | ;; In Emacs21, the beginning of the prompt | ||
| 310 | ;; line is accessible, which wasn't the case | ||
| 311 | ;; in emacs20. Skip over it. | ||
| 312 | (if (looking-at "^[^ \t]+:") | ||
| 313 | (skip-chars-forward "^ \t")) | ||
| 314 | (skip-chars-forward " ") | ||
| 315 | (point))))) | ||
| 316 | (if (assoc-ignore-case the-name mh-alias-alist) | ||
| 317 | (message "%s -> %s" the-name (mh-alias-expand the-name)) | ||
| 318 | ;; Check if if was a single word likely to be an alias | ||
| 319 | (if (and (equal mh-alias-flash-on-comma 1) | ||
| 320 | (not (string-match " " the-name))) | ||
| 321 | (message "No alias for %s" the-name)))))) | ||
| 322 | (self-insert-command 1)) | ||
| 323 | |||
| 324 | ;;;###mh-autoload | ||
| 325 | (defun mh-alias-letter-expand-alias () | ||
| 326 | "Expand mail alias before point." | ||
| 327 | (mh-alias-reload-maybe) | ||
| 328 | (let ((mail-abbrevs mh-alias-alist)) | ||
| 329 | (mail-abbrev-complete-alias)) | ||
| 330 | (when mh-alias-expand-aliases-flag | ||
| 331 | (let* ((end (point)) | ||
| 332 | (syntax-table (syntax-table)) | ||
| 333 | (beg (unwind-protect | ||
| 334 | (save-excursion | ||
| 335 | (set-syntax-table mail-abbrev-syntax-table) | ||
| 336 | (backward-word 1) | ||
| 337 | (point)) | ||
| 338 | (set-syntax-table syntax-table))) | ||
| 339 | (alias (buffer-substring beg end)) | ||
| 340 | (expansion (mh-alias-expand alias))) | ||
| 341 | (delete-region beg end) | ||
| 342 | (insert expansion)))) | ||
| 343 | |||
| 344 | ;;; Adding addresses to alias file. | ||
| 345 | |||
| 346 | (defun mh-alias-suggest-alias (string) | ||
| 347 | "Suggest an alias for STRING." | ||
| 348 | (cond | ||
| 349 | ((string-match "^\\sw+$" string) | ||
| 350 | ;; One word -> downcase it. | ||
| 351 | (downcase string)) | ||
| 352 | ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string) | ||
| 353 | ;; Two words -> first.last | ||
| 354 | (downcase | ||
| 355 | (format "%s.%s" (match-string 1 string) (match-string 2 string)))) | ||
| 356 | ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$" | ||
| 357 | string) | ||
| 358 | ;; email only -> downcase username | ||
| 359 | (downcase (match-string 1 string))) | ||
| 360 | ((string-match "^\"\\(.*\\)\".*" string) | ||
| 361 | ;; "Some name" <somename@foo.bar> -> recurse -> "Some name" | ||
| 362 | (mh-alias-suggest-alias (match-string 1 string))) | ||
| 363 | ((string-match "^\\(.*\\) +<.*>$" string) | ||
| 364 | ;; Some name <somename@foo.bar> -> recurse -> Some name | ||
| 365 | (mh-alias-suggest-alias (match-string 1 string))) | ||
| 366 | ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string) | ||
| 367 | ;; somename@foo.bar (Some name) -> recurse -> Some name | ||
| 368 | (mh-alias-suggest-alias (match-string 1 string))) | ||
| 369 | ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string) | ||
| 370 | ;; Strip out title | ||
| 371 | (mh-alias-suggest-alias (match-string 2 string))) | ||
| 372 | ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string) | ||
| 373 | ;; Strip out tails with comma | ||
| 374 | (mh-alias-suggest-alias (match-string 1 string))) | ||
| 375 | ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string) | ||
| 376 | ;; Strip out tails | ||
| 377 | (mh-alias-suggest-alias (match-string 1 string))) | ||
| 378 | ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string) | ||
| 379 | ;; Strip out initials | ||
| 380 | (mh-alias-suggest-alias | ||
| 381 | (format "%s %s" (match-string 1 string) (match-string 2 string)))) | ||
| 382 | ((string-match "^\\([^,]+\\), +\\(.*\\)$" string) | ||
| 383 | ;; Reverse order of comma-separated fields | ||
| 384 | (mh-alias-suggest-alias | ||
| 385 | (format "%s %s" (match-string 2 string) (match-string 1 string)))) | ||
| 386 | (t | ||
| 387 | ;; Output string, with spaces replaced by dots. | ||
| 388 | (downcase (replace-regexp-in-string | ||
| 389 | "\\.\\.+" "." | ||
| 390 | (replace-regexp-in-string " +" "." string)))))) | ||
| 391 | |||
| 392 | (defun mh-alias-which-file-has-alias (alias file-list) | ||
| 393 | "Return the name of writable file which defines ALIAS from list FILE-LIST." | ||
| 394 | (save-excursion | ||
| 395 | (set-buffer (get-buffer-create mh-temp-buffer)) | ||
| 396 | (let ((the-list file-list) | ||
| 397 | (found)) | ||
| 398 | (while the-list | ||
| 399 | (erase-buffer) | ||
| 400 | (when (file-writable-p (car file-list)) | ||
| 401 | (insert-file-contents (car file-list)) | ||
| 402 | (if (re-search-forward (concat "^" (regexp-quote alias) ":")) | ||
| 403 | (setq found (car file-list) | ||
| 404 | the-list nil) | ||
| 405 | (setq the-list (cdr the-list))))) | ||
| 406 | found))) | ||
| 407 | |||
| 408 | (defun mh-alias-insert-file (&optional alias) | ||
| 409 | "Return the alias file to write a new entry for ALIAS in. | ||
| 410 | Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component | ||
| 411 | value. | ||
| 412 | If ALIAS is specified and it already exists, try to return the file that | ||
| 413 | contains it." | ||
| 414 | (cond | ||
| 415 | ((and mh-alias-insert-file (listp mh-alias-insert-file)) | ||
| 416 | (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it | ||
| 417 | (car mh-alias-insert-file) | ||
| 418 | (if (or (not alias) | ||
| 419 | (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist | ||
| 420 | (completing-read "Alias file [press Tab]: " | ||
| 421 | (mapcar 'list mh-alias-insert-file) nil t) | ||
| 422 | (or (mh-alias-which-file-has-alias alias mh-alias-insert-file) | ||
| 423 | (completing-read "Alias file [press Tab]: " | ||
| 424 | (mapcar 'list mh-alias-insert-file) nil t))))) | ||
| 425 | ((and mh-alias-insert-file (stringp mh-alias-insert-file)) | ||
| 426 | mh-alias-insert-file) | ||
| 427 | (t | ||
| 428 | ;; writable ones returned from (mh-alias-filenames): | ||
| 429 | (let ((autolist (delq nil (mapcar (lambda (file) | ||
| 430 | (if (and (file-writable-p file) | ||
| 431 | (not (string-equal | ||
| 432 | file "/etc/passwd"))) | ||
| 433 | file)) | ||
| 434 | (mh-alias-filenames t))))) | ||
| 435 | (cond | ||
| 436 | ((not autolist) | ||
| 437 | (error "No writable alias file. | ||
| 438 | Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file")) | ||
| 439 | ((not (elt autolist 1)) ; Only one entry, use it | ||
| 440 | (car autolist)) | ||
| 441 | ((or (not alias) | ||
| 442 | (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist | ||
| 443 | (completing-read "Alias file [press Tab]: " | ||
| 444 | (mapcar 'list autolist) nil t)) | ||
| 445 | (t | ||
| 446 | (or (mh-alias-which-file-has-alias alias autolist) | ||
| 447 | (completing-read "Alias file [press Tab]: " | ||
| 448 | (mapcar 'list autolist) nil t)))))))) | ||
| 449 | |||
| 450 | (defun mh-alias-address-to-alias (address) | ||
| 451 | "Return the ADDRESS alias if defined, or nil." | ||
| 452 | (let* ((aliases (mh-alias-ali address t))) | ||
| 453 | (if (string-equal aliases address) | ||
| 454 | nil ; ali returned same string -> no. | ||
| 455 | ;; For the comma-separated aliases reyurned by ali, check that one of | ||
| 456 | ;; them doesn't expand into a list. e.g. we do have an individual | ||
| 457 | ;; alias for that adress. | ||
| 458 | (car (delq nil (mapcar | ||
| 459 | (function | ||
| 460 | (lambda (alias) | ||
| 461 | (let ((recurse (mh-alias-ali alias nil))) | ||
| 462 | (if (string-match ".*,.*" recurse) | ||
| 463 | nil | ||
| 464 | alias)))) | ||
| 465 | (split-string aliases ", +"))))))) | ||
| 466 | |||
| 467 | ;;;###mh-autoload | ||
| 468 | (defun mh-alias-from-has-no-alias-p () | ||
| 469 | "Return t is From has no current alias set." | ||
| 470 | (mh-alias-reload-maybe) | ||
| 471 | (save-excursion | ||
| 472 | (if (not (mh-folder-line-matches-show-buffer-p)) | ||
| 473 | nil ;No corresponding show buffer | ||
| 474 | (if (eq major-mode 'mh-folder-mode) | ||
| 475 | (set-buffer mh-show-buffer)) | ||
| 476 | (not (mh-alias-address-to-alias (mh-extract-from-header-value)))))) | ||
| 477 | |||
| 478 | (defun mh-alias-add-alias-to-file (alias address &optional file) | ||
| 479 | "Add ALIAS for ADDRESS in alias FILE without alias check or prompts. | ||
| 480 | Prompt for alias file if not provided and there is more than one candidate. | ||
| 481 | If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend | ||
| 482 | after it." | ||
| 483 | (if (not file) | ||
| 484 | (setq file (mh-alias-insert-file alias))) | ||
| 485 | (save-excursion | ||
| 486 | (set-buffer (find-file-noselect file)) | ||
| 487 | (goto-char (point-min)) | ||
| 488 | (let ((alias-search (concat alias ":")) | ||
| 489 | (letter) | ||
| 490 | (here (point)) | ||
| 491 | (case-fold-search t)) | ||
| 492 | (cond | ||
| 493 | ;; Search for exact match (if we had the same alias before) | ||
| 494 | ((re-search-forward | ||
| 495 | (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t) | ||
| 496 | (let ((answer (read-string | ||
| 497 | (format "Exists for %s; [i]nsert, [a]ppend: " | ||
| 498 | (match-string 1)))) | ||
| 499 | (case-fold-search t)) | ||
| 500 | (cond ((string-match "^i" answer)) | ||
| 501 | ((string-match "^a" answer) | ||
| 502 | (forward-line 1)) | ||
| 503 | (t | ||
| 504 | error "Quitting.")))) | ||
| 505 | ;; No, so sort-in at the right place | ||
| 506 | ;; search for "^alias", then "^alia", etc. | ||
| 507 | ((eq mh-alias-insertion-location 'sorted) | ||
| 508 | (setq letter (substring alias-search -1) | ||
| 509 | alias-search (substring alias-search 0 -1)) | ||
| 510 | (while (and (not (equal alias-search "")) | ||
| 511 | (not (re-search-forward | ||
| 512 | (concat "^" (regexp-quote alias-search)) nil t))) | ||
| 513 | (setq letter (substring alias-search -1) | ||
| 514 | alias-search (substring alias-search 0 -1))) | ||
| 515 | ;; Next, move forward to sort alphabetically for following letters | ||
| 516 | (beginning-of-line) | ||
| 517 | (while (re-search-forward | ||
| 518 | (concat "^" (regexp-quote alias-search) "[a-" letter "]") | ||
| 519 | nil t) | ||
| 520 | (forward-line 1))) | ||
| 521 | ((eq mh-alias-insertion-location 'bottom) | ||
| 522 | (goto-char (point-max))) | ||
| 523 | ((eq mh-alias-insertion-location 'top) | ||
| 524 | (goto-char (point-min))))) | ||
| 525 | (beginning-of-line) | ||
| 526 | (insert (format "%s: %s\n" alias address)) | ||
| 527 | (save-buffer))) | ||
| 528 | |||
| 529 | ;;;###mh-autoload | ||
| 530 | (defun mh-alias-add-alias (alias address) | ||
| 531 | "*Add ALIAS for ADDRESS in personal alias file. | ||
| 532 | Prompts for confirmation if the address already has an alias. | ||
| 533 | If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." | ||
| 534 | (interactive "P\nP") | ||
| 535 | (mh-alias-reload-maybe) | ||
| 536 | (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias)) | ||
| 537 | (setq address (read-string "Address: " address)) | ||
| 538 | (let ((address-alias (mh-alias-address-to-alias address)) | ||
| 539 | (alias-address (mh-alias-expand alias))) | ||
| 540 | (if (string-equal alias-address alias) | ||
| 541 | (setq alias-address nil)) | ||
| 542 | (cond | ||
| 543 | ((and (equal alias address-alias) | ||
| 544 | (equal address alias-address)) | ||
| 545 | (message "Already defined as: %s" alias-address)) | ||
| 546 | (address-alias | ||
| 547 | (if (y-or-n-p (format "Address has alias %s; set new one? " | ||
| 548 | address-alias)) | ||
| 549 | (mh-alias-add-alias-to-file alias address))) | ||
| 550 | (t | ||
| 551 | (mh-alias-add-alias-to-file alias address))))) | ||
| 552 | |||
| 553 | ;;;###mh-autoload | ||
| 554 | (defun mh-alias-grab-from-field () | ||
| 555 | "*Add ALIAS for ADDRESS in personal alias file. | ||
| 556 | Prompts for confirmation if the alias is already in use or if the address | ||
| 557 | already has an alias." | ||
| 558 | (interactive) | ||
| 559 | (mh-alias-reload-maybe) | ||
| 560 | (save-excursion | ||
| 561 | (cond | ||
| 562 | ((mh-folder-line-matches-show-buffer-p) | ||
| 563 | (set-buffer mh-show-buffer)) | ||
| 564 | ((and (eq major-mode 'mh-folder-mode) | ||
| 565 | (mh-get-msg-num nil)) | ||
| 566 | (set-buffer (get-buffer-create mh-temp-buffer)) | ||
| 567 | (insert-file-contents (mh-msg-filename (mh-get-msg-num t)))) | ||
| 568 | ((eq major-mode 'mh-folder-mode) | ||
| 569 | (error "Cursor not pointing to a message"))) | ||
| 570 | (let* ((address (mh-extract-from-header-value)) | ||
| 571 | (alias (mh-alias-suggest-alias address))) | ||
| 572 | (mh-alias-add-alias alias address)))) | ||
| 573 | |||
| 574 | ;;;###mh-autoload | ||
| 575 | (defun mh-alias-add-address-under-point () | ||
| 576 | "Insert an alias for email address under point." | ||
| 577 | (interactive) | ||
| 578 | (let ((address (mh-goto-address-find-address-at-point))) | ||
| 579 | (if address | ||
| 580 | (mh-alias-add-alias nil address) | ||
| 581 | (message "No email address found under point.")))) | ||
| 582 | |||
| 583 | (provide 'mh-alias) | ||
| 584 | |||
| 585 | ;;; Local Variables: | ||
| 586 | ;;; indent-tabs-mode: nil | ||
| 587 | ;;; sentence-end-double-space: nil | ||
| 588 | ;;; End: | ||
| 589 | |||
| 590 | ;;; mh-alias.el ends here | ||
diff --git a/lisp/mail/mh-comp.el b/lisp/mail/mh-comp.el index c332f431f4b..c1e28a97011 100644 --- a/lisp/mail/mh-comp.el +++ b/lisp/mail/mh-comp.el | |||
| @@ -30,12 +30,11 @@ | |||
| 30 | 30 | ||
| 31 | ;;; Change Log: | 31 | ;;; Change Log: |
| 32 | 32 | ||
| 33 | ;; $Id: mh-comp.el,v 1.145 2002/11/29 16:49:43 wohler Exp $ | 33 | ;; $Id: mh-comp.el,v 1.164 2003/01/07 21:16:25 satyaki Exp $ |
| 34 | 34 | ||
| 35 | ;;; Code: | 35 | ;;; Code: |
| 36 | 36 | ||
| 37 | (require 'mh-e) | 37 | (require 'mh-e) |
| 38 | (require 'mh-utils) | ||
| 39 | (require 'gnus-util) | 38 | (require 'gnus-util) |
| 40 | (require 'easymenu) | 39 | (require 'easymenu) |
| 41 | (require 'cl) | 40 | (require 'cl) |
| @@ -45,94 +44,11 @@ | |||
| 45 | (defvar font-lock-defaults) | 44 | (defvar font-lock-defaults) |
| 46 | (defvar mark-active) | 45 | (defvar mark-active) |
| 47 | (defvar sendmail-coding-system) | 46 | (defvar sendmail-coding-system) |
| 48 | (defvar tool-bar-mode) | 47 | (defvar mh-identity-list) |
| 49 | 48 | (defvar mh-identity-default) | |
| 50 | ;;; autoloads from mh-mime | 49 | (defvar mh-identity-menu) |
| 51 | (autoload 'mh-press-button "mh-mime") | ||
| 52 | |||
| 53 | ;;; autoloads for mh-seq | ||
| 54 | (autoload 'mh-notate-seq "mh-seq") | ||
| 55 | |||
| 56 | (autoload 'mh-compose-insertion "mh-mime" | ||
| 57 | "Add a MIME directive to insert a file, using mhn or gnus. | ||
| 58 | If the variable mh-compose-insertion is set to 'mhn, then that will be used. | ||
| 59 | If it is set to 'gnus, then that will be used instead.") | ||
| 60 | |||
| 61 | (autoload 'mh-compose-forward "mh-mime" | ||
| 62 | "Add a MIME directive to forward a message, using mhn or gnus. | ||
| 63 | If the variable mh-compose-insertion is set to 'mhn, then that will be used. | ||
| 64 | If it is set to 'gnus, then that will be used instead.") | ||
| 65 | |||
| 66 | (autoload 'mh-mhn-compose-insertion "mh-mime" | ||
| 67 | "Add a directive to insert a MIME message part from a file. | ||
| 68 | This is the typical way to insert non-text parts in a message. | ||
| 69 | See also \\[mh-edit-mhn]." t) | ||
| 70 | |||
| 71 | (autoload 'mh-mhn-compose-anon-ftp "mh-mime" | ||
| 72 | "Add a directive for a MIME anonymous ftp external body part. | ||
| 73 | This directive tells MH to include a reference to a | ||
| 74 | message/external-body part retrievable by anonymous FTP. | ||
| 75 | See also \\[mh-edit-mhn]." t) | ||
| 76 | |||
| 77 | (autoload 'mh-mhn-compose-external-compressed-tar "mh-mime" | ||
| 78 | "Add a directive to include a MIME reference to a compressed tar file. | ||
| 79 | The file should be available via anonymous ftp. This directive | ||
| 80 | tells MH to include a reference to a message/external-body part. | ||
| 81 | See also \\[mh-edit-mhn]." t) | ||
| 82 | |||
| 83 | (autoload 'mh-mhn-compose-forw "mh-mime" | ||
| 84 | "Add a forw directive to this message, to forward a message with MIME. | ||
| 85 | This directive tells MH to include another message in this one. | ||
| 86 | See also \\[mh-edit-mhn]." t) | ||
| 87 | |||
| 88 | (autoload 'mh-edit-mhn "mh-mime" | ||
| 89 | "Format the current draft for MIME, expanding any mhn directives. | ||
| 90 | Process the current draft with the mhn program, which, | ||
| 91 | using directives already inserted in the draft, fills in | ||
| 92 | all the MIME components and header fields. | ||
| 93 | This step should be done last just before sending the message. | ||
| 94 | The mhn program is part of MH version 6.8 or later. | ||
| 95 | The \\[mh-revert-mhn-edit] command undoes this command. | ||
| 96 | For assistance with creating mhn directives to insert | ||
| 97 | various types of components in a message, see | ||
| 98 | \\[mh-mhn-compose-insertion] (generic insertion from a file), | ||
| 99 | \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), | ||
| 100 | \\[mh-mhn-compose-external-compressed-tar] \ | ||
| 101 | \(reference to compressed tar file via anonymous ftp), and | ||
| 102 | \\[mh-mhn-compose-forw] (forward message)." t) | ||
| 103 | |||
| 104 | (autoload 'mh-revert-mhn-edit "mh-mime" | ||
| 105 | "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. | ||
| 106 | Optional non-nil argument means don't ask for confirmation." t) | ||
| 107 | |||
| 108 | (autoload 'mh-mml-to-mime "mh-mime" | ||
| 109 | "Compose MIME message from mml directives.") | ||
| 110 | |||
| 111 | (autoload 'mh-mml-forward-message "mh-mime" | ||
| 112 | "Forward a message as attachment. | ||
| 113 | The function will prompt the user for a description, a folder and message | ||
| 114 | number.") | ||
| 115 | |||
| 116 | (autoload 'mh-mml-attach-file "mh-mime" | ||
| 117 | "Attach a file to the outgoing MIME message. | ||
| 118 | The file is not inserted or encoded until you send the message with | ||
| 119 | `\\[message-send-and-exit]' or `\\[message-send]'. | ||
| 120 | |||
| 121 | Message dispostion is \"inline\" is INLINE is non-nil, else the default is | ||
| 122 | \"attachment\". | ||
| 123 | FILE is the name of the file to attach. TYPE is its content-type, a | ||
| 124 | string of the form \"type/subtype\". DESCRIPTION is a one-line | ||
| 125 | description of the attachment.") | ||
| 126 | |||
| 127 | (autoload 'mh-mml-secure-message-sign-pgpmime "mh-mime" | ||
| 128 | "Add MML tag to encrypt/sign the entire message.") | ||
| 129 | |||
| 130 | (autoload 'mh-mml-secure-message-encrypt-pgpmime "mh-mime" | ||
| 131 | "Add MML tag to encrypt and sign the entire message. | ||
| 132 | If called with a prefix argument, only encrypt (do NOT sign).") | ||
| 133 | |||
| 134 | ;;; Other Autoloads. | ||
| 135 | 50 | ||
| 51 | ;;; Autoloads | ||
| 136 | (autoload 'Info-goto-node "info") | 52 | (autoload 'Info-goto-node "info") |
| 137 | (autoload 'mail-mode-fill-paragraph "sendmail") | 53 | (autoload 'mail-mode-fill-paragraph "sendmail") |
| 138 | (autoload 'mm-handle-displayed-p "mm-decode") | 54 | (autoload 'mm-handle-displayed-p "mm-decode") |
| @@ -163,11 +79,6 @@ before, and `sc-post-hook' is run after the guts of this function.") | |||
| 163 | 79 | ||
| 164 | ;;; Site customization (see also mh-utils.el): | 80 | ;;; Site customization (see also mh-utils.el): |
| 165 | 81 | ||
| 166 | (defgroup mh-compose nil | ||
| 167 | "MH-E functions for composing messages." | ||
| 168 | :prefix "mh-" | ||
| 169 | :group 'mh) | ||
| 170 | |||
| 171 | (defvar mh-send-prog "send" | 82 | (defvar mh-send-prog "send" |
| 172 | "Name of the MH send program. | 83 | "Name of the MH send program. |
| 173 | Some sites need to change this because of a name conflict.") | 84 | Some sites need to change this because of a name conflict.") |
| @@ -217,148 +128,6 @@ this nil and set up supercite by setting the variable | |||
| 217 | `mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, | 128 | `mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, |
| 218 | to 'autosupercite.") | 129 | to 'autosupercite.") |
| 219 | 130 | ||
| 220 | ;;; Personal preferences: | ||
| 221 | |||
| 222 | (defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn) | ||
| 223 | "Use either 'gnus or 'mhn to insert MIME message directives in messages." | ||
| 224 | :type '(choice (const :tag "Use gnus" gnus) | ||
| 225 | (const :tag "Use mhn" mhn)) | ||
| 226 | :group 'mh-compose) | ||
| 227 | |||
| 228 | (defcustom mh-x-face-file "~/.face" | ||
| 229 | "*File name containing the encoded X-Face string to insert in outgoing mail. | ||
| 230 | If nil, or the file does not exist, nothing is added to message headers." | ||
| 231 | :type 'file | ||
| 232 | :group 'mh-compose) | ||
| 233 | |||
| 234 | (defcustom mh-insert-x-mailer-flag t | ||
| 235 | "*Non-nil means append an X-Mailer field to the header." | ||
| 236 | :type 'boolean | ||
| 237 | :group 'mh-compose) | ||
| 238 | |||
| 239 | (defvar mh-x-mailer-string nil | ||
| 240 | "*String containing the contents of the X-Mailer header field. | ||
| 241 | If nil, this variable is initialized to show the version of MH-E, Emacs, and | ||
| 242 | MH the first time a message is composed.") | ||
| 243 | |||
| 244 | (defcustom mh-insert-mail-followup-to-flag t | ||
| 245 | "Non-nil means maybe append a Mail-Followup-To field to the header. | ||
| 246 | The insertion is done if the To: or Cc: fields matches an entry in | ||
| 247 | `mh-insert-mail-followup-to-list'." | ||
| 248 | :type 'boolean | ||
| 249 | :group 'mh-compose) | ||
| 250 | |||
| 251 | (defcustom mh-insert-mail-followup-to-list nil | ||
| 252 | "Alist of addresses for which a Mail-Followup-To field is inserted. | ||
| 253 | Each element has the form (REGEXP ADDRESS). | ||
| 254 | When the REGEXP appears in the To or cc fields of a message, the corresponding | ||
| 255 | ADDRESS is inserted in a Mail-Followup-To field. | ||
| 256 | |||
| 257 | Here's a customization example: | ||
| 258 | |||
| 259 | regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net | ||
| 260 | address: mh-e-users@lists.sourceforge.net | ||
| 261 | |||
| 262 | This corresponds to: | ||
| 263 | |||
| 264 | (setq mh-insert-mail-followup-to-list | ||
| 265 | '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\" | ||
| 266 | \"mh-e-users@lists.sourceforge.net\"))) | ||
| 267 | |||
| 268 | While it might be tempting to add a descriptive name to the mailing list | ||
| 269 | address, consider that this field will appear in other people's outgoing | ||
| 270 | mail in their To: field. It might be best to keep it simple." | ||
| 271 | :type '(repeat (list (string :tag "regexp") (string :tag "address"))) | ||
| 272 | :group 'mh-compose) | ||
| 273 | |||
| 274 | (defcustom mh-delete-yanked-msg-window-flag nil | ||
| 275 | "*Non-nil means delete any window displaying the message. | ||
| 276 | Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. | ||
| 277 | If non-nil, yanking the current message into a draft letter deletes any | ||
| 278 | windows displaying the message." | ||
| 279 | :type 'boolean | ||
| 280 | :group 'mh-compose) | ||
| 281 | |||
| 282 | (defcustom mh-yank-from-start-of-msg 'attribution | ||
| 283 | "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. | ||
| 284 | If t, include the entire message, with full headers. This is historically | ||
| 285 | here for use with supercite, but is now deprecated in favor of the setting | ||
| 286 | `supercite' below. | ||
| 287 | |||
| 288 | If the symbol `body', then yank the message minus the header. | ||
| 289 | |||
| 290 | If the symbol `supercite', include the entire message, with full headers. | ||
| 291 | This also causes the invocation of `sc-cite-original' without the setting | ||
| 292 | of `mail-citation-hook', now deprecated practice. | ||
| 293 | |||
| 294 | If the symbol `autosupercite', do as for `supercite' automatically when | ||
| 295 | show buffer matches the message being replied-to. When this option is used, | ||
| 296 | the -noformat switch is passed to the repl program to override a -filter or | ||
| 297 | -format switch. | ||
| 298 | |||
| 299 | If the symbol `attribution', then yank the message minus the header and add | ||
| 300 | a simple attribution line at the top. | ||
| 301 | |||
| 302 | If the symbol `autoattrib', do as for `attribution' automatically when show | ||
| 303 | buffer matches the message being replied-to. You can make sure this is | ||
| 304 | always the case by setting `mh-reply-show-message-flag' to t (which is the | ||
| 305 | default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such | ||
| 306 | that the show window is never displayed. When the `autoattrib' option is | ||
| 307 | used, the -noformat switch is passed to the repl program to override a | ||
| 308 | -filter or -format switch. | ||
| 309 | |||
| 310 | If nil, yank only the portion of the message following the point. | ||
| 311 | |||
| 312 | If the show buffer has a region, this variable is ignored unless its value is | ||
| 313 | one of `attribution' or `autoattrib' in which case the attribution is added | ||
| 314 | to the yanked region." | ||
| 315 | :type '(choice (const :tag "Below point" nil) | ||
| 316 | (const :tag "Without header" body) | ||
| 317 | (const :tag "Invoke supercite" supercite) | ||
| 318 | (const :tag "Invoke supercite, automatically" autosupercite) | ||
| 319 | (const :tag "Without header, with attribution" attribution) | ||
| 320 | (const :tag "Without header, with attribution, automatically" | ||
| 321 | autoattrib) | ||
| 322 | (const :tag "Entire message with headers" t)) | ||
| 323 | :group 'mh-compose) | ||
| 324 | |||
| 325 | (defcustom mh-extract-from-attribution-verb "wrote:" | ||
| 326 | "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]." | ||
| 327 | :type '(choice (const "wrote:") | ||
| 328 | (const "a écrit :") | ||
| 329 | (string :tag "Custom string")) | ||
| 330 | :group 'mh-compose) | ||
| 331 | |||
| 332 | (defcustom mh-ins-buf-prefix "> " | ||
| 333 | "*String to put before each non-blank line of a yanked or inserted message. | ||
| 334 | \\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter | ||
| 335 | by \\[mh-insert-letter] or \\[mh-yank-cur-msg]." | ||
| 336 | :type 'string | ||
| 337 | :group 'mh-compose) | ||
| 338 | |||
| 339 | (defcustom mh-reply-default-reply-to nil | ||
| 340 | "*Sets the person or persons to whom a reply will be sent. | ||
| 341 | If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this | ||
| 342 | value and it should be one of \"from\", \"to\", \"cc\", or \"all\". | ||
| 343 | The values \"cc\" and \"all\" do the same thing." | ||
| 344 | :type '(choice (const :tag "Prompt" nil) | ||
| 345 | (const "from") (const "to") | ||
| 346 | (const "cc") (const "all")) | ||
| 347 | :group 'mh-compose) | ||
| 348 | |||
| 349 | (defcustom mh-signature-file-name "~/.signature" | ||
| 350 | "*Name of file containing the user's signature. | ||
| 351 | Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]." | ||
| 352 | :type 'file | ||
| 353 | :group 'mh-compose) | ||
| 354 | |||
| 355 | (defcustom mh-forward-subject-format "%s: %s" | ||
| 356 | "*Format to generate the Subject: line contents for a forwarded message. | ||
| 357 | The two string arguments to the format are the sender of the original | ||
| 358 | message and the original subject line." | ||
| 359 | :type 'string | ||
| 360 | :group 'mh-compose) | ||
| 361 | |||
| 362 | (defvar mh-comp-formfile "components" | 131 | (defvar mh-comp-formfile "components" |
| 363 | "Name of file to be used as a skeleton for composing messages. | 132 | "Name of file to be used as a skeleton for composing messages. |
| 364 | Default is \"components\". If not an absolute file name, the file | 133 | Default is \"components\". If not an absolute file name, the file |
| @@ -378,65 +147,19 @@ message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\". | |||
| 378 | If not an absolute file name, the file is searched for first in the user's MH | 147 | If not an absolute file name, the file is searched for first in the user's MH |
| 379 | directory, then in the system MH lib directory.") | 148 | directory, then in the system MH lib directory.") |
| 380 | 149 | ||
| 381 | (defcustom mh-reply-show-message-flag t | ||
| 382 | "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply]. | ||
| 383 | |||
| 384 | The setting of this variable determines whether the MH `show-buffer' is | ||
| 385 | displayed with the current message when using `mh-reply' without a prefix | ||
| 386 | argument. Set it to nil if you already include the message automatically | ||
| 387 | in your draft using | ||
| 388 | repl: -filter repl.filter | ||
| 389 | in your ~/.mh_profile file." | ||
| 390 | :type 'boolean | ||
| 391 | :group 'mh-compose) | ||
| 392 | |||
| 393 | (defcustom mh-letter-fill-column 72 | ||
| 394 | "*Fill column to use in `mh-letter-mode'. | ||
| 395 | This is usually less than in other text modes because email messages get | ||
| 396 | quoted by some prefix (sometimes many times) when they are replied to, | ||
| 397 | and it's best to avoid quoted lines that span more than 80 columns." | ||
| 398 | :type 'integer | ||
| 399 | :group 'mh-compose) | ||
| 400 | |||
| 401 | ;;; Hooks: | ||
| 402 | |||
| 403 | (defcustom mh-letter-mode-hook nil | ||
| 404 | "Invoked in `mh-letter-mode' on a new letter." | ||
| 405 | :type 'hook | ||
| 406 | :group 'mh-compose) | ||
| 407 | |||
| 408 | (defcustom mh-compose-letter-function nil | ||
| 409 | "Invoked when setting up a letter draft. | ||
| 410 | It is passed three arguments: TO recipients, SUBJECT, and CC recipients." | ||
| 411 | :type '(choice (const nil) function) | ||
| 412 | :group 'mh-compose) | ||
| 413 | |||
| 414 | (defcustom mh-before-send-letter-hook nil | ||
| 415 | "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command." | ||
| 416 | :type 'hook | ||
| 417 | :group 'mh-compose) | ||
| 418 | |||
| 419 | (defcustom mh-letter-insert-signature-hook nil | ||
| 420 | "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command. | ||
| 421 | Can be used to determine which signature file to use based on message content. | ||
| 422 | On return, if `mh-signature-file-name' is non-nil that file will be inserted at | ||
| 423 | the current point in the buffer." | ||
| 424 | :type 'hook | ||
| 425 | :group 'mh-compose) | ||
| 426 | |||
| 427 | (defvar mh-rejected-letter-start | 150 | (defvar mh-rejected-letter-start |
| 428 | (format "^%s$" | 151 | (format "^%s$" |
| 429 | (regexp-opt | 152 | (regexp-opt |
| 430 | '("Content-Type: message/rfc822" ;MIME MDN | 153 | '("Content-Type: message/rfc822" ;MIME MDN |
| 431 | " ----- Unsent message follows -----" ;from sendmail V5 | 154 | " ----- Unsent message follows -----" ;from sendmail V5 |
| 432 | " --------Unsent Message below:" ; from sendmail at BU | 155 | " --------Unsent Message below:" ; from sendmail at BU |
| 433 | " ----- Original message follows -----" ;from sendmail V8 | 156 | " ----- Original message follows -----" ;from sendmail V8 |
| 434 | "------- Unsent Draft" ;from MH itself | 157 | "------- Unsent Draft" ;from MH itself |
| 435 | "---------- Original Message ----------" ;from zmailer | 158 | "---------- Original Message ----------" ;from zmailer |
| 436 | " --- The unsent message follows ---" ;from AIX mail system | 159 | " --- The unsent message follows ---" ;from AIX mail system |
| 437 | " Your message follows:" ;from MMDF-II | 160 | " Your message follows:" ;from MMDF-II |
| 438 | "Content-Description: Returned Content" ;1993 KJ sendmail | 161 | "Content-Description: Returned Content" ;1993 KJ sendmail |
| 439 | )))) | 162 | )))) |
| 440 | 163 | ||
| 441 | (defvar mh-new-draft-cleaned-headers | 164 | (defvar mh-new-draft-cleaned-headers |
| 442 | "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" | 165 | "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" |
| @@ -444,8 +167,8 @@ the current point in the buffer." | |||
| 444 | Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.") | 167 | Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.") |
| 445 | 168 | ||
| 446 | (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") | 169 | (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") |
| 447 | ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") | 170 | ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") |
| 448 | ("d" . "Dcc:")) | 171 | ("d" . "Dcc:")) |
| 449 | "Alist of (final-character . field-name) choices for `mh-to-field'.") | 172 | "Alist of (final-character . field-name) choices for `mh-to-field'.") |
| 450 | 173 | ||
| 451 | (defvar mh-letter-mode-map (copy-keymap text-mode-map) | 174 | (defvar mh-letter-mode-map (copy-keymap text-mode-map) |
| @@ -456,9 +179,9 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte | |||
| 456 | 179 | ||
| 457 | (if mh-letter-mode-syntax-table | 180 | (if mh-letter-mode-syntax-table |
| 458 | () | 181 | () |
| 459 | (setq mh-letter-mode-syntax-table | 182 | (setq mh-letter-mode-syntax-table |
| 460 | (make-syntax-table text-mode-syntax-table)) | 183 | (make-syntax-table text-mode-syntax-table)) |
| 461 | (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) | 184 | (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) |
| 462 | 185 | ||
| 463 | (defvar mh-sent-from-folder nil | 186 | (defvar mh-sent-from-folder nil |
| 464 | "Folder of msg assoc with this letter.") | 187 | "Folder of msg assoc with this letter.") |
| @@ -486,7 +209,7 @@ See documentation of `\\[mh-send]' for more details on composing mail." | |||
| 486 | (mh-find-path) | 209 | (mh-find-path) |
| 487 | (call-interactively 'mh-send)) | 210 | (call-interactively 'mh-send)) |
| 488 | 211 | ||
| 489 | (defvar mh-error-if-no-draft nil) ;raise error over using old draft | 212 | (defvar mh-error-if-no-draft nil) ;raise error over using old draft |
| 490 | 213 | ||
| 491 | ;;;###autoload | 214 | ;;;###autoload |
| 492 | (defun mh-smail-batch (&optional to subject other-headers &rest ignored) | 215 | (defun mh-smail-batch (&optional to subject other-headers &rest ignored) |
| @@ -505,8 +228,8 @@ OTHER-HEADERS. Additional arguments are IGNORED." | |||
| 505 | ;; XEmacs needs this: | 228 | ;; XEmacs needs this: |
| 506 | ;;;###autoload | 229 | ;;;###autoload |
| 507 | (defun mh-user-agent-compose (&optional to subject other-headers continue | 230 | (defun mh-user-agent-compose (&optional to subject other-headers continue |
| 508 | switch-function yank-action | 231 | switch-function yank-action |
| 509 | send-actions) | 232 | send-actions) |
| 510 | "Set up mail composition draft with the MH mail system. | 233 | "Set up mail composition draft with the MH mail system. |
| 511 | This is `mail-user-agent' entry point to MH-E. | 234 | This is `mail-user-agent' entry point to MH-E. |
| 512 | 235 | ||
| @@ -523,9 +246,10 @@ CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored." | |||
| 523 | (mh-send to "" subject) | 246 | (mh-send to "" subject) |
| 524 | (while other-headers | 247 | (while other-headers |
| 525 | (mh-insert-fields (concat (car (car other-headers)) ":") | 248 | (mh-insert-fields (concat (car (car other-headers)) ":") |
| 526 | (cdr (car other-headers))) | 249 | (cdr (car other-headers))) |
| 527 | (setq other-headers (cdr other-headers))))) | 250 | (setq other-headers (cdr other-headers))))) |
| 528 | 251 | ||
| 252 | ;;;###mh-autoload | ||
| 529 | (defun mh-edit-again (msg) | 253 | (defun mh-edit-again (msg) |
| 530 | "Clean up a draft or a message MSG previously sent and make it resendable. | 254 | "Clean up a draft or a message MSG previously sent and make it resendable. |
| 531 | Default is the current message. | 255 | Default is the current message. |
| @@ -533,11 +257,11 @@ The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. | |||
| 533 | See also documentation for `\\[mh-send]' function." | 257 | See also documentation for `\\[mh-send]' function." |
| 534 | (interactive (list (mh-get-msg-num t))) | 258 | (interactive (list (mh-get-msg-num t))) |
| 535 | (let* ((from-folder mh-current-folder) | 259 | (let* ((from-folder mh-current-folder) |
| 536 | (config (current-window-configuration)) | 260 | (config (current-window-configuration)) |
| 537 | (draft | 261 | (draft |
| 538 | (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) | 262 | (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) |
| 539 | (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) | 263 | (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) |
| 540 | (rename-buffer (format "draft-%d" msg)) | 264 | (rename-buffer (format "draft-%d" msg)) |
| 541 | ;; Make buffer writable... | 265 | ;; Make buffer writable... |
| 542 | (setq buffer-read-only nil) | 266 | (setq buffer-read-only nil) |
| 543 | ;; If buffer was being used to display the message reinsert | 267 | ;; If buffer was being used to display the message reinsert |
| @@ -545,17 +269,18 @@ See also documentation for `\\[mh-send]' function." | |||
| 545 | (when (eq major-mode 'mh-show-mode) | 269 | (when (eq major-mode 'mh-show-mode) |
| 546 | (erase-buffer) | 270 | (erase-buffer) |
| 547 | (insert-file-contents buffer-file-name)) | 271 | (insert-file-contents buffer-file-name)) |
| 548 | (buffer-name)) | 272 | (buffer-name)) |
| 549 | (t | 273 | (t |
| 550 | (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) | 274 | (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) |
| 551 | (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) | 275 | (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) |
| 552 | (mh-insert-header-separator) | 276 | (mh-insert-header-separator) |
| 553 | (goto-char (point-min)) | 277 | (goto-char (point-min)) |
| 554 | (save-buffer) | 278 | (save-buffer) |
| 555 | (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil | 279 | (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil |
| 556 | config) | 280 | config) |
| 557 | (mh-letter-mode-message))) | 281 | (mh-letter-mode-message))) |
| 558 | 282 | ||
| 283 | ;;;###mh-autoload | ||
| 559 | (defun mh-extract-rejected-mail (msg) | 284 | (defun mh-extract-rejected-mail (msg) |
| 560 | "Extract message MSG returned by the mail system and make it resendable. | 285 | "Extract message MSG returned by the mail system and make it resendable. |
| 561 | Default is the current message. The variable `mh-new-draft-cleaned-headers' | 286 | Default is the current message. The variable `mh-new-draft-cleaned-headers' |
| @@ -563,27 +288,28 @@ gives the headers to clean out of the original message. | |||
| 563 | See also documentation for `\\[mh-send]' function." | 288 | See also documentation for `\\[mh-send]' function." |
| 564 | (interactive (list (mh-get-msg-num t))) | 289 | (interactive (list (mh-get-msg-num t))) |
| 565 | (let ((from-folder mh-current-folder) | 290 | (let ((from-folder mh-current-folder) |
| 566 | (config (current-window-configuration)) | 291 | (config (current-window-configuration)) |
| 567 | (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil))) | 292 | (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil))) |
| 568 | (goto-char (point-min)) | 293 | (goto-char (point-min)) |
| 569 | (cond ((re-search-forward mh-rejected-letter-start nil t) | 294 | (cond ((re-search-forward mh-rejected-letter-start nil t) |
| 570 | (skip-chars-forward " \t\n") | 295 | (skip-chars-forward " \t\n") |
| 571 | (delete-region (point-min) (point)) | 296 | (delete-region (point-min) (point)) |
| 572 | (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) | 297 | (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) |
| 573 | (t | 298 | (t |
| 574 | (message "Does not appear to be a rejected letter."))) | 299 | (message "Does not appear to be a rejected letter."))) |
| 575 | (mh-insert-header-separator) | 300 | (mh-insert-header-separator) |
| 576 | (goto-char (point-min)) | 301 | (goto-char (point-min)) |
| 577 | (save-buffer) | 302 | (save-buffer) |
| 578 | (mh-compose-and-send-mail draft "" from-folder msg | 303 | (mh-compose-and-send-mail draft "" from-folder msg |
| 579 | (mh-get-header-field "To:") | 304 | (mh-get-header-field "To:") |
| 580 | (mh-get-header-field "From:") | 305 | (mh-get-header-field "From:") |
| 581 | (mh-get-header-field "Cc:") | 306 | (mh-get-header-field "Cc:") |
| 582 | nil nil config) | 307 | nil nil config) |
| 583 | (mh-letter-mode-message))) | 308 | (mh-letter-mode-message))) |
| 584 | 309 | ||
| 310 | ;;;###mh-autoload | ||
| 585 | (defun mh-forward (to cc &optional msg-or-seq) | 311 | (defun mh-forward (to cc &optional msg-or-seq) |
| 586 | "Forward one or more messages to the recipients TO and CC. | 312 | "Forward one or more messages to the recipients TO and CC. |
| 587 | 313 | ||
| 588 | Use the optional MSG-OR-SEQ to specify a message or sequence to forward. | 314 | Use the optional MSG-OR-SEQ to specify a message or sequence to forward. |
| 589 | 315 | ||
| @@ -592,90 +318,93 @@ prompt for the message sequence. If variable `transient-mark-mode' is non-nil | |||
| 592 | and the mark is active, then the selected region is forwarded. | 318 | and the mark is active, then the selected region is forwarded. |
| 593 | See also documentation for `\\[mh-send]' function." | 319 | See also documentation for `\\[mh-send]' function." |
| 594 | (interactive (list (mh-read-address "To: ") | 320 | (interactive (list (mh-read-address "To: ") |
| 595 | (mh-read-address "Cc: ") | 321 | (mh-read-address "Cc: ") |
| 596 | (cond | 322 | (cond |
| 597 | ((mh-mark-active-p t) | 323 | ((mh-mark-active-p t) |
| 598 | (mh-region-to-sequence (region-beginning) (region-end)) | 324 | (mh-region-to-msg-list (region-beginning) (region-end))) |
| 599 | 'region) | ||
| 600 | (current-prefix-arg | 325 | (current-prefix-arg |
| 601 | (mh-read-seq-default "Forward" t)) | 326 | (mh-read-seq-default "Forward" t)) |
| 602 | (t | 327 | (t |
| 603 | (mh-get-msg-num t))))) | 328 | (mh-get-msg-num t))))) |
| 604 | (let* ((folder mh-current-folder) | 329 | (let* ((folder mh-current-folder) |
| 605 | (msgs (if (numberp msg-or-seq) | 330 | (msgs (cond ((numberp msg-or-seq) (list msg-or-seq)) |
| 606 | (list msg-or-seq) | 331 | ((listp msg-or-seq) msg-or-seq) |
| 607 | (mh-seq-to-msgs msg-or-seq))) | 332 | (t (mh-seq-to-msgs msg-or-seq)))) |
| 608 | (config (current-window-configuration)) | 333 | (config (current-window-configuration)) |
| 609 | (fwd-msg-file (mh-msg-filename (car msgs) folder)) | 334 | (fwd-msg-file (mh-msg-filename (car msgs) folder)) |
| 610 | ;; forw always leaves file in "draft" since it doesn't have -draft | 335 | ;; forw always leaves file in "draft" since it doesn't have -draft |
| 611 | (draft-name (expand-file-name "draft" mh-user-path)) | 336 | (draft-name (expand-file-name "draft" mh-user-path)) |
| 612 | (draft (cond ((or (not (file-exists-p draft-name)) | 337 | (draft (cond ((or (not (file-exists-p draft-name)) |
| 613 | (y-or-n-p "The file 'draft' exists. Discard it? ")) | 338 | (y-or-n-p "The file 'draft' exists. Discard it? ")) |
| 614 | (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") | 339 | (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") |
| 615 | mh-current-folder msgs) | 340 | mh-current-folder msgs) |
| 616 | (prog1 | 341 | (prog1 |
| 617 | (mh-read-draft "" draft-name t) | 342 | (mh-read-draft "" draft-name t) |
| 618 | (mh-insert-fields "To:" to "Cc:" cc) | 343 | (mh-insert-fields "To:" to "Cc:" cc) |
| 619 | (save-buffer))) | 344 | (save-buffer))) |
| 620 | (t | 345 | (t |
| 621 | (mh-read-draft "" draft-name nil))))) | 346 | (mh-read-draft "" draft-name nil))))) |
| 622 | (let (orig-from | 347 | (let (orig-from |
| 623 | orig-subject) | 348 | orig-subject) |
| 624 | (save-excursion | 349 | (save-excursion |
| 625 | (set-buffer (get-buffer-create mh-temp-buffer)) | 350 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 626 | (erase-buffer) | 351 | (erase-buffer) |
| 627 | (insert-file-contents fwd-msg-file) | 352 | (insert-file-contents fwd-msg-file) |
| 628 | (setq orig-from (mh-get-header-field "From:")) | 353 | (setq orig-from (mh-get-header-field "From:")) |
| 629 | (setq orig-subject (mh-get-header-field "Subject:"))) | 354 | (setq orig-subject (mh-get-header-field "Subject:"))) |
| 630 | (let ((forw-subject | 355 | (let ((forw-subject |
| 631 | (mh-forwarded-letter-subject orig-from orig-subject)) | 356 | (mh-forwarded-letter-subject orig-from orig-subject)) |
| 632 | (mail-header-separator mh-mail-header-separator) | 357 | (compose)) |
| 633 | (compose)) | 358 | (mh-insert-fields "Subject:" forw-subject) |
| 634 | (mh-insert-fields "Subject:" forw-subject) | 359 | (goto-char (point-min)) |
| 635 | (goto-char (point-min)) | 360 | ;; If using MML, translate mhn |
| 636 | ;; If using MML, translate mhn | 361 | (if (equal mh-compose-insertion 'gnus) |
| 637 | (if (equal mh-compose-insertion 'gnus) | 362 | (save-excursion |
| 638 | (save-excursion | 363 | (setq compose t) |
| 639 | (setq compose t) | 364 | (re-search-forward (format "^\\(%s\\)?$" |
| 640 | (re-search-forward (format "^\\(%s\\)?$" mail-header-separator)) | 365 | mh-mail-header-separator)) |
| 641 | (while | 366 | (while |
| 642 | (re-search-forward "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" (point-max) t) | 367 | (re-search-forward |
| 643 | (let ((description (if (equal (match-string 1) "forwarded messages") | 368 | "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" |
| 644 | "forwarded message %d" | 369 | (point-max) t) |
| 645 | (match-string 1))) | 370 | (let ((description (if (equal (match-string 1) |
| 646 | (msgs (split-string (match-string 3))) | 371 | "forwarded messages") |
| 647 | (i 0)) | 372 | "forwarded message %d" |
| 648 | (beginning-of-line) | 373 | (match-string 1))) |
| 649 | (delete-region (point)(progn (forward-line 1)(point))) | 374 | (msgs (split-string (match-string 3))) |
| 650 | (dolist (msg msgs) | 375 | (i 0)) |
| 651 | (setq i (1+ i)) | 376 | (beginning-of-line) |
| 652 | (mh-mml-forward-message (format description i) folder msg)))))) | 377 | (delete-region (point) (progn (forward-line 1) (point))) |
| 653 | ;; Postition just before forwarded message | 378 | (dolist (msg msgs) |
| 654 | (if (re-search-forward "^------- Forwarded Message" nil t) | 379 | (setq i (1+ i)) |
| 655 | (forward-line -1) | 380 | (mh-mml-forward-message (format description i) |
| 656 | (re-search-forward (format "^\\(%s\\)?$" mail-header-separator)) | 381 | folder msg)))))) |
| 657 | (forward-line 1)) | 382 | ;; Postition just before forwarded message |
| 658 | (delete-other-windows) | 383 | (if (re-search-forward "^------- Forwarded Message" nil t) |
| 659 | (mh-add-msgs-to-seq msgs 'forwarded t) | 384 | (forward-line -1) |
| 660 | (mh-compose-and-send-mail draft "" folder msg-or-seq | 385 | (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator)) |
| 661 | to forw-subject cc | 386 | (forward-line 1)) |
| 662 | mh-note-forw "Forwarded:" | 387 | (delete-other-windows) |
| 663 | config) | 388 | (mh-add-msgs-to-seq msgs 'forwarded t) |
| 664 | (if compose | 389 | (mh-compose-and-send-mail draft "" folder msg-or-seq |
| 665 | (setq mh-mml-compose-insert-flag t)) | 390 | to forw-subject cc |
| 666 | (mh-letter-mode-message))))) | 391 | mh-note-forw "Forwarded:" |
| 392 | config) | ||
| 393 | (if compose | ||
| 394 | (setq mh-mml-compose-insert-flag t)) | ||
| 395 | (mh-letter-mode-message))))) | ||
| 667 | 396 | ||
| 668 | (defun mh-forwarded-letter-subject (from subject) | 397 | (defun mh-forwarded-letter-subject (from subject) |
| 669 | "Return a Subject suitable for a forwarded message. | 398 | "Return a Subject suitable for a forwarded message. |
| 670 | Original message has headers FROM and SUBJECT." | 399 | Original message has headers FROM and SUBJECT." |
| 671 | (let ((addr-start (string-match "<" from)) | 400 | (let ((addr-start (string-match "<" from)) |
| 672 | (comment (string-match "(" from))) | 401 | (comment (string-match "(" from))) |
| 673 | (cond ((and addr-start (> addr-start 0)) | 402 | (cond ((and addr-start (> addr-start 0)) |
| 674 | ;; Full Name <luser@host> | 403 | ;; Full Name <luser@host> |
| 675 | (setq from (substring from 0 (1- addr-start)))) | 404 | (setq from (substring from 0 (1- addr-start)))) |
| 676 | (comment | 405 | (comment |
| 677 | ;; luser@host (Full Name) | 406 | ;; luser@host (Full Name) |
| 678 | (setq from (substring from (1+ comment) (1- (length from))))))) | 407 | (setq from (substring from (1+ comment) (1- (length from))))))) |
| 679 | (format mh-forward-subject-format from subject)) | 408 | (format mh-forward-subject-format from subject)) |
| 680 | 409 | ||
| 681 | ;;;###autoload | 410 | ;;;###autoload |
| @@ -689,57 +418,59 @@ See documentation of `\\[mh-send]' for more details on composing mail." | |||
| 689 | (mh-find-path) | 418 | (mh-find-path) |
| 690 | (call-interactively 'mh-send-other-window)) | 419 | (call-interactively 'mh-send-other-window)) |
| 691 | 420 | ||
| 421 | ;;;###mh-autoload | ||
| 692 | (defun mh-redistribute (to cc &optional msg) | 422 | (defun mh-redistribute (to cc &optional msg) |
| 693 | "Redistribute displayed message to recipients TO and CC. | 423 | "Redistribute displayed message to recipients TO and CC. |
| 694 | Use optional argument MSG to redistribute another message. | 424 | Use optional argument MSG to redistribute another message. |
| 695 | Depending on how your copy of MH was compiled, you may need to change the | 425 | Depending on how your copy of MH was compiled, you may need to change the |
| 696 | setting of the variable `mh-redist-full-contents'. See its documentation." | 426 | setting of the variable `mh-redist-full-contents'. See its documentation." |
| 697 | (interactive (list (mh-read-address "Redist-To: ") | 427 | (interactive (list (mh-read-address "Redist-To: ") |
| 698 | (mh-read-address "Redist-Cc: ") | 428 | (mh-read-address "Redist-Cc: ") |
| 699 | (mh-get-msg-num t))) | 429 | (mh-get-msg-num t))) |
| 700 | (or msg | 430 | (or msg |
| 701 | (setq msg (mh-get-msg-num t))) | 431 | (setq msg (mh-get-msg-num t))) |
| 702 | (save-window-excursion | 432 | (save-window-excursion |
| 703 | (let ((folder mh-current-folder) | 433 | (let ((folder mh-current-folder) |
| 704 | (draft (mh-read-draft "redistribution" | 434 | (draft (mh-read-draft "redistribution" |
| 705 | (if mh-redist-full-contents | 435 | (if mh-redist-full-contents |
| 706 | (mh-msg-filename msg) | 436 | (mh-msg-filename msg) |
| 707 | nil) | 437 | nil) |
| 708 | nil))) | 438 | nil))) |
| 709 | (mh-goto-header-end 0) | 439 | (mh-goto-header-end 0) |
| 710 | (insert "Resent-To: " to "\n") | 440 | (insert "Resent-To: " to "\n") |
| 711 | (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) | 441 | (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) |
| 712 | (mh-clean-msg-header (point-min) | 442 | (mh-clean-msg-header (point-min) |
| 713 | "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" | 443 | "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" |
| 714 | nil) | 444 | nil) |
| 715 | (save-buffer) | 445 | (save-buffer) |
| 716 | (message "Redistributing...") | 446 | (message "Redistributing...") |
| 717 | (if (not mh-redist-background) | 447 | (if (not mh-redist-background) |
| 718 | (if mh-redist-full-contents | 448 | (if mh-redist-full-contents |
| 719 | (call-process "/bin/sh" nil 0 nil "-c" | 449 | (call-process "/bin/sh" nil 0 nil "-c" |
| 720 | (format "mhdist=1 mhaltmsg=%s %s -push %s" | 450 | (format "mhdist=1 mhaltmsg=%s %s -push %s" |
| 721 | buffer-file-name | 451 | buffer-file-name |
| 722 | (expand-file-name mh-send-prog mh-progs) | 452 | (expand-file-name mh-send-prog mh-progs) |
| 723 | buffer-file-name)) | 453 | buffer-file-name)) |
| 724 | (call-process "/bin/sh" nil 0 nil "-c" | 454 | (call-process "/bin/sh" nil 0 nil "-c" |
| 725 | (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" | 455 | (format |
| 726 | (mh-msg-filename msg folder) | 456 | "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" |
| 727 | (expand-file-name mh-send-prog mh-progs) | 457 | (mh-msg-filename msg folder) |
| 728 | buffer-file-name)))) | 458 | (expand-file-name mh-send-prog mh-progs) |
| 459 | buffer-file-name)))) | ||
| 729 | (mh-annotate-msg msg folder mh-note-dist | 460 | (mh-annotate-msg msg folder mh-note-dist |
| 730 | "-component" "Resent:" | 461 | "-component" "Resent:" |
| 731 | "-text" (format "\"%s %s\"" to cc)) | 462 | "-text" (format "\"%s %s\"" to cc)) |
| 732 | (if mh-redist-background | 463 | (if mh-redist-background |
| 733 | (mh-exec-cmd-daemon "/bin/sh" "-c" | 464 | (mh-exec-cmd-daemon "/bin/sh" "-c" |
| 734 | (format "mhdist=1 mhaltmsg=%s %s %s %s" | 465 | (format "mhdist=1 mhaltmsg=%s %s %s %s" |
| 735 | (if mh-redist-full-contents | 466 | (if mh-redist-full-contents |
| 736 | buffer-file-name | 467 | buffer-file-name |
| 737 | (mh-msg-filename msg folder)) | 468 | (mh-msg-filename msg folder)) |
| 738 | (if mh-redist-full-contents | 469 | (if mh-redist-full-contents |
| 739 | "" | 470 | "" |
| 740 | "mhannotate=1") | 471 | "mhannotate=1") |
| 741 | (mh-expand-file-name "send" mh-progs) | 472 | (mh-expand-file-name "send" mh-progs) |
| 742 | buffer-file-name))) | 473 | buffer-file-name))) |
| 743 | (kill-buffer draft) | 474 | (kill-buffer draft) |
| 744 | (message "Redistributing...done")))) | 475 | (message "Redistributing...done")))) |
| 745 | 476 | ||
| @@ -754,9 +485,9 @@ Optional argument BUFFER can be used to specify the buffer." | |||
| 754 | (if buffer | 485 | (if buffer |
| 755 | (set-buffer buffer)) | 486 | (set-buffer buffer)) |
| 756 | (cond ((eq major-mode 'mh-show-mode) | 487 | (cond ((eq major-mode 'mh-show-mode) |
| 757 | (let ((number-start (search "/" buffer-file-name :from-end t))) | 488 | (let ((number-start (mh-search-from-end ?/ buffer-file-name))) |
| 758 | (car (read-from-string (subseq buffer-file-name | 489 | (car (read-from-string (substring buffer-file-name |
| 759 | (1+ number-start)))))) | 490 | (1+ number-start)))))) |
| 760 | ((and (eq major-mode 'mh-folder-mode) | 491 | ((and (eq major-mode 'mh-folder-mode) |
| 761 | mh-show-buffer | 492 | mh-show-buffer |
| 762 | (get-buffer mh-show-buffer)) | 493 | (get-buffer mh-show-buffer)) |
| @@ -768,6 +499,7 @@ Optional argument BUFFER can be used to specify the buffer." | |||
| 768 | (t | 499 | (t |
| 769 | nil)))) | 500 | nil)))) |
| 770 | 501 | ||
| 502 | ;;;###mh-autoload | ||
| 771 | (defun mh-reply (message &optional reply-to includep) | 503 | (defun mh-reply (message &optional reply-to includep) |
| 772 | "Reply to MESSAGE (default: current message). | 504 | "Reply to MESSAGE (default: current message). |
| 773 | If the optional argument REPLY-TO is not given, prompts for type of addresses | 505 | If the optional argument REPLY-TO is not given, prompts for type of addresses |
| @@ -810,11 +542,11 @@ for the reply. See also documentation for `\\[mh-send]' function." | |||
| 810 | (group-reply (if mh-nmh-flag | 542 | (group-reply (if mh-nmh-flag |
| 811 | '("-group" "-nocc" "me") | 543 | '("-group" "-nocc" "me") |
| 812 | '("-cc" "all" "-nocc" "me")))) | 544 | '("-cc" "all" "-nocc" "me")))) |
| 813 | (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite) | 545 | (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite) |
| 814 | (eq mh-yank-from-start-of-msg 'autoattrib)) | 546 | (eq mh-yank-from-start-of-msg 'autoattrib)) |
| 815 | '("-noformat")) | 547 | '("-noformat")) |
| 816 | (includep '("-filter" "mhl.reply")) | 548 | (includep '("-filter" "mhl.reply")) |
| 817 | (t '()))) | 549 | (t '()))) |
| 818 | (let ((draft (mh-read-draft "reply" | 550 | (let ((draft (mh-read-draft "reply" |
| 819 | (expand-file-name "reply" mh-user-path) | 551 | (expand-file-name "reply" mh-user-path) |
| 820 | t))) | 552 | t))) |
| @@ -841,6 +573,7 @@ for the reply. See also documentation for `\\[mh-send]' function." | |||
| 841 | (mh-yank-cur-msg)) | 573 | (mh-yank-cur-msg)) |
| 842 | (mh-letter-mode-message)))) | 574 | (mh-letter-mode-message)))) |
| 843 | 575 | ||
| 576 | ;;;###mh-autoload | ||
| 844 | (defun mh-send (to cc subject) | 577 | (defun mh-send (to cc subject) |
| 845 | "Compose and send a letter. | 578 | "Compose and send a letter. |
| 846 | 579 | ||
| @@ -852,13 +585,14 @@ details. | |||
| 852 | If `mh-compose-letter-function' is defined, it is called on the draft and | 585 | If `mh-compose-letter-function' is defined, it is called on the draft and |
| 853 | passed three arguments: TO, CC, and SUBJECT." | 586 | passed three arguments: TO, CC, and SUBJECT." |
| 854 | (interactive (list | 587 | (interactive (list |
| 855 | (mh-read-address "To: ") | 588 | (mh-read-address "To: ") |
| 856 | (mh-read-address "Cc: ") | 589 | (mh-read-address "Cc: ") |
| 857 | (read-string "Subject: "))) | 590 | (read-string "Subject: "))) |
| 858 | (let ((config (current-window-configuration))) | 591 | (let ((config (current-window-configuration))) |
| 859 | (delete-other-windows) | 592 | (delete-other-windows) |
| 860 | (mh-send-sub to cc subject config))) | 593 | (mh-send-sub to cc subject config))) |
| 861 | 594 | ||
| 595 | ;;;###mh-autoload | ||
| 862 | (defun mh-send-other-window (to cc subject) | 596 | (defun mh-send-other-window (to cc subject) |
| 863 | "Compose and send a letter in another window. | 597 | "Compose and send a letter in another window. |
| 864 | 598 | ||
| @@ -871,9 +605,9 @@ details. | |||
| 871 | If `mh-compose-letter-function' is defined, it is called on the draft and | 605 | If `mh-compose-letter-function' is defined, it is called on the draft and |
| 872 | passed three arguments: TO, CC, and SUBJECT." | 606 | passed three arguments: TO, CC, and SUBJECT." |
| 873 | (interactive (list | 607 | (interactive (list |
| 874 | (mh-read-address "To: ") | 608 | (mh-read-address "To: ") |
| 875 | (mh-read-address "Cc: ") | 609 | (mh-read-address "Cc: ") |
| 876 | (read-string "Subject: "))) | 610 | (read-string "Subject: "))) |
| 877 | (let ((pop-up-windows t)) | 611 | (let ((pop-up-windows t)) |
| 878 | (mh-send-sub to cc subject (current-window-configuration)))) | 612 | (mh-send-sub to cc subject (current-window-configuration)))) |
| 879 | 613 | ||
| @@ -882,38 +616,38 @@ passed three arguments: TO, CC, and SUBJECT." | |||
| 882 | Expects the TO, CC, and SUBJECT fields as arguments. | 616 | Expects the TO, CC, and SUBJECT fields as arguments. |
| 883 | CONFIG is the window configuration before sending mail." | 617 | CONFIG is the window configuration before sending mail." |
| 884 | (let ((folder mh-current-folder) | 618 | (let ((folder mh-current-folder) |
| 885 | (msg-num (mh-get-msg-num nil))) | 619 | (msg-num (mh-get-msg-num nil))) |
| 886 | (message "Composing a message...") | 620 | (message "Composing a message...") |
| 887 | (let ((draft (mh-read-draft | 621 | (let ((draft (mh-read-draft |
| 888 | "message" | 622 | "message" |
| 889 | (let (components) | 623 | (let (components) |
| 890 | (cond | 624 | (cond |
| 891 | ((file-exists-p | 625 | ((file-exists-p |
| 892 | (setq components | 626 | (setq components |
| 893 | (expand-file-name mh-comp-formfile mh-user-path))) | 627 | (expand-file-name mh-comp-formfile mh-user-path))) |
| 894 | components) | 628 | components) |
| 895 | ((file-exists-p | 629 | ((file-exists-p |
| 896 | (setq components | 630 | (setq components |
| 897 | (expand-file-name mh-comp-formfile mh-lib))) | 631 | (expand-file-name mh-comp-formfile mh-lib))) |
| 898 | components) | 632 | components) |
| 899 | ((file-exists-p | 633 | ((file-exists-p |
| 900 | (setq components | 634 | (setq components |
| 901 | (expand-file-name mh-comp-formfile | 635 | (expand-file-name mh-comp-formfile |
| 902 | ;; What is this mh-etc ?? -sm | 636 | ;; What is this mh-etc ?? -sm |
| 903 | ;; This is dead code, so | 637 | ;; This is dead code, so |
| 904 | ;; remove it. | 638 | ;; remove it. |
| 905 | ;(and (boundp 'mh-etc) mh-etc) | 639 | ;(and (boundp 'mh-etc) mh-etc) |
| 906 | ))) | 640 | ))) |
| 907 | components) | 641 | components) |
| 908 | (t | 642 | (t |
| 909 | (error (format "Can't find components file \"%s\"" | 643 | (error (format "Can't find components file \"%s\"" |
| 910 | components))))) | 644 | components))))) |
| 911 | nil))) | 645 | nil))) |
| 912 | (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) | 646 | (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) |
| 913 | (goto-char (point-max)) | 647 | (goto-char (point-max)) |
| 914 | (mh-compose-and-send-mail draft "" folder msg-num | 648 | (mh-compose-and-send-mail draft "" folder msg-num |
| 915 | to subject cc | 649 | to subject cc |
| 916 | nil nil config) | 650 | nil nil config) |
| 917 | (mh-letter-mode-message)))) | 651 | (mh-letter-mode-message)))) |
| 918 | 652 | ||
| 919 | (defun mh-read-draft (use initial-contents delete-contents-file) | 653 | (defun mh-read-draft (use initial-contents delete-contents-file) |
| @@ -927,42 +661,42 @@ If the draft folder facility is enabled in ~/.mh_profile, a new buffer is | |||
| 927 | used each time and saved in the draft folder. The draft file can then be | 661 | used each time and saved in the draft folder. The draft file can then be |
| 928 | reused." | 662 | reused." |
| 929 | (cond (mh-draft-folder | 663 | (cond (mh-draft-folder |
| 930 | (let ((orig-default-dir default-directory) | 664 | (let ((orig-default-dir default-directory) |
| 931 | (draft-file-name (mh-new-draft-name))) | 665 | (draft-file-name (mh-new-draft-name))) |
| 932 | (pop-to-buffer (generate-new-buffer | 666 | (pop-to-buffer (generate-new-buffer |
| 933 | (format "draft-%s" | 667 | (format "draft-%s" |
| 934 | (file-name-nondirectory draft-file-name)))) | 668 | (file-name-nondirectory draft-file-name)))) |
| 935 | (condition-case () | 669 | (condition-case () |
| 936 | (insert-file-contents draft-file-name t) | 670 | (insert-file-contents draft-file-name t) |
| 937 | (file-error)) | 671 | (file-error)) |
| 938 | (setq default-directory orig-default-dir))) | 672 | (setq default-directory orig-default-dir))) |
| 939 | (t | 673 | (t |
| 940 | (let ((draft-name (expand-file-name "draft" mh-user-path))) | 674 | (let ((draft-name (expand-file-name "draft" mh-user-path))) |
| 941 | (pop-to-buffer "draft") ; Create if necessary | 675 | (pop-to-buffer "draft") ; Create if necessary |
| 942 | (if (buffer-modified-p) | 676 | (if (buffer-modified-p) |
| 943 | (if (y-or-n-p "Draft has been modified; kill anyway? ") | 677 | (if (y-or-n-p "Draft has been modified; kill anyway? ") |
| 944 | (set-buffer-modified-p nil) | 678 | (set-buffer-modified-p nil) |
| 945 | (error "Draft preserved"))) | 679 | (error "Draft preserved"))) |
| 946 | (setq buffer-file-name draft-name) | 680 | (setq buffer-file-name draft-name) |
| 947 | (clear-visited-file-modtime) | 681 | (clear-visited-file-modtime) |
| 948 | (unlock-buffer) | 682 | (unlock-buffer) |
| 949 | (cond ((and (file-exists-p draft-name) | 683 | (cond ((and (file-exists-p draft-name) |
| 950 | (not (equal draft-name initial-contents))) | 684 | (not (equal draft-name initial-contents))) |
| 951 | (insert-file-contents draft-name) | 685 | (insert-file-contents draft-name) |
| 952 | (delete-file draft-name)))))) | 686 | (delete-file draft-name)))))) |
| 953 | (cond ((and initial-contents | 687 | (cond ((and initial-contents |
| 954 | (or (zerop (buffer-size)) | 688 | (or (zerop (buffer-size)) |
| 955 | (if (y-or-n-p | 689 | (if (y-or-n-p |
| 956 | (format "A draft exists. Use for %s? " use)) | 690 | (format "A draft exists. Use for %s? " use)) |
| 957 | (if mh-error-if-no-draft | 691 | (if mh-error-if-no-draft |
| 958 | (error "A prior draft exists")) | 692 | (error "A prior draft exists")) |
| 959 | t))) | 693 | t))) |
| 960 | (erase-buffer) | 694 | (erase-buffer) |
| 961 | (insert-file-contents initial-contents) | 695 | (insert-file-contents initial-contents) |
| 962 | (if delete-contents-file (delete-file initial-contents)))) | 696 | (if delete-contents-file (delete-file initial-contents)))) |
| 963 | (auto-save-mode 1) | 697 | (auto-save-mode 1) |
| 964 | (if mh-draft-folder | 698 | (if mh-draft-folder |
| 965 | (save-buffer)) ; Do not reuse draft name | 699 | (save-buffer)) ; Do not reuse draft name |
| 966 | (buffer-name)) | 700 | (buffer-name)) |
| 967 | 701 | ||
| 968 | (defun mh-new-draft-name () | 702 | (defun mh-new-draft-name () |
| @@ -975,11 +709,11 @@ reused." | |||
| 975 | "Mark MSG in BUFFER with character NOTE and annotate message with ARGS." | 709 | "Mark MSG in BUFFER with character NOTE and annotate message with ARGS." |
| 976 | (apply 'mh-exec-cmd "anno" buffer msg args) | 710 | (apply 'mh-exec-cmd "anno" buffer msg args) |
| 977 | (save-excursion | 711 | (save-excursion |
| 978 | (cond ((get-buffer buffer) ; Buffer may be deleted | 712 | (cond ((get-buffer buffer) ; Buffer may be deleted |
| 979 | (set-buffer buffer) | 713 | (set-buffer buffer) |
| 980 | (if (symbolp msg) | 714 | (if (numberp msg) |
| 981 | (mh-notate-seq msg note (1+ mh-cmd-note)) | 715 | (mh-notate msg note (1+ mh-cmd-note)) |
| 982 | (mh-notate msg note (1+ mh-cmd-note))))))) | 716 | (mh-notate-seq msg note (1+ mh-cmd-note))))))) |
| 983 | 717 | ||
| 984 | (defun mh-insert-fields (&rest name-values) | 718 | (defun mh-insert-fields (&rest name-values) |
| 985 | "Insert the NAME-VALUES pairs in the current buffer. | 719 | "Insert the NAME-VALUES pairs in the current buffer. |
| @@ -988,14 +722,14 @@ Do not insert any pairs whose value is the empty string." | |||
| 988 | (let ((case-fold-search t)) | 722 | (let ((case-fold-search t)) |
| 989 | (while name-values | 723 | (while name-values |
| 990 | (let ((field-name (car name-values)) | 724 | (let ((field-name (car name-values)) |
| 991 | (value (car (cdr name-values)))) | 725 | (value (car (cdr name-values)))) |
| 992 | (cond ((equal value "") | 726 | (cond ((equal value "") |
| 993 | nil) | 727 | nil) |
| 994 | ((mh-position-on-field field-name) | 728 | ((mh-position-on-field field-name) |
| 995 | (insert " " (or value ""))) | 729 | (insert " " (or value ""))) |
| 996 | (t | 730 | (t |
| 997 | (insert field-name " " value "\n"))) | 731 | (insert field-name " " value "\n"))) |
| 998 | (setq name-values (cdr (cdr name-values))))))) | 732 | (setq name-values (cdr (cdr name-values))))))) |
| 999 | 733 | ||
| 1000 | (defun mh-position-on-field (field &optional ignored) | 734 | (defun mh-position-on-field (field &optional ignored) |
| 1001 | "Move to the end of the FIELD in the header. | 735 | "Move to the end of the FIELD in the header. |
| @@ -1003,10 +737,10 @@ Move to end of entire header if FIELD not found. | |||
| 1003 | Returns non-nil iff FIELD was found. | 737 | Returns non-nil iff FIELD was found. |
| 1004 | The optional second arg is for pre-version 4 compatibility and is IGNORED." | 738 | The optional second arg is for pre-version 4 compatibility and is IGNORED." |
| 1005 | (cond ((mh-goto-header-field field) | 739 | (cond ((mh-goto-header-field field) |
| 1006 | (mh-header-field-end) | 740 | (mh-header-field-end) |
| 1007 | t) | 741 | t) |
| 1008 | ((mh-goto-header-end 0) | 742 | ((mh-goto-header-end 0) |
| 1009 | nil))) | 743 | nil))) |
| 1010 | 744 | ||
| 1011 | (defun mh-get-header-field (field) | 745 | (defun mh-get-header-field (field) |
| 1012 | "Find and return the body of FIELD in the mail header. | 746 | "Find and return the body of FIELD in the mail header. |
| @@ -1014,10 +748,10 @@ Returns the empty string if the field is not in the header of the | |||
| 1014 | current buffer." | 748 | current buffer." |
| 1015 | (if (mh-goto-header-field field) | 749 | (if (mh-goto-header-field field) |
| 1016 | (progn | 750 | (progn |
| 1017 | (skip-chars-forward " \t") ;strip leading white space in body | 751 | (skip-chars-forward " \t") ;strip leading white space in body |
| 1018 | (let ((start (point))) | 752 | (let ((start (point))) |
| 1019 | (mh-header-field-end) | 753 | (mh-header-field-end) |
| 1020 | (buffer-substring start (point)))) | 754 | (buffer-substring-no-properties start (point)))) |
| 1021 | "")) | 755 | "")) |
| 1022 | 756 | ||
| 1023 | (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility | 757 | (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility |
| @@ -1028,9 +762,9 @@ Move to the end of the FIELD name, which should end in a colon. | |||
| 1028 | Returns t if found, nil if not." | 762 | Returns t if found, nil if not." |
| 1029 | (goto-char (point-min)) | 763 | (goto-char (point-min)) |
| 1030 | (let ((case-fold-search t) | 764 | (let ((case-fold-search t) |
| 1031 | (headers-end (save-excursion | 765 | (headers-end (save-excursion |
| 1032 | (mh-goto-header-end 0) | 766 | (mh-goto-header-end 0) |
| 1033 | (point)))) | 767 | (point)))) |
| 1034 | (re-search-forward (format "^%s" field) headers-end t))) | 768 | (re-search-forward (format "^%s" field) headers-end t))) |
| 1035 | 769 | ||
| 1036 | (defun mh-goto-header-end (arg) | 770 | (defun mh-goto-header-end (arg) |
| @@ -1038,11 +772,14 @@ Returns t if found, nil if not." | |||
| 1038 | (if (re-search-forward "^-*$" nil nil) | 772 | (if (re-search-forward "^-*$" nil nil) |
| 1039 | (forward-line arg))) | 773 | (forward-line arg))) |
| 1040 | 774 | ||
| 1041 | 775 | (defun mh-extract-from-header-value () | |
| 1042 | (defun mh-read-address (prompt) | 776 | "Extract From: string from header." |
| 1043 | "Read a To: or Cc: address, prompting in the minibuffer with PROMPT. | 777 | (save-excursion |
| 1044 | May someday do completion on aliases." | 778 | (if (not (mh-goto-header-field "From:")) |
| 1045 | (read-string prompt)) | 779 | (error "No From header line found") |
| 780 | (skip-chars-forward " \t") | ||
| 781 | (buffer-substring-no-properties | ||
| 782 | (point) (progn (mh-header-field-end)(point)))))) | ||
| 1046 | 783 | ||
| 1047 | 784 | ||
| 1048 | 785 | ||
| @@ -1050,37 +787,6 @@ May someday do completion on aliases." | |||
| 1050 | 787 | ||
| 1051 | (put 'mh-letter-mode 'mode-class 'special) | 788 | (put 'mh-letter-mode 'mode-class 'special) |
| 1052 | 789 | ||
| 1053 | ;;; Support for emacs21 toolbar using gnus/message.el icons (and code). | ||
| 1054 | (eval-when-compile (defvar tool-bar-map)) | ||
| 1055 | (defvar mh-letter-tool-bar-map nil) | ||
| 1056 | (when (and (fboundp 'tool-bar-add-item) | ||
| 1057 | tool-bar-mode) | ||
| 1058 | (setq mh-letter-tool-bar-map | ||
| 1059 | (let ((tool-bar-map (make-sparse-keymap))) | ||
| 1060 | (tool-bar-add-item "mail_send" 'mh-send-letter 'mh-lettertoolbar-send | ||
| 1061 | :help "Send this letter") | ||
| 1062 | (tool-bar-add-item "attach" 'mh-compose-insertion | ||
| 1063 | 'mh-lettertoolbar-compose | ||
| 1064 | :help "Insert attachment") | ||
| 1065 | (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell | ||
| 1066 | :help "Check spelling") | ||
| 1067 | (tool-bar-add-item-from-menu 'save-buffer "save") | ||
| 1068 | (tool-bar-add-item-from-menu 'undo "undo") | ||
| 1069 | (tool-bar-add-item-from-menu 'kill-region "cut") | ||
| 1070 | (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy") | ||
| 1071 | (tool-bar-add-item "close" 'mh-fully-kill-draft 'mh-lettertoolbar-kill | ||
| 1072 | :help "Kill this draft") | ||
| 1073 | (tool-bar-add-item "preferences" (lambda () | ||
| 1074 | (interactive) | ||
| 1075 | (customize-group "mh-compose")) | ||
| 1076 | 'mh-lettertoolbar-customize | ||
| 1077 | :help "MH-E composition preferences") | ||
| 1078 | (tool-bar-add-item "help" (lambda () | ||
| 1079 | (interactive) | ||
| 1080 | (Info-goto-node "(mh-e)Draft Editing")) | ||
| 1081 | 'mh-lettertoolbar-help :help "Help") | ||
| 1082 | tool-bar-map))) | ||
| 1083 | |||
| 1084 | ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) | 790 | ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) |
| 1085 | (eval-when-compile (defvar mh-letter-menu nil)) | 791 | (eval-when-compile (defvar mh-letter-menu nil)) |
| 1086 | (cond | 792 | (cond |
| @@ -1094,17 +800,23 @@ May someday do completion on aliases." | |||
| 1094 | ["Yank Current Message" mh-yank-cur-msg t] | 800 | ["Yank Current Message" mh-yank-cur-msg t] |
| 1095 | ["Insert a Message..." mh-insert-letter t] | 801 | ["Insert a Message..." mh-insert-letter t] |
| 1096 | ["Insert Signature" mh-insert-signature t] | 802 | ["Insert Signature" mh-insert-signature t] |
| 1097 | ["GPG Sign message" mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag] | 803 | ["GPG Sign message" |
| 1098 | ["GPG Encrypt message" mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag] | 804 | mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag] |
| 805 | ["GPG Encrypt message" | ||
| 806 | mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag] | ||
| 1099 | ["Compose Insertion (MIME)..." mh-compose-insertion t] | 807 | ["Compose Insertion (MIME)..." mh-compose-insertion t] |
| 1100 | ;; ["Compose Compressed tar (MIME)..." mh-mhn-compose-external-compressed-tar t] | 808 | ;; ["Compose Compressed tar (MIME)..." |
| 1101 | ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t] | 809 | ;;mh-mhn-compose-external-compressed-tar t] |
| 810 | ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t] | ||
| 1102 | ["Compose Forward (MIME)..." mh-compose-forward t] | 811 | ["Compose Forward (MIME)..." mh-compose-forward t] |
| 1103 | ;; The next two will have to be merged. But I also need to make sure the user | 812 | ;; The next two will have to be merged. But I also need to make sure the |
| 1104 | ;; can't mix directives of both types. | 813 | ;; user can't mix directives of both types. |
| 1105 | ["Pull in All Compositions (mhn)" mh-edit-mhn mh-mhn-compose-insert-flag] | 814 | ["Pull in All Compositions (mhn)" |
| 1106 | ["Pull in All Compositions (gnus)" mh-mml-to-mime mh-mml-compose-insert-flag] | 815 | mh-edit-mhn mh-mhn-compose-insert-flag] |
| 1107 | ["Revert to Non-MIME Edit (mhn)" mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] | 816 | ["Pull in All Compositions (gnus)" |
| 817 | mh-mml-to-mime mh-mml-compose-insert-flag] | ||
| 818 | ["Revert to Non-MIME Edit (mhn)" | ||
| 819 | mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] | ||
| 1108 | ["Kill This Draft" mh-fully-kill-draft t])))) | 820 | ["Kill This Draft" mh-fully-kill-draft t])))) |
| 1109 | 821 | ||
| 1110 | ;;; Help Messages | 822 | ;;; Help Messages |
| @@ -1134,7 +846,7 @@ non-prefixed commands. | |||
| 1134 | The substitutions described in `substitute-command-keys' are performed as | 846 | The substitutions described in `substitute-command-keys' are performed as |
| 1135 | well.") | 847 | well.") |
| 1136 | 848 | ||
| 1137 | 849 | ;;;###mh-autoload | |
| 1138 | (defun mh-fill-paragraph-function (arg) | 850 | (defun mh-fill-paragraph-function (arg) |
| 1139 | "Fill paragraph at or after point. | 851 | "Fill paragraph at or after point. |
| 1140 | Prefix ARG means justify as well. This function enables `fill-paragraph' to | 852 | Prefix ARG means justify as well. This function enables `fill-paragraph' to |
| @@ -1152,10 +864,13 @@ work better in MH-Letter mode." | |||
| 1152 | When you have finished composing, type \\[mh-send-letter] to send the message | 864 | When you have finished composing, type \\[mh-send-letter] to send the message |
| 1153 | using the MH mail handling system. | 865 | using the MH mail handling system. |
| 1154 | 866 | ||
| 1155 | If MH MIME directives are added manually, you must first run \\[mh-edit-mhn] | 867 | There are two types of MIME directives used by MH-E: Gnus and MH. The option |
| 1156 | before sending the message. MIME directives that are added by MH-E commands | 868 | `mh-compose-insertion' controls what type of directives are inserted by MH-E |
| 1157 | such as \\[mh-mhn-compose-insertion] are processed automatically when the | 869 | commands. These directives can be converted to MIME body parts by running |
| 1158 | message is sent. | 870 | \\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives. |
| 871 | This step is mandatory if these directives are added manually. If the | ||
| 872 | directives are inserted with MH-E commands such as \\[mh-compose-insertion], | ||
| 873 | the directives are expanded automatically when the letter is sent. | ||
| 1159 | 874 | ||
| 1160 | Options that control this mode can be changed with | 875 | Options that control this mode can be changed with |
| 1161 | \\[customize-group]; specify the \"mh-compose\" group. | 876 | \\[customize-group]; specify the \"mh-compose\" group. |
| @@ -1185,21 +900,21 @@ When a message is composed, the hooks `text-mode-hook' and | |||
| 1185 | (setq fill-paragraph-function 'mh-fill-paragraph-function) | 900 | (setq fill-paragraph-function 'mh-fill-paragraph-function) |
| 1186 | (make-local-variable 'adaptive-fill-regexp) | 901 | (make-local-variable 'adaptive-fill-regexp) |
| 1187 | (setq adaptive-fill-regexp | 902 | (setq adaptive-fill-regexp |
| 1188 | (concat adaptive-fill-regexp | 903 | (concat adaptive-fill-regexp |
| 1189 | "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) | 904 | "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) |
| 1190 | (make-local-variable 'adaptive-fill-first-line-regexp) | 905 | (make-local-variable 'adaptive-fill-first-line-regexp) |
| 1191 | (setq adaptive-fill-first-line-regexp | 906 | (setq adaptive-fill-first-line-regexp |
| 1192 | (concat adaptive-fill-first-line-regexp | 907 | (concat adaptive-fill-first-line-regexp |
| 1193 | "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) | 908 | "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) |
| 1194 | ;; `-- ' precedes the signature. `-----' appears at the start of the | 909 | ;; `-- ' precedes the signature. `-----' appears at the start of the |
| 1195 | ;; lines that delimit forwarded messages. | 910 | ;; lines that delimit forwarded messages. |
| 1196 | ;; Lines containing just >= 3 dashes, perhaps after whitespace, | 911 | ;; Lines containing just >= 3 dashes, perhaps after whitespace, |
| 1197 | ;; are also sometimes used and should be separators. | 912 | ;; are also sometimes used and should be separators. |
| 1198 | (setq paragraph-start (concat (regexp-quote mail-header-separator) | 913 | (setq paragraph-start (concat (regexp-quote mail-header-separator) |
| 1199 | "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" | 914 | "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" |
| 1200 | "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" | 915 | "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" |
| 1201 | "-- $\\|---+$\\|" | 916 | "-- $\\|---+$\\|" |
| 1202 | page-delimiter)) | 917 | page-delimiter)) |
| 1203 | (setq paragraph-separate paragraph-start) | 918 | (setq paragraph-separate paragraph-start) |
| 1204 | ;; --- End of code from sendmail.el --- | 919 | ;; --- End of code from sendmail.el --- |
| 1205 | 920 | ||
| @@ -1219,16 +934,17 @@ When a message is composed, the hooks `text-mode-hook' and | |||
| 1219 | (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) | 934 | (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) |
| 1220 | (easy-menu-add mh-letter-menu) | 935 | (easy-menu-add mh-letter-menu) |
| 1221 | ;; See if a "forw: -mime" message containing a MIME composition. | 936 | ;; See if a "forw: -mime" message containing a MIME composition. |
| 1222 | ;; mode clears local vars, so can't do this in mh-forward. | 937 | ;; Mode clears local vars, so can't do this in mh-forward. |
| 1223 | (save-excursion | 938 | (save-excursion |
| 1224 | (goto-char (point-min)) | 939 | (goto-char (point-min)) |
| 1225 | (when (and (re-search-forward (format "^\\(%s\\)?$" mail-header-separator) nil t) | 940 | (when (and (re-search-forward |
| 941 | (format "^\\(%s\\)?$" mail-header-separator) nil t) | ||
| 1226 | (= 0 (forward-line 1)) | 942 | (= 0 (forward-line 1)) |
| 1227 | (looking-at "^#forw")) | 943 | (looking-at "^#forw")) |
| 1228 | (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var | 944 | (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var |
| 1229 | (setq mh-mhn-compose-insert-flag t))) | 945 | (setq mh-mhn-compose-insert-flag t))) |
| 1230 | (setq fill-column mh-letter-fill-column) | 946 | (setq fill-column mh-letter-fill-column) |
| 1231 | ;; if text-mode-hook turned on auto-fill, tune it for messages | 947 | ;; If text-mode-hook turned on auto-fill, tune it for messages |
| 1232 | (when auto-fill-function | 948 | (when auto-fill-function |
| 1233 | (make-local-variable 'auto-fill-function) | 949 | (make-local-variable 'auto-fill-function) |
| 1234 | (setq auto-fill-function 'mh-auto-fill-for-letter))) | 950 | (setq auto-fill-function 'mh-auto-fill-for-letter))) |
| @@ -1238,7 +954,7 @@ When a message is composed, the hooks `text-mode-hook' and | |||
| 1238 | Header is treated specially by inserting a tab before continuation lines." | 954 | Header is treated specially by inserting a tab before continuation lines." |
| 1239 | (if (mh-in-header-p) | 955 | (if (mh-in-header-p) |
| 1240 | (let ((fill-prefix "\t")) | 956 | (let ((fill-prefix "\t")) |
| 1241 | (do-auto-fill)) | 957 | (do-auto-fill)) |
| 1242 | (do-auto-fill))) | 958 | (do-auto-fill))) |
| 1243 | 959 | ||
| 1244 | (defun mh-insert-header-separator () | 960 | (defun mh-insert-header-separator () |
| @@ -1247,8 +963,9 @@ Header is treated specially by inserting a tab before continuation lines." | |||
| 1247 | (goto-char (point-min)) | 963 | (goto-char (point-min)) |
| 1248 | (rfc822-goto-eoh) | 964 | (rfc822-goto-eoh) |
| 1249 | (if (looking-at "$") | 965 | (if (looking-at "$") |
| 1250 | (insert mh-mail-header-separator)))) | 966 | (insert mh-mail-header-separator)))) |
| 1251 | 967 | ||
| 968 | ;;;###mh-autoload | ||
| 1252 | (defun mh-to-field () | 969 | (defun mh-to-field () |
| 1253 | "Move point to the end of a specified header field. | 970 | "Move point to the end of a specified header field. |
| 1254 | The field is indicated by the previous keystroke (the last keystroke | 971 | The field is indicated by the previous keystroke (the last keystroke |
| @@ -1257,48 +974,52 @@ Create the field if it does not exist. Set the mark to point before moving." | |||
| 1257 | (interactive) | 974 | (interactive) |
| 1258 | (expand-abbrev) | 975 | (expand-abbrev) |
| 1259 | (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) | 976 | (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) |
| 1260 | mh-to-field-choices) | 977 | mh-to-field-choices) |
| 1261 | ;; also look for a char for version 4 compat | 978 | ;; also look for a char for version 4 compat |
| 1262 | (assoc (logior last-input-char ?`) mh-to-field-choices)))) | 979 | (assoc (logior last-input-char ?`) |
| 1263 | (case-fold-search t)) | 980 | mh-to-field-choices)))) |
| 981 | (case-fold-search t)) | ||
| 1264 | (push-mark) | 982 | (push-mark) |
| 1265 | (cond ((mh-position-on-field target) | 983 | (cond ((mh-position-on-field target) |
| 1266 | (let ((eol (point))) | 984 | (let ((eol (point))) |
| 1267 | (skip-chars-backward " \t") | 985 | (skip-chars-backward " \t") |
| 1268 | (delete-region (point) eol)) | 986 | (delete-region (point) eol)) |
| 1269 | (if (and (not (eq (logior last-input-char ?`) ?s)) | 987 | (if (and (not (eq (logior last-input-char ?`) ?s)) |
| 1270 | (save-excursion | 988 | (save-excursion |
| 1271 | (backward-char 1) | 989 | (backward-char 1) |
| 1272 | (not (looking-at "[:,]")))) | 990 | (not (looking-at "[:,]")))) |
| 1273 | (insert ", ") | 991 | (insert ", ") |
| 1274 | (insert " "))) | 992 | (insert " "))) |
| 1275 | (t | 993 | (t |
| 1276 | (if (mh-position-on-field "To:") | 994 | (if (mh-position-on-field "To:") |
| 1277 | (forward-line 1)) | 995 | (forward-line 1)) |
| 1278 | (insert (format "%s \n" target)) | 996 | (insert (format "%s \n" target)) |
| 1279 | (backward-char 1))))) | 997 | (backward-char 1))))) |
| 1280 | 998 | ||
| 999 | ;;;###mh-autoload | ||
| 1281 | (defun mh-to-fcc (&optional folder) | 1000 | (defun mh-to-fcc (&optional folder) |
| 1282 | "Insert an Fcc: FOLDER field in the current message. | 1001 | "Insert an Fcc: FOLDER field in the current message. |
| 1283 | Prompt for the field name with a completion list of the current folders." | 1002 | Prompt for the field name with a completion list of the current folders." |
| 1284 | (interactive) | 1003 | (interactive) |
| 1285 | (or folder | 1004 | (or folder |
| 1286 | (setq folder (mh-prompt-for-folder | 1005 | (setq folder (mh-prompt-for-folder |
| 1287 | "Fcc" | 1006 | "Fcc" |
| 1288 | (or (and mh-default-folder-for-message-function | 1007 | (or (and mh-default-folder-for-message-function |
| 1289 | (save-excursion | 1008 | (save-excursion |
| 1290 | (goto-char (point-min)) | 1009 | (goto-char (point-min)) |
| 1291 | (funcall mh-default-folder-for-message-function))) | 1010 | (funcall |
| 1292 | "") | 1011 | mh-default-folder-for-message-function))) |
| 1293 | t))) | 1012 | "") |
| 1013 | t))) | ||
| 1294 | (let ((last-input-char ?\C-f)) | 1014 | (let ((last-input-char ?\C-f)) |
| 1295 | (expand-abbrev) | 1015 | (expand-abbrev) |
| 1296 | (save-excursion | 1016 | (save-excursion |
| 1297 | (mh-to-field) | 1017 | (mh-to-field) |
| 1298 | (insert (if (mh-folder-name-p folder) | 1018 | (insert (if (mh-folder-name-p folder) |
| 1299 | (substring folder 1) | 1019 | (substring folder 1) |
| 1300 | folder))))) | 1020 | folder))))) |
| 1301 | 1021 | ||
| 1022 | ;;;###mh-autoload | ||
| 1302 | (defun mh-insert-signature () | 1023 | (defun mh-insert-signature () |
| 1303 | "Insert the file named by `mh-signature-file-name' at point. | 1024 | "Insert the file named by `mh-signature-file-name' at point. |
| 1304 | The value of `mh-letter-insert-signature-hook' is a list of functions to be | 1025 | The value of `mh-letter-insert-signature-hook' is a list of functions to be |
| @@ -1307,9 +1028,10 @@ called, with no arguments, before the signature is actually inserted." | |||
| 1307 | (let ((mh-signature-file-name mh-signature-file-name)) | 1028 | (let ((mh-signature-file-name mh-signature-file-name)) |
| 1308 | (run-hooks 'mh-letter-insert-signature-hook) | 1029 | (run-hooks 'mh-letter-insert-signature-hook) |
| 1309 | (if mh-signature-file-name | 1030 | (if mh-signature-file-name |
| 1310 | (insert-file-contents mh-signature-file-name))) | 1031 | (insert-file-contents mh-signature-file-name))) |
| 1311 | (force-mode-line-update)) | 1032 | (force-mode-line-update)) |
| 1312 | 1033 | ||
| 1034 | ;;;###mh-autoload | ||
| 1313 | (defun mh-check-whom () | 1035 | (defun mh-check-whom () |
| 1314 | "Verify recipients of the current letter, showing expansion of any aliases." | 1036 | "Verify recipients of the current letter, showing expansion of any aliases." |
| 1315 | (interactive) | 1037 | (interactive) |
| @@ -1348,21 +1070,21 @@ The versions of MH-E, Emacs, and MH are shown." | |||
| 1348 | (mh-version) | 1070 | (mh-version) |
| 1349 | (set-buffer mh-temp-buffer) | 1071 | (set-buffer mh-temp-buffer) |
| 1350 | (if mh-nmh-flag | 1072 | (if mh-nmh-flag |
| 1351 | (search-forward-regexp "^nmh-\\(\\S +\\)") | 1073 | (search-forward-regexp "^nmh-\\(\\S +\\)") |
| 1352 | (search-forward-regexp "^MH \\(\\S +\\)" nil t)) | 1074 | (search-forward-regexp "^MH \\(\\S +\\)" nil t)) |
| 1353 | (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1)))) | 1075 | (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1)))) |
| 1354 | (setq mh-x-mailer-string | 1076 | (setq mh-x-mailer-string |
| 1355 | (format "MH-E %s; %s %s; %s %d.%d" | 1077 | (format "MH-E %s; %s %s; %s %d.%d" |
| 1356 | mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh | 1078 | mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh |
| 1357 | (if mh-xemacs-flag | 1079 | (if mh-xemacs-flag |
| 1358 | "XEmacs" | 1080 | "XEmacs" |
| 1359 | "Emacs") | 1081 | "Emacs") |
| 1360 | emacs-major-version emacs-minor-version))) | 1082 | emacs-major-version emacs-minor-version))) |
| 1361 | (kill-buffer mh-temp-buffer))) | 1083 | (kill-buffer mh-temp-buffer))) |
| 1362 | ;; Insert X-Mailer, but only if it doesn't already exist. | 1084 | ;; Insert X-Mailer, but only if it doesn't already exist. |
| 1363 | (save-excursion | 1085 | (save-excursion |
| 1364 | (when (null (mh-goto-header-field "X-Mailer")) | 1086 | (when (null (mh-goto-header-field "X-Mailer")) |
| 1365 | (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) | 1087 | (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) |
| 1366 | 1088 | ||
| 1367 | (defun mh-regexp-in-field-p (regexp &rest fields) | 1089 | (defun mh-regexp-in-field-p (regexp &rest fields) |
| 1368 | "Non-nil means REGEXP was found in FIELDS." | 1090 | "Non-nil means REGEXP was found in FIELDS." |
| @@ -1396,10 +1118,10 @@ The versions of MH-E, Emacs, and MH are shown." | |||
| 1396 | (setq list (cdr list)))))))) | 1118 | (setq list (cdr list)))))))) |
| 1397 | 1119 | ||
| 1398 | (defun mh-compose-and-send-mail (draft send-args | 1120 | (defun mh-compose-and-send-mail (draft send-args |
| 1399 | sent-from-folder sent-from-msg | 1121 | sent-from-folder sent-from-msg |
| 1400 | to subject cc | 1122 | to subject cc |
| 1401 | annotate-char annotate-field | 1123 | annotate-char annotate-field |
| 1402 | config) | 1124 | config) |
| 1403 | "Edit and compose a draft message in buffer DRAFT and send or save it. | 1125 | "Edit and compose a draft message in buffer DRAFT and send or save it. |
| 1404 | SEND-ARGS is the argument passed to the send command. | 1126 | SEND-ARGS is the argument passed to the send command. |
| 1405 | SENT-FROM-FOLDER is buffer containing scan listing of current folder, or | 1127 | SENT-FROM-FOLDER is buffer containing scan listing of current folder, or |
| @@ -1414,6 +1136,16 @@ CONFIG is the window configuration to restore after sending the letter." | |||
| 1414 | (pop-to-buffer draft) | 1136 | (pop-to-buffer draft) |
| 1415 | (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to)) | 1137 | (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to)) |
| 1416 | (mh-letter-mode) | 1138 | (mh-letter-mode) |
| 1139 | |||
| 1140 | ;; mh-identity support | ||
| 1141 | (if (and (boundp 'mh-identity-default) | ||
| 1142 | mh-identity-default) | ||
| 1143 | (mh-insert-identity mh-identity-default)) | ||
| 1144 | (when (and (boundp 'mh-identity-list) | ||
| 1145 | mh-identity-list) | ||
| 1146 | (mh-identity-make-menu) | ||
| 1147 | (easy-menu-add mh-identity-menu)) | ||
| 1148 | |||
| 1417 | (setq mh-sent-from-folder sent-from-folder) | 1149 | (setq mh-sent-from-folder sent-from-folder) |
| 1418 | (setq mh-sent-from-msg sent-from-msg) | 1150 | (setq mh-sent-from-msg sent-from-msg) |
| 1419 | (setq mh-send-args send-args) | 1151 | (setq mh-send-args send-args) |
| @@ -1422,28 +1154,32 @@ CONFIG is the window configuration to restore after sending the letter." | |||
| 1422 | (setq mh-previous-window-config config) | 1154 | (setq mh-previous-window-config config) |
| 1423 | (setq mode-line-buffer-identification (list "{%b}")) | 1155 | (setq mode-line-buffer-identification (list "{%b}")) |
| 1424 | (if (and (boundp 'mh-compose-letter-function) | 1156 | (if (and (boundp 'mh-compose-letter-function) |
| 1425 | mh-compose-letter-function) | 1157 | mh-compose-letter-function) |
| 1426 | ;; run-hooks will not pass arguments. | 1158 | ;; run-hooks will not pass arguments. |
| 1427 | (let ((value mh-compose-letter-function)) | 1159 | (let ((value mh-compose-letter-function)) |
| 1428 | (if (and (listp value) (not (eq (car value) 'lambda))) | 1160 | (if (and (listp value) (not (eq (car value) 'lambda))) |
| 1429 | (while value | 1161 | (while value |
| 1430 | (funcall (car value) to subject cc) | 1162 | (funcall (car value) to subject cc) |
| 1431 | (setq value (cdr value))) | 1163 | (setq value (cdr value))) |
| 1432 | (funcall mh-compose-letter-function to subject cc))))) | 1164 | (funcall mh-compose-letter-function to subject cc))))) |
| 1433 | 1165 | ||
| 1434 | (defun mh-letter-mode-message () | 1166 | (defun mh-letter-mode-message () |
| 1435 | "Display a help message for users of `mh-letter-mode'. | 1167 | "Display a help message for users of `mh-letter-mode'. |
| 1436 | This should be the last function called when composing the draft." | 1168 | This should be the last function called when composing the draft." |
| 1437 | (message "%s" (substitute-command-keys | 1169 | (message "%s" (substitute-command-keys |
| 1438 | (concat "Type \\[mh-send-letter] to send message, " | 1170 | (concat "Type \\[mh-send-letter] to send message, " |
| 1439 | "\\[mh-help] for help.")))) | 1171 | "\\[mh-help] for help.")))) |
| 1440 | 1172 | ||
| 1173 | ;;;###mh-autoload | ||
| 1441 | (defun mh-send-letter (&optional arg) | 1174 | (defun mh-send-letter (&optional arg) |
| 1442 | "Send the draft letter in the current buffer. | 1175 | "Send the draft letter in the current buffer. |
| 1443 | If optional prefix argument ARG is provided, monitor delivery. | 1176 | If optional prefix argument ARG is provided, monitor delivery. |
| 1444 | The value of `mh-before-send-letter-hook' is a list of functions to be called, | 1177 | The value of `mh-before-send-letter-hook' is a list of functions to be called, |
| 1445 | with no arguments, before doing anything. | 1178 | with no arguments, before doing anything. |
| 1446 | Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set." | 1179 | Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set. |
| 1180 | Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set. | ||
| 1181 | Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. | ||
| 1182 | Insert X-Face field if the file specified by `mh-x-face-file' exists." | ||
| 1447 | (interactive "P") | 1183 | (interactive "P") |
| 1448 | (run-hooks 'mh-before-send-letter-hook) | 1184 | (run-hooks 'mh-before-send-letter-hook) |
| 1449 | (cond | 1185 | (cond |
| @@ -1458,70 +1194,72 @@ Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set." | |||
| 1458 | (save-buffer) | 1194 | (save-buffer) |
| 1459 | (message "Sending...") | 1195 | (message "Sending...") |
| 1460 | (let ((draft-buffer (current-buffer)) | 1196 | (let ((draft-buffer (current-buffer)) |
| 1461 | (file-name buffer-file-name) | 1197 | (file-name buffer-file-name) |
| 1462 | (config mh-previous-window-config) | 1198 | (config mh-previous-window-config) |
| 1463 | (coding-system-for-write | 1199 | (coding-system-for-write |
| 1464 | (if (and (local-variable-p 'buffer-file-coding-system | 1200 | (if (and (local-variable-p 'buffer-file-coding-system |
| 1465 | (current-buffer)) ;XEmacs needs two args | 1201 | (current-buffer)) ;XEmacs needs two args |
| 1466 | ;; We're not sure why, but buffer-file-coding-system | 1202 | ;; We're not sure why, but buffer-file-coding-system |
| 1467 | ;; tends to get set to undecided-unix. | 1203 | ;; tends to get set to undecided-unix. |
| 1468 | (not (memq buffer-file-coding-system | 1204 | (not (memq buffer-file-coding-system |
| 1469 | '(undecided undecided-unix undecided-dos)))) | 1205 | '(undecided undecided-unix undecided-dos)))) |
| 1470 | buffer-file-coding-system | 1206 | buffer-file-coding-system |
| 1471 | (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) | 1207 | (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) |
| 1472 | (and (boundp 'default-buffer-file-coding-system ) | 1208 | (and (boundp 'default-buffer-file-coding-system ) |
| 1473 | default-buffer-file-coding-system) | 1209 | default-buffer-file-coding-system) |
| 1474 | 'iso-latin-1)))) | 1210 | 'iso-latin-1)))) |
| 1475 | ;; The default BCC encapsulation will make a MIME message unreadable. | 1211 | ;; The default BCC encapsulation will make a MIME message unreadable. |
| 1476 | ;; With nmh use the -mime arg to prevent this. | 1212 | ;; With nmh use the -mime arg to prevent this. |
| 1477 | (if (and mh-nmh-flag | 1213 | (if (and mh-nmh-flag |
| 1478 | (mh-goto-header-field "Bcc:") | 1214 | (mh-goto-header-field "Bcc:") |
| 1479 | (mh-goto-header-field "Content-Type:")) | 1215 | (mh-goto-header-field "Content-Type:")) |
| 1480 | (setq mh-send-args (format "-mime %s" mh-send-args))) | 1216 | (setq mh-send-args (format "-mime %s" mh-send-args))) |
| 1481 | (cond (arg | 1217 | (cond (arg |
| 1482 | (pop-to-buffer "MH mail delivery") | 1218 | (pop-to-buffer "MH mail delivery") |
| 1483 | (erase-buffer) | 1219 | (erase-buffer) |
| 1484 | (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" | 1220 | (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" |
| 1485 | "-nodraftfolder" mh-send-args file-name) | 1221 | "-nodraftfolder" mh-send-args file-name) |
| 1486 | (goto-char (point-max)) ; show the interesting part | 1222 | (goto-char (point-max)) ; show the interesting part |
| 1487 | (recenter -1) | 1223 | (recenter -1) |
| 1488 | (set-buffer draft-buffer)) ; for annotation below | 1224 | (set-buffer draft-buffer)) ; for annotation below |
| 1489 | (t | 1225 | (t |
| 1490 | (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose" | 1226 | (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose" |
| 1491 | mh-send-args file-name))) | 1227 | mh-send-args file-name))) |
| 1492 | (if mh-annotate-char | 1228 | (if mh-annotate-char |
| 1493 | (mh-annotate-msg mh-sent-from-msg | 1229 | (mh-annotate-msg mh-sent-from-msg |
| 1494 | mh-sent-from-folder | 1230 | mh-sent-from-folder |
| 1495 | mh-annotate-char | 1231 | mh-annotate-char |
| 1496 | "-component" mh-annotate-field | 1232 | "-component" mh-annotate-field |
| 1497 | "-text" (format "\"%s %s\"" | 1233 | "-text" (format "\"%s %s\"" |
| 1498 | (mh-get-header-field "To:") | 1234 | (mh-get-header-field "To:") |
| 1499 | (mh-get-header-field "Cc:")))) | 1235 | (mh-get-header-field "Cc:")))) |
| 1500 | 1236 | ||
| 1501 | (cond ((or (not arg) | 1237 | (cond ((or (not arg) |
| 1502 | (y-or-n-p "Kill draft buffer? ")) | 1238 | (y-or-n-p "Kill draft buffer? ")) |
| 1503 | (kill-buffer draft-buffer) | 1239 | (kill-buffer draft-buffer) |
| 1504 | (if config | 1240 | (if config |
| 1505 | (set-window-configuration config)))) | 1241 | (set-window-configuration config)))) |
| 1506 | (if arg | 1242 | (if arg |
| 1507 | (message "Sending...done") | 1243 | (message "Sending...done") |
| 1508 | (message "Sending...backgrounded")))) | 1244 | (message "Sending...backgrounded")))) |
| 1509 | 1245 | ||
| 1246 | ;;;###mh-autoload | ||
| 1510 | (defun mh-insert-letter (folder message verbatim) | 1247 | (defun mh-insert-letter (folder message verbatim) |
| 1511 | "Insert a message into the current letter. | 1248 | "Insert a message into the current letter. |
| 1512 | Removes the message's headers using `mh-invisible-headers'. Prefixes each | 1249 | Removes the header fields according to the variable `mh-invisible-headers'. |
| 1513 | non-blank line with `mh-ins-buf-prefix', unless `mh-yank-from-start-of-msg' | 1250 | Prefixes each non-blank line with `mh-ins-buf-prefix', unless |
| 1514 | is set for supercite and then use it to format the message. | 1251 | `mh-yank-from-start-of-msg' is set for supercite in which case supercite is |
| 1252 | used to format the message. | ||
| 1515 | Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do | 1253 | Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do |
| 1516 | not indent and do not delete headers. Leaves the mark before the letter | 1254 | not indent and do not delete headers. Leaves the mark before the letter |
| 1517 | and point after it." | 1255 | and point after it." |
| 1518 | (interactive | 1256 | (interactive |
| 1519 | (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) | 1257 | (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
| 1520 | (read-input (format "Message number%s: " | 1258 | (read-input (format "Message number%s: " |
| 1521 | (if mh-sent-from-msg | 1259 | (if (numberp mh-sent-from-msg) |
| 1522 | (format " [%d]" mh-sent-from-msg) | 1260 | (format " [%d]" mh-sent-from-msg) |
| 1523 | ""))) | 1261 | ""))) |
| 1524 | current-prefix-arg)) | 1262 | current-prefix-arg)) |
| 1525 | (save-restriction | 1263 | (save-restriction |
| 1526 | (narrow-to-region (point) (point)) | 1264 | (narrow-to-region (point) (point)) |
| 1527 | (let ((start (point-min))) | 1265 | (let ((start (point-min))) |
| @@ -1530,9 +1268,9 @@ and point after it." | |||
| 1530 | (expand-file-name message (mh-expand-file-name folder))) | 1268 | (expand-file-name message (mh-expand-file-name folder))) |
| 1531 | (when (not verbatim) | 1269 | (when (not verbatim) |
| 1532 | (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) | 1270 | (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) |
| 1533 | (goto-char (point-max)) ;Needed for sc-cite-original | 1271 | (goto-char (point-max)) ;Needed for sc-cite-original |
| 1534 | (push-mark) ;Needed for sc-cite-original | 1272 | (push-mark) ;Needed for sc-cite-original |
| 1535 | (goto-char (point-min)) ;Needed for sc-cite-original | 1273 | (goto-char (point-min)) ;Needed for sc-cite-original |
| 1536 | (mh-insert-prefix-string mh-ins-buf-prefix))))) | 1274 | (mh-insert-prefix-string mh-ins-buf-prefix))))) |
| 1537 | 1275 | ||
| 1538 | (defun mh-extract-from-attribution () | 1276 | (defun mh-extract-from-attribution () |
| @@ -1553,6 +1291,7 @@ and point after it." | |||
| 1553 | ((looking-at " *\\(.+\\)$") | 1291 | ((looking-at " *\\(.+\\)$") |
| 1554 | (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)))))) | 1292 | (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)))))) |
| 1555 | 1293 | ||
| 1294 | ;;;###mh-autoload | ||
| 1556 | (defun mh-yank-cur-msg () | 1295 | (defun mh-yank-cur-msg () |
| 1557 | "Insert the current message into the draft buffer. | 1296 | "Insert the current message into the draft buffer. |
| 1558 | Prefix each non-blank line in the message with the string in | 1297 | Prefix each non-blank line in the message with the string in |
| @@ -1569,13 +1308,13 @@ yanked message will be deleted." | |||
| 1569 | (get-buffer mh-show-buffer)) | 1308 | (get-buffer mh-show-buffer)) |
| 1570 | mh-sent-from-msg) | 1309 | mh-sent-from-msg) |
| 1571 | (let ((to-point (point)) | 1310 | (let ((to-point (point)) |
| 1572 | (to-buffer (current-buffer))) | 1311 | (to-buffer (current-buffer))) |
| 1573 | (set-buffer mh-sent-from-folder) | 1312 | (set-buffer mh-sent-from-folder) |
| 1574 | (if mh-delete-yanked-msg-window-flag | 1313 | (if mh-delete-yanked-msg-window-flag |
| 1575 | (delete-windows-on mh-show-buffer)) | 1314 | (delete-windows-on mh-show-buffer)) |
| 1576 | (set-buffer mh-show-buffer) ; Find displayed message | 1315 | (set-buffer mh-show-buffer) ; Find displayed message |
| 1577 | (let* ((from-attr (mh-extract-from-attribution)) | 1316 | (let* ((from-attr (mh-extract-from-attribution)) |
| 1578 | (yank-region (mh-mark-active-p nil)) | 1317 | (yank-region (mh-mark-active-p nil)) |
| 1579 | (mh-ins-str | 1318 | (mh-ins-str |
| 1580 | (cond ((and yank-region | 1319 | (cond ((and yank-region |
| 1581 | (or (eq 'supercite mh-yank-from-start-of-msg) | 1320 | (or (eq 'supercite mh-yank-from-start-of-msg) |
| @@ -1605,26 +1344,26 @@ yanked message will be deleted." | |||
| 1605 | (buffer-substring (point-min) (point-max))) | 1344 | (buffer-substring (point-min) (point-max))) |
| 1606 | (t | 1345 | (t |
| 1607 | (buffer-substring (point) (point-max)))))) | 1346 | (buffer-substring (point) (point-max)))))) |
| 1608 | (set-buffer to-buffer) | 1347 | (set-buffer to-buffer) |
| 1609 | (save-restriction | 1348 | (save-restriction |
| 1610 | (narrow-to-region to-point to-point) | 1349 | (narrow-to-region to-point to-point) |
| 1611 | (insert (mh-filter-out-non-text mh-ins-str)) | 1350 | (insert (mh-filter-out-non-text mh-ins-str)) |
| 1612 | (goto-char (point-max)) ;Needed for sc-cite-original | 1351 | (goto-char (point-max)) ;Needed for sc-cite-original |
| 1613 | (push-mark) ;Needed for sc-cite-original | 1352 | (push-mark) ;Needed for sc-cite-original |
| 1614 | (goto-char (point-min)) ;Needed for sc-cite-original | 1353 | (goto-char (point-min)) ;Needed for sc-cite-original |
| 1615 | (mh-insert-prefix-string mh-ins-buf-prefix) | 1354 | (mh-insert-prefix-string mh-ins-buf-prefix) |
| 1616 | (if (or (eq 'attribution mh-yank-from-start-of-msg) | 1355 | (if (or (eq 'attribution mh-yank-from-start-of-msg) |
| 1617 | (eq 'autoattrib mh-yank-from-start-of-msg)) | 1356 | (eq 'autoattrib mh-yank-from-start-of-msg)) |
| 1618 | (insert from-attr "\n\n")) | 1357 | (insert from-attr "\n\n")) |
| 1619 | ;; If the user has selected a region, he has already "edited" the | 1358 | ;; If the user has selected a region, he has already "edited" the |
| 1620 | ;; text, so leave the cursor at the end of the yanked text. In | 1359 | ;; text, so leave the cursor at the end of the yanked text. In |
| 1621 | ;; either case, leave a mark at the opposite end of the included | 1360 | ;; either case, leave a mark at the opposite end of the included |
| 1622 | ;; text to make it easy to jump or delete to the other end of the | 1361 | ;; text to make it easy to jump or delete to the other end of the |
| 1623 | ;; text. | 1362 | ;; text. |
| 1624 | (push-mark) | 1363 | (push-mark) |
| 1625 | (goto-char (point-max)) | 1364 | (goto-char (point-max)) |
| 1626 | (if (null yank-region) | 1365 | (if (null yank-region) |
| 1627 | (mh-exchange-point-and-mark-preserving-active-mark))))) | 1366 | (mh-exchange-point-and-mark-preserving-active-mark))))) |
| 1628 | (error "There is no current message"))) | 1367 | (error "There is no current message"))) |
| 1629 | 1368 | ||
| 1630 | (defun mh-filter-out-non-text (string) | 1369 | (defun mh-filter-out-non-text (string) |
| @@ -1640,8 +1379,7 @@ yanked message will be deleted." | |||
| 1640 | (while can-move-forward | 1379 | (while can-move-forward |
| 1641 | (cond ((and (not (get-text-property (point) 'mh-data)) | 1380 | (cond ((and (not (get-text-property (point) 'mh-data)) |
| 1642 | in-button) | 1381 | in-button) |
| 1643 | (delete-region (save-excursion (forward-line -1) (point)) | 1382 | (delete-region (1- (point)) (point)) |
| 1644 | (point)) | ||
| 1645 | (setq in-button nil)) | 1383 | (setq in-button nil)) |
| 1646 | ((get-text-property (point) 'mh-data) | 1384 | ((get-text-property (point) 'mh-data) |
| 1647 | (delete-region (point) | 1385 | (delete-region (point) |
| @@ -1663,29 +1401,30 @@ simply insert MH-INS-STRING before each line." | |||
| 1663 | (eq mh-yank-from-start-of-msg 'autosupercite)) | 1401 | (eq mh-yank-from-start-of-msg 'autosupercite)) |
| 1664 | (sc-cite-original)) | 1402 | (sc-cite-original)) |
| 1665 | (mail-citation-hook | 1403 | (mail-citation-hook |
| 1666 | (run-hooks 'mail-citation-hook)) | 1404 | (run-hooks 'mail-citation-hook)) |
| 1667 | (mh-yank-hooks ;old hook name | 1405 | (mh-yank-hooks ;old hook name |
| 1668 | (run-hooks 'mh-yank-hooks)) | 1406 | (run-hooks 'mh-yank-hooks)) |
| 1669 | (t | 1407 | (t |
| 1670 | (or (bolp) (forward-line 1)) | 1408 | (or (bolp) (forward-line 1)) |
| 1671 | (while (< (point) (point-max)) | 1409 | (while (< (point) (point-max)) |
| 1672 | (insert mh-ins-string) | 1410 | (insert mh-ins-string) |
| 1673 | (forward-line 1)) | 1411 | (forward-line 1)) |
| 1674 | (goto-char (point-min))))) ;leave point like sc-cite-original | 1412 | (goto-char (point-min))))) ;leave point like sc-cite-original |
| 1675 | 1413 | ||
| 1414 | ;;;###mh-autoload | ||
| 1676 | (defun mh-fully-kill-draft () | 1415 | (defun mh-fully-kill-draft () |
| 1677 | "Kill the draft message file and the draft message buffer. | 1416 | "Kill the draft message file and the draft message buffer. |
| 1678 | Use \\[kill-buffer] if you don't want to delete the draft message file." | 1417 | Use \\[kill-buffer] if you don't want to delete the draft message file." |
| 1679 | (interactive) | 1418 | (interactive) |
| 1680 | (if (y-or-n-p "Kill draft message? ") | 1419 | (if (y-or-n-p "Kill draft message? ") |
| 1681 | (let ((config mh-previous-window-config)) | 1420 | (let ((config mh-previous-window-config)) |
| 1682 | (if (file-exists-p buffer-file-name) | 1421 | (if (file-exists-p buffer-file-name) |
| 1683 | (delete-file buffer-file-name)) | 1422 | (delete-file buffer-file-name)) |
| 1684 | (set-buffer-modified-p nil) | 1423 | (set-buffer-modified-p nil) |
| 1685 | (kill-buffer (buffer-name)) | 1424 | (kill-buffer (buffer-name)) |
| 1686 | (message "") | 1425 | (message "") |
| 1687 | (if config | 1426 | (if config |
| 1688 | (set-window-configuration config))) | 1427 | (set-window-configuration config))) |
| 1689 | (error "Message not killed"))) | 1428 | (error "Message not killed"))) |
| 1690 | 1429 | ||
| 1691 | (defun mh-current-fill-prefix () | 1430 | (defun mh-current-fill-prefix () |
| @@ -1700,6 +1439,7 @@ Use \\[kill-buffer] if you don't want to delete the draft message file." | |||
| 1700 | (match-string 0) | 1439 | (match-string 0) |
| 1701 | ""))) | 1440 | ""))) |
| 1702 | 1441 | ||
| 1442 | ;;;###mh-autoload | ||
| 1703 | (defun mh-open-line () | 1443 | (defun mh-open-line () |
| 1704 | "Insert a newline and leave point after it. | 1444 | "Insert a newline and leave point after it. |
| 1705 | In addition, insert newline and quoting characters before text after point. | 1445 | In addition, insert newline and quoting characters before text after point. |
| @@ -1715,57 +1455,70 @@ This is useful in breaking up paragraphs in replies." | |||
| 1715 | (insert " ")) | 1455 | (insert " ")) |
| 1716 | (forward-line -1)))) | 1456 | (forward-line -1)))) |
| 1717 | 1457 | ||
| 1458 | ;;;###mh-autoload | ||
| 1459 | (defun mh-letter-complete (arg) | ||
| 1460 | "Perform completion on header field or word preceding point. | ||
| 1461 | Alias completion is done within the mail header on selected fields and | ||
| 1462 | by the function designated by `mh-letter-complete-function' elsewhere, | ||
| 1463 | passing the prefix ARG if any." | ||
| 1464 | (interactive "P") | ||
| 1465 | (let ((case-fold-search t)) | ||
| 1466 | (if (and (mh-in-header-p) | ||
| 1467 | (save-excursion | ||
| 1468 | (mh-header-field-beginning) | ||
| 1469 | (looking-at "^.*\\(to\\|cc\\|from\\):"))) | ||
| 1470 | (mh-alias-letter-expand-alias) | ||
| 1471 | (funcall mh-letter-complete-function arg)))) | ||
| 1472 | |||
| 1718 | ;;; Build the letter-mode keymap: | 1473 | ;;; Build the letter-mode keymap: |
| 1719 | ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. | 1474 | ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. |
| 1720 | (gnus-define-keys mh-letter-mode-map | 1475 | (gnus-define-keys mh-letter-mode-map |
| 1721 | "\C-c?" mh-help | 1476 | "\C-c?" mh-help |
| 1722 | "\C-c\C-c" mh-send-letter | 1477 | "\C-c\C-c" mh-send-letter |
| 1723 | "\C-c\C-e" mh-edit-mhn | 1478 | "\C-c\C-d" mh-insert-identity |
| 1724 | "\C-c\C-f\C-b" mh-to-field | 1479 | "\C-c\C-e" mh-edit-mhn |
| 1725 | "\C-c\C-f\C-c" mh-to-field | 1480 | "\C-c\C-f\C-b" mh-to-field |
| 1726 | "\C-c\C-f\C-d" mh-to-field | 1481 | "\C-c\C-f\C-c" mh-to-field |
| 1727 | "\C-c\C-f\C-f" mh-to-fcc | 1482 | "\C-c\C-f\C-d" mh-to-field |
| 1728 | "\C-c\C-f\C-r" mh-to-field | 1483 | "\C-c\C-f\C-f" mh-to-fcc |
| 1729 | "\C-c\C-f\C-s" mh-to-field | 1484 | "\C-c\C-f\C-r" mh-to-field |
| 1730 | "\C-c\C-f\C-t" mh-to-field | 1485 | "\C-c\C-f\C-s" mh-to-field |
| 1731 | "\C-c\C-fb" mh-to-field | 1486 | "\C-c\C-f\C-t" mh-to-field |
| 1732 | "\C-c\C-fc" mh-to-field | 1487 | "\C-c\C-fb" mh-to-field |
| 1733 | "\C-c\C-fd" mh-to-field | 1488 | "\C-c\C-fc" mh-to-field |
| 1734 | "\C-c\C-ff" mh-to-fcc | 1489 | "\C-c\C-fd" mh-to-field |
| 1735 | "\C-c\C-fr" mh-to-field | 1490 | "\C-c\C-ff" mh-to-fcc |
| 1736 | "\C-c\C-fs" mh-to-field | 1491 | "\C-c\C-fr" mh-to-field |
| 1737 | "\C-c\C-ft" mh-to-field | 1492 | "\C-c\C-fs" mh-to-field |
| 1738 | "\C-c\C-i" mh-insert-letter | 1493 | "\C-c\C-ft" mh-to-field |
| 1739 | "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime | 1494 | "\C-c\C-i" mh-insert-letter |
| 1740 | "\C-c\C-m\C-f" mh-compose-forward | 1495 | "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime |
| 1741 | "\C-c\C-m\C-i" mh-compose-insertion | 1496 | "\C-c\C-m\C-f" mh-compose-forward |
| 1742 | "\C-c\C-m\C-m" mh-mml-to-mime | 1497 | "\C-c\C-m\C-i" mh-compose-insertion |
| 1743 | "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime | 1498 | "\C-c\C-m\C-m" mh-mml-to-mime |
| 1744 | "\C-c\C-m\C-u" mh-revert-mhn-edit | 1499 | "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime |
| 1745 | "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime | 1500 | "\C-c\C-m\C-u" mh-revert-mhn-edit |
| 1746 | "\C-c\C-mf" mh-compose-forward | 1501 | "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime |
| 1747 | "\C-c\C-mi" mh-compose-insertion | 1502 | "\C-c\C-mf" mh-compose-forward |
| 1748 | "\C-c\C-mm" mh-mml-to-mime | 1503 | "\C-c\C-mi" mh-compose-insertion |
| 1749 | "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime | 1504 | "\C-c\C-mm" mh-mml-to-mime |
| 1750 | "\C-c\C-mu" mh-revert-mhn-edit | 1505 | "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime |
| 1751 | "\C-c\C-o" mh-open-line | 1506 | "\C-c\C-mu" mh-revert-mhn-edit |
| 1752 | "\C-c\C-q" mh-fully-kill-draft | 1507 | "\C-c\C-o" mh-open-line |
| 1753 | "\C-c\C-\\" mh-fully-kill-draft ;if no C-q | 1508 | "\C-c\C-q" mh-fully-kill-draft |
| 1754 | "\C-c\C-s" mh-insert-signature | 1509 | "\C-c\C-\\" mh-fully-kill-draft ;if no C-q |
| 1755 | "\C-c\C-^" mh-insert-signature ;if no C-s | 1510 | "\C-c\C-s" mh-insert-signature |
| 1756 | "\C-c\C-w" mh-check-whom | 1511 | "\C-c\C-^" mh-insert-signature ;if no C-s |
| 1757 | "\C-c\C-y" mh-yank-cur-msg) | 1512 | "\C-c\C-w" mh-check-whom |
| 1513 | "\C-c\C-y" mh-yank-cur-msg | ||
| 1514 | "\M-\t" mh-letter-complete) | ||
| 1758 | 1515 | ||
| 1759 | ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. | 1516 | ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. |
| 1760 | 1517 | ||
| 1761 | (defun mh-customize () | ||
| 1762 | "Customize MH-E variables." | ||
| 1763 | (interactive) | ||
| 1764 | (customize-group 'mh)) | ||
| 1765 | |||
| 1766 | (provide 'mh-comp) | 1518 | (provide 'mh-comp) |
| 1767 | 1519 | ||
| 1768 | ;;; Local Variables: | 1520 | ;;; Local Variables: |
| 1521 | ;;; indent-tabs-mode: nil | ||
| 1769 | ;;; sentence-end-double-space: nil | 1522 | ;;; sentence-end-double-space: nil |
| 1770 | ;;; End: | 1523 | ;;; End: |
| 1771 | 1524 | ||
diff --git a/lisp/mail/mh-customize.el b/lisp/mail/mh-customize.el new file mode 100644 index 00000000000..92b2b60f505 --- /dev/null +++ b/lisp/mail/mh-customize.el | |||
| @@ -0,0 +1,1751 @@ | |||
| 1 | ;;; mh-customize.el --- MH-E customization | ||
| 2 | |||
| 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Bill Wohler <wohler@newt.com> | ||
| 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> | ||
| 7 | ;; Keywords: mail | ||
| 8 | ;; See: mh-e.el | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 15 | ;; any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 25 | ;; Boston, MA 02111-1307, USA. | ||
| 26 | |||
| 27 | ;;; Commentary: | ||
| 28 | |||
| 29 | ;; All of the defgroups, defcustoms, and deffaces in MH-E are found here. This | ||
| 30 | ;; makes it possible to customize modules that aren't loaded yet. It also | ||
| 31 | ;; makes it easier to organize the customization groups. | ||
| 32 | |||
| 33 | ;; This file contains the following sections: | ||
| 34 | ;; | ||
| 35 | ;; 1. MH-E Customization Groups | ||
| 36 | ;; | ||
| 37 | ;; These are the customization group definitions. These are organized in a | ||
| 38 | ;; logical order. High-level, windows and toolbar, folder, message, | ||
| 39 | ;; composing and hooks. | ||
| 40 | ;; | ||
| 41 | ;; 2. MH-E Customization | ||
| 42 | ;; | ||
| 43 | ;; Here are the actual customization variables. There is a sub-section for | ||
| 44 | ;; each group in the MH-E Customization Groups section. Within each | ||
| 45 | ;; section, variables are sorted alphabetically. The manual section | ||
| 46 | ;; dictates which group a variable should be placed. New variables should | ||
| 47 | ;; be placed in the section where they would most likely be defined. | ||
| 48 | ;; | ||
| 49 | ;; All hooks should be placed in the 'mh-hook group; in addition, add the | ||
| 50 | ;; group in which the hook is defined in the manual (or, if it is new, | ||
| 51 | ;; where it would be defined). These two actions insures that the hooks | ||
| 52 | ;; appear last in each group. | ||
| 53 | ;; | ||
| 54 | ;; 3. Faces | ||
| 55 | |||
| 56 | ;;; Change Log: | ||
| 57 | |||
| 58 | ;; $Id: mh-customize.el,v 1.18 2003/01/08 00:45:37 wohler Exp $ | ||
| 59 | |||
| 60 | ;;; Code: | ||
| 61 | |||
| 62 | ;;;###mh-autoload | ||
| 63 | (defun mh-customize () | ||
| 64 | "Customize MH-E variables." | ||
| 65 | (interactive) | ||
| 66 | (customize-group 'mh)) | ||
| 67 | |||
| 68 | ;;; MH-E Customization Groups | ||
| 69 | |||
| 70 | (defgroup mh nil | ||
| 71 | "GNU Emacs interface to the MH mail system." | ||
| 72 | :link '(custom-manual "(mh-e)Top") | ||
| 73 | :group 'mail) | ||
| 74 | |||
| 75 | (defgroup mh-toolbar nil | ||
| 76 | "Toolbar configuration." | ||
| 77 | :prefix "mh-" | ||
| 78 | :group 'mh) | ||
| 79 | |||
| 80 | (defgroup mh-speed nil | ||
| 81 | "Speedbar and folder configuration." | ||
| 82 | :prefix "mh-" | ||
| 83 | :link '(custom-manual "(mh-e)Customizing Moving Mail") | ||
| 84 | :group 'mh) | ||
| 85 | |||
| 86 | (defgroup mh-folder nil | ||
| 87 | "Options for controlling scan listing." | ||
| 88 | :prefix "mh-" | ||
| 89 | :link '(custom-manual "(mh-e)Customizing Moving Mail") | ||
| 90 | :group 'mh) | ||
| 91 | |||
| 92 | (defgroup mh-show nil | ||
| 93 | "Message display." | ||
| 94 | :prefix "mh-" | ||
| 95 | :link '(custom-manual "(mh-e)Customizing Reading") | ||
| 96 | :group 'mh) | ||
| 97 | |||
| 98 | (defgroup mh-letter nil | ||
| 99 | "Composing messages." | ||
| 100 | :prefix "mh-" | ||
| 101 | :link '(custom-manual "(mh-e)Customizing Sending") | ||
| 102 | :group 'mh) | ||
| 103 | |||
| 104 | (defgroup mh-alias nil | ||
| 105 | "Alias handling." | ||
| 106 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 107 | :prefix "mh-alias-" | ||
| 108 | :group 'mh) | ||
| 109 | |||
| 110 | (defgroup mh-index nil | ||
| 111 | "Indexed searching." | ||
| 112 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 113 | :prefix "mh-" | ||
| 114 | :group 'mh) | ||
| 115 | |||
| 116 | (defgroup mh-identity nil | ||
| 117 | "Multiple personalities." | ||
| 118 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 119 | :prefix "mh-" | ||
| 120 | :group 'mh) | ||
| 121 | |||
| 122 | (defgroup mh-faces nil | ||
| 123 | "Faces used in MH-E." | ||
| 124 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 125 | :prefix "mh-" | ||
| 126 | :group 'faces | ||
| 127 | :group 'mh) | ||
| 128 | |||
| 129 | (defgroup mh-hooks nil | ||
| 130 | "MH-E hooks." | ||
| 131 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 132 | :prefix "mh-" | ||
| 133 | :group 'mh) | ||
| 134 | |||
| 135 | ;;; Faces | ||
| 136 | |||
| 137 | (defgroup mh-speed-faces nil | ||
| 138 | "Faces used in speedbar." | ||
| 139 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 140 | :prefix "mh-" | ||
| 141 | :group 'mh-faces | ||
| 142 | :group 'mh-speed) | ||
| 143 | |||
| 144 | (defgroup mh-folder-faces nil | ||
| 145 | "Faces used in scan listing." | ||
| 146 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 147 | :prefix "mh-" | ||
| 148 | :group 'mh-faces | ||
| 149 | :group 'mh-folder) | ||
| 150 | |||
| 151 | (defgroup mh-show-faces nil | ||
| 152 | "Faces used in message display." | ||
| 153 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 154 | :prefix "mh-" | ||
| 155 | :group 'mh-faces | ||
| 156 | :group 'mh-show) | ||
| 157 | |||
| 158 | (defgroup mh-index-faces nil | ||
| 159 | "Faces used in indexed searches." | ||
| 160 | :link '(custom-manual "(mh-e)Customizing mh-e") | ||
| 161 | :prefix "mh-" | ||
| 162 | :group 'mh-faces | ||
| 163 | :group 'mh-index) | ||
| 164 | |||
| 165 | |||
| 166 | |||
| 167 | ;;; MH-E Customization (:group mh) | ||
| 168 | |||
| 169 | ;;; Toolbar configuration (:group 'mh-toolbar) | ||
| 170 | |||
| 171 | (defconst mh-tool-bar-item-inc "Incorporate new mail in Inbox") | ||
| 172 | (defconst mh-tool-bar-item-save-mime "Save MIME parts") | ||
| 173 | (defconst mh-tool-bar-item-prev-msg "Previous message") | ||
| 174 | (defconst mh-tool-bar-item-page-msg "Page this message") | ||
| 175 | (defconst mh-tool-bar-item-next-msg "Next message") | ||
| 176 | (defconst mh-tool-bar-item-delete "Mark for deletion") | ||
| 177 | (defconst mh-tool-bar-item-refile "Refile this message") | ||
| 178 | (defconst mh-tool-bar-item-undo "Undo this mark") | ||
| 179 | (defconst mh-tool-bar-item-perform "Perform moves and deletes") | ||
| 180 | (defconst mh-tool-bar-item-toggle-show "Toggle showing message") | ||
| 181 | (defconst mh-tool-bar-item-reply-from "Reply to \"from\"") | ||
| 182 | (defconst mh-tool-bar-item-reply-to "Reply to \"to\"") | ||
| 183 | (defconst mh-tool-bar-item-reply-all "Reply to \"all\"") | ||
| 184 | (defconst mh-tool-bar-item-reply "Reply to this message") | ||
| 185 | (defconst mh-tool-bar-item-alias "Grab From alias") | ||
| 186 | (defconst mh-tool-bar-item-compose "Compose new message") | ||
| 187 | (defconst mh-tool-bar-item-rescan "Rescan this folder") | ||
| 188 | (defconst mh-tool-bar-item-repack "Repack this folder") | ||
| 189 | (defconst mh-tool-bar-item-search "Search") | ||
| 190 | (defconst mh-tool-bar-item-visit "Visit other folder") | ||
| 191 | (defconst mh-tool-bar-item-prefs "MH-E preferences") | ||
| 192 | (defconst mh-tool-bar-item-help "Help") | ||
| 193 | (defconst mh-tool-bar-item-widen "Widen from this sequence") | ||
| 194 | |||
| 195 | (defconst mh-tool-bar-item-send "Send this letter") | ||
| 196 | (defconst mh-tool-bar-item-attach "Insert attachment") | ||
| 197 | (defconst mh-tool-bar-item-spell "Check spelling") | ||
| 198 | (defconst mh-tool-bar-item-save "Save current buffer to its file") | ||
| 199 | (defconst mh-tool-bar-item-undo-op "Undo last operation") | ||
| 200 | (defconst mh-tool-bar-item-kill | ||
| 201 | "Cut (kill) text in region between mark and current position") | ||
| 202 | (defconst mh-tool-bar-item-copy | ||
| 203 | "Copy text in region between mark and current position") | ||
| 204 | (defconst mh-tool-bar-item-paste | ||
| 205 | "Paste (yank) text cut or copied earlier") | ||
| 206 | (defconst mh-tool-bar-item-kill-draft "Kill this draft") | ||
| 207 | (defconst mh-tool-bar-item-comp-prefs "MH-E composition preferences") | ||
| 208 | |||
| 209 | (defcustom mh-tool-bar-reply-3-buttons-flag nil | ||
| 210 | "*Non-nil means use three buttons for reply commands in tool-bar. | ||
| 211 | If you have room on your tool-bar because you are using a large font, you | ||
| 212 | may set this variable to expand the single reply button into three buttons | ||
| 213 | that won't lead to minibuffer prompt about who to reply to." | ||
| 214 | :type 'boolean | ||
| 215 | :group 'mh-toolbar) | ||
| 216 | |||
| 217 | (defcustom mh-tool-bar-search-function 'mh-search-folder | ||
| 218 | "*Function called by the tool-bar search button. | ||
| 219 | See `mh-search-folder' and `mh-index-search' for details." | ||
| 220 | :type '(choice (const mh-search-folder) | ||
| 221 | (const mh-index-search) | ||
| 222 | (function :tag "Other function")) | ||
| 223 | :group 'mh-toolbar) | ||
| 224 | |||
| 225 | (eval-when-compile (defvar tool-bar-map)) | ||
| 226 | (defvar mh-show-tool-bar-map nil) | ||
| 227 | (defun mh-tool-bar-show-set () | ||
| 228 | "Construct toolbar for `mh-show-mode'." | ||
| 229 | (when (fboundp 'tool-bar-add-item) | ||
| 230 | (setq | ||
| 231 | mh-show-tool-bar-map | ||
| 232 | (let ((tool-bar-map (make-sparse-keymap))) | ||
| 233 | (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons) | ||
| 234 | (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder | ||
| 235 | :help mh-tool-bar-item-inc)) | ||
| 236 | (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons) | ||
| 237 | (tool-bar-add-item "attach" 'mh-mime-save-parts | ||
| 238 | 'mh-showtoolbar-mime-save-parts | ||
| 239 | :help mh-tool-bar-item-save-mime)) | ||
| 240 | (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons) | ||
| 241 | (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg | ||
| 242 | 'mh-showtoolbar-prev | ||
| 243 | :help mh-tool-bar-item-prev-msg)) | ||
| 244 | (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons) | ||
| 245 | (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page | ||
| 246 | :help mh-tool-bar-item-page-msg)) | ||
| 247 | (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons) | ||
| 248 | (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg | ||
| 249 | 'mh-showtoolbar-next | ||
| 250 | :help mh-tool-bar-item-next-msg)) | ||
| 251 | (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons) | ||
| 252 | (tool-bar-add-item "close" 'mh-show-delete-msg | ||
| 253 | 'mh-showtoolbar-delete | ||
| 254 | :help mh-tool-bar-item-delete)) | ||
| 255 | (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons) | ||
| 256 | (tool-bar-add-item "refile" 'mh-show-refile-msg | ||
| 257 | 'mh-showtoolbar-refile | ||
| 258 | :help mh-tool-bar-item-refile)) | ||
| 259 | (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons) | ||
| 260 | (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo | ||
| 261 | :help mh-tool-bar-item-undo)) | ||
| 262 | (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons) | ||
| 263 | (tool-bar-add-item "execute" 'mh-show-execute-commands | ||
| 264 | 'mh-showtoolbar-exec | ||
| 265 | :help mh-tool-bar-item-perform)) | ||
| 266 | (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons) | ||
| 267 | (tool-bar-add-item "show" 'mh-show-toggle-showing | ||
| 268 | 'mh-showtoolbar-toggle-show | ||
| 269 | :help mh-tool-bar-item-toggle-show)) | ||
| 270 | (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons) | ||
| 271 | (tool-bar-add-item "reply-from" | ||
| 272 | (lambda (&optional arg) | ||
| 273 | (interactive "P") | ||
| 274 | (set-buffer mh-show-folder-buffer) | ||
| 275 | (mh-reply (mh-get-msg-num nil) "from" arg)) | ||
| 276 | 'mh-showtoolbar-reply-from | ||
| 277 | :help mh-tool-bar-item-reply-from)) | ||
| 278 | (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons) | ||
| 279 | (tool-bar-add-item "reply-to" | ||
| 280 | (lambda (&optional arg) | ||
| 281 | (interactive "P") | ||
| 282 | (set-buffer mh-show-folder-buffer) | ||
| 283 | (mh-reply (mh-get-msg-num nil) "to" arg)) | ||
| 284 | 'mh-showtoolbar-reply-to | ||
| 285 | :help mh-tool-bar-item-reply-to)) | ||
| 286 | (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons) | ||
| 287 | (tool-bar-add-item "reply-all" | ||
| 288 | (lambda (&optional arg) | ||
| 289 | (interactive "P") | ||
| 290 | (set-buffer mh-show-folder-buffer) | ||
| 291 | (mh-reply (mh-get-msg-num nil) "all" arg)) | ||
| 292 | 'mh-showtoolbar-reply-all | ||
| 293 | :help mh-tool-bar-item-reply-all)) | ||
| 294 | (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons) | ||
| 295 | (tool-bar-add-item "mail/reply2" 'mh-show-reply | ||
| 296 | 'mh-showtoolbar-reply | ||
| 297 | :help mh-tool-bar-item-reply)) | ||
| 298 | (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons) | ||
| 299 | (tool-bar-add-item "alias" 'mh-alias-grab-from-field | ||
| 300 | 'mh-showtoolbar-alias | ||
| 301 | :help mh-tool-bar-item-alias | ||
| 302 | :enable '(mh-alias-from-has-no-alias-p))) | ||
| 303 | (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons) | ||
| 304 | (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose | ||
| 305 | :help mh-tool-bar-item-compose)) | ||
| 306 | (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons) | ||
| 307 | (tool-bar-add-item "rescan" 'mh-show-rescan-folder | ||
| 308 | 'mh-showtoolbar-rescan | ||
| 309 | :help mh-tool-bar-item-rescan)) | ||
| 310 | (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons) | ||
| 311 | (tool-bar-add-item "repack" 'mh-show-pack-folder | ||
| 312 | 'mh-showtoolbar-pack | ||
| 313 | :help mh-tool-bar-item-repack)) | ||
| 314 | (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons) | ||
| 315 | (tool-bar-add-item "search" | ||
| 316 | (lambda (&optional arg) | ||
| 317 | (interactive "P") | ||
| 318 | (call-interactively | ||
| 319 | mh-tool-bar-search-function)) | ||
| 320 | 'mh-showtoolbar-search | ||
| 321 | :help mh-tool-bar-item-search)) | ||
| 322 | (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons) | ||
| 323 | (tool-bar-add-item "fld_open" 'mh-visit-folder | ||
| 324 | 'mh-showtoolbar-visit | ||
| 325 | :help mh-tool-bar-item-visit)) | ||
| 326 | (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons) | ||
| 327 | (tool-bar-add-item "preferences" (lambda () | ||
| 328 | (interactive) | ||
| 329 | (customize-group "mh")) | ||
| 330 | 'mh-showtoolbar-customize | ||
| 331 | :help mh-tool-bar-item-prefs)) | ||
| 332 | (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons) | ||
| 333 | (tool-bar-add-item "help" (lambda () | ||
| 334 | (interactive) | ||
| 335 | (Info-goto-node "(mh-e)Top")) | ||
| 336 | 'mh-showtoolbar-help | ||
| 337 | :help mh-tool-bar-item-help)) | ||
| 338 | tool-bar-map)))) | ||
| 339 | |||
| 340 | (defvar mh-letter-tool-bar-map nil) | ||
| 341 | ;;;###mh-autoload | ||
| 342 | (defun mh-tool-bar-letter-set () | ||
| 343 | "Construct toolbar for `mh-letter-mode'." | ||
| 344 | (when (fboundp 'tool-bar-add-item) | ||
| 345 | (setq | ||
| 346 | mh-letter-tool-bar-map | ||
| 347 | (let ((tool-bar-map (make-sparse-keymap))) | ||
| 348 | (if (member mh-tool-bar-item-send mh-tool-bar-letter-buttons) | ||
| 349 | (tool-bar-add-item "mail_send" 'mh-send-letter | ||
| 350 | 'mh-lettertoolbar-send | ||
| 351 | :help mh-tool-bar-item-send)) | ||
| 352 | (if (member mh-tool-bar-item-attach mh-tool-bar-letter-buttons) | ||
| 353 | (tool-bar-add-item "attach" 'mh-compose-insertion | ||
| 354 | 'mh-lettertoolbar-compose | ||
| 355 | :help mh-tool-bar-item-attach)) | ||
| 356 | (if (member mh-tool-bar-item-spell mh-tool-bar-letter-buttons) | ||
| 357 | (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell | ||
| 358 | :help mh-tool-bar-item-spell)) | ||
| 359 | (if (member mh-tool-bar-item-save mh-tool-bar-letter-buttons) | ||
| 360 | (tool-bar-add-item-from-menu 'save-buffer "save")) | ||
| 361 | (if (member mh-tool-bar-item-undo-op mh-tool-bar-letter-buttons) | ||
| 362 | (tool-bar-add-item-from-menu 'undo "undo")) | ||
| 363 | (if (member mh-tool-bar-item-kill mh-tool-bar-letter-buttons) | ||
| 364 | (tool-bar-add-item-from-menu 'kill-region "cut")) | ||
| 365 | (if (member mh-tool-bar-item-copy mh-tool-bar-letter-buttons) | ||
| 366 | (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")) | ||
| 367 | (if (member mh-tool-bar-item-paste mh-tool-bar-letter-buttons) | ||
| 368 | (tool-bar-add-item-from-menu 'yank "paste")) | ||
| 369 | (if (member mh-tool-bar-item-kill-draft mh-tool-bar-letter-buttons) | ||
| 370 | (tool-bar-add-item "close" 'mh-fully-kill-draft | ||
| 371 | 'mh-lettertoolbar-kill | ||
| 372 | :help mh-tool-bar-item-kill-draft)) | ||
| 373 | (if (member mh-tool-bar-item-comp-prefs mh-tool-bar-letter-buttons) | ||
| 374 | (tool-bar-add-item "preferences" (lambda () | ||
| 375 | (interactive) | ||
| 376 | (customize-group "mh-compose")) | ||
| 377 | 'mh-lettertoolbar-customize | ||
| 378 | :help mh-tool-bar-item-comp-prefs)) | ||
| 379 | (if (member mh-tool-bar-item-help mh-tool-bar-letter-buttons) | ||
| 380 | (tool-bar-add-item "help" (lambda () | ||
| 381 | (interactive) | ||
| 382 | (Info-goto-node "(mh-e)Draft Editing")) | ||
| 383 | 'mh-lettertoolbar-help | ||
| 384 | :help mh-tool-bar-item-help)) | ||
| 385 | tool-bar-map)))) | ||
| 386 | |||
| 387 | (defvar mh-folder-tool-bar-map nil) | ||
| 388 | (defvar mh-folder-seq-tool-bar-map nil | ||
| 389 | "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.") | ||
| 390 | ;;;###mh-autoload | ||
| 391 | (defun mh-tool-bar-folder-set () | ||
| 392 | "Construct toolbar for `mh-folder-mode'." | ||
| 393 | (when (fboundp 'tool-bar-add-item) | ||
| 394 | (setq | ||
| 395 | mh-folder-tool-bar-map | ||
| 396 | (let ((tool-bar-map (make-sparse-keymap))) | ||
| 397 | (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons) | ||
| 398 | (tool-bar-add-item "mail" 'mh-inc-folder | ||
| 399 | 'mh-foldertoolbar-inc-folder | ||
| 400 | :help mh-tool-bar-item-inc)) | ||
| 401 | (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons) | ||
| 402 | (tool-bar-add-item "attach" 'mh-mime-save-parts | ||
| 403 | 'mh-foldertoolbar-mime-save-parts | ||
| 404 | :help mh-tool-bar-item-save-mime)) | ||
| 405 | (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons) | ||
| 406 | (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg | ||
| 407 | 'mh-foldertoolbar-prev | ||
| 408 | :help mh-tool-bar-item-prev-msg)) | ||
| 409 | (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons) | ||
| 410 | (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page | ||
| 411 | :help mh-tool-bar-item-page-msg)) | ||
| 412 | (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons) | ||
| 413 | (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg | ||
| 414 | 'mh-foldertoolbar-next | ||
| 415 | :help mh-tool-bar-item-next-msg)) | ||
| 416 | (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons) | ||
| 417 | (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete | ||
| 418 | :help mh-tool-bar-item-delete)) | ||
| 419 | (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons) | ||
| 420 | (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile | ||
| 421 | :help mh-tool-bar-item-refile)) | ||
| 422 | (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons) | ||
| 423 | (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo | ||
| 424 | :help mh-tool-bar-item-undo)) | ||
| 425 | (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons) | ||
| 426 | (tool-bar-add-item "execute" 'mh-execute-commands | ||
| 427 | 'mh-foldertoolbar-exec | ||
| 428 | :help mh-tool-bar-item-perform)) | ||
| 429 | (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons) | ||
| 430 | (tool-bar-add-item "show" 'mh-toggle-showing | ||
| 431 | 'mh-foldertoolbar-toggle-show | ||
| 432 | :help mh-tool-bar-item-toggle-show)) | ||
| 433 | (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons) | ||
| 434 | (tool-bar-add-item "reply-from" | ||
| 435 | (lambda (&optional arg) | ||
| 436 | (interactive "P") | ||
| 437 | (mh-reply (mh-get-msg-num nil) "from" arg)) | ||
| 438 | 'mh-foldertoolbar-reply-from | ||
| 439 | :help mh-tool-bar-item-reply-from)) | ||
| 440 | (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons) | ||
| 441 | (tool-bar-add-item "reply-to" | ||
| 442 | (lambda (&optional arg) | ||
| 443 | (interactive "P") | ||
| 444 | (mh-reply (mh-get-msg-num nil) "to" arg)) | ||
| 445 | 'mh-foldertoolbar-reply-to | ||
| 446 | :help mh-tool-bar-item-reply-to)) | ||
| 447 | (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons) | ||
| 448 | (tool-bar-add-item "reply-all" | ||
| 449 | (lambda (&optional arg) | ||
| 450 | (interactive "P") | ||
| 451 | (mh-reply (mh-get-msg-num nil) "all" arg)) | ||
| 452 | 'mh-foldertoolbar-reply-all | ||
| 453 | :help mh-tool-bar-item-reply-all)) | ||
| 454 | (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons) | ||
| 455 | (tool-bar-add-item "mail/reply2" 'mh-reply | ||
| 456 | 'mh-foldertoolbar-reply | ||
| 457 | :help mh-tool-bar-item-reply)) | ||
| 458 | (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons) | ||
| 459 | (tool-bar-add-item "alias" 'mh-alias-grab-from-field | ||
| 460 | 'mh-foldertoolbar-alias | ||
| 461 | :help mh-tool-bar-item-alias | ||
| 462 | :enable '(mh-alias-from-has-no-alias-p))) | ||
| 463 | (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons) | ||
| 464 | (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose | ||
| 465 | :help mh-tool-bar-item-compose)) | ||
| 466 | (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons) | ||
| 467 | (tool-bar-add-item "rescan" 'mh-rescan-folder | ||
| 468 | 'mh-foldertoolbar-rescan | ||
| 469 | :help mh-tool-bar-item-rescan)) | ||
| 470 | (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons) | ||
| 471 | (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack | ||
| 472 | :help mh-tool-bar-item-repack)) | ||
| 473 | (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons) | ||
| 474 | (tool-bar-add-item "search" | ||
| 475 | (lambda (&optional arg) | ||
| 476 | (interactive "P") | ||
| 477 | (call-interactively | ||
| 478 | mh-tool-bar-search-function)) | ||
| 479 | 'mh-foldertoolbar-search | ||
| 480 | :help mh-tool-bar-item-search)) | ||
| 481 | (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons) | ||
| 482 | (tool-bar-add-item "fld_open" 'mh-visit-folder | ||
| 483 | 'mh-foldertoolbar-visit | ||
| 484 | :help mh-tool-bar-item-visit)) | ||
| 485 | (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons) | ||
| 486 | (tool-bar-add-item "preferences" (lambda () | ||
| 487 | (interactive) | ||
| 488 | (customize-group "mh")) | ||
| 489 | 'mh-foldertoolbar-customize | ||
| 490 | :help mh-tool-bar-item-prefs)) | ||
| 491 | (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons) | ||
| 492 | (tool-bar-add-item "help" (lambda () | ||
| 493 | (interactive) | ||
| 494 | (Info-goto-node "(mh-e)Top")) | ||
| 495 | 'mh-foldertoolbar-help | ||
| 496 | :help mh-tool-bar-item-help)) | ||
| 497 | tool-bar-map)) | ||
| 498 | |||
| 499 | (setq mh-folder-seq-tool-bar-map | ||
| 500 | (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) | ||
| 501 | (if (member mh-tool-bar-item-widen mh-tool-bar-folder-buttons) | ||
| 502 | (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen | ||
| 503 | :help mh-tool-bar-item-widen)) | ||
| 504 | tool-bar-map)))) | ||
| 505 | |||
| 506 | (defun mh-tool-bar-folder-buttons-set (symbol value) | ||
| 507 | "Update the `mh-tool-bar-folder-buttons' variable, and rebuild the tool-bar. | ||
| 508 | Sets the default for SYMBOL (e.g. `mh-tool-bar-folder-buttons') to VALUE (as | ||
| 509 | set in customization). This is called after 'customize is used to alter | ||
| 510 | `mh-tool-bar-folder-buttons'." | ||
| 511 | (set-default symbol value) | ||
| 512 | (mh-tool-bar-show-set) | ||
| 513 | (mh-tool-bar-folder-set)) | ||
| 514 | |||
| 515 | (custom-declare-variable | ||
| 516 | 'mh-tool-bar-folder-buttons | ||
| 517 | '(append | ||
| 518 | (list mh-tool-bar-item-inc | ||
| 519 | mh-tool-bar-item-save-mime | ||
| 520 | mh-tool-bar-item-prev-msg | ||
| 521 | mh-tool-bar-item-page-msg | ||
| 522 | mh-tool-bar-item-next-msg | ||
| 523 | mh-tool-bar-item-delete | ||
| 524 | mh-tool-bar-item-refile | ||
| 525 | mh-tool-bar-item-undo | ||
| 526 | mh-tool-bar-item-perform | ||
| 527 | ;;; mh-tool-bar-item-toggle-show | ||
| 528 | ) | ||
| 529 | (if mh-tool-bar-reply-3-buttons-flag | ||
| 530 | (list mh-tool-bar-item-reply-from | ||
| 531 | mh-tool-bar-item-reply-to | ||
| 532 | mh-tool-bar-item-reply-all) | ||
| 533 | (list mh-tool-bar-item-reply)) | ||
| 534 | (list mh-tool-bar-item-alias | ||
| 535 | mh-tool-bar-item-compose | ||
| 536 | mh-tool-bar-item-rescan | ||
| 537 | ;;; mh-tool-bar-item-repack | ||
| 538 | mh-tool-bar-item-search | ||
| 539 | mh-tool-bar-item-visit | ||
| 540 | mh-tool-bar-item-prefs | ||
| 541 | mh-tool-bar-item-help | ||
| 542 | mh-tool-bar-item-widen)) | ||
| 543 | "Buttons to include in MH-E folder/show toolbar." | ||
| 544 | :group 'mh-toolbar | ||
| 545 | :set 'mh-tool-bar-folder-buttons-set | ||
| 546 | :type `(set (const ,mh-tool-bar-item-inc) | ||
| 547 | (const ,mh-tool-bar-item-save-mime) | ||
| 548 | (const ,mh-tool-bar-item-prev-msg) | ||
| 549 | (const ,mh-tool-bar-item-page-msg) | ||
| 550 | (const ,mh-tool-bar-item-next-msg) | ||
| 551 | (const ,mh-tool-bar-item-delete) | ||
| 552 | (const ,mh-tool-bar-item-refile) | ||
| 553 | (const ,mh-tool-bar-item-undo) | ||
| 554 | (const ,mh-tool-bar-item-perform) | ||
| 555 | (const ,mh-tool-bar-item-toggle-show) | ||
| 556 | (const ,mh-tool-bar-item-reply-from) | ||
| 557 | (const ,mh-tool-bar-item-reply-to) | ||
| 558 | (const ,mh-tool-bar-item-reply-all) | ||
| 559 | (const ,mh-tool-bar-item-reply) | ||
| 560 | (const ,mh-tool-bar-item-alias) | ||
| 561 | (const ,mh-tool-bar-item-compose) | ||
| 562 | (const ,mh-tool-bar-item-rescan) | ||
| 563 | (const ,mh-tool-bar-item-repack) | ||
| 564 | (const ,mh-tool-bar-item-search) | ||
| 565 | (const ,mh-tool-bar-item-visit) | ||
| 566 | (const ,mh-tool-bar-item-prefs) | ||
| 567 | (const ,mh-tool-bar-item-help) | ||
| 568 | (const ,mh-tool-bar-item-widen))) | ||
| 569 | |||
| 570 | (defun mh-tool-bar-letter-buttons-set (symbol value) | ||
| 571 | "Update the `mh-tool-bar-letter-buttons' variable, and rebuild the tool-bar. | ||
| 572 | Sets the default for SYMBOL (e.g. `mh-tool-bar-letter-buttons') to VALUE (as | ||
| 573 | set in customization). This is called after 'customize is used to alter | ||
| 574 | `mh-tool-bar-letter-buttons'." | ||
| 575 | (set-default symbol value) | ||
| 576 | (mh-tool-bar-letter-set)) | ||
| 577 | |||
| 578 | (custom-declare-variable | ||
| 579 | 'mh-tool-bar-letter-buttons | ||
| 580 | '(list mh-tool-bar-item-send | ||
| 581 | mh-tool-bar-item-attach | ||
| 582 | mh-tool-bar-item-spell | ||
| 583 | mh-tool-bar-item-save | ||
| 584 | mh-tool-bar-item-undo-op | ||
| 585 | mh-tool-bar-item-kill | ||
| 586 | mh-tool-bar-item-copy | ||
| 587 | mh-tool-bar-item-paste | ||
| 588 | mh-tool-bar-item-kill-draft | ||
| 589 | mh-tool-bar-item-comp-prefs | ||
| 590 | mh-tool-bar-item-help) | ||
| 591 | "Buttons to include in MH-E letter toolbar." | ||
| 592 | :group 'mh-toolbar | ||
| 593 | :set 'mh-tool-bar-letter-buttons-set | ||
| 594 | :type `(set (const ,mh-tool-bar-item-send) | ||
| 595 | (const ,mh-tool-bar-item-attach) | ||
| 596 | (const ,mh-tool-bar-item-spell) | ||
| 597 | (const ,mh-tool-bar-item-save) | ||
| 598 | (const ,mh-tool-bar-item-undo-op) | ||
| 599 | (const ,mh-tool-bar-item-kill) | ||
| 600 | (const ,mh-tool-bar-item-copy) | ||
| 601 | (const ,mh-tool-bar-item-paste) | ||
| 602 | (const ,mh-tool-bar-item-kill-draft) | ||
| 603 | (const ,mh-tool-bar-item-comp-prefs) | ||
| 604 | (const ,mh-tool-bar-item-help))) | ||
| 605 | |||
| 606 | |||
| 607 | |||
| 608 | ;;; Speedbar and folder configuration (:group 'mh-speed) | ||
| 609 | |||
| 610 | (defcustom mh-large-folder 200 | ||
| 611 | "The number of messages that indicates a large folder. | ||
| 612 | If a folder is deemed to be large, that is the number of messages in it exceed | ||
| 613 | this value, then confirmation is needed when it is visited. Even when | ||
| 614 | `mh-show-threads-flag' is non-nil, the folder is not automatically threaded, if | ||
| 615 | it is large. If set to nil all folders are treated as if they are small." | ||
| 616 | :type '(choice (const :tag "No limit") integer) | ||
| 617 | :group 'mh-speed) | ||
| 618 | |||
| 619 | (defcustom mh-speed-flists-interval 60 | ||
| 620 | "Time between calls to flists in seconds. | ||
| 621 | If 0, flists is not called repeatedly." | ||
| 622 | :type 'integer | ||
| 623 | :group 'mh-speed) | ||
| 624 | |||
| 625 | (defcustom mh-speed-run-flists-flag t | ||
| 626 | "Non-nil means flists is used. | ||
| 627 | If non-nil, flists is executed every `mh-speed-flists-interval' seconds to | ||
| 628 | update the display of the number of unseen and total messages in each folder. | ||
| 629 | If resources are limited, this can be set to nil and the speedbar display can | ||
| 630 | be updated manually with the \\[mh-speed-flists] command." | ||
| 631 | :type 'boolean | ||
| 632 | :group 'mh-speed) | ||
| 633 | |||
| 634 | ;;; Options for controlling scan listing (:group 'mh-folder) | ||
| 635 | |||
| 636 | (defcustom mh-adaptive-cmd-note-flag t | ||
| 637 | "*Non-nil means that the message number width is determined dynamically. | ||
| 638 | This is done once when a folder is first opened by running scan on the last | ||
| 639 | message of the folder. The message number for the last message is extracted | ||
| 640 | and its width calculated. This width is used when calling `mh-set-cmd-note'. | ||
| 641 | |||
| 642 | If you prefer fixed-width message numbers, set this variable to nil and call | ||
| 643 | `mh-set-cmd-note' with the width specified by the scan format in | ||
| 644 | `mh-scan-format-file'. For example, the default width is 4, so you would use | ||
| 645 | \"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil." | ||
| 646 | :type 'boolean | ||
| 647 | :group 'mh-folder) | ||
| 648 | |||
| 649 | (defcustom mh-auto-folder-collect-flag t | ||
| 650 | "*Non-nil means to collect all folder names at startup in the background. | ||
| 651 | Otherwise, the internal list of folder names is built as folders are | ||
| 652 | referenced." | ||
| 653 | :type 'boolean | ||
| 654 | :group 'mh-folder) | ||
| 655 | |||
| 656 | (defcustom mh-inc-prog "inc" | ||
| 657 | "*Program to run to incorporate new mail into a folder. | ||
| 658 | Normally \"inc\". This file is searched for relative to | ||
| 659 | the `mh-progs' directory unless it is an absolute pathname." | ||
| 660 | :type 'string | ||
| 661 | :group 'mh-folder) | ||
| 662 | |||
| 663 | (defcustom mh-lpr-command-format "lpr -J '%s'" | ||
| 664 | "*Format for Unix command that prints a message. | ||
| 665 | The string should be a Unix command line, with the string '%s' where | ||
| 666 | the job's name (folder and message number) should appear. The formatted | ||
| 667 | message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'." | ||
| 668 | :type 'string | ||
| 669 | :group 'mh-folder) | ||
| 670 | |||
| 671 | (defcustom mh-mime-save-parts-default-directory t | ||
| 672 | "Default directory to use for `mh-mime-save-parts'. | ||
| 673 | If nil, prompt and set for next time the command is used during same session. | ||
| 674 | If t, prompt always" | ||
| 675 | :type '(choice (const :tag "Prompt the first time" nil) | ||
| 676 | (const :tag "Prompt always" t) | ||
| 677 | directory) | ||
| 678 | :group 'mh-folder) | ||
| 679 | |||
| 680 | (defcustom mh-recenter-summary-flag nil | ||
| 681 | "*Non-nil means to recenter the summary window. | ||
| 682 | Recenter the summary window when the show window is toggled off if non-nil." | ||
| 683 | :type 'boolean | ||
| 684 | :group 'mh-folder) | ||
| 685 | |||
| 686 | (defcustom mh-print-background-flag nil | ||
| 687 | "*Non-nil means messages should be printed in the background. | ||
| 688 | WARNING: do not delete the messages until printing is finished; | ||
| 689 | otherwise, your output may be truncated." | ||
| 690 | :type 'boolean | ||
| 691 | :group 'mh-folder) | ||
| 692 | |||
| 693 | (defcustom mh-recursive-folders-flag nil | ||
| 694 | "*Non-nil means that commands which operate on folders do so recursively." | ||
| 695 | :type 'boolean | ||
| 696 | :group 'mh-folder) | ||
| 697 | |||
| 698 | (defcustom mh-scan-format-file t | ||
| 699 | "Specifies the format file to pass to the scan program. | ||
| 700 | If t, the format string will be taken from the either `mh-scan-format-mh' | ||
| 701 | or `mh-scan-format-nmh' depending on whether MH or nmh is in use. | ||
| 702 | If nil, the default scan output will be used. | ||
| 703 | |||
| 704 | If you customize the scan format, you may need to modify a few variables | ||
| 705 | containing regexps that MH-E uses to identify specific portions of the output. | ||
| 706 | Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You | ||
| 707 | may also have to call `mh-set-cmd-note' with the width of your message | ||
| 708 | numbers. See also `mh-adaptive-cmd-note-flag'." | ||
| 709 | :type '(choice (const :tag "Use MH-E scan format" t) | ||
| 710 | (const :tag "Use default scan format" nil) | ||
| 711 | (file :tag "Specify a scan format file")) | ||
| 712 | :group 'mh-folder) | ||
| 713 | |||
| 714 | (defcustom mh-scan-prog "scan" | ||
| 715 | "*Program to run to generate one-line-per-message listing of a folder. | ||
| 716 | Normally \"scan\" or a file name linked to scan. This file is searched | ||
| 717 | for relative to the `mh-progs' directory unless it is an absolute pathname." | ||
| 718 | :type 'string | ||
| 719 | :group 'mh-folder) | ||
| 720 | (make-variable-buffer-local 'mh-scan-prog) | ||
| 721 | |||
| 722 | (defcustom mh-show-threads-flag nil | ||
| 723 | "Non-nil means new folders start in threaded mode. | ||
| 724 | Threading large number of messages can be time consuming. So if the flag is | ||
| 725 | non-nil then threading will be done only if the number of messages being | ||
| 726 | threaded is less than `mh-large-folder'." | ||
| 727 | :type 'boolean | ||
| 728 | :group 'mh-folder) | ||
| 729 | |||
| 730 | (defcustom mh-store-default-directory nil | ||
| 731 | "*Last directory used by \\[mh-store-msg]; default for next store. | ||
| 732 | A directory name string, or nil to use current directory." | ||
| 733 | :type '(choice (const :tag "Current" nil) | ||
| 734 | directory) | ||
| 735 | :group 'mh-folder) | ||
| 736 | |||
| 737 | (defcustom mh-update-sequences-after-mh-show-flag t | ||
| 738 | "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'. | ||
| 739 | If set, `mh-update-sequence' is run every time a message is shown, telling | ||
| 740 | MH or nmh that this is your current message. It's useful, for example, to | ||
| 741 | display MIME content using \"M-! mhshow RET\"" | ||
| 742 | :type 'boolean | ||
| 743 | :group 'mh-folder) | ||
| 744 | |||
| 745 | ;;; Message display (:group 'mh-show) | ||
| 746 | |||
| 747 | (defcustom mh-bury-show-buffer-flag t | ||
| 748 | "*Non-nil means that the displayed show buffer for a folder is buried." | ||
| 749 | :type 'boolean | ||
| 750 | :group 'mh-show) | ||
| 751 | |||
| 752 | (defcustom mh-clean-message-header-flag t | ||
| 753 | "*Non-nil means clean headers of messages that are displayed or inserted. | ||
| 754 | The variables `mh-invisible-headers' and `mh-visible-headers' control | ||
| 755 | what is removed." | ||
| 756 | :type 'boolean | ||
| 757 | :group 'mh-show) | ||
| 758 | |||
| 759 | (defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode"))) | ||
| 760 | "*Non-nil means that Gnus is used to show MIME attachments with Gnus." | ||
| 761 | :type 'boolean | ||
| 762 | :group 'mh-show) | ||
| 763 | |||
| 764 | (defcustom mh-decode-quoted-printable-flag | ||
| 765 | (not (null (and (fboundp 'executable-find)(executable-find "mimedecode")))) | ||
| 766 | "Non-nil means decode quoted-printable MIME part with `mimedecode'. | ||
| 767 | |||
| 768 | Quoted-printable message parts are translated to 8-bit characters by the | ||
| 769 | `mimedecode' command. However, unless there is only one quoted-printable body | ||
| 770 | part, Gnus will have already decoded the quoted-printable parts. | ||
| 771 | |||
| 772 | This variable is initialized t if `mimedecode' is available. | ||
| 773 | |||
| 774 | The source code for `mimedecode' can be obtained from | ||
| 775 | http://www.freesoft.org/CIE/FAQ/mimedeco.c." | ||
| 776 | :type 'boolean | ||
| 777 | :group 'mh-show) | ||
| 778 | |||
| 779 | (defcustom mh-display-buttons-for-inline-parts-flag nil | ||
| 780 | "*Non-nil means display buttons for all inline MIME parts. | ||
| 781 | If non-nil, buttons are displayed for all MIME parts. Inline parts start off | ||
| 782 | in displayed state but they can be hidden by clicking the button. If nil no | ||
| 783 | buttons are shown for inline parts." | ||
| 784 | :type 'boolean | ||
| 785 | :group 'mh-show) | ||
| 786 | |||
| 787 | (defcustom mh-do-not-confirm-flag nil | ||
| 788 | "*Non-nil means do not prompt for confirmation. | ||
| 789 | Commands such as `mh-pack-folder' prompt to confirm whether to process | ||
| 790 | outstanding moves and deletes or not before continuing. A non-nil setting will | ||
| 791 | perform the action--which is usually desired but cannot be retracted--without | ||
| 792 | question." | ||
| 793 | :type 'boolean | ||
| 794 | :group 'mh-show) | ||
| 795 | |||
| 796 | (defcustom mh-graphical-smileys-flag t | ||
| 797 | "*Non-nil means graphical smileys are displayed. | ||
| 798 | Non-nil means that small graphics will be used in the show buffer instead of | ||
| 799 | patterns like :-), ;-) etc. The setting only has effect if | ||
| 800 | `mh-decode-mime-flag' is non-nil." | ||
| 801 | :type 'boolean | ||
| 802 | :group 'mh-show) | ||
| 803 | |||
| 804 | (defcustom mh-graphical-emphasis-flag t | ||
| 805 | "*Non-nil means graphical emphasis is displayed. | ||
| 806 | Non-nil means that _underline_ will be underlined, *bold* will appear in bold, | ||
| 807 | /italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole | ||
| 808 | list. The setting only has effect if `mh-decode-mime-flag' is non-nil." | ||
| 809 | :type 'boolean | ||
| 810 | :group 'mh-show) | ||
| 811 | |||
| 812 | (defcustom mh-highlight-citation-p 'gnus | ||
| 813 | "How to highlight citations in show buffers. | ||
| 814 | The gnus method uses a different color for each indentation." | ||
| 815 | :type '(choice (const :tag "Use gnus" gnus) | ||
| 816 | (const :tag "Use font-lock" font-lock) | ||
| 817 | (const :tag "Don't fontify" nil)) | ||
| 818 | :group 'mh-show) | ||
| 819 | |||
| 820 | (defcustom mh-max-inline-image-height nil | ||
| 821 | "*Maximum inline image height if Content-Disposition is not present. | ||
| 822 | If nil, image will be displayed if its height is smaller than the height of | ||
| 823 | the window." | ||
| 824 | :type '(choice (const nil) integer) | ||
| 825 | :group 'mh-show) | ||
| 826 | |||
| 827 | (defcustom mh-max-inline-image-width nil | ||
| 828 | "*Maximum inline image width if Content-Disposition is not present. | ||
| 829 | If nil, image will be displayed if its width is smaller than the width of the | ||
| 830 | window." | ||
| 831 | :type '(choice (const nil) integer) | ||
| 832 | :group 'mh-show) | ||
| 833 | |||
| 834 | (defcustom mh-show-maximum-size 0 | ||
| 835 | "*Maximum size of message (in bytes) to display automatically. | ||
| 836 | Provides an opportunity to skip over large messages which may be slow to load. | ||
| 837 | Use a value of 0 to display all messages automatically regardless of size." | ||
| 838 | :type 'integer | ||
| 839 | :group 'mh-show) | ||
| 840 | |||
| 841 | ;; Use goto-addr if it was already loaded (which probably sets this | ||
| 842 | ;; variable to t), or if this variable is otherwise set to t. | ||
| 843 | (defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p) | ||
| 844 | goto-address-highlight-p) | ||
| 845 | "*Non-nil means highlight URLs and email addresses. | ||
| 846 | The `goto-addr' module is used." | ||
| 847 | :type 'boolean | ||
| 848 | :group 'mh-show) | ||
| 849 | |||
| 850 | (defcustom mh-show-use-xface-flag | ||
| 851 | (and window-system | ||
| 852 | (not (null (cond | ||
| 853 | (mh-xemacs-flag | ||
| 854 | (locate-library "x-face")) | ||
| 855 | ((>= emacs-major-version 21) | ||
| 856 | (locate-library "x-face-e21")) | ||
| 857 | (t ;Emacs20 | ||
| 858 | nil)))) | ||
| 859 | (not (null (and (fboundp 'executable-find) | ||
| 860 | (executable-find | ||
| 861 | "uncompface"))))) | ||
| 862 | "*Non-nil means display faces in `mh-show-mode' with external x-face package. | ||
| 863 | It is available from ftp://ftp.jpl.org/pub/elisp/. Download it and put its | ||
| 864 | files in the Emacs `load-path' and MH-E will invoke it automatically for you if | ||
| 865 | this variable is non-nil. | ||
| 866 | |||
| 867 | The `uncompface' binary is also required to be in the execute PATH. It can | ||
| 868 | be obtained from: ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z" | ||
| 869 | :type 'boolean | ||
| 870 | :group 'mh-show) | ||
| 871 | |||
| 872 | (defcustom mh-summary-height (or (and (fboundp 'frame-height) | ||
| 873 | (> (frame-height) 24) | ||
| 874 | (min 10 (/ (frame-height) 6))) | ||
| 875 | 4) | ||
| 876 | "*Number of lines in MH-Folder window (including the mode line)." | ||
| 877 | :type 'integer | ||
| 878 | :group 'mh-show) | ||
| 879 | |||
| 880 | (defcustom mh-visible-headers nil | ||
| 881 | "*Contains a regexp specifying the headers to keep when cleaning. | ||
| 882 | Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides | ||
| 883 | the variable `mh-invisible-headers'." | ||
| 884 | :type '(choice (const nil) regexp) | ||
| 885 | :group 'mh-show) | ||
| 886 | |||
| 887 | (defcustom mhl-formfile nil | ||
| 888 | "*Name of format file to be used by mhl to show and print messages. | ||
| 889 | A value of t means use the default format file. | ||
| 890 | nil means don't use mhl to format messages when showing; mhl is still used, | ||
| 891 | with the default format file, to format messages when printing them. | ||
| 892 | The format used should specify a non-zero value for overflowoffset so | ||
| 893 | the message continues to conform to RFC 822 and MH-E can parse the headers." | ||
| 894 | :type '(choice (const nil) (const t) string) | ||
| 895 | :group 'mh-show) | ||
| 896 | (put 'mhl-formfile 'info-file "mh-e") | ||
| 897 | |||
| 898 | (defvar mh-invisible-headers nil | ||
| 899 | "*Regexp matching lines in a message header that are not to be shown. | ||
| 900 | If `mh-visible-headers' is non-nil, it is used instead to specify what | ||
| 901 | to keep.") | ||
| 902 | |||
| 903 | (defun mh-invisible-headers () | ||
| 904 | "Make or remake the variable `mh-invisible-headers'. | ||
| 905 | Done using `mh-invisible-header-fields' as input." | ||
| 906 | (setq mh-invisible-headers | ||
| 907 | (concat | ||
| 908 | "^" | ||
| 909 | (let ((max-specpdl-size 1000)) ;workaround for insufficient default | ||
| 910 | (regexp-opt | ||
| 911 | (append | ||
| 912 | (if (not mh-show-use-xface-flag) | ||
| 913 | '("X-Face: ")) | ||
| 914 | mh-invisible-header-fields)))))) | ||
| 915 | |||
| 916 | (defun mh-invisible-header-fields-set (symbol value) | ||
| 917 | "Update `mh-invisible-header-fields'. | ||
| 918 | The function is called with SYMBOL bound to `mh-invisible-header-fields' and | ||
| 919 | VALUE is the the list of headers that are invisible. As a side effect, the | ||
| 920 | variable `mh-invisible-fields' is set." | ||
| 921 | (set-default symbol value) | ||
| 922 | (mh-invisible-headers)) | ||
| 923 | |||
| 924 | ;; Keep fields alphabetized. Mention source, if known. | ||
| 925 | (defcustom mh-invisible-header-fields | ||
| 926 | '("Autoforwarded: " | ||
| 927 | "Bestservhost: " | ||
| 928 | "Content-" ; RFC 2045 | ||
| 929 | "Delivered-To: " ; Egroups/yahoogroups mailing list manager | ||
| 930 | "Delivery-Date: " ; MH | ||
| 931 | "Delivery: " | ||
| 932 | "Encoding: " | ||
| 933 | "Errors-To: " | ||
| 934 | "Forwarded: " ; MH | ||
| 935 | "From " ; sendmail | ||
| 936 | "Importance: " ; MS Outlook | ||
| 937 | "In-Reply-To: " ; MH | ||
| 938 | "Lines: " | ||
| 939 | "List-" ; Mailman mailing list manager | ||
| 940 | "List-" ; Unknown mailing list managers | ||
| 941 | "List-Subscribe: " ; Unknown mailing list managers | ||
| 942 | "List-Unsubscribe: " ; Unknown mailing list managers | ||
| 943 | "Mail-from: " ; MH | ||
| 944 | "Mailing-List: " ; Egroups/yahoogroups mailing list manager | ||
| 945 | "Message-Id: " ; RFC 822 | ||
| 946 | "Mime-Version" ; RFC 2045 | ||
| 947 | "NNTP-" ; News | ||
| 948 | "Old-Return-Path: " | ||
| 949 | "Original-Encoded-Information-Types: " ; X400 | ||
| 950 | "P1-Content-Type: " ; X400 | ||
| 951 | "P1-Message-Id: " ; X400 | ||
| 952 | "P1-Recipient: " ; X400 | ||
| 953 | "Path: " | ||
| 954 | "Precedence: " | ||
| 955 | "Prev-Resent" ; MH | ||
| 956 | "Priority: " | ||
| 957 | "Received: " ; RFC 822 | ||
| 958 | "References: " | ||
| 959 | "Remailed-" ; MH | ||
| 960 | "Replied: " ; MH | ||
| 961 | "Resent" ; MH | ||
| 962 | "Return-Path: " ; RFC 822 | ||
| 963 | "Sensitivity: " ; MS Outlook | ||
| 964 | "Status: " ; sendmail | ||
| 965 | "Ua-Content-Id: " ; X400 | ||
| 966 | "User-Agent: " | ||
| 967 | "Via: " ; MH | ||
| 968 | "X-Abuse-Info: " | ||
| 969 | "X-Accept-Language: " | ||
| 970 | "X-Accept-Language: " ; Netscape/Mozilla | ||
| 971 | "X-Ack: " | ||
| 972 | "X-Apparently-From: " ; MS Outlook | ||
| 973 | "X-Apparently-To: " ; Egroups/yahoogroups mailing list manager | ||
| 974 | "X-Authentication-Warning: " ; sendmail | ||
| 975 | "X-Beenthere: " ; Mailman mailing list manager | ||
| 976 | "X-Complaints-To: " | ||
| 977 | "X-Cron-Env: " | ||
| 978 | "X-Delivered" | ||
| 979 | "X-Envelope-Sender: " | ||
| 980 | "X-Envelope-To: " | ||
| 981 | "X-Folder: " ; Spam | ||
| 982 | "X-From-Line" | ||
| 983 | "X-Gnus-Mail-Source: " ; gnus | ||
| 984 | "X-Habeas-SWE-1: " ; Spam | ||
| 985 | "X-Habeas-SWE-2: " ; Spam | ||
| 986 | "X-Habeas-SWE-3: " ; Spam | ||
| 987 | "X-Habeas-SWE-4: " ; Spam | ||
| 988 | "X-Habeas-SWE-5: " ; Spam | ||
| 989 | "X-Habeas-SWE-6: " ; Spam | ||
| 990 | "X-Habeas-SWE-7: " ; Spam | ||
| 991 | "X-Habeas-SWE-8: " ; Spam | ||
| 992 | "X-Habeas-SWE-9: " ; Spam | ||
| 993 | "X-Info: " ; NTMail | ||
| 994 | "X-Juno-" ; Juno | ||
| 995 | "X-List-Host: " ; Unknown mailing list managers | ||
| 996 | "X-List-Subscribe: " ; Unknown mailing list managers | ||
| 997 | "X-List-Unsubscribe: " ; Unknown mailing list managers | ||
| 998 | "X-Listserver: " ; Unknown mailing list managers | ||
| 999 | "X-Loop: " ; Unknown mailing list managers | ||
| 1000 | "X-MIME-Autoconverted: " ; sendmail | ||
| 1001 | "X-MIMETrack: " | ||
| 1002 | "X-MS-TNEF-Correlator: " ; MS Outlook | ||
| 1003 | "X-Mailing-List: " ; Unknown mailing list managers | ||
| 1004 | "X-Mailman-Version: " ; Mailman mailing list manager | ||
| 1005 | "X-Message-Id" | ||
| 1006 | "X-MimeOLE: " ; MS Outlook | ||
| 1007 | "X-Mozilla-Status: " ; Netscape/Mozilla | ||
| 1008 | "X-Msmail-" ; MS Outlook | ||
| 1009 | "X-News: " ; News | ||
| 1010 | "X-No-Archive: " | ||
| 1011 | "X-Orcl-Content-Type: " | ||
| 1012 | "X-Original-Complaints-To: " | ||
| 1013 | "X-Original-Date: " ; SourceForge mailing list manager | ||
| 1014 | "X-Original-Trace: " | ||
| 1015 | "X-OriginalArrivalTime: " ; Hotmail | ||
| 1016 | "X-Originating-IP: " ; Hotmail | ||
| 1017 | "X-Priority: " ; MS Outlook | ||
| 1018 | "X-Qotd-" ; User added | ||
| 1019 | "X-Received-Date: " | ||
| 1020 | "X-Received: " | ||
| 1021 | "X-Request-" | ||
| 1022 | "X-SBClass: " ; Spam | ||
| 1023 | "X-SBNote: " ; Spam | ||
| 1024 | "X-SBPass: " ; Spam | ||
| 1025 | "X-SBRule: " ; Spam | ||
| 1026 | "X-Scanned-By" | ||
| 1027 | "X-Sender: " | ||
| 1028 | "X-Server-Date: " | ||
| 1029 | "X-Server-Uuid: " | ||
| 1030 | "X-Sieve: " ; Sieve filtering | ||
| 1031 | "X-Spam-Level: " ; Spam | ||
| 1032 | "X-Spam-Score: " ; Spam | ||
| 1033 | "X-Spam-Status: " ; Spam | ||
| 1034 | "X-SpamBouncer: " ; Spam | ||
| 1035 | "X-Trace: " | ||
| 1036 | "X-UIDL: " | ||
| 1037 | "X-UserInfo1: " | ||
| 1038 | "X-VSMLoop: " ; NTMail | ||
| 1039 | "X-Vms-To: " | ||
| 1040 | "X-Wss-Id: " ; Worldtalk gateways | ||
| 1041 | "X-eGroups-" ; Egroups/yahoogroups mailing list manager | ||
| 1042 | "X-pgp: " | ||
| 1043 | "X-submission-address: " | ||
| 1044 | "X400-" ; X400 | ||
| 1045 | "Xref: ") | ||
| 1046 | "*List of header fields that are not to be shown. | ||
| 1047 | Regexps are not allowed. Unique fields should have a \": \" suffix; | ||
| 1048 | otherwise, the element can be used to render an entire class of fields | ||
| 1049 | that start with the same prefix invisible. | ||
| 1050 | This variable is ignored if `mh-visible-headers' is set." | ||
| 1051 | :type '(repeat (string :tag "Header field")) | ||
| 1052 | :set 'mh-invisible-header-fields-set | ||
| 1053 | :group 'mh-show) | ||
| 1054 | |||
| 1055 | ;;; Composing messages (:group 'mh-letter) | ||
| 1056 | |||
| 1057 | (defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn) | ||
| 1058 | "Use either 'gnus or 'mhn to insert MIME message directives in messages." | ||
| 1059 | :type '(choice (const :tag "Use gnus" gnus) | ||
| 1060 | (const :tag "Use mhn" mhn)) | ||
| 1061 | :group 'mh-letter) | ||
| 1062 | |||
| 1063 | (defcustom mh-compose-letter-function nil | ||
| 1064 | "Invoked when setting up a letter draft. | ||
| 1065 | It is passed three arguments: TO recipients, SUBJECT, and CC recipients." | ||
| 1066 | :type '(choice (const nil) function) | ||
| 1067 | :group 'mh-letter) | ||
| 1068 | |||
| 1069 | (defcustom mh-delete-yanked-msg-window-flag nil | ||
| 1070 | "*Non-nil means delete any window displaying the message. | ||
| 1071 | Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. | ||
| 1072 | If non-nil, yanking the current message into a draft letter deletes any | ||
| 1073 | windows displaying the message." | ||
| 1074 | :type 'boolean | ||
| 1075 | :group 'mh-letter) | ||
| 1076 | |||
| 1077 | (defcustom mh-extract-from-attribution-verb "wrote:" | ||
| 1078 | "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]." | ||
| 1079 | :type '(choice (const "wrote:") | ||
| 1080 | (const "a écrit :") | ||
| 1081 | (string :tag "Custom string")) | ||
| 1082 | :group 'mh-letter) | ||
| 1083 | |||
| 1084 | (defcustom mh-forward-subject-format "%s: %s" | ||
| 1085 | "*Format to generate the Subject: line contents for a forwarded message. | ||
| 1086 | The two string arguments to the format are the sender of the original | ||
| 1087 | message and the original subject line." | ||
| 1088 | :type 'string | ||
| 1089 | :group 'mh-letter) | ||
| 1090 | |||
| 1091 | (defcustom mh-ins-buf-prefix "> " | ||
| 1092 | "*String to put before each non-blank line of a yanked or inserted message. | ||
| 1093 | \\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter | ||
| 1094 | by \\[mh-insert-letter] or \\[mh-yank-cur-msg]." | ||
| 1095 | :type 'string | ||
| 1096 | :group 'mh-letter) | ||
| 1097 | |||
| 1098 | (defcustom mh-insert-mail-followup-to-flag t | ||
| 1099 | "Non-nil means maybe append a Mail-Followup-To field to the header. | ||
| 1100 | The insertion is done if the To: or Cc: fields matches an entry in | ||
| 1101 | `mh-insert-mail-followup-to-list'." | ||
| 1102 | :type 'boolean | ||
| 1103 | :group 'mh-letter) | ||
| 1104 | |||
| 1105 | (defcustom mh-insert-mail-followup-to-list nil | ||
| 1106 | "Alist of addresses for which a Mail-Followup-To field is inserted. | ||
| 1107 | Each element has the form (REGEXP ADDRESS). | ||
| 1108 | When the REGEXP appears in the To or cc fields of a message, the corresponding | ||
| 1109 | ADDRESS is inserted in a Mail-Followup-To field. | ||
| 1110 | |||
| 1111 | Here's a customization example: | ||
| 1112 | |||
| 1113 | regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net | ||
| 1114 | address: mh-e-users@lists.sourceforge.net | ||
| 1115 | |||
| 1116 | This corresponds to: | ||
| 1117 | |||
| 1118 | (setq mh-insert-mail-followup-to-list | ||
| 1119 | '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\" | ||
| 1120 | \"mh-e-users@lists.sourceforge.net\"))) | ||
| 1121 | |||
| 1122 | While it might be tempting to add a descriptive name to the mailing list | ||
| 1123 | address, consider that this field will appear in other people's outgoing | ||
| 1124 | mail in their To: field. It might be best to keep it simple." | ||
| 1125 | :type '(repeat (list (string :tag "regexp") (string :tag "address"))) | ||
| 1126 | :group 'mh-letter) | ||
| 1127 | |||
| 1128 | (defcustom mh-insert-x-mailer-flag t | ||
| 1129 | "*Non-nil means append an X-Mailer field to the header." | ||
| 1130 | :type 'boolean | ||
| 1131 | :group 'mh-letter) | ||
| 1132 | |||
| 1133 | (defcustom mh-letter-fill-column 72 | ||
| 1134 | "*Fill column to use in `mh-letter-mode'. | ||
| 1135 | This is usually less than in other text modes because email messages get | ||
| 1136 | quoted by some prefix (sometimes many times) when they are replied to, | ||
| 1137 | and it's best to avoid quoted lines that span more than 80 columns." | ||
| 1138 | :type 'integer | ||
| 1139 | :group 'mh-letter) | ||
| 1140 | |||
| 1141 | (defcustom mh-reply-default-reply-to nil | ||
| 1142 | "*Sets the person or persons to whom a reply will be sent. | ||
| 1143 | If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this | ||
| 1144 | value and it should be one of \"from\", \"to\", \"cc\", or \"all\". | ||
| 1145 | The values \"cc\" and \"all\" do the same thing." | ||
| 1146 | :type '(choice (const :tag "Prompt" nil) | ||
| 1147 | (const "from") (const "to") | ||
| 1148 | (const "cc") (const "all")) | ||
| 1149 | :group 'mh-letter) | ||
| 1150 | |||
| 1151 | (defcustom mh-reply-show-message-flag t | ||
| 1152 | "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply]. | ||
| 1153 | |||
| 1154 | The setting of this variable determines whether the MH `show-buffer' is | ||
| 1155 | displayed with the current message when using `mh-reply' without a prefix | ||
| 1156 | argument. Set it to nil if you already include the message automatically | ||
| 1157 | in your draft using | ||
| 1158 | repl: -filter repl.filter | ||
| 1159 | in your ~/.mh_profile file." | ||
| 1160 | :type 'boolean | ||
| 1161 | :group 'mh-letter) | ||
| 1162 | |||
| 1163 | (defcustom mh-signature-file-name "~/.signature" | ||
| 1164 | "*Name of file containing the user's signature. | ||
| 1165 | Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]." | ||
| 1166 | :type 'file | ||
| 1167 | :group 'mh-letter) | ||
| 1168 | |||
| 1169 | (defcustom mh-x-face-file "~/.face" | ||
| 1170 | "*File name containing the encoded X-Face string to insert in outgoing mail. | ||
| 1171 | If nil, or the file does not exist, nothing is added to message headers." | ||
| 1172 | :type 'file | ||
| 1173 | :group 'mh-letter) | ||
| 1174 | |||
| 1175 | (defvar mh-x-mailer-string nil | ||
| 1176 | "*String containing the contents of the X-Mailer header field. | ||
| 1177 | If nil, this variable is initialized to show the version of MH-E, Emacs, and | ||
| 1178 | MH the first time a message is composed.") | ||
| 1179 | |||
| 1180 | (defcustom mh-yank-from-start-of-msg 'attribution | ||
| 1181 | "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. | ||
| 1182 | If t, include the entire message, with full headers. This is historically | ||
| 1183 | here for use with supercite, but is now deprecated in favor of the setting | ||
| 1184 | `supercite' below. | ||
| 1185 | |||
| 1186 | If the symbol `body', then yank the message minus the header. | ||
| 1187 | |||
| 1188 | If the symbol `supercite', include the entire message, with full headers. | ||
| 1189 | This also causes the invocation of `sc-cite-original' without the setting | ||
| 1190 | of `mail-citation-hook', now deprecated practice. | ||
| 1191 | |||
| 1192 | If the symbol `autosupercite', do as for `supercite' automatically when | ||
| 1193 | show buffer matches the message being replied-to. When this option is used, | ||
| 1194 | the -noformat switch is passed to the repl program to override a -filter or | ||
| 1195 | -format switch. | ||
| 1196 | |||
| 1197 | If the symbol `attribution', then yank the message minus the header and add | ||
| 1198 | a simple attribution line at the top. | ||
| 1199 | |||
| 1200 | If the symbol `autoattrib', do as for `attribution' automatically when show | ||
| 1201 | buffer matches the message being replied-to. You can make sure this is | ||
| 1202 | always the case by setting `mh-reply-show-message-flag' to t (which is the | ||
| 1203 | default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such | ||
| 1204 | that the show window is never displayed. When the `autoattrib' option is | ||
| 1205 | used, the -noformat switch is passed to the repl program to override a | ||
| 1206 | -filter or -format switch. | ||
| 1207 | |||
| 1208 | If nil, yank only the portion of the message following the point. | ||
| 1209 | |||
| 1210 | If the show buffer has a region, this variable is ignored unless its value is | ||
| 1211 | one of `attribution' or `autoattrib' in which case the attribution is added | ||
| 1212 | to the yanked region." | ||
| 1213 | :type '(choice (const :tag "Below point" nil) | ||
| 1214 | (const :tag "Without header" body) | ||
| 1215 | (const :tag "Invoke supercite" supercite) | ||
| 1216 | (const :tag "Invoke supercite, automatically" autosupercite) | ||
| 1217 | (const :tag "Without header, with attribution" attribution) | ||
| 1218 | (const :tag "Without header, with attribution, automatically" | ||
| 1219 | autoattrib) | ||
| 1220 | (const :tag "Entire message with headers" t)) | ||
| 1221 | :group 'mh-letter) | ||
| 1222 | |||
| 1223 | (defcustom mh-letter-complete-function 'ispell-complete-word | ||
| 1224 | "*Function to call when completing outside of fields specific to aliases." | ||
| 1225 | :type '(choice function (const nil)) | ||
| 1226 | :group 'mh-letter) | ||
| 1227 | |||
| 1228 | ;;; Alias handling (:group 'mh-alias) | ||
| 1229 | |||
| 1230 | (defcustom mh-alias-system-aliases | ||
| 1231 | '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd") | ||
| 1232 | "*A list of system files from which to cull aliases. | ||
| 1233 | If these files are modified, they are automatically reread. This list need | ||
| 1234 | include only system aliases and the passwd file, since personal alias files | ||
| 1235 | listed in your \"AliasFile\" MH profile component are automatically included. | ||
| 1236 | You can update the alias list manually using \\[mh-alias-reload]." | ||
| 1237 | :group 'mh-alias | ||
| 1238 | :type '(choice (file) (repeat file))) | ||
| 1239 | |||
| 1240 | (defcustom mh-alias-expand-aliases-flag nil | ||
| 1241 | "*Non-nil means to expand aliases entered in the minibuffer. | ||
| 1242 | In other words, aliases entered in the minibuffer will be expanded to the full | ||
| 1243 | address in the message draft. By default, this expansion is not performed." | ||
| 1244 | :group 'mh-alias | ||
| 1245 | :type 'boolean) | ||
| 1246 | |||
| 1247 | (defcustom mh-alias-completion-ignore-case-flag t | ||
| 1248 | "*Non-nil means don't consider case significant in MH alias completion. | ||
| 1249 | This is the default in plain MH, so it is the default here as well. It | ||
| 1250 | can be useful to set this to t if, for example, you use lowercase | ||
| 1251 | aliases for people and uppercase for mailing lists." | ||
| 1252 | :group 'mh-alias | ||
| 1253 | :type 'boolean) | ||
| 1254 | |||
| 1255 | (defcustom mh-alias-flash-on-comma t | ||
| 1256 | "*Specify whether to flash or warn on translation. | ||
| 1257 | When a [comma] is pressed while entering aliases or addresses, setting this | ||
| 1258 | variable to the following values has the listed effects: | ||
| 1259 | t Flash alias translation but don't warn if there is no translation. | ||
| 1260 | 1 Flash alias translation and warn if there is no translation. | ||
| 1261 | nil Do not flash alias translation nor warn if there is no translation." | ||
| 1262 | :group 'mh-alias | ||
| 1263 | :type '(choice (const :tag "Flash but don't warn if no translation" t) | ||
| 1264 | (const :tag "Flash and warn if no translation" 1) | ||
| 1265 | (const :tag "Don't flash nor warn if no translation" nil))) | ||
| 1266 | |||
| 1267 | (defcustom mh-alias-local-users t | ||
| 1268 | "*If t, local users are completed in MH-E To: and Cc: prompts. | ||
| 1269 | |||
| 1270 | Users with a userid greater than some magic number (usually 200) are available | ||
| 1271 | for completion. | ||
| 1272 | |||
| 1273 | If you set this variable to a string, it will be executed to generate a | ||
| 1274 | password file. A value of \"ypcat passwd\" is helpful if NIS is in use." | ||
| 1275 | :group 'mh-alias | ||
| 1276 | :type '(choice (boolean) (string))) | ||
| 1277 | |||
| 1278 | (defcustom mh-alias-insert-file nil | ||
| 1279 | "*Filename to use to store new MH-E aliases. | ||
| 1280 | This variable can also be a list of filenames, in which case MH-E will prompt | ||
| 1281 | for one of them. If nil, the default, then MH-E will use the first file found | ||
| 1282 | in the \"AliasFile\" component of the MH profile." | ||
| 1283 | :group 'mh-alias | ||
| 1284 | :type '(choice (const :tag "Use AliasFile MH profile component" nil) | ||
| 1285 | (file :tag "Alias file") | ||
| 1286 | (repeat :tag "List of alias files" file))) | ||
| 1287 | |||
| 1288 | (defcustom mh-alias-insertion-location 'sorted | ||
| 1289 | "Specifies where new aliases are entered in alias files. | ||
| 1290 | Options are sorted alphabetically, at the top of the file or at the bottom." | ||
| 1291 | :type '(choice (const :tag "Sorted alphabetically" sorted) | ||
| 1292 | (const :tag "At the top of file" top) | ||
| 1293 | (const :tag "At the bottom of file" bottom)) | ||
| 1294 | :group 'mh-alias) | ||
| 1295 | |||
| 1296 | ;;; Indexed searching (:group 'mh-index) | ||
| 1297 | |||
| 1298 | (defcustom mh-index-program nil | ||
| 1299 | "Indexing program that MH-E shall use. | ||
| 1300 | The possible choices are swish++, swish-e, namazu, glimpse and grep. By | ||
| 1301 | default this variable is nil which means that the programs are tried in order | ||
| 1302 | and the first one found is used." | ||
| 1303 | :type '(choice (const :tag "auto-detect" nil) | ||
| 1304 | (const :tag "swish++" swish++) | ||
| 1305 | (const :tag "swish-e" swish) | ||
| 1306 | (const :tag "namazu" namazu) | ||
| 1307 | (const :tag "glimpse" glimpse) | ||
| 1308 | (const :tag "grep" grep)) | ||
| 1309 | :group 'mh-index) | ||
| 1310 | |||
| 1311 | ;;; Multiple personalities (:group 'mh-identity) | ||
| 1312 | |||
| 1313 | (defcustom mh-identity-list nil | ||
| 1314 | "*List holding MH-E identity. | ||
| 1315 | Omit the colon and trailing space from the field names. | ||
| 1316 | The keyword name \"none\" is reversed for internal use. | ||
| 1317 | Use the keyname name \"signature\" to specify either a signature file or a | ||
| 1318 | function to call to insert a signature at point. | ||
| 1319 | |||
| 1320 | Providing an empty Value (\"\") will cause the field to be deleted. | ||
| 1321 | |||
| 1322 | Example entries using the customize interface: | ||
| 1323 | Keyword name: work | ||
| 1324 | From | ||
| 1325 | Value: John Doe <john@work.com> | ||
| 1326 | Organization | ||
| 1327 | Value: Acme Inc. | ||
| 1328 | Keyword name: home | ||
| 1329 | From | ||
| 1330 | Value: John Doe <johndoe@home.net> | ||
| 1331 | Organization | ||
| 1332 | Value: | ||
| 1333 | |||
| 1334 | This would produce the equivalent of: | ||
| 1335 | (setq mh-identity-list | ||
| 1336 | '((\"work\" | ||
| 1337 | ((\"From\" . \"John Doe <john@work.com>\") | ||
| 1338 | (\"Organization\" . \"Acme Inc.\"))) | ||
| 1339 | (\"home\" | ||
| 1340 | ((\"From\" . \"John Doe <johndoe@home.net>\") | ||
| 1341 | (\"Organization\" . \"\")))))" | ||
| 1342 | :type '(repeat (list :tag "" | ||
| 1343 | (string :tag "Keyword name") | ||
| 1344 | (repeat :tag "At least one pair from below" | ||
| 1345 | (choice (cons :tag "From field" | ||
| 1346 | (const "From") | ||
| 1347 | (string :tag "Value")) | ||
| 1348 | (cons :tag "Organization field" | ||
| 1349 | (const "Organization") | ||
| 1350 | (string :tag "Value")) | ||
| 1351 | (cons :tag "Signature" | ||
| 1352 | (const "signature") | ||
| 1353 | (choice (file) (function))) | ||
| 1354 | (cons :tag "Other field & value pair" | ||
| 1355 | (string :tag "Field") | ||
| 1356 | (string :tag "Value")))))) | ||
| 1357 | :set 'mh-identity-list-set | ||
| 1358 | :group 'mh-identity) | ||
| 1359 | |||
| 1360 | (defcustom mh-identity-default nil | ||
| 1361 | "Default identity to use when `mh-letter-mode' is called." | ||
| 1362 | ;; Dynamically render :type corresponding to `mh-identity-list' entries, | ||
| 1363 | ;; e.g.: | ||
| 1364 | ;; :type '(radio (const :tag "none" nil) | ||
| 1365 | ;; (const "home") | ||
| 1366 | ;; (const "work")) | ||
| 1367 | :type (append | ||
| 1368 | '(radio) | ||
| 1369 | (cons '(const :tag "none" nil) | ||
| 1370 | (mapcar (function (lambda (arg) `(const ,arg))) | ||
| 1371 | (mapcar 'car mh-identity-list)))) | ||
| 1372 | :group 'mh-identity) | ||
| 1373 | |||
| 1374 | ;;; Hooks (:group 'mh-hooks + group where hook defined) | ||
| 1375 | |||
| 1376 | ;;; These are alphabetized. All hooks should be placed in the 'mh-hook group; | ||
| 1377 | ;;; in addition, add the group in which the hook is defined in the manual (or, | ||
| 1378 | ;;; if it is new, where it would be defined). | ||
| 1379 | |||
| 1380 | (defcustom mh-before-quit-hook nil | ||
| 1381 | "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E. | ||
| 1382 | See also `mh-quit-hook'." | ||
| 1383 | :type 'hook | ||
| 1384 | :group 'mh-hooks | ||
| 1385 | :group 'mh-folder) | ||
| 1386 | |||
| 1387 | (defcustom mh-before-send-letter-hook nil | ||
| 1388 | "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command." | ||
| 1389 | :type 'hook | ||
| 1390 | :group 'mh-hooks | ||
| 1391 | :group 'mh-letter) | ||
| 1392 | |||
| 1393 | (defcustom mh-delete-msg-hook nil | ||
| 1394 | "Invoked after marking each message for deletion." | ||
| 1395 | :type 'hook | ||
| 1396 | :group 'mh-hooks | ||
| 1397 | :group 'mh-folder) | ||
| 1398 | |||
| 1399 | (defcustom mh-edit-mhn-hook nil | ||
| 1400 | "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]." | ||
| 1401 | :type 'hook | ||
| 1402 | :group 'mh-hooks | ||
| 1403 | :group 'mh-letter) | ||
| 1404 | |||
| 1405 | (defcustom mh-find-path-hook nil | ||
| 1406 | "Invoked by `mh-find-path' after reading the user's MH profile." | ||
| 1407 | :type 'hook | ||
| 1408 | :group 'mh-hooks | ||
| 1409 | :group 'mh-folder) | ||
| 1410 | |||
| 1411 | (defcustom mh-folder-list-change-hook nil | ||
| 1412 | "Invoked whenever the cached folder list `mh-folder-list' is changed." | ||
| 1413 | :type 'hook | ||
| 1414 | :group 'mh-hooks | ||
| 1415 | :group 'mh-folder) | ||
| 1416 | |||
| 1417 | (defcustom mh-folder-mode-hook nil | ||
| 1418 | "Invoked in `mh-folder-mode' on a new folder." | ||
| 1419 | :type 'hook | ||
| 1420 | :group 'mh-hooks | ||
| 1421 | :group 'mh-folder) | ||
| 1422 | |||
| 1423 | (defcustom mh-folder-updated-hook nil | ||
| 1424 | "Invoked when the folder actions (such as moves and deletes) are performed. | ||
| 1425 | Variables that are useful in this hook include `mh-delete-list' and | ||
| 1426 | `mh-refile-list' which can be used to see which changes are being made to | ||
| 1427 | current folder, `mh-current-folder'." | ||
| 1428 | :type 'hook | ||
| 1429 | :group 'mh-hooks) | ||
| 1430 | |||
| 1431 | (defcustom mh-inc-folder-hook nil | ||
| 1432 | "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder." | ||
| 1433 | :type 'hook | ||
| 1434 | :group 'mh-hooks | ||
| 1435 | :group 'mh-folder) | ||
| 1436 | |||
| 1437 | (defcustom mh-index-show-hook nil | ||
| 1438 | "Invoked after the message has been displayed." | ||
| 1439 | :type 'hook | ||
| 1440 | :group 'mh-hooks | ||
| 1441 | :group 'mh-index) | ||
| 1442 | |||
| 1443 | (defcustom mh-letter-insert-signature-hook nil | ||
| 1444 | "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command. | ||
| 1445 | Can be used to determine which signature file to use based on message content. | ||
| 1446 | On return, if `mh-signature-file-name' is non-nil that file will be inserted at | ||
| 1447 | the current point in the buffer." | ||
| 1448 | :type 'hook | ||
| 1449 | :group 'mh-hooks | ||
| 1450 | :group 'mh-letter) | ||
| 1451 | |||
| 1452 | (defcustom mh-letter-mode-hook nil | ||
| 1453 | "Invoked in `mh-letter-mode' on a new letter." | ||
| 1454 | :type 'hook | ||
| 1455 | :group 'mh-hooks | ||
| 1456 | :group 'mh-letter) | ||
| 1457 | |||
| 1458 | (defcustom mh-pick-mode-hook nil | ||
| 1459 | "Invoked upon entry to `mh-pick-mode'." | ||
| 1460 | :type 'hook | ||
| 1461 | :group 'mh-hooks | ||
| 1462 | :group 'mh-folder) | ||
| 1463 | |||
| 1464 | (defcustom mh-quit-hook nil | ||
| 1465 | "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E. | ||
| 1466 | See also `mh-before-quit-hook'." | ||
| 1467 | :type 'hook | ||
| 1468 | :group 'mh-hooks | ||
| 1469 | :group 'mh-folder) | ||
| 1470 | |||
| 1471 | (defcustom mh-refile-msg-hook nil | ||
| 1472 | "Invoked after marking each message for refiling." | ||
| 1473 | :type 'hook | ||
| 1474 | :group 'mh-hooks | ||
| 1475 | :group 'mh-folder) | ||
| 1476 | |||
| 1477 | (defcustom mh-show-hook nil | ||
| 1478 | "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message." | ||
| 1479 | :type 'hook | ||
| 1480 | :group 'mh-hooks | ||
| 1481 | :group 'mh-show) | ||
| 1482 | |||
| 1483 | (defcustom mh-show-mode-hook nil | ||
| 1484 | "Invoked upon entry to `mh-show-mode'." | ||
| 1485 | :type 'hook | ||
| 1486 | :group 'mh-hooks | ||
| 1487 | :group 'mh-show) | ||
| 1488 | |||
| 1489 | (defcustom mh-unseen-updated-hook nil | ||
| 1490 | "Invoked after the unseen sequence has been updated. | ||
| 1491 | The variable `mh-seen-list' can be used to obtain the list of messages which | ||
| 1492 | will be removed from the unseen sequence." | ||
| 1493 | :type 'hook | ||
| 1494 | :group 'mh-hooks | ||
| 1495 | :group 'mh-folder) | ||
| 1496 | |||
| 1497 | |||
| 1498 | |||
| 1499 | ;;; Faces | ||
| 1500 | |||
| 1501 | ;;; Faces used in speedbar (:group mh-speed-faces) | ||
| 1502 | |||
| 1503 | (defface mh-speedbar-folder-face | ||
| 1504 | '((((class color) (background light)) | ||
| 1505 | (:foreground "blue4")) | ||
| 1506 | (((class color) (background dark)) | ||
| 1507 | (:foreground "light blue"))) | ||
| 1508 | "Face used for folders in the speedbar buffer." | ||
| 1509 | :group 'mh-speed-faces) | ||
| 1510 | |||
| 1511 | (defface mh-speedbar-selected-folder-face | ||
| 1512 | '((((class color) (background light)) | ||
| 1513 | (:foreground "red" :underline t)) | ||
| 1514 | (((class color) (background dark)) | ||
| 1515 | (:foreground "red" :underline t)) | ||
| 1516 | (t (:underline t))) | ||
| 1517 | "Face used for the current folder." | ||
| 1518 | :group 'mh-speed-faces) | ||
| 1519 | |||
| 1520 | (defface mh-speedbar-folder-with-unseen-messages-face | ||
| 1521 | '((t (:inherit mh-speedbar-folder-face :bold t))) | ||
| 1522 | "Face used for folders in the speedbar buffer which have unread messages." | ||
| 1523 | :group 'mh-speed-faces) | ||
| 1524 | |||
| 1525 | (defface mh-speedbar-selected-folder-with-unseen-messages-face | ||
| 1526 | '((t (:inherit mh-speedbar-selected-folder-face :bold t))) | ||
| 1527 | "Face used for the current folder when it has unread messages." | ||
| 1528 | :group 'mh-speed-faces) | ||
| 1529 | |||
| 1530 | ;;; Faces used in scan listing (:group mh-folder-faces) | ||
| 1531 | |||
| 1532 | (defvar mh-folder-body-face 'mh-folder-body-face | ||
| 1533 | "Face for highlighting body text in MH-Folder buffers.") | ||
| 1534 | (defface mh-folder-body-face | ||
| 1535 | '((((type tty) (class color)) (:foreground "green")) | ||
| 1536 | (((class grayscale) (background light)) (:foreground "DimGray" :italic t)) | ||
| 1537 | (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) | ||
| 1538 | (((class color) (background light)) (:foreground "RosyBrown")) | ||
| 1539 | (((class color) (background dark)) (:foreground "LightSalmon")) | ||
| 1540 | (t (:italic t))) | ||
| 1541 | "Face for highlighting body text in MH-Folder buffers." | ||
| 1542 | :group 'mh-folder-faces) | ||
| 1543 | |||
| 1544 | (defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face | ||
| 1545 | "Face for the current message line in MH-Folder buffers.") | ||
| 1546 | (defface mh-folder-cur-msg-face | ||
| 1547 | '((((type tty pc) (class color)) | ||
| 1548 | (:background "LightGreen")) | ||
| 1549 | (((class color) (background light)) | ||
| 1550 | (:background "LightGreen") ;Use this for solid background colour | ||
| 1551 | ;; (:underline t) ;Use this for underlining | ||
| 1552 | ) | ||
| 1553 | (((class color) (background dark)) | ||
| 1554 | (:background "DarkOliveGreen4")) | ||
| 1555 | (t (:underline t))) | ||
| 1556 | "Face for the current message line in MH-Folder buffers." | ||
| 1557 | :group 'mh-folder-faces) | ||
| 1558 | |||
| 1559 | (defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face | ||
| 1560 | "Face for highlighting the current message in MH-Folder buffers.") | ||
| 1561 | (defface mh-folder-cur-msg-number-face | ||
| 1562 | '((((type tty) (class color)) (:foreground "cyan" :weight bold)) | ||
| 1563 | (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) | ||
| 1564 | (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) | ||
| 1565 | (((class color) (background light)) (:foreground "Purple")) | ||
| 1566 | (((class color) (background dark)) (:foreground "Cyan")) | ||
| 1567 | (t (:bold t))) | ||
| 1568 | "Face for highlighting the current message in MH-Folder buffers." | ||
| 1569 | :group 'mh-folder-faces) | ||
| 1570 | |||
| 1571 | (defvar mh-folder-date-face 'mh-folder-date-face | ||
| 1572 | "Face for highlighting the date in MH-Folder buffers.") | ||
| 1573 | (defface mh-folder-date-face | ||
| 1574 | '((((class color) (background light)) | ||
| 1575 | (:foreground "snow4")) | ||
| 1576 | (((class color) (background dark)) | ||
| 1577 | (:foreground "snow3")) | ||
| 1578 | (t | ||
| 1579 | (:bold t))) | ||
| 1580 | "Face for highlighting the date in MH-Folder buffers." | ||
| 1581 | :group 'mh-folder-faces) | ||
| 1582 | |||
| 1583 | (defvar mh-folder-followup-face 'mh-folder-followup-face | ||
| 1584 | "Face for highlighting Re: (followup) subject text in MH-Folder buffers.") | ||
| 1585 | (defface mh-folder-followup-face | ||
| 1586 | '((((class color) (background light)) | ||
| 1587 | (:foreground "blue3")) | ||
| 1588 | (((class color) (background dark)) | ||
| 1589 | (:foreground "LightGoldenRod")) | ||
| 1590 | (t | ||
| 1591 | (:bold t))) | ||
| 1592 | "Face for highlighting Re: (followup) subject text in MH-Folder buffers." | ||
| 1593 | :group 'mh-folder-faces) | ||
| 1594 | |||
| 1595 | (defvar mh-folder-msg-number-face 'mh-folder-msg-number-face | ||
| 1596 | "Face for highlighting the message number in MH-Folder buffers.") | ||
| 1597 | (defface mh-folder-msg-number-face | ||
| 1598 | '((((class color) (background light)) | ||
| 1599 | (:foreground "snow4")) | ||
| 1600 | (((class color) (background dark)) | ||
| 1601 | (:foreground "snow3")) | ||
| 1602 | (t | ||
| 1603 | (:bold t))) | ||
| 1604 | "Face for highlighting the message number in MH-Folder buffers." | ||
| 1605 | :group 'mh-folder-faces) | ||
| 1606 | |||
| 1607 | (defvar mh-folder-deleted-face 'mh-folder-deleted-face | ||
| 1608 | "Face for highlighting deleted messages in MH-Folder buffers.") | ||
| 1609 | (copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face) | ||
| 1610 | |||
| 1611 | (defvar mh-folder-refiled-face 'mh-folder-refiled-face | ||
| 1612 | "Face for highlighting refiled messages in MH-Folder buffers.") | ||
| 1613 | (defface mh-folder-refiled-face | ||
| 1614 | '((((type tty) (class color)) (:foreground "yellow" :weight light)) | ||
| 1615 | (((class grayscale) (background light)) | ||
| 1616 | (:foreground "Gray90" :bold t :italic t)) | ||
| 1617 | (((class grayscale) (background dark)) | ||
| 1618 | (:foreground "DimGray" :bold t :italic t)) | ||
| 1619 | (((class color) (background light)) (:foreground "DarkGoldenrod")) | ||
| 1620 | (((class color) (background dark)) (:foreground "LightGoldenrod")) | ||
| 1621 | (t (:bold t :italic t))) | ||
| 1622 | "Face for highlighting refiled messages in MH-Folder buffers." | ||
| 1623 | :group 'mh-folder-faces) | ||
| 1624 | |||
| 1625 | (defvar mh-folder-subject-face 'mh-folder-subject-face | ||
| 1626 | "Face for highlighting subject text in MH-Folder buffers.") | ||
| 1627 | (if (boundp 'facemenu-unlisted-faces) | ||
| 1628 | (add-to-list 'facemenu-unlisted-faces "^mh-folder")) | ||
| 1629 | (defface mh-folder-subject-face | ||
| 1630 | '((((class color) (background light)) | ||
| 1631 | (:foreground "blue4")) | ||
| 1632 | (((class color) (background dark)) | ||
| 1633 | (:foreground "yellow")) | ||
| 1634 | (t | ||
| 1635 | (:bold t))) | ||
| 1636 | "Face for highlighting subject text in MH-Folder buffers." | ||
| 1637 | :group 'mh-folder-faces) | ||
| 1638 | |||
| 1639 | (defvar mh-folder-address-face 'mh-folder-address-face | ||
| 1640 | "Face for highlighting the address in MH-Folder buffers.") | ||
| 1641 | (copy-face 'mh-folder-subject-face 'mh-folder-address-face) | ||
| 1642 | |||
| 1643 | (defvar mh-folder-scan-format-face 'mh-folder-scan-format-face | ||
| 1644 | "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.") | ||
| 1645 | (copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face) | ||
| 1646 | |||
| 1647 | (defvar mh-folder-to-face 'mh-folder-to-face | ||
| 1648 | "Face for highlighting the To: string in MH-Folder buffers.") | ||
| 1649 | (defface mh-folder-to-face | ||
| 1650 | '((((type tty) (class color)) (:foreground "green")) | ||
| 1651 | (((class grayscale) (background light)) (:foreground "DimGray" :italic t)) | ||
| 1652 | (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) | ||
| 1653 | (((class color) (background light)) (:foreground "RosyBrown")) | ||
| 1654 | (((class color) (background dark)) (:foreground "LightSalmon")) | ||
| 1655 | (t (:italic t))) | ||
| 1656 | "Face for highlighting the To: string in MH-Folder buffers." | ||
| 1657 | :group 'mh-folder-faces) | ||
| 1658 | |||
| 1659 | ;;; Faces used in message display (:group mh-show-faces) | ||
| 1660 | |||
| 1661 | (defvar mh-show-cc-face 'mh-show-cc-face | ||
| 1662 | "Face for highlighting cc header fields.") | ||
| 1663 | (defface mh-show-cc-face | ||
| 1664 | '((((type tty) (class color)) (:foreground "yellow" :weight light)) | ||
| 1665 | (((class grayscale) (background light)) | ||
| 1666 | (:foreground "Gray90" :bold t :italic t)) | ||
| 1667 | (((class grayscale) (background dark)) | ||
| 1668 | (:foreground "DimGray" :bold t :italic t)) | ||
| 1669 | (((class color) (background light)) (:foreground "DarkGoldenrod")) | ||
| 1670 | (((class color) (background dark)) (:foreground "LightGoldenrod")) | ||
| 1671 | (t (:bold t :italic t))) | ||
| 1672 | "Face for highlighting cc header fields." | ||
| 1673 | :group 'mh-show-faces) | ||
| 1674 | |||
| 1675 | (defvar mh-show-date-face 'mh-show-date-face | ||
| 1676 | "Face for highlighting the Date header field.") | ||
| 1677 | (defface mh-show-date-face | ||
| 1678 | '((((type tty) (class color)) (:foreground "green")) | ||
| 1679 | (((class grayscale) (background light)) (:foreground "Gray90" :bold t)) | ||
| 1680 | (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) | ||
| 1681 | (((class color) (background light)) (:foreground "ForestGreen")) | ||
| 1682 | (((class color) (background dark)) (:foreground "PaleGreen")) | ||
| 1683 | (t (:bold t :underline t))) | ||
| 1684 | "Face for highlighting the Date header field." | ||
| 1685 | :group 'mh-show-faces) | ||
| 1686 | |||
| 1687 | (defvar mh-show-header-face 'mh-show-header-face | ||
| 1688 | "Face used to deemphasize unspecified header fields.") | ||
| 1689 | (defface mh-show-header-face | ||
| 1690 | '((((type tty) (class color)) (:foreground "green")) | ||
| 1691 | (((class grayscale) (background light)) (:foreground "DimGray" :italic t)) | ||
| 1692 | (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) | ||
| 1693 | (((class color) (background light)) (:foreground "RosyBrown")) | ||
| 1694 | (((class color) (background dark)) (:foreground "LightSalmon")) | ||
| 1695 | (t (:italic t))) | ||
| 1696 | "Face used to deemphasize unspecified header fields." | ||
| 1697 | :group 'mh-show-faces) | ||
| 1698 | |||
| 1699 | (defvar mh-show-to-face 'mh-show-to-face | ||
| 1700 | "Face for highlighting the To: header field.") | ||
| 1701 | (if (boundp 'facemenu-unlisted-faces) | ||
| 1702 | (add-to-list 'facemenu-unlisted-faces "^mh-show")) | ||
| 1703 | (defface mh-show-to-face | ||
| 1704 | '((((class grayscale) (background light)) | ||
| 1705 | (:foreground "DimGray" :underline t)) | ||
| 1706 | (((class grayscale) (background dark)) | ||
| 1707 | (:foreground "LightGray" :underline t)) | ||
| 1708 | (((class color) (background light)) (:foreground "SaddleBrown")) | ||
| 1709 | (((class color) (background dark)) (:foreground "burlywood")) | ||
| 1710 | (t (:underline t))) | ||
| 1711 | "Face for highlighting the To: header field." | ||
| 1712 | :group 'mh-show-faces) | ||
| 1713 | |||
| 1714 | (defvar mh-show-from-face 'mh-show-from-face | ||
| 1715 | "Face for highlighting the From: header field.") | ||
| 1716 | (defface mh-show-from-face | ||
| 1717 | '((((class color) (background light)) | ||
| 1718 | (:foreground "red3")) | ||
| 1719 | (((class color) (background dark)) | ||
| 1720 | (:foreground "cyan")) | ||
| 1721 | (t | ||
| 1722 | (:bold t))) | ||
| 1723 | "Face for highlighting the From: header field." | ||
| 1724 | :group 'mh-show-faces) | ||
| 1725 | |||
| 1726 | (defvar mh-show-subject-face 'mh-show-subject-face | ||
| 1727 | "Face for highlighting the Subject header field.") | ||
| 1728 | (copy-face 'mh-folder-subject-face 'mh-show-subject-face) | ||
| 1729 | |||
| 1730 | ;;; Faces used in indexed searches (:group mh-index-faces) | ||
| 1731 | |||
| 1732 | (defvar mh-index-folder-face 'mh-index-folder-face | ||
| 1733 | "Face for highlighting folders in MH-Index buffers.") | ||
| 1734 | (defface mh-index-folder-face | ||
| 1735 | '((((class color) (background light)) | ||
| 1736 | (:foreground "dark green" :bold t)) | ||
| 1737 | (((class color) (background dark)) | ||
| 1738 | (:foreground "indian red" :bold t)) | ||
| 1739 | (t | ||
| 1740 | (:bold t))) | ||
| 1741 | "Face for highlighting folders in MH-Index buffers." | ||
| 1742 | :group 'mh-index-faces) | ||
| 1743 | |||
| 1744 | (provide 'mh-customize) | ||
| 1745 | |||
| 1746 | ;;; Local Variables: | ||
| 1747 | ;;; indent-tabs-mode: nil | ||
| 1748 | ;;; sentence-end-double-space: nil | ||
| 1749 | ;;; End: | ||
| 1750 | |||
| 1751 | ;;; mh-customize.el ends here | ||
diff --git a/lisp/mail/mh-e.el b/lisp/mail/mh-e.el index 61dc037524f..9a5f8967f2a 100644 --- a/lisp/mail/mh-e.el +++ b/lisp/mail/mh-e.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | 4 | ||
| 5 | ;; Author: Bill Wohler <wohler@newt.com> | 5 | ;; Author: Bill Wohler <wohler@newt.com> |
| 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> | 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> |
| 7 | ;; Version: 7.0 | 7 | ;; Version: 7.1 |
| 8 | ;; Keywords: mail | 8 | ;; Keywords: mail |
| 9 | 9 | ||
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| @@ -79,11 +79,19 @@ | |||
| 79 | ;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the | 79 | ;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the |
| 80 | ;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001. | 80 | ;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001. |
| 81 | 81 | ||
| 82 | ;; $Id: mh-e.el,v 1.198 2002/11/29 15:33:37 wohler Exp $ | 82 | ;; $Id: mh-e.el,v 1.240 2003/01/08 00:46:25 wohler Exp $ |
| 83 | 83 | ||
| 84 | ;;; Code: | 84 | ;;; Code: |
| 85 | 85 | ||
| 86 | (require 'cl) | 86 | (require 'cl) |
| 87 | |||
| 88 | (defvar recursive-load-depth-limit) | ||
| 89 | (eval-when (compile load eval) | ||
| 90 | (if (and (boundp 'recursive-load-depth-limit) | ||
| 91 | (integerp recursive-load-depth-limit) | ||
| 92 | (> 50 recursive-load-depth-limit)) | ||
| 93 | (setq recursive-load-depth-limit 50))) | ||
| 94 | |||
| 87 | (require 'mh-utils) | 95 | (require 'mh-utils) |
| 88 | (require 'gnus-util) | 96 | (require 'gnus-util) |
| 89 | (require 'easymenu) | 97 | (require 'easymenu) |
| @@ -93,160 +101,14 @@ | |||
| 93 | ;; Shush the byte-compiler | 101 | ;; Shush the byte-compiler |
| 94 | (defvar font-lock-auto-fontify) | 102 | (defvar font-lock-auto-fontify) |
| 95 | (defvar font-lock-defaults) | 103 | (defvar font-lock-defaults) |
| 96 | (defvar tool-bar-mode) | ||
| 97 | |||
| 98 | (defconst mh-version "7.0" "Version number of MH-E.") | ||
| 99 | |||
| 100 | ;;; Initial Autoloads | ||
| 101 | ;;; The autoloads for mh-undo-folder, mh-widen and mh-reply are needed before | ||
| 102 | ;;; they are used to avoid compiler warnings. | ||
| 103 | (autoload 'mh-undo-folder "mh-funcs" | ||
| 104 | "Undo all commands in current folder." t) | ||
| 105 | (autoload 'mh-widen "mh-seq" | ||
| 106 | "Remove restrictions from current folder, thereby showing all messages." t) | ||
| 107 | (autoload 'mh-reply "mh-comp" | ||
| 108 | "Reply to a MESSAGE (default: displayed message). | ||
| 109 | If optional prefix argument INCLUDEP provided, then include the message | ||
| 110 | in the reply using filter mhl.reply in your MH directory. | ||
| 111 | Prompts for type of addresses to reply to: | ||
| 112 | from sender only, | ||
| 113 | to sender and primary recipients, | ||
| 114 | cc/all sender and all recipients. | ||
| 115 | If the file named by `mh-repl-formfile' exists, it is used as a skeleton | ||
| 116 | for the reply. See also documentation for `\\[mh-send]' function." t) | ||
| 117 | (autoload 'mh-map-to-seq-msgs "mh-seq") | ||
| 118 | (autoload 'mh-notate-seq "mh-seq") | ||
| 119 | (autoload 'mh-destroy-postponed-handles "mh-mime") | ||
| 120 | (autoload 'mh-press-button "mh-mime") | ||
| 121 | (autoload 'mh-mime-save-part "mh-mime") | ||
| 122 | (autoload 'mh-mime-inline-part "mh-mime") | ||
| 123 | (autoload 'mh-mime-save-parts "mh-mime") | ||
| 124 | (autoload 'mh-thread-inc "mh-seq") | ||
| 125 | (autoload 'mh-thread-forget-message "mh-seq") | ||
| 126 | (autoload 'mh-thread-add-spaces "mh-seq") | ||
| 127 | 104 | ||
| 105 | (defconst mh-version "7.1" "Version number of MH-E.") | ||
| 106 | |||
| 107 | ;;; Autoloads | ||
| 128 | (autoload 'Info-goto-node "info") | 108 | (autoload 'Info-goto-node "info") |
| 129 | 109 | ||
| 130 | 110 | ||
| 131 | 111 | ||
| 132 | ;;; Hooks: | ||
| 133 | |||
| 134 | (defgroup mh nil | ||
| 135 | "Emacs interface to the MH mail system." | ||
| 136 | :group 'mail) | ||
| 137 | |||
| 138 | (defgroup mh-hook nil | ||
| 139 | "Hooks to MH-E mode." | ||
| 140 | :prefix "mh-" | ||
| 141 | :group 'mh) | ||
| 142 | |||
| 143 | (defcustom mh-folder-mode-hook nil | ||
| 144 | "Invoked in `mh-folder-mode' on a new folder." | ||
| 145 | :type 'hook | ||
| 146 | :group 'mh-hook) | ||
| 147 | |||
| 148 | (defcustom mh-inc-folder-hook nil | ||
| 149 | "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder." | ||
| 150 | :type 'hook | ||
| 151 | :group 'mh-hook) | ||
| 152 | |||
| 153 | (defcustom mh-folder-updated-hook nil | ||
| 154 | "Invoked when the folder actions (such as moves and deletes) are performed. | ||
| 155 | Variables that are useful in this hook include `mh-delete-list' and | ||
| 156 | `mh-refile-list' which can be used to see which changes are being made to | ||
| 157 | current folder, `mh-current-folder'." | ||
| 158 | :type 'hook | ||
| 159 | :group 'mh-hook) | ||
| 160 | |||
| 161 | (defcustom mh-delete-msg-hook nil | ||
| 162 | "Invoked after marking each message for deletion." | ||
| 163 | :type 'hook | ||
| 164 | :group 'mh-hook) | ||
| 165 | |||
| 166 | (defcustom mh-refile-msg-hook nil | ||
| 167 | "Invoked after marking each message for refiling." | ||
| 168 | :type 'hook | ||
| 169 | :group 'mh-hook) | ||
| 170 | |||
| 171 | (defcustom mh-folder-list-change-hook nil | ||
| 172 | "Invoked whenever the cached folder list `mh-folder-list' is changed." | ||
| 173 | :type 'hook | ||
| 174 | :group 'mh-hook) | ||
| 175 | |||
| 176 | (defcustom mh-before-quit-hook nil | ||
| 177 | "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E. | ||
| 178 | See also `mh-quit-hook'." | ||
| 179 | :type 'hook | ||
| 180 | :group 'mh-hook) | ||
| 181 | |||
| 182 | (defcustom mh-quit-hook nil | ||
| 183 | "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E. | ||
| 184 | See also `mh-before-quit-hook'." | ||
| 185 | :type 'hook | ||
| 186 | :group 'mh-hook) | ||
| 187 | |||
| 188 | (defcustom mh-unseen-updated-hook nil | ||
| 189 | "Invoked after the unseen sequence has been updated. | ||
| 190 | The variable `mh-seen-list' can be used to obtain the list of messages which | ||
| 191 | will be removed from the unseen sequence." | ||
| 192 | :type 'hook | ||
| 193 | :group 'mh-hook) | ||
| 194 | |||
| 195 | ;;; Personal preferences: | ||
| 196 | |||
| 197 | (defcustom mh-lpr-command-format "lpr -J '%s'" | ||
| 198 | "*Format for Unix command that prints a message. | ||
| 199 | The string should be a Unix command line, with the string '%s' where | ||
| 200 | the job's name (folder and message number) should appear. The formatted | ||
| 201 | message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'." | ||
| 202 | :type 'string | ||
| 203 | :group 'mh) | ||
| 204 | |||
| 205 | (defcustom mh-scan-prog "scan" | ||
| 206 | "*Program to run to generate one-line-per-message listing of a folder. | ||
| 207 | Normally \"scan\" or a file name linked to scan. This file is searched | ||
| 208 | for relative to the mh-progs directory unless it is an absolute pathname." | ||
| 209 | :type 'string | ||
| 210 | :group 'mh) | ||
| 211 | (make-variable-buffer-local 'mh-scan-prog) | ||
| 212 | |||
| 213 | (defcustom mh-inc-prog "inc" | ||
| 214 | "*Program to run to incorporate new mail into a folder. | ||
| 215 | Normally \"inc\". This file is searched for relative to | ||
| 216 | the mh-progs directory unless it is an absolute pathname." | ||
| 217 | :type 'string | ||
| 218 | :group 'mh) | ||
| 219 | |||
| 220 | (defcustom mh-print-background-flag nil | ||
| 221 | "*Non-nil means messages should be printed in the background. | ||
| 222 | WARNING: do not delete the messages until printing is finished; | ||
| 223 | otherwise, your output may be truncated." | ||
| 224 | :type 'boolean | ||
| 225 | :group 'mh) | ||
| 226 | |||
| 227 | (defcustom mh-recenter-summary-flag nil | ||
| 228 | "*Non-nil means to recenter the summary window. | ||
| 229 | |||
| 230 | Recenter the summary window when the show window is toggled off if non-nil." | ||
| 231 | :type 'boolean | ||
| 232 | :group 'mh) | ||
| 233 | |||
| 234 | (defcustom mh-do-not-confirm-flag nil | ||
| 235 | "*Non-nil means do not prompt for confirmation. | ||
| 236 | Commands such as `mh-pack-folder' prompt to confirm whether to process | ||
| 237 | outstanding moves and deletes or not before continuing. A non-nil setting will | ||
| 238 | perform the action--which is usually desired but cannot be retracted--without | ||
| 239 | question." | ||
| 240 | :type 'boolean | ||
| 241 | :group 'mh) | ||
| 242 | |||
| 243 | (defcustom mh-store-default-directory nil | ||
| 244 | "*Last directory used by \\[mh-store-msg]; default for next store. | ||
| 245 | A directory name string, or nil to use current directory." | ||
| 246 | :type '(choice (const :tag "Current" nil) | ||
| 247 | directory) | ||
| 248 | :group 'mh) | ||
| 249 | |||
| 250 | (defvar mh-note-deleted "D" | 112 | (defvar mh-note-deleted "D" |
| 251 | "String whose first character is used to notate deleted messages.") | 113 | "String whose first character is used to notate deleted messages.") |
| 252 | 114 | ||
| @@ -264,22 +126,6 @@ The string is displayed after the folder's name. nil for no annotation.") | |||
| 264 | ;;; with the standard MH scan listings, in which the first 4 characters on | 126 | ;;; with the standard MH scan listings, in which the first 4 characters on |
| 265 | ;;; the line are the message number, followed by two places for notations. | 127 | ;;; the line are the message number, followed by two places for notations. |
| 266 | 128 | ||
| 267 | (defcustom mh-scan-format-file t | ||
| 268 | "Specifies the format file to pass to the scan program. | ||
| 269 | If t, the format string will be taken from the either `mh-scan-format-mh' | ||
| 270 | or `mh-scan-format-nmh' depending on whether MH or nmh is in use. | ||
| 271 | If nil, the default scan output will be used. | ||
| 272 | |||
| 273 | If you customize the scan format, you may need to modify a few variables | ||
| 274 | containing regexps that MH-E uses to identify specific portions of the output. | ||
| 275 | Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You | ||
| 276 | may also have to call `mh-set-cmd-note' with the width of your message | ||
| 277 | numbers. See also `mh-adaptive-cmd-note-flag'." | ||
| 278 | :type '(choice (const :tag "Use MH-E scan format" t) | ||
| 279 | (const :tag "Use default scan format" nil) | ||
| 280 | (file :tag "Specify a scan format file")) | ||
| 281 | :group 'mh) | ||
| 282 | |||
| 283 | ;; The following scan formats are passed to the scan program if the | 129 | ;; The following scan formats are passed to the scan program if the |
| 284 | ;; setting of `mh-scan-format-file' above is nil. They are identical | 130 | ;; setting of `mh-scan-format-file' above is nil. They are identical |
| 285 | ;; except the later one makes use of the nmh `decode' function to | 131 | ;; except the later one makes use of the nmh `decode' function to |
| @@ -386,7 +232,7 @@ The default `mh-folder-font-lock-keywords' expects this expression to contain | |||
| 386 | at least one parenthesized expression which matches the body text.") | 232 | at least one parenthesized expression which matches the body text.") |
| 387 | 233 | ||
| 388 | (defvar mh-scan-subject-regexp | 234 | (defvar mh-scan-subject-regexp |
| 389 | ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)" | 235 | ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)" |
| 390 | "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" | 236 | "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" |
| 391 | "*Regexp matching the subject string in MH folder mode. | 237 | "*Regexp matching the subject string in MH folder mode. |
| 392 | The default `mh-folder-font-lock-keywords' expects this expression to contain | 238 | The default `mh-folder-font-lock-keywords' expects this expression to contain |
| @@ -404,122 +250,13 @@ at least three parenthesized expressions. The first should match the | |||
| 404 | fontification hint, the second is found in `mh-scan-date-regexp', and the | 250 | fontification hint, the second is found in `mh-scan-date-regexp', and the |
| 405 | third should match the user name.") | 251 | third should match the user name.") |
| 406 | 252 | ||
| 407 | (defvar mh-folder-followup-face 'mh-folder-followup-face | 253 | |
| 408 | "Face for highlighting Re: (followup) subject text in MH-Folder buffers.") | 254 | |
| 409 | (defface mh-folder-followup-face | ||
| 410 | '((((class color) (background light)) | ||
| 411 | (:foreground "blue3")) | ||
| 412 | (((class color) (background dark)) | ||
| 413 | (:foreground "LightGoldenRod")) | ||
| 414 | (t | ||
| 415 | (:bold t))) | ||
| 416 | "Face for highlighting Re: (followup) subject text in MH-Folder buffers." | ||
| 417 | :group 'mh) | ||
| 418 | (defvar mh-folder-address-face 'mh-folder-address-face | ||
| 419 | "Face for highlighting the address in MH-Folder buffers.") | ||
| 420 | (copy-face 'mh-folder-subject-face 'mh-folder-address-face) | ||
| 421 | (defvar mh-folder-scan-format-face 'mh-folder-scan-format-face | ||
| 422 | "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.") | ||
| 423 | (copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face) | ||
| 424 | |||
| 425 | (defvar mh-folder-date-face 'mh-folder-date-face | ||
| 426 | "Face for highlighting the date in MH-Folder buffers.") | ||
| 427 | (defface mh-folder-date-face | ||
| 428 | '((((class color) (background light)) | ||
| 429 | (:foreground "snow4")) | ||
| 430 | (((class color) (background dark)) | ||
| 431 | (:foreground "snow3")) | ||
| 432 | (t | ||
| 433 | (:bold t))) | ||
| 434 | "Face for highlighting the date in MH-Folder buffers." | ||
| 435 | :group 'mh) | ||
| 436 | |||
| 437 | (defvar mh-folder-msg-number-face 'mh-folder-msg-number-face | ||
| 438 | "Face for highlighting the message number in MH-Folder buffers.") | ||
| 439 | (defface mh-folder-msg-number-face | ||
| 440 | '((((class color) (background light)) | ||
| 441 | (:foreground "snow4")) | ||
| 442 | (((class color) (background dark)) | ||
| 443 | (:foreground "snow3")) | ||
| 444 | (t | ||
| 445 | (:bold t))) | ||
| 446 | "Face for highlighting the message number in MH-Folder buffers." | ||
| 447 | :group 'mh) | ||
| 448 | |||
| 449 | (defvar mh-folder-deleted-face 'mh-folder-deleted-face | ||
| 450 | "Face for highlighting deleted messages in MH-Folder buffers.") | ||
| 451 | (copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face) | ||
| 452 | |||
| 453 | (defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face | ||
| 454 | "Face for the current message line in MH-Folder buffers.") | ||
| 455 | (defface mh-folder-cur-msg-face | ||
| 456 | '((((type tty pc) (class color)) | ||
| 457 | (:background "LightGreen")) | ||
| 458 | (((class color) (background light)) | ||
| 459 | (:background "LightGreen") ;Use this for solid background colour | ||
| 460 | ;;; (:underline t) ;Use this for underlining | ||
| 461 | ) | ||
| 462 | (((class color) (background dark)) | ||
| 463 | (:background "DarkOliveGreen4")) | ||
| 464 | (t (:underline t))) | ||
| 465 | "Face for the current message line in MH-Folder buffers." | ||
| 466 | :group 'mh) | ||
| 467 | |||
| 468 | ;;mh-folder-subject-face is defined in mh-utils since it's needed there | ||
| 469 | ;;for mh-show-subject-face. | ||
| 470 | |||
| 471 | (defvar mh-folder-refiled-face 'mh-folder-refiled-face | ||
| 472 | "Face for highlighting refiled messages in MH-Folder buffers.") | ||
| 473 | (defface mh-folder-refiled-face | ||
| 474 | '((((type tty) (class color)) (:foreground "yellow" :weight light)) | ||
| 475 | (((class grayscale) (background light)) | ||
| 476 | (:foreground "Gray90" :bold t :italic t)) | ||
| 477 | (((class grayscale) (background dark)) | ||
| 478 | (:foreground "DimGray" :bold t :italic t)) | ||
| 479 | (((class color) (background light)) (:foreground "DarkGoldenrod")) | ||
| 480 | (((class color) (background dark)) (:foreground "LightGoldenrod")) | ||
| 481 | (t (:bold t :italic t))) | ||
| 482 | "Face for highlighting refiled messages in MH-Folder buffers." | ||
| 483 | :group 'mh) | ||
| 484 | |||
| 485 | (defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face | ||
| 486 | "Face for highlighting the current message in MH-Folder buffers.") | ||
| 487 | (defface mh-folder-cur-msg-number-face | ||
| 488 | '((((type tty) (class color)) (:foreground "cyan" :weight bold)) | ||
| 489 | (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) | ||
| 490 | (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) | ||
| 491 | (((class color) (background light)) (:foreground "Purple")) | ||
| 492 | (((class color) (background dark)) (:foreground "Cyan")) | ||
| 493 | (t (:bold t))) | ||
| 494 | "Face for highlighting the current message in MH-Folder buffers." | ||
| 495 | :group 'mh) | ||
| 496 | |||
| 497 | (defvar mh-folder-to-face 'mh-folder-to-face | ||
| 498 | "Face for highlighting the To: string in MH-Folder buffers.") | ||
| 499 | (defface mh-folder-to-face | ||
| 500 | '((((type tty) (class color)) (:foreground "green")) | ||
| 501 | (((class grayscale) (background light)) (:foreground "DimGray" :italic t)) | ||
| 502 | (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) | ||
| 503 | (((class color) (background light)) (:foreground "RosyBrown")) | ||
| 504 | (((class color) (background dark)) (:foreground "LightSalmon")) | ||
| 505 | (t (:italic t))) | ||
| 506 | "Face for highlighting the To: string in MH-Folder buffers." | ||
| 507 | :group 'mh) | ||
| 508 | |||
| 509 | (defvar mh-folder-body-face 'mh-folder-body-face | ||
| 510 | "Face for highlighting body text in MH-Folder buffers.") | ||
| 511 | (defface mh-folder-body-face | ||
| 512 | '((((type tty) (class color)) (:foreground "green")) | ||
| 513 | (((class grayscale) (background light)) (:foreground "DimGray" :italic t)) | ||
| 514 | (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) | ||
| 515 | (((class color) (background light)) (:foreground "RosyBrown")) | ||
| 516 | (((class color) (background dark)) (:foreground "LightSalmon")) | ||
| 517 | (t (:italic t))) | ||
| 518 | "Face for highlighting body text in MH-Folder buffers." | ||
| 519 | :group 'mh) | ||
| 520 | |||
| 521 | (defvar mh-folder-font-lock-keywords | 255 | (defvar mh-folder-font-lock-keywords |
| 522 | (list | 256 | (list |
| 257 | ;; Folders when displaying index buffer | ||
| 258 | (list "^\\+.*" | ||
| 259 | '(0 mh-index-folder-face)) | ||
| 523 | ;; Marked for deletion | 260 | ;; Marked for deletion |
| 524 | (list (concat mh-scan-deleted-msg-regexp ".*") | 261 | (list (concat mh-scan-deleted-msg-regexp ".*") |
| 525 | '(0 mh-folder-deleted-face)) | 262 | '(0 mh-folder-deleted-face)) |
| @@ -535,11 +272,11 @@ third should match the user name.") | |||
| 535 | (list mh-scan-cur-msg-number-regexp | 272 | (list mh-scan-cur-msg-number-regexp |
| 536 | '(1 mh-folder-cur-msg-number-face)) | 273 | '(1 mh-folder-cur-msg-number-face)) |
| 537 | (list mh-scan-good-msg-regexp | 274 | (list mh-scan-good-msg-regexp |
| 538 | '(1 mh-folder-msg-number-face)) ;; Msg number | 275 | '(1 mh-folder-msg-number-face)) ;; Msg number |
| 539 | (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date | 276 | (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date |
| 540 | (list mh-scan-rcpt-regexp | 277 | (list mh-scan-rcpt-regexp |
| 541 | '(1 mh-folder-to-face) ;; To: | 278 | '(1 mh-folder-to-face) ;; To: |
| 542 | '(2 mh-folder-address-face)) ;; address | 279 | '(2 mh-folder-address-face)) ;; address |
| 543 | ;; scan font-lock name | 280 | ;; scan font-lock name |
| 544 | (list mh-scan-format-regexp | 281 | (list mh-scan-format-regexp |
| 545 | '(1 mh-folder-date-face) | 282 | '(1 mh-folder-date-face) |
| @@ -548,8 +285,7 @@ third should match the user name.") | |||
| 548 | (list mh-scan-cur-msg-regexp | 285 | (list mh-scan-cur-msg-regexp |
| 549 | '(1 mh-folder-cur-msg-face prepend t)) | 286 | '(1 mh-folder-cur-msg-face prepend t)) |
| 550 | ;; Unseen messages in bold | 287 | ;; Unseen messages in bold |
| 551 | '(mh-folder-font-lock-unseen (1 'bold append t)) | 288 | '(mh-folder-font-lock-unseen (1 'bold append t))) |
| 552 | ) | ||
| 553 | "Regexp keywords used to fontify the MH-Folder buffer.") | 289 | "Regexp keywords used to fontify the MH-Folder buffer.") |
| 554 | 290 | ||
| 555 | (defvar mh-scan-cmd-note-width 1 | 291 | (defvar mh-scan-cmd-note-width 1 |
| @@ -589,15 +325,15 @@ originator, or a \"To: address\" for outgoing e-mail messages.") | |||
| 589 | This column will only ever have spaces in it.") | 325 | This column will only ever have spaces in it.") |
| 590 | 326 | ||
| 591 | (defvar mh-scan-field-from-start-offset | 327 | (defvar mh-scan-field-from-start-offset |
| 592 | (+ mh-scan-cmd-note-width | 328 | (+ mh-scan-cmd-note-width |
| 593 | mh-scan-destination-width | 329 | mh-scan-destination-width |
| 594 | mh-scan-date-width | 330 | mh-scan-date-width |
| 595 | mh-scan-date-flag-width) | 331 | mh-scan-date-flag-width) |
| 596 | "The offset from the `mh-cmd-note' to find the start of \"From:\" address.") | 332 | "The offset from the `mh-cmd-note' to find the start of \"From:\" address.") |
| 597 | 333 | ||
| 598 | (defvar mh-scan-field-from-end-offset | 334 | (defvar mh-scan-field-from-end-offset |
| 599 | (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width) | 335 | (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width) |
| 600 | "The offset from the `mh-cmd-note' to find the end of \"From:\" address.") | 336 | "The offset from the `mh-cmd-note' to find the end of \"From:\" address.") |
| 601 | 337 | ||
| 602 | (defvar mh-scan-field-subject-start-offset | 338 | (defvar mh-scan-field-subject-start-offset |
| 603 | (+ mh-scan-cmd-note-width | 339 | (+ mh-scan-cmd-note-width |
| @@ -634,13 +370,13 @@ On nmh systems.") | |||
| 634 | (save-excursion | 370 | (save-excursion |
| 635 | (let ((unseen-seq-name "unseen")) | 371 | (let ((unseen-seq-name "unseen")) |
| 636 | (with-temp-buffer | 372 | (with-temp-buffer |
| 637 | (unwind-protect | 373 | (unwind-protect |
| 638 | (progn | 374 | (progn |
| 639 | (call-process (expand-file-name "mhparam" mh-progs) | 375 | (call-process (expand-file-name "mhparam" mh-progs) |
| 640 | nil '(t t) nil "-component" "Unseen-Sequence") | 376 | nil '(t t) nil "-component" "Unseen-Sequence") |
| 641 | (goto-char (point-min)) | 377 | (goto-char (point-min)) |
| 642 | (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t) | 378 | (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t) |
| 643 | (setq unseen-seq-name (match-string 1)))))) | 379 | (setq unseen-seq-name (match-string 1)))))) |
| 644 | unseen-seq-name))) | 380 | unseen-seq-name))) |
| 645 | 381 | ||
| 646 | (defun mh-folder-unseen-seq-list () | 382 | (defun mh-folder-unseen-seq-list () |
| @@ -653,15 +389,15 @@ On nmh systems.") | |||
| 653 | (t | 389 | (t |
| 654 | (let ((folder mh-current-folder)) | 390 | (let ((folder mh-current-folder)) |
| 655 | (save-excursion | 391 | (save-excursion |
| 656 | (with-temp-buffer | 392 | (with-temp-buffer |
| 657 | (unwind-protect | 393 | (unwind-protect |
| 658 | (progn | 394 | (progn |
| 659 | (call-process (expand-file-name "mark" mh-progs) | 395 | (call-process (expand-file-name "mark" mh-progs) |
| 660 | nil '(t t) nil | 396 | nil '(t t) nil |
| 661 | folder "-seq" mh-folder-unseen-seq-name | 397 | folder "-seq" mh-folder-unseen-seq-name |
| 662 | "-list") | 398 | "-list") |
| 663 | (goto-char (point-min)) | 399 | (goto-char (point-min)) |
| 664 | (sort (mh-read-msg-list) '<))))))))) | 400 | (sort (mh-read-msg-list) '<))))))))) |
| 665 | 401 | ||
| 666 | (defvar mh-folder-unseen-seq-cache nil | 402 | (defvar mh-folder-unseen-seq-cache nil |
| 667 | "Internal cache variable used for font-lock in MH-E. | 403 | "Internal cache variable used for font-lock in MH-E. |
| @@ -713,31 +449,36 @@ is done highlighting.") | |||
| 713 | 449 | ||
| 714 | ;;; Internal variables: | 450 | ;;; Internal variables: |
| 715 | 451 | ||
| 716 | (defvar mh-last-destination nil) ;Destination of last refile or write | 452 | (defvar mh-last-destination nil) ;Destination of last refile or write |
| 717 | ;command. | 453 | ;command. |
| 718 | (defvar mh-last-destination-folder nil) ;Destination of last refile command. | 454 | (defvar mh-last-destination-folder nil) ;Destination of last refile command. |
| 719 | (defvar mh-last-destination-write nil) ;Destination of last write command. | 455 | (defvar mh-last-destination-write nil) ;Destination of last write command. |
| 720 | 456 | ||
| 721 | (defvar mh-folder-mode-map (make-keymap) | 457 | (defvar mh-folder-mode-map (make-keymap) |
| 722 | "Keymap for MH folders.") | 458 | "Keymap for MH folders.") |
| 723 | 459 | ||
| 724 | (defvar mh-delete-list nil) ;List of msg numbers to delete. | 460 | (defvar mh-delete-list nil) ;List of msg numbers to delete. |
| 725 | 461 | ||
| 726 | (defvar mh-refile-list nil) ;List of folder names in mh-seq-list. | 462 | (defvar mh-refile-list nil) ;List of folder names in mh-seq-list. |
| 727 | 463 | ||
| 728 | (defvar mh-next-direction 'forward) ;Direction to move to next message. | 464 | (defvar mh-next-direction 'forward) ;Direction to move to next message. |
| 729 | 465 | ||
| 730 | (defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or | 466 | (defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or |
| 731 | ;nil if not narrowed. | 467 | ;nil if not narrowed. |
| 732 | 468 | ||
| 733 | (defvar mh-view-ops ()) ;Stack of ops that change the folder | 469 | (defvar mh-view-ops ()) ;Stack of ops that change the folder |
| 734 | ;view (such as narrowing or threading). | 470 | ;view (such as narrowing or threading). |
| 735 | 471 | ||
| 736 | (defvar mh-first-msg-num nil) ;Number of first msg in buffer. | 472 | (defvar mh-index-data nil) ;Info about index search results |
| 473 | (defvar mh-index-previous-search nil) | ||
| 474 | (defvar mh-index-msg-checksum-map nil) | ||
| 475 | (defvar mh-index-checksum-origin-map nil) | ||
| 476 | |||
| 477 | (defvar mh-first-msg-num nil) ;Number of first msg in buffer. | ||
| 737 | 478 | ||
| 738 | (defvar mh-last-msg-num nil) ;Number of last msg in buffer. | 479 | (defvar mh-last-msg-num nil) ;Number of last msg in buffer. |
| 739 | 480 | ||
| 740 | (defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. | 481 | (defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. |
| 741 | 482 | ||
| 742 | ;;; Macros and generic functions: | 483 | ;;; Macros and generic functions: |
| 743 | 484 | ||
| @@ -751,12 +492,12 @@ is done highlighting.") | |||
| 751 | "Return \"-format\" argument for the scan program." | 492 | "Return \"-format\" argument for the scan program." |
| 752 | (if (equal mh-scan-format-file t) | 493 | (if (equal mh-scan-format-file t) |
| 753 | (list "-format" (if mh-nmh-flag | 494 | (list "-format" (if mh-nmh-flag |
| 754 | (list (mh-update-scan-format | 495 | (list (mh-update-scan-format |
| 755 | mh-scan-format-nmh mh-cmd-note)) | 496 | mh-scan-format-nmh mh-cmd-note)) |
| 756 | (list (mh-update-scan-format | 497 | (list (mh-update-scan-format |
| 757 | mh-scan-format-mh mh-cmd-note)))) | 498 | mh-scan-format-mh mh-cmd-note)))) |
| 758 | (if (not (equal mh-scan-format-file nil)) | 499 | (if (not (equal mh-scan-format-file nil)) |
| 759 | (list "-format" mh-scan-format-file)))) | 500 | (list "-format" mh-scan-format-file)))) |
| 760 | 501 | ||
| 761 | 502 | ||
| 762 | 503 | ||
| @@ -771,7 +512,7 @@ the Emacs front end to the MH mail system." | |||
| 771 | (mh-find-path) | 512 | (mh-find-path) |
| 772 | (if arg | 513 | (if arg |
| 773 | (call-interactively 'mh-visit-folder) | 514 | (call-interactively 'mh-visit-folder) |
| 774 | (mh-inc-folder))) | 515 | (mh-inc-folder))) |
| 775 | 516 | ||
| 776 | ;;;###autoload | 517 | ;;;###autoload |
| 777 | (defun mh-nmail (&optional arg) | 518 | (defun mh-nmail (&optional arg) |
| @@ -779,7 +520,7 @@ the Emacs front end to the MH mail system." | |||
| 779 | Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, | 520 | Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, |
| 780 | the Emacs front end to the MH mail system." | 521 | the Emacs front end to the MH mail system." |
| 781 | (interactive "P") | 522 | (interactive "P") |
| 782 | (mh-find-path) ; init mh-inbox | 523 | (mh-find-path) ; init mh-inbox |
| 783 | (if arg | 524 | (if arg |
| 784 | (call-interactively 'mh-visit-folder) | 525 | (call-interactively 'mh-visit-folder) |
| 785 | (mh-visit-folder mh-inbox))) | 526 | (mh-visit-folder mh-inbox))) |
| @@ -788,7 +529,6 @@ the Emacs front end to the MH mail system." | |||
| 788 | 529 | ||
| 789 | ;;; User executable MH-E commands: | 530 | ;;; User executable MH-E commands: |
| 790 | 531 | ||
| 791 | |||
| 792 | (defun mh-delete-msg (msg-or-seq) | 532 | (defun mh-delete-msg (msg-or-seq) |
| 793 | "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next. | 533 | "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next. |
| 794 | 534 | ||
| @@ -797,8 +537,7 @@ prompt for the message sequence. If variable `transient-mark-mode' is non-nil | |||
| 797 | and the mark is active, then the selected region is marked for deletion." | 537 | and the mark is active, then the selected region is marked for deletion." |
| 798 | (interactive (list (cond | 538 | (interactive (list (cond |
| 799 | ((mh-mark-active-p t) | 539 | ((mh-mark-active-p t) |
| 800 | (mh-region-to-sequence (region-beginning) (region-end)) | 540 | (mh-region-to-msg-list (region-beginning) (region-end))) |
| 801 | 'region) | ||
| 802 | (current-prefix-arg | 541 | (current-prefix-arg |
| 803 | (mh-read-seq-default "Delete" t)) | 542 | (mh-read-seq-default "Delete" t)) |
| 804 | (t | 543 | (t |
| @@ -811,11 +550,11 @@ and the mark is active, then the selected region is marked for deletion." | |||
| 811 | Default is the displayed message. If optional prefix argument is provided, | 550 | Default is the displayed message. If optional prefix argument is provided, |
| 812 | then prompt for the message sequence." | 551 | then prompt for the message sequence." |
| 813 | (interactive (list (if current-prefix-arg | 552 | (interactive (list (if current-prefix-arg |
| 814 | (mh-read-seq-default "Delete" t) | 553 | (mh-read-seq-default "Delete" t) |
| 815 | (mh-get-msg-num t)))) | 554 | (mh-get-msg-num t)))) |
| 816 | (if (numberp msg-or-seq) | 555 | (if (numberp msg-or-seq) |
| 817 | (mh-delete-a-msg msg-or-seq) | 556 | (mh-delete-a-msg msg-or-seq) |
| 818 | (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))) | 557 | (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))) |
| 819 | 558 | ||
| 820 | (defun mh-execute-commands () | 559 | (defun mh-execute-commands () |
| 821 | "Process outstanding delete and refile requests." | 560 | "Process outstanding delete and refile requests." |
| @@ -823,9 +562,9 @@ then prompt for the message sequence." | |||
| 823 | (if mh-narrowed-to-seq (mh-widen)) | 562 | (if mh-narrowed-to-seq (mh-widen)) |
| 824 | (mh-process-commands mh-current-folder) | 563 | (mh-process-commands mh-current-folder) |
| 825 | (mh-set-scan-mode) | 564 | (mh-set-scan-mode) |
| 826 | (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency | 565 | (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency |
| 827 | (mh-make-folder-mode-line) | 566 | (mh-make-folder-mode-line) |
| 828 | t) ; return t for write-file-functions | 567 | t) ; return t for write-file-functions |
| 829 | 568 | ||
| 830 | (defun mh-first-msg () | 569 | (defun mh-first-msg () |
| 831 | "Move to the first message." | 570 | "Move to the first message." |
| @@ -846,7 +585,7 @@ Type \"\\[mh-show]\" to show the message normally again." | |||
| 846 | (mh-invalidate-show-buffer)) | 585 | (mh-invalidate-show-buffer)) |
| 847 | (let ((mh-decode-mime-flag nil) | 586 | (let ((mh-decode-mime-flag nil) |
| 848 | (mhl-formfile nil) | 587 | (mhl-formfile nil) |
| 849 | (mh-clean-message-header-flag nil)) | 588 | (mh-clean-message-header-flag nil)) |
| 850 | (mh-show-msg nil) | 589 | (mh-show-msg nil) |
| 851 | (mh-in-show-buffer (mh-show-buffer) | 590 | (mh-in-show-buffer (mh-show-buffer) |
| 852 | (goto-char (point-min)) | 591 | (goto-char (point-min)) |
| @@ -862,26 +601,36 @@ The value of `mh-inc-folder-hook' is a list of functions to be called, with no | |||
| 862 | arguments, after incorporating new mail. | 601 | arguments, after incorporating new mail. |
| 863 | Do not call this function from outside MH-E; use \\[mh-rmail] instead." | 602 | Do not call this function from outside MH-E; use \\[mh-rmail] instead." |
| 864 | (interactive (list (if current-prefix-arg | 603 | (interactive (list (if current-prefix-arg |
| 865 | (expand-file-name | 604 | (expand-file-name |
| 866 | (read-file-name "inc mail from file: " | 605 | (read-file-name "inc mail from file: " |
| 867 | mh-user-path))))) | 606 | mh-user-path))))) |
| 868 | (let ((config (current-window-configuration))) | 607 | (let ((threading-needed-flag nil)) |
| 869 | (if (not maildrop-name) | 608 | (let ((config (current-window-configuration))) |
| 870 | (cond ((not (get-buffer mh-inbox)) | 609 | (if (not maildrop-name) |
| 871 | (mh-make-folder mh-inbox) | 610 | (cond ((not (get-buffer mh-inbox)) |
| 872 | (setq mh-previous-window-config config)) | 611 | (mh-make-folder mh-inbox) |
| 873 | ((not (eq (current-buffer) (get-buffer mh-inbox))) | 612 | (setq threading-needed-flag mh-show-threads-flag) |
| 874 | (switch-to-buffer mh-inbox) | 613 | (setq mh-previous-window-config config)) |
| 875 | (setq mh-previous-window-config config))))) | 614 | ((not (eq (current-buffer) (get-buffer mh-inbox))) |
| 876 | (mh-get-new-mail maildrop-name) | 615 | (switch-to-buffer mh-inbox) |
| 877 | (if mh-showing-mode (mh-show)) | 616 | (setq mh-previous-window-config config))))) |
| 878 | (run-hooks 'mh-inc-folder-hook)) | 617 | (mh-get-new-mail maildrop-name) |
| 618 | (when (and threading-needed-flag | ||
| 619 | (save-excursion | ||
| 620 | (goto-char (point-min)) | ||
| 621 | (or (null mh-large-folder) | ||
| 622 | (not (equal (forward-line mh-large-folder) 0)) | ||
| 623 | (and (message "Not threading since the number of messages exceeds `mh-large-folder'") | ||
| 624 | nil)))) | ||
| 625 | (mh-toggle-threads)) | ||
| 626 | (if mh-showing-mode (mh-show)) | ||
| 627 | (run-hooks 'mh-inc-folder-hook))) | ||
| 879 | 628 | ||
| 880 | (defun mh-last-msg () | 629 | (defun mh-last-msg () |
| 881 | "Move to the last message." | 630 | "Move to the last message." |
| 882 | (interactive) | 631 | (interactive) |
| 883 | (goto-char (point-max)) | 632 | (goto-char (point-max)) |
| 884 | (while (and (not (bobp)) (looking-at "^$")) | 633 | (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp))) |
| 885 | (forward-line -1)) | 634 | (forward-line -1)) |
| 886 | (mh-recenter nil)) | 635 | (mh-recenter nil)) |
| 887 | 636 | ||
| @@ -891,9 +640,9 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead." | |||
| 891 | (setq mh-next-direction 'forward) | 640 | (setq mh-next-direction 'forward) |
| 892 | (forward-line 1) | 641 | (forward-line 1) |
| 893 | (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg) | 642 | (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg) |
| 894 | (beginning-of-line) | 643 | (beginning-of-line) |
| 895 | (mh-maybe-show)) | 644 | (mh-maybe-show)) |
| 896 | (t (forward-line -1) | 645 | (t (forward-line -1) |
| 897 | (message "No more undeleted messages")))) | 646 | (message "No more undeleted messages")))) |
| 898 | 647 | ||
| 899 | (defun mh-refile-msg (msg-or-seq folder) | 648 | (defun mh-refile-msg (msg-or-seq folder) |
| @@ -904,32 +653,31 @@ selected region is marked for refiling." | |||
| 904 | (interactive | 653 | (interactive |
| 905 | (list (cond | 654 | (list (cond |
| 906 | ((mh-mark-active-p t) | 655 | ((mh-mark-active-p t) |
| 907 | (mh-region-to-sequence (region-beginning) (region-end)) | 656 | (mh-region-to-msg-list (region-beginning) (region-end))) |
| 908 | 'region) | ||
| 909 | (current-prefix-arg | 657 | (current-prefix-arg |
| 910 | (mh-read-seq-default "Refile" t)) | 658 | (mh-read-seq-default "Refile" t)) |
| 911 | (t | 659 | (t |
| 912 | (mh-get-msg-num t))) | 660 | (mh-get-msg-num t))) |
| 913 | (intern | 661 | (intern |
| 914 | (mh-prompt-for-folder | 662 | (mh-prompt-for-folder |
| 915 | "Destination" | 663 | "Destination" |
| 916 | (or (and mh-default-folder-for-message-function | 664 | (or (and mh-default-folder-for-message-function |
| 917 | (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) | 665 | (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) |
| 918 | (save-excursion | 666 | (save-excursion |
| 919 | (set-buffer (get-buffer-create mh-temp-buffer)) | 667 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 920 | (erase-buffer) | 668 | (erase-buffer) |
| 921 | (insert-file-contents refile-file) | 669 | (insert-file-contents refile-file) |
| 922 | (let ((buffer-file-name refile-file)) | 670 | (let ((buffer-file-name refile-file)) |
| 923 | (funcall mh-default-folder-for-message-function))))) | 671 | (funcall mh-default-folder-for-message-function))))) |
| 924 | (and (eq 'refile (car mh-last-destination-folder)) | 672 | (and (eq 'refile (car mh-last-destination-folder)) |
| 925 | (symbol-name (cdr mh-last-destination-folder))) | 673 | (symbol-name (cdr mh-last-destination-folder))) |
| 926 | "") | 674 | "") |
| 927 | t)))) | 675 | t)))) |
| 928 | (setq mh-last-destination (cons 'refile folder) | 676 | (setq mh-last-destination (cons 'refile folder) |
| 929 | mh-last-destination-folder mh-last-destination) | 677 | mh-last-destination-folder mh-last-destination) |
| 930 | (if (numberp msg-or-seq) | 678 | (if (numberp msg-or-seq) |
| 931 | (mh-refile-a-msg msg-or-seq folder) | 679 | (mh-refile-a-msg msg-or-seq folder) |
| 932 | (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)) | 680 | (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)) |
| 933 | (mh-next-msg)) | 681 | (mh-next-msg)) |
| 934 | 682 | ||
| 935 | (defun mh-refile-or-write-again (message) | 683 | (defun mh-refile-or-write-again (message) |
| @@ -940,11 +688,11 @@ refile or write command." | |||
| 940 | (if (null mh-last-destination) | 688 | (if (null mh-last-destination) |
| 941 | (error "No previous refile or write")) | 689 | (error "No previous refile or write")) |
| 942 | (cond ((eq (car mh-last-destination) 'refile) | 690 | (cond ((eq (car mh-last-destination) 'refile) |
| 943 | (mh-refile-a-msg message (cdr mh-last-destination)) | 691 | (mh-refile-a-msg message (cdr mh-last-destination)) |
| 944 | (message "Destination folder: %s" (cdr mh-last-destination))) | 692 | (message "Destination folder: %s" (cdr mh-last-destination))) |
| 945 | (t | 693 | (t |
| 946 | (apply 'mh-write-msg-to-file message (cdr mh-last-destination)) | 694 | (apply 'mh-write-msg-to-file message (cdr mh-last-destination)) |
| 947 | (message "Destination: %s" (cdr mh-last-destination)))) | 695 | (message "Destination: %s" (cdr mh-last-destination)))) |
| 948 | (mh-next-msg)) | 696 | (mh-next-msg)) |
| 949 | 697 | ||
| 950 | (defun mh-quit () | 698 | (defun mh-quit () |
| @@ -980,20 +728,20 @@ bottom of the current message." | |||
| 980 | (interactive "P") | 728 | (interactive "P") |
| 981 | (if mh-showing-mode | 729 | (if mh-showing-mode |
| 982 | (if mh-page-to-next-msg-flag | 730 | (if mh-page-to-next-msg-flag |
| 983 | (if (equal mh-next-direction 'backward) | 731 | (if (equal mh-next-direction 'backward) |
| 984 | (mh-previous-undeleted-msg) | 732 | (mh-previous-undeleted-msg) |
| 985 | (mh-next-undeleted-msg)) | 733 | (mh-next-undeleted-msg)) |
| 986 | (if (mh-in-show-buffer (mh-show-buffer) | 734 | (if (mh-in-show-buffer (mh-show-buffer) |
| 987 | (pos-visible-in-window-p (point-max))) | 735 | (pos-visible-in-window-p (point-max))) |
| 988 | (progn | 736 | (progn |
| 989 | (message (format | 737 | (message (format |
| 990 | "End of message (Type %s to read %s undeleted message)" | 738 | "End of message (Type %s to read %s undeleted message)" |
| 991 | (single-key-description last-input-event) | 739 | (single-key-description last-input-event) |
| 992 | (if (equal mh-next-direction 'backward) | 740 | (if (equal mh-next-direction 'backward) |
| 993 | "previous" | 741 | "previous" |
| 994 | "next"))) | 742 | "next"))) |
| 995 | (setq mh-page-to-next-msg-flag t)) | 743 | (setq mh-page-to-next-msg-flag t)) |
| 996 | (scroll-other-window arg))) | 744 | (scroll-other-window arg))) |
| 997 | (mh-show))) | 745 | (mh-show))) |
| 998 | 746 | ||
| 999 | (defun mh-previous-page (&optional arg) | 747 | (defun mh-previous-page (&optional arg) |
| @@ -1009,8 +757,39 @@ Scrolls ARG lines or a full screen if no argument is supplied." | |||
| 1009 | (setq mh-next-direction 'backward) | 757 | (setq mh-next-direction 'backward) |
| 1010 | (beginning-of-line) | 758 | (beginning-of-line) |
| 1011 | (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg) | 759 | (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg) |
| 1012 | (mh-maybe-show)) | 760 | (mh-maybe-show)) |
| 1013 | (t (message "No previous undeleted message")))) | 761 | (t (message "No previous undeleted message")))) |
| 762 | |||
| 763 | (defun mh-previous-unread-msg (&optional count) | ||
| 764 | "Move to previous unread message. | ||
| 765 | With optional argument COUNT, COUNT-1 unread messages before current message | ||
| 766 | are skipped." | ||
| 767 | (interactive "p") | ||
| 768 | (unless (> count 0) | ||
| 769 | (error "The function mh-previous-unread-msg expects positive argument")) | ||
| 770 | (setq count (1- count)) | ||
| 771 | (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list))) | ||
| 772 | (cur-msg (mh-get-msg-num nil))) | ||
| 773 | (cond ((and (not cur-msg) (not (bobp)) | ||
| 774 | ;; If we are at the end of the buffer back up one line and go | ||
| 775 | ;; to unread message after that. | ||
| 776 | (progn | ||
| 777 | (forward-line -1) | ||
| 778 | (setq cur-msg (mh-get-msg-num nil))) | ||
| 779 | nil)) | ||
| 780 | ((or (null unread-sequence) (not cur-msg)) | ||
| 781 | ;; No unread message or there aren't any messages in buffer... | ||
| 782 | (message "No more unread messages")) | ||
| 783 | ((progn | ||
| 784 | ;; Skip count messages... | ||
| 785 | (while (and unread-sequence (>= (car unread-sequence) cur-msg)) | ||
| 786 | (setq unread-sequence (cdr unread-sequence))) | ||
| 787 | (while (> count 0) | ||
| 788 | (setq unread-sequence (cdr unread-sequence)) | ||
| 789 | (setq count (1- count))) | ||
| 790 | (not (car unread-sequence))) | ||
| 791 | (message "No more unread messages")) | ||
| 792 | (t (mh-goto-msg (car unread-sequence)))))) | ||
| 1014 | 793 | ||
| 1015 | (defun mh-goto-next-button (backward-flag &optional criterion) | 794 | (defun mh-goto-next-button (backward-flag &optional criterion) |
| 1016 | "Search for next button satisfying criterion. | 795 | "Search for next button satisfying criterion. |
| @@ -1025,35 +804,35 @@ function must return non-nil at the button we stop." | |||
| 1025 | (beginning-of-line) | 804 | (beginning-of-line) |
| 1026 | ;; Find point before current button | 805 | ;; Find point before current button |
| 1027 | (let ((point-before-current-button | 806 | (let ((point-before-current-button |
| 1028 | (save-excursion | 807 | (save-excursion |
| 1029 | (while (get-text-property (point) 'mh-data) | 808 | (while (get-text-property (point) 'mh-data) |
| 1030 | (unless (= (forward-line | 809 | (unless (= (forward-line |
| 1031 | (if backward-flag 1 -1)) | 810 | (if backward-flag 1 -1)) |
| 1032 | 0) | 811 | 0) |
| 1033 | (if backward-flag | 812 | (if backward-flag |
| 1034 | (goto-char (point-min)) | 813 | (goto-char (point-min)) |
| 1035 | (goto-char (point-max))))) | 814 | (goto-char (point-max))))) |
| 1036 | (point)))) | 815 | (point)))) |
| 1037 | ;; Skip over current button | 816 | ;; Skip over current button |
| 1038 | (while (and (get-text-property (point) 'mh-data) | 817 | (while (and (get-text-property (point) 'mh-data) |
| 1039 | (not (if backward-flag (bobp) (eobp)))) | 818 | (not (if backward-flag (bobp) (eobp)))) |
| 1040 | (forward-line (if backward-flag -1 1))) | 819 | (forward-line (if backward-flag -1 1))) |
| 1041 | ;; Stop at next MIME button if any exists. | 820 | ;; Stop at next MIME button if any exists. |
| 1042 | (block loop | 821 | (block loop |
| 1043 | (while (/= (progn | 822 | (while (/= (progn |
| 1044 | (unless (= (forward-line | 823 | (unless (= (forward-line |
| 1045 | (if backward-flag -1 1)) | 824 | (if backward-flag -1 1)) |
| 1046 | 0) | 825 | 0) |
| 1047 | (if backward-flag | 826 | (if backward-flag |
| 1048 | (goto-char (point-max)) | 827 | (goto-char (point-max)) |
| 1049 | (goto-char (point-min))) | 828 | (goto-char (point-min))) |
| 1050 | (beginning-of-line)) | 829 | (beginning-of-line)) |
| 1051 | (point)) | 830 | (point)) |
| 1052 | point-before-current-button) | 831 | point-before-current-button) |
| 1053 | (when (and (get-text-property (point) 'mh-data) | 832 | (when (and (get-text-property (point) 'mh-data) |
| 1054 | (funcall criterion (point))) | 833 | (funcall criterion (point))) |
| 1055 | (return-from loop (point)))) | 834 | (return-from loop (point)))) |
| 1056 | nil))) | 835 | nil))) |
| 1057 | (point)))) | 836 | (point)))) |
| 1058 | 837 | ||
| 1059 | (defun mh-next-button (&optional backward-flag) | 838 | (defun mh-next-button (&optional backward-flag) |
| @@ -1086,14 +865,14 @@ searching for a suitable parts." | |||
| 1086 | (mh-show)) | 865 | (mh-show)) |
| 1087 | (mh-in-show-buffer (mh-show-buffer) | 866 | (mh-in-show-buffer (mh-show-buffer) |
| 1088 | (let ((criterion | 867 | (let ((criterion |
| 1089 | (cond (part-index | 868 | (cond (part-index |
| 1090 | (lambda (p) | 869 | (lambda (p) |
| 1091 | (let ((part (get-text-property p 'mh-part))) | 870 | (let ((part (get-text-property p 'mh-part))) |
| 1092 | (and (integerp part) (= part part-index))))) | 871 | (and (integerp part) (= part part-index))))) |
| 1093 | (t (lambda (p) | 872 | (t (lambda (p) |
| 1094 | (if include-security-flag | 873 | (if include-security-flag |
| 1095 | (get-text-property p 'mh-data) | 874 | (get-text-property p 'mh-data) |
| 1096 | (integerp (get-text-property p 'mh-part))))))) | 875 | (integerp (get-text-property p 'mh-part))))))) |
| 1097 | (point (point))) | 876 | (point (point))) |
| 1098 | (cond ((and (get-text-property point 'mh-part) | 877 | (cond ((and (get-text-property point 'mh-part) |
| 1099 | (or (null part-index) | 878 | (or (null part-index) |
| @@ -1153,11 +932,14 @@ messages to display. Otherwise show the entire folder. | |||
| 1153 | If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and | 932 | If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and |
| 1154 | refiles aren't carried out." | 933 | refiles aren't carried out." |
| 1155 | (interactive (list (if current-prefix-arg | 934 | (interactive (list (if current-prefix-arg |
| 1156 | (mh-read-msg-range "Range to scan [all]? ") | 935 | (mh-read-msg-range mh-current-folder t) |
| 1157 | nil))) | 936 | nil))) |
| 1158 | (setq mh-next-direction 'forward) | 937 | (setq mh-next-direction 'forward) |
| 1159 | (mh-reset-threads-and-narrowing) | 938 | (let ((threaded-flag (memq 'unthread mh-view-ops))) |
| 1160 | (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)) | 939 | (mh-reset-threads-and-narrowing) |
| 940 | (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending) | ||
| 941 | (cond (threaded-flag (mh-toggle-threads)) | ||
| 942 | (mh-index-data (mh-index-insert-folder-headers))))) | ||
| 1161 | 943 | ||
| 1162 | (defun mh-write-msg-to-file (msg file no-headers) | 944 | (defun mh-write-msg-to-file (msg file no-headers) |
| 1163 | "Append MSG to the end of a FILE. | 945 | "Append MSG to the end of a FILE. |
| @@ -1165,21 +947,21 @@ If prefix argument NO-HEADERS is provided, write only the message body. | |||
| 1165 | Otherwise send the entire message including the headers." | 947 | Otherwise send the entire message including the headers." |
| 1166 | (interactive | 948 | (interactive |
| 1167 | (list (mh-get-msg-num t) | 949 | (list (mh-get-msg-num t) |
| 1168 | (let ((default-dir (if (eq 'write (car mh-last-destination-write)) | 950 | (let ((default-dir (if (eq 'write (car mh-last-destination-write)) |
| 1169 | (file-name-directory | 951 | (file-name-directory |
| 1170 | (car (cdr mh-last-destination-write))) | 952 | (car (cdr mh-last-destination-write))) |
| 1171 | default-directory))) | 953 | default-directory))) |
| 1172 | (read-file-name (format "Save message%s in file: " | 954 | (read-file-name (format "Save message%s in file: " |
| 1173 | (if current-prefix-arg " body" "")) | 955 | (if current-prefix-arg " body" "")) |
| 1174 | default-dir | 956 | default-dir |
| 1175 | (if (eq 'write (car mh-last-destination-write)) | 957 | (if (eq 'write (car mh-last-destination-write)) |
| 1176 | (car (cdr mh-last-destination-write)) | 958 | (car (cdr mh-last-destination-write)) |
| 1177 | (expand-file-name "mail.out" default-dir)))) | 959 | (expand-file-name "mail.out" default-dir)))) |
| 1178 | current-prefix-arg)) | 960 | current-prefix-arg)) |
| 1179 | (let ((msg-file-to-output (mh-msg-filename msg)) | 961 | (let ((msg-file-to-output (mh-msg-filename msg)) |
| 1180 | (output-file (mh-expand-file-name file))) | 962 | (output-file (mh-expand-file-name file))) |
| 1181 | (setq mh-last-destination (list 'write file (if no-headers 'no-headers)) | 963 | (setq mh-last-destination (list 'write file (if no-headers 'no-headers)) |
| 1182 | mh-last-destination-write mh-last-destination) | 964 | mh-last-destination-write mh-last-destination) |
| 1183 | (save-excursion | 965 | (save-excursion |
| 1184 | (set-buffer (get-buffer-create mh-temp-buffer)) | 966 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 1185 | (erase-buffer) | 967 | (erase-buffer) |
| @@ -1203,33 +985,61 @@ If variable `transient-mark-mode' is non-nil and the mark is active, then the | |||
| 1203 | selected region is unmarked." | 985 | selected region is unmarked." |
| 1204 | (interactive (list (cond | 986 | (interactive (list (cond |
| 1205 | ((mh-mark-active-p t) | 987 | ((mh-mark-active-p t) |
| 1206 | (mh-region-to-sequence (region-beginning) (region-end)) | 988 | (mh-region-to-msg-list (region-beginning) (region-end))) |
| 1207 | 'region) | ||
| 1208 | (current-prefix-arg | 989 | (current-prefix-arg |
| 1209 | (mh-read-seq-default "Undo" t)) | 990 | (mh-read-seq-default "Undo" t)) |
| 1210 | (t | 991 | (t |
| 1211 | (mh-get-msg-num t))))) | 992 | (mh-get-msg-num t))))) |
| 1212 | (cond ((numberp msg-or-seq) | 993 | (cond ((numberp msg-or-seq) |
| 1213 | (let ((original-position (point))) | 994 | (let ((original-position (point))) |
| 1214 | (beginning-of-line) | 995 | (beginning-of-line) |
| 1215 | (while (not (or (looking-at mh-scan-deleted-msg-regexp) | 996 | (while (not (or (looking-at mh-scan-deleted-msg-regexp) |
| 1216 | (looking-at mh-scan-refiled-msg-regexp) | 997 | (looking-at mh-scan-refiled-msg-regexp) |
| 1217 | (and (eq mh-next-direction 'forward) (bobp)) | 998 | (and (eq mh-next-direction 'forward) (bobp)) |
| 1218 | (and (eq mh-next-direction 'backward) | 999 | (and (eq mh-next-direction 'backward) |
| 1219 | (save-excursion (forward-line) (eobp))))) | 1000 | (save-excursion (forward-line) (eobp))))) |
| 1220 | (forward-line (if (eq mh-next-direction 'forward) -1 1))) | 1001 | (forward-line (if (eq mh-next-direction 'forward) -1 1))) |
| 1221 | (if (or (looking-at mh-scan-deleted-msg-regexp) | 1002 | (if (or (looking-at mh-scan-deleted-msg-regexp) |
| 1222 | (looking-at mh-scan-refiled-msg-regexp)) | 1003 | (looking-at mh-scan-refiled-msg-regexp)) |
| 1223 | (progn | 1004 | (progn |
| 1224 | (mh-undo-msg (mh-get-msg-num t)) | 1005 | (mh-undo-msg (mh-get-msg-num t)) |
| 1225 | (mh-maybe-show)) | 1006 | (mh-maybe-show)) |
| 1226 | (goto-char original-position) | 1007 | (goto-char original-position) |
| 1227 | (error "Nothing to undo")))) | 1008 | (error "Nothing to undo")))) |
| 1228 | (t | 1009 | (t |
| 1229 | (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq))) | 1010 | (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq))) |
| 1230 | (if (not (mh-outstanding-commands-p)) | 1011 | (if (not (mh-outstanding-commands-p)) |
| 1231 | (mh-set-folder-modified-p nil))) | 1012 | (mh-set-folder-modified-p nil))) |
| 1232 | 1013 | ||
| 1014 | ;;;###mh-autoload | ||
| 1015 | (defun mh-folder-line-matches-show-buffer-p () | ||
| 1016 | "Return t if the message under point in folder-mode is in the show buffer. | ||
| 1017 | Return nil in any other circumstance (no message under point, no show buffer, | ||
| 1018 | the message in the show buffer doesn't match." | ||
| 1019 | (and (eq major-mode 'mh-folder-mode) | ||
| 1020 | (mh-get-msg-num nil) | ||
| 1021 | mh-show-buffer | ||
| 1022 | (get-buffer mh-show-buffer) | ||
| 1023 | (buffer-file-name (get-buffer mh-show-buffer)) | ||
| 1024 | (string-match ".*/\\([0-9]+\\)$" | ||
| 1025 | (buffer-file-name (get-buffer mh-show-buffer))) | ||
| 1026 | (string-equal | ||
| 1027 | (match-string 1 (buffer-file-name (get-buffer mh-show-buffer))) | ||
| 1028 | (int-to-string (mh-get-msg-num nil))))) | ||
| 1029 | |||
| 1030 | (eval-when-compile (require 'gnus)) | ||
| 1031 | |||
| 1032 | (defmacro mh-macro-expansion-time-gnus-version () | ||
| 1033 | "Return Gnus version available at macro expansion time. | ||
| 1034 | The macro evaluates the Gnus version at macro expansion time. If MH-E was | ||
| 1035 | compiled then macro expansion happens at compile time." | ||
| 1036 | gnus-version) | ||
| 1037 | |||
| 1038 | (defun mh-run-time-gnus-version () | ||
| 1039 | "Return Gnus version available at run time." | ||
| 1040 | (require 'gnus) | ||
| 1041 | gnus-version) | ||
| 1042 | |||
| 1233 | ;;;###autoload | 1043 | ;;;###autoload |
| 1234 | (defun mh-version () | 1044 | (defun mh-version () |
| 1235 | "Display version information about MH-E and the MH mail handling system." | 1045 | "Display version information about MH-E and the MH mail handling system." |
| @@ -1237,22 +1047,33 @@ selected region is unmarked." | |||
| 1237 | (mh-find-progs) | 1047 | (mh-find-progs) |
| 1238 | (set-buffer (get-buffer-create mh-temp-buffer)) | 1048 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 1239 | (erase-buffer) | 1049 | (erase-buffer) |
| 1240 | ;; MH-E and Emacs versions. | 1050 | ;; MH-E version. |
| 1241 | (insert "MH-E " mh-version "\n\n" (emacs-version) "\n\n") | 1051 | (insert "MH-E " mh-version "\n\n") |
| 1052 | ;; MH-E compilation details. | ||
| 1053 | (insert "MH-E compilation details:\n") | ||
| 1054 | (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version))) | ||
| 1055 | (gnus-compiled-version (if compiled-mhe | ||
| 1056 | (mh-macro-expansion-time-gnus-version) | ||
| 1057 | "N/A"))) | ||
| 1058 | (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n" | ||
| 1059 | " Gnus (compile-time):\t" gnus-compiled-version "\n" | ||
| 1060 | " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n")) | ||
| 1061 | ;; Emacs version. | ||
| 1062 | (insert (emacs-version) "\n\n") | ||
| 1242 | ;; MH version. | 1063 | ;; MH version. |
| 1243 | (let ((help-start (point))) | 1064 | (let ((help-start (point))) |
| 1244 | (condition-case err-data | 1065 | (condition-case err-data |
| 1245 | (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help")) | 1066 | (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help")) |
| 1246 | (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n"))) | 1067 | (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n"))) |
| 1247 | (goto-char help-start) | 1068 | (goto-char help-start) |
| 1248 | (if mh-nmh-flag | 1069 | (if mh-nmh-flag |
| 1249 | (search-forward "inc -- " nil t) | 1070 | (search-forward "inc -- " nil t) |
| 1250 | (search-forward "version: " nil t)) | 1071 | (search-forward "version: " nil t)) |
| 1251 | (delete-region help-start (point))) | 1072 | (delete-region help-start (point))) |
| 1252 | (goto-char (point-max)) | 1073 | (goto-char (point-max)) |
| 1253 | (insert "mh-progs:\t" mh-progs "\n" | 1074 | (insert " mh-progs:\t" mh-progs "\n" |
| 1254 | "mh-lib:\t\t" mh-lib "\n" | 1075 | " mh-lib:\t" mh-lib "\n" |
| 1255 | "mh-lib-progs:\t" mh-lib-progs "\n\n") | 1076 | " mh-lib-progs:\t" mh-lib-progs "\n\n") |
| 1256 | ;; Linux version. | 1077 | ;; Linux version. |
| 1257 | (condition-case () | 1078 | (condition-case () |
| 1258 | (call-process "uname" nil t nil "-a") | 1079 | (call-process "uname" nil t nil "-a") |
| @@ -1260,16 +1081,80 @@ selected region is unmarked." | |||
| 1260 | (goto-char (point-min)) | 1081 | (goto-char (point-min)) |
| 1261 | (display-buffer mh-temp-buffer)) | 1082 | (display-buffer mh-temp-buffer)) |
| 1262 | 1083 | ||
| 1263 | (defun mh-visit-folder (folder &optional range) | 1084 | (defun mh-parse-flist-output-line (line) |
| 1085 | "Parse LINE to generate folder name, unseen messages and total messages." | ||
| 1086 | (with-temp-buffer | ||
| 1087 | (insert line) | ||
| 1088 | (goto-char (point-max)) | ||
| 1089 | (let (folder unseen total p) | ||
| 1090 | (when (search-backward " out of " (point-min) t) | ||
| 1091 | (setq total (read-from-string | ||
| 1092 | (buffer-substring-no-properties | ||
| 1093 | (match-end 0) (line-end-position)))) | ||
| 1094 | (when (search-backward " in sequence " (point-min) t) | ||
| 1095 | (setq p (point)) | ||
| 1096 | (when (search-backward " has " (point-min) t) | ||
| 1097 | (setq unseen (read-from-string (buffer-substring-no-properties | ||
| 1098 | (match-end 0) p))) | ||
| 1099 | (while (or (eq (char-after) ?+) (eq (char-after) ? )) | ||
| 1100 | (backward-char)) | ||
| 1101 | (setq folder (buffer-substring-no-properties | ||
| 1102 | (point-min) (1+ (point)))) | ||
| 1103 | (values (format "+%s" folder) (car unseen) (car total)))))))) | ||
| 1104 | |||
| 1105 | (defun mh-folder-size (folder) | ||
| 1106 | "Find size of FOLDER." | ||
| 1107 | (with-temp-buffer | ||
| 1108 | (call-process (expand-file-name "flist" mh-progs) nil t nil | ||
| 1109 | "-norecurse" folder) | ||
| 1110 | (goto-char (point-min)) | ||
| 1111 | (multiple-value-bind (folder1 unseen total) | ||
| 1112 | (mh-parse-flist-output-line | ||
| 1113 | (buffer-substring (point) (line-end-position))) | ||
| 1114 | (unless (equal folder folder1) | ||
| 1115 | (error "Call to flist failed on folder %s" folder)) | ||
| 1116 | (values total unseen)))) | ||
| 1117 | |||
| 1118 | (defun mh-visit-folder (folder &optional range index-data) | ||
| 1264 | "Visit FOLDER and display RANGE of messages. | 1119 | "Visit FOLDER and display RANGE of messages. |
| 1265 | Do not call this function from outside MH-E; see \\[mh-rmail] instead." | 1120 | Do not call this function from outside MH-E; see \\[mh-rmail] instead. |
| 1266 | (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t) | 1121 | |
| 1267 | (mh-read-msg-range "Range [all]? "))) | 1122 | If RANGE is nil (the default if it is omitted when called non-interactively), |
| 1268 | (let ((config (current-window-configuration))) | 1123 | then all messages in FOLDER are displayed. |
| 1124 | |||
| 1125 | If an index buffer is being created then INDEX-DATA is used to initialize the | ||
| 1126 | index buffer specific data structures." | ||
| 1127 | (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t))) | ||
| 1128 | (list folder-name (mh-read-msg-range folder-name)))) | ||
| 1129 | (let ((config (current-window-configuration)) | ||
| 1130 | (threaded-view-flag mh-show-threads-flag)) | ||
| 1131 | (save-excursion | ||
| 1132 | (when (get-buffer folder) | ||
| 1133 | (set-buffer folder) | ||
| 1134 | (setq threaded-view-flag (memq 'unthread mh-view-ops)) | ||
| 1135 | (mh-reset-threads-and-narrowing))) | ||
| 1136 | (when index-data | ||
| 1137 | (mh-make-folder folder) | ||
| 1138 | (setq mh-index-data (car index-data) | ||
| 1139 | mh-index-msg-checksum-map (make-hash-table :test #'equal) | ||
| 1140 | mh-index-checksum-origin-map (make-hash-table :test #'equal)) | ||
| 1141 | (mh-index-update-maps folder (cadr index-data))) | ||
| 1269 | (mh-scan-folder folder (or range "all")) | 1142 | (mh-scan-folder folder (or range "all")) |
| 1143 | (cond ((and threaded-view-flag | ||
| 1144 | (save-excursion | ||
| 1145 | (goto-char (point-min)) | ||
| 1146 | (or (null mh-large-folder) | ||
| 1147 | (not (equal (forward-line mh-large-folder) 0)) | ||
| 1148 | (and (message "Not threading since the number of messages exceeds `mh-large-folder'") | ||
| 1149 | nil)))) | ||
| 1150 | (mh-toggle-threads)) | ||
| 1151 | (mh-index-data | ||
| 1152 | (mh-index-insert-folder-headers))) | ||
| 1153 | (unless mh-showing-mode (delete-other-windows)) | ||
| 1270 | (setq mh-previous-window-config config)) | 1154 | (setq mh-previous-window-config config)) |
| 1271 | nil) | 1155 | nil) |
| 1272 | 1156 | ||
| 1157 | ;;;###mh-autoload | ||
| 1273 | (defun mh-update-sequences () | 1158 | (defun mh-update-sequences () |
| 1274 | "Update MH's Unseen-Sequence and current folder and message. | 1159 | "Update MH's Unseen-Sequence and current folder and message. |
| 1275 | Flush MH-E's state out to MH. The message at the cursor becomes current." | 1160 | Flush MH-E's state out to MH. The message at the cursor becomes current." |
| @@ -1277,17 +1162,18 @@ Flush MH-E's state out to MH. The message at the cursor becomes current." | |||
| 1277 | ;; mh-update-sequences is the opposite of mh-read-folder-sequences, | 1162 | ;; mh-update-sequences is the opposite of mh-read-folder-sequences, |
| 1278 | ;; which updates MH-E's state from MH. | 1163 | ;; which updates MH-E's state from MH. |
| 1279 | (let ((folder-set (mh-update-unseen)) | 1164 | (let ((folder-set (mh-update-unseen)) |
| 1280 | (new-cur (mh-get-msg-num nil))) | 1165 | (new-cur (mh-get-msg-num nil))) |
| 1281 | (if new-cur | 1166 | (if new-cur |
| 1282 | (let ((seq-entry (mh-find-seq 'cur))) | 1167 | (let ((seq-entry (mh-find-seq 'cur))) |
| 1283 | (mh-remove-cur-notation) | 1168 | (mh-remove-cur-notation) |
| 1284 | (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq | 1169 | (setcdr seq-entry |
| 1285 | (mh-define-sequence 'cur (list new-cur)) | 1170 | (list new-cur)) ;delete-seq-locally, add-msgs-to-seq |
| 1286 | (beginning-of-line) | 1171 | (mh-define-sequence 'cur (list new-cur)) |
| 1287 | (if (looking-at mh-scan-good-msg-regexp) | 1172 | (beginning-of-line) |
| 1288 | (mh-notate nil mh-note-cur mh-cmd-note))) | 1173 | (if (looking-at mh-scan-good-msg-regexp) |
| 1174 | (mh-notate nil mh-note-cur mh-cmd-note))) | ||
| 1289 | (or folder-set | 1175 | (or folder-set |
| 1290 | (save-excursion | 1176 | (save-excursion |
| 1291 | ;; psg - mh-current-folder is nil if mh-summary-height < 4 ! | 1177 | ;; psg - mh-current-folder is nil if mh-summary-height < 4 ! |
| 1292 | ;; So I added this sanity check. | 1178 | ;; So I added this sanity check. |
| 1293 | (if (stringp mh-current-folder) | 1179 | (if (stringp mh-current-folder) |
| @@ -1305,13 +1191,13 @@ arguments, after the message has been deleted." | |||
| 1305 | (save-excursion | 1191 | (save-excursion |
| 1306 | (mh-goto-msg msg nil t) | 1192 | (mh-goto-msg msg nil t) |
| 1307 | (if (looking-at mh-scan-refiled-msg-regexp) | 1193 | (if (looking-at mh-scan-refiled-msg-regexp) |
| 1308 | (error "Message %d is refiled. Undo refile before deleting" msg)) | 1194 | (error "Message %d is refiled. Undo refile before deleting" msg)) |
| 1309 | (if (looking-at mh-scan-deleted-msg-regexp) | 1195 | (if (looking-at mh-scan-deleted-msg-regexp) |
| 1310 | nil | 1196 | nil |
| 1311 | (mh-set-folder-modified-p t) | 1197 | (mh-set-folder-modified-p t) |
| 1312 | (setq mh-delete-list (cons msg mh-delete-list)) | 1198 | (setq mh-delete-list (cons msg mh-delete-list)) |
| 1313 | (mh-notate msg mh-note-deleted mh-cmd-note) | 1199 | (mh-notate msg mh-note-deleted mh-cmd-note) |
| 1314 | (run-hooks 'mh-delete-msg-hook)))) | 1200 | (run-hooks 'mh-delete-msg-hook)))) |
| 1315 | 1201 | ||
| 1316 | (defun mh-refile-a-msg (msg folder) | 1202 | (defun mh-refile-a-msg (msg folder) |
| 1317 | "Refile MSG in FOLDER. | 1203 | "Refile MSG in FOLDER. |
| @@ -1321,28 +1207,59 @@ arguments, after the message has been refiled." | |||
| 1321 | (save-excursion | 1207 | (save-excursion |
| 1322 | (mh-goto-msg msg nil t) | 1208 | (mh-goto-msg msg nil t) |
| 1323 | (cond ((looking-at mh-scan-deleted-msg-regexp) | 1209 | (cond ((looking-at mh-scan-deleted-msg-regexp) |
| 1324 | (error "Message %d is deleted. Undo delete before moving" msg)) | 1210 | (error "Message %d is deleted. Undo delete before moving" msg)) |
| 1325 | ((looking-at mh-scan-refiled-msg-regexp) | 1211 | ((looking-at mh-scan-refiled-msg-regexp) |
| 1326 | (if (y-or-n-p | 1212 | (if (y-or-n-p |
| 1327 | (format "Message %d already refiled. Copy to %s as well? " | 1213 | (format "Message %d already refiled. Copy to %s as well? " |
| 1328 | msg folder)) | 1214 | msg folder)) |
| 1329 | (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" | 1215 | (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" |
| 1330 | "-src" mh-current-folder | 1216 | "-src" mh-current-folder |
| 1331 | (symbol-name folder)) | 1217 | (symbol-name folder)) |
| 1332 | (message "Message not copied."))) | 1218 | (message "Message not copied."))) |
| 1333 | (t | 1219 | (t |
| 1334 | (mh-set-folder-modified-p t) | 1220 | (mh-set-folder-modified-p t) |
| 1335 | (if (null (assoc folder mh-refile-list)) | 1221 | (cond ((null (assoc folder mh-refile-list)) |
| 1336 | (push (list folder msg) mh-refile-list) | 1222 | (push (list folder msg) mh-refile-list)) |
| 1337 | (pushnew msg (cdr (assoc folder mh-refile-list)))) | 1223 | ((not (member msg (cdr (assoc folder mh-refile-list)))) |
| 1338 | (mh-notate msg mh-note-refiled mh-cmd-note) | 1224 | (push msg (cdr (assoc folder mh-refile-list))))) |
| 1339 | (run-hooks 'mh-refile-msg-hook))))) | 1225 | (mh-notate msg mh-note-refiled mh-cmd-note) |
| 1226 | (run-hooks 'mh-refile-msg-hook))))) | ||
| 1340 | 1227 | ||
| 1341 | (defun mh-next-msg () | 1228 | (defun mh-next-msg () |
| 1342 | "Move backward or forward to the next undeleted message in the buffer." | 1229 | "Move backward or forward to the next undeleted message in the buffer." |
| 1343 | (if (eq mh-next-direction 'forward) | 1230 | (if (eq mh-next-direction 'forward) |
| 1344 | (mh-next-undeleted-msg 1) | 1231 | (mh-next-undeleted-msg 1) |
| 1345 | (mh-previous-undeleted-msg 1))) | 1232 | (mh-previous-undeleted-msg 1))) |
| 1233 | |||
| 1234 | (defun mh-next-unread-msg (&optional count) | ||
| 1235 | "Move to next unread message. | ||
| 1236 | With optional argument COUNT, COUNT-1 unread messages are skipped." | ||
| 1237 | (interactive "p") | ||
| 1238 | (unless (> count 0) | ||
| 1239 | (error "The function mh-next-unread-msg expects positive argument")) | ||
| 1240 | (setq count (1- count)) | ||
| 1241 | (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list)))) | ||
| 1242 | (cur-msg (mh-get-msg-num nil))) | ||
| 1243 | (cond ((and (not cur-msg) (not (bobp)) | ||
| 1244 | ;; If we are at the end of the buffer back up one line and go | ||
| 1245 | ;; to unread message after that. | ||
| 1246 | (progn | ||
| 1247 | (forward-line -1) | ||
| 1248 | (setq cur-msg (mh-get-msg-num nil))) | ||
| 1249 | nil)) | ||
| 1250 | ((or (null unread-sequence) (not cur-msg)) | ||
| 1251 | ;; No unread message or there aren't any messages in buffer... | ||
| 1252 | (message "No more unread messages")) | ||
| 1253 | ((progn | ||
| 1254 | ;; Skip messages | ||
| 1255 | (while (and unread-sequence (>= cur-msg (car unread-sequence))) | ||
| 1256 | (setq unread-sequence (cdr unread-sequence))) | ||
| 1257 | (while (> count 0) | ||
| 1258 | (setq unread-sequence (cdr unread-sequence)) | ||
| 1259 | (setq count (1- count))) | ||
| 1260 | (not (car unread-sequence))) | ||
| 1261 | (message "No more unread messages")) | ||
| 1262 | (t (mh-goto-msg (car unread-sequence)))))) | ||
| 1346 | 1263 | ||
| 1347 | (defun mh-set-scan-mode () | 1264 | (defun mh-set-scan-mode () |
| 1348 | "Display the scan listing buffer, but do not show a message." | 1265 | "Display the scan listing buffer, but do not show a message." |
| @@ -1356,12 +1273,12 @@ arguments, after the message has been refiled." | |||
| 1356 | (defun mh-undo-msg (msg) | 1273 | (defun mh-undo-msg (msg) |
| 1357 | "Undo the deletion or refile of one MSG." | 1274 | "Undo the deletion or refile of one MSG." |
| 1358 | (cond ((memq msg mh-delete-list) | 1275 | (cond ((memq msg mh-delete-list) |
| 1359 | (setq mh-delete-list (delq msg mh-delete-list))) | 1276 | (setq mh-delete-list (delq msg mh-delete-list))) |
| 1360 | (t | 1277 | (t |
| 1361 | (dolist (folder-msg-list mh-refile-list) | 1278 | (dolist (folder-msg-list mh-refile-list) |
| 1362 | (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) | 1279 | (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) |
| 1363 | (setq mh-refile-list (remove-if #'(lambda (x) (null (cdr x))) | 1280 | (setq mh-refile-list (loop for x in mh-refile-list |
| 1364 | mh-refile-list)))) | 1281 | unless (null (cdr x)) collect x)))) |
| 1365 | (mh-notate msg ? mh-cmd-note)) | 1282 | (mh-notate msg ? mh-cmd-note)) |
| 1366 | 1283 | ||
| 1367 | 1284 | ||
| @@ -1463,100 +1380,6 @@ Make it the current folder." | |||
| 1463 | 1380 | ||
| 1464 | 1381 | ||
| 1465 | 1382 | ||
| 1466 | ;;; Support for emacs21 toolbar using gnus/message.el icons (and code). | ||
| 1467 | (eval-when-compile (defvar tool-bar-map)) | ||
| 1468 | (defvar mh-folder-tool-bar-map nil) | ||
| 1469 | (defvar mh-folder-seq-tool-bar-map nil | ||
| 1470 | "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.") | ||
| 1471 | (when (and (fboundp 'tool-bar-add-item) | ||
| 1472 | tool-bar-mode) | ||
| 1473 | (setq mh-folder-tool-bar-map | ||
| 1474 | (let ((tool-bar-map (make-sparse-keymap))) | ||
| 1475 | (tool-bar-add-item "mail" 'mh-inc-folder 'mh-foldertoolbar-inc-folder | ||
| 1476 | :help "Incorporate new mail in Inbox") | ||
| 1477 | (tool-bar-add-item "attach" 'mh-mime-save-parts | ||
| 1478 | 'mh-foldertoolbar-mime-save-parts | ||
| 1479 | :help "Save MIME parts") | ||
| 1480 | |||
| 1481 | (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg | ||
| 1482 | 'mh-foldertoolbar-prev :help "Previous message") | ||
| 1483 | (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page | ||
| 1484 | :help "Page this message") | ||
| 1485 | (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg | ||
| 1486 | 'mh-foldertoolbar-next :help "Next message") | ||
| 1487 | |||
| 1488 | (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete | ||
| 1489 | :help "Mark for deletion") | ||
| 1490 | (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile | ||
| 1491 | :help "Refile this message") | ||
| 1492 | (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo | ||
| 1493 | :help "Undo this mark") | ||
| 1494 | (tool-bar-add-item "execute" 'mh-execute-commands 'mh-foldertoolbar-exec | ||
| 1495 | :help "Perform moves and deletes") | ||
| 1496 | |||
| 1497 | (tool-bar-add-item "show" 'mh-toggle-showing | ||
| 1498 | 'mh-foldertoolbar-toggle-show | ||
| 1499 | :help "Toggle showing message") | ||
| 1500 | |||
| 1501 | (cond | ||
| 1502 | (mh-tool-bar-reply-3-buttons-flag | ||
| 1503 | (tool-bar-add-item "reply-from" (lambda (&optional arg) | ||
| 1504 | (interactive "P") | ||
| 1505 | (mh-reply (mh-get-msg-num nil) | ||
| 1506 | "from" arg)) | ||
| 1507 | 'mh-foldertoolbar-reply-from | ||
| 1508 | :help "Reply to \"from\"") | ||
| 1509 | (tool-bar-add-item "reply-to" (lambda (&optional arg) | ||
| 1510 | (interactive "P") | ||
| 1511 | (mh-reply (mh-get-msg-num nil) | ||
| 1512 | "to" arg)) | ||
| 1513 | 'mh-foldertoolbar-reply-to | ||
| 1514 | :help "Reply to \"to\"") | ||
| 1515 | (tool-bar-add-item "reply-all" (lambda (&optional arg) | ||
| 1516 | (interactive "P") | ||
| 1517 | (mh-reply (mh-get-msg-num nil) | ||
| 1518 | "all" arg)) | ||
| 1519 | 'mh-foldertoolbar-reply-all | ||
| 1520 | :help "Reply to \"all\"")) | ||
| 1521 | (t | ||
| 1522 | (tool-bar-add-item "mail/reply2" 'mh-reply 'mh-foldertoolbar-reply | ||
| 1523 | :help "Reply to this message"))) | ||
| 1524 | (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose | ||
| 1525 | :help "Compose new message") | ||
| 1526 | |||
| 1527 | (tool-bar-add-item "rescan" 'mh-rescan-folder 'mh-foldertoolbar-rescan | ||
| 1528 | :help "Rescan this folder") | ||
| 1529 | (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack | ||
| 1530 | :help "Repack this folder") | ||
| 1531 | |||
| 1532 | (tool-bar-add-item "search" | ||
| 1533 | (lambda (&optional arg) | ||
| 1534 | (interactive "P") | ||
| 1535 | (call-interactively mh-tool-bar-search-function)) | ||
| 1536 | 'mh-foldertoolbar-search :help "Search") | ||
| 1537 | (tool-bar-add-item "fld_open" 'mh-visit-folder 'mh-foldertoolbar-visit | ||
| 1538 | :help "Visit other folder") | ||
| 1539 | |||
| 1540 | (tool-bar-add-item "preferences" (lambda () | ||
| 1541 | (interactive) | ||
| 1542 | (customize-group "mh")) | ||
| 1543 | 'mh-foldertoolbar-customize | ||
| 1544 | :help "mh-e preferences") | ||
| 1545 | (tool-bar-add-item "help" (lambda () | ||
| 1546 | (interactive) | ||
| 1547 | (Info-goto-node "(mh-e)Top")) | ||
| 1548 | 'mh-foldertoolbar-help :help "Help") | ||
| 1549 | tool-bar-map)) | ||
| 1550 | |||
| 1551 | (setq mh-folder-seq-tool-bar-map | ||
| 1552 | (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) | ||
| 1553 | (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen | ||
| 1554 | :help "Widen from this sequence") | ||
| 1555 | tool-bar-map)) | ||
| 1556 | ) | ||
| 1557 | |||
| 1558 | |||
| 1559 | |||
| 1560 | (defmacro mh-remove-xemacs-horizontal-scrollbar () | 1383 | (defmacro mh-remove-xemacs-horizontal-scrollbar () |
| 1561 | "Get rid of the horizontal scrollbar that XEmacs insists on putting in." | 1384 | "Get rid of the horizontal scrollbar that XEmacs insists on putting in." |
| 1562 | (when mh-xemacs-flag | 1385 | (when mh-xemacs-flag |
| @@ -1571,8 +1394,8 @@ Otherwise return `local-write-file-hooks'. This macro exists purely for | |||
| 1571 | compatibility. The former symbol is used in Emacs 21.4 onward while the latter | 1394 | compatibility. The former symbol is used in Emacs 21.4 onward while the latter |
| 1572 | is used in previous versions and XEmacs." | 1395 | is used in previous versions and XEmacs." |
| 1573 | (if (boundp 'write-file-functions) | 1396 | (if (boundp 'write-file-functions) |
| 1574 | ''write-file-functions ;Emacs 21.4 | 1397 | ''write-file-functions ;Emacs 21.4 |
| 1575 | ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs | 1398 | ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs |
| 1576 | 1399 | ||
| 1577 | (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" | 1400 | (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" |
| 1578 | "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> | 1401 | "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> |
| @@ -1594,48 +1417,54 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run. | |||
| 1594 | \\{mh-folder-mode-map}" | 1417 | \\{mh-folder-mode-map}" |
| 1595 | 1418 | ||
| 1596 | (make-local-variable 'font-lock-defaults) | 1419 | (make-local-variable 'font-lock-defaults) |
| 1597 | (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) | 1420 | (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) |
| 1598 | (mh-make-local-vars | 1421 | (mh-make-local-vars |
| 1599 | 'mh-current-folder (buffer-name) ; Name of folder, a string | 1422 | 'mh-current-folder (buffer-name) ; Name of folder, a string |
| 1600 | 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs | 1423 | 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs |
| 1601 | 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" | 1424 | 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" |
| 1602 | (file-name-as-directory (mh-expand-file-name (buffer-name))) | 1425 | (file-name-as-directory (mh-expand-file-name (buffer-name))) |
| 1603 | 'mh-showing-mode nil ; Show message also? | 1426 | 'mh-showing-mode nil ; Show message also? |
| 1604 | 'mh-delete-list nil ; List of msgs nums to delete | 1427 | 'mh-delete-list nil ; List of msgs nums to delete |
| 1605 | 'mh-refile-list nil ; List of folder names in mh-seq-list | 1428 | 'mh-refile-list nil ; List of folder names in mh-seq-list |
| 1606 | 'mh-seq-list nil ; Alist of (seq . msgs) nums | 1429 | 'mh-seq-list nil ; Alist of (seq . msgs) nums |
| 1607 | 'mh-seen-list nil ; List of displayed messages | 1430 | 'mh-seen-list nil ; List of displayed messages |
| 1608 | 'mh-next-direction 'forward ; Direction to move to next message | 1431 | 'mh-next-direction 'forward ; Direction to move to next message |
| 1609 | 'mh-narrowed-to-seq nil ; Sequence display is narrowed to | 1432 | 'mh-narrowed-to-seq nil ; Sequence display is narrowed to |
| 1610 | 'mh-view-ops () ; Stack that keeps track of the order | 1433 | 'mh-view-ops () ; Stack that keeps track of the order |
| 1611 | ; in which narrowing/threading has been | 1434 | ; in which narrowing/threading has been |
| 1612 | ; carried out. | 1435 | ; carried out. |
| 1613 | 'mh-first-msg-num nil ; Number of first msg in buffer | 1436 | 'mh-index-data nil ; If the folder was created by a call |
| 1614 | 'mh-last-msg-num nil ; Number of last msg in buffer | 1437 | ; to mh-index-search this contains info |
| 1615 | 'mh-msg-count nil ; Number of msgs in buffer | 1438 | ; about the search results. |
| 1616 | 'mh-mode-line-annotation nil ; Indiction this is not the full folder | 1439 | 'mh-index-previous-search nil ; Previous folder and search-regexp |
| 1617 | 'mh-previous-window-config nil) ; Previous window configuration | 1440 | 'mh-index-msg-checksum-map nil ; msg -> checksum map |
| 1441 | 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) | ||
| 1442 | 'mh-first-msg-num nil ; Number of first msg in buffer | ||
| 1443 | 'mh-last-msg-num nil ; Number of last msg in buffer | ||
| 1444 | 'mh-msg-count nil ; Number of msgs in buffer | ||
| 1445 | 'mh-mode-line-annotation nil ; Indicates message range | ||
| 1446 | 'mh-previous-window-config nil) ; Previous window configuration | ||
| 1618 | (mh-remove-xemacs-horizontal-scrollbar) | 1447 | (mh-remove-xemacs-horizontal-scrollbar) |
| 1619 | (setq truncate-lines t) | 1448 | (setq truncate-lines t) |
| 1620 | (auto-save-mode -1) | 1449 | (auto-save-mode -1) |
| 1621 | (setq buffer-offer-save t) | 1450 | (setq buffer-offer-save t) |
| 1622 | (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t) | 1451 | (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t) |
| 1623 | (make-local-variable 'revert-buffer-function) | 1452 | (make-local-variable 'revert-buffer-function) |
| 1624 | (make-local-variable 'hl-line-mode) ; avoid pollution | 1453 | (make-local-variable 'hl-line-mode) ; avoid pollution |
| 1625 | (if (fboundp 'hl-line-mode) | 1454 | (if (fboundp 'hl-line-mode) |
| 1626 | (hl-line-mode 1)) | 1455 | (hl-line-mode 1)) |
| 1627 | (setq revert-buffer-function 'mh-undo-folder) | 1456 | (setq revert-buffer-function 'mh-undo-folder) |
| 1628 | (or (assq 'mh-showing-mode minor-mode-alist) | 1457 | (or (assq 'mh-showing-mode minor-mode-alist) |
| 1629 | (setq minor-mode-alist | 1458 | (setq minor-mode-alist |
| 1630 | (cons '(mh-showing-mode " Show") minor-mode-alist))) | 1459 | (cons '(mh-showing-mode " Show") minor-mode-alist))) |
| 1631 | (easy-menu-add mh-folder-sequence-menu) | 1460 | (easy-menu-add mh-folder-sequence-menu) |
| 1632 | (easy-menu-add mh-folder-message-menu) | 1461 | (easy-menu-add mh-folder-message-menu) |
| 1633 | (easy-menu-add mh-folder-folder-menu) | 1462 | (easy-menu-add mh-folder-folder-menu) |
| 1634 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) | 1463 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) |
| 1635 | (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) | 1464 | (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) |
| 1636 | (if (and mh-xemacs-flag | 1465 | (if (and mh-xemacs-flag |
| 1637 | font-lock-auto-fontify) | 1466 | font-lock-auto-fontify) |
| 1638 | (turn-on-font-lock))) ; Force font-lock in XEmacs. | 1467 | (turn-on-font-lock))) ; Force font-lock in XEmacs. |
| 1639 | 1468 | ||
| 1640 | (defun mh-make-local-vars (&rest pairs) | 1469 | (defun mh-make-local-vars (&rest pairs) |
| 1641 | "Initialize local variables according to the variable-value PAIRS." | 1470 | "Initialize local variables according to the variable-value PAIRS." |
| @@ -1650,15 +1479,15 @@ If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and | |||
| 1650 | refiles aren't carried out. | 1479 | refiles aren't carried out. |
| 1651 | Return in the folder's buffer." | 1480 | Return in the folder's buffer." |
| 1652 | (cond ((null (get-buffer folder)) | 1481 | (cond ((null (get-buffer folder)) |
| 1653 | (mh-make-folder folder)) | 1482 | (mh-make-folder folder)) |
| 1654 | (t | 1483 | (t |
| 1655 | (or dont-exec-pending (mh-process-or-undo-commands folder)) | 1484 | (or dont-exec-pending (mh-process-or-undo-commands folder)) |
| 1656 | (switch-to-buffer folder))) | 1485 | (switch-to-buffer folder))) |
| 1657 | (mh-regenerate-headers range) | 1486 | (mh-regenerate-headers range) |
| 1658 | (if (zerop (buffer-size)) | 1487 | (if (zerop (buffer-size)) |
| 1659 | (if (equal range "all") | 1488 | (if (equal range "all") |
| 1660 | (message "Folder %s is empty" folder) | 1489 | (message "Folder %s is empty" folder) |
| 1661 | (message "No messages in %s, range %s" folder range)) | 1490 | (message "No messages in %s, range %s" folder range)) |
| 1662 | (mh-goto-cur-msg)) | 1491 | (mh-goto-cur-msg)) |
| 1663 | (save-excursion | 1492 | (save-excursion |
| 1664 | (when dont-exec-pending | 1493 | (when dont-exec-pending |
| @@ -1670,19 +1499,31 @@ Return in the folder's buffer." | |||
| 1670 | (dolist (msg mh-delete-list) | 1499 | (dolist (msg mh-delete-list) |
| 1671 | (mh-notate msg mh-note-deleted mh-cmd-note))))) | 1500 | (mh-notate msg mh-note-deleted mh-cmd-note))))) |
| 1672 | 1501 | ||
| 1502 | (defun mh-set-cmd-note (width) | ||
| 1503 | "Set `mh-cmd-note' to WIDTH characters (minimum of 2). | ||
| 1504 | |||
| 1505 | If `mh-scan-format-file' specifies nil or a filename, then this function | ||
| 1506 | will NOT update `mh-cmd-note'." | ||
| 1507 | ;; Add one to the width to always have whitespace in column zero. | ||
| 1508 | (setq width (max (1+ width) 2)) | ||
| 1509 | (if (and (equal mh-scan-format-file t) | ||
| 1510 | (not (eq mh-cmd-note width))) | ||
| 1511 | (setq mh-cmd-note width)) | ||
| 1512 | mh-cmd-note) | ||
| 1513 | |||
| 1673 | (defun mh-regenerate-headers (range &optional update) | 1514 | (defun mh-regenerate-headers (range &optional update) |
| 1674 | "Scan folder over range RANGE. | 1515 | "Scan folder over range RANGE. |
| 1675 | If UPDATE, append the scan lines, otherwise replace." | 1516 | If UPDATE, append the scan lines, otherwise replace." |
| 1676 | (let ((folder mh-current-folder) | 1517 | (let ((folder mh-current-folder) |
| 1677 | (range (if (and range (atom range)) (list range) range)) | 1518 | (range (if (and range (atom range)) (list range) range)) |
| 1678 | scan-start) | 1519 | scan-start) |
| 1679 | (message "Scanning %s..." folder) | 1520 | (message "Scanning %s..." folder) |
| 1680 | (with-mh-folder-updating (nil) | 1521 | (with-mh-folder-updating (nil) |
| 1681 | (if update | 1522 | (if update |
| 1682 | (goto-char (point-max)) | 1523 | (goto-char (point-max)) |
| 1683 | (delete-region (point-min) (point-max)) | 1524 | (delete-region (point-min) (point-max)) |
| 1684 | (if mh-adaptive-cmd-note-flag | 1525 | (if mh-adaptive-cmd-note-flag |
| 1685 | (mh-set-cmd-note (mh-message-number-width folder)))) | 1526 | (mh-set-cmd-note (mh-message-number-width folder)))) |
| 1686 | (setq scan-start (point)) | 1527 | (setq scan-start (point)) |
| 1687 | (apply #'mh-exec-cmd-output | 1528 | (apply #'mh-exec-cmd-output |
| 1688 | mh-scan-prog nil | 1529 | mh-scan-prog nil |
| @@ -1692,19 +1533,19 @@ If UPDATE, append the scan lines, otherwise replace." | |||
| 1692 | folder range) | 1533 | folder range) |
| 1693 | (goto-char scan-start) | 1534 | (goto-char scan-start) |
| 1694 | (cond ((looking-at "scan: no messages in") | 1535 | (cond ((looking-at "scan: no messages in") |
| 1695 | (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines | 1536 | (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines |
| 1696 | ((looking-at "scan: bad message list ") | 1537 | ((looking-at "scan: bad message list ") |
| 1697 | (keep-lines mh-scan-valid-regexp)) | 1538 | (keep-lines mh-scan-valid-regexp)) |
| 1698 | ((looking-at "scan: ")) ; Keep error messages | 1539 | ((looking-at "scan: ")) ; Keep error messages |
| 1699 | (t | 1540 | (t |
| 1700 | (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines | 1541 | (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines |
| 1701 | (setq mh-seq-list (mh-read-folder-sequences folder nil)) | 1542 | (setq mh-seq-list (mh-read-folder-sequences folder nil)) |
| 1702 | (mh-notate-user-sequences) | 1543 | (mh-notate-user-sequences) |
| 1703 | (or update | 1544 | (or update |
| 1704 | (setq mh-mode-line-annotation | 1545 | (setq mh-mode-line-annotation |
| 1705 | (if (equal range '("all")) | 1546 | (if (equal range '("all")) |
| 1706 | nil | 1547 | nil |
| 1707 | mh-partial-folder-mode-line-annotation))) | 1548 | mh-partial-folder-mode-line-annotation))) |
| 1708 | (mh-make-folder-mode-line)) | 1549 | (mh-make-folder-mode-line)) |
| 1709 | (message "Scanning %s...done" folder))) | 1550 | (message "Scanning %s...done" folder))) |
| 1710 | 1551 | ||
| @@ -1727,8 +1568,8 @@ line now with no message truncation." | |||
| 1727 | (save-excursion | 1568 | (save-excursion |
| 1728 | (let ((maxcol (1- (window-width))) | 1569 | (let ((maxcol (1- (window-width))) |
| 1729 | (old-cmd-note mh-cmd-note) | 1570 | (old-cmd-note mh-cmd-note) |
| 1730 | mh-cmd-note-fmt | 1571 | mh-cmd-note-fmt |
| 1731 | msgnum) | 1572 | msgnum) |
| 1732 | ;; Nuke all of the lines just added by the last inc | 1573 | ;; Nuke all of the lines just added by the last inc |
| 1733 | (delete-char (- (point-max) (point))) | 1574 | (delete-char (- (point-max) (point))) |
| 1734 | ;; Update the current buffer to reflect the new mh-cmd-note | 1575 | ;; Update the current buffer to reflect the new mh-cmd-note |
| @@ -1750,7 +1591,7 @@ line now with no message truncation." | |||
| 1750 | (let ((eol (point))) | 1591 | (let ((eol (point))) |
| 1751 | (move-to-column maxcol) | 1592 | (move-to-column maxcol) |
| 1752 | (if (<= (point) eol) | 1593 | (if (<= (point) eol) |
| 1753 | (delete-char (- eol (point)))))))) | 1594 | (delete-char (- eol (point)))))))) |
| 1754 | ;; now re-read the lost messages | 1595 | ;; now re-read the lost messages |
| 1755 | (goto-char (point-max)) | 1596 | (goto-char (point-max)) |
| 1756 | (prog1 (point) | 1597 | (prog1 (point) |
| @@ -1760,36 +1601,36 @@ line now with no message truncation." | |||
| 1760 | "Read new mail from MAILDROP-NAME into the current buffer. | 1601 | "Read new mail from MAILDROP-NAME into the current buffer. |
| 1761 | Return in the current buffer." | 1602 | Return in the current buffer." |
| 1762 | (let ((point-before-inc (point)) | 1603 | (let ((point-before-inc (point)) |
| 1763 | (folder mh-current-folder) | 1604 | (folder mh-current-folder) |
| 1764 | (new-mail-flag nil)) | 1605 | (new-mail-flag nil)) |
| 1765 | (with-mh-folder-updating (t) | 1606 | (with-mh-folder-updating (t) |
| 1766 | (if maildrop-name | 1607 | (if maildrop-name |
| 1767 | (message "inc %s -file %s..." folder maildrop-name) | 1608 | (message "inc %s -file %s..." folder maildrop-name) |
| 1768 | (message "inc %s..." folder)) | 1609 | (message "inc %s..." folder)) |
| 1769 | (setq mh-next-direction 'forward) | 1610 | (setq mh-next-direction 'forward) |
| 1770 | (goto-char (point-max)) | 1611 | (goto-char (point-max)) |
| 1771 | (let ((start-of-inc (point))) | 1612 | (let ((start-of-inc (point))) |
| 1772 | (mh-remove-cur-notation) | 1613 | (mh-remove-cur-notation) |
| 1773 | (if maildrop-name | 1614 | (if maildrop-name |
| 1774 | ;; I think MH 5 used "-ms-file" instead of "-file", | 1615 | ;; I think MH 5 used "-ms-file" instead of "-file", |
| 1775 | ;; which would make inc'ing from maildrops fail. | 1616 | ;; which would make inc'ing from maildrops fail. |
| 1776 | (mh-exec-cmd-output mh-inc-prog nil folder | 1617 | (mh-exec-cmd-output mh-inc-prog nil folder |
| 1777 | (mh-scan-format) | 1618 | (mh-scan-format) |
| 1778 | "-file" (expand-file-name maildrop-name) | 1619 | "-file" (expand-file-name maildrop-name) |
| 1779 | "-width" (window-width) | 1620 | "-width" (window-width) |
| 1780 | "-truncate") | 1621 | "-truncate") |
| 1781 | (mh-exec-cmd-output mh-inc-prog nil | 1622 | (mh-exec-cmd-output mh-inc-prog nil |
| 1782 | (mh-scan-format) | 1623 | (mh-scan-format) |
| 1783 | "-width" (window-width))) | 1624 | "-width" (window-width))) |
| 1784 | (if maildrop-name | 1625 | (if maildrop-name |
| 1785 | (message "inc %s -file %s...done" folder maildrop-name) | 1626 | (message "inc %s -file %s...done" folder maildrop-name) |
| 1786 | (message "inc %s...done" folder)) | 1627 | (message "inc %s...done" folder)) |
| 1787 | (goto-char start-of-inc) | 1628 | (goto-char start-of-inc) |
| 1788 | (cond ((save-excursion | 1629 | (cond ((save-excursion |
| 1789 | (re-search-forward "^inc: no mail" nil t)) | 1630 | (re-search-forward "^inc: no mail" nil t)) |
| 1790 | (message "No new mail%s%s" (if maildrop-name " in " "") | 1631 | (message "No new mail%s%s" (if maildrop-name " in " "") |
| 1791 | (if maildrop-name maildrop-name ""))) | 1632 | (if maildrop-name maildrop-name ""))) |
| 1792 | ((and (when mh-narrowed-to-seq | 1633 | ((and (when mh-narrowed-to-seq |
| 1793 | (let ((saved-text (buffer-substring-no-properties | 1634 | (let ((saved-text (buffer-substring-no-properties |
| 1794 | start-of-inc (point-max)))) | 1635 | start-of-inc (point-max)))) |
| 1795 | (delete-region start-of-inc (point-max)) | 1636 | (delete-region start-of-inc (point-max)) |
| @@ -1800,27 +1641,29 @@ Return in the current buffer." | |||
| 1800 | (goto-char start-of-inc)))) | 1641 | (goto-char start-of-inc)))) |
| 1801 | nil)) | 1642 | nil)) |
| 1802 | ((re-search-forward "^inc:" nil t) ; Error messages | 1643 | ((re-search-forward "^inc:" nil t) ; Error messages |
| 1803 | (error "Error incorporating mail")) | 1644 | (error "Error incorporating mail")) |
| 1804 | ((and | 1645 | ((and |
| 1805 | (equal mh-scan-format-file t) | 1646 | (equal mh-scan-format-file t) |
| 1806 | mh-adaptive-cmd-note-flag | 1647 | mh-adaptive-cmd-note-flag |
| 1807 | ;; Have we reached an edge condition? | 1648 | ;; Have we reached an edge condition? |
| 1808 | (save-excursion | 1649 | (save-excursion |
| 1809 | (re-search-forward mh-scan-msg-overflow-regexp nil 0 1)) | 1650 | (re-search-forward mh-scan-msg-overflow-regexp nil 0 1)) |
| 1810 | (setq start-of-inc (mh-generate-new-cmd-note folder)) | 1651 | (setq start-of-inc (mh-generate-new-cmd-note folder)) |
| 1811 | nil)) | 1652 | nil)) |
| 1812 | (t | 1653 | (t |
| 1813 | (setq new-mail-flag t))) | 1654 | (setq new-mail-flag t))) |
| 1814 | (keep-lines mh-scan-valid-regexp) ; Flush random scan lines | 1655 | (keep-lines mh-scan-valid-regexp) ; Flush random scan lines |
| 1815 | (setq mh-seq-list (mh-read-folder-sequences folder t)) | 1656 | (setq mh-seq-list (mh-read-folder-sequences folder t)) |
| 1816 | (mh-notate-user-sequences) | 1657 | (when (equal (point-max) start-of-inc) |
| 1817 | (if new-mail-flag | 1658 | (mh-notate-seq 'cur mh-note-cur mh-cmd-note)) |
| 1818 | (progn | 1659 | (mh-notate-user-sequences) |
| 1819 | (mh-make-folder-mode-line) | 1660 | (if new-mail-flag |
| 1661 | (progn | ||
| 1662 | (mh-make-folder-mode-line) | ||
| 1820 | (when (memq 'unthread mh-view-ops) | 1663 | (when (memq 'unthread mh-view-ops) |
| 1821 | (mh-thread-inc folder start-of-inc)) | 1664 | (mh-thread-inc folder start-of-inc)) |
| 1822 | (mh-goto-cur-msg)) | 1665 | (mh-goto-cur-msg)) |
| 1823 | (goto-char point-before-inc)))))) | 1666 | (goto-char point-before-inc)))))) |
| 1824 | 1667 | ||
| 1825 | (defun mh-make-folder-mode-line (&optional ignored) | 1668 | (defun mh-make-folder-mode-line (&optional ignored) |
| 1826 | "Set the fields of the mode line for a folder buffer. | 1669 | "Set the fields of the mode line for a folder buffer. |
| @@ -1830,37 +1673,37 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'." | |||
| 1830 | (save-window-excursion | 1673 | (save-window-excursion |
| 1831 | (mh-first-msg) | 1674 | (mh-first-msg) |
| 1832 | (let ((new-first-msg-num (mh-get-msg-num nil))) | 1675 | (let ((new-first-msg-num (mh-get-msg-num nil))) |
| 1833 | (when (or (not (memq 'unthread mh-view-ops)) | 1676 | (when (or (not (memq 'unthread mh-view-ops)) |
| 1834 | (null mh-first-msg-num) | 1677 | (null mh-first-msg-num) |
| 1835 | (null new-first-msg-num) | 1678 | (null new-first-msg-num) |
| 1836 | (< new-first-msg-num mh-first-msg-num)) | 1679 | (< new-first-msg-num mh-first-msg-num)) |
| 1837 | (setq mh-first-msg-num new-first-msg-num))) | 1680 | (setq mh-first-msg-num new-first-msg-num))) |
| 1838 | (mh-last-msg) | 1681 | (mh-last-msg) |
| 1839 | (let ((new-last-msg-num (mh-get-msg-num nil))) | 1682 | (let ((new-last-msg-num (mh-get-msg-num nil))) |
| 1840 | (when (or (not (memq 'unthread mh-view-ops)) | 1683 | (when (or (not (memq 'unthread mh-view-ops)) |
| 1841 | (null mh-last-msg-num) | 1684 | (null mh-last-msg-num) |
| 1842 | (null new-last-msg-num) | 1685 | (null new-last-msg-num) |
| 1843 | (> new-last-msg-num mh-last-msg-num)) | 1686 | (> new-last-msg-num mh-last-msg-num)) |
| 1844 | (setq mh-last-msg-num new-last-msg-num))) | 1687 | (setq mh-last-msg-num new-last-msg-num))) |
| 1845 | (setq mh-msg-count (if mh-first-msg-num | 1688 | (setq mh-msg-count (if mh-first-msg-num |
| 1846 | (count-lines (point-min) (point-max)) | 1689 | (count-lines (point-min) (point-max)) |
| 1847 | 0)) | 1690 | 0)) |
| 1848 | (setq mode-line-buffer-identification | 1691 | (setq mode-line-buffer-identification |
| 1849 | (list (format "{%%b%s} %s msg%s" | 1692 | (list (format "{%%b%s} %s msg%s" |
| 1850 | (if mh-mode-line-annotation | 1693 | (if mh-mode-line-annotation |
| 1851 | (format "/%s" mh-mode-line-annotation) | 1694 | (format "/%s" mh-mode-line-annotation) |
| 1852 | "") | 1695 | "") |
| 1853 | (if (zerop mh-msg-count) | 1696 | (if (zerop mh-msg-count) |
| 1854 | "no" | 1697 | "no" |
| 1855 | (format "%d" mh-msg-count)) | 1698 | (format "%d" mh-msg-count)) |
| 1856 | (if (zerop mh-msg-count) | 1699 | (if (zerop mh-msg-count) |
| 1857 | "s" | 1700 | "s" |
| 1858 | (cond ((> mh-msg-count 1) | 1701 | (cond ((> mh-msg-count 1) |
| 1859 | (format "s (%d-%d)" mh-first-msg-num | 1702 | (format "s (%d-%d)" mh-first-msg-num |
| 1860 | mh-last-msg-num)) | 1703 | mh-last-msg-num)) |
| 1861 | (mh-first-msg-num | 1704 | (mh-first-msg-num |
| 1862 | (format " (%d)" mh-first-msg-num)) | 1705 | (format " (%d)" mh-first-msg-num)) |
| 1863 | (""))))))))) | 1706 | (""))))))))) |
| 1864 | 1707 | ||
| 1865 | (defun mh-unmark-all-headers (remove-all-flags) | 1708 | (defun mh-unmark-all-headers (remove-all-flags) |
| 1866 | "Remove all '+' flags from the folder listing. | 1709 | "Remove all '+' flags from the folder listing. |
| @@ -1868,60 +1711,62 @@ With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too. | |||
| 1868 | Optimized for speed (i.e., no regular expressions)." | 1711 | Optimized for speed (i.e., no regular expressions)." |
| 1869 | (save-excursion | 1712 | (save-excursion |
| 1870 | (let ((case-fold-search nil) | 1713 | (let ((case-fold-search nil) |
| 1871 | (last-line (1- (point-max))) | 1714 | (last-line (1- (point-max))) |
| 1872 | char) | 1715 | char) |
| 1873 | (mh-first-msg) | 1716 | (mh-first-msg) |
| 1874 | (while (<= (point) last-line) | 1717 | (while (<= (point) last-line) |
| 1875 | (forward-char mh-cmd-note) | 1718 | (forward-char mh-cmd-note) |
| 1876 | (setq char (following-char)) | 1719 | (setq char (following-char)) |
| 1877 | (if (or (and remove-all-flags | 1720 | (if (or (and remove-all-flags |
| 1878 | (or (= char (aref mh-note-deleted 0)) | 1721 | (or (= char (aref mh-note-deleted 0)) |
| 1879 | (= char (aref mh-note-refiled 0)))) | 1722 | (= char (aref mh-note-refiled 0)))) |
| 1880 | (= char (aref mh-note-cur 0))) | 1723 | (= char (aref mh-note-cur 0))) |
| 1881 | (progn | 1724 | (progn |
| 1882 | (delete-char 1) | 1725 | (delete-char 1) |
| 1883 | (insert " "))) | 1726 | (insert " "))) |
| 1884 | (if remove-all-flags | 1727 | (if remove-all-flags |
| 1885 | (progn | 1728 | (progn |
| 1886 | (forward-char 1) | 1729 | (forward-char 1) |
| 1887 | (if (= (following-char) (aref mh-note-seq 0)) | 1730 | (if (= (following-char) (aref mh-note-seq 0)) |
| 1888 | (progn | 1731 | (progn |
| 1889 | (delete-char 1) | 1732 | (delete-char 1) |
| 1890 | (insert " "))))) | 1733 | (insert " "))))) |
| 1891 | (forward-line))))) | 1734 | (forward-line))))) |
| 1892 | 1735 | ||
| 1893 | (defun mh-remove-cur-notation () | 1736 | (defun mh-remove-cur-notation () |
| 1894 | "Remove old cur notation." | 1737 | "Remove old cur notation." |
| 1895 | (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) | 1738 | (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) |
| 1896 | (save-excursion | 1739 | (save-excursion |
| 1897 | (and cur-msg | 1740 | (and cur-msg |
| 1898 | (mh-goto-msg cur-msg t t) | 1741 | (mh-goto-msg cur-msg t t) |
| 1899 | (looking-at mh-scan-cur-msg-number-regexp) | 1742 | (looking-at mh-scan-cur-msg-number-regexp) |
| 1900 | (mh-notate nil ? mh-cmd-note))))) | 1743 | (mh-notate nil ? mh-cmd-note))))) |
| 1901 | 1744 | ||
| 1902 | (defun mh-remove-all-notation () | 1745 | (defun mh-remove-all-notation () |
| 1903 | "Remove all notations on all scan lines that MH-E introduces." | 1746 | "Remove all notations on all scan lines that MH-E introduces." |
| 1904 | (save-excursion | 1747 | (save-excursion |
| 1905 | (goto-char (point-min)) | 1748 | (goto-char (point-min)) |
| 1906 | (while (not (eobp)) | 1749 | (while (not (eobp)) |
| 1907 | (mh-notate nil ? mh-cmd-note) | 1750 | (unless (or (equal (char-after) ?+) (eolp)) |
| 1908 | (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0)) | 1751 | (mh-notate nil ? mh-cmd-note) |
| 1909 | (mh-notate nil ? (1+ mh-cmd-note))) | 1752 | (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0)) |
| 1753 | (mh-notate nil ? (1+ mh-cmd-note)))) | ||
| 1910 | (forward-line)))) | 1754 | (forward-line)))) |
| 1911 | 1755 | ||
| 1756 | ;;;###mh-autoload | ||
| 1912 | (defun mh-goto-cur-msg (&optional minimal-changes-flag) | 1757 | (defun mh-goto-cur-msg (&optional minimal-changes-flag) |
| 1913 | "Position the cursor at the current message. | 1758 | "Position the cursor at the current message. |
| 1914 | When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't | 1759 | When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't |
| 1915 | recenter the folder buffer." | 1760 | recenter the folder buffer." |
| 1916 | (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) | 1761 | (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) |
| 1917 | (cond ((and cur-msg | 1762 | (cond ((and cur-msg |
| 1918 | (mh-goto-msg cur-msg t t)) | 1763 | (mh-goto-msg cur-msg t t)) |
| 1919 | (unless minimal-changes-flag | 1764 | (unless minimal-changes-flag |
| 1920 | (mh-notate nil mh-note-cur mh-cmd-note) | 1765 | (mh-notate nil mh-note-cur mh-cmd-note) |
| 1921 | (mh-recenter 0) | 1766 | (mh-recenter 0) |
| 1922 | (mh-maybe-show cur-msg))) | 1767 | (mh-maybe-show cur-msg))) |
| 1923 | (t | 1768 | (t |
| 1924 | (message "No current message"))))) | 1769 | (message "No current message"))))) |
| 1925 | 1770 | ||
| 1926 | (defun mh-process-or-undo-commands (folder) | 1771 | (defun mh-process-or-undo-commands (folder) |
| 1927 | "If FOLDER has outstanding commands, then either process or discard them. | 1772 | "If FOLDER has outstanding commands, then either process or discard them. |
| @@ -1929,10 +1774,10 @@ Called by functions like `mh-sort-folder', so also invalidate show buffer." | |||
| 1929 | (set-buffer folder) | 1774 | (set-buffer folder) |
| 1930 | (if (mh-outstanding-commands-p) | 1775 | (if (mh-outstanding-commands-p) |
| 1931 | (if (or mh-do-not-confirm-flag | 1776 | (if (or mh-do-not-confirm-flag |
| 1932 | (y-or-n-p | 1777 | (y-or-n-p |
| 1933 | "Process outstanding deletes and refiles (or lose them)? ")) | 1778 | "Process outstanding deletes and refiles (or lose them)? ")) |
| 1934 | (mh-process-commands folder) | 1779 | (mh-process-commands folder) |
| 1935 | (mh-undo-folder))) | 1780 | (mh-undo-folder))) |
| 1936 | (mh-update-unseen) | 1781 | (mh-update-unseen) |
| 1937 | (mh-invalidate-show-buffer)) | 1782 | (mh-invalidate-show-buffer)) |
| 1938 | 1783 | ||
| @@ -1949,7 +1794,13 @@ with no arguments, before the commands are processed." | |||
| 1949 | ;; Update the unseen sequence if it exists | 1794 | ;; Update the unseen sequence if it exists |
| 1950 | (mh-update-unseen) | 1795 | (mh-update-unseen) |
| 1951 | 1796 | ||
| 1952 | (let ((redraw-needed-flag nil)) | 1797 | (let ((redraw-needed-flag mh-index-data)) |
| 1798 | ;; Remove invalid scan lines if we are in an index folder and then remove | ||
| 1799 | ;; the real messages | ||
| 1800 | (when mh-index-data | ||
| 1801 | (mh-index-delete-folder-headers) | ||
| 1802 | (mh-index-execute-commands)) | ||
| 1803 | |||
| 1953 | ;; Then refile messages | 1804 | ;; Then refile messages |
| 1954 | (mh-mapc #'(lambda (folder-msg-list) | 1805 | (mh-mapc #'(lambda (folder-msg-list) |
| 1955 | (let ((dest-folder (symbol-name (car folder-msg-list))) | 1806 | (let ((dest-folder (symbol-name (car folder-msg-list))) |
| @@ -1973,17 +1824,18 @@ with no arguments, before the commands are processed." | |||
| 1973 | ;; Don't need to remove sequences since delete and refile do so. | 1824 | ;; Don't need to remove sequences since delete and refile do so. |
| 1974 | ;; Mark cur message | 1825 | ;; Mark cur message |
| 1975 | (if (> (buffer-size) 0) | 1826 | (if (> (buffer-size) 0) |
| 1976 | (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) | 1827 | (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) |
| 1977 | 1828 | ||
| 1978 | ;; Redraw folder window if needed | 1829 | ;; Redraw folder buffer if needed |
| 1979 | (when (and (memq 'unthread mh-view-ops) redraw-needed-flag) | 1830 | (when (and redraw-needed-flag) |
| 1980 | (mh-thread-inc folder (point-max)))) | 1831 | (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max))) |
| 1832 | (mh-index-data (mh-index-insert-folder-headers))))) | ||
| 1981 | 1833 | ||
| 1982 | (and (buffer-file-name (get-buffer mh-show-buffer)) | 1834 | (and (buffer-file-name (get-buffer mh-show-buffer)) |
| 1983 | (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer)))) | 1835 | (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer)))) |
| 1984 | ;; If "inc" were to put a new msg in this file, | 1836 | ;; If "inc" were to put a new msg in this file, |
| 1985 | ;; we would not notice, so mark it invalid now. | 1837 | ;; we would not notice, so mark it invalid now. |
| 1986 | (mh-invalidate-show-buffer)) | 1838 | (mh-invalidate-show-buffer)) |
| 1987 | 1839 | ||
| 1988 | (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) | 1840 | (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) |
| 1989 | (mh-unmark-all-headers t) | 1841 | (mh-unmark-all-headers t) |
| @@ -1997,17 +1849,17 @@ The value of `mh-unseen-updated-hook' is a list of functions to be called, | |||
| 1997 | with no arguments, after the unseen sequence is updated." | 1849 | with no arguments, after the unseen sequence is updated." |
| 1998 | (if mh-seen-list | 1850 | (if mh-seen-list |
| 1999 | (let* ((unseen-seq (mh-find-seq mh-unseen-seq)) | 1851 | (let* ((unseen-seq (mh-find-seq mh-unseen-seq)) |
| 2000 | (unseen-msgs (mh-seq-msgs unseen-seq))) | 1852 | (unseen-msgs (mh-seq-msgs unseen-seq))) |
| 2001 | (if unseen-msgs | 1853 | (if unseen-msgs |
| 2002 | (progn | 1854 | (progn |
| 2003 | (mh-undefine-sequence mh-unseen-seq mh-seen-list) | 1855 | (mh-undefine-sequence mh-unseen-seq mh-seen-list) |
| 2004 | (run-hooks 'mh-unseen-updated-hook) | 1856 | (run-hooks 'mh-unseen-updated-hook) |
| 2005 | (while mh-seen-list | 1857 | (while mh-seen-list |
| 2006 | (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs)) | 1858 | (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs)) |
| 2007 | (setq mh-seen-list (cdr mh-seen-list))) | 1859 | (setq mh-seen-list (cdr mh-seen-list))) |
| 2008 | (setcdr unseen-seq unseen-msgs) | 1860 | (setcdr unseen-seq unseen-msgs) |
| 2009 | t) ;since we set the folder | 1861 | t) ;since we set the folder |
| 2010 | (setq mh-seen-list nil))))) | 1862 | (setq mh-seen-list nil))))) |
| 2011 | 1863 | ||
| 2012 | (defun mh-delete-scan-msgs (msgs) | 1864 | (defun mh-delete-scan-msgs (msgs) |
| 2013 | "Delete the scan listing lines for MSGS." | 1865 | "Delete the scan listing lines for MSGS." |
| @@ -2029,20 +1881,20 @@ Sort of the opposite of `mh-read-msg-list', which expands ranges. | |||
| 2029 | Message lists passed to MH programs go through this so | 1881 | Message lists passed to MH programs go through this so |
| 2030 | command line arguments won't exceed system limits." | 1882 | command line arguments won't exceed system limits." |
| 2031 | (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) | 1883 | (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) |
| 2032 | (range-high nil) | 1884 | (range-high nil) |
| 2033 | (prev -1) | 1885 | (prev -1) |
| 2034 | (ranges nil)) | 1886 | (ranges nil)) |
| 2035 | (while prev | 1887 | (while prev |
| 2036 | (if range-high | 1888 | (if range-high |
| 2037 | (if (or (not (numberp prev)) | 1889 | (if (or (not (numberp prev)) |
| 2038 | (not (equal (car msgs) (1- prev)))) | 1890 | (not (equal (car msgs) (1- prev)))) |
| 2039 | (progn ;non-sequential, flush old range | 1891 | (progn ;non-sequential, flush old range |
| 2040 | (if (eq prev range-high) | 1892 | (if (eq prev range-high) |
| 2041 | (setq ranges (cons range-high ranges)) | 1893 | (setq ranges (cons range-high ranges)) |
| 2042 | (setq ranges (cons (format "%s-%s" prev range-high) ranges))) | 1894 | (setq ranges (cons (format "%s-%s" prev range-high) ranges))) |
| 2043 | (setq range-high nil)))) | 1895 | (setq range-high nil)))) |
| 2044 | (or range-high | 1896 | (or range-high |
| 2045 | (setq range-high (car msgs))) ;start new or first range | 1897 | (setq range-high (car msgs))) ;start new or first range |
| 2046 | (setq prev (car msgs)) | 1898 | (setq prev (car msgs)) |
| 2047 | (setq msgs (cdr msgs))) | 1899 | (setq msgs (cdr msgs))) |
| 2048 | ranges)) | 1900 | ranges)) |
| @@ -2052,11 +1904,11 @@ command line arguments won't exceed system limits." | |||
| 2052 | Strings are \"smaller\" than numbers. | 1904 | Strings are \"smaller\" than numbers. |
| 2053 | Legal values are things like \"cur\", \"last\", 1, and 1820." | 1905 | Legal values are things like \"cur\", \"last\", 1, and 1820." |
| 2054 | (if (numberp msg1) | 1906 | (if (numberp msg1) |
| 2055 | (if (numberp msg2) | 1907 | (if (numberp msg2) |
| 2056 | (> msg1 msg2) | 1908 | (> msg1 msg2) |
| 2057 | t) | 1909 | t) |
| 2058 | (if (numberp msg2) | 1910 | (if (numberp msg2) |
| 2059 | nil | 1911 | nil |
| 2060 | (string-lessp msg2 msg1)))) | 1912 | (string-lessp msg2 msg1)))) |
| 2061 | 1913 | ||
| 2062 | (defun mh-lessp (msg1 msg2) | 1914 | (defun mh-lessp (msg1 msg2) |
| @@ -2080,55 +1932,55 @@ If SAVE-REFILES is non-nil, then keep the sequences | |||
| 2080 | that note messages to be refiled." | 1932 | that note messages to be refiled." |
| 2081 | (let ((seqs ())) | 1933 | (let ((seqs ())) |
| 2082 | (cond (save-refiles | 1934 | (cond (save-refiles |
| 2083 | (mh-mapc (function (lambda (seq) ; Save the refiling sequences | 1935 | (mh-mapc (function (lambda (seq) ; Save the refiling sequences |
| 2084 | (if (mh-folder-name-p (mh-seq-name seq)) | 1936 | (if (mh-folder-name-p (mh-seq-name seq)) |
| 2085 | (setq seqs (cons seq seqs))))) | 1937 | (setq seqs (cons seq seqs))))) |
| 2086 | mh-seq-list))) | 1938 | mh-seq-list))) |
| 2087 | (save-excursion | 1939 | (save-excursion |
| 2088 | (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) | 1940 | (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) |
| 2089 | (progn | 1941 | (progn |
| 2090 | ;; look for name in line of form "cur: 4" or "myseq (private): 23" | 1942 | ;; look for name in line of form "cur: 4" or "myseq (private): 23" |
| 2091 | (while (re-search-forward "^[^: ]+" nil t) | 1943 | (while (re-search-forward "^[^: ]+" nil t) |
| 2092 | (setq seqs (cons (mh-make-seq (intern (buffer-substring | 1944 | (setq seqs (cons (mh-make-seq (intern (buffer-substring |
| 2093 | (match-beginning 0) | 1945 | (match-beginning 0) |
| 2094 | (match-end 0))) | 1946 | (match-end 0))) |
| 2095 | (mh-read-msg-list)) | 1947 | (mh-read-msg-list)) |
| 2096 | seqs))) | 1948 | seqs))) |
| 2097 | (delete-region (point-min) (point))))) ; avoid race with | 1949 | (delete-region (point-min) (point))))) ; avoid race with |
| 2098 | ; mh-process-daemon | 1950 | ; mh-process-daemon |
| 2099 | seqs)) | 1951 | seqs)) |
| 2100 | 1952 | ||
| 2101 | (defun mh-read-msg-list () | 1953 | (defun mh-read-msg-list () |
| 2102 | "Return a list of message numbers from point to the end of the line. | 1954 | "Return a list of message numbers from point to the end of the line. |
| 2103 | Expands ranges into set of individual numbers." | 1955 | Expands ranges into set of individual numbers." |
| 2104 | (let ((msgs ()) | 1956 | (let ((msgs ()) |
| 2105 | (end-of-line (save-excursion (end-of-line) (point))) | 1957 | (end-of-line (save-excursion (end-of-line) (point))) |
| 2106 | num) | 1958 | num) |
| 2107 | (while (re-search-forward "[0-9]+" end-of-line t) | 1959 | (while (re-search-forward "[0-9]+" end-of-line t) |
| 2108 | (setq num (string-to-int (buffer-substring (match-beginning 0) | 1960 | (setq num (string-to-int (buffer-substring (match-beginning 0) |
| 2109 | (match-end 0)))) | 1961 | (match-end 0)))) |
| 2110 | (cond ((looking-at "-") ; Message range | 1962 | (cond ((looking-at "-") ; Message range |
| 2111 | (forward-char 1) | 1963 | (forward-char 1) |
| 2112 | (re-search-forward "[0-9]+" end-of-line t) | 1964 | (re-search-forward "[0-9]+" end-of-line t) |
| 2113 | (let ((num2 (string-to-int (buffer-substring (match-beginning 0) | 1965 | (let ((num2 (string-to-int (buffer-substring (match-beginning 0) |
| 2114 | (match-end 0))))) | 1966 | (match-end 0))))) |
| 2115 | (if (< num2 num) | 1967 | (if (< num2 num) |
| 2116 | (error "Bad message range: %d-%d" num num2)) | 1968 | (error "Bad message range: %d-%d" num num2)) |
| 2117 | (while (<= num num2) | 1969 | (while (<= num num2) |
| 2118 | (setq msgs (cons num msgs)) | 1970 | (setq msgs (cons num msgs)) |
| 2119 | (setq num (1+ num))))) | 1971 | (setq num (1+ num))))) |
| 2120 | ((not (zerop num)) ;"pick" outputs "0" to mean no match | 1972 | ((not (zerop num)) ;"pick" outputs "0" to mean no match |
| 2121 | (setq msgs (cons num msgs))))) | 1973 | (setq msgs (cons num msgs))))) |
| 2122 | msgs)) | 1974 | msgs)) |
| 2123 | 1975 | ||
| 2124 | (defun mh-notate-user-sequences () | 1976 | (defun mh-notate-user-sequences () |
| 2125 | "Mark the scan listing of all messages in user-defined sequences." | 1977 | "Mark the scan listing of all messages in user-defined sequences." |
| 2126 | (let ((seqs mh-seq-list) | 1978 | (let ((seqs mh-seq-list) |
| 2127 | name) | 1979 | name) |
| 2128 | (while seqs | 1980 | (while seqs |
| 2129 | (setq name (mh-seq-name (car seqs))) | 1981 | (setq name (mh-seq-name (car seqs))) |
| 2130 | (if (not (mh-internal-seq name)) | 1982 | (if (not (mh-internal-seq name)) |
| 2131 | (mh-notate-seq name mh-note-seq (1+ mh-cmd-note))) | 1983 | (mh-notate-seq name mh-note-seq (1+ mh-cmd-note))) |
| 2132 | (setq seqs (cdr seqs))))) | 1984 | (setq seqs (cdr seqs))))) |
| 2133 | 1985 | ||
| 2134 | (defun mh-internal-seq (name) | 1986 | (defun mh-internal-seq (name) |
| @@ -2143,39 +1995,39 @@ Expands ranges into set of individual numbers." | |||
| 2143 | MESSAGE defaults to displayed message. From Lisp, optional third arg | 1995 | MESSAGE defaults to displayed message. From Lisp, optional third arg |
| 2144 | INTERNAL-FLAG non-nil means do not inform MH of the change." | 1996 | INTERNAL-FLAG non-nil means do not inform MH of the change." |
| 2145 | (interactive (list (mh-get-msg-num t) | 1997 | (interactive (list (mh-get-msg-num t) |
| 2146 | (mh-read-seq-default "Delete from" t) | 1998 | (mh-read-seq-default "Delete from" t) |
| 2147 | nil)) | 1999 | nil)) |
| 2148 | (let ((entry (mh-find-seq sequence))) | 2000 | (let ((entry (mh-find-seq sequence))) |
| 2149 | (cond (entry | 2001 | (cond (entry |
| 2150 | (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence) | 2002 | (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence) |
| 2151 | (if (not internal-flag) | 2003 | (if (not internal-flag) |
| 2152 | (mh-undefine-sequence sequence (list message))) | 2004 | (mh-undefine-sequence sequence (list message))) |
| 2153 | (setcdr entry (delq message (mh-seq-msgs entry))))))) | 2005 | (setcdr entry (delq message (mh-seq-msgs entry))))))) |
| 2154 | 2006 | ||
| 2155 | (defun mh-undefine-sequence (seq msgs) | 2007 | (defun mh-undefine-sequence (seq msgs) |
| 2156 | "Remove from the SEQ the list of MSGS." | 2008 | "Remove from the SEQ the list of MSGS." |
| 2157 | (mh-exec-cmd "mark" mh-current-folder "-delete" | 2009 | (mh-exec-cmd "mark" mh-current-folder "-delete" |
| 2158 | "-sequence" (symbol-name seq) | 2010 | "-sequence" (symbol-name seq) |
| 2159 | (mh-coalesce-msg-list msgs))) | 2011 | (mh-coalesce-msg-list msgs))) |
| 2160 | 2012 | ||
| 2161 | (defun mh-define-sequence (seq msgs) | 2013 | (defun mh-define-sequence (seq msgs) |
| 2162 | "Define the SEQ to contain the list of MSGS. | 2014 | "Define the SEQ to contain the list of MSGS. |
| 2163 | Do not mark pseudo-sequences or empty sequences. | 2015 | Do not mark pseudo-sequences or empty sequences. |
| 2164 | Signals an error if SEQ is an illegal name." | 2016 | Signals an error if SEQ is an illegal name." |
| 2165 | (if (and msgs | 2017 | (if (and msgs |
| 2166 | (not (mh-folder-name-p seq))) | 2018 | (not (mh-folder-name-p seq))) |
| 2167 | (save-excursion | 2019 | (save-excursion |
| 2168 | (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" | 2020 | (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" |
| 2169 | "-sequence" (symbol-name seq) | 2021 | "-sequence" (symbol-name seq) |
| 2170 | (mh-coalesce-msg-list msgs))))) | 2022 | (mh-coalesce-msg-list msgs))))) |
| 2171 | 2023 | ||
| 2172 | (defun mh-map-over-seqs (function seq-list) | 2024 | (defun mh-map-over-seqs (function seq-list) |
| 2173 | "Apply FUNCTION to each sequence in SEQ-LIST. | 2025 | "Apply FUNCTION to each sequence in SEQ-LIST. |
| 2174 | The sequence name and the list of messages are passed as arguments." | 2026 | The sequence name and the list of messages are passed as arguments." |
| 2175 | (while seq-list | 2027 | (while seq-list |
| 2176 | (funcall function | 2028 | (funcall function |
| 2177 | (mh-seq-name (car seq-list)) | 2029 | (mh-seq-name (car seq-list)) |
| 2178 | (mh-seq-msgs (car seq-list))) | 2030 | (mh-seq-msgs (car seq-list))) |
| 2179 | (setq seq-list (cdr seq-list)))) | 2031 | (setq seq-list (cdr seq-list)))) |
| 2180 | 2032 | ||
| 2181 | (defun mh-notate-if-in-one-seq (msg character offset seq) | 2033 | (defun mh-notate-if-in-one-seq (msg character offset seq) |
| @@ -2184,18 +2036,18 @@ The CHARACTER is placed at the given OFFSET from the beginning of the listing. | |||
| 2184 | The notation is performed if the MSG is only in SEQ." | 2036 | The notation is performed if the MSG is only in SEQ." |
| 2185 | (let ((in-seqs (mh-seq-containing-msg msg nil))) | 2037 | (let ((in-seqs (mh-seq-containing-msg msg nil))) |
| 2186 | (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) | 2038 | (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) |
| 2187 | (mh-notate msg character offset)))) | 2039 | (mh-notate msg character offset)))) |
| 2188 | 2040 | ||
| 2189 | (defun mh-seq-containing-msg (msg &optional include-internal-flag) | 2041 | (defun mh-seq-containing-msg (msg &optional include-internal-flag) |
| 2190 | "Return a list of the sequences containing MSG. | 2042 | "Return a list of the sequences containing MSG. |
| 2191 | If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." | 2043 | If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." |
| 2192 | (let ((l mh-seq-list) | 2044 | (let ((l mh-seq-list) |
| 2193 | (seqs ())) | 2045 | (seqs ())) |
| 2194 | (while l | 2046 | (while l |
| 2195 | (and (memq msg (mh-seq-msgs (car l))) | 2047 | (and (memq msg (mh-seq-msgs (car l))) |
| 2196 | (or include-internal-flag | 2048 | (or include-internal-flag |
| 2197 | (not (mh-internal-seq (mh-seq-name (car l))))) | 2049 | (not (mh-internal-seq (mh-seq-name (car l))))) |
| 2198 | (setq seqs (cons (mh-seq-name (car l)) seqs))) | 2050 | (setq seqs (cons (mh-seq-name (car l)) seqs))) |
| 2199 | (setq l (cdr l))) | 2051 | (setq l (cdr l))) |
| 2200 | seqs)) | 2052 | seqs)) |
| 2201 | 2053 | ||
| @@ -2203,17 +2055,26 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." | |||
| 2203 | 2055 | ||
| 2204 | ;;; User prompting commands. | 2056 | ;;; User prompting commands. |
| 2205 | 2057 | ||
| 2206 | (defun mh-read-msg-range (prompt) | 2058 | (defun mh-read-msg-range (folder &optional always-prompt-flag) |
| 2207 | "Read a list of blank-separated messages using the given PROMPT." | 2059 | "Prompt for message range from FOLDER. |
| 2208 | (let* ((buf (read-string prompt)) | 2060 | If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for |
| 2209 | (buf-size (length buf)) | 2061 | range." |
| 2210 | (start 0) | 2062 | (multiple-value-bind (total unseen) (mh-folder-size folder) |
| 2211 | (input ())) | 2063 | (cond |
| 2212 | (while (< start buf-size) | 2064 | ((and (not always-prompt-flag) (numberp unseen) (> unseen 0)) |
| 2213 | (let ((next (read-from-string buf start buf-size))) | 2065 | (list (symbol-name mh-unseen-seq))) |
| 2214 | (setq input (cons (car next) input)) | 2066 | ((or (null mh-large-folder) (not (numberp total))) |
| 2215 | (setq start (cdr next)))) | 2067 | (list "all")) |
| 2216 | (nreverse input))) | 2068 | ((and (numberp total) (or always-prompt-flag (> total mh-large-folder))) |
| 2069 | (let* ((prompt | ||
| 2070 | (format "Range or number of messages to read (default: %s): " | ||
| 2071 | total)) | ||
| 2072 | (in (read-string prompt nil nil (number-to-string total)))) | ||
| 2073 | (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in) | ||
| 2074 | (list (format "last:%s" (car (read-from-string in))))) | ||
| 2075 | ((equal in "") (list "all")) | ||
| 2076 | (t (split-string in))))) | ||
| 2077 | (t (list "all"))))) | ||
| 2217 | 2078 | ||
| 2218 | 2079 | ||
| 2219 | 2080 | ||
| @@ -2230,91 +2091,99 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." | |||
| 2230 | 2091 | ||
| 2231 | ;; Save the `b' binding for a future `back'. Maybe? | 2092 | ;; Save the `b' binding for a future `back'. Maybe? |
| 2232 | (gnus-define-keys mh-folder-mode-map | 2093 | (gnus-define-keys mh-folder-mode-map |
| 2233 | " " mh-page-msg | 2094 | " " mh-page-msg |
| 2234 | "!" mh-refile-or-write-again | 2095 | "!" mh-refile-or-write-again |
| 2235 | "," mh-header-display | 2096 | "," mh-header-display |
| 2236 | "." mh-alt-show | 2097 | "." mh-alt-show |
| 2237 | ">" mh-write-msg-to-file | 2098 | ">" mh-write-msg-to-file |
| 2238 | "?" mh-help | 2099 | "?" mh-help |
| 2239 | "E" mh-extract-rejected-mail | 2100 | "E" mh-extract-rejected-mail |
| 2240 | "M" mh-modify | 2101 | "M" mh-modify |
| 2241 | "\177" mh-previous-page | 2102 | "\177" mh-previous-page |
| 2242 | "\C-d" mh-delete-msg-no-motion | 2103 | "\C-d" mh-delete-msg-no-motion |
| 2243 | "\t" mh-next-button | 2104 | "\t" mh-index-next-folder |
| 2244 | [backtab] mh-prev-button | 2105 | [backtab] mh-index-previous-folder |
| 2245 | "\M-\t" mh-prev-button | 2106 | "\M-\t" mh-index-previous-folder |
| 2246 | "\e<" mh-first-msg | 2107 | "\e<" mh-first-msg |
| 2247 | "\e>" mh-last-msg | 2108 | "\e>" mh-last-msg |
| 2248 | "\ed" mh-redistribute | 2109 | "\ed" mh-redistribute |
| 2249 | "\r" mh-show | 2110 | "\r" mh-show |
| 2250 | "^" mh-alt-refile-msg | 2111 | "^" mh-alt-refile-msg |
| 2251 | "c" mh-copy-msg | 2112 | "c" mh-copy-msg |
| 2252 | "d" mh-delete-msg | 2113 | "d" mh-delete-msg |
| 2253 | "e" mh-edit-again | 2114 | "e" mh-edit-again |
| 2254 | "f" mh-forward | 2115 | "f" mh-forward |
| 2255 | "g" mh-goto-msg | 2116 | "g" mh-goto-msg |
| 2256 | "i" mh-inc-folder | 2117 | "i" mh-inc-folder |
| 2257 | "k" mh-delete-subject | 2118 | "k" mh-delete-subject-or-thread |
| 2258 | "l" mh-print-msg | 2119 | "l" mh-print-msg |
| 2259 | "m" mh-alt-send | 2120 | "m" mh-alt-send |
| 2260 | "n" mh-next-undeleted-msg | 2121 | "n" mh-next-undeleted-msg |
| 2261 | "o" mh-refile-msg | 2122 | "\M-n" mh-next-unread-msg |
| 2262 | "p" mh-previous-undeleted-msg | 2123 | "o" mh-refile-msg |
| 2263 | "q" mh-quit | 2124 | "p" mh-previous-undeleted-msg |
| 2264 | "r" mh-reply | 2125 | "\M-p" mh-previous-unread-msg |
| 2265 | "s" mh-send | 2126 | "q" mh-quit |
| 2266 | "t" mh-toggle-showing | 2127 | "r" mh-reply |
| 2267 | "u" mh-undo | 2128 | "s" mh-send |
| 2268 | "x" mh-execute-commands | 2129 | "t" mh-toggle-showing |
| 2269 | "|" mh-pipe-msg) | 2130 | "u" mh-undo |
| 2131 | "v" mh-index-visit-folder | ||
| 2132 | "x" mh-execute-commands | ||
| 2133 | "|" mh-pipe-msg) | ||
| 2270 | 2134 | ||
| 2271 | (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) | 2135 | (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) |
| 2272 | "?" mh-prefix-help | 2136 | "?" mh-prefix-help |
| 2273 | "S" mh-sort-folder | 2137 | "S" mh-sort-folder |
| 2274 | "f" mh-alt-visit-folder | 2138 | "f" mh-alt-visit-folder |
| 2275 | "i" mh-index-search | 2139 | "i" mh-index-search |
| 2276 | "k" mh-kill-folder | 2140 | "k" mh-kill-folder |
| 2277 | "l" mh-list-folders | 2141 | "l" mh-list-folders |
| 2278 | "o" mh-alt-visit-folder | 2142 | "o" mh-alt-visit-folder |
| 2279 | "p" mh-pack-folder | 2143 | "p" mh-pack-folder |
| 2280 | "r" mh-rescan-folder | 2144 | "r" mh-rescan-folder |
| 2281 | "s" mh-search-folder | 2145 | "s" mh-search-folder |
| 2282 | "u" mh-undo-folder | 2146 | "u" mh-undo-folder |
| 2283 | "v" mh-visit-folder) | 2147 | "v" mh-visit-folder) |
| 2284 | 2148 | ||
| 2285 | (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) | 2149 | (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) |
| 2286 | "?" mh-prefix-help | 2150 | "?" mh-prefix-help |
| 2287 | "d" mh-delete-msg-from-seq | 2151 | "d" mh-delete-msg-from-seq |
| 2288 | "k" mh-delete-seq | 2152 | "k" mh-delete-seq |
| 2289 | "l" mh-list-sequences | 2153 | "l" mh-list-sequences |
| 2290 | "n" mh-narrow-to-seq | 2154 | "n" mh-narrow-to-seq |
| 2291 | "p" mh-put-msg-in-seq | 2155 | "p" mh-put-msg-in-seq |
| 2292 | "s" mh-msg-is-in-seq | 2156 | "s" mh-msg-is-in-seq |
| 2293 | "w" mh-widen) | 2157 | "w" mh-widen) |
| 2294 | 2158 | ||
| 2295 | (gnus-define-keys (mh-thread-map "T" mh-folder-mode-map) | 2159 | (gnus-define-keys (mh-thread-map "T" mh-folder-mode-map) |
| 2296 | "?" mh-prefix-help | 2160 | "?" mh-prefix-help |
| 2297 | "t" mh-toggle-threads) | 2161 | "u" mh-thread-ancestor |
| 2162 | "p" mh-thread-previous-sibling | ||
| 2163 | "n" mh-thread-next-sibling | ||
| 2164 | "t" mh-toggle-threads | ||
| 2165 | "d" mh-thread-delete | ||
| 2166 | "o" mh-thread-refile) | ||
| 2298 | 2167 | ||
| 2299 | (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) | 2168 | (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) |
| 2300 | "?" mh-prefix-help | 2169 | "?" mh-prefix-help |
| 2301 | "s" mh-narrow-to-subject | 2170 | "s" mh-narrow-to-subject |
| 2302 | "w" mh-widen) | 2171 | "w" mh-widen) |
| 2303 | 2172 | ||
| 2304 | (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) | 2173 | (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) |
| 2305 | "?" mh-prefix-help | 2174 | "?" mh-prefix-help |
| 2306 | "s" mh-store-msg ;shar | 2175 | "s" mh-store-msg ;shar |
| 2307 | "u" mh-store-msg) ;uuencode | 2176 | "u" mh-store-msg) ;uuencode |
| 2308 | 2177 | ||
| 2309 | (gnus-define-keys (mh-digest-map "D" mh-folder-mode-map) | 2178 | (gnus-define-keys (mh-digest-map "D" mh-folder-mode-map) |
| 2310 | " " mh-page-digest | 2179 | " " mh-page-digest |
| 2311 | "?" mh-prefix-help | 2180 | "?" mh-prefix-help |
| 2312 | "\177" mh-page-digest-backwards | 2181 | "\177" mh-page-digest-backwards |
| 2313 | "b" mh-burst-digest) | 2182 | "b" mh-burst-digest) |
| 2314 | 2183 | ||
| 2315 | (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) | 2184 | (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) |
| 2316 | "?" mh-prefix-help | 2185 | "?" mh-prefix-help |
| 2317 | "a" mh-mime-save-parts | 2186 | "a" mh-mime-save-parts |
| 2318 | "i" mh-folder-inline-mime-part | 2187 | "i" mh-folder-inline-mime-part |
| 2319 | "o" mh-folder-save-mime-part | 2188 | "o" mh-folder-save-mime-part |
| 2320 | "v" mh-folder-toggle-mime-part | 2189 | "v" mh-folder-toggle-mime-part |
| @@ -2345,23 +2214,23 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." | |||
| 2345 | ;;; `F' entry, it would not be clear what these commands operated upon. | 2214 | ;;; `F' entry, it would not be clear what these commands operated upon. |
| 2346 | (defvar mh-help-messages | 2215 | (defvar mh-help-messages |
| 2347 | '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" | 2216 | '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" |
| 2348 | "[d]elete, [o]refile, e[x]ecute,\n" | 2217 | "[d]elete, [o]refile, e[x]ecute,\n" |
| 2349 | "[s]end, [r]eply.\n" | 2218 | "[s]end, [r]eply.\n" |
| 2350 | "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, " | 2219 | "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, " |
| 2351 | "[T]hread, / Limit, e[X]tract, [D]igest.") | 2220 | "[T]hread, / Limit, e[X]tract, [D]igest.") |
| 2352 | 2221 | ||
| 2353 | (?F "[l]ist, [v]isit folder;\n" | 2222 | (?F "[l]ist, [v]isit folder;\n" |
| 2354 | "[t]hread; [s]earch; [i]ndexed search;\n" | 2223 | "[t]hread; [s]earch; [i]ndexed search;\n" |
| 2355 | "[p]ack; [S]ort; [r]escan; [k]ill") | 2224 | "[p]ack; [S]ort; [r]escan; [k]ill") |
| 2356 | (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n" | 2225 | (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n" |
| 2357 | "[s]equences, [l]ist,\n" | 2226 | "[s]equences, [l]ist,\n" |
| 2358 | "[d]elete message from sequence, [k]ill sequence") | 2227 | "[d]elete message from sequence, [k]ill sequence") |
| 2359 | (?T "[t]oggle thread") | 2228 | (?T "[t]oggle, [d]elete, [o]refile thread") |
| 2360 | (?/ "Limit to [s]ubject; [w]iden") | 2229 | (?/ "Limit to [s]ubject; [w]iden") |
| 2361 | (?X "un[s]har, [u]udecode message") | 2230 | (?X "un[s]har, [u]udecode message") |
| 2362 | (?D "[b]urst digest") | 2231 | (?D "[b]urst digest") |
| 2363 | (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" | 2232 | (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" |
| 2364 | "[TAB] next; [SHIFT-TAB] previous")) | 2233 | "[TAB] next; [SHIFT-TAB] previous")) |
| 2365 | "Key binding cheat sheet. | 2234 | "Key binding cheat sheet. |
| 2366 | 2235 | ||
| 2367 | This is an associative array which is used to show the most common commands. | 2236 | This is an associative array which is used to show the most common commands. |
| @@ -2375,175 +2244,14 @@ well.") | |||
| 2375 | 2244 | ||
| 2376 | 2245 | ||
| 2377 | 2246 | ||
| 2378 | ;;; autoload the other MH-E parts | ||
| 2379 | |||
| 2380 | ;;; mh-comp | ||
| 2381 | |||
| 2382 | (autoload 'mh-smail "mh-comp" | ||
| 2383 | "Compose and send mail with the MH mail system. | ||
| 2384 | This function is an entry point to MH-E, the Emacs front end | ||
| 2385 | to the MH mail system. | ||
| 2386 | See documentation of `\\[mh-send]' for more details on composing mail." t) | ||
| 2387 | |||
| 2388 | (autoload 'mh-smail-other-window "mh-comp" | ||
| 2389 | "Compose and send mail in other window with the MH mail system. | ||
| 2390 | This function is an entry point to MH-E, the Emacs front end | ||
| 2391 | to the MH mail system. | ||
| 2392 | See documentation of `\\[mh-send]' for more details on composing mail." t) | ||
| 2393 | |||
| 2394 | (autoload 'mh-edit-again "mh-comp" | ||
| 2395 | "Clean-up a draft or a message previously sent and make it resendable. | ||
| 2396 | Default is the current message. | ||
| 2397 | The variable mh-new-draft-cleaned-headers specifies the headers to remove. | ||
| 2398 | See also documentation for `\\[mh-send]' function." t) | ||
| 2399 | |||
| 2400 | (autoload 'mh-extract-rejected-mail "mh-comp" | ||
| 2401 | "Extract a letter returned by the mail system and make it resendable. | ||
| 2402 | Default is the current message. The variable mh-new-draft-cleaned-headers | ||
| 2403 | gives the headers to clean out of the original message. | ||
| 2404 | See also documentation for `\\[mh-send]' function." t) | ||
| 2405 | |||
| 2406 | (autoload 'mh-forward "mh-comp" | ||
| 2407 | "Forward a message or message sequence. Defaults to displayed message. | ||
| 2408 | If optional prefix argument provided, then prompt for the message sequence. | ||
| 2409 | See also documentation for `\\[mh-send]' function." t) | ||
| 2410 | |||
| 2411 | (autoload 'mh-redistribute "mh-comp" | ||
| 2412 | "Redistribute a letter. | ||
| 2413 | Depending on how your copy of MH was compiled, you may need to change the | ||
| 2414 | setting of the variable mh-redist-full-contents. See its documentation." t) | ||
| 2415 | |||
| 2416 | (autoload 'mh-send "mh-comp" | ||
| 2417 | "Compose and send a letter. | ||
| 2418 | The file named by `mh-comp-formfile' will be used as the form. | ||
| 2419 | Do not call this function from outside MH-E; use \\[mh-smail] instead. | ||
| 2420 | The letter is composed in mh-letter-mode; see its documentation for more | ||
| 2421 | details. If `mh-compose-letter-function' is defined, it is called on the | ||
| 2422 | draft and passed three arguments: to, subject, and cc." t) | ||
| 2423 | |||
| 2424 | (autoload 'mh-send-other-window "mh-comp" | ||
| 2425 | "Compose and send a letter in another window. | ||
| 2426 | Do not call this function from outside MH-E; | ||
| 2427 | use \\[mh-smail-other-window] instead. | ||
| 2428 | See also documentation for `\\[mh-send]' function." t) | ||
| 2429 | |||
| 2430 | (autoload 'mh-letter-mode "mh-comp" | ||
| 2431 | "Mode for composing letters in MH-E. | ||
| 2432 | For more details, type \\[describe-mode] while in MH-Letter mode." t) | ||
| 2433 | |||
| 2434 | ;;; mh-funcs | ||
| 2435 | |||
| 2436 | (autoload 'mh-burst-digest "mh-funcs" | ||
| 2437 | "Burst apart the current message, which should be a digest. | ||
| 2438 | The message is replaced by its table of contents and the messages from the | ||
| 2439 | digest are inserted into the folder after that message." t) | ||
| 2440 | |||
| 2441 | (autoload 'mh-copy-msg "mh-funcs" | ||
| 2442 | "Copy to another FOLDER the specified MESSAGE(s) without deleting them. | ||
| 2443 | Default is the displayed message. If optional prefix argument is | ||
| 2444 | provided, then prompt for the message sequence." t) | ||
| 2445 | |||
| 2446 | (autoload 'mh-kill-folder "mh-funcs" | ||
| 2447 | "Remove the current folder." t) | ||
| 2448 | |||
| 2449 | (autoload 'mh-list-folders "mh-funcs" | ||
| 2450 | "List mail folders." t) | ||
| 2451 | |||
| 2452 | (autoload 'mh-pack-folder "mh-funcs" | ||
| 2453 | "Renumber the messages of a folder to be 1..n. | ||
| 2454 | First, offer to execute any outstanding commands for the current folder. | ||
| 2455 | If optional prefix argument provided, prompt for the range of messages | ||
| 2456 | to display after packing. Otherwise, show the entire folder." t) | ||
| 2457 | |||
| 2458 | (autoload 'mh-pipe-msg "mh-funcs" | ||
| 2459 | "Pipe the current message through the given shell COMMAND. | ||
| 2460 | If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. | ||
| 2461 | Otherwise just send the message's body without the headers." t) | ||
| 2462 | |||
| 2463 | (autoload 'mh-page-digest "mh-funcs" | ||
| 2464 | "Advance displayed message to next digested message." t) | ||
| 2465 | |||
| 2466 | (autoload 'mh-page-digest-backwards "mh-funcs" | ||
| 2467 | "Back up displayed message to previous digested message." t) | ||
| 2468 | |||
| 2469 | (autoload 'mh-print-msg "mh-funcs" | ||
| 2470 | "Print MESSAGE(s) (default: displayed message) on printer. | ||
| 2471 | If optional prefix argument provided, then prompt for the message sequence. | ||
| 2472 | The variable mh-lpr-command-format is used to generate the print command. | ||
| 2473 | The messages are formatted by mhl. See the variable mhl-formfile." t) | ||
| 2474 | |||
| 2475 | (autoload 'mh-sort-folder "mh-funcs" | ||
| 2476 | "Sort the messages in the current folder by date. | ||
| 2477 | Calls the MH program sortm to do the work. | ||
| 2478 | The arguments in the list mh-sortm-args are passed to sortm | ||
| 2479 | if this function is passed an argument." t) | ||
| 2480 | |||
| 2481 | (autoload 'mh-store-msg "mh-funcs" | ||
| 2482 | "Store the file(s) contained in the current message into DIRECTORY. | ||
| 2483 | The message can contain a shar file or uuencoded file. | ||
| 2484 | Default directory is the last directory used, or initially the value of | ||
| 2485 | mh-store-default-directory or the current directory." t) | ||
| 2486 | |||
| 2487 | (autoload 'mh-store-buffer "mh-funcs" | ||
| 2488 | "Store the file(s) contained in the current buffer into DIRECTORY. | ||
| 2489 | The buffer can contain a shar file or uuencoded file. | ||
| 2490 | Default directory is the last directory used, or initially the value of | ||
| 2491 | `mh-store-default-directory' or the current directory." t) | ||
| 2492 | |||
| 2493 | (autoload 'mh-help "mh-funcs" | ||
| 2494 | "Display cheat sheet for MH-E commands in minibuffer." t) | ||
| 2495 | |||
| 2496 | (autoload 'mh-prefix-help "mh-funcs" | ||
| 2497 | "Display cheat sheet for the commands of the current prefix in minibuffer." | ||
| 2498 | t) | ||
| 2499 | |||
| 2500 | ;;; mh-pick | ||
| 2501 | |||
| 2502 | (autoload 'mh-search-folder "mh-pick" | ||
| 2503 | "Search FOLDER for messages matching a pattern. | ||
| 2504 | Add the messages found to the sequence named `search'." t) | ||
| 2505 | |||
| 2506 | ;;; mh-seq | ||
| 2507 | |||
| 2508 | (autoload 'mh-region-to-sequence "mh-seq" | ||
| 2509 | "Define sequence 'region as the messages in selected region." t) | ||
| 2510 | (autoload 'mh-delete-seq "mh-seq" | ||
| 2511 | "Delete the SEQUENCE." t) | ||
| 2512 | (autoload 'mh-list-sequences "mh-seq" | ||
| 2513 | "List the sequences defined in FOLDER." t) | ||
| 2514 | (autoload 'mh-msg-is-in-seq "mh-seq" | ||
| 2515 | "Display the sequences that contain MESSAGE (default: displayed message)." t) | ||
| 2516 | (autoload 'mh-narrow-to-seq "mh-seq" | ||
| 2517 | "Restrict display of this folder to just messages in SEQUENCE | ||
| 2518 | Use \\[mh-widen] to undo this command." t) | ||
| 2519 | (autoload 'mh-put-msg-in-seq "mh-seq" | ||
| 2520 | "Add MESSAGE(s) (default: displayed message) to SEQUENCE. | ||
| 2521 | If optional prefix argument provided, then prompt for the message sequence." t) | ||
| 2522 | (autoload 'mh-rename-seq "mh-seq" | ||
| 2523 | "Rename SEQUENCE to have NEW-NAME." t) | ||
| 2524 | (autoload 'mh-narrow-to-subject "mh-seq" | ||
| 2525 | "Narrow to a sequence containing all following messages with same subject." | ||
| 2526 | t) | ||
| 2527 | (autoload 'mh-toggle-threads "mh-seq" | ||
| 2528 | "Toggle threaded view of folder." t) | ||
| 2529 | (autoload 'mh-delete-subject "mh-seq" | ||
| 2530 | "Mark all following messages with same subject to be deleted." t) | ||
| 2531 | |||
| 2532 | ;;; mh-speed | ||
| 2533 | |||
| 2534 | (autoload 'mh-folder-speedbar-buttons "mh-speed") | ||
| 2535 | (autoload 'mh-show-speedbar-buttons "mh-speed") | ||
| 2536 | (autoload 'mh-index-folder-speedbar-buttons "mh-speed") | ||
| 2537 | (autoload 'mh-index-show-speedbar-buttons "mh-speed") | ||
| 2538 | (autoload 'mh-letter-speedbar-buttons "mh-speed") | ||
| 2539 | |||
| 2540 | (dolist (mess '("^Cursor not pointing to message$" | 2247 | (dolist (mess '("^Cursor not pointing to message$" |
| 2541 | "^There is no other window$")) | 2248 | "^There is no other window$")) |
| 2542 | (add-to-list 'debug-ignored-errors mess)) | 2249 | (add-to-list 'debug-ignored-errors mess)) |
| 2543 | 2250 | ||
| 2544 | (provide 'mh-e) | 2251 | (provide 'mh-e) |
| 2545 | 2252 | ||
| 2546 | ;;; Local Variables: | 2253 | ;;; Local Variables: |
| 2254 | ;;; indent-tabs-mode: nil | ||
| 2547 | ;;; sentence-end-double-space: nil | 2255 | ;;; sentence-end-double-space: nil |
| 2548 | ;;; End: | 2256 | ;;; End: |
| 2549 | 2257 | ||
diff --git a/lisp/mail/mh-funcs.el b/lisp/mail/mh-funcs.el index e092b7554f6..b14039170f1 100644 --- a/lisp/mail/mh-funcs.el +++ b/lisp/mail/mh-funcs.el | |||
| @@ -32,17 +32,13 @@ | |||
| 32 | 32 | ||
| 33 | ;;; Change Log: | 33 | ;;; Change Log: |
| 34 | 34 | ||
| 35 | ;; $Id: mh-funcs.el,v 1.28 2002/11/11 23:01:27 mbaushke Exp $ | 35 | ;; $Id: mh-funcs.el,v 1.36 2002/12/23 05:52:07 satyaki Exp $ |
| 36 | 36 | ||
| 37 | ;;; Code: | 37 | ;;; Code: |
| 38 | 38 | ||
| 39 | (require 'mh-e) | 39 | (require 'mh-e) |
| 40 | 40 | ||
| 41 | ;;; autoload | 41 | ;;; Customization |
| 42 | (autoload 'mh-notate-seq "mh-seq") | ||
| 43 | (autoload 'mh-speed-invalidate-map "mh-speed") | ||
| 44 | |||
| 45 | ;;; customization | ||
| 46 | 42 | ||
| 47 | (defvar mh-sortm-args nil | 43 | (defvar mh-sortm-args nil |
| 48 | "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. | 44 | "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. |
| @@ -59,6 +55,7 @@ For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.") | |||
| 59 | 55 | ||
| 60 | ;;; Functions | 56 | ;;; Functions |
| 61 | 57 | ||
| 58 | ;;;###mh-autoload | ||
| 62 | (defun mh-burst-digest () | 59 | (defun mh-burst-digest () |
| 63 | "Burst apart the current message, which should be a digest. | 60 | "Burst apart the current message, which should be a digest. |
| 64 | The message is replaced by its table of contents and the messages from the | 61 | The message is replaced by its table of contents and the messages from the |
| @@ -66,7 +63,7 @@ digest are inserted into the folder after that message." | |||
| 66 | (interactive) | 63 | (interactive) |
| 67 | (let ((digest (mh-get-msg-num t))) | 64 | (let ((digest (mh-get-msg-num t))) |
| 68 | (mh-process-or-undo-commands mh-current-folder) | 65 | (mh-process-or-undo-commands mh-current-folder) |
| 69 | (mh-set-folder-modified-p t) ; lock folder while bursting | 66 | (mh-set-folder-modified-p t) ; lock folder while bursting |
| 70 | (message "Bursting digest...") | 67 | (message "Bursting digest...") |
| 71 | (mh-exec-cmd "burst" mh-current-folder digest "-inplace") | 68 | (mh-exec-cmd "burst" mh-current-folder digest "-inplace") |
| 72 | (with-mh-folder-updating (t) | 69 | (with-mh-folder-updating (t) |
| @@ -76,19 +73,29 @@ digest are inserted into the folder after that message." | |||
| 76 | (mh-goto-cur-msg) | 73 | (mh-goto-cur-msg) |
| 77 | (message "Bursting digest...done"))) | 74 | (message "Bursting digest...done"))) |
| 78 | 75 | ||
| 76 | ;;;###mh-autoload | ||
| 79 | (defun mh-copy-msg (msg-or-seq folder) | 77 | (defun mh-copy-msg (msg-or-seq folder) |
| 80 | "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. | 78 | "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. |
| 81 | Default is the displayed message. If optional prefix argument is provided, | 79 | Default is the displayed message. If optional prefix argument is provided, |
| 82 | then prompt for the message sequence." | 80 | then prompt for the message sequence." |
| 83 | (interactive (list (if current-prefix-arg | 81 | (interactive (list (cond |
| 84 | (mh-read-seq-default "Copy" t) | 82 | ((mh-mark-active-p t) |
| 85 | (mh-get-msg-num t)) | 83 | (mh-region-to-msg-list (region-beginning) (region-end))) |
| 86 | (mh-prompt-for-folder "Copy to" "" t))) | 84 | (current-prefix-arg |
| 87 | (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder) | 85 | (mh-read-seq-default "Copy" t)) |
| 86 | (t | ||
| 87 | (mh-get-msg-num t))) | ||
| 88 | (mh-prompt-for-folder "Copy to" "" t))) | ||
| 89 | (mh-exec-cmd "refile" | ||
| 90 | (cond ((numberp msg-or-seq) msg-or-seq) | ||
| 91 | ((listp msg-or-seq) msg-or-seq) | ||
| 92 | (t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq)))) | ||
| 93 | "-link" "-src" mh-current-folder folder) | ||
| 88 | (if (numberp msg-or-seq) | 94 | (if (numberp msg-or-seq) |
| 89 | (mh-notate msg-or-seq mh-note-copied mh-cmd-note) | 95 | (mh-notate msg-or-seq mh-note-copied mh-cmd-note) |
| 90 | (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note))) | 96 | (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note))) |
| 91 | 97 | ||
| 98 | ;;;###mh-autoload | ||
| 92 | (defun mh-kill-folder () | 99 | (defun mh-kill-folder () |
| 93 | "Remove the current folder and all included messages. | 100 | "Remove the current folder and all included messages. |
| 94 | Removes all of the messages (files) within the specified current folder, | 101 | Removes all of the messages (files) within the specified current folder, |
| @@ -99,54 +106,60 @@ with no arguments, after the folders has been removed." | |||
| 99 | (if (yes-or-no-p (format "Remove folder %s (and all included messages)?" | 106 | (if (yes-or-no-p (format "Remove folder %s (and all included messages)?" |
| 100 | mh-current-folder)) | 107 | mh-current-folder)) |
| 101 | (let ((folder mh-current-folder)) | 108 | (let ((folder mh-current-folder)) |
| 102 | (if (null mh-folder-list) | 109 | (if (null mh-folder-list) |
| 103 | (mh-set-folder-list)) | 110 | (mh-set-folder-list)) |
| 104 | (mh-set-folder-modified-p t) ; lock folder to kill it | 111 | (mh-set-folder-modified-p t) ; lock folder to kill it |
| 105 | (mh-exec-cmd-daemon "rmf" folder) | 112 | (mh-exec-cmd-daemon "rmf" folder) |
| 106 | (setq mh-folder-list | 113 | (setq mh-folder-list |
| 107 | (delq (assoc folder mh-folder-list) mh-folder-list)) | 114 | (delq (assoc folder mh-folder-list) mh-folder-list)) |
| 108 | (when (boundp 'mh-speed-folder-map) | 115 | (when (boundp 'mh-speed-folder-map) |
| 109 | (mh-speed-invalidate-map folder)) | 116 | (mh-speed-invalidate-map folder)) |
| 110 | (run-hooks 'mh-folder-list-change-hook) | 117 | (run-hooks 'mh-folder-list-change-hook) |
| 111 | (message "Folder %s removed" folder) | 118 | (message "Folder %s removed" folder) |
| 112 | (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain | 119 | (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain |
| 113 | (if (get-buffer mh-show-buffer) | 120 | (if (get-buffer mh-show-buffer) |
| 114 | (kill-buffer mh-show-buffer)) | 121 | (kill-buffer mh-show-buffer)) |
| 115 | (if (get-buffer folder) | 122 | (if (get-buffer folder) |
| 116 | (kill-buffer folder))) | 123 | (kill-buffer folder))) |
| 117 | (message "Folder not removed"))) | 124 | (message "Folder not removed"))) |
| 118 | 125 | ||
| 119 | ;; Avoid compiler warning... | 126 | ;; Avoid compiler warning... |
| 120 | (defvar view-exit-action) | 127 | (defvar view-exit-action) |
| 121 | 128 | ||
| 129 | ;;;###mh-autoload | ||
| 122 | (defun mh-list-folders () | 130 | (defun mh-list-folders () |
| 123 | "List mail folders." | 131 | "List mail folders." |
| 124 | (interactive) | 132 | (interactive) |
| 125 | (let ((temp-buffer mh-temp-folders-buffer)) | 133 | (let ((temp-buffer mh-temp-folders-buffer)) |
| 126 | (with-output-to-temp-buffer temp-buffer | 134 | (with-output-to-temp-buffer temp-buffer |
| 127 | (save-excursion | 135 | (save-excursion |
| 128 | (set-buffer temp-buffer) | 136 | (set-buffer temp-buffer) |
| 129 | (erase-buffer) | 137 | (erase-buffer) |
| 130 | (message "Listing folders...") | 138 | (message "Listing folders...") |
| 131 | (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag | 139 | (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag |
| 132 | "-recurse" | 140 | "-recurse" |
| 133 | "-norecurse")) | 141 | "-norecurse")) |
| 134 | (goto-char (point-min)) | 142 | (goto-char (point-min)) |
| 135 | (view-mode 1) | 143 | (view-mode 1) |
| 136 | (setq view-exit-action 'kill-buffer) | 144 | (setq view-exit-action 'kill-buffer) |
| 137 | (message "Listing folders...done"))))) | 145 | (message "Listing folders...done"))))) |
| 138 | 146 | ||
| 147 | ;;;###mh-autoload | ||
| 139 | (defun mh-pack-folder (range) | 148 | (defun mh-pack-folder (range) |
| 140 | "Renumber the messages of a folder to be 1..n. | 149 | "Renumber the messages of a folder to be 1..n. |
| 141 | First, offer to execute any outstanding commands for the current folder. If | 150 | First, offer to execute any outstanding commands for the current folder. If |
| 142 | optional prefix argument provided, prompt for the RANGE of messages to display | 151 | optional prefix argument provided, prompt for the RANGE of messages to display |
| 143 | after packing. Otherwise, show the entire folder." | 152 | after packing. Otherwise, show the entire folder." |
| 144 | (interactive (list (if current-prefix-arg | 153 | (interactive (list (if current-prefix-arg |
| 145 | (mh-read-msg-range | 154 | (mh-read-msg-range mh-current-folder t) |
| 146 | "Range to scan after packing [all]? ") | 155 | '("all")))) |
| 147 | "all"))) | 156 | (let ((threaded-flag (memq 'unthread mh-view-ops))) |
| 148 | (mh-pack-folder-1 range) | 157 | (mh-pack-folder-1 range) |
| 149 | (mh-goto-cur-msg) | 158 | (mh-goto-cur-msg) |
| 159 | (when mh-index-data | ||
| 160 | (mh-index-update-maps mh-current-folder)) | ||
| 161 | (cond (threaded-flag (mh-toggle-threads)) | ||
| 162 | (mh-index-data (mh-index-insert-folder-headers)))) | ||
| 150 | (message "Packing folder...done")) | 163 | (message "Packing folder...done")) |
| 151 | 164 | ||
| 152 | (defun mh-pack-folder-1 (range) | 165 | (defun mh-pack-folder-1 (range) |
| @@ -155,13 +168,14 @@ Display the given RANGE of messages after packing. If RANGE is nil, show the | |||
| 155 | entire folder." | 168 | entire folder." |
| 156 | (mh-process-or-undo-commands mh-current-folder) | 169 | (mh-process-or-undo-commands mh-current-folder) |
| 157 | (message "Packing folder...") | 170 | (message "Packing folder...") |
| 158 | (mh-set-folder-modified-p t) ; lock folder while packing | 171 | (mh-set-folder-modified-p t) ; lock folder while packing |
| 159 | (save-excursion | 172 | (save-excursion |
| 160 | (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" | 173 | (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" |
| 161 | "-norecurse" "-fast")) | 174 | "-norecurse" "-fast")) |
| 162 | (mh-reset-threads-and-narrowing) | 175 | (mh-reset-threads-and-narrowing) |
| 163 | (mh-regenerate-headers range)) | 176 | (mh-regenerate-headers range)) |
| 164 | 177 | ||
| 178 | ;;;###mh-autoload | ||
| 165 | (defun mh-pipe-msg (command include-headers) | 179 | (defun mh-pipe-msg (command include-headers) |
| 166 | "Pipe the current message through the given shell COMMAND. | 180 | "Pipe the current message through the given shell COMMAND. |
| 167 | If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. | 181 | If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. |
| @@ -169,7 +183,7 @@ Otherwise just send the message's body without the headers." | |||
| 169 | (interactive | 183 | (interactive |
| 170 | (list (read-string "Shell command on message: ") current-prefix-arg)) | 184 | (list (read-string "Shell command on message: ") current-prefix-arg)) |
| 171 | (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) | 185 | (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) |
| 172 | (message-directory default-directory)) | 186 | (message-directory default-directory)) |
| 173 | (save-excursion | 187 | (save-excursion |
| 174 | (set-buffer (get-buffer-create mh-temp-buffer)) | 188 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 175 | (erase-buffer) | 189 | (erase-buffer) |
| @@ -177,8 +191,9 @@ Otherwise just send the message's body without the headers." | |||
| 177 | (goto-char (point-min)) | 191 | (goto-char (point-min)) |
| 178 | (if (not include-headers) (search-forward "\n\n")) | 192 | (if (not include-headers) (search-forward "\n\n")) |
| 179 | (let ((default-directory message-directory)) | 193 | (let ((default-directory message-directory)) |
| 180 | (shell-command-on-region (point) (point-max) command nil))))) | 194 | (shell-command-on-region (point) (point-max) command nil))))) |
| 181 | 195 | ||
| 196 | ;;;###mh-autoload | ||
| 182 | (defun mh-page-digest () | 197 | (defun mh-page-digest () |
| 183 | "Advance displayed message to next digested message." | 198 | "Advance displayed message to next digested message." |
| 184 | (interactive) | 199 | (interactive) |
| @@ -188,13 +203,14 @@ Otherwise just send the message's body without the headers." | |||
| 188 | (let ((case-fold-search nil)) | 203 | (let ((case-fold-search nil)) |
| 189 | ;; Search for blank line and then for From: | 204 | ;; Search for blank line and then for From: |
| 190 | (or (and (search-forward "\n\n" nil t) | 205 | (or (and (search-forward "\n\n" nil t) |
| 191 | (re-search-forward "^From:" nil t)) | 206 | (re-search-forward "^From:" nil t)) |
| 192 | (error "No more messages in digest"))) | 207 | (error "No more messages in digest"))) |
| 193 | ;; Go back to previous blank line, then forward to the first non-blank. | 208 | ;; Go back to previous blank line, then forward to the first non-blank. |
| 194 | (search-backward "\n\n" nil t) | 209 | (search-backward "\n\n" nil t) |
| 195 | (forward-line 2) | 210 | (forward-line 2) |
| 196 | (mh-recenter 0))) | 211 | (mh-recenter 0))) |
| 197 | 212 | ||
| 213 | ;;;###mh-autoload | ||
| 198 | (defun mh-page-digest-backwards () | 214 | (defun mh-page-digest-backwards () |
| 199 | "Back up displayed message to previous digested message." | 215 | "Back up displayed message to previous digested message." |
| 200 | (interactive) | 216 | (interactive) |
| @@ -204,66 +220,68 @@ Otherwise just send the message's body without the headers." | |||
| 204 | (let ((case-fold-search nil)) | 220 | (let ((case-fold-search nil)) |
| 205 | (beginning-of-line) | 221 | (beginning-of-line) |
| 206 | (or (and (search-backward "\n\n" nil t) | 222 | (or (and (search-backward "\n\n" nil t) |
| 207 | (re-search-backward "^From:" nil t)) | 223 | (re-search-backward "^From:" nil t)) |
| 208 | (error "No previous message in digest"))) | 224 | (error "No previous message in digest"))) |
| 209 | ;; Go back to previous blank line, then forward to the first non-blank. | 225 | ;; Go back to previous blank line, then forward to the first non-blank. |
| 210 | (if (search-backward "\n\n" nil t) | 226 | (if (search-backward "\n\n" nil t) |
| 211 | (forward-line 2)) | 227 | (forward-line 2)) |
| 212 | (mh-recenter 0))) | 228 | (mh-recenter 0))) |
| 213 | 229 | ||
| 230 | ;;;###mh-autoload | ||
| 214 | (defun mh-print-msg (msg-or-seq) | 231 | (defun mh-print-msg (msg-or-seq) |
| 215 | "Print MSG-OR-SEQ (default: displayed message) on printer. | 232 | "Print MSG-OR-SEQ (default: displayed message) on printer. |
| 216 | If optional prefix argument provided, then prompt for the message sequence. | 233 | If optional prefix argument provided, then prompt for the message sequence. |
| 217 | The variable `mh-lpr-command-format' is used to generate the print command. | 234 | The variable `mh-lpr-command-format' is used to generate the print command. |
| 218 | The messages are formatted by mhl. See the variable `mhl-formfile'." | 235 | The messages are formatted by mhl. See the variable `mhl-formfile'." |
| 219 | (interactive (list (if current-prefix-arg | 236 | (interactive (list (if current-prefix-arg |
| 220 | (reverse (mh-seq-to-msgs | 237 | (reverse (mh-seq-to-msgs |
| 221 | (mh-read-seq-default "Print" t))) | 238 | (mh-read-seq-default "Print" t))) |
| 222 | (mh-get-msg-num t)))) | 239 | (mh-get-msg-num t)))) |
| 223 | (if (numberp msg-or-seq) | 240 | (if (numberp msg-or-seq) |
| 224 | (message "Printing message...") | 241 | (message "Printing message...") |
| 225 | (message "Printing sequence...")) | 242 | (message "Printing sequence...")) |
| 226 | (let ((print-command | 243 | (let ((print-command |
| 227 | (if (numberp msg-or-seq) | 244 | (if (numberp msg-or-seq) |
| 228 | (format "%s -nobell -clear %s %s | %s" | 245 | (format "%s -nobell -clear %s %s | %s" |
| 229 | (expand-file-name "mhl" mh-lib-progs) | 246 | (expand-file-name "mhl" mh-lib-progs) |
| 230 | (mh-msg-filename msg-or-seq) | 247 | (mh-msg-filename msg-or-seq) |
| 231 | (if (stringp mhl-formfile) | 248 | (if (stringp mhl-formfile) |
| 232 | (format "-form %s" mhl-formfile) | 249 | (format "-form %s" mhl-formfile) |
| 233 | "") | 250 | "") |
| 234 | (format mh-lpr-command-format | 251 | (format mh-lpr-command-format |
| 235 | (if (numberp msg-or-seq) | 252 | (if (numberp msg-or-seq) |
| 236 | (format "%s/%d" mh-current-folder | 253 | (format "%s/%d" mh-current-folder |
| 237 | msg-or-seq) | 254 | msg-or-seq) |
| 238 | (format "Sequence from %s" mh-current-folder)))) | 255 | (format "Sequence from %s" mh-current-folder)))) |
| 239 | (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s" | 256 | (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s" |
| 240 | (mapconcat (function (lambda (msg) msg)) msg-or-seq " ") | 257 | (mapconcat (function (lambda (msg) msg)) msg-or-seq " ") |
| 241 | (expand-file-name "mhl" mh-lib-progs) | 258 | (expand-file-name "mhl" mh-lib-progs) |
| 242 | (if (stringp mhl-formfile) | 259 | (if (stringp mhl-formfile) |
| 243 | (format "-form %s" mhl-formfile) | 260 | (format "-form %s" mhl-formfile) |
| 244 | "") | 261 | "") |
| 245 | (mh-msg-filenames msg-or-seq) | 262 | (mh-msg-filenames msg-or-seq) |
| 246 | (format mh-lpr-command-format | 263 | (format mh-lpr-command-format |
| 247 | (if (numberp msg-or-seq) | 264 | (if (numberp msg-or-seq) |
| 248 | (format "%s/%d" mh-current-folder | 265 | (format "%s/%d" mh-current-folder |
| 249 | msg-or-seq) | 266 | msg-or-seq) |
| 250 | (format "Sequence from %s" | 267 | (format "Sequence from %s" |
| 251 | mh-current-folder))))))) | 268 | mh-current-folder))))))) |
| 252 | (if mh-print-background-flag | 269 | (if mh-print-background-flag |
| 253 | (mh-exec-cmd-daemon shell-file-name "-c" print-command) | 270 | (mh-exec-cmd-daemon shell-file-name "-c" print-command) |
| 254 | (call-process shell-file-name nil nil nil "-c" print-command)) | 271 | (call-process shell-file-name nil nil nil "-c" print-command)) |
| 255 | (if (numberp msg-or-seq) | 272 | (if (numberp msg-or-seq) |
| 256 | (mh-notate msg-or-seq mh-note-printed mh-cmd-note) | 273 | (mh-notate msg-or-seq mh-note-printed mh-cmd-note) |
| 257 | (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note)) | 274 | (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note)) |
| 258 | (mh-add-msgs-to-seq msg-or-seq 'printed t) | 275 | (mh-add-msgs-to-seq msg-or-seq 'printed t) |
| 259 | (if (numberp msg-or-seq) | 276 | (if (numberp msg-or-seq) |
| 260 | (message "Printing message...done") | 277 | (message "Printing message...done") |
| 261 | (message "Printing sequence...done")))) | 278 | (message "Printing sequence...done")))) |
| 262 | 279 | ||
| 263 | (defun mh-msg-filenames (msgs &optional folder) | 280 | (defun mh-msg-filenames (msgs &optional folder) |
| 264 | "Return a list of file names for MSGS in FOLDER (default current folder)." | 281 | "Return a list of file names for MSGS in FOLDER (default current folder)." |
| 265 | (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " ")) | 282 | (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " ")) |
| 266 | 283 | ||
| 284 | ;;;###mh-autoload | ||
| 267 | (defun mh-sort-folder (&optional extra-args) | 285 | (defun mh-sort-folder (&optional extra-args) |
| 268 | "Sort the messages in the current folder by date. | 286 | "Sort the messages in the current folder by date. |
| 269 | Calls the MH program sortm to do the work. | 287 | Calls the MH program sortm to do the work. |
| @@ -272,36 +290,45 @@ argument EXTRA-ARGS is given." | |||
| 272 | (interactive "P") | 290 | (interactive "P") |
| 273 | (mh-process-or-undo-commands mh-current-folder) | 291 | (mh-process-or-undo-commands mh-current-folder) |
| 274 | (setq mh-next-direction 'forward) | 292 | (setq mh-next-direction 'forward) |
| 275 | (mh-set-folder-modified-p t) ; lock folder while sorting | 293 | (mh-set-folder-modified-p t) ; lock folder while sorting |
| 276 | (message "Sorting folder...") | 294 | (message "Sorting folder...") |
| 277 | (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) | 295 | (let ((threaded-flag (memq 'unthread mh-view-ops))) |
| 278 | (message "Sorting folder...done") | 296 | (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) |
| 279 | (mh-scan-folder mh-current-folder "all")) | 297 | (when mh-index-data |
| 280 | 298 | (mh-index-update-maps mh-current-folder)) | |
| 299 | (message "Sorting folder...done") | ||
| 300 | (mh-reset-threads-and-narrowing) | ||
| 301 | (mh-scan-folder mh-current-folder "all") | ||
| 302 | (cond (threaded-flag (mh-toggle-threads)) | ||
| 303 | (mh-index-data (mh-index-insert-folder-headers))))) | ||
| 304 | |||
| 305 | ;;;###mh-autoload | ||
| 281 | (defun mh-undo-folder (&rest ignore) | 306 | (defun mh-undo-folder (&rest ignore) |
| 282 | "Undo all pending deletes and refiles in current folder. | 307 | "Undo all pending deletes and refiles in current folder. |
| 283 | Argument IGNORE is deprecated." | 308 | Argument IGNORE is deprecated." |
| 284 | (interactive) | 309 | (interactive) |
| 285 | (cond ((or mh-do-not-confirm-flag | 310 | (cond ((or mh-do-not-confirm-flag |
| 286 | (yes-or-no-p "Undo all commands in folder? ")) | 311 | (yes-or-no-p "Undo all commands in folder? ")) |
| 287 | (setq mh-delete-list nil | 312 | (setq mh-delete-list nil |
| 288 | mh-refile-list nil | 313 | mh-refile-list nil |
| 289 | mh-seq-list nil | 314 | mh-seq-list nil |
| 290 | mh-next-direction 'forward) | 315 | mh-next-direction 'forward) |
| 291 | (with-mh-folder-updating (nil) | 316 | (with-mh-folder-updating (nil) |
| 292 | (mh-unmark-all-headers t))) | 317 | (mh-unmark-all-headers t))) |
| 293 | (t | 318 | (t |
| 294 | (message "Commands not undone.") | 319 | (message "Commands not undone.") |
| 295 | (sit-for 2)))) | 320 | (sit-for 2)))) |
| 296 | 321 | ||
| 322 | ;;;###mh-autoload | ||
| 297 | (defun mh-store-msg (directory) | 323 | (defun mh-store-msg (directory) |
| 298 | "Store the file(s) contained in the current message into DIRECTORY. | 324 | "Store the file(s) contained in the current message into DIRECTORY. |
| 299 | The message can contain a shar file or uuencoded file. | 325 | The message can contain a shar file or uuencoded file. |
| 300 | Default directory is the last directory used, or initially the value of | 326 | Default directory is the last directory used, or initially the value of |
| 301 | `mh-store-default-directory' or the current directory." | 327 | `mh-store-default-directory' or the current directory." |
| 302 | (interactive (list (let ((udir (or mh-store-default-directory default-directory))) | 328 | (interactive (list (let ((udir (or mh-store-default-directory |
| 303 | (read-file-name "Store message in directory: " | 329 | default-directory))) |
| 304 | udir udir nil)))) | 330 | (read-file-name "Store message in directory: " |
| 331 | udir udir nil)))) | ||
| 305 | (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) | 332 | (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) |
| 306 | (save-excursion | 333 | (save-excursion |
| 307 | (set-buffer (get-buffer-create mh-temp-buffer)) | 334 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| @@ -309,58 +336,59 @@ Default directory is the last directory used, or initially the value of | |||
| 309 | (insert-file-contents msg-file-to-store) | 336 | (insert-file-contents msg-file-to-store) |
| 310 | (mh-store-buffer directory)))) | 337 | (mh-store-buffer directory)))) |
| 311 | 338 | ||
| 339 | ;;;###mh-autoload | ||
| 312 | (defun mh-store-buffer (directory) | 340 | (defun mh-store-buffer (directory) |
| 313 | "Store the file(s) contained in the current buffer into DIRECTORY. | 341 | "Store the file(s) contained in the current buffer into DIRECTORY. |
| 314 | The buffer can contain a shar file or uuencoded file. | 342 | The buffer can contain a shar file or uuencoded file. |
| 315 | Default directory is the last directory used, or initially the value of | 343 | Default directory is the last directory used, or initially the value of |
| 316 | `mh-store-default-directory' or the current directory." | 344 | `mh-store-default-directory' or the current directory." |
| 317 | (interactive (list (let ((udir (or mh-store-default-directory | 345 | (interactive (list (let ((udir (or mh-store-default-directory |
| 318 | default-directory))) | 346 | default-directory))) |
| 319 | (read-file-name "Store buffer in directory: " | 347 | (read-file-name "Store buffer in directory: " |
| 320 | udir udir nil)))) | 348 | udir udir nil)))) |
| 321 | (let ((store-directory (expand-file-name directory)) | 349 | (let ((store-directory (expand-file-name directory)) |
| 322 | (sh-start (save-excursion | 350 | (sh-start (save-excursion |
| 323 | (goto-char (point-min)) | 351 | (goto-char (point-min)) |
| 324 | (if (re-search-forward | 352 | (if (re-search-forward |
| 325 | "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) | 353 | "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) |
| 326 | (progn | 354 | (progn |
| 327 | ;; The "cut here" pattern was removed from above | 355 | ;; The "cut here" pattern was removed from above |
| 328 | ;; because it seemed to hurt more than help. | 356 | ;; because it seemed to hurt more than help. |
| 329 | ;; But keep this to make it easier to put it back. | 357 | ;; But keep this to make it easier to put it back. |
| 330 | (if (looking-at "^[^a-z0-9\"]*cut here\\b") | 358 | (if (looking-at "^[^a-z0-9\"]*cut here\\b") |
| 331 | (forward-line 1)) | 359 | (forward-line 1)) |
| 332 | (beginning-of-line) | 360 | (beginning-of-line) |
| 333 | (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") | 361 | (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") |
| 334 | nil ;most likely end of a uuencode | 362 | nil ;most likely end of a uuencode |
| 335 | (point)))))) | 363 | (point)))))) |
| 336 | (log-buffer (get-buffer-create "*Store Output*")) | 364 | (log-buffer (get-buffer-create "*Store Output*")) |
| 337 | (command "sh") | 365 | (command "sh") |
| 338 | (uudecode-filename "(unknown filename)")) | 366 | (uudecode-filename "(unknown filename)")) |
| 339 | (if (not sh-start) | 367 | (if (not sh-start) |
| 340 | (save-excursion | 368 | (save-excursion |
| 341 | (goto-char (point-min)) | 369 | (goto-char (point-min)) |
| 342 | (if (re-search-forward "^begin [0-7]+ " nil t) | 370 | (if (re-search-forward "^begin [0-7]+ " nil t) |
| 343 | (setq uudecode-filename | 371 | (setq uudecode-filename |
| 344 | (buffer-substring (point) | 372 | (buffer-substring (point) |
| 345 | (progn (end-of-line) (point))))))) | 373 | (progn (end-of-line) (point))))))) |
| 346 | (save-excursion | 374 | (save-excursion |
| 347 | (set-buffer log-buffer) | 375 | (set-buffer log-buffer) |
| 348 | (erase-buffer) | 376 | (erase-buffer) |
| 349 | (if (not (file-directory-p store-directory)) | 377 | (if (not (file-directory-p store-directory)) |
| 350 | (progn | 378 | (progn |
| 351 | (insert "mkdir " directory "\n") | 379 | (insert "mkdir " directory "\n") |
| 352 | (call-process "mkdir" nil log-buffer t store-directory))) | 380 | (call-process "mkdir" nil log-buffer t store-directory))) |
| 353 | (insert "cd " directory "\n") | 381 | (insert "cd " directory "\n") |
| 354 | (setq mh-store-default-directory directory) | 382 | (setq mh-store-default-directory directory) |
| 355 | (if (not sh-start) | 383 | (if (not sh-start) |
| 356 | (progn | 384 | (progn |
| 357 | (setq command "uudecode") | 385 | (setq command "uudecode") |
| 358 | (insert uudecode-filename " being uudecoded...\n")))) | 386 | (insert uudecode-filename " being uudecoded...\n")))) |
| 359 | (set-window-start (display-buffer log-buffer) 0) ;watch progress | 387 | (set-window-start (display-buffer log-buffer) 0) ;watch progress |
| 360 | (let (value) | 388 | (let (value) |
| 361 | (let ((default-directory (file-name-as-directory store-directory))) | 389 | (let ((default-directory (file-name-as-directory store-directory))) |
| 362 | (setq value (call-process-region sh-start (point-max) command | 390 | (setq value (call-process-region sh-start (point-max) command |
| 363 | nil log-buffer t))) | 391 | nil log-buffer t))) |
| 364 | (set-buffer log-buffer) | 392 | (set-buffer log-buffer) |
| 365 | (mh-handle-process-error command value)) | 393 | (mh-handle-process-error command value)) |
| 366 | (insert "\n(mh-store finished)\n"))) | 394 | (insert "\n(mh-store finished)\n"))) |
| @@ -375,13 +403,15 @@ Default directory is the last directory used, or initially the value of | |||
| 375 | (sit-for 5) | 403 | (sit-for 5) |
| 376 | (message "")) | 404 | (message "")) |
| 377 | 405 | ||
| 406 | ;;;###mh-autoload | ||
| 378 | (defun mh-help () | 407 | (defun mh-help () |
| 379 | "Display cheat sheet for the MH-Folder commands in minibuffer." | 408 | "Display cheat sheet for the MH-Folder commands in minibuffer." |
| 380 | (interactive) | 409 | (interactive) |
| 381 | (mh-ephem-message | 410 | (mh-ephem-message |
| 382 | (substitute-command-keys | 411 | (substitute-command-keys |
| 383 | (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) | 412 | (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) |
| 384 | 413 | ||
| 414 | ;;;###mh-autoload | ||
| 385 | (defun mh-prefix-help () | 415 | (defun mh-prefix-help () |
| 386 | "Display cheat sheet for the commands of the current prefix in minibuffer." | 416 | "Display cheat sheet for the commands of the current prefix in minibuffer." |
| 387 | (interactive) | 417 | (interactive) |
| @@ -391,7 +421,7 @@ Default directory is the last directory used, or initially the value of | |||
| 391 | ;; length-2. We use that information to obtain a suitable prefix character | 421 | ;; length-2. We use that information to obtain a suitable prefix character |
| 392 | ;; from the recent keys. | 422 | ;; from the recent keys. |
| 393 | (let* ((keys (recent-keys)) | 423 | (let* ((keys (recent-keys)) |
| 394 | (prefix-char (elt keys (- (length keys) 2)))) | 424 | (prefix-char (elt keys (- (length keys) 2)))) |
| 395 | (mh-ephem-message | 425 | (mh-ephem-message |
| 396 | (substitute-command-keys | 426 | (substitute-command-keys |
| 397 | (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) ""))))) | 427 | (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) ""))))) |
| @@ -399,6 +429,7 @@ Default directory is the last directory used, or initially the value of | |||
| 399 | (provide 'mh-funcs) | 429 | (provide 'mh-funcs) |
| 400 | 430 | ||
| 401 | ;;; Local Variables: | 431 | ;;; Local Variables: |
| 432 | ;;; indent-tabs-mode: nil | ||
| 402 | ;;; sentence-end-double-space: nil | 433 | ;;; sentence-end-double-space: nil |
| 403 | ;;; End: | 434 | ;;; End: |
| 404 | 435 | ||
diff --git a/lisp/mail/mh-identity.el b/lisp/mail/mh-identity.el new file mode 100644 index 00000000000..1347225a2ed --- /dev/null +++ b/lisp/mail/mh-identity.el | |||
| @@ -0,0 +1,219 @@ | |||
| 1 | ;;; mh-identity.el --- Multiple Identify support for MH-E. | ||
| 2 | |||
| 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Peter S. Galbraith <psg@debian.org> | ||
| 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> | ||
| 7 | ;; Keywords: mail | ||
| 8 | ;; See: mh-e.el | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 15 | ;; any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 25 | ;; Boston, MA 02111-1307, USA. | ||
| 26 | |||
| 27 | ;;; Commentary: | ||
| 28 | |||
| 29 | ;; Multiple identity support for MH-E. | ||
| 30 | ;; | ||
| 31 | ;; Used to easily set different fields such as From and Organization, as | ||
| 32 | ;; well as different signature files. | ||
| 33 | ;; | ||
| 34 | ;; Customize the variable `mh-identity-list' and an Identity menu will | ||
| 35 | ;; appear in mh-letter-mode. The command 'mh-insert-identity can be used | ||
| 36 | ;; from the command line. | ||
| 37 | |||
| 38 | ;;; Change Log: | ||
| 39 | |||
| 40 | ;; $Id: mh-identity.el,v 1.17 2002/12/03 15:54:27 psg Exp $ | ||
| 41 | |||
| 42 | ;;; Code: | ||
| 43 | |||
| 44 | |||
| 45 | (require 'cl) | ||
| 46 | |||
| 47 | (eval-when (compile load eval) | ||
| 48 | (defvar mh-comp-loaded nil) | ||
| 49 | (unless mh-comp-loaded | ||
| 50 | (setq mh-comp-loaded t) | ||
| 51 | (require 'mh-comp))) ;Since we do this on sending | ||
| 52 | |||
| 53 | (autoload 'mml-insert-tag "mml") | ||
| 54 | |||
| 55 | ;;;###mh-autoload | ||
| 56 | (defun mh-identity-make-menu () | ||
| 57 | "Build (or rebuild) the Identity menu (e.g. after the list is modified)." | ||
| 58 | (when (and mh-identity-list (boundp 'mh-letter-mode-map)) | ||
| 59 | (easy-menu-define mh-identity-menu mh-letter-mode-map | ||
| 60 | "mh-e identity menu" | ||
| 61 | (append | ||
| 62 | '("Identity") | ||
| 63 | ;; Dynamically render :type corresponding to `mh-identity-list' | ||
| 64 | ;; e.g.: | ||
| 65 | ;; ["home" (mh-insert-identity "home") | ||
| 66 | ;; :style radio :active (not (equal mh-identity-local "home")) | ||
| 67 | ;; :selected (equal mh-identity-local "home")] | ||
| 68 | (mapcar (function | ||
| 69 | (lambda (arg) | ||
| 70 | `[,arg (mh-insert-identity ,arg) :style radio | ||
| 71 | :active (not (equal mh-identity-local ,arg)) | ||
| 72 | :selected (equal mh-identity-local ,arg)])) | ||
| 73 | (mapcar 'car mh-identity-list)) | ||
| 74 | '("--" | ||
| 75 | ["none" (mh-insert-identity "none") mh-identity-local] | ||
| 76 | ["Set Default for Session" | ||
| 77 | (setq mh-identity-default mh-identity-local) t] | ||
| 78 | ["Save as Default" | ||
| 79 | (customize-save-variable | ||
| 80 | 'mh-identity-default mh-identity-local) t] | ||
| 81 | ))))) | ||
| 82 | |||
| 83 | ;;;###mh-autoload | ||
| 84 | (defun mh-identity-list-set (symbol value) | ||
| 85 | "Update the `mh-identity-list' variable, and rebuild the menu. | ||
| 86 | Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in | ||
| 87 | customization). This is called after 'customize is used to alter | ||
| 88 | `mh-identity-list'." | ||
| 89 | (set-default symbol value) | ||
| 90 | (mh-identity-make-menu)) | ||
| 91 | |||
| 92 | (defvar mh-identity-local nil | ||
| 93 | "Buffer-local variable holding the identity currently in use.") | ||
| 94 | (make-variable-buffer-local 'mh-identity-local) | ||
| 95 | |||
| 96 | (defun mh-header-field-delete (field value-only) | ||
| 97 | "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t. | ||
| 98 | Return t if anything is deleted." | ||
| 99 | (when (mh-goto-header-field field) | ||
| 100 | (if (not value-only) | ||
| 101 | (beginning-of-line) | ||
| 102 | (forward-char)) | ||
| 103 | (delete-region (point) | ||
| 104 | (progn (mh-header-field-end) | ||
| 105 | (if (not value-only) (forward-char 1)) | ||
| 106 | (point))) | ||
| 107 | t)) | ||
| 108 | |||
| 109 | (defvar mh-identity-signature-start nil | ||
| 110 | "Marker for the beginning of a signature inserted by `mh-insert-identity'.") | ||
| 111 | (defvar mh-identity-signature-end nil | ||
| 112 | "Marker for the end of a signature inserted by `mh-insert-identity'.") | ||
| 113 | |||
| 114 | ;;;###mh-autoload | ||
| 115 | (defun mh-insert-identity (identity) | ||
| 116 | "Insert proper fields for given IDENTITY. | ||
| 117 | Edit the `mh-identity-list' variable to define identity." | ||
| 118 | (interactive | ||
| 119 | (list (completing-read | ||
| 120 | "Identity: " | ||
| 121 | (if mh-identity-local | ||
| 122 | (cons '("none") | ||
| 123 | (mapcar 'list (mapcar 'car mh-identity-list))) | ||
| 124 | (mapcar 'list (mapcar 'car mh-identity-list))) | ||
| 125 | nil t))) | ||
| 126 | (save-excursion | ||
| 127 | ;;First remove old settings, if any. | ||
| 128 | (when mh-identity-local | ||
| 129 | (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) | ||
| 130 | (while pers-list | ||
| 131 | (let ((field (concat (caar pers-list) ":"))) | ||
| 132 | (cond | ||
| 133 | ((string-equal "signature:" field) | ||
| 134 | (when (and (boundp 'mh-identity-signature-start) | ||
| 135 | (markerp mh-identity-signature-start)) | ||
| 136 | (goto-char mh-identity-signature-start) | ||
| 137 | (forward-char -1) | ||
| 138 | (delete-region (point) mh-identity-signature-end))) | ||
| 139 | ((mh-header-field-delete field nil)))) | ||
| 140 | (setq pers-list (cdr pers-list))))) | ||
| 141 | ;; Then insert the replacement | ||
| 142 | (when (not (equal "none" identity)) | ||
| 143 | (let ((pers-list (cadr (assoc identity mh-identity-list)))) | ||
| 144 | (while pers-list | ||
| 145 | (let ((field (concat (caar pers-list) ":")) | ||
| 146 | (value (cdar pers-list))) | ||
| 147 | (cond | ||
| 148 | ;; No value, remove field | ||
| 149 | ((or (not value) | ||
| 150 | (string= value "")) | ||
| 151 | (mh-header-field-delete field nil)) | ||
| 152 | ;; Existing field, replace | ||
| 153 | ((mh-header-field-delete field t) | ||
| 154 | (insert value)) | ||
| 155 | ;; Handle "signature" special case. Insert file or call function. | ||
| 156 | ((and (string-equal "signature:" field) | ||
| 157 | (or (and (stringp value) | ||
| 158 | (file-readable-p value)) | ||
| 159 | (fboundp value))) | ||
| 160 | (goto-char (point-max)) | ||
| 161 | (if (not (looking-at "^$")) | ||
| 162 | (insert "\n")) | ||
| 163 | (insert "\n") | ||
| 164 | (save-restriction | ||
| 165 | (narrow-to-region (point) (point)) | ||
| 166 | (set (make-local-variable 'mh-identity-signature-start) | ||
| 167 | (make-marker)) | ||
| 168 | (set-marker mh-identity-signature-start (point)) | ||
| 169 | (cond | ||
| 170 | ;; If MIME composition done, insert signature at the end as | ||
| 171 | ;; an inline MIME part. | ||
| 172 | ((and (boundp 'mh-mhn-compose-insert-flag) | ||
| 173 | mh-mhn-compose-insert-flag) | ||
| 174 | (insert "#\n" "Content-Description: Signature\n")) | ||
| 175 | ((and (boundp 'mh-mml-compose-insert-flag) | ||
| 176 | mh-mml-compose-insert-flag) | ||
| 177 | (mml-insert-tag 'part 'type "text/plain" | ||
| 178 | 'disposition "inline" | ||
| 179 | 'description "Signature"))) | ||
| 180 | (if (stringp value) | ||
| 181 | (insert-file-contents value) | ||
| 182 | (funcall value)) | ||
| 183 | (goto-char (point-min)) | ||
| 184 | (when (not (re-search-forward "^--" nil t)) | ||
| 185 | (if (and (boundp 'mh-mhn-compose-insert-flag) | ||
| 186 | mh-mhn-compose-insert-flag) | ||
| 187 | (forward-line 2)) | ||
| 188 | (if (and (boundp 'mh-mml-compose-insert-flag) | ||
| 189 | mh-mml-compose-insert-flag) | ||
| 190 | (forward-line 1)) | ||
| 191 | (insert "-- \n")) | ||
| 192 | (set (make-local-variable 'mh-identity-signature-end) | ||
| 193 | (make-marker)) | ||
| 194 | (set-marker mh-identity-signature-end (point-max)))) | ||
| 195 | ;; Handle "From" field differently, adding it at the beginning. | ||
| 196 | ((string-equal "From:" field) | ||
| 197 | (goto-char (point-min)) | ||
| 198 | (insert "From: " value "\n")) | ||
| 199 | ;; Skip empty signature (Can't remove what we don't know) | ||
| 200 | ((string-equal "signature:" field)) | ||
| 201 | ;; Other field, add at end | ||
| 202 | (t ;Otherwise, add the end. | ||
| 203 | (goto-char (point-min)) | ||
| 204 | (mh-goto-header-end 0) | ||
| 205 | (mh-insert-fields field value)))) | ||
| 206 | (setq pers-list (cdr pers-list)))))) | ||
| 207 | ;; Remember what is in use in this buffer | ||
| 208 | (if (equal "none" identity) | ||
| 209 | (setq mh-identity-local nil) | ||
| 210 | (setq mh-identity-local identity))) | ||
| 211 | |||
| 212 | (provide 'mh-identity) | ||
| 213 | |||
| 214 | ;;; Local Variables: | ||
| 215 | ;;; indent-tabs-mode: nil | ||
| 216 | ;;; sentence-end-double-space: nil | ||
| 217 | ;;; End: | ||
| 218 | |||
| 219 | ;;; mh-identity.el ends here | ||
diff --git a/lisp/mail/mh-index.el b/lisp/mail/mh-index.el index cf4b97f31e8..a04a11b651f 100644 --- a/lisp/mail/mh-index.el +++ b/lisp/mail/mh-index.el | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Bill Wohler <wohler@newt.com> | 5 | ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
| 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> | 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> |
| 7 | ;; Keywords: mail | 7 | ;; Keywords: mail |
| 8 | ;; See: mh-e.el | 8 | ;; See: mh-e.el |
| @@ -37,14 +37,10 @@ | |||
| 37 | ;;; the documentation for `mh-index-search' to get started. That | 37 | ;;; the documentation for `mh-index-search' to get started. That |
| 38 | ;;; documentation will direct you to the specific instructions for your | 38 | ;;; documentation will direct you to the specific instructions for your |
| 39 | ;;; particular indexer. | 39 | ;;; particular indexer. |
| 40 | ;;; | ||
| 41 | ;;; (3) Right now only viewing messages and moving between messages works in | ||
| 42 | ;;; the index buffer. With a little bit of work more stuff like | ||
| 43 | ;;; replying or forwarding messages can be done. | ||
| 44 | 40 | ||
| 45 | ;;; Change Log: | 41 | ;;; Change Log: |
| 46 | 42 | ||
| 47 | ;; $Id: mh-index.el,v 1.51 2002/11/13 18:43:57 satyaki Exp $ | 43 | ;; $Id: mh-index.el,v 1.73 2003/01/07 21:15:49 satyaki Exp $ |
| 48 | 44 | ||
| 49 | ;;; Code: | 45 | ;;; Code: |
| 50 | 46 | ||
| @@ -52,34 +48,11 @@ | |||
| 52 | (require 'mh-e) | 48 | (require 'mh-e) |
| 53 | (require 'mh-mime) | 49 | (require 'mh-mime) |
| 54 | 50 | ||
| 55 | ;; Shush the byte-compiler | ||
| 56 | (defvar font-lock-defaults) | ||
| 57 | |||
| 58 | (autoload 'gnus-local-map-property "gnus-util") | 51 | (autoload 'gnus-local-map-property "gnus-util") |
| 59 | (autoload 'gnus-eval-format "gnus-spec") | 52 | (autoload 'gnus-eval-format "gnus-spec") |
| 60 | (autoload 'widget-convert-button "wid-edit") | 53 | (autoload 'widget-convert-button "wid-edit") |
| 61 | (autoload 'executable-find "executable") | 54 | (autoload 'executable-find "executable") |
| 62 | 55 | ||
| 63 | ;;; User customizable | ||
| 64 | (defcustom mh-index-program nil | ||
| 65 | "Indexing program that MH-E shall use. | ||
| 66 | The possible choices are swish++, swish-e, namazu, glimpse and grep. By | ||
| 67 | default this variable is nil which means that the programs are tried in order | ||
| 68 | and the first one found is used." | ||
| 69 | :group 'mh | ||
| 70 | :type '(choice (const :tag "auto-detect" nil) | ||
| 71 | (const :tag "swish++" swish++) | ||
| 72 | (const :tag "swish-e" swish) | ||
| 73 | (const :tag "namazu" namazu) | ||
| 74 | (const :tag "glimpse" glimpse) | ||
| 75 | (const :tag "grep" grep))) | ||
| 76 | |||
| 77 | ;;; Hooks | ||
| 78 | (defcustom mh-index-show-hook nil | ||
| 79 | "Invoked after the message has been displayed." | ||
| 80 | :type 'hook | ||
| 81 | :group 'mh-hook) | ||
| 82 | |||
| 83 | ;; Support different indexing programs | 56 | ;; Support different indexing programs |
| 84 | (defvar mh-indexer-choices | 57 | (defvar mh-indexer-choices |
| 85 | '((swish++ | 58 | '((swish++ |
| @@ -100,118 +73,211 @@ and the first one found is used." | |||
| 100 | (defvar mh-index-next-result-function nil | 73 | (defvar mh-index-next-result-function nil |
| 101 | "Function to parse the next line of output.") | 74 | "Function to parse the next line of output.") |
| 102 | 75 | ||
| 103 | ;; Names for the default mh-index-buffers... | 76 | ;; FIXME: This should be a defcustom... |
| 104 | (defvar mh-index-buffer "*mh-index*") | 77 | (defvar mh-index-folder "+mhe-index" |
| 105 | (defvar mh-index-show-buffer "*mh-index-show*") | 78 | "Folder that contains the folders resulting from the index searches.") |
| 106 | 79 | ||
| 107 | ;; For use with adaptive size setting... | 80 | ;; Temporary buffers for search results |
| 108 | (defvar mh-index-max-msg-index 0) | ||
| 109 | |||
| 110 | ;; Buffer locals to allow multiple concurrent search folders. | ||
| 111 | (defvar mh-index-other-buffer nil | ||
| 112 | "Keeps track of other buffer associated with current buffer. | ||
| 113 | The value is the show buffer or the folder-buffer depending on whether we are | ||
| 114 | in a folder buffer or show buffer respectively.") | ||
| 115 | (defvar mh-index-matches nil | ||
| 116 | "Map of folder to messages which match.") | ||
| 117 | (defvar mh-index-previous-window-configuration nil | ||
| 118 | "Keep track of previous window configuration that is restored on exit.") | ||
| 119 | (defvar mh-index-current-msg nil | ||
| 120 | "Message index of message being shown.") | ||
| 121 | |||
| 122 | ;; Make variables buffer local ... | ||
| 123 | (make-variable-buffer-local 'mh-index-other-buffer) | ||
| 124 | (make-variable-buffer-local 'mh-index-matches) | ||
| 125 | (make-variable-buffer-local 'mh-index-previous-window-configuration) | ||
| 126 | (make-variable-buffer-local 'mh-current-folder) | ||
| 127 | (make-variable-buffer-local 'mh-index-current-msg) | ||
| 128 | |||
| 129 | ;; ... and arrange for them to not get slaughtered by a call to text-mode | ||
| 130 | ;; (text-mode is called by mh-show-mode and mh-folder-mode). | ||
| 131 | (put 'mh-index-other-buffer 'permanent-local t) | ||
| 132 | (put 'mh-index-matches 'permanent-local t) | ||
| 133 | (put 'mh-index-previous-window-configuration 'permanent-local t) | ||
| 134 | (put 'mh-index-current-msg 'permanent-local t) | ||
| 135 | (put 'mh-current-folder 'permanent-local t) | ||
| 136 | (put 'mh-cmd-note 'permanent-local t) | ||
| 137 | |||
| 138 | ;; Temporary buffer where search results are output. | ||
| 139 | (defvar mh-index-temp-buffer " *mh-index-temp*") | 81 | (defvar mh-index-temp-buffer " *mh-index-temp*") |
| 82 | (defvar mh-checksum-buffer " *mh-checksum-buffer*") | ||
| 83 | |||
| 84 | |||
| 140 | 85 | ||
| 141 | ;; Keymaps | 86 | ;;; A few different checksum programs are supported. The supported programs |
| 142 | 87 | ;;; are: | |
| 143 | ;; N.B. If this map were named mh-index-folder-mode-map, it would inherit the | 88 | ;;; 1. md5sum |
| 144 | ;; keymap from mh-folder-mode. Since we want our own keymap, we tweak the name | 89 | ;;; 2. md5 |
| 145 | ;; to avoid this unwanted inheritance. | 90 | ;;; 3. openssl |
| 146 | (defvar mh-index-folder-mode-keymap (make-sparse-keymap) | 91 | ;;; |
| 147 | "Keymap for MH index folder.") | 92 | ;;; To add support for your favorite checksum program add a clause to the cond |
| 148 | (suppress-keymap mh-index-folder-mode-keymap) | 93 | ;;; statement in mh-checksum-choose. This should set the variable |
| 149 | (gnus-define-keys mh-index-folder-mode-keymap | 94 | ;;; mh-checksum-cmd to the command line needed to run the checsum program and |
| 150 | " " mh-index-page-msg | 95 | ;;; should set mh-checksum-parser to a function which returns a cons cell |
| 151 | "," mh-index-header-display | 96 | ;;; containing the message number and checksum string. |
| 152 | "." mh-index-show | 97 | |
| 153 | [mouse-2] mh-index-show | 98 | (defvar mh-checksum-cmd) |
| 154 | "?" mh-help | 99 | (defvar mh-checksum-parser) |
| 155 | "\177" mh-index-previous-page | 100 | |
| 156 | "\M-\t" mh-index-prev-button | 101 | (defun mh-checksum-choose () |
| 157 | [backtab] mh-index-prev-button | 102 | "Check if a program to create a checksum is present." |
| 158 | "\r" mh-index-show | 103 | (unless (boundp 'mh-checksum-cmd) |
| 159 | "\t" mh-index-next-button | 104 | (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path))) |
| 160 | "i" mh-inc-folder | 105 | (cond ((executable-find "md5sum") |
| 161 | "m" mh-send ;alias | 106 | (setq mh-checksum-cmd (list (executable-find "md5sum"))) |
| 162 | "n" mh-index-next | 107 | (setq mh-checksum-parser #'mh-md5sum-parser)) |
| 163 | "p" mh-index-prev | 108 | ((executable-find "openssl") |
| 164 | "q" mh-index-quit | 109 | (setq mh-checksum-cmd (list (executable-find "openssl") "md5")) |
| 165 | "s" mh-send) | 110 | (setq mh-checksum-parser #'mh-openssl-parser)) |
| 166 | 111 | ((executable-find "md5") | |
| 167 | (gnus-define-keys (mh-index-folder-map "F" mh-index-folder-mode-keymap) | 112 | (setq mh-checksum-cmd (list (executable-find "md5"))) |
| 168 | "?" mh-prefix-help | 113 | (setq mh-checksum-parser #'mh-md5-parser)) |
| 169 | "f" mh-visit-folder ;alias | 114 | (t (error "No suitable checksum program")))))) |
| 170 | "i" mh-index-search-again | 115 | |
| 171 | "o" mh-visit-folder ;alias | 116 | (defun mh-md5sum-parser () |
| 172 | "v" mh-visit-folder) | 117 | "Parse md5sum output." |
| 173 | 118 | (let ((begin (line-beginning-position)) | |
| 174 | (defvar mh-index-button-map (make-sparse-keymap)) | 119 | (end (line-end-position)) |
| 175 | (gnus-define-keys mh-index-button-map | 120 | first-space last-slash) |
| 176 | "\r" mh-index-press-button) | 121 | (setq first-space (search-forward " " end t)) |
| 122 | (goto-char end) | ||
| 123 | (setq last-slash (search-backward "/" begin t)) | ||
| 124 | (cond ((and first-space last-slash) | ||
| 125 | (cons (car (read-from-string (buffer-substring-no-properties | ||
| 126 | (1+ last-slash) end))) | ||
| 127 | (buffer-substring-no-properties begin (1- first-space)))) | ||
| 128 | (t (cons nil nil))))) | ||
| 129 | |||
| 130 | (defun mh-openssl-parser () | ||
| 131 | "Parse openssl output." | ||
| 132 | (let ((begin (line-beginning-position)) | ||
| 133 | (end (line-end-position)) | ||
| 134 | last-space last-slash) | ||
| 135 | (goto-char end) | ||
| 136 | (setq last-space (search-backward " " begin t)) | ||
| 137 | (setq last-slash (search-backward "/" begin t)) | ||
| 138 | (cond ((and last-slash last-space) | ||
| 139 | (cons (car (read-from-string (buffer-substring-no-properties | ||
| 140 | (1+ last-slash) (1- last-space)))) | ||
| 141 | (buffer-substring-no-properties (1+ last-space) end)))))) | ||
| 142 | |||
| 143 | (defalias 'mh-md5-parser 'mh-openssl-parser) | ||
| 177 | 144 | ||
| 178 | 145 | ||
| 179 | 146 | ||
| 180 | ;;; Help Messages | 147 | ;;; Make sure that we don't produce too long a command line. |
| 181 | 148 | ||
| 182 | ;;; If you add a new prefix, add appropriate text to the nil key. | 149 | (defvar mh-index-max-cmdline-args 500 |
| 183 | ;;; | 150 | "Maximum number of command line args.") |
| 184 | ;;; In general, messages are grouped logically. Taking the main commands for | 151 | |
| 185 | ;;; example, the first line is "ways to view messages," the second line is | 152 | (defun mh-index-execute (cmd &rest args) |
| 186 | ;;; "things you can do with messages", and the third is "composing" messages. | 153 | "Partial imitation of xargs. |
| 187 | ;;; | 154 | The current buffer contains a list of strings, one on each line. The function |
| 188 | ;;; When adding a new prefix, ensure that the help message contains "what" the | 155 | will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args' |
| 189 | ;;; prefix is for. For example, if the word "folder" were not present in the | 156 | strings to it. This is repeated till all the strings have been used." |
| 190 | ;;; `F' entry, it would not be clear what these commands operated upon. | 157 | (goto-char (point-min)) |
| 191 | (defvar mh-index-folder-mode-help-messages | 158 | (let ((out (get-buffer-create " *mh-xargs-output*"))) |
| 192 | '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" | 159 | (save-excursion |
| 193 | "[s]end, [q]uit") | 160 | (set-buffer out) |
| 194 | (?F "[v]isit folder; [i]ndexed search")) | 161 | (erase-buffer)) |
| 195 | "Key binding cheat sheet. | 162 | (while (not (eobp)) |
| 196 | 163 | (let ((arg-list (reverse args)) | |
| 197 | This is an associative array which is used to show the most common commands. | 164 | (count 0)) |
| 198 | The key is a prefix char. The value is one or more strings which are | 165 | (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) |
| 199 | concatenated together and displayed in the minibuffer if ? is pressed after | 166 | (push (buffer-substring-no-properties (point) (line-end-position)) |
| 200 | the prefix character. The special key nil is used to display the | 167 | arg-list) |
| 201 | non-prefixed commands. | 168 | (incf count) |
| 202 | 169 | (forward-line)) | |
| 203 | The substitutions described in `substitute-command-keys' are performed as | 170 | (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list)))) |
| 204 | well.") | 171 | (erase-buffer) |
| 172 | (insert-buffer-substring out))) | ||
| 205 | 173 | ||
| 206 | 174 | ||
| 207 | 175 | ||
| 208 | (defun mh-index-search (folder search-regexp &optional new-buffer-flag) | 176 | (defun mh-index-update-single-msg (msg checksum origin-map) |
| 177 | "Update various maps for one message. | ||
| 178 | MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if | ||
| 179 | non-nil, a hashtable containing which maps each message in the index folder to | ||
| 180 | the folder and message that it was copied from. The function updates the hash | ||
| 181 | tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'. | ||
| 182 | |||
| 183 | This function should only be called in the appropriate index folder buffer." | ||
| 184 | (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map)) | ||
| 185 | (let* ((intermediate (gethash msg origin-map)) | ||
| 186 | (ofolder (car intermediate)) | ||
| 187 | (omsg (cdr intermediate))) | ||
| 188 | ;; This is most probably a duplicate. So eliminate it. | ||
| 189 | (call-process "rm" nil nil nil | ||
| 190 | (format "%s%s/%s" mh-user-path | ||
| 191 | (substring mh-current-folder 1) msg)) | ||
| 192 | (remhash omsg (gethash ofolder mh-index-data)))) | ||
| 193 | (t | ||
| 194 | (setf (gethash msg mh-index-msg-checksum-map) checksum) | ||
| 195 | (when origin-map | ||
| 196 | (setf (gethash checksum mh-index-checksum-origin-map) | ||
| 197 | (gethash msg origin-map)))))) | ||
| 198 | |||
| 199 | ;;;###mh-autoload | ||
| 200 | (defun mh-index-update-maps (folder &optional origin-map) | ||
| 201 | "Annotate all as yet unannotated messages in FOLDER with their MD5 hash. | ||
| 202 | As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP | ||
| 203 | is a hashtable which maps each message in the index folder to the original | ||
| 204 | folder and message from whence it was copied. If present the | ||
| 205 | checksum -> (origin-folder, origin-index) map is updated too." | ||
| 206 | (clrhash mh-index-msg-checksum-map) | ||
| 207 | (save-excursion | ||
| 208 | ;; Clear temp buffer | ||
| 209 | (set-buffer (get-buffer-create mh-checksum-buffer)) | ||
| 210 | (erase-buffer) | ||
| 211 | ;; Run scan to check if any messages needs MD5 annotations at all | ||
| 212 | (with-temp-buffer | ||
| 213 | (mh-exec-cmd-output mh-scan-prog nil "-width" "80" | ||
| 214 | "-format" "%(msg)\n%{x-mhe-checksum}\n" | ||
| 215 | folder "all") | ||
| 216 | (goto-char (point-min)) | ||
| 217 | (let (msg checksum) | ||
| 218 | (while (not (eobp)) | ||
| 219 | (setq msg (buffer-substring-no-properties | ||
| 220 | (point) (line-end-position))) | ||
| 221 | (forward-line) | ||
| 222 | (save-excursion | ||
| 223 | (cond ((eolp) | ||
| 224 | ;; need to compute checksum | ||
| 225 | (set-buffer mh-checksum-buffer) | ||
| 226 | (insert mh-user-path (substring folder 1) "/" msg "\n")) | ||
| 227 | (t | ||
| 228 | ;; update maps | ||
| 229 | (setq checksum (buffer-substring-no-properties | ||
| 230 | (point) (line-end-position))) | ||
| 231 | (let ((msg (car (read-from-string msg)))) | ||
| 232 | (set-buffer folder) | ||
| 233 | (mh-index-update-single-msg msg checksum origin-map))))) | ||
| 234 | (forward-line)))) | ||
| 235 | ;; Run checksum program if needed | ||
| 236 | (unless (and (eobp) (bobp)) | ||
| 237 | (apply #'mh-index-execute mh-checksum-cmd) | ||
| 238 | (goto-char (point-min)) | ||
| 239 | (while (not (eobp)) | ||
| 240 | (let* ((intermediate (funcall mh-checksum-parser)) | ||
| 241 | (msg (car intermediate)) | ||
| 242 | (checksum (cdr intermediate))) | ||
| 243 | (when msg | ||
| 244 | ;; annotate | ||
| 245 | (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum" | ||
| 246 | "-nodate" "-text" checksum "-inplace") | ||
| 247 | ;; update maps | ||
| 248 | (save-excursion | ||
| 249 | (set-buffer folder) | ||
| 250 | (mh-index-update-single-msg msg checksum origin-map))) | ||
| 251 | (forward-line)))))) | ||
| 252 | |||
| 253 | (defun mh-index-generate-pretty-name (string) | ||
| 254 | "Given STRING generate a name which is suitable for use as a folder name. | ||
| 255 | White space from the beginning and end are removed. All spaces in the name are | ||
| 256 | replaced with underscores and all / are replaced with $. If STRING is longer | ||
| 257 | than 20 it is truncated too." | ||
| 258 | (with-temp-buffer | ||
| 259 | (insert string) | ||
| 260 | (goto-char (point-min)) | ||
| 261 | (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r))) | ||
| 262 | (delete-char 1)) | ||
| 263 | (goto-char (point-max)) | ||
| 264 | (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r))) | ||
| 265 | (delete-backward-char 1)) | ||
| 266 | (subst-char-in-region (point-min) (point-max) ? ?_ t) | ||
| 267 | (subst-char-in-region (point-min) (point-max) ?\t ?_ t) | ||
| 268 | (subst-char-in-region (point-min) (point-max) ?\n ?_ t) | ||
| 269 | (subst-char-in-region (point-min) (point-max) ?\r ?_ t) | ||
| 270 | (subst-char-in-region (point-min) (point-max) ?/ ?$ t) | ||
| 271 | (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20))) | ||
| 272 | |||
| 273 | ;;;###mh-autoload | ||
| 274 | (defun mh-index-search (redo-search-flag folder search-regexp) | ||
| 209 | "Perform an indexed search in an MH mail folder. | 275 | "Perform an indexed search in an MH mail folder. |
| 210 | 276 | ||
| 211 | FOLDER is searched with SEARCH-REGEXP and the results are presented in an MH-E | 277 | If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a |
| 212 | folder. If FOLDER is \"+\" then mail in all folders are searched. Optional | 278 | index search, then the search is repeated. Otherwise, FOLDER is searched with |
| 213 | prefix argument NEW-BUFFER-FLAG decides whether the results are presented in a | 279 | SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is |
| 214 | new buffer. This allows multiple search results to coexist. | 280 | \"+\" then mail in all folders are searched. |
| 215 | 281 | ||
| 216 | Four indexing programs are supported; if none of these are present, then grep | 282 | Four indexing programs are supported; if none of these are present, then grep |
| 217 | is used. This function picks the first program that is available on your | 283 | is used. This function picks the first program that is available on your |
| @@ -224,544 +290,249 @@ index for each program: | |||
| 224 | - `mh-swish++-execute-search' | 290 | - `mh-swish++-execute-search' |
| 225 | - `mh-swish-execute-search' | 291 | - `mh-swish-execute-search' |
| 226 | - `mh-namazu-execute-search' | 292 | - `mh-namazu-execute-search' |
| 227 | - `mh-glimpse-execute-search'" | 293 | - `mh-glimpse-execute-search' |
| 294 | |||
| 295 | This and related functions use an X-MHE-Checksum header to cache the MD5 | ||
| 296 | checksum of a message. This means that already present X-MHE-Checksum headers | ||
| 297 | in the incoming email could result in messages not being found. The following | ||
| 298 | procmail recipe should avoid this: | ||
| 299 | |||
| 300 | :0 wf | ||
| 301 | | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\" | ||
| 302 | |||
| 303 | This has the effect of renaming already present X-MHE-Checksum headers." | ||
| 228 | (interactive | 304 | (interactive |
| 229 | (list (progn | 305 | (list current-prefix-arg |
| 306 | (progn | ||
| 230 | (unless mh-find-path-run (mh-find-path)) | 307 | (unless mh-find-path-run (mh-find-path)) |
| 231 | (mh-prompt-for-folder "Search" "+" nil "all")) | 308 | (or (and current-prefix-arg (car mh-index-previous-search)) |
| 309 | (mh-prompt-for-folder "Search" "+" nil "all"))) | ||
| 232 | (progn | 310 | (progn |
| 233 | ;; Yes, we do want to call mh-index-choose every time in case the | 311 | ;; Yes, we do want to call mh-index-choose every time in case the |
| 234 | ;; user has switched the indexer manually. | 312 | ;; user has switched the indexer manually. |
| 235 | (unless (mh-index-choose) (error "No indexing program found")) | 313 | (unless (mh-index-choose) (error "No indexing program found")) |
| 236 | (read-string (format "%s regexp: " | 314 | (or (and current-prefix-arg (cadr mh-index-previous-search)) |
| 237 | (upcase-initials (symbol-name mh-indexer))))) | 315 | (read-string (format "%s regexp: " |
| 238 | current-prefix-arg)) | 316 | (upcase-initials |
| 239 | (setq mh-index-max-msg-index 0) | 317 | (symbol-name mh-indexer)))))))) |
| 240 | (let ((config (current-window-configuration)) | 318 | (mh-checksum-choose) |
| 241 | (mh-index-buffer | 319 | (let ((result-count 0) |
| 242 | (cond (new-buffer-flag | 320 | (old-window-config mh-previous-window-config) |
| 243 | (buffer-name (generate-new-buffer mh-index-buffer))) | 321 | (previous-search mh-index-previous-search) |
| 244 | ((and (eq major-mode 'mh-index-folder-mode)) | 322 | (index-folder (format "%s/%s" mh-index-folder |
| 245 | (buffer-name (current-buffer))) | 323 | (mh-index-generate-pretty-name search-regexp)))) |
| 246 | (t mh-index-buffer))) | 324 | ;; Create a new folder for the search results or recreate the old one... |
| 247 | (mh-index-show-buffer | 325 | (if (and redo-search-flag mh-index-previous-search) |
| 248 | (cond (new-buffer-flag | 326 | (let ((buffer-name (buffer-name (current-buffer)))) |
| 249 | (buffer-name (generate-new-buffer mh-index-show-buffer))) | 327 | (mh-process-or-undo-commands buffer-name) |
| 250 | ((eq major-mode 'mh-index-folder-mode) | 328 | (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name)) |
| 251 | mh-index-other-buffer) | 329 | (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name) |
| 252 | (t mh-index-show-buffer)))) | 330 | (setq index-folder buffer-name)) |
| 253 | (when (buffer-live-p (get-buffer mh-index-show-buffer)) | 331 | (setq index-folder (mh-index-new-folder index-folder))) |
| 254 | (kill-buffer (get-buffer mh-index-show-buffer))) | 332 | |
| 255 | (get-buffer-create mh-index-buffer) | 333 | (let ((folder-path (format "%s%s" mh-user-path (substring folder 1))) |
| 256 | (get-buffer-create mh-index-show-buffer) | 334 | (folder-results-map (make-hash-table :test #'equal)) |
| 257 | (save-excursion | 335 | (origin-map (make-hash-table :test #'equal))) |
| 258 | (set-buffer mh-index-buffer) | ||
| 259 | (setq mh-index-other-buffer mh-index-show-buffer)) | ||
| 260 | (save-excursion | ||
| 261 | (set-buffer mh-index-show-buffer) | ||
| 262 | (setq mh-index-other-buffer mh-index-buffer)) | ||
| 263 | (set-buffer mh-index-buffer) | ||
| 264 | (setq buffer-read-only nil) | ||
| 265 | (erase-buffer) | ||
| 266 | (let* ((folder-path (format "%s%s" mh-user-path (substring folder 1))) | ||
| 267 | (count 0) | ||
| 268 | (folder-count 0) | ||
| 269 | cur-folder last-folder cur-index last-index | ||
| 270 | parse-results button-start button-end) | ||
| 271 | (setq mh-index-matches (make-hash-table :test #'equal)) | ||
| 272 | |||
| 273 | ;; Run search program... | 336 | ;; Run search program... |
| 274 | (message "%s searching... " (upcase-initials (symbol-name mh-indexer))) | 337 | (message "Executing %s... " mh-indexer) |
| 275 | (funcall mh-index-execute-search-function folder-path search-regexp) | 338 | (funcall mh-index-execute-search-function folder-path search-regexp) |
| 276 | 339 | ||
| 277 | ;; Parse output and generate folder view | 340 | ;; Parse indexer output |
| 278 | (message "Processing %s output... " mh-indexer) | 341 | (message "Processing %s output... " mh-indexer) |
| 279 | (goto-char (point-min)) | 342 | (goto-char (point-min)) |
| 280 | (while (setq parse-results (funcall mh-index-next-result-function)) | 343 | (loop for next-result = (funcall mh-index-next-result-function) |
| 281 | (unless (eq parse-results 'error) | 344 | when (null next-result) return nil |
| 282 | (setq cur-folder (car parse-results) | 345 | do (unless (eq next-result 'error) |
| 283 | cur-index (cadr parse-results)) | 346 | (unless (gethash (car next-result) folder-results-map) |
| 284 | (setq mh-index-max-msg-index (max mh-index-max-msg-index cur-index)) | 347 | (setf (gethash (car next-result) folder-results-map) |
| 285 | (cond ((and (equal cur-folder last-folder) | 348 | (make-hash-table :test #'equal))) |
| 286 | (= cur-index last-index)) | 349 | (setf (gethash (cadr next-result) |
| 287 | nil) | 350 | (gethash (car next-result) folder-results-map)) |
| 288 | ((equal cur-folder last-folder) | 351 | t))) |
| 289 | (save-excursion | 352 | |
| 290 | (set-buffer mh-index-buffer) | 353 | ;; Copy the search results over |
| 291 | (push cur-index (gethash cur-folder mh-index-matches)))) | 354 | (maphash #'(lambda (folder msgs) |
| 292 | (t | 355 | (let ((msgs (sort (loop for msg being the hash-keys of msgs |
| 293 | (save-excursion | 356 | collect msg) |
| 294 | (set-buffer mh-index-buffer) | 357 | #'<))) |
| 295 | (unless (gethash cur-folder mh-index-matches) | 358 | (mh-exec-cmd "refile" msgs "-src" folder |
| 296 | (setq button-start (point)) | 359 | "-link" index-folder) |
| 297 | (gnus-eval-format "%T\n" '((?T cur-folder ?s)) | 360 | (loop for msg in msgs |
| 298 | `(,@(gnus-local-map-property | 361 | do (incf result-count) |
| 299 | mh-index-button-map) | 362 | (setf (gethash result-count origin-map) |
| 300 | mh-callback mh-index-callback | 363 | (cons folder msg))))) |
| 301 | mh-data ,cur-folder)) | 364 | folder-results-map) |
| 302 | (setq button-end (point)) | ||
| 303 | (widget-convert-button | ||
| 304 | 'link button-start button-end | ||
| 305 | :button-keymap mh-index-button-map | ||
| 306 | :action 'mh-index-callback) | ||
| 307 | (insert "\n")) | ||
| 308 | (push cur-index (gethash cur-folder mh-index-matches))))) | ||
| 309 | (setq last-folder cur-folder) | ||
| 310 | (setq last-index cur-index))) | ||
| 311 | |||
| 312 | ;; Get rid of extra line at end of the buffer if there were any hits. | ||
| 313 | (set-buffer mh-index-buffer) | ||
| 314 | (goto-char (point-max)) | ||
| 315 | (when (and (= (forward-line -1) 0) (bolp) (eolp)) | ||
| 316 | (delete-char 1)) | ||
| 317 | |||
| 318 | ;; Set mh-cmd-note to a large enough value... | ||
| 319 | (when mh-adaptive-cmd-note-flag | ||
| 320 | (mh-set-cmd-note (mh-index-find-max-width mh-index-max-msg-index))) | ||
| 321 | 365 | ||
| 322 | ;; Generate scan lines for the hits. | 366 | ;; Generate scan lines for the hits. |
| 323 | (message "Generating scan lines... ") | 367 | (let ((mh-show-threads-flag nil)) |
| 324 | (goto-char (point-min)) | 368 | (mh-visit-folder index-folder () (list folder-results-map origin-map))) |
| 325 | (while (not (eobp)) | 369 | |
| 326 | (let ((folder (get-text-property (point) 'mh-data))) | ||
| 327 | (when folder | ||
| 328 | (incf folder-count) | ||
| 329 | (forward-line) | ||
| 330 | (incf count (mh-index-insert-scan folder)))) | ||
| 331 | (forward-line)) | ||
| 332 | |||
| 333 | ;; Go to the first hit (if any). | ||
| 334 | (goto-char (point-min)) | 370 | (goto-char (point-min)) |
| 335 | (forward-line) | 371 | (forward-line) |
| 372 | (mh-update-sequences) | ||
| 373 | (mh-recenter nil) | ||
| 374 | |||
| 375 | ;; Maintain history | ||
| 376 | (when (and redo-search-flag previous-search) | ||
| 377 | (setq mh-previous-window-config old-window-config)) | ||
| 378 | (setq mh-index-previous-search (list folder search-regexp)) | ||
| 336 | 379 | ||
| 337 | ;; Remember old window configuration | ||
| 338 | (setq mh-index-previous-window-configuration config) | ||
| 339 | |||
| 340 | ;; Setup folder buffer mode | ||
| 341 | (when mh-decode-mime-flag | ||
| 342 | (add-hook 'kill-buffer-hook 'mh-mime-cleanup)) | ||
| 343 | (mh-index-folder-mode) | ||
| 344 | (setq mh-show-buffer mh-index-show-buffer) | ||
| 345 | (setq buffer-read-only t) | ||
| 346 | (set-buffer-modified-p nil) | ||
| 347 | (mh-index-configure-one-window) | ||
| 348 | (setq mh-current-folder nil mh-index-current-msg nil) | ||
| 349 | (message "%s found %s matches in %s folders" | 380 | (message "%s found %s matches in %s folders" |
| 350 | (upcase-initials (symbol-name mh-indexer)) | 381 | (upcase-initials (symbol-name mh-indexer)) |
| 351 | count folder-count)))) | 382 | (loop for msg-hash being hash-values of mh-index-data |
| 352 | 383 | sum (hash-table-count msg-hash)) | |
| 353 | (defun mh-index-find-max-width (max-index) | 384 | (loop for msg-hash being hash-values of mh-index-data |
| 354 | "Given MAX-INDEX find the number of digits necessary to print it." | 385 | count (> (hash-table-count msg-hash) 0)))))) |
| 355 | (let ((result 1) | 386 | |
| 356 | (max-int 9)) | 387 | ;;;###mh-autoload |
| 357 | (while (< max-int max-index) | 388 | (defun mh-index-next-folder (&optional backward-flag) |
| 358 | (incf result) | 389 | "Jump to the next folder marker. |
| 359 | (setq max-int (+ (* 10 max-int) 9))) | 390 | The function is only applicable to folders displaying index search results. |
| 360 | result)) | 391 | With non-nil optional argument BACKWARD-FLAG, jump to the previous group of |
| 361 | 392 | results." | |
| 362 | (defun mh-index-search-again () | 393 | (interactive "P") |
| 363 | "Call `mh-index-search' from index search buffer." | 394 | (if (or (null mh-index-data) |
| 395 | (memq 'unthread mh-view-ops)) | ||
| 396 | (message "Only applicable in an unthreaded MH-E index search buffer") | ||
| 397 | (let ((point (point))) | ||
| 398 | (forward-line (if backward-flag -1 1)) | ||
| 399 | (cond ((if backward-flag | ||
| 400 | (re-search-backward "^+" (point-min) t) | ||
| 401 | (re-search-forward "^+" (point-max) t)) | ||
| 402 | (beginning-of-line)) | ||
| 403 | ((and (if backward-flag | ||
| 404 | (goto-char (point-max)) | ||
| 405 | (goto-char (point-min))) | ||
| 406 | nil)) | ||
| 407 | ((if backward-flag | ||
| 408 | (re-search-backward "^+" (point-min) t) | ||
| 409 | (re-search-forward "^+" (point-max) t)) | ||
| 410 | (beginning-of-line)) | ||
| 411 | (t (goto-char point)))))) | ||
| 412 | |||
| 413 | ;;;###mh-autoload | ||
| 414 | (defun mh-index-previous-folder () | ||
| 415 | "Jump to the previous folder marker." | ||
| 364 | (interactive) | 416 | (interactive) |
| 365 | (cond ((eq major-mode 'mh-index-show-mode) | 417 | (mh-index-next-folder t)) |
| 366 | (set-buffer mh-index-other-buffer)) | 418 | |
| 367 | ((not (eq major-mode 'mh-index-folder-mode)) | 419 | (defun mh-folder-exists-p (folder) |
| 368 | (error "Should be called from one of the index buffers"))) | 420 | "Check if FOLDER exists." |
| 369 | (let ((old-buffer (current-buffer)) | 421 | (and (mh-folder-name-p folder) |
| 370 | (window-config mh-index-previous-window-configuration)) | 422 | (save-excursion |
| 371 | (unwind-protect (call-interactively 'mh-index-search) | 423 | (with-temp-buffer |
| 372 | (when (eq old-buffer (current-buffer)) | 424 | (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder) |
| 373 | (setq mh-index-previous-window-configuration window-config))))) | 425 | (goto-char (point-min)) |
| 374 | 426 | (not (eobp)))))) | |
| 375 | (defun mh-index-insert-scan (folder) | 427 | |
| 376 | "Insert scan lines for hits in FOLDER that the indexing program found. | 428 | (defun mh-msg-exists-p (msg folder) |
| 377 | The only twist is to replace the subject/body field with the match (if | 429 | "Check if MSG exists in FOLDER." |
| 378 | possible)." | 430 | (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg))) |
| 379 | (save-excursion | 431 | |
| 380 | (apply #'mh-exec-cmd-output | 432 | (defun mh-index-new-folder (name) |
| 381 | mh-scan-prog nil (mh-scan-format) | 433 | "Create and return an MH folder name based on NAME. |
| 382 | "-noclear" "-noheader" "-width" (window-width) | 434 | If the folder NAME already exists then check if NAME<2> exists. If it doesn't |
| 383 | folder (mh-coalesce-msg-list (gethash folder mh-index-matches)))) | 435 | then it is created and returned. Otherwise try NAME<3>. This is repeated till |
| 384 | (save-excursion | 436 | we find a new folder name." |
| 385 | (let ((window-width (window-width)) | 437 | (unless (mh-folder-name-p name) |
| 386 | (count 0)) | 438 | (error "The argument should be a valid MH folder name")) |
| 387 | (while (not (or (get-text-property (point) 'mh-data) (eobp))) | 439 | (let ((chosen-name name)) |
| 388 | (beginning-of-line) | 440 | (block unique-name |
| 389 | (unless (and (eolp) (bolp)) | 441 | (unless (mh-folder-exists-p name) |
| 390 | (incf count) | 442 | (return-from unique-name)) |
| 391 | (forward-char mh-cmd-note) | 443 | (loop for index from 2 |
| 392 | (delete-char 1) | 444 | do (let ((new-name (format "%s<%s>" name index))) |
| 393 | (insert " ")) | 445 | (unless (mh-folder-exists-p new-name) |
| 394 | (forward-line 1)) | 446 | (setq chosen-name new-name) |
| 395 | count))) | 447 | (return-from unique-name))))) |
| 396 | 448 | (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) | |
| 397 | (defun mh-index-callback () | 449 | (when (boundp 'mh-speed-folder-map) |
| 398 | "Callback function for buttons in the index buffer." | 450 | (mh-speed-add-folder chosen-name)) |
| 399 | (let* ((folder (save-excursion | 451 | (push (list chosen-name) mh-folder-list) |
| 400 | (buffer-substring-no-properties | 452 | chosen-name)) |
| 401 | (progn (beginning-of-line) (point)) | 453 | |
| 402 | (progn (end-of-line) (point))))) | 454 | ;;;###mh-autoload |
| 403 | (data (get-text-property (point) 'mh-data)) | 455 | (defun mh-index-insert-folder-headers () |
| 404 | (msg-list (gethash data mh-index-matches))) | 456 | "Annotate the search results with original folder names." |
| 405 | (when msg-list | 457 | (let ((cur-msg (mh-get-msg-num nil)) |
| 406 | (mh-visit-folder folder msg-list)))) | 458 | (old-buffer-modified-flag (buffer-modified-p)) |
| 407 | 459 | (buffer-read-only nil) | |
| 408 | (defmacro mh-defun-index (func args &rest body) | 460 | current-folder last-folder) |
| 409 | "Macro to generate a function callable both from index and show buffer. | ||
| 410 | FUNC is the function name, ARGS the argument list and BODY the function | ||
| 411 | body." | ||
| 412 | (let ((cur (gensym)) | ||
| 413 | interactive-spec doc-string) | ||
| 414 | (when (stringp (car body)) | ||
| 415 | (setq doc-string (car body)) | ||
| 416 | (setq body (cdr body))) | ||
| 417 | (when (and (listp (car body)) (eq (caar body) 'interactive)) | ||
| 418 | (setq interactive-spec (car body)) | ||
| 419 | (setq body (cdr body))) | ||
| 420 | `(defun ,func ,args | ||
| 421 | ,@(if doc-string (list doc-string) ()) | ||
| 422 | ,interactive-spec | ||
| 423 | (let* ((mh-index-buffer (if (eq major-mode 'mh-index-folder-mode) | ||
| 424 | (buffer-name (current-buffer)) | ||
| 425 | mh-index-other-buffer)) | ||
| 426 | (mh-index-show-buffer (if (eq major-mode 'mh-index-show-mode) | ||
| 427 | (buffer-name (current-buffer)) | ||
| 428 | mh-index-other-buffer)) | ||
| 429 | (,cur (cond ((eq (get-buffer mh-index-buffer) | ||
| 430 | (current-buffer)) | ||
| 431 | mh-index-buffer) | ||
| 432 | ((eq (get-buffer mh-index-show-buffer) | ||
| 433 | (current-buffer)) | ||
| 434 | mh-index-show-buffer) | ||
| 435 | (t (error "Not called from mh-index buffer"))))) | ||
| 436 | (flet ((mh-msg-folder (folder) mh-index-buffer) | ||
| 437 | (mh-msg-filename (msg-num folder) | ||
| 438 | (format "%s%s/%s" mh-user-path (subseq folder 1) msg-num))) | ||
| 439 | (cond ((eq ,cur mh-index-buffer) | ||
| 440 | (mh-index-goto-nearest-msg) | ||
| 441 | (when (and mh-current-folder mh-index-current-msg) | ||
| 442 | (mh-index-notate mh-current-folder | ||
| 443 | mh-index-current-msg " " mh-cmd-note)) | ||
| 444 | (setq mh-current-folder (mh-index-parse-folder)) | ||
| 445 | (setq mh-index-current-msg (mh-index-parse-msg-number))) | ||
| 446 | ((eq ,cur mh-index-show-buffer) | ||
| 447 | (set-buffer mh-index-buffer) | ||
| 448 | (mh-index-goto-msg mh-current-folder | ||
| 449 | mh-index-current-msg) | ||
| 450 | (mh-index-notate nil nil " " mh-cmd-note)) | ||
| 451 | (t (error "This can't happen!"))) | ||
| 452 | (unwind-protect | ||
| 453 | (progn ,@body) | ||
| 454 | (save-excursion | ||
| 455 | (set-buffer mh-index-buffer) | ||
| 456 | (mh-index-goto-msg mh-current-folder mh-index-current-msg) | ||
| 457 | (mh-recenter nil)) | ||
| 458 | (mh-index-configure-windows) | ||
| 459 | (pop-to-buffer ,cur))))))) | ||
| 460 | |||
| 461 | (defun mh-index-advance (steps) | ||
| 462 | "Advance STEPS messages in the folder buffer. | ||
| 463 | If there are less than STEPS messages left then an error message is printed." | ||
| 464 | (let* ((backward-flag (< steps 0)) | ||
| 465 | (steps (if backward-flag (- steps) steps)) | ||
| 466 | point) | ||
| 467 | (block body | ||
| 468 | (save-excursion | ||
| 469 | (while (> steps 0) | ||
| 470 | (unless (= (forward-line (if backward-flag -1 1)) 0) | ||
| 471 | (return-from body)) | ||
| 472 | (cond ((and (eolp) (bolp) (not backward-flag)) | ||
| 473 | (unless (= (forward-line 2) 0) (return-from body))) | ||
| 474 | ((and (get-text-property (point) 'mh-data) backward-flag) | ||
| 475 | (unless (= (forward-line -2) 0) (return-from body))) | ||
| 476 | ((or (and (eolp) (bolp)) | ||
| 477 | (get-text-property (point) 'mh-data)) | ||
| 478 | (error "Mh-index-buffer is inconsistent"))) | ||
| 479 | (decf steps)) | ||
| 480 | (setq point (point)))) | ||
| 481 | (cond (point (goto-char point) t) | ||
| 482 | (t nil)))) | ||
| 483 | |||
| 484 | ;; Details about message at point. These functions assume that we are on a | ||
| 485 | ;; line which contains a message scan line and not on a blank line or a line | ||
| 486 | ;; with a folder name. | ||
| 487 | (defun mh-index-parse-msg-number () | ||
| 488 | "Parse message number of message at point." | ||
| 489 | (save-excursion | ||
| 490 | (beginning-of-line) | ||
| 491 | (let* ((b (point)) | ||
| 492 | (e (progn (forward-char mh-cmd-note) (point))) | ||
| 493 | (data (ignore-errors | ||
| 494 | (read-from-string (buffer-substring-no-properties b e))))) | ||
| 495 | (unless (and (consp data) (integerp (car data))) | ||
| 496 | (error "Didn't find message number")) | ||
| 497 | (car data)))) | ||
| 498 | |||
| 499 | (defun mh-index-parse-folder () | ||
| 500 | "Parse folder of message at point." | ||
| 501 | (save-excursion | ||
| 502 | (while (not (get-text-property (point) 'mh-data)) | ||
| 503 | (unless (eql (forward-line -1) 0) | ||
| 504 | (error "Reached beginning of buffer without seeing a folder"))) | ||
| 505 | (buffer-substring-no-properties (progn (beginning-of-line) (point)) | ||
| 506 | (progn (end-of-line) (point))))) | ||
| 507 | |||
| 508 | (defun mh-index-goto-nearest-msg () | ||
| 509 | "If point is not at a message go to the closest line with a message on it." | ||
| 510 | (beginning-of-line) | ||
| 511 | (cond ((and (eolp) (bolp)) (forward-line -1)) | ||
| 512 | ((get-text-property (point) 'mh-data) (forward-line 1)))) | ||
| 513 | |||
| 514 | ;; Window configuration for mh-index... There should be similar functions | ||
| 515 | ;; in MH-E but I couldn't find them. I got the idea of using next-window, | ||
| 516 | ;; previous-window and minibuffer-window from MH-E code. | ||
| 517 | (defun mh-index-configure-windows () | ||
| 518 | "Configure windows." | ||
| 519 | (cond ((and (buffer-live-p (get-buffer mh-index-show-buffer)) | ||
| 520 | (buffer-live-p (get-buffer mh-index-buffer)) | ||
| 521 | (eq (save-excursion (set-buffer mh-index-show-buffer) major-mode) | ||
| 522 | 'mh-index-show-mode)) | ||
| 523 | (mh-index-configure-two-windows)) | ||
| 524 | ((buffer-live-p (get-buffer mh-index-buffer)) | ||
| 525 | (mh-index-configure-one-window)))) | ||
| 526 | |||
| 527 | (defun mh-count-windows () | ||
| 528 | "Count the number of windows in the current frame. | ||
| 529 | The minibuffer window is excluded from the count." | ||
| 530 | (let* ((start-window (next-window nil t)) | ||
| 531 | (current-window (next-window start-window t)) | ||
| 532 | (count 0)) | ||
| 533 | (while (not (eq current-window start-window)) | ||
| 534 | (incf count) | ||
| 535 | (setq current-window (next-window current-window t))) | ||
| 536 | count)) | ||
| 537 | |||
| 538 | (defun mh-index-configure-two-windows () | ||
| 539 | "Force a split view like that of MH-E." | ||
| 540 | (save-excursion | ||
| 541 | (unless (and (get-buffer mh-index-show-buffer) | ||
| 542 | (get-buffer mh-index-buffer)) | ||
| 543 | (error "We don't have both index buffers")) | ||
| 544 | (let ((window-count (mh-count-windows))) | ||
| 545 | (unless (and (= window-count 2) | ||
| 546 | (eq (window-buffer (next-window (minibuffer-window))) | ||
| 547 | (get-buffer mh-index-buffer)) | ||
| 548 | (eq (window-buffer (previous-window (minibuffer-window))) | ||
| 549 | (get-buffer mh-index-show-buffer))) | ||
| 550 | (unless (= window-count 2) | ||
| 551 | (delete-other-windows) | ||
| 552 | (split-window-vertically)) | ||
| 553 | (set-window-buffer (next-window (minibuffer-window)) | ||
| 554 | mh-index-buffer) | ||
| 555 | (set-window-buffer (previous-window (minibuffer-window)) | ||
| 556 | mh-index-show-buffer)) | ||
| 557 | (unless (and (get-buffer-window mh-index-buffer) | ||
| 558 | (= (window-height (get-buffer-window mh-index-buffer)) | ||
| 559 | mh-summary-height)) | ||
| 560 | (pop-to-buffer mh-index-buffer) | ||
| 561 | (shrink-window (- (window-height) mh-summary-height)))) | ||
| 562 | (set-window-point (previous-window (minibuffer-window)) | ||
| 563 | (progn (set-buffer mh-index-show-buffer) (point))) | ||
| 564 | (set-window-point (next-window (minibuffer-window)) | ||
| 565 | (progn (set-buffer mh-index-buffer) (point))))) | ||
| 566 | |||
| 567 | (defun mh-index-configure-one-window () | ||
| 568 | "Single window view." | ||
| 569 | (save-excursion | ||
| 570 | (unless (buffer-live-p (get-buffer mh-index-buffer)) | ||
| 571 | (error "Should have mh-index-buffer")) | ||
| 572 | (switch-to-buffer mh-index-buffer) | ||
| 573 | (delete-other-windows) | ||
| 574 | (set-window-point (next-window (minibuffer-window)) | ||
| 575 | (progn (set-buffer mh-index-buffer) (point))))) | ||
| 576 | |||
| 577 | ;; This is slightly more involved than normal MH-E since we may have multiple | ||
| 578 | ;; folders in the same buffer. | ||
| 579 | (defun mh-index-goto-msg (folder msg) | ||
| 580 | "Move the cursor to the message specified by FOLDER and MSG." | ||
| 581 | (block body | ||
| 582 | (unless (buffer-live-p (get-buffer mh-index-buffer)) | ||
| 583 | (error "No index buffer to go to")) | ||
| 584 | (set-buffer mh-index-buffer) | ||
| 585 | (goto-char (point-min)) | 461 | (goto-char (point-min)) |
| 586 | (while (re-search-forward (format "^%s$" folder) nil t) | 462 | (while (not (eobp)) |
| 587 | (forward-line) | 463 | (setq current-folder (car (gethash (gethash (mh-get-msg-num nil) |
| 588 | (while (not (eolp)) | 464 | mh-index-msg-checksum-map) |
| 589 | (when (= (mh-index-parse-msg-number) msg) | 465 | mh-index-checksum-origin-map))) |
| 590 | (return-from body)) | 466 | (when (and current-folder (not (eq current-folder last-folder))) |
| 467 | (insert (if last-folder "\n" "") current-folder "\n") | ||
| 468 | (setq last-folder current-folder)) | ||
| 469 | (forward-line)) | ||
| 470 | (when cur-msg (mh-goto-msg cur-msg t)) | ||
| 471 | (set-buffer-modified-p old-buffer-modified-flag))) | ||
| 472 | |||
| 473 | ;;;###mh-autoload | ||
| 474 | (defun mh-index-delete-folder-headers () | ||
| 475 | "Delete the folder headers." | ||
| 476 | (let ((cur-msg (mh-get-msg-num nil)) | ||
| 477 | (old-buffer-modified-flag (buffer-modified-p)) | ||
| 478 | (buffer-read-only nil)) | ||
| 479 | (goto-char (point-min)) | ||
| 480 | (while (not (eobp)) | ||
| 481 | (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10)) | ||
| 482 | (delete-region (point) (progn (forward-line) (point))) | ||
| 591 | (forward-line))) | 483 | (forward-line))) |
| 592 | (error "Folder: %s, msg: %s doesn't exist" folder msg))) | 484 | (when cur-msg (mh-goto-msg cur-msg t t)) |
| 593 | 485 | (set-buffer-modified-p old-buffer-modified-flag))) | |
| 594 | ;; Can't use mh-notate directly since we could have more than one folder in | ||
| 595 | ;; the same buffer | ||
| 596 | (defun mh-index-notate (folder msg notation offset) | ||
| 597 | "Add notation to scan line. | ||
| 598 | FOLDER is the message folder and MSG the message index. These arguments | ||
| 599 | specify the message to be notated. NOTATION is the character to be used to | ||
| 600 | notate and OFFSET is the number of chars from start of the line where | ||
| 601 | notation is to be placed." | ||
| 602 | (save-excursion | ||
| 603 | (set-buffer mh-index-buffer) | ||
| 604 | (let ((buffer-read-only nil) | ||
| 605 | (modified-p (buffer-modified-p)) | ||
| 606 | (found t)) | ||
| 607 | (setq found nil) | ||
| 608 | (when (and (stringp folder) (numberp msg)) | ||
| 609 | (block nil | ||
| 610 | (goto-char (point-min)) | ||
| 611 | (re-search-forward (format "^%s$" folder)) | ||
| 612 | (forward-line) | ||
| 613 | (while (not (eolp)) | ||
| 614 | (when (= (mh-index-parse-msg-number) msg) | ||
| 615 | (setq found t) | ||
| 616 | (return)) | ||
| 617 | (forward-line)))) | ||
| 618 | (when found | ||
| 619 | (beginning-of-line) | ||
| 620 | (forward-char offset) | ||
| 621 | (delete-char 1) | ||
| 622 | (insert notation) | ||
| 623 | (unless modified-p (set-buffer-modified-p nil)))))) | ||
| 624 | 486 | ||
| 625 | 487 | ;;;###mh-autoload | |
| 626 | 488 | (defun mh-index-visit-folder () | |
| 627 | ;;; User functions | 489 | "Visit original folder from where the message at point was found." |
| 628 | |||
| 629 | (mh-defun-index mh-index-show (display-headers-flag) | ||
| 630 | "Display message at point. | ||
| 631 | If there are no messages at point then display the closest message. | ||
| 632 | The value of `mh-index-show-hook' is a list of functions to be called, | ||
| 633 | with no arguments, after the message has been displayed. | ||
| 634 | If DISPLAY-HEADERS-FLAG is non-nil then the raw message is shown." | ||
| 635 | (interactive (list nil)) | ||
| 636 | (when (or (and (bolp) (eolp)) (get-text-property (point) 'mh-data)) | ||
| 637 | (error "No message at point")) | ||
| 638 | (setq mh-current-folder (mh-index-parse-folder)) | ||
| 639 | (setq mh-index-current-msg (mh-index-parse-msg-number)) | ||
| 640 | ;; Do new notation | ||
| 641 | (when (and mh-current-folder mh-index-current-msg) | ||
| 642 | (mh-index-notate mh-current-folder mh-index-current-msg | ||
| 643 | mh-note-cur mh-cmd-note)) | ||
| 644 | (let ((mh-decode-mime-flag (and (not display-headers-flag) mh-decode-mime-flag)) | ||
| 645 | (mh-clean-message-header-flag | ||
| 646 | (and (not display-headers-flag) mh-clean-message-header-flag)) | ||
| 647 | (mhl-formfile (if display-headers-flag nil mhl-formfile)) | ||
| 648 | (msg mh-index-current-msg) | ||
| 649 | (folder mh-current-folder)) | ||
| 650 | (when (not (eq display-headers-flag mh-showing-with-headers)) | ||
| 651 | (mh-invalidate-show-buffer)) | ||
| 652 | (mh-in-show-buffer (mh-index-show-buffer) | ||
| 653 | (mh-display-msg msg folder)) | ||
| 654 | ;; Search for match in shown message | ||
| 655 | (select-window (get-buffer-window mh-index-show-buffer)) | ||
| 656 | (set-buffer mh-index-show-buffer) | ||
| 657 | (mh-index-show-mode)) | ||
| 658 | (run-hooks 'mh-index-show-hook)) | ||
| 659 | |||
| 660 | (defun mh-index-header-display () | ||
| 661 | "Show the message with full headers." | ||
| 662 | (interactive) | ||
| 663 | (mh-index-show t) | ||
| 664 | (setq mh-showing-with-headers t)) | ||
| 665 | |||
| 666 | (mh-defun-index mh-index-next (steps) | ||
| 667 | "Display next message. | ||
| 668 | Prefix argument STEPS specifies the number of messages to skip ahead." | ||
| 669 | (interactive "p") | ||
| 670 | (mh-index-goto-nearest-msg) | ||
| 671 | (if (mh-index-advance steps) | ||
| 672 | (mh-index-show nil) | ||
| 673 | (mh-index-show nil) | ||
| 674 | (message "Not enough messages"))) | ||
| 675 | |||
| 676 | (mh-defun-index mh-index-prev (steps) | ||
| 677 | "Display previous message. | ||
| 678 | Prefix argument STEPS specifies the number of messages to skip backward." | ||
| 679 | (interactive "p") | ||
| 680 | (mh-index-goto-nearest-msg) | ||
| 681 | (if (mh-index-advance (- steps)) | ||
| 682 | (mh-index-show nil) | ||
| 683 | (mh-index-show nil) | ||
| 684 | (message "Not enough messages"))) | ||
| 685 | |||
| 686 | (defun mh-index-page-msg (arg) | ||
| 687 | "Scroll the displayed message upward ARG lines." | ||
| 688 | (interactive "P") | ||
| 689 | (save-excursion | ||
| 690 | (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode) | ||
| 691 | mh-index-other-buffer) | ||
| 692 | ((eq major-mode 'mh-index-show-mode) | ||
| 693 | (buffer-name (current-buffer))) | ||
| 694 | (t (error "Don't use mh-index-page-msg")))) | ||
| 695 | (window (get-buffer-window show-buffer)) | ||
| 696 | (current-window (selected-window))) | ||
| 697 | (when (window-live-p window) | ||
| 698 | (select-window window) | ||
| 699 | (unwind-protect (scroll-up arg) | ||
| 700 | (select-window current-window)))))) | ||
| 701 | |||
| 702 | (defun mh-index-previous-page (arg) | ||
| 703 | "Scroll the displayed message downward ARG lines." | ||
| 704 | (interactive "P") | ||
| 705 | (save-excursion | ||
| 706 | (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode) | ||
| 707 | mh-index-other-buffer) | ||
| 708 | ((eq major-mode 'mh-index-show-mode) | ||
| 709 | (buffer-name (current-buffer))) | ||
| 710 | (t (error "Don't use mh-index-previous-page")))) | ||
| 711 | (window (get-buffer-window show-buffer)) | ||
| 712 | (current-window (selected-window))) | ||
| 713 | (when (window-live-p window) | ||
| 714 | (select-window window) | ||
| 715 | (unwind-protect (scroll-down arg) | ||
| 716 | (select-window current-window)))))) | ||
| 717 | |||
| 718 | (defun mh-index-press-button () | ||
| 719 | "Press index button." | ||
| 720 | (interactive) | ||
| 721 | (let ((function (get-text-property (point) 'mh-callback))) | ||
| 722 | (when function | ||
| 723 | (funcall function)))) | ||
| 724 | |||
| 725 | (defun mh-index-quit () | ||
| 726 | "Quit the index folder. | ||
| 727 | Restore the previous window configuration, if one exists. | ||
| 728 | The value of `mh-before-quit-hook' is a list of functions to be called, with | ||
| 729 | no arguments, immediately upon entry to this function. | ||
| 730 | The value of `mh-quit-hook' is a list of functions to be called, with no | ||
| 731 | arguments, upon exit of this function." | ||
| 732 | (interactive) | 490 | (interactive) |
| 733 | (cond ((eq major-mode 'mh-index-show-mode) | 491 | (unless mh-index-data |
| 734 | (set-buffer mh-index-other-buffer)) | 492 | (error "Not in an index folder")) |
| 735 | ((not (eq major-mode 'mh-index-folder-mode)) | 493 | (let (folder msg) |
| 736 | (error "The function mh-index-quit shouldn't be called"))) | 494 | (save-excursion |
| 737 | (run-hooks 'mh-before-quit-hook) | 495 | (cond ((and (bolp) (eolp)) |
| 738 | (let ((mh-index-buffer (buffer-name (current-buffer))) | 496 | (ignore-errors (forward-line -1)) |
| 739 | (mh-index-show-buffer mh-index-other-buffer) | 497 | (setq msg (mh-get-msg-num t))) |
| 740 | (window-config mh-index-previous-window-configuration)) | 498 | ((equal (char-after (line-beginning-position)) ?+) |
| 741 | (when (buffer-live-p (get-buffer mh-index-buffer)) | 499 | (setq folder (buffer-substring-no-properties |
| 742 | (bury-buffer (get-buffer mh-index-buffer))) | 500 | (line-beginning-position) (line-end-position)))) |
| 743 | (when (buffer-live-p (get-buffer mh-index-show-buffer)) | 501 | (t (setq msg (mh-get-msg-num t))))) |
| 744 | (bury-buffer (get-buffer mh-index-show-buffer))) | 502 | (when (not folder) |
| 745 | (when window-config | 503 | (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) |
| 746 | (set-window-configuration window-config))) | 504 | mh-index-checksum-origin-map)))) |
| 747 | (run-hooks 'mh-quit-hook)) | 505 | (mh-visit-folder |
| 748 | 506 | folder (loop for x being the hash-keys of (gethash folder mh-index-data) | |
| 749 | ;; Can't quite use mh-next-button... This buffer has no concept of | 507 | when (mh-msg-exists-p x folder) collect x)))) |
| 750 | ;; folder-buffer or show-buffer. Maybe refactor mh-next-button? | 508 | |
| 751 | (defun mh-index-next-button (&optional backward-flag) | 509 | (defun mh-index-match-checksum (msg folder checksum) |
| 752 | "Go to the next button. | 510 | "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." |
| 753 | Advance point to the next button in the show buffer. If the end of buffer is | 511 | (with-temp-buffer |
| 754 | reached then the search wraps over to the start of the buffer. With optional | 512 | (mh-exec-cmd-output mh-scan-prog nil "-width" "80" |
| 755 | argument BACKWARD-FLAG the point will move to the previous button." | 513 | "-format" "%{x-mhe-checksum}\n" folder msg) |
| 756 | (interactive current-prefix-arg) | 514 | (goto-char (point-min)) |
| 757 | (mh-goto-next-button backward-flag)) | 515 | (string-equal (buffer-substring-no-properties (point) (line-end-position)) |
| 758 | 516 | checksum))) | |
| 759 | (defun mh-index-prev-button () | 517 | |
| 760 | "Go to the next button. | 518 | ;;;###mh-autoload |
| 761 | Move point to the previous button in the show buffer. If the beginning of | 519 | (defun mh-index-execute-commands () |
| 762 | the buffer is reached then the search wraps over to the end." | 520 | "Delete/refile the actual messages. |
| 763 | (interactive) | 521 | The copies in the searched folder are then deleted/refiled to get the desired |
| 764 | (mh-index-next-button t)) | 522 | result. Before deleting the messages we make sure that the message being |
| 523 | deleted is identical to the one that the user has marked in the index buffer." | ||
| 524 | (let ((message-table (make-hash-table :test #'equal))) | ||
| 525 | (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list))) | ||
| 526 | (dolist (msg msg-list) | ||
| 527 | (let* ((checksum (gethash msg mh-index-msg-checksum-map)) | ||
| 528 | (pair (gethash checksum mh-index-checksum-origin-map))) | ||
| 529 | (when (and checksum (car pair) (cdr pair) | ||
| 530 | (mh-index-match-checksum (cdr pair) (car pair) checksum)) | ||
| 531 | (push (cdr pair) (gethash (car pair) message-table)) | ||
| 532 | (remhash (cdr pair) (gethash (car pair) mh-index-data)))))) | ||
| 533 | (maphash (lambda (folder msgs) | ||
| 534 | (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))) | ||
| 535 | message-table))) | ||
| 765 | 536 | ||
| 766 | 537 | ||
| 767 | 538 | ||
| @@ -770,6 +541,7 @@ the buffer is reached then the search wraps over to the end." | |||
| 770 | (defvar mh-glimpse-binary (executable-find "glimpse")) | 541 | (defvar mh-glimpse-binary (executable-find "glimpse")) |
| 771 | (defvar mh-glimpse-directory ".glimpse") | 542 | (defvar mh-glimpse-directory ".glimpse") |
| 772 | 543 | ||
| 544 | ;;;###mh-autoload | ||
| 773 | (defun mh-glimpse-execute-search (folder-path search-regexp) | 545 | (defun mh-glimpse-execute-search (folder-path search-regexp) |
| 774 | "Execute glimpse and read the results. | 546 | "Execute glimpse and read the results. |
| 775 | 547 | ||
| @@ -784,12 +556,18 @@ First create the directory /home/user/Mail/.glimpse. Then create the file | |||
| 784 | */,* | 556 | */,* |
| 785 | */*~ | 557 | */*~ |
| 786 | ^/home/user/Mail/.glimpse | 558 | ^/home/user/Mail/.glimpse |
| 559 | ^/home/user/Mail/mhe-index | ||
| 787 | 560 | ||
| 788 | If there are any directories you would like to ignore, append lines like the | 561 | If there are any directories you would like to ignore, append lines like the |
| 789 | following to .glimpse_exclude: | 562 | following to .glimpse_exclude: |
| 790 | 563 | ||
| 791 | ^/home/user/Mail/scripts | 564 | ^/home/user/Mail/scripts |
| 792 | 565 | ||
| 566 | You do not want to index the folders that hold the results of your searches | ||
| 567 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 568 | The configuration file above assumes that the results are found in sub-folders | ||
| 569 | of `mh-index-folder' which is +mhe-index by default. | ||
| 570 | |||
| 793 | Use the following command line to generate the glimpse index. Run this | 571 | Use the following command line to generate the glimpse index. Run this |
| 794 | daily from cron: | 572 | daily from cron: |
| 795 | 573 | ||
| @@ -799,9 +577,9 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | |||
| 799 | (set-buffer (get-buffer-create mh-index-temp-buffer)) | 577 | (set-buffer (get-buffer-create mh-index-temp-buffer)) |
| 800 | (erase-buffer) | 578 | (erase-buffer) |
| 801 | (call-process mh-glimpse-binary nil '(t nil) nil | 579 | (call-process mh-glimpse-binary nil '(t nil) nil |
| 802 | ;(format "-%s" fuzz) | 580 | ;(format "-%s" fuzz) |
| 803 | "-i" "-y" | 581 | "-i" "-y" |
| 804 | "-H" (format "%s%s" mh-user-path mh-glimpse-directory) | 582 | "-H" (format "%s%s" mh-user-path mh-glimpse-directory) |
| 805 | "-F" (format "^%s" folder-path) | 583 | "-F" (format "^%s" folder-path) |
| 806 | search-regexp) | 584 | search-regexp) |
| 807 | (goto-char (point-min))) | 585 | (goto-char (point-min))) |
| @@ -812,32 +590,32 @@ Parse it and return the message folder, message index and the match. If no | |||
| 812 | other matches left then return nil. If the current record is invalid return | 590 | other matches left then return nil. If the current record is invalid return |
| 813 | 'error." | 591 | 'error." |
| 814 | (prog1 | 592 | (prog1 |
| 815 | (block nil | 593 | (block nil |
| 816 | (when (eobp) | 594 | (when (eobp) |
| 817 | (return nil)) | 595 | (return nil)) |
| 818 | (let ((eol-pos (line-end-position)) | 596 | (let ((eol-pos (line-end-position)) |
| 819 | (bol-pos (line-beginning-position)) | 597 | (bol-pos (line-beginning-position)) |
| 820 | folder-start msg-end) | 598 | folder-start msg-end) |
| 821 | (goto-char bol-pos) | 599 | (goto-char bol-pos) |
| 822 | (unless (search-forward mh-user-path eol-pos t) | 600 | (unless (search-forward mh-user-path eol-pos t) |
| 823 | (return 'error)) | ||
| 824 | (setq folder-start (point)) | ||
| 825 | (unless (search-forward ": " eol-pos t) | ||
| 826 | (return 'error)) | ||
| 827 | (let ((match (buffer-substring-no-properties (point) eol-pos))) | ||
| 828 | (forward-char -2) | ||
| 829 | (setq msg-end (point)) | ||
| 830 | (unless (search-backward "/" folder-start t) | ||
| 831 | (return 'error)) | 601 | (return 'error)) |
| 832 | (list (format "+%s" (buffer-substring-no-properties | 602 | (setq folder-start (point)) |
| 833 | folder-start (point))) | 603 | (unless (search-forward ": " eol-pos t) |
| 834 | (let ((val (ignore-errors (read-from-string | 604 | (return 'error)) |
| 835 | (buffer-substring-no-properties | 605 | (let ((match (buffer-substring-no-properties (point) eol-pos))) |
| 836 | (1+ (point)) msg-end))))) | 606 | (forward-char -2) |
| 837 | (if (and (consp val) (integerp (car val))) | 607 | (setq msg-end (point)) |
| 838 | (car val) | 608 | (unless (search-backward "/" folder-start t) |
| 839 | (return 'error))) | 609 | (return 'error)) |
| 840 | match)))) | 610 | (list (format "+%s" (buffer-substring-no-properties |
| 611 | folder-start (point))) | ||
| 612 | (let ((val (ignore-errors (read-from-string | ||
| 613 | (buffer-substring-no-properties | ||
| 614 | (1+ (point)) msg-end))))) | ||
| 615 | (if (and (consp val) (integerp (car val))) | ||
| 616 | (car val) | ||
| 617 | (return 'error))) | ||
| 618 | match)))) | ||
| 841 | (forward-line))) | 619 | (forward-line))) |
| 842 | 620 | ||
| 843 | 621 | ||
| @@ -861,32 +639,32 @@ Parse it and return the message folder, message index and the match. If no | |||
| 861 | other matches left then return nil. If the current record is invalid return | 639 | other matches left then return nil. If the current record is invalid return |
| 862 | 'error." | 640 | 'error." |
| 863 | (prog1 | 641 | (prog1 |
| 864 | (block nil | 642 | (block nil |
| 865 | (when (eobp) | 643 | (when (eobp) |
| 866 | (return nil)) | 644 | (return nil)) |
| 867 | (let ((eol-pos (line-end-position)) | 645 | (let ((eol-pos (line-end-position)) |
| 868 | (bol-pos (line-beginning-position)) | 646 | (bol-pos (line-beginning-position)) |
| 869 | folder-start msg-end) | 647 | folder-start msg-end) |
| 870 | (goto-char bol-pos) | 648 | (goto-char bol-pos) |
| 871 | (unless (search-forward mh-user-path eol-pos t) | 649 | (unless (search-forward mh-user-path eol-pos t) |
| 872 | (return 'error)) | ||
| 873 | (setq folder-start (point)) | ||
| 874 | (unless (search-forward ":" eol-pos t) | ||
| 875 | (return 'error)) | ||
| 876 | (let ((match (buffer-substring-no-properties (point) eol-pos))) | ||
| 877 | (forward-char -1) | ||
| 878 | (setq msg-end (point)) | ||
| 879 | (unless (search-backward "/" folder-start t) | ||
| 880 | (return 'error)) | 650 | (return 'error)) |
| 881 | (list (format "+%s" (buffer-substring-no-properties | 651 | (setq folder-start (point)) |
| 882 | folder-start (point))) | 652 | (unless (search-forward ":" eol-pos t) |
| 883 | (let ((val (ignore-errors (read-from-string | 653 | (return 'error)) |
| 884 | (buffer-substring-no-properties | 654 | (let ((match (buffer-substring-no-properties (point) eol-pos))) |
| 885 | (1+ (point)) msg-end))))) | 655 | (forward-char -1) |
| 886 | (if (and (consp val) (integerp (car val))) | 656 | (setq msg-end (point)) |
| 887 | (car val) | 657 | (unless (search-backward "/" folder-start t) |
| 888 | (return 'error))) | 658 | (return 'error)) |
| 889 | match)))) | 659 | (list (format "+%s" (buffer-substring-no-properties |
| 660 | folder-start (point))) | ||
| 661 | (let ((val (ignore-errors (read-from-string | ||
| 662 | (buffer-substring-no-properties | ||
| 663 | (1+ (point)) msg-end))))) | ||
| 664 | (if (and (consp val) (integerp (car val))) | ||
| 665 | (car val) | ||
| 666 | (return 'error))) | ||
| 667 | match)))) | ||
| 890 | (forward-line))) | 668 | (forward-line))) |
| 891 | 669 | ||
| 892 | 670 | ||
| @@ -897,6 +675,7 @@ other matches left then return nil. If the current record is invalid return | |||
| 897 | (defvar mh-swish-directory ".swish") | 675 | (defvar mh-swish-directory ".swish") |
| 898 | (defvar mh-swish-folder nil) | 676 | (defvar mh-swish-folder nil) |
| 899 | 677 | ||
| 678 | ;;;###mh-autoload | ||
| 900 | (defun mh-swish-execute-search (folder-path search-regexp) | 679 | (defun mh-swish-execute-search (folder-path search-regexp) |
| 901 | "Execute swish-e and read the results. | 680 | "Execute swish-e and read the results. |
| 902 | 681 | ||
| @@ -923,6 +702,7 @@ First create the directory /home/user/Mail/.swish. Then create the file | |||
| 923 | IgnoreLimit 50 1000 | 702 | IgnoreLimit 50 1000 |
| 924 | IndexComments 0 | 703 | IndexComments 0 |
| 925 | FileRules pathname contains /home/user/Mail/.swish | 704 | FileRules pathname contains /home/user/Mail/.swish |
| 705 | FileRules pathname contains /home/user/Mail/mhe-index | ||
| 926 | FileRules filename is index | 706 | FileRules filename is index |
| 927 | FileRules filename is \..* | 707 | FileRules filename is \..* |
| 928 | FileRules filename is #.* | 708 | FileRules filename is #.* |
| @@ -934,6 +714,11 @@ following to config: | |||
| 934 | 714 | ||
| 935 | FileRules pathname contains /home/user/Mail/scripts | 715 | FileRules pathname contains /home/user/Mail/scripts |
| 936 | 716 | ||
| 717 | You do not want to index the folders that hold the results of your searches | ||
| 718 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 719 | The configuration file above assumes that the results are found in sub-folders | ||
| 720 | of `mh-index-folder' which is +mhe-index by default. | ||
| 721 | |||
| 937 | Use the following command line to generate the swish index. Run this | 722 | Use the following command line to generate the swish index. Run this |
| 938 | daily from cron: | 723 | daily from cron: |
| 939 | 724 | ||
| @@ -991,9 +776,10 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | |||
| 991 | ;; Swish++ interface | 776 | ;; Swish++ interface |
| 992 | 777 | ||
| 993 | (defvar mh-swish++-binary (or (executable-find "search++") | 778 | (defvar mh-swish++-binary (or (executable-find "search++") |
| 994 | (executable-find "search"))) | 779 | (executable-find "search"))) |
| 995 | (defvar mh-swish++-directory ".swish++") | 780 | (defvar mh-swish++-directory ".swish++") |
| 996 | 781 | ||
| 782 | ;;;###mh-autoload | ||
| 997 | (defun mh-swish++-execute-search (folder-path search-regexp) | 783 | (defun mh-swish++-execute-search (folder-path search-regexp) |
| 998 | "Execute swish++ and read the results. | 784 | "Execute swish++ and read the results. |
| 999 | 785 | ||
| @@ -1003,15 +789,24 @@ directory. | |||
| 1003 | First create the directory /home/user/Mail/.swish++. Then create the file | 789 | First create the directory /home/user/Mail/.swish++. Then create the file |
| 1004 | /home/user/Mail/.swish++/swish++.conf with the following contents: | 790 | /home/user/Mail/.swish++/swish++.conf with the following contents: |
| 1005 | 791 | ||
| 1006 | IncludeMeta Bcc Cc Comments Content-Description From Keywords | 792 | IncludeMeta Bcc Cc Comments Content-Description From Keywords |
| 1007 | IncludeMeta Newsgroups Resent-To Subject To | 793 | IncludeMeta Newsgroups Resent-To Subject To |
| 1008 | IncludeFile Mail [0-9]* | 794 | IncludeMeta Message-Id References In-Reply-To |
| 1009 | IndexFile /home/user/Mail/.swish++/swish++.index | 795 | IncludeFile Mail * |
| 796 | IndexFile /home/user/Mail/.swish++/swish++.index | ||
| 1010 | 797 | ||
| 1011 | Use the following command line to generate the swish index. Run this | 798 | Use the following command line to generate the swish index. Run this |
| 1012 | daily from cron: | 799 | daily from cron: |
| 1013 | 800 | ||
| 1014 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail | 801 | find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\ |
| 802 | -o -path /home/user/Mail/.swish++ -prune \\ | ||
| 803 | -o -name \"[0-9]*\" -print \\ | ||
| 804 | | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail | ||
| 805 | |||
| 806 | You do not want to index the folders that hold the results of your searches | ||
| 807 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 808 | The command above assumes that the results are found in sub-folders of | ||
| 809 | `mh-index-folder' which is +mhe-index by default. | ||
| 1015 | 810 | ||
| 1016 | On some systems (Debian GNU/Linux, for example), use index++ instead of index. | 811 | On some systems (Debian GNU/Linux, for example), use index++ instead of index. |
| 1017 | 812 | ||
| @@ -1042,6 +837,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | |||
| 1042 | (defvar mh-namazu-directory ".namazu") | 837 | (defvar mh-namazu-directory ".namazu") |
| 1043 | (defvar mh-namazu-folder nil) | 838 | (defvar mh-namazu-folder nil) |
| 1044 | 839 | ||
| 840 | ;;;###mh-autoload | ||
| 1045 | (defun mh-namazu-execute-search (folder-path search-regexp) | 841 | (defun mh-namazu-execute-search (folder-path search-regexp) |
| 1046 | "Execute namazu and read the results. | 842 | "Execute namazu and read the results. |
| 1047 | 843 | ||
| @@ -1054,6 +850,15 @@ First create the directory /home/user/Mail/.namazu. Then create the file | |||
| 1054 | package conf; # Don't remove this line! | 850 | package conf; # Don't remove this line! |
| 1055 | $ADDRESS = 'user@localhost'; | 851 | $ADDRESS = 'user@localhost'; |
| 1056 | $ALLOW_FILE = \"[0-9]*\"; | 852 | $ALLOW_FILE = \"[0-9]*\"; |
| 853 | $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\"; | ||
| 854 | |||
| 855 | In the above example configuration, none of the mail files contained in the | ||
| 856 | directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed. | ||
| 857 | |||
| 858 | You do not want to index the folders that hold the results of your searches | ||
| 859 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 860 | The configuration file above assumes that the results are found in sub-folders | ||
| 861 | of `mh-index-folder' which is +mhe-index by default. | ||
| 1057 | 862 | ||
| 1058 | Use the following command line to generate the namazu index. Run this | 863 | Use the following command line to generate the namazu index. Run this |
| 1059 | daily from cron: | 864 | daily from cron: |
| @@ -1063,7 +868,7 @@ daily from cron: | |||
| 1063 | 868 | ||
| 1064 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | 869 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." |
| 1065 | (let ((namazu-index-directory | 870 | (let ((namazu-index-directory |
| 1066 | (format "%s%s" mh-user-path mh-namazu-directory))) | 871 | (format "%s%s" mh-user-path mh-namazu-directory))) |
| 1067 | (unless (file-exists-p namazu-index-directory) | 872 | (unless (file-exists-p namazu-index-directory) |
| 1068 | (error "Namazu directory %s not present" namazu-index-directory)) | 873 | (error "Namazu directory %s not present" namazu-index-directory)) |
| 1069 | (unless (executable-find mh-namazu-binary) | 874 | (unless (executable-find mh-namazu-binary) |
| @@ -1092,7 +897,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | |||
| 1092 | (return 'error)) | 897 | (return 'error)) |
| 1093 | (string-match mh-user-path file-name) | 898 | (string-match mh-user-path file-name) |
| 1094 | (let* ((folder/msg (substring file-name (match-end 0))) | 899 | (let* ((folder/msg (substring file-name (match-end 0))) |
| 1095 | (mark (search "/" folder/msg :from-end t))) | 900 | (mark (mh-search-from-end ?/ folder/msg))) |
| 1096 | (unless mark (return 'error)) | 901 | (unless mark (return 'error)) |
| 1097 | (list (format "+%s" (substring folder/msg 0 mark)) | 902 | (list (format "+%s" (substring folder/msg 0 mark)) |
| 1098 | (let ((n (ignore-errors (read-from-string | 903 | (let ((n (ignore-errors (read-from-string |
| @@ -1117,7 +922,7 @@ system." | |||
| 1117 | ;; through the list. | 922 | ;; through the list. |
| 1118 | (let ((program-alist (cond (mh-index-program | 923 | (let ((program-alist (cond (mh-index-program |
| 1119 | (list | 924 | (list |
| 1120 | (assoc mh-index-program mh-indexer-choices))) | 925 | (assoc mh-index-program mh-indexer-choices))) |
| 1121 | (mh-indexer | 926 | (mh-indexer |
| 1122 | (list (assoc mh-indexer mh-indexer-choices))) | 927 | (list (assoc mh-indexer mh-indexer-choices))) |
| 1123 | (t mh-indexer-choices)))) | 928 | (t mh-indexer-choices)))) |
| @@ -1133,157 +938,10 @@ system." | |||
| 1133 | 938 | ||
| 1134 | 939 | ||
| 1135 | 940 | ||
| 1136 | ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) | ||
| 1137 | ;;; Menus for folder mode: folder, message (in that order) | ||
| 1138 | ;;; folder-mode "Message" menu | ||
| 1139 | (easy-menu-define | ||
| 1140 | mh-index-folder-message-menu mh-index-folder-mode-keymap | ||
| 1141 | "Menu for MH-E folder-message." | ||
| 1142 | '("Message" | ||
| 1143 | ["Show Message" mh-index-show (mh-get-msg-num nil)] | ||
| 1144 | ["Show Message with Header" mh-index-header-display (mh-get-msg-num nil)] | ||
| 1145 | ["Next Message" mh-index-next t] | ||
| 1146 | ["Previous Message" mh-index-prev t] | ||
| 1147 | "--" | ||
| 1148 | ["Compose a New Message" mh-send t])) | ||
| 1149 | |||
| 1150 | ;;; folder-mode "Folder" menu | ||
| 1151 | (easy-menu-define | ||
| 1152 | mh-index-folder-folder-menu mh-index-folder-mode-keymap | ||
| 1153 | "Menu for MH-E folder." | ||
| 1154 | '("Folder" | ||
| 1155 | ["Incorporate New Mail" mh-inc-folder t] | ||
| 1156 | "--" | ||
| 1157 | ["Visit a Folder..." mh-visit-folder t] | ||
| 1158 | ["Indexed Search..." mh-index-search-again t] | ||
| 1159 | "--" | ||
| 1160 | ["Quit Indexed Search" mh-index-quit t])) | ||
| 1161 | |||
| 1162 | |||
| 1163 | |||
| 1164 | ;;; Support for emacs21 toolbar using gnus/message.el icons (and code). | ||
| 1165 | (eval-when-compile (defvar tool-bar-map)) | ||
| 1166 | (defvar mh-index-folder-tool-bar-map nil) | ||
| 1167 | (when (fboundp 'tool-bar-add-item) | ||
| 1168 | (setq mh-index-folder-tool-bar-map | ||
| 1169 | (let ((tool-bar-map (make-sparse-keymap))) | ||
| 1170 | (tool-bar-add-item "mail" 'mh-inc-folder | ||
| 1171 | 'mh-indexfoldertoolbar-inc-folder | ||
| 1172 | :help "Incorporate new mail in Inbox") | ||
| 1173 | (tool-bar-add-item "left_arrow" 'mh-index-prev | ||
| 1174 | 'mh-indexfoldertoolbar-prev :help "Previous message") | ||
| 1175 | (tool-bar-add-item "page-down" 'mh-index-page-msg | ||
| 1176 | 'mh-indexfoldertoolbar-page | ||
| 1177 | :help "Page this message") | ||
| 1178 | (tool-bar-add-item "right_arrow" 'mh-index-next | ||
| 1179 | 'mh-indexfoldertoolbar-next :help "Next message") | ||
| 1180 | |||
| 1181 | (tool-bar-add-item "mail_compose" 'mh-send 'mh-indexfoldertoolbar-compose | ||
| 1182 | :help "Compose new message") | ||
| 1183 | |||
| 1184 | (tool-bar-add-item "search" | ||
| 1185 | (lambda (&optional arg) | ||
| 1186 | (interactive "P") | ||
| 1187 | (call-interactively mh-tool-bar-search-function)) | ||
| 1188 | 'mh-indexfoldertoolbar-search :help "Search") | ||
| 1189 | (tool-bar-add-item "fld_open" 'mh-visit-folder | ||
| 1190 | 'mh-indexfoldertoolbar-visit | ||
| 1191 | :help "Visit other folder") | ||
| 1192 | |||
| 1193 | (tool-bar-add-item "preferences" (lambda () | ||
| 1194 | (interactive) | ||
| 1195 | (customize-group "mh")) | ||
| 1196 | 'mh-indexfoldertoolbar-customize | ||
| 1197 | :help "MH-E preferences") | ||
| 1198 | (tool-bar-add-item "help" (lambda () | ||
| 1199 | (interactive) | ||
| 1200 | (Info-goto-node "(mh-e)Top")) | ||
| 1201 | 'mh-indexfoldertoolbar-help :help "Help") | ||
| 1202 | tool-bar-map))) | ||
| 1203 | |||
| 1204 | ;; Modes for mh-index | ||
| 1205 | (define-derived-mode mh-index-folder-mode mh-folder-mode "MH-Index-Folder" | ||
| 1206 | "Major MH-E mode for displaying the results of searching.\\<mh-index-folder-mode-keymap> | ||
| 1207 | |||
| 1208 | You can display the message the cursor is pointing to and step through the | ||
| 1209 | messages. | ||
| 1210 | |||
| 1211 | You can also jump to the folders narrowed to the search results by pressing | ||
| 1212 | RET on the folder name. Many operations, such as replying to a message, | ||
| 1213 | require that you do this first. | ||
| 1214 | |||
| 1215 | \\{mh-index-folder-mode-keymap}" | ||
| 1216 | (make-local-variable 'font-lock-defaults) | ||
| 1217 | (setq font-lock-defaults '(mh-index-font-lock-keywords t)) | ||
| 1218 | (use-local-map mh-index-folder-mode-keymap) | ||
| 1219 | (make-local-variable 'mh-help-messages) | ||
| 1220 | (easy-menu-add mh-index-folder-message-menu) | ||
| 1221 | (easy-menu-add mh-index-folder-folder-menu) | ||
| 1222 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) | ||
| 1223 | (set (make-local-variable 'tool-bar-map) mh-index-folder-tool-bar-map)) | ||
| 1224 | (setq mh-help-messages mh-index-folder-mode-help-messages)) | ||
| 1225 | |||
| 1226 | (define-derived-mode mh-index-show-mode mh-show-mode "MH-Index-Show" | ||
| 1227 | "Major mode for showing messages in MH-E index.\\<mh-index-folder-mode-keymap> | ||
| 1228 | \\{mh-index-folder-mode-keymap}" | ||
| 1229 | (use-local-map mh-index-folder-mode-keymap) | ||
| 1230 | (setq mh-help-messages mh-index-folder-mode-help-messages)) | ||
| 1231 | |||
| 1232 | ;; Font lock support for mh-index-folder. This is the same as mh-folder | ||
| 1233 | ;; except that the folder line needs to be recognized and highlighted. | ||
| 1234 | (defvar mh-index-folder-face 'mh-index-folder-face | ||
| 1235 | "Face for highlighting folders in MH-Index buffers.") | ||
| 1236 | (defface mh-index-folder-face | ||
| 1237 | '((((class color) (background light)) | ||
| 1238 | (:foreground "dark green")) | ||
| 1239 | (((class color) (background dark)) | ||
| 1240 | (:foreground "indian red")) | ||
| 1241 | (t | ||
| 1242 | (:bold t))) | ||
| 1243 | "Face for highlighting folders in MH-Index buffers." | ||
| 1244 | :group 'mh) | ||
| 1245 | |||
| 1246 | (eval-after-load "font-lock" | ||
| 1247 | '(progn | ||
| 1248 | (defvar mh-index-folder-face 'mh-index-folder-face | ||
| 1249 | "Face for highlighting folders in MH-Index buffers.") | ||
| 1250 | |||
| 1251 | (defvar mh-index-font-lock-keywords | ||
| 1252 | (list | ||
| 1253 | ;; Folder name | ||
| 1254 | (list "^\\+.*" '(0 mh-index-folder-face)) | ||
| 1255 | ;; Marked for deletion | ||
| 1256 | (list (concat mh-scan-deleted-msg-regexp ".*") | ||
| 1257 | '(0 mh-folder-deleted-face)) | ||
| 1258 | ;; Marked for refile | ||
| 1259 | (list (concat mh-scan-refiled-msg-regexp ".*") | ||
| 1260 | '(0 mh-folder-refiled-face)) | ||
| 1261 | ;;after subj | ||
| 1262 | (list mh-scan-body-regexp '(1 mh-folder-body-face nil t)) | ||
| 1263 | '(mh-folder-font-lock-subject | ||
| 1264 | (1 mh-folder-followup-face append t) | ||
| 1265 | (2 mh-folder-subject-face append t)) | ||
| 1266 | ;;current msg | ||
| 1267 | (list mh-scan-cur-msg-number-regexp | ||
| 1268 | '(1 mh-folder-cur-msg-number-face)) | ||
| 1269 | (list mh-scan-good-msg-regexp | ||
| 1270 | '(1 mh-folder-msg-number-face)) ;; Msg number | ||
| 1271 | (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date | ||
| 1272 | (list mh-scan-rcpt-regexp | ||
| 1273 | '(1 mh-folder-to-face) ;; To: | ||
| 1274 | '(2 mh-folder-address-face)) ;; address | ||
| 1275 | ;; scan font-lock name | ||
| 1276 | (list mh-scan-format-regexp | ||
| 1277 | '(1 mh-folder-date-face) | ||
| 1278 | '(3 mh-folder-scan-format-face)) | ||
| 1279 | ;; Current message line | ||
| 1280 | (list mh-scan-cur-msg-regexp | ||
| 1281 | '(1 mh-folder-cur-msg-face prepend t))) | ||
| 1282 | "Regexp keywords used to fontify the MH-Index-Folder buffer."))) | ||
| 1283 | |||
| 1284 | (provide 'mh-index) | 941 | (provide 'mh-index) |
| 1285 | 942 | ||
| 1286 | ;;; Local Variables: | 943 | ;;; Local Variables: |
| 944 | ;;; indent-tabs-mode: nil | ||
| 1287 | ;;; sentence-end-double-space: nil | 945 | ;;; sentence-end-double-space: nil |
| 1288 | ;;; End: | 946 | ;;; End: |
| 1289 | 947 | ||
diff --git a/lisp/mail/mh-loaddefs.el b/lisp/mail/mh-loaddefs.el new file mode 100644 index 00000000000..20cfb8571bd --- /dev/null +++ b/lisp/mail/mh-loaddefs.el | |||
| @@ -0,0 +1,880 @@ | |||
| 1 | ;;; mh-loaddefs.el --- automatically extracted autoloads | ||
| 2 | ;; | ||
| 3 | ;;; Commentary: | ||
| 4 | ;;; Code: | ||
| 5 | |||
| 6 | ;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft | ||
| 7 | ;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom | ||
| 8 | ;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function | ||
| 9 | ;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward | ||
| 10 | ;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el" | ||
| 11 | ;;;;;; (15899 19356)) | ||
| 12 | ;;; Generated autoloads from mh-comp.el | ||
| 13 | |||
| 14 | (autoload (quote mh-edit-again) "mh-comp" "\ | ||
| 15 | Clean up a draft or a message MSG previously sent and make it resendable. | ||
| 16 | Default is the current message. | ||
| 17 | The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. | ||
| 18 | See also documentation for `\\[mh-send]' function." t nil) | ||
| 19 | |||
| 20 | (autoload (quote mh-extract-rejected-mail) "mh-comp" "\ | ||
| 21 | Extract message MSG returned by the mail system and make it resendable. | ||
| 22 | Default is the current message. The variable `mh-new-draft-cleaned-headers' | ||
| 23 | gives the headers to clean out of the original message. | ||
| 24 | See also documentation for `\\[mh-send]' function." t nil) | ||
| 25 | |||
| 26 | (autoload (quote mh-forward) "mh-comp" "\ | ||
| 27 | Forward one or more messages to the recipients TO and CC. | ||
| 28 | |||
| 29 | Use the optional MSG-OR-SEQ to specify a message or sequence to forward. | ||
| 30 | |||
| 31 | Default is the displayed message. If optional prefix argument is given then | ||
| 32 | prompt for the message sequence. If variable `transient-mark-mode' is non-nil | ||
| 33 | and the mark is active, then the selected region is forwarded. | ||
| 34 | See also documentation for `\\[mh-send]' function." t nil) | ||
| 35 | |||
| 36 | (autoload (quote mh-redistribute) "mh-comp" "\ | ||
| 37 | Redistribute displayed message to recipients TO and CC. | ||
| 38 | Use optional argument MSG to redistribute another message. | ||
| 39 | Depending on how your copy of MH was compiled, you may need to change the | ||
| 40 | setting of the variable `mh-redist-full-contents'. See its documentation." t nil) | ||
| 41 | |||
| 42 | (autoload (quote mh-reply) "mh-comp" "\ | ||
| 43 | Reply to MESSAGE (default: current message). | ||
| 44 | If the optional argument REPLY-TO is not given, prompts for type of addresses | ||
| 45 | to reply to: | ||
| 46 | from sender only, | ||
| 47 | to sender and primary recipients, | ||
| 48 | cc/all sender and all recipients. | ||
| 49 | If optional prefix argument INCLUDEP provided, then include the message | ||
| 50 | in the reply using filter `mhl.reply' in your MH directory. | ||
| 51 | If the file named by `mh-repl-formfile' exists, it is used as a skeleton | ||
| 52 | for the reply. See also documentation for `\\[mh-send]' function." t nil) | ||
| 53 | |||
| 54 | (autoload (quote mh-send) "mh-comp" "\ | ||
| 55 | Compose and send a letter. | ||
| 56 | |||
| 57 | Do not call this function from outside MH-E; use \\[mh-smail] instead. | ||
| 58 | |||
| 59 | The file named by `mh-comp-formfile' will be used as the form. | ||
| 60 | The letter is composed in `mh-letter-mode'; see its documentation for more | ||
| 61 | details. | ||
| 62 | If `mh-compose-letter-function' is defined, it is called on the draft and | ||
| 63 | passed three arguments: TO, CC, and SUBJECT." t nil) | ||
| 64 | |||
| 65 | (autoload (quote mh-send-other-window) "mh-comp" "\ | ||
| 66 | Compose and send a letter in another window. | ||
| 67 | |||
| 68 | Do not call this function from outside MH-E; use \\[mh-smail-other-window] | ||
| 69 | instead. | ||
| 70 | |||
| 71 | The file named by `mh-comp-formfile' will be used as the form. | ||
| 72 | The letter is composed in `mh-letter-mode'; see its documentation for more | ||
| 73 | details. | ||
| 74 | If `mh-compose-letter-function' is defined, it is called on the draft and | ||
| 75 | passed three arguments: TO, CC, and SUBJECT." t nil) | ||
| 76 | |||
| 77 | (autoload (quote mh-fill-paragraph-function) "mh-comp" "\ | ||
| 78 | Fill paragraph at or after point. | ||
| 79 | Prefix ARG means justify as well. This function enables `fill-paragraph' to | ||
| 80 | work better in MH-Letter mode." t nil) | ||
| 81 | |||
| 82 | (autoload (quote mh-to-field) "mh-comp" "\ | ||
| 83 | Move point to the end of a specified header field. | ||
| 84 | The field is indicated by the previous keystroke (the last keystroke | ||
| 85 | of the command) according to the list in the variable `mh-to-field-choices'. | ||
| 86 | Create the field if it does not exist. Set the mark to point before moving." t nil) | ||
| 87 | |||
| 88 | (autoload (quote mh-to-fcc) "mh-comp" "\ | ||
| 89 | Insert an Fcc: FOLDER field in the current message. | ||
| 90 | Prompt for the field name with a completion list of the current folders." t nil) | ||
| 91 | |||
| 92 | (autoload (quote mh-insert-signature) "mh-comp" "\ | ||
| 93 | Insert the file named by `mh-signature-file-name' at point. | ||
| 94 | The value of `mh-letter-insert-signature-hook' is a list of functions to be | ||
| 95 | called, with no arguments, before the signature is actually inserted." t nil) | ||
| 96 | |||
| 97 | (autoload (quote mh-check-whom) "mh-comp" "\ | ||
| 98 | Verify recipients of the current letter, showing expansion of any aliases." t nil) | ||
| 99 | |||
| 100 | (autoload (quote mh-send-letter) "mh-comp" "\ | ||
| 101 | Send the draft letter in the current buffer. | ||
| 102 | If optional prefix argument ARG is provided, monitor delivery. | ||
| 103 | The value of `mh-before-send-letter-hook' is a list of functions to be called, | ||
| 104 | with no arguments, before doing anything. | ||
| 105 | Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set. | ||
| 106 | Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set. | ||
| 107 | Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. | ||
| 108 | Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil) | ||
| 109 | |||
| 110 | (autoload (quote mh-insert-letter) "mh-comp" "\ | ||
| 111 | Insert a message into the current letter. | ||
| 112 | Removes the header fields according to the variable `mh-invisible-headers'. | ||
| 113 | Prefixes each non-blank line with `mh-ins-buf-prefix', unless | ||
| 114 | `mh-yank-from-start-of-msg' is set for supercite in which case supercite is | ||
| 115 | used to format the message. | ||
| 116 | Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do | ||
| 117 | not indent and do not delete headers. Leaves the mark before the letter | ||
| 118 | and point after it." t nil) | ||
| 119 | |||
| 120 | (autoload (quote mh-yank-cur-msg) "mh-comp" "\ | ||
| 121 | Insert the current message into the draft buffer. | ||
| 122 | Prefix each non-blank line in the message with the string in | ||
| 123 | `mh-ins-buf-prefix'. If a region is set in the message's buffer, then | ||
| 124 | only the region will be inserted. Otherwise, the entire message will | ||
| 125 | be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable | ||
| 126 | is nil, the portion of the message following the point will be yanked. | ||
| 127 | If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the | ||
| 128 | yanked message will be deleted." t nil) | ||
| 129 | |||
| 130 | (autoload (quote mh-fully-kill-draft) "mh-comp" "\ | ||
| 131 | Kill the draft message file and the draft message buffer. | ||
| 132 | Use \\[kill-buffer] if you don't want to delete the draft message file." t nil) | ||
| 133 | |||
| 134 | (autoload (quote mh-open-line) "mh-comp" "\ | ||
| 135 | Insert a newline and leave point after it. | ||
| 136 | In addition, insert newline and quoting characters before text after point. | ||
| 137 | This is useful in breaking up paragraphs in replies." t nil) | ||
| 138 | |||
| 139 | (autoload (quote mh-letter-complete) "mh-comp" "\ | ||
| 140 | Perform completion on header field or word preceding point. | ||
| 141 | Alias completion is done within the mail header on selected fields and | ||
| 142 | by the function designated by `mh-letter-complete-function' elsewhere, | ||
| 143 | passing the prefix ARG if any." t nil) | ||
| 144 | |||
| 145 | ;;;*** | ||
| 146 | |||
| 147 | ;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set | ||
| 148 | ;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15899 29873)) | ||
| 149 | ;;; Generated autoloads from mh-customize.el | ||
| 150 | |||
| 151 | (autoload (quote mh-customize) "mh-customize" "\ | ||
| 152 | Customize MH-E variables." t nil) | ||
| 153 | |||
| 154 | (autoload (quote mh-tool-bar-letter-set) "mh-customize" "\ | ||
| 155 | Construct toolbar for `mh-letter-mode'." nil nil) | ||
| 156 | |||
| 157 | (autoload (quote mh-tool-bar-folder-set) "mh-customize" "\ | ||
| 158 | Construct toolbar for `mh-folder-mode'." nil nil) | ||
| 159 | |||
| 160 | ;;;*** | ||
| 161 | |||
| 162 | ;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p) | ||
| 163 | ;;;;;; "mh-e" "mh-e.el" (15899 29921)) | ||
| 164 | ;;; Generated autoloads from mh-e.el | ||
| 165 | |||
| 166 | (autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\ | ||
| 167 | Return t if the message under point in folder-mode is in the show buffer. | ||
| 168 | Return nil in any other circumstance (no message under point, no show buffer, | ||
| 169 | the message in the show buffer doesn't match." nil nil) | ||
| 170 | |||
| 171 | (autoload (quote mh-update-sequences) "mh-e" "\ | ||
| 172 | Update MH's Unseen-Sequence and current folder and message. | ||
| 173 | Flush MH-E's state out to MH. The message at the cursor becomes current." t nil) | ||
| 174 | |||
| 175 | (autoload (quote mh-goto-cur-msg) "mh-e" "\ | ||
| 176 | Position the cursor at the current message. | ||
| 177 | When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't | ||
| 178 | recenter the folder buffer." nil nil) | ||
| 179 | |||
| 180 | ;;;*** | ||
| 181 | |||
| 182 | ;;;### (autoloads (mh-prefix-help mh-help mh-store-buffer mh-store-msg | ||
| 183 | ;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards | ||
| 184 | ;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders | ||
| 185 | ;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el" | ||
| 186 | ;;;;;; (15886 19303)) | ||
| 187 | ;;; Generated autoloads from mh-funcs.el | ||
| 188 | |||
| 189 | (autoload (quote mh-burst-digest) "mh-funcs" "\ | ||
| 190 | Burst apart the current message, which should be a digest. | ||
| 191 | The message is replaced by its table of contents and the messages from the | ||
| 192 | digest are inserted into the folder after that message." t nil) | ||
| 193 | |||
| 194 | (autoload (quote mh-copy-msg) "mh-funcs" "\ | ||
| 195 | Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. | ||
| 196 | Default is the displayed message. If optional prefix argument is provided, | ||
| 197 | then prompt for the message sequence." t nil) | ||
| 198 | |||
| 199 | (autoload (quote mh-kill-folder) "mh-funcs" "\ | ||
| 200 | Remove the current folder and all included messages. | ||
| 201 | Removes all of the messages (files) within the specified current folder, | ||
| 202 | and then removes the folder (directory) itself. | ||
| 203 | The value of `mh-folder-list-change-hook' is a list of functions to be called, | ||
| 204 | with no arguments, after the folders has been removed." t nil) | ||
| 205 | |||
| 206 | (autoload (quote mh-list-folders) "mh-funcs" "\ | ||
| 207 | List mail folders." t nil) | ||
| 208 | |||
| 209 | (autoload (quote mh-pack-folder) "mh-funcs" "\ | ||
| 210 | Renumber the messages of a folder to be 1..n. | ||
| 211 | First, offer to execute any outstanding commands for the current folder. If | ||
| 212 | optional prefix argument provided, prompt for the RANGE of messages to display | ||
| 213 | after packing. Otherwise, show the entire folder." t nil) | ||
| 214 | |||
| 215 | (autoload (quote mh-pipe-msg) "mh-funcs" "\ | ||
| 216 | Pipe the current message through the given shell COMMAND. | ||
| 217 | If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. | ||
| 218 | Otherwise just send the message's body without the headers." t nil) | ||
| 219 | |||
| 220 | (autoload (quote mh-page-digest) "mh-funcs" "\ | ||
| 221 | Advance displayed message to next digested message." t nil) | ||
| 222 | |||
| 223 | (autoload (quote mh-page-digest-backwards) "mh-funcs" "\ | ||
| 224 | Back up displayed message to previous digested message." t nil) | ||
| 225 | |||
| 226 | (autoload (quote mh-print-msg) "mh-funcs" "\ | ||
| 227 | Print MSG-OR-SEQ (default: displayed message) on printer. | ||
| 228 | If optional prefix argument provided, then prompt for the message sequence. | ||
| 229 | The variable `mh-lpr-command-format' is used to generate the print command. | ||
| 230 | The messages are formatted by mhl. See the variable `mhl-formfile'." t nil) | ||
| 231 | |||
| 232 | (autoload (quote mh-sort-folder) "mh-funcs" "\ | ||
| 233 | Sort the messages in the current folder by date. | ||
| 234 | Calls the MH program sortm to do the work. | ||
| 235 | The arguments in the list `mh-sortm-args' are passed to sortm if the optional | ||
| 236 | argument EXTRA-ARGS is given." t nil) | ||
| 237 | |||
| 238 | (autoload (quote mh-undo-folder) "mh-funcs" "\ | ||
| 239 | Undo all pending deletes and refiles in current folder. | ||
| 240 | Argument IGNORE is deprecated." t nil) | ||
| 241 | |||
| 242 | (autoload (quote mh-store-msg) "mh-funcs" "\ | ||
| 243 | Store the file(s) contained in the current message into DIRECTORY. | ||
| 244 | The message can contain a shar file or uuencoded file. | ||
| 245 | Default directory is the last directory used, or initially the value of | ||
| 246 | `mh-store-default-directory' or the current directory." t nil) | ||
| 247 | |||
| 248 | (autoload (quote mh-store-buffer) "mh-funcs" "\ | ||
| 249 | Store the file(s) contained in the current buffer into DIRECTORY. | ||
| 250 | The buffer can contain a shar file or uuencoded file. | ||
| 251 | Default directory is the last directory used, or initially the value of | ||
| 252 | `mh-store-default-directory' or the current directory." t nil) | ||
| 253 | |||
| 254 | (autoload (quote mh-help) "mh-funcs" "\ | ||
| 255 | Display cheat sheet for the MH-Folder commands in minibuffer." t nil) | ||
| 256 | |||
| 257 | (autoload (quote mh-prefix-help) "mh-funcs" "\ | ||
| 258 | Display cheat sheet for the commands of the current prefix in minibuffer." t nil) | ||
| 259 | |||
| 260 | ;;;*** | ||
| 261 | |||
| 262 | ;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu) | ||
| 263 | ;;;;;; "mh-identity" "mh-identity.el" (15852 60439)) | ||
| 264 | ;;; Generated autoloads from mh-identity.el | ||
| 265 | |||
| 266 | (autoload (quote mh-identity-make-menu) "mh-identity" "\ | ||
| 267 | Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil) | ||
| 268 | |||
| 269 | (autoload (quote mh-identity-list-set) "mh-identity" "\ | ||
| 270 | Update the `mh-identity-list' variable, and rebuild the menu. | ||
| 271 | Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in | ||
| 272 | customization). This is called after 'customize is used to alter | ||
| 273 | `mh-identity-list'." nil nil) | ||
| 274 | |||
| 275 | (autoload (quote mh-insert-identity) "mh-identity" "\ | ||
| 276 | Insert proper fields for given IDENTITY. | ||
| 277 | Edit the `mh-identity-list' variable to define identity." t nil) | ||
| 278 | |||
| 279 | ;;;*** | ||
| 280 | |||
| 281 | ;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search | ||
| 282 | ;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands | ||
| 283 | ;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers | ||
| 284 | ;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-search | ||
| 285 | ;;;;;; mh-index-update-maps) "mh-index" "mh-index.el" (15899 19358)) | ||
| 286 | ;;; Generated autoloads from mh-index.el | ||
| 287 | |||
| 288 | (autoload (quote mh-index-update-maps) "mh-index" "\ | ||
| 289 | Annotate all as yet unannotated messages in FOLDER with their MD5 hash. | ||
| 290 | As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP | ||
| 291 | is a hashtable which maps each message in the index folder to the original | ||
| 292 | folder and message from whence it was copied. If present the | ||
| 293 | checksum -> (origin-folder, origin-index) map is updated too." nil nil) | ||
| 294 | |||
| 295 | (autoload (quote mh-index-search) "mh-index" "\ | ||
| 296 | Perform an indexed search in an MH mail folder. | ||
| 297 | |||
| 298 | If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a | ||
| 299 | index search, then the search is repeated. Otherwise, FOLDER is searched with | ||
| 300 | SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is | ||
| 301 | \"+\" then mail in all folders are searched. | ||
| 302 | |||
| 303 | Four indexing programs are supported; if none of these are present, then grep | ||
| 304 | is used. This function picks the first program that is available on your | ||
| 305 | system. If you would prefer to use a different program, set the customization | ||
| 306 | variable `mh-index-program' accordingly. | ||
| 307 | |||
| 308 | The documentation for the following functions describes how to generate the | ||
| 309 | index for each program: | ||
| 310 | |||
| 311 | - `mh-swish++-execute-search' | ||
| 312 | - `mh-swish-execute-search' | ||
| 313 | - `mh-namazu-execute-search' | ||
| 314 | - `mh-glimpse-execute-search' | ||
| 315 | |||
| 316 | This and related functions use an X-MHE-Checksum header to cache the MD5 | ||
| 317 | checksum of a message. This means that already present X-MHE-Checksum headers | ||
| 318 | in the incoming email could result in messages not being found. The following | ||
| 319 | procmail recipe should avoid this: | ||
| 320 | |||
| 321 | :0 wf | ||
| 322 | | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\" | ||
| 323 | |||
| 324 | This has the effect of renaming already present X-MHE-Checksum headers." t nil) | ||
| 325 | |||
| 326 | (autoload (quote mh-index-next-folder) "mh-index" "\ | ||
| 327 | Jump to the next folder marker. | ||
| 328 | The function is only applicable to folders displaying index search results. | ||
| 329 | With non-nil optional argument BACKWARD-FLAG, jump to the previous group of | ||
| 330 | results." t nil) | ||
| 331 | |||
| 332 | (autoload (quote mh-index-previous-folder) "mh-index" "\ | ||
| 333 | Jump to the previous folder marker." t nil) | ||
| 334 | |||
| 335 | (autoload (quote mh-index-insert-folder-headers) "mh-index" "\ | ||
| 336 | Annotate the search results with original folder names." nil nil) | ||
| 337 | |||
| 338 | (autoload (quote mh-index-delete-folder-headers) "mh-index" "\ | ||
| 339 | Delete the folder headers." nil nil) | ||
| 340 | |||
| 341 | (autoload (quote mh-index-visit-folder) "mh-index" "\ | ||
| 342 | Visit original folder from where the message at point was found." t nil) | ||
| 343 | |||
| 344 | (autoload (quote mh-index-execute-commands) "mh-index" "\ | ||
| 345 | Delete/refile the actual messages. | ||
| 346 | The copies in the searched folder are then deleted/refiled to get the desired | ||
| 347 | result. Before deleting the messages we make sure that the message being | ||
| 348 | deleted is identical to the one that the user has marked in the index buffer." nil nil) | ||
| 349 | |||
| 350 | (autoload (quote mh-glimpse-execute-search) "mh-index" "\ | ||
| 351 | Execute glimpse and read the results. | ||
| 352 | |||
| 353 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 354 | directory. | ||
| 355 | |||
| 356 | First create the directory /home/user/Mail/.glimpse. Then create the file | ||
| 357 | /home/user/Mail/.glimpse/.glimpse_exclude with the following contents: | ||
| 358 | |||
| 359 | */.* | ||
| 360 | */#* | ||
| 361 | */,* | ||
| 362 | */*~ | ||
| 363 | ^/home/user/Mail/.glimpse | ||
| 364 | ^/home/user/Mail/mhe-index | ||
| 365 | |||
| 366 | If there are any directories you would like to ignore, append lines like the | ||
| 367 | following to .glimpse_exclude: | ||
| 368 | |||
| 369 | ^/home/user/Mail/scripts | ||
| 370 | |||
| 371 | You do not want to index the folders that hold the results of your searches | ||
| 372 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 373 | The configuration file above assumes that the results are found in sub-folders | ||
| 374 | of `mh-index-folder' which is +mhe-index by default. | ||
| 375 | |||
| 376 | Use the following command line to generate the glimpse index. Run this | ||
| 377 | daily from cron: | ||
| 378 | |||
| 379 | glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail | ||
| 380 | |||
| 381 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil) | ||
| 382 | |||
| 383 | (autoload (quote mh-swish-execute-search) "mh-index" "\ | ||
| 384 | Execute swish-e and read the results. | ||
| 385 | |||
| 386 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 387 | directory. | ||
| 388 | |||
| 389 | First create the directory /home/user/Mail/.swish. Then create the file | ||
| 390 | /home/user/Mail/.swish/config with the following contents: | ||
| 391 | |||
| 392 | IndexDir /home/user/Mail | ||
| 393 | IndexFile /home/user/Mail/.swish/index | ||
| 394 | IndexName \"Mail Index\" | ||
| 395 | IndexDescription \"Mail Index\" | ||
| 396 | IndexPointer \"http://nowhere\" | ||
| 397 | IndexAdmin \"nobody\" | ||
| 398 | #MetaNames automatic | ||
| 399 | IndexReport 3 | ||
| 400 | FollowSymLinks no | ||
| 401 | UseStemming no | ||
| 402 | IgnoreTotalWordCountWhenRanking yes | ||
| 403 | WordCharacters abcdefghijklmnopqrstuvwxyz0123456789- | ||
| 404 | BeginCharacters abcdefghijklmnopqrstuvwxyz | ||
| 405 | EndCharacters abcdefghijklmnopqrstuvwxyz0123456789 | ||
| 406 | IgnoreLimit 50 1000 | ||
| 407 | IndexComments 0 | ||
| 408 | FileRules pathname contains /home/user/Mail/.swish | ||
| 409 | FileRules pathname contains /home/user/Mail/mhe-index | ||
| 410 | FileRules filename is index | ||
| 411 | FileRules filename is ..* | ||
| 412 | FileRules filename is #.* | ||
| 413 | FileRules filename is ,.* | ||
| 414 | FileRules filename is .*~ | ||
| 415 | |||
| 416 | If there are any directories you would like to ignore, append lines like the | ||
| 417 | following to config: | ||
| 418 | |||
| 419 | FileRules pathname contains /home/user/Mail/scripts | ||
| 420 | |||
| 421 | You do not want to index the folders that hold the results of your searches | ||
| 422 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 423 | The configuration file above assumes that the results are found in sub-folders | ||
| 424 | of `mh-index-folder' which is +mhe-index by default. | ||
| 425 | |||
| 426 | Use the following command line to generate the swish index. Run this | ||
| 427 | daily from cron: | ||
| 428 | |||
| 429 | swish-e -c /home/user/Mail/.swish/config | ||
| 430 | |||
| 431 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil) | ||
| 432 | |||
| 433 | (autoload (quote mh-swish++-execute-search) "mh-index" "\ | ||
| 434 | Execute swish++ and read the results. | ||
| 435 | |||
| 436 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 437 | directory. | ||
| 438 | |||
| 439 | First create the directory /home/user/Mail/.swish++. Then create the file | ||
| 440 | /home/user/Mail/.swish++/swish++.conf with the following contents: | ||
| 441 | |||
| 442 | IncludeMeta Bcc Cc Comments Content-Description From Keywords | ||
| 443 | IncludeMeta Newsgroups Resent-To Subject To | ||
| 444 | IncludeMeta Message-Id References In-Reply-To | ||
| 445 | IncludeFile Mail * | ||
| 446 | IndexFile /home/user/Mail/.swish++/swish++.index | ||
| 447 | |||
| 448 | Use the following command line to generate the swish index. Run this | ||
| 449 | daily from cron: | ||
| 450 | |||
| 451 | find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\ | ||
| 452 | -o -path /home/user/Mail/.swish++ -prune \\ | ||
| 453 | -o -name \"[0-9]*\" -print \\ | ||
| 454 | | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail | ||
| 455 | |||
| 456 | You do not want to index the folders that hold the results of your searches | ||
| 457 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 458 | The command above assumes that the results are found in sub-folders of | ||
| 459 | `mh-index-folder' which is +mhe-index by default. | ||
| 460 | |||
| 461 | On some systems (Debian GNU/Linux, for example), use index++ instead of index. | ||
| 462 | |||
| 463 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil) | ||
| 464 | |||
| 465 | (autoload (quote mh-namazu-execute-search) "mh-index" "\ | ||
| 466 | Execute namazu and read the results. | ||
| 467 | |||
| 468 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 469 | directory. | ||
| 470 | |||
| 471 | First create the directory /home/user/Mail/.namazu. Then create the file | ||
| 472 | /home/user/Mail/.namazu/mknmzrc with the following contents: | ||
| 473 | |||
| 474 | package conf; # Don't remove this line! | ||
| 475 | $ADDRESS = 'user@localhost'; | ||
| 476 | $ALLOW_FILE = \"[0-9]*\"; | ||
| 477 | $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\"; | ||
| 478 | |||
| 479 | In the above example configuration, none of the mail files contained in the | ||
| 480 | directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed. | ||
| 481 | |||
| 482 | You do not want to index the folders that hold the results of your searches | ||
| 483 | since they tend to be ephemeral and the original messages are indexed anyway. | ||
| 484 | The configuration file above assumes that the results are found in sub-folders | ||
| 485 | of `mh-index-folder' which is +mhe-index by default. | ||
| 486 | |||
| 487 | Use the following command line to generate the namazu index. Run this | ||
| 488 | daily from cron: | ||
| 489 | |||
| 490 | mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\ | ||
| 491 | /home/user/Mail | ||
| 492 | |||
| 493 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil) | ||
| 494 | |||
| 495 | ;;;*** | ||
| 496 | |||
| 497 | ;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button | ||
| 498 | ;;;;;; mh-press-button mh-mime-display mh-mime-save-parts mh-display-emphasis | ||
| 499 | ;;;;;; mh-display-smileys mh-add-missing-mime-version-header mh-destroy-postponed-handles | ||
| 500 | ;;;;;; mh-mime-cleanup mh-mml-secure-message-encrypt-pgpmime mh-mml-secure-message-sign-pgpmime | ||
| 501 | ;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime | ||
| 502 | ;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar | ||
| 503 | ;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward | ||
| 504 | ;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15858 6046)) | ||
| 505 | ;;; Generated autoloads from mh-mime.el | ||
| 506 | |||
| 507 | (autoload (quote mh-compose-insertion) "mh-mime" "\ | ||
| 508 | Add a directive to insert a MIME part from a file, using mhn or gnus. | ||
| 509 | If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. | ||
| 510 | If it is set to 'gnus, then that will be used instead. | ||
| 511 | Optional argument INLINE means make it an inline attachment." t nil) | ||
| 512 | |||
| 513 | (autoload (quote mh-compose-forward) "mh-mime" "\ | ||
| 514 | Add a MIME directive to forward a message, using mhn or gnus. | ||
| 515 | If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. | ||
| 516 | If it is set to 'gnus, then that will be used instead. | ||
| 517 | Optional argument DESCRIPTION is a description of the attachment. | ||
| 518 | Optional argument FOLDER is the folder from which the forwarded message should | ||
| 519 | come. | ||
| 520 | Optional argument MESSAGE is the message to forward. | ||
| 521 | If any of the optional arguments are absent, they are prompted for." t nil) | ||
| 522 | |||
| 523 | (autoload (quote mh-mhn-compose-insertion) "mh-mime" "\ | ||
| 524 | Add a directive to insert a MIME message part from a file. | ||
| 525 | This is the typical way to insert non-text parts in a message. | ||
| 526 | |||
| 527 | Arguments are FILENAME, which tells where to find the file, TYPE, the MIME | ||
| 528 | content type, DESCRIPTION, a line of text for the Content-Description field. | ||
| 529 | ATTRIBUTES is a comma separated list of name=value pairs that is appended to | ||
| 530 | the Content-Type field of the attachment. | ||
| 531 | |||
| 532 | See also \\[mh-edit-mhn]." t nil) | ||
| 533 | |||
| 534 | (autoload (quote mh-mhn-compose-anon-ftp) "mh-mime" "\ | ||
| 535 | Add a directive for a MIME anonymous ftp external body part. | ||
| 536 | This directive tells MH to include a reference to a message/external-body part | ||
| 537 | retrievable by anonymous FTP. | ||
| 538 | |||
| 539 | Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the | ||
| 540 | MIME content type, and DESCRIPTION, a line of text for the Content-description | ||
| 541 | header. | ||
| 542 | |||
| 543 | See also \\[mh-edit-mhn]." t nil) | ||
| 544 | |||
| 545 | (autoload (quote mh-mhn-compose-external-compressed-tar) "mh-mime" "\ | ||
| 546 | Add a directive to include a MIME reference to a compressed tar file. | ||
| 547 | The file should be available via anonymous ftp. This directive tells MH to | ||
| 548 | include a reference to a message/external-body part. | ||
| 549 | |||
| 550 | Arguments are HOST and FILENAME, which tell where to find the file, and | ||
| 551 | DESCRIPTION, a line of text for the Content-description header. | ||
| 552 | |||
| 553 | See also \\[mh-edit-mhn]." t nil) | ||
| 554 | |||
| 555 | (autoload (quote mh-mhn-compose-forw) "mh-mime" "\ | ||
| 556 | Add a forw directive to this message, to forward a message with MIME. | ||
| 557 | This directive tells MH to include the named messages in this one. | ||
| 558 | |||
| 559 | Arguments are DESCRIPTION, a line of text for the Content-description header, | ||
| 560 | and FOLDER and MESSAGES, which name the message(s) to be forwarded. | ||
| 561 | |||
| 562 | See also \\[mh-edit-mhn]." t nil) | ||
| 563 | |||
| 564 | (autoload (quote mh-edit-mhn) "mh-mime" "\ | ||
| 565 | Format the current draft for MIME, expanding any mhn directives. | ||
| 566 | |||
| 567 | Process the current draft with the mhn program, which, using directives | ||
| 568 | already inserted in the draft, fills in all the MIME components and header | ||
| 569 | fields. | ||
| 570 | |||
| 571 | This step should be done last just before sending the message. | ||
| 572 | |||
| 573 | The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the | ||
| 574 | list `mh-mhn-args' are passed to mhn if this function is passed an optional | ||
| 575 | prefix argument EXTRA-ARGS. | ||
| 576 | |||
| 577 | For assistance with creating mhn directives to insert various types of | ||
| 578 | components in a message, see \\[mh-mhn-compose-insertion] (generic insertion | ||
| 579 | from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via | ||
| 580 | anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] (reference to | ||
| 581 | compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward | ||
| 582 | message). If these helper functions are used, `mh-edit-mhn' is run | ||
| 583 | automatically when the draft is sent. | ||
| 584 | |||
| 585 | The value of `mh-edit-mhn-hook' is a list of functions to be called, with no | ||
| 586 | arguments, after performing the conversion. | ||
| 587 | |||
| 588 | The mhn program is part of MH version 6.8 or later." t nil) | ||
| 589 | |||
| 590 | (autoload (quote mh-revert-mhn-edit) "mh-mime" "\ | ||
| 591 | Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. | ||
| 592 | Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil) | ||
| 593 | |||
| 594 | (autoload (quote mh-mml-to-mime) "mh-mime" "\ | ||
| 595 | Compose MIME message from mml directives." t nil) | ||
| 596 | |||
| 597 | (autoload (quote mh-mml-forward-message) "mh-mime" "\ | ||
| 598 | Forward a message as attachment. | ||
| 599 | The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE | ||
| 600 | number." nil nil) | ||
| 601 | |||
| 602 | (autoload (quote mh-mml-attach-file) "mh-mime" "\ | ||
| 603 | Attach a file to the outgoing MIME message. | ||
| 604 | The file is not inserted or encoded until you send the message with | ||
| 605 | `\\[mh-send-letter]'. | ||
| 606 | Message disposition is \"inline\" or \"attachment\" and is prompted for if | ||
| 607 | DISPOSITION is nil. | ||
| 608 | |||
| 609 | This is basically `mml-attach-file' from gnus, modified such that a prefix | ||
| 610 | argument yields an `inline' disposition and Content-Type is determined | ||
| 611 | automatically." nil nil) | ||
| 612 | |||
| 613 | (autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\ | ||
| 614 | Add directive to encrypt/sign the entire message." t nil) | ||
| 615 | |||
| 616 | (autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\ | ||
| 617 | Add directive to encrypt and sign the entire message. | ||
| 618 | If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil) | ||
| 619 | |||
| 620 | (autoload (quote mh-mime-cleanup) "mh-mime" "\ | ||
| 621 | Free the decoded MIME parts." nil nil) | ||
| 622 | |||
| 623 | (autoload (quote mh-destroy-postponed-handles) "mh-mime" "\ | ||
| 624 | Free MIME data for externally displayed mime parts." nil nil) | ||
| 625 | |||
| 626 | (autoload (quote mh-add-missing-mime-version-header) "mh-mime" "\ | ||
| 627 | Some mail programs don't put a MIME-Version header. | ||
| 628 | I have seen this only in spam, so maybe we shouldn't fix this ;-)" nil nil) | ||
| 629 | |||
| 630 | (autoload (quote mh-display-smileys) "mh-mime" "\ | ||
| 631 | Function to display smileys." nil nil) | ||
| 632 | |||
| 633 | (autoload (quote mh-display-emphasis) "mh-mime" "\ | ||
| 634 | Function to display graphical emphasis." nil nil) | ||
| 635 | |||
| 636 | (autoload (quote mh-mime-save-parts) "mh-mime" "\ | ||
| 637 | Store the MIME parts of the current message. | ||
| 638 | If ARG, prompt for directory, else use that specified by the variable | ||
| 639 | `mh-mime-save-parts-default-directory'. These directories may be superseded by | ||
| 640 | mh_profile directives, since this function calls on mhstore or mhn to do the | ||
| 641 | actual storing." t nil) | ||
| 642 | |||
| 643 | (autoload (quote mh-mime-display) "mh-mime" "\ | ||
| 644 | Display (and possibly decode) MIME handles. | ||
| 645 | Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If | ||
| 646 | present they are displayed otherwise the buffer is parsed and then | ||
| 647 | displayed." nil nil) | ||
| 648 | |||
| 649 | (autoload (quote mh-press-button) "mh-mime" "\ | ||
| 650 | Press MIME button. | ||
| 651 | If the MIME part is visible then it is removed. Otherwise the part is | ||
| 652 | displayed." t nil) | ||
| 653 | |||
| 654 | (autoload (quote mh-push-button) "mh-mime" "\ | ||
| 655 | Click MIME button for EVENT. | ||
| 656 | If the MIME part is visible then it is removed. Otherwise the part is | ||
| 657 | displayed. This function is called when the mouse is used to click the MIME | ||
| 658 | button." t nil) | ||
| 659 | |||
| 660 | (autoload (quote mh-mime-save-part) "mh-mime" "\ | ||
| 661 | Save MIME part at point." t nil) | ||
| 662 | |||
| 663 | (autoload (quote mh-mime-inline-part) "mh-mime" "\ | ||
| 664 | Toggle display of the raw MIME part." t nil) | ||
| 665 | |||
| 666 | ;;;*** | ||
| 667 | |||
| 668 | ;;;### (autoloads (mh-do-pick-search mh-search-folder) "mh-pick" | ||
| 669 | ;;;;;; "mh-pick.el" (15854 20166)) | ||
| 670 | ;;; Generated autoloads from mh-pick.el | ||
| 671 | |||
| 672 | (autoload (quote mh-search-folder) "mh-pick" "\ | ||
| 673 | Search FOLDER for messages matching a pattern. | ||
| 674 | This function uses the MH command `pick' to do the work. | ||
| 675 | Add the messages found to the sequence named `search'." t nil) | ||
| 676 | |||
| 677 | (autoload (quote mh-do-pick-search) "mh-pick" "\ | ||
| 678 | Find messages that match the qualifications in the current pattern buffer. | ||
| 679 | Messages are searched for in the folder named in `mh-searching-folder'. | ||
| 680 | Add the messages found to the sequence named `search'." t nil) | ||
| 681 | |||
| 682 | ;;;*** | ||
| 683 | |||
| 684 | ;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor | ||
| 685 | ;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message | ||
| 686 | ;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread | ||
| 687 | ;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list | ||
| 688 | ;;;;;; mh-add-to-sequence mh-notate-seq mh-map-to-seq-msgs mh-rename-seq | ||
| 689 | ;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq | ||
| 690 | ;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (15899 | ||
| 691 | ;;;;;; 19358)) | ||
| 692 | ;;; Generated autoloads from mh-seq.el | ||
| 693 | |||
| 694 | (autoload (quote mh-delete-seq) "mh-seq" "\ | ||
| 695 | Delete the SEQUENCE." t nil) | ||
| 696 | |||
| 697 | (autoload (quote mh-list-sequences) "mh-seq" "\ | ||
| 698 | List the sequences defined in the folder being visited." t nil) | ||
| 699 | |||
| 700 | (autoload (quote mh-msg-is-in-seq) "mh-seq" "\ | ||
| 701 | Display the sequences that contain MESSAGE (default: current message)." t nil) | ||
| 702 | |||
| 703 | (autoload (quote mh-narrow-to-seq) "mh-seq" "\ | ||
| 704 | Restrict display of this folder to just messages in SEQUENCE. | ||
| 705 | Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) | ||
| 706 | |||
| 707 | (autoload (quote mh-put-msg-in-seq) "mh-seq" "\ | ||
| 708 | Add MSG-OR-SEQ (default: displayed message) to SEQUENCE. | ||
| 709 | If optional prefix argument provided, then prompt for the message sequence. | ||
| 710 | If variable `transient-mark-mode' is non-nil and the mark is active, then | ||
| 711 | the selected region is added to the sequence." t nil) | ||
| 712 | |||
| 713 | (autoload (quote mh-widen) "mh-seq" "\ | ||
| 714 | Remove restrictions from current folder, thereby showing all messages." t nil) | ||
| 715 | |||
| 716 | (autoload (quote mh-rename-seq) "mh-seq" "\ | ||
| 717 | Rename SEQUENCE to have NEW-NAME." t nil) | ||
| 718 | |||
| 719 | (autoload (quote mh-map-to-seq-msgs) "mh-seq" "\ | ||
| 720 | Invoke the FUNC at each message in the SEQ. | ||
| 721 | SEQ can either be a list of messages or a MH sequence. The remaining ARGS are | ||
| 722 | passed as arguments to FUNC." nil nil) | ||
| 723 | |||
| 724 | (autoload (quote mh-notate-seq) "mh-seq" "\ | ||
| 725 | Mark the scan listing. | ||
| 726 | All messages in SEQ are marked with NOTATION at OFFSET from the beginning of | ||
| 727 | the line." nil nil) | ||
| 728 | |||
| 729 | (autoload (quote mh-add-to-sequence) "mh-seq" "\ | ||
| 730 | The sequence SEQ is augmented with the messages in MSGS." nil nil) | ||
| 731 | |||
| 732 | (autoload (quote mh-region-to-msg-list) "mh-seq" "\ | ||
| 733 | Return a list of messages within the region between BEGIN and END." nil nil) | ||
| 734 | |||
| 735 | (autoload (quote mh-narrow-to-subject) "mh-seq" "\ | ||
| 736 | Narrow to a sequence containing all following messages with same subject." t nil) | ||
| 737 | |||
| 738 | (autoload (quote mh-delete-subject) "mh-seq" "\ | ||
| 739 | Mark all following messages with same subject to be deleted. | ||
| 740 | This puts the messages in a sequence named subject. You can undo the last | ||
| 741 | deletion marks using `mh-undo' with a prefix argument and then specifying the | ||
| 742 | subject sequence." t nil) | ||
| 743 | |||
| 744 | (autoload (quote mh-delete-subject-or-thread) "mh-seq" "\ | ||
| 745 | Mark messages for deletion intelligently. | ||
| 746 | If the folder is threaded then `mh-thread-delete' is used to mark the current | ||
| 747 | message and all its descendants for deletion. Otherwise `mh-delete-subject' is | ||
| 748 | used to mark the current message and all messages following it with the same | ||
| 749 | subject for deletion." t nil) | ||
| 750 | |||
| 751 | (autoload (quote mh-thread-inc) "mh-seq" "\ | ||
| 752 | Update thread tree for FOLDER. | ||
| 753 | All messages after START-POINT are added to the thread tree." nil nil) | ||
| 754 | |||
| 755 | (autoload (quote mh-thread-add-spaces) "mh-seq" "\ | ||
| 756 | Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil) | ||
| 757 | |||
| 758 | (autoload (quote mh-toggle-threads) "mh-seq" "\ | ||
| 759 | Toggle threaded view of folder. | ||
| 760 | The conversion of normal view to threaded view is exact, that is the same | ||
| 761 | messages are displayed in the folder buffer before and after threading. However | ||
| 762 | the conversion from threaded view to normal view is inexact. So more messages | ||
| 763 | than were originally present may be shown as a result." t nil) | ||
| 764 | |||
| 765 | (autoload (quote mh-thread-forget-message) "mh-seq" "\ | ||
| 766 | Forget the message INDEX from the threading tables." nil nil) | ||
| 767 | |||
| 768 | (autoload (quote mh-thread-next-sibling) "mh-seq" "\ | ||
| 769 | Jump to next sibling. | ||
| 770 | With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." t nil) | ||
| 771 | |||
| 772 | (autoload (quote mh-thread-previous-sibling) "mh-seq" "\ | ||
| 773 | Jump to previous sibling." t nil) | ||
| 774 | |||
| 775 | (autoload (quote mh-thread-ancestor) "mh-seq" "\ | ||
| 776 | Jump to the ancestor of current message. | ||
| 777 | If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the | ||
| 778 | thread tree the message belongs to." t nil) | ||
| 779 | |||
| 780 | (autoload (quote mh-thread-delete) "mh-seq" "\ | ||
| 781 | Mark current message and all its children for subsequent deletion." t nil) | ||
| 782 | |||
| 783 | (autoload (quote mh-thread-refile) "mh-seq" "\ | ||
| 784 | Mark current message and all its children for refiling to FOLDER." t nil) | ||
| 785 | |||
| 786 | ;;;*** | ||
| 787 | |||
| 788 | ;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists | ||
| 789 | ;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons) | ||
| 790 | ;;;;;; "mh-speed" "mh-speed.el" (15899 19358)) | ||
| 791 | ;;; Generated autoloads from mh-speed.el | ||
| 792 | |||
| 793 | (autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\ | ||
| 794 | Interface function to create MH-E speedbar buffer. | ||
| 795 | BUFFER is the MH-E buffer for which the speedbar buffer is to be created." nil nil) | ||
| 796 | |||
| 797 | (defalias (quote mh-show-speedbar-buttons) (quote mh-folder-speedbar-buttons)) | ||
| 798 | |||
| 799 | (defalias (quote mh-letter-speedbar-buttons) (quote mh-folder-speedbar-buttons)) | ||
| 800 | |||
| 801 | (autoload (quote mh-speed-toggle) "mh-speed" "\ | ||
| 802 | Toggle the display of child folders. | ||
| 803 | The otional ARGS are ignored and there for compatibilty with speedbar." t nil) | ||
| 804 | |||
| 805 | (autoload (quote mh-speed-view) "mh-speed" "\ | ||
| 806 | View folder on current line. | ||
| 807 | Optional ARGS are ignored." t nil) | ||
| 808 | |||
| 809 | (autoload (quote mh-speed-flists) "mh-speed" "\ | ||
| 810 | Execute flists -recurse and update message counts. | ||
| 811 | If FORCE is non-nil the timer is reset." t nil) | ||
| 812 | |||
| 813 | (autoload (quote mh-speed-invalidate-map) "mh-speed" "\ | ||
| 814 | Remove FOLDER from various optimization caches." t nil) | ||
| 815 | |||
| 816 | (autoload (quote mh-speed-add-folder) "mh-speed" "\ | ||
| 817 | Add FOLDER since it is being created. | ||
| 818 | The function invalidates the latest ancestor that is present." nil nil) | ||
| 819 | |||
| 820 | ;;;*** | ||
| 821 | |||
| 822 | ;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point) | ||
| 823 | ;;;;;; "mh-utils" "mh-utils.el" (15899 28827)) | ||
| 824 | ;;; Generated autoloads from mh-utils.el | ||
| 825 | |||
| 826 | (autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\ | ||
| 827 | Find e-mail address around or before point. | ||
| 828 | Then search backwards to beginning of line for the start of an e-mail | ||
| 829 | address. If no e-mail address found, return nil." nil nil) | ||
| 830 | |||
| 831 | (autoload (quote mh-get-msg-num) "mh-utils" "\ | ||
| 832 | Return the message number of the displayed message. | ||
| 833 | If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is | ||
| 834 | not pointing to a message." nil nil) | ||
| 835 | |||
| 836 | ;;;*** | ||
| 837 | |||
| 838 | ;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field | ||
| 839 | ;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-letter-expand-alias | ||
| 840 | ;;;;;; mh-alias-minibuffer-confirm-address mh-read-address mh-alias-reload) | ||
| 841 | ;;;;;; "mh-alias" "mh-alias.el" (15899 29102)) | ||
| 842 | ;;; Generated autoloads from mh-alias.el | ||
| 843 | |||
| 844 | (autoload (quote mh-alias-reload) "mh-alias" "\ | ||
| 845 | Load MH aliases into `mh-alias-alist'." t nil) | ||
| 846 | |||
| 847 | (autoload (quote mh-read-address) "mh-alias" "\ | ||
| 848 | Read an address from the minibuffer with PROMPT." nil nil) | ||
| 849 | |||
| 850 | (autoload (quote mh-alias-minibuffer-confirm-address) "mh-alias" "\ | ||
| 851 | Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." t nil) | ||
| 852 | |||
| 853 | (autoload (quote mh-alias-letter-expand-alias) "mh-alias" "\ | ||
| 854 | Expand mail alias before point." nil nil) | ||
| 855 | |||
| 856 | (autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\ | ||
| 857 | Return t is From has no current alias set." nil nil) | ||
| 858 | |||
| 859 | (autoload (quote mh-alias-add-alias) "mh-alias" "\ | ||
| 860 | *Add ALIAS for ADDRESS in personal alias file. | ||
| 861 | Prompts for confirmation if the address already has an alias. | ||
| 862 | If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil) | ||
| 863 | |||
| 864 | (autoload (quote mh-alias-grab-from-field) "mh-alias" "\ | ||
| 865 | *Add ALIAS for ADDRESS in personal alias file. | ||
| 866 | Prompts for confirmation if the alias is already in use or if the address | ||
| 867 | already has an alias." t nil) | ||
| 868 | |||
| 869 | (autoload (quote mh-alias-add-address-under-point) "mh-alias" "\ | ||
| 870 | Insert an alias for email address under point." t nil) | ||
| 871 | |||
| 872 | ;;;*** | ||
| 873 | |||
| 874 | (provide 'mh-loaddefs) | ||
| 875 | ;;; Local Variables: | ||
| 876 | ;;; version-control: never | ||
| 877 | ;;; no-byte-compile: t | ||
| 878 | ;;; no-update-autoloads: t | ||
| 879 | ;;; End: | ||
| 880 | ;;; mh-loaddefs.el ends here | ||
diff --git a/lisp/mail/mh-mime.el b/lisp/mail/mh-mime.el index bd70c371549..594b63eee9b 100644 --- a/lisp/mail/mh-mime.el +++ b/lisp/mail/mh-mime.el | |||
| @@ -32,17 +32,17 @@ | |||
| 32 | 32 | ||
| 33 | ;;; Change Log: | 33 | ;;; Change Log: |
| 34 | 34 | ||
| 35 | ;; $Id: mh-mime.el,v 1.90 2002/11/22 20:00:48 satyaki Exp $ | 35 | ;; $Id: mh-mime.el,v 1.98 2002/12/06 03:33:47 satyaki Exp $ |
| 36 | 36 | ||
| 37 | ;;; Code: | 37 | ;;; Code: |
| 38 | 38 | ||
| 39 | (require 'cl) | 39 | (require 'cl) |
| 40 | (require 'mh-comp) | 40 | (require 'mh-comp) |
| 41 | (require 'mh-utils) | 41 | (require 'mh-utils) |
| 42 | (load "mm-decode" t t) ; Non-fatal dependency | 42 | (load "mm-decode" t t) ; Non-fatal dependency |
| 43 | (load "mm-uu" t t) ; Non-fatal dependency | 43 | (load "mm-uu" t t) ; Non-fatal dependency |
| 44 | (load "mailcap" t t) ; Non-fatal dependency | 44 | (load "mailcap" t t) ; Non-fatal dependency |
| 45 | (load "smiley" t t) ; Non-fatal dependency | 45 | (load "smiley" t t) ; Non-fatal dependency |
| 46 | (require 'gnus-util) | 46 | (require 'gnus-util) |
| 47 | 47 | ||
| 48 | (autoload 'gnus-article-goto-header "gnus-art") | 48 | (autoload 'gnus-article-goto-header "gnus-art") |
| @@ -59,29 +59,7 @@ | |||
| 59 | (autoload 'mml-to-mime "mml") | 59 | (autoload 'mml-to-mime "mml") |
| 60 | (autoload 'mml-attach-file "mml") | 60 | (autoload 'mml-attach-file "mml") |
| 61 | 61 | ||
| 62 | ;;; Hooks | 62 | ;;;###mh-autoload |
| 63 | (defcustom mh-edit-mhn-hook nil | ||
| 64 | "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]." | ||
| 65 | :type 'hook | ||
| 66 | :group 'mh-hook) | ||
| 67 | |||
| 68 | ;; Keeps assorted MIME data | ||
| 69 | (defstruct (mh-buffer-data (:conc-name mh-mime-) | ||
| 70 | (:constructor mh-make-buffer-data)) | ||
| 71 | ;; Structure to keep track of MIME handles on a per buffer basis. | ||
| 72 | (handles ()) ; List of MIME handles | ||
| 73 | (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of | ||
| 74 | ; nested messages | ||
| 75 | (parts-count 0) ; The button number is generated from | ||
| 76 | ; this number | ||
| 77 | (part-index-hash (make-hash-table))) ; Avoid incrementing the part number | ||
| 78 | ; for nested messages | ||
| 79 | |||
| 80 | ;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...) | ||
| 81 | (defmacro mh-buffer-data () | ||
| 82 | "Convenience macro to get the MIME data structures of the current buffer." | ||
| 83 | `(gethash (current-buffer) mh-globals-hash)) | ||
| 84 | |||
| 85 | (defun mh-compose-insertion (&optional inline) | 63 | (defun mh-compose-insertion (&optional inline) |
| 86 | "Add a directive to insert a MIME part from a file, using mhn or gnus. | 64 | "Add a directive to insert a MIME part from a file, using mhn or gnus. |
| 87 | If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. | 65 | If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. |
| @@ -94,6 +72,7 @@ Optional argument INLINE means make it an inline attachment." | |||
| 94 | (mh-mml-attach-file)) | 72 | (mh-mml-attach-file)) |
| 95 | (call-interactively 'mh-mhn-compose-insertion))) | 73 | (call-interactively 'mh-mhn-compose-insertion))) |
| 96 | 74 | ||
| 75 | ;;;###mh-autoload | ||
| 97 | (defun mh-compose-forward (&optional description folder message) | 76 | (defun mh-compose-forward (&optional description folder message) |
| 98 | "Add a MIME directive to forward a message, using mhn or gnus. | 77 | "Add a MIME directive to forward a message, using mhn or gnus. |
| 99 | If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. | 78 | If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. |
| @@ -104,12 +83,12 @@ come. | |||
| 104 | Optional argument MESSAGE is the message to forward. | 83 | Optional argument MESSAGE is the message to forward. |
| 105 | If any of the optional arguments are absent, they are prompted for." | 84 | If any of the optional arguments are absent, they are prompted for." |
| 106 | (interactive (list | 85 | (interactive (list |
| 107 | (read-string "Forw Content-description: ") | 86 | (read-string "Forw Content-description: ") |
| 108 | (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) | 87 | (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
| 109 | (read-string (format "Messages%s: " | 88 | (read-string (format "Messages%s: " |
| 110 | (if mh-sent-from-msg | 89 | (if mh-sent-from-msg |
| 111 | (format " [%d]" mh-sent-from-msg) | 90 | (format " [%d]" mh-sent-from-msg) |
| 112 | ""))))) | 91 | ""))))) |
| 113 | (if (equal mh-compose-insertion 'gnus) | 92 | (if (equal mh-compose-insertion 'gnus) |
| 114 | (mh-mml-forward-message description folder message) | 93 | (mh-mml-forward-message description folder message) |
| 115 | (mh-mhn-compose-forw description folder message))) | 94 | (mh-mhn-compose-forw description folder message))) |
| @@ -117,7 +96,7 @@ If any of the optional arguments are absent, they are prompted for." | |||
| 117 | ;; To do: | 96 | ;; To do: |
| 118 | ;; paragraph code should not fill # lines if MIME enabled. | 97 | ;; paragraph code should not fill # lines if MIME enabled. |
| 119 | ;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter] | 98 | ;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter] |
| 120 | ;; invokes mh-edit-mhn automatically before sending.) | 99 | ;; invokes mh-edit-mhn automatically before sending.) |
| 121 | ;; actually, instead of mh-auto-edit-mhn, | 100 | ;; actually, instead of mh-auto-edit-mhn, |
| 122 | ;; should read automhnproc from profile | 101 | ;; should read automhnproc from profile |
| 123 | ;; MIME option to mh-forward | 102 | ;; MIME option to mh-forward |
| @@ -143,7 +122,7 @@ MH profile.") | |||
| 143 | "Return t if 'file' command is on the system. | 122 | "Return t if 'file' command is on the system. |
| 144 | 'file -i' is used to get MIME type of composition insertion." | 123 | 'file -i' is used to get MIME type of composition insertion." |
| 145 | (when (not (boundp 'mh-have-file-command)) | 124 | (when (not (boundp 'mh-have-file-command)) |
| 146 | (load "executable" t t) ; executable-find not autoloaded in emacs20 | 125 | (load "executable" t t) ; executable-find not autoloaded in emacs20 |
| 147 | (setq mh-have-file-command | 126 | (setq mh-have-file-command |
| 148 | (and (fboundp 'executable-find) | 127 | (and (fboundp 'executable-find) |
| 149 | (executable-find "file") ; file command exists | 128 | (executable-find "file") ; file command exists |
| @@ -223,6 +202,7 @@ Returns nil if file command not on system." | |||
| 223 | "Legal MIME content types. | 202 | "Legal MIME content types. |
| 224 | See documentation for \\[mh-edit-mhn].") | 203 | See documentation for \\[mh-edit-mhn].") |
| 225 | 204 | ||
| 205 | ;;;###mh-autoload | ||
| 226 | (defun mh-mhn-compose-insertion (filename type description attributes) | 206 | (defun mh-mhn-compose-insertion (filename type description attributes) |
| 227 | "Add a directive to insert a MIME message part from a file. | 207 | "Add a directive to insert a MIME message part from a file. |
| 228 | This is the typical way to insert non-text parts in a message. | 208 | This is the typical way to insert non-text parts in a message. |
| @@ -234,22 +214,22 @@ the Content-Type field of the attachment. | |||
| 234 | 214 | ||
| 235 | See also \\[mh-edit-mhn]." | 215 | See also \\[mh-edit-mhn]." |
| 236 | (interactive (let ((filename (read-file-name "Insert contents of: "))) | 216 | (interactive (let ((filename (read-file-name "Insert contents of: "))) |
| 237 | (list | 217 | (list |
| 238 | filename | 218 | filename |
| 239 | (or (mh-file-mime-type filename) | 219 | (or (mh-file-mime-type filename) |
| 240 | (completing-read "Content-Type: " | 220 | (completing-read "Content-Type: " |
| 241 | (if (fboundp 'mailcap-mime-types) | 221 | (if (fboundp 'mailcap-mime-types) |
| 242 | (mapcar 'list (mailcap-mime-types)) | 222 | (mapcar 'list (mailcap-mime-types)) |
| 243 | mh-mime-content-types))) | 223 | mh-mime-content-types))) |
| 244 | (read-string "Content-Description: ") | 224 | (read-string "Content-Description: ") |
| 245 | (read-string "Content-Attributes: " | 225 | (read-string "Content-Attributes: " |
| 246 | (concat "name=\"" | 226 | (concat "name=\"" |
| 247 | (file-name-nondirectory filename) | 227 | (file-name-nondirectory filename) |
| 248 | "\""))))) | 228 | "\""))))) |
| 249 | (mh-mhn-compose-type filename type description attributes )) | 229 | (mh-mhn-compose-type filename type description attributes )) |
| 250 | 230 | ||
| 251 | (defun mh-mhn-compose-type (filename type | 231 | (defun mh-mhn-compose-type (filename type |
| 252 | &optional description attributes comment) | 232 | &optional description attributes comment) |
| 253 | "Insert a mhn directive to insert a file. | 233 | "Insert a mhn directive to insert a file. |
| 254 | 234 | ||
| 255 | The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is | 235 | The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is |
| @@ -269,6 +249,7 @@ optional COMMENT can also be included." | |||
| 269 | (insert "\n")) | 249 | (insert "\n")) |
| 270 | 250 | ||
| 271 | 251 | ||
| 252 | ;;;###mh-autoload | ||
| 272 | (defun mh-mhn-compose-anon-ftp (host filename type description) | 253 | (defun mh-mhn-compose-anon-ftp (host filename type description) |
| 273 | "Add a directive for a MIME anonymous ftp external body part. | 254 | "Add a directive for a MIME anonymous ftp external body part. |
| 274 | This directive tells MH to include a reference to a message/external-body part | 255 | This directive tells MH to include a reference to a message/external-body part |
| @@ -280,16 +261,17 @@ header. | |||
| 280 | 261 | ||
| 281 | See also \\[mh-edit-mhn]." | 262 | See also \\[mh-edit-mhn]." |
| 282 | (interactive (list | 263 | (interactive (list |
| 283 | (read-string "Remote host: ") | 264 | (read-string "Remote host: ") |
| 284 | (read-string "Remote filename: ") | 265 | (read-string "Remote filename: ") |
| 285 | (completing-read "External Content-Type: " | 266 | (completing-read "External Content-Type: " |
| 286 | (if (fboundp 'mailcap-mime-types) | 267 | (if (fboundp 'mailcap-mime-types) |
| 287 | (mapcar 'list (mailcap-mime-types)) | 268 | (mapcar 'list (mailcap-mime-types)) |
| 288 | mh-mime-content-types)) | 269 | mh-mime-content-types)) |
| 289 | (read-string "External Content-Description: "))) | 270 | (read-string "External Content-Description: "))) |
| 290 | (mh-mhn-compose-external-type "anon-ftp" host filename | 271 | (mh-mhn-compose-external-type "anon-ftp" host filename |
| 291 | type description)) | 272 | type description)) |
| 292 | 273 | ||
| 274 | ;;;###mh-autoload | ||
| 293 | (defun mh-mhn-compose-external-compressed-tar (host filename description) | 275 | (defun mh-mhn-compose-external-compressed-tar (host filename description) |
| 294 | "Add a directive to include a MIME reference to a compressed tar file. | 276 | "Add a directive to include a MIME reference to a compressed tar file. |
| 295 | The file should be available via anonymous ftp. This directive tells MH to | 277 | The file should be available via anonymous ftp. This directive tells MH to |
| @@ -300,19 +282,20 @@ DESCRIPTION, a line of text for the Content-description header. | |||
| 300 | 282 | ||
| 301 | See also \\[mh-edit-mhn]." | 283 | See also \\[mh-edit-mhn]." |
| 302 | (interactive (list | 284 | (interactive (list |
| 303 | (read-string "Remote host: ") | 285 | (read-string "Remote host: ") |
| 304 | (read-string "Remote filename: ") | 286 | (read-string "Remote filename: ") |
| 305 | (read-string "Tar file Content-description: "))) | 287 | (read-string "Tar file Content-description: "))) |
| 306 | (mh-mhn-compose-external-type "anon-ftp" host filename | 288 | (mh-mhn-compose-external-type "anon-ftp" host filename |
| 307 | "application/octet-stream" | 289 | "application/octet-stream" |
| 308 | description | 290 | description |
| 309 | "type=tar; conversions=x-compress" | 291 | "type=tar; conversions=x-compress" |
| 310 | "mode=image")) | 292 | "mode=image")) |
| 311 | 293 | ||
| 312 | 294 | ||
| 313 | (defun mh-mhn-compose-external-type (access-type host filename type | 295 | (defun mh-mhn-compose-external-type (access-type host filename type |
| 314 | &optional description | 296 | &optional description |
| 315 | attributes extra-params comment) | 297 | attributes extra-params |
| 298 | comment) | ||
| 316 | "Add a directive to include a MIME reference to a remote file. | 299 | "Add a directive to include a MIME reference to a remote file. |
| 317 | The file should be available via anonymous ftp. This directive tells MH to | 300 | The file should be available via anonymous ftp. This directive tells MH to |
| 318 | include a reference to a message/external-body part. | 301 | include a reference to a message/external-body part. |
| @@ -342,6 +325,7 @@ See also \\[mh-edit-mhn]." | |||
| 342 | (insert "; " extra-params)) | 325 | (insert "; " extra-params)) |
| 343 | (insert "\n")) | 326 | (insert "\n")) |
| 344 | 327 | ||
| 328 | ;;;###mh-autoload | ||
| 345 | (defun mh-mhn-compose-forw (&optional description folder messages) | 329 | (defun mh-mhn-compose-forw (&optional description folder messages) |
| 346 | "Add a forw directive to this message, to forward a message with MIME. | 330 | "Add a forw directive to this message, to forward a message with MIME. |
| 347 | This directive tells MH to include the named messages in this one. | 331 | This directive tells MH to include the named messages in this one. |
| @@ -351,12 +335,12 @@ and FOLDER and MESSAGES, which name the message(s) to be forwarded. | |||
| 351 | 335 | ||
| 352 | See also \\[mh-edit-mhn]." | 336 | See also \\[mh-edit-mhn]." |
| 353 | (interactive (list | 337 | (interactive (list |
| 354 | (read-string "Forw Content-description: ") | 338 | (read-string "Forw Content-description: ") |
| 355 | (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) | 339 | (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
| 356 | (read-string (format "Messages%s: " | 340 | (read-string (format "Messages%s: " |
| 357 | (if mh-sent-from-msg | 341 | (if mh-sent-from-msg |
| 358 | (format " [%d]" mh-sent-from-msg) | 342 | (format " [%d]" mh-sent-from-msg) |
| 359 | ""))))) | 343 | ""))))) |
| 360 | (setq mh-mhn-compose-insert-flag t) | 344 | (setq mh-mhn-compose-insert-flag t) |
| 361 | (beginning-of-line) | 345 | (beginning-of-line) |
| 362 | (insert "#forw [") | 346 | (insert "#forw [") |
| @@ -368,14 +352,15 @@ See also \\[mh-edit-mhn]." | |||
| 368 | (not (string= folder "")) | 352 | (not (string= folder "")) |
| 369 | (insert " " folder)) | 353 | (insert " " folder)) |
| 370 | (if (and messages | 354 | (if (and messages |
| 371 | (not (string= messages ""))) | 355 | (not (string= messages ""))) |
| 372 | (let ((start (point))) | 356 | (let ((start (point))) |
| 373 | (insert " " messages) | 357 | (insert " " messages) |
| 374 | (subst-char-in-region start (point) ?, ? )) | 358 | (subst-char-in-region start (point) ?, ? )) |
| 375 | (if mh-sent-from-msg | 359 | (if mh-sent-from-msg |
| 376 | (insert " " (int-to-string mh-sent-from-msg)))) | 360 | (insert " " (int-to-string mh-sent-from-msg)))) |
| 377 | (insert "\n")) | 361 | (insert "\n")) |
| 378 | 362 | ||
| 363 | ;;;###mh-autoload | ||
| 379 | (defun mh-edit-mhn (&optional extra-args) | 364 | (defun mh-edit-mhn (&optional extra-args) |
| 380 | "Format the current draft for MIME, expanding any mhn directives. | 365 | "Format the current draft for MIME, expanding any mhn directives. |
| 381 | 366 | ||
| @@ -416,6 +401,7 @@ The mhn program is part of MH version 6.8 or later." | |||
| 416 | (message "mhn editing...done") | 401 | (message "mhn editing...done") |
| 417 | (run-hooks 'mh-edit-mhn-hook)) | 402 | (run-hooks 'mh-edit-mhn-hook)) |
| 418 | 403 | ||
| 404 | ;;;###mh-autoload | ||
| 419 | (defun mh-revert-mhn-edit (noconfirm) | 405 | (defun mh-revert-mhn-edit (noconfirm) |
| 420 | "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. | 406 | "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. |
| 421 | Optional non-nil argument NOCONFIRM means don't ask for confirmation." | 407 | Optional non-nil argument NOCONFIRM means don't ask for confirmation." |
| @@ -423,21 +409,21 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation." | |||
| 423 | (if (null buffer-file-name) | 409 | (if (null buffer-file-name) |
| 424 | (error "Buffer does not seem to be associated with any file")) | 410 | (error "Buffer does not seem to be associated with any file")) |
| 425 | (let ((backup-strings '("," "#")) | 411 | (let ((backup-strings '("," "#")) |
| 426 | backup-file) | 412 | backup-file) |
| 427 | (while (and backup-strings | 413 | (while (and backup-strings |
| 428 | (not (file-exists-p | 414 | (not (file-exists-p |
| 429 | (setq backup-file | 415 | (setq backup-file |
| 430 | (concat (file-name-directory buffer-file-name) | 416 | (concat (file-name-directory buffer-file-name) |
| 431 | (car backup-strings) | 417 | (car backup-strings) |
| 432 | (file-name-nondirectory buffer-file-name) | 418 | (file-name-nondirectory buffer-file-name) |
| 433 | ".orig"))))) | 419 | ".orig"))))) |
| 434 | (setq backup-strings (cdr backup-strings))) | 420 | (setq backup-strings (cdr backup-strings))) |
| 435 | (or backup-strings | 421 | (or backup-strings |
| 436 | (error "Backup file for %s no longer exists!" buffer-file-name)) | 422 | (error "Backup file for %s no longer exists!" buffer-file-name)) |
| 437 | (or noconfirm | 423 | (or noconfirm |
| 438 | (yes-or-no-p (format "Revert buffer from file %s? " | 424 | (yes-or-no-p (format "Revert buffer from file %s? " |
| 439 | backup-file)) | 425 | backup-file)) |
| 440 | (error "Revert not confirmed")) | 426 | (error "Revert not confirmed")) |
| 441 | (let ((buffer-read-only nil)) | 427 | (let ((buffer-read-only nil)) |
| 442 | (erase-buffer) | 428 | (erase-buffer) |
| 443 | (insert-file-contents backup-file)) | 429 | (insert-file-contents backup-file)) |
| @@ -447,6 +433,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation." | |||
| 447 | 433 | ||
| 448 | ;;; MIME composition functions | 434 | ;;; MIME composition functions |
| 449 | 435 | ||
| 436 | ;;;###mh-autoload | ||
| 450 | (defun mh-mml-to-mime () | 437 | (defun mh-mml-to-mime () |
| 451 | "Compose MIME message from mml directives." | 438 | "Compose MIME message from mml directives." |
| 452 | (interactive) | 439 | (interactive) |
| @@ -455,6 +442,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation." | |||
| 455 | (mml-to-mime) | 442 | (mml-to-mime) |
| 456 | (setq mh-mml-compose-insert-flag nil)) | 443 | (setq mh-mml-compose-insert-flag nil)) |
| 457 | 444 | ||
| 445 | ;;;###mh-autoload | ||
| 458 | (defun mh-mml-forward-message (description folder message) | 446 | (defun mh-mml-forward-message (description folder message) |
| 459 | "Forward a message as attachment. | 447 | "Forward a message as attachment. |
| 460 | The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE | 448 | The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE |
| @@ -476,6 +464,7 @@ number." | |||
| 476 | (setq mh-mml-compose-insert-flag t)) | 464 | (setq mh-mml-compose-insert-flag t)) |
| 477 | (t (error "The message number, %s is not a integer!" msg))))) | 465 | (t (error "The message number, %s is not a integer!" msg))))) |
| 478 | 466 | ||
| 467 | ;;;###mh-autoload | ||
| 479 | (defun mh-mml-attach-file (&optional disposition) | 468 | (defun mh-mml-attach-file (&optional disposition) |
| 480 | "Attach a file to the outgoing MIME message. | 469 | "Attach a file to the outgoing MIME message. |
| 481 | The file is not inserted or encoded until you send the message with | 470 | The file is not inserted or encoded until you send the message with |
| @@ -502,6 +491,7 @@ automatically." | |||
| 502 | 'disposition dispos 'description description) | 491 | 'disposition dispos 'description description) |
| 503 | (setq mh-mml-compose-insert-flag t))) | 492 | (setq mh-mml-compose-insert-flag t))) |
| 504 | 493 | ||
| 494 | ;;;###mh-autoload | ||
| 505 | (defun mh-mml-secure-message-sign-pgpmime () | 495 | (defun mh-mml-secure-message-sign-pgpmime () |
| 506 | "Add directive to encrypt/sign the entire message." | 496 | "Add directive to encrypt/sign the entire message." |
| 507 | (interactive) | 497 | (interactive) |
| @@ -510,6 +500,7 @@ automatically." | |||
| 510 | (mml-secure-message-sign-pgpmime) | 500 | (mml-secure-message-sign-pgpmime) |
| 511 | (setq mh-mml-compose-insert-flag t))) | 501 | (setq mh-mml-compose-insert-flag t))) |
| 512 | 502 | ||
| 503 | ;;;###mh-autoload | ||
| 513 | (defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign) | 504 | (defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign) |
| 514 | "Add directive to encrypt and sign the entire message. | 505 | "Add directive to encrypt and sign the entire message. |
| 515 | If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." | 506 | If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." |
| @@ -523,54 +514,6 @@ If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." | |||
| 523 | 514 | ||
| 524 | ;;; MIME decoding | 515 | ;;; MIME decoding |
| 525 | 516 | ||
| 526 | (defcustom mh-graphical-smileys-flag t | ||
| 527 | "*Non-nil means graphical smileys are displayed. | ||
| 528 | Non-nil means that small graphics will be used in the show buffer instead of | ||
| 529 | patterns like :-), ;-) etc. The setting only has effect if | ||
| 530 | `mh-decode-mime-flag' is non-nil." | ||
| 531 | :type 'boolean | ||
| 532 | :group 'mh-buffer) | ||
| 533 | |||
| 534 | (defcustom mh-graphical-emphasis-flag t | ||
| 535 | "*Non-nil means graphical emphasis is displayed. | ||
| 536 | Non-nil means that _underline_ will be underlined, *bold* will appear in bold, | ||
| 537 | /italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole | ||
| 538 | list. The setting only has effect if `mh-decode-mime-flag' is non-nil." | ||
| 539 | :type 'boolean | ||
| 540 | :group 'mh-buffer) | ||
| 541 | |||
| 542 | ;; Small image definition | ||
| 543 | (defcustom mh-max-inline-image-width nil | ||
| 544 | "*Maximum inline image width if Content-Disposition is not present. | ||
| 545 | If nil, image will be displayed if its width is smaller than the width of the | ||
| 546 | window." | ||
| 547 | :type '(choice (const nil) integer) | ||
| 548 | :group 'mh-buffer) | ||
| 549 | |||
| 550 | (defcustom mh-max-inline-image-height nil | ||
| 551 | "*Maximum inline image height if Content-Disposition is not present. | ||
| 552 | If nil, image will be displayed if its height is smaller than the height of | ||
| 553 | the window." | ||
| 554 | :type '(choice (const nil) integer) | ||
| 555 | :group 'mh-buffer) | ||
| 556 | |||
| 557 | (defcustom mh-display-buttons-for-inline-parts-flag nil | ||
| 558 | "*Non-nil means display buttons for all inline MIME parts. | ||
| 559 | If non-nil, buttons are displayed for all MIME parts. Inline parts start off | ||
| 560 | in displayed state but they can be hidden by clicking the button. If nil no | ||
| 561 | buttons are shown for inline parts." | ||
| 562 | :type 'boolean | ||
| 563 | :group 'mh-buffer) | ||
| 564 | |||
| 565 | (defcustom mh-mime-save-parts-default-directory t | ||
| 566 | "Default directory to use for `mh-mime-save-parts'. | ||
| 567 | If nil, prompt and set for next time the command is used during same session. | ||
| 568 | If t, prompt always" | ||
| 569 | :type '(choice (const :tag "Prompt the first time" nil) | ||
| 570 | (const :tag "Prompt always" t) | ||
| 571 | directory) | ||
| 572 | :group 'mh) | ||
| 573 | |||
| 574 | (defmacro mh-defun-compat (function arg-list &rest body) | 517 | (defmacro mh-defun-compat (function arg-list &rest body) |
| 575 | "This is a macro to define functions which are not defined. | 518 | "This is a macro to define functions which are not defined. |
| 576 | It is used for Gnus utility functions which were added recently. If FUNCTION | 519 | It is used for Gnus utility functions which were added recently. If FUNCTION |
| @@ -579,6 +522,7 @@ BODY." | |||
| 579 | (let ((defined-p (fboundp function))) | 522 | (let ((defined-p (fboundp function))) |
| 580 | (unless defined-p | 523 | (unless defined-p |
| 581 | `(defun ,function ,arg-list ,@body)))) | 524 | `(defun ,function ,arg-list ,@body)))) |
| 525 | (put 'mh-defun-compat 'lisp-indent-function 'defun) | ||
| 582 | 526 | ||
| 583 | ;; Copy of original function from gnus-util.el | 527 | ;; Copy of original function from gnus-util.el |
| 584 | (mh-defun-compat gnus-local-map-property (map) | 528 | (mh-defun-compat gnus-local-map-property (map) |
| @@ -597,7 +541,7 @@ BODY." | |||
| 597 | ;; HANDLE could be a CTL. | 541 | ;; HANDLE could be a CTL. |
| 598 | (if handle | 542 | (if handle |
| 599 | (put-text-property 0 (length (car handle)) parameter value | 543 | (put-text-property 0 (length (car handle)) parameter value |
| 600 | (car handle)))) | 544 | (car handle)))) |
| 601 | 545 | ||
| 602 | ;; Copy of original macro is in mm-decode.el | 546 | ;; Copy of original macro is in mm-decode.el |
| 603 | (mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter) | 547 | (mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter) |
| @@ -607,11 +551,11 @@ BODY." | |||
| 607 | (mh-defun-compat mm-readable-p (handle) | 551 | (mh-defun-compat mm-readable-p (handle) |
| 608 | "Say whether the content of HANDLE is readable." | 552 | "Say whether the content of HANDLE is readable." |
| 609 | (and (< (with-current-buffer (mm-handle-buffer handle) | 553 | (and (< (with-current-buffer (mm-handle-buffer handle) |
| 610 | (buffer-size)) 10000) | 554 | (buffer-size)) 10000) |
| 611 | (mm-with-unibyte-buffer | 555 | (mm-with-unibyte-buffer |
| 612 | (mm-insert-part handle) | 556 | (mm-insert-part handle) |
| 613 | (and (eq (mm-body-7-or-8) '7bit) | 557 | (and (eq (mm-body-7-or-8) '7bit) |
| 614 | (not (mm-long-lines-p 76)))))) | 558 | (not (mm-long-lines-p 76)))))) |
| 615 | 559 | ||
| 616 | ;; Copy of original function in mm-bodies.el | 560 | ;; Copy of original function in mm-bodies.el |
| 617 | (mh-defun-compat mm-long-lines-p (length) | 561 | (mh-defun-compat mm-long-lines-p (length) |
| @@ -620,11 +564,11 @@ BODY." | |||
| 620 | (goto-char (point-min)) | 564 | (goto-char (point-min)) |
| 621 | (end-of-line) | 565 | (end-of-line) |
| 622 | (while (and (not (eobp)) | 566 | (while (and (not (eobp)) |
| 623 | (not (> (current-column) length))) | 567 | (not (> (current-column) length))) |
| 624 | (forward-line 1) | 568 | (forward-line 1) |
| 625 | (end-of-line)) | 569 | (end-of-line)) |
| 626 | (and (> (current-column) length) | 570 | (and (> (current-column) length) |
| 627 | (current-column)))) | 571 | (current-column)))) |
| 628 | 572 | ||
| 629 | (mh-defun-compat mm-keep-viewer-alive-p (handle) | 573 | (mh-defun-compat mm-keep-viewer-alive-p (handle) |
| 630 | ;; Released Gnus doesn't keep handles associated with externally displayed | 574 | ;; Released Gnus doesn't keep handles associated with externally displayed |
| @@ -642,25 +586,26 @@ BODY." | |||
| 642 | (defun mh-mm-save-part (handle) | 586 | (defun mh-mm-save-part (handle) |
| 643 | "Write HANDLE to a file." | 587 | "Write HANDLE to a file." |
| 644 | (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) | 588 | (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) |
| 645 | (filename (mail-content-type-get | 589 | (filename (mail-content-type-get |
| 646 | (mm-handle-disposition handle) 'filename)) | 590 | (mm-handle-disposition handle) 'filename)) |
| 647 | file) | 591 | file) |
| 648 | (when filename | 592 | (when filename |
| 649 | (setq filename (file-name-nondirectory filename))) | 593 | (setq filename (file-name-nondirectory filename))) |
| 650 | (setq file (read-file-name "Save MIME part to: " | 594 | (setq file (read-file-name "Save MIME part to: " |
| 651 | (or mm-default-directory | 595 | (or mm-default-directory |
| 652 | default-directory) | 596 | default-directory) |
| 653 | nil nil (or filename name ""))) | 597 | nil nil (or filename name ""))) |
| 654 | (setq mm-default-directory (file-name-directory file)) | 598 | (setq mm-default-directory (file-name-directory file)) |
| 655 | (and (or (not (file-exists-p file)) | 599 | (and (or (not (file-exists-p file)) |
| 656 | (yes-or-no-p (format "File %s already exists; overwrite? " | 600 | (yes-or-no-p (format "File %s already exists; overwrite? " |
| 657 | file))) | 601 | file))) |
| 658 | (mm-save-part-to-file handle file)))) | 602 | (mm-save-part-to-file handle file)))) |
| 659 | 603 | ||
| 660 | 604 | ||
| 661 | 605 | ||
| 662 | ;;; MIME cleanup | 606 | ;;; MIME cleanup |
| 663 | 607 | ||
| 608 | ;;;###mh-autoload | ||
| 664 | (defun mh-mime-cleanup () | 609 | (defun mh-mime-cleanup () |
| 665 | "Free the decoded MIME parts." | 610 | "Free the decoded MIME parts." |
| 666 | (let ((mime-data (gethash (current-buffer) mh-globals-hash))) | 611 | (let ((mime-data (gethash (current-buffer) mh-globals-hash))) |
| @@ -671,6 +616,7 @@ BODY." | |||
| 671 | (mm-destroy-parts (mh-mime-handles mime-data)) | 616 | (mm-destroy-parts (mh-mime-handles mime-data)) |
| 672 | (remhash (current-buffer) mh-globals-hash)))) | 617 | (remhash (current-buffer) mh-globals-hash)))) |
| 673 | 618 | ||
| 619 | ;;;###mh-autoload | ||
| 674 | (defun mh-destroy-postponed-handles () | 620 | (defun mh-destroy-postponed-handles () |
| 675 | "Free MIME data for externally displayed mime parts." | 621 | "Free MIME data for externally displayed mime parts." |
| 676 | (let ((mime-data (mh-buffer-data))) | 622 | (let ((mime-data (mh-buffer-data))) |
| @@ -686,8 +632,8 @@ Gnus (as in the original). The MIME part, HANDLE is associated with the | |||
| 686 | undisplayer FUNCTION." | 632 | undisplayer FUNCTION." |
| 687 | (if (mm-keep-viewer-alive-p handle) | 633 | (if (mm-keep-viewer-alive-p handle) |
| 688 | (let ((new-handle (copy-sequence handle))) | 634 | (let ((new-handle (copy-sequence handle))) |
| 689 | (mm-handle-set-undisplayer new-handle function) | 635 | (mm-handle-set-undisplayer new-handle function) |
| 690 | (mm-handle-set-undisplayer handle nil) | 636 | (mm-handle-set-undisplayer handle nil) |
| 691 | (save-excursion | 637 | (save-excursion |
| 692 | (set-buffer folder) | 638 | (set-buffer folder) |
| 693 | (push new-handle (mh-mime-handles (mh-buffer-data))))) | 639 | (push new-handle (mh-mime-handles (mh-buffer-data))))) |
| @@ -696,7 +642,9 @@ undisplayer FUNCTION." | |||
| 696 | 642 | ||
| 697 | 643 | ||
| 698 | ;;; MIME transformations | 644 | ;;; MIME transformations |
| 645 | (eval-when-compile (require 'font-lock)) | ||
| 699 | 646 | ||
| 647 | ;;;###mh-autoload | ||
| 700 | (defun mh-add-missing-mime-version-header () | 648 | (defun mh-add-missing-mime-version-header () |
| 701 | "Some mail programs don't put a MIME-Version header. | 649 | "Some mail programs don't put a MIME-Version header. |
| 702 | I have seen this only in spam, so maybe we shouldn't fix this ;-)" | 650 | I have seen this only in spam, so maybe we shouldn't fix this ;-)" |
| @@ -708,15 +656,22 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)" | |||
| 708 | (forward-line -1) | 656 | (forward-line -1) |
| 709 | (insert "MIME-Version: 1.0\n"))))) | 657 | (insert "MIME-Version: 1.0\n"))))) |
| 710 | 658 | ||
| 659 | ;;;###mh-autoload | ||
| 711 | (defun mh-display-smileys () | 660 | (defun mh-display-smileys () |
| 712 | "Function to display smileys." | 661 | "Function to display smileys." |
| 713 | (when (and mh-graphical-smileys-flag (fboundp 'smiley-region)) | 662 | (when (and mh-graphical-smileys-flag |
| 663 | (fboundp 'smiley-region) | ||
| 664 | (boundp 'font-lock-maximum-size) | ||
| 665 | (>= (/ font-lock-maximum-size 8) (buffer-size))) | ||
| 714 | (smiley-region (point-min) (point-max)))) | 666 | (smiley-region (point-min) (point-max)))) |
| 715 | 667 | ||
| 668 | ;;;###mh-autoload | ||
| 716 | (defun mh-display-emphasis () | 669 | (defun mh-display-emphasis () |
| 717 | "Function to display graphical emphasis." | 670 | "Function to display graphical emphasis." |
| 718 | (when mh-graphical-emphasis-flag | 671 | (when (and mh-graphical-emphasis-flag |
| 719 | (flet ((article-goto-body ())) ; shadow this function to do nothing | 672 | (boundp 'font-lock-maximum-size) |
| 673 | (>= (/ font-lock-maximum-size 8) (buffer-size))) | ||
| 674 | (flet ((article-goto-body ())) ; shadow this function to do nothing | ||
| 720 | (save-excursion | 675 | (save-excursion |
| 721 | (goto-char (point-min)) | 676 | (goto-char (point-min)) |
| 722 | (article-emphasize))))) | 677 | (article-emphasize))))) |
| @@ -760,6 +715,7 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)" | |||
| 760 | "Default to use for `mh-mime-save-parts-default-directory'. | 715 | "Default to use for `mh-mime-save-parts-default-directory'. |
| 761 | Set from last use.") | 716 | Set from last use.") |
| 762 | 717 | ||
| 718 | ;;;###mh-autoload | ||
| 763 | (defun mh-mime-save-parts (arg) | 719 | (defun mh-mime-save-parts (arg) |
| 764 | "Store the MIME parts of the current message. | 720 | "Store the MIME parts of the current message. |
| 765 | If ARG, prompt for directory, else use that specified by the variable | 721 | If ARG, prompt for directory, else use that specified by the variable |
| @@ -815,6 +771,7 @@ actual storing." | |||
| 815 | (defvar gnus-newsgroup-charset nil) | 771 | (defvar gnus-newsgroup-charset nil) |
| 816 | (defvar gnus-newsgroup-name nil) | 772 | (defvar gnus-newsgroup-name nil) |
| 817 | 773 | ||
| 774 | ;;;###mh-autoload | ||
| 818 | (defun mh-mime-display (&optional pre-dissected-handles) | 775 | (defun mh-mime-display (&optional pre-dissected-handles) |
| 819 | "Display (and possibly decode) MIME handles. | 776 | "Display (and possibly decode) MIME handles. |
| 820 | Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If | 777 | Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If |
| @@ -822,11 +779,12 @@ present they are displayed otherwise the buffer is parsed and then | |||
| 822 | displayed." | 779 | displayed." |
| 823 | (let ((handles ()) | 780 | (let ((handles ()) |
| 824 | (folder mh-show-folder-buffer)) | 781 | (folder mh-show-folder-buffer)) |
| 825 | (flet ((mm-handle-set-external-undisplayer (handle function) | 782 | (flet ((mm-handle-set-external-undisplayer |
| 826 | (mh-handle-set-external-undisplayer folder handle function))) | 783 | (handle function) |
| 784 | (mh-handle-set-external-undisplayer folder handle function))) | ||
| 827 | ;; If needed dissect the current buffer | 785 | ;; If needed dissect the current buffer |
| 828 | (if pre-dissected-handles | 786 | (if pre-dissected-handles |
| 829 | (setq handles pre-dissected-handles) | 787 | (setq handles pre-dissected-handles) |
| 830 | (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect))) | 788 | (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect))) |
| 831 | (setf (mh-mime-handles (mh-buffer-data)) | 789 | (setf (mh-mime-handles (mh-buffer-data)) |
| 832 | (mm-merge-handles handles (mh-mime-handles (mh-buffer-data))))) | 790 | (mm-merge-handles handles (mh-mime-handles (mh-buffer-data))))) |
| @@ -864,7 +822,7 @@ If no part is preferred then all the parts are displayed." | |||
| 864 | (preferred | 822 | (preferred |
| 865 | (save-restriction | 823 | (save-restriction |
| 866 | (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) | 824 | (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) |
| 867 | (or (mm-display-part preferred) (mm-display-part preferred)) | 825 | (mh-mime-display-single preferred) |
| 868 | (goto-char (point-max)))) | 826 | (goto-char (point-max)))) |
| 869 | (t (mh-mime-display-mixed handles))))) | 827 | (t (mh-mime-display-mixed handles))))) |
| 870 | 828 | ||
| @@ -883,9 +841,9 @@ opened)." | |||
| 883 | 841 | ||
| 884 | ;;; Avoid compiler warnings for XEmacs functions... | 842 | ;;; Avoid compiler warnings for XEmacs functions... |
| 885 | (eval-when (compile) | 843 | (eval-when (compile) |
| 886 | (loop for function in '(glyph-width window-pixel-width | 844 | (loop for function in '(glyph-width window-pixel-width |
| 887 | glyph-height window-pixel-height) | 845 | glyph-height window-pixel-height) |
| 888 | do (or (fboundp function) (defalias function 'ignore)))) | 846 | do (or (fboundp function) (defalias function 'ignore)))) |
| 889 | 847 | ||
| 890 | (defun mh-small-image-p (handle) | 848 | (defun mh-small-image-p (handle) |
| 891 | "Decide whether HANDLE is a \"small\" image that can be displayed inline. | 849 | "Decide whether HANDLE is a \"small\" image that can be displayed inline. |
| @@ -895,9 +853,9 @@ This is only useful if a Content-Disposition header is not present." | |||
| 895 | (mm-inline-large-images t)) | 853 | (mm-inline-large-images t)) |
| 896 | (and media-test | 854 | (and media-test |
| 897 | (equal (mm-handle-media-supertype handle) "image") | 855 | (equal (mm-handle-media-supertype handle) "image") |
| 898 | (funcall media-test handle) ; Since mm-inline-large-images is T, | 856 | (funcall media-test handle) ; Since mm-inline-large-images is T, |
| 899 | ; this only tells us if the image is | 857 | ; this only tells us if the image is |
| 900 | ; something that emacs can display | 858 | ; something that emacs can display |
| 901 | (let* ((image (mm-get-image handle))) | 859 | (let* ((image (mm-get-image handle))) |
| 902 | (cond ((fboundp 'glyph-width) | 860 | (cond ((fboundp 'glyph-width) |
| 903 | ;; XEmacs -- totally untested, copied from gnus | 861 | ;; XEmacs -- totally untested, copied from gnus |
| @@ -919,6 +877,17 @@ This is only useful if a Content-Disposition header is not present." | |||
| 919 | ;; Can't show image inline | 877 | ;; Can't show image inline |
| 920 | nil)))))) | 878 | nil)))))) |
| 921 | 879 | ||
| 880 | (defun mh-inline-vcard-p (handle) | ||
| 881 | "Decide if HANDLE is a vcard that must be displayed inline." | ||
| 882 | (let ((type (mm-handle-type handle))) | ||
| 883 | (and (consp type) | ||
| 884 | (equal (car type) "text/x-vcard") | ||
| 885 | (save-excursion | ||
| 886 | (save-restriction | ||
| 887 | (widen) | ||
| 888 | (goto-char (point-min)) | ||
| 889 | (not (re-search-forward "^-- $" nil t))))))) | ||
| 890 | |||
| 922 | (defun mh-mime-display-single (handle) | 891 | (defun mh-mime-display-single (handle) |
| 923 | "Display a leaf node, HANDLE in the MIME tree." | 892 | "Display a leaf node, HANDLE in the MIME tree." |
| 924 | (let* ((type (mm-handle-media-type handle)) | 893 | (let* ((type (mm-handle-media-type handle)) |
| @@ -928,10 +897,11 @@ This is only useful if a Content-Disposition header is not present." | |||
| 928 | (inlinep (and (equal (car (mm-handle-disposition handle)) "inline") | 897 | (inlinep (and (equal (car (mm-handle-disposition handle)) "inline") |
| 929 | (mm-inlinable-p handle) | 898 | (mm-inlinable-p handle) |
| 930 | (mm-inlined-p handle))) | 899 | (mm-inlined-p handle))) |
| 931 | (displayp (or inlinep ; display if inline | 900 | (displayp (or inlinep ; show if inline OR |
| 932 | (and (not attachmentp) ; if it is not an attachment | 901 | (mh-inline-vcard-p handle); inline vcard OR |
| 933 | (or small-image-flag ; display if small image | 902 | (and (not attachmentp) ; if not an attachment |
| 934 | ; or if user wants inline. | 903 | (or small-image-flag ; and small image |
| 904 | ; and user wants inline | ||
| 935 | (and (not (equal | 905 | (and (not (equal |
| 936 | (mm-handle-media-supertype handle) | 906 | (mm-handle-media-supertype handle) |
| 937 | "image")) | 907 | "image")) |
| @@ -941,7 +911,7 @@ This is only useful if a Content-Disposition header is not present." | |||
| 941 | (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) | 911 | (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) |
| 942 | (cond ((and mh-gnus-pgp-support-flag | 912 | (cond ((and mh-gnus-pgp-support-flag |
| 943 | (equal type "application/pgp-signature")) | 913 | (equal type "application/pgp-signature")) |
| 944 | nil) ; skip signatures as they are already handled... | 914 | nil) ; skip signatures as they are already handled... |
| 945 | ((not displayp) | 915 | ((not displayp) |
| 946 | (insert "\n") | 916 | (insert "\n") |
| 947 | (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) | 917 | (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) |
| @@ -982,9 +952,9 @@ like \"K v\" which operate on individual MIME parts." | |||
| 982 | (gnus-eval-format | 952 | (gnus-eval-format |
| 983 | mh-mime-button-line-format mh-mime-button-line-format-alist | 953 | mh-mime-button-line-format mh-mime-button-line-format-alist |
| 984 | `(,@(gnus-local-map-property mh-mime-button-map) | 954 | `(,@(gnus-local-map-property mh-mime-button-map) |
| 985 | mh-callback mh-mm-display-part | 955 | mh-callback mh-mm-display-part |
| 986 | mh-part ,index | 956 | mh-part ,index |
| 987 | mh-data ,handle)) | 957 | mh-data ,handle)) |
| 988 | (setq end (point)) | 958 | (setq end (point)) |
| 989 | (widget-convert-button | 959 | (widget-convert-button |
| 990 | 'link begin end | 960 | 'link begin end |
| @@ -1062,6 +1032,7 @@ like \"K v\" which operate on individual MIME parts." | |||
| 1062 | (add-text-properties (line-beginning-position) (line-end-position) | 1032 | (add-text-properties (line-beginning-position) (line-end-position) |
| 1063 | `(mh-region ,region))))))) | 1033 | `(mh-region ,region))))))) |
| 1064 | 1034 | ||
| 1035 | ;;;###mh-autoload | ||
| 1065 | (defun mh-press-button () | 1036 | (defun mh-press-button () |
| 1066 | "Press MIME button. | 1037 | "Press MIME button. |
| 1067 | If the MIME part is visible then it is removed. Otherwise the part is | 1038 | If the MIME part is visible then it is removed. Otherwise the part is |
| @@ -1072,13 +1043,15 @@ displayed." | |||
| 1072 | (function (get-text-property (point) 'mh-callback)) | 1043 | (function (get-text-property (point) 'mh-callback)) |
| 1073 | (buffer-read-only nil) | 1044 | (buffer-read-only nil) |
| 1074 | (folder mh-show-folder-buffer)) | 1045 | (folder mh-show-folder-buffer)) |
| 1075 | (flet ((mm-handle-set-external-undisplayer (handle function) | 1046 | (flet ((mm-handle-set-external-undisplayer |
| 1076 | (mh-handle-set-external-undisplayer folder handle function))) | 1047 | (handle function) |
| 1048 | (mh-handle-set-external-undisplayer folder handle function))) | ||
| 1077 | (when (and function (eolp)) | 1049 | (when (and function (eolp)) |
| 1078 | (backward-char)) | 1050 | (backward-char)) |
| 1079 | (unwind-protect (and function (funcall function data)) | 1051 | (unwind-protect (and function (funcall function data)) |
| 1080 | (set-buffer-modified-p nil))))) | 1052 | (set-buffer-modified-p nil))))) |
| 1081 | 1053 | ||
| 1054 | ;;;###mh-autoload | ||
| 1082 | (defun mh-push-button (event) | 1055 | (defun mh-push-button (event) |
| 1083 | "Click MIME button for EVENT. | 1056 | "Click MIME button for EVENT. |
| 1084 | If the MIME part is visible then it is removed. Otherwise the part is | 1057 | If the MIME part is visible then it is removed. Otherwise the part is |
| @@ -1093,21 +1066,24 @@ button." | |||
| 1093 | (data (get-text-property pos 'mh-data)) | 1066 | (data (get-text-property pos 'mh-data)) |
| 1094 | (function (get-text-property pos 'mh-callback)) | 1067 | (function (get-text-property pos 'mh-callback)) |
| 1095 | (buffer-read-only nil)) | 1068 | (buffer-read-only nil)) |
| 1096 | (flet ((mm-handle-set-external-undisplayer (handle function) | 1069 | (flet ((mm-handle-set-external-undisplayer |
| 1097 | (mh-handle-set-external-undisplayer folder handle function))) | 1070 | (handle function) |
| 1071 | (mh-handle-set-external-undisplayer folder handle function))) | ||
| 1098 | (goto-char pos) | 1072 | (goto-char pos) |
| 1099 | (unwind-protect (and function (funcall function data)) | 1073 | (unwind-protect (and function (funcall function data)) |
| 1100 | (set-buffer-modified-p nil))))) | 1074 | (set-buffer-modified-p nil))))) |
| 1101 | 1075 | ||
| 1076 | ;;;###mh-autoload | ||
| 1102 | (defun mh-mime-save-part () | 1077 | (defun mh-mime-save-part () |
| 1103 | "Save MIME part at point." | 1078 | "Save MIME part at point." |
| 1104 | (interactive) | 1079 | (interactive) |
| 1105 | (let ((data (get-text-property (point) 'mh-data))) | 1080 | (let ((data (get-text-property (point) 'mh-data))) |
| 1106 | (when data | 1081 | (when data |
| 1107 | (let ((mm-default-directory mh-mime-save-parts-directory)) | 1082 | (let ((mm-default-directory mh-mime-save-parts-directory)) |
| 1108 | (mh-mm-save-part data) | 1083 | (mh-mm-save-part data) |
| 1109 | (setq mh-mime-save-parts-directory mm-default-directory))))) | 1084 | (setq mh-mime-save-parts-directory mm-default-directory))))) |
| 1110 | 1085 | ||
| 1086 | ;;;###mh-autoload | ||
| 1111 | (defun mh-mime-inline-part () | 1087 | (defun mh-mime-inline-part () |
| 1112 | "Toggle display of the raw MIME part." | 1088 | "Toggle display of the raw MIME part." |
| 1113 | (interactive) | 1089 | (interactive) |
| @@ -1149,7 +1125,7 @@ Parameter EL is unused." | |||
| 1149 | (mh-mime-display-mixed (cdr handle)) | 1125 | (mh-mime-display-mixed (cdr handle)) |
| 1150 | (insert "\n") | 1126 | (insert "\n") |
| 1151 | (let ((mh-mime-security-button-line-format | 1127 | (let ((mh-mime-security-button-line-format |
| 1152 | mh-mime-security-button-end-line-format)) | 1128 | mh-mime-security-button-end-line-format)) |
| 1153 | (mh-insert-mime-security-button handle)) | 1129 | (mh-insert-mime-security-button handle)) |
| 1154 | (mm-set-handle-multipart-parameter | 1130 | (mm-set-handle-multipart-parameter |
| 1155 | handle 'mh-region | 1131 | handle 'mh-region |
| @@ -1164,9 +1140,9 @@ Parameter EL is unused." | |||
| 1164 | (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) | 1140 | (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) |
| 1165 | (when details | 1141 | (when details |
| 1166 | (let ((mh-mime-security-button-pressed | 1142 | (let ((mh-mime-security-button-pressed |
| 1167 | (not (get-text-property (point) 'mh-button-pressed))) | 1143 | (not (get-text-property (point) 'mh-button-pressed))) |
| 1168 | (mh-mime-security-button-line-format | 1144 | (mh-mime-security-button-line-format |
| 1169 | (get-text-property (point) 'mh-line-format))) | 1145 | (get-text-property (point) 'mh-line-format))) |
| 1170 | (forward-char -1) | 1146 | (forward-char -1) |
| 1171 | (while (eq (get-text-property (point) 'mh-line-format) | 1147 | (while (eq (get-text-property (point) 'mh-line-format) |
| 1172 | mh-mime-security-button-line-format) | 1148 | mh-mime-security-button-line-format) |
| @@ -1217,10 +1193,10 @@ Parameter EL is unused." | |||
| 1217 | mh-mime-security-button-line-format | 1193 | mh-mime-security-button-line-format |
| 1218 | mh-mime-security-button-line-format-alist | 1194 | mh-mime-security-button-line-format-alist |
| 1219 | `(,@(gnus-local-map-property mh-mime-security-button-map) | 1195 | `(,@(gnus-local-map-property mh-mime-security-button-map) |
| 1220 | mh-button-pressed ,mh-mime-security-button-pressed | 1196 | mh-button-pressed ,mh-mime-security-button-pressed |
| 1221 | mh-callback mh-mime-security-press-button | 1197 | mh-callback mh-mime-security-press-button |
| 1222 | mh-line-format ,mh-mime-security-button-line-format | 1198 | mh-line-format ,mh-mime-security-button-line-format |
| 1223 | mh-data ,handle)) | 1199 | mh-data ,handle)) |
| 1224 | (setq end (point)) | 1200 | (setq end (point)) |
| 1225 | (widget-convert-button 'link begin end | 1201 | (widget-convert-button 'link begin end |
| 1226 | :mime-handle handle | 1202 | :mime-handle handle |
| @@ -1293,6 +1269,7 @@ message multiple times." | |||
| 1293 | (provide 'mh-mime) | 1269 | (provide 'mh-mime) |
| 1294 | 1270 | ||
| 1295 | ;;; Local Variables: | 1271 | ;;; Local Variables: |
| 1272 | ;;; indent-tabs-mode: nil | ||
| 1296 | ;;; sentence-end-double-space: nil | 1273 | ;;; sentence-end-double-space: nil |
| 1297 | ;;; End: | 1274 | ;;; End: |
| 1298 | 1275 | ||
diff --git a/lisp/mail/mh-pick.el b/lisp/mail/mh-pick.el index d724cdbbfbc..a2a50f80565 100644 --- a/lisp/mail/mh-pick.el +++ b/lisp/mail/mh-pick.el | |||
| @@ -30,7 +30,7 @@ | |||
| 30 | 30 | ||
| 31 | ;;; Change Log: | 31 | ;;; Change Log: |
| 32 | 32 | ||
| 33 | ;; $Id: mh-pick.el,v 1.21 2002/11/05 21:43:16 wohler Exp $ | 33 | ;; $Id: mh-pick.el,v 1.25 2002/12/04 18:51:50 wohler Exp $ |
| 34 | 34 | ||
| 35 | ;;; Code: | 35 | ;;; Code: |
| 36 | 36 | ||
| @@ -38,46 +38,40 @@ | |||
| 38 | (require 'easymenu) | 38 | (require 'easymenu) |
| 39 | (require 'gnus-util) | 39 | (require 'gnus-util) |
| 40 | 40 | ||
| 41 | ;;; Hooks | ||
| 42 | |||
| 43 | (defcustom mh-pick-mode-hook nil | ||
| 44 | "Invoked upon entry to `mh-pick-mode'." | ||
| 45 | :type 'hook | ||
| 46 | :group 'mh-hook) | ||
| 47 | |||
| 48 | ;;; Internal variables: | 41 | ;;; Internal variables: |
| 49 | 42 | ||
| 50 | (defvar mh-pick-mode-map (make-sparse-keymap) | 43 | (defvar mh-pick-mode-map (make-sparse-keymap) |
| 51 | "Keymap for searching folder.") | 44 | "Keymap for searching folder.") |
| 52 | 45 | ||
| 53 | (defvar mh-searching-folder nil) ;Folder this pick is searching. | 46 | (defvar mh-searching-folder nil) ;Folder this pick is searching. |
| 54 | 47 | ||
| 48 | ;;;###mh-autoload | ||
| 55 | (defun mh-search-folder (folder) | 49 | (defun mh-search-folder (folder) |
| 56 | "Search FOLDER for messages matching a pattern. | 50 | "Search FOLDER for messages matching a pattern. |
| 57 | This function uses the MH command `pick' to do the work. | 51 | This function uses the MH command `pick' to do the work. |
| 58 | Add the messages found to the sequence named `search'." | 52 | Add the messages found to the sequence named `search'." |
| 59 | (interactive (list (mh-prompt-for-folder "Search" | 53 | (interactive (list (mh-prompt-for-folder "Search" |
| 60 | mh-current-folder | 54 | mh-current-folder |
| 61 | t))) | 55 | t))) |
| 62 | (switch-to-buffer-other-window "pick-pattern") | 56 | (switch-to-buffer-other-window "pick-pattern") |
| 63 | (if (or (zerop (buffer-size)) | 57 | (if (or (zerop (buffer-size)) |
| 64 | (not (y-or-n-p "Reuse pattern? "))) | 58 | (not (y-or-n-p "Reuse pattern? "))) |
| 65 | (mh-make-pick-template) | 59 | (mh-make-pick-template) |
| 66 | (message "")) | 60 | (message "")) |
| 67 | (setq mh-searching-folder folder) | 61 | (setq mh-searching-folder folder) |
| 68 | (message "%s" (substitute-command-keys | 62 | (message "%s" (substitute-command-keys |
| 69 | (concat "Type \\[mh-do-pick-search] to search messages, " | 63 | (concat "Type \\[mh-do-pick-search] to search messages, " |
| 70 | "\\[mh-help] for help.")))) | 64 | "\\[mh-help] for help.")))) |
| 71 | 65 | ||
| 72 | (defun mh-make-pick-template () | 66 | (defun mh-make-pick-template () |
| 73 | "Initialize the current buffer with a template for a pick pattern." | 67 | "Initialize the current buffer with a template for a pick pattern." |
| 74 | (erase-buffer) | 68 | (erase-buffer) |
| 75 | (insert "From: \n" | 69 | (insert "From: \n" |
| 76 | "To: \n" | 70 | "To: \n" |
| 77 | "Cc: \n" | 71 | "Cc: \n" |
| 78 | "Date: \n" | 72 | "Date: \n" |
| 79 | "Subject: \n" | 73 | "Subject: \n" |
| 80 | "---------\n") | 74 | "---------\n") |
| 81 | (mh-pick-mode) | 75 | (mh-pick-mode) |
| 82 | (goto-char (point-min)) | 76 | (goto-char (point-min)) |
| 83 | (end-of-line)) | 77 | (end-of-line)) |
| @@ -130,41 +124,42 @@ with no arguments, upon entry to this mode. | |||
| 130 | (setq mh-help-messages mh-pick-mode-help-messages) | 124 | (setq mh-help-messages mh-pick-mode-help-messages) |
| 131 | (run-hooks 'mh-pick-mode-hook)) | 125 | (run-hooks 'mh-pick-mode-hook)) |
| 132 | 126 | ||
| 127 | ;;;###mh-autoload | ||
| 133 | (defun mh-do-pick-search () | 128 | (defun mh-do-pick-search () |
| 134 | "Find messages that match the qualifications in the current pattern buffer. | 129 | "Find messages that match the qualifications in the current pattern buffer. |
| 135 | Messages are searched for in the folder named in `mh-searching-folder'. | 130 | Messages are searched for in the folder named in `mh-searching-folder'. |
| 136 | Add the messages found to the sequence named `search'." | 131 | Add the messages found to the sequence named `search'." |
| 137 | (interactive) | 132 | (interactive) |
| 138 | (let ((pattern-buffer (buffer-name)) | 133 | (let ((pattern-buffer (buffer-name)) |
| 139 | (searching-buffer mh-searching-folder) | 134 | (searching-buffer mh-searching-folder) |
| 140 | range | 135 | range |
| 141 | msgs | 136 | msgs |
| 142 | (pattern nil) | 137 | (pattern nil) |
| 143 | (new-buffer nil)) | 138 | (new-buffer nil)) |
| 144 | (save-excursion | 139 | (save-excursion |
| 145 | (cond ((get-buffer searching-buffer) | 140 | (cond ((get-buffer searching-buffer) |
| 146 | (set-buffer searching-buffer) | 141 | (set-buffer searching-buffer) |
| 147 | (setq range (list (format "%d-%d" | 142 | (setq range (list (format "%d-%d" |
| 148 | mh-first-msg-num mh-last-msg-num)))) | 143 | mh-first-msg-num mh-last-msg-num)))) |
| 149 | (t | 144 | (t |
| 150 | (mh-make-folder searching-buffer) | 145 | (mh-make-folder searching-buffer) |
| 151 | (setq range '("all")) | 146 | (setq range '("all")) |
| 152 | (setq new-buffer t)))) | 147 | (setq new-buffer t)))) |
| 153 | (message "Searching...") | 148 | (message "Searching...") |
| 154 | (goto-char (point-min)) | 149 | (goto-char (point-min)) |
| 155 | (while (and range | 150 | (while (and range |
| 156 | (setq pattern (mh-next-pick-field pattern-buffer))) | 151 | (setq pattern (mh-next-pick-field pattern-buffer))) |
| 157 | (setq msgs (mh-seq-from-command searching-buffer | 152 | (setq msgs (mh-seq-from-command searching-buffer |
| 158 | 'search | 153 | 'search |
| 159 | (mh-list-to-string | 154 | (mh-list-to-string |
| 160 | (list "pick" pattern searching-buffer | 155 | (list "pick" pattern searching-buffer |
| 161 | "-list" | 156 | "-list" |
| 162 | (mh-coalesce-msg-list range))))) | 157 | (mh-coalesce-msg-list range))))) |
| 163 | (setq range msgs)) ;restrict the pick range for next pass | 158 | (setq range msgs)) ;restrict the pick range for next pass |
| 164 | (message "Searching...done") | 159 | (message "Searching...done") |
| 165 | (if new-buffer | 160 | (if new-buffer |
| 166 | (mh-scan-folder searching-buffer msgs) | 161 | (mh-scan-folder searching-buffer msgs) |
| 167 | (switch-to-buffer searching-buffer)) | 162 | (switch-to-buffer searching-buffer)) |
| 168 | (mh-add-msgs-to-seq msgs 'search) | 163 | (mh-add-msgs-to-seq msgs 'search) |
| 169 | (delete-other-windows))) | 164 | (delete-other-windows))) |
| 170 | 165 | ||
| @@ -173,17 +168,17 @@ Add the messages found to the sequence named `search'." | |||
| 173 | COMMAND is a list. The first element is a program name | 168 | COMMAND is a list. The first element is a program name |
| 174 | and the subsequent elements are its arguments, all strings." | 169 | and the subsequent elements are its arguments, all strings." |
| 175 | (let ((msg) | 170 | (let ((msg) |
| 176 | (msgs ()) | 171 | (msgs ()) |
| 177 | (case-fold-search t)) | 172 | (case-fold-search t)) |
| 178 | (save-excursion | 173 | (save-excursion |
| 179 | (save-window-excursion | 174 | (save-window-excursion |
| 180 | (if (eq 0 (apply 'mh-exec-cmd-quiet nil command)) | 175 | (if (eq 0 (apply 'mh-exec-cmd-quiet nil command)) |
| 181 | ;; "pick" outputs one number per line | 176 | ;; "pick" outputs one number per line |
| 182 | (while (setq msg (car (mh-read-msg-list))) | 177 | (while (setq msg (car (mh-read-msg-list))) |
| 183 | (setq msgs (cons msg msgs)) | 178 | (setq msgs (cons msg msgs)) |
| 184 | (forward-line 1)))) | 179 | (forward-line 1)))) |
| 185 | (set-buffer folder) | 180 | (set-buffer folder) |
| 186 | (setq msgs (nreverse msgs)) ;put in ascending order | 181 | (setq msgs (nreverse msgs)) ;put in ascending order |
| 187 | msgs))) | 182 | msgs))) |
| 188 | 183 | ||
| 189 | (defun mh-next-pick-field (buffer) | 184 | (defun mh-next-pick-field (buffer) |
| @@ -193,50 +188,51 @@ or nil if no pieces remain." | |||
| 193 | (set-buffer buffer) | 188 | (set-buffer buffer) |
| 194 | (let ((case-fold-search t)) | 189 | (let ((case-fold-search t)) |
| 195 | (cond ((eobp) | 190 | (cond ((eobp) |
| 196 | nil) | 191 | nil) |
| 197 | ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" | 192 | ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" |
| 198 | nil t) | 193 | nil t) |
| 199 | (let* ((component | 194 | (let* ((component |
| 200 | (format "--%s" | 195 | (format "--%s" |
| 201 | (downcase (buffer-substring (match-beginning 1) | 196 | (downcase (buffer-substring (match-beginning 1) |
| 202 | (match-end 1))))) | 197 | (match-end 1))))) |
| 203 | (pat (buffer-substring (match-beginning 2) (match-end 2)))) | 198 | (pat (buffer-substring (match-beginning 2) (match-end 2)))) |
| 204 | (forward-line 1) | 199 | (forward-line 1) |
| 205 | (list component pat))) | 200 | (list component pat))) |
| 206 | ((re-search-forward "^-*$" nil t) | 201 | ((re-search-forward "^-*$" nil t) |
| 207 | (forward-char 1) | 202 | (forward-char 1) |
| 208 | (let ((body (buffer-substring (point) (point-max)))) | 203 | (let ((body (buffer-substring (point) (point-max)))) |
| 209 | (if (and (> (length body) 0) (not (equal body "\n"))) | 204 | (if (and (> (length body) 0) (not (equal body "\n"))) |
| 210 | (list "-search" body) | 205 | (list "-search" body) |
| 211 | nil))) | 206 | nil))) |
| 212 | (t | 207 | (t |
| 213 | nil)))) | 208 | nil)))) |
| 214 | 209 | ||
| 215 | 210 | ||
| 216 | 211 | ||
| 217 | ;;; Build the pick-mode keymap: | 212 | ;;; Build the pick-mode keymap: |
| 218 | ;;; If this changes, modify mh-pick-mode-help-messages accordingly, above. | 213 | ;;; If this changes, modify mh-pick-mode-help-messages accordingly, above. |
| 219 | (gnus-define-keys mh-pick-mode-map | 214 | (gnus-define-keys mh-pick-mode-map |
| 220 | "\C-c?" mh-help | 215 | "\C-c?" mh-help |
| 221 | "\C-c\C-c" mh-do-pick-search | 216 | "\C-c\C-c" mh-do-pick-search |
| 222 | "\C-c\C-f\C-b" mh-to-field | 217 | "\C-c\C-f\C-b" mh-to-field |
| 223 | "\C-c\C-f\C-c" mh-to-field | 218 | "\C-c\C-f\C-c" mh-to-field |
| 224 | "\C-c\C-f\C-d" mh-to-field | 219 | "\C-c\C-f\C-d" mh-to-field |
| 225 | "\C-c\C-f\C-f" mh-to-field | 220 | "\C-c\C-f\C-f" mh-to-field |
| 226 | "\C-c\C-f\C-r" mh-to-field | 221 | "\C-c\C-f\C-r" mh-to-field |
| 227 | "\C-c\C-f\C-s" mh-to-field | 222 | "\C-c\C-f\C-s" mh-to-field |
| 228 | "\C-c\C-f\C-t" mh-to-field | 223 | "\C-c\C-f\C-t" mh-to-field |
| 229 | "\C-c\C-fb" mh-to-field | 224 | "\C-c\C-fb" mh-to-field |
| 230 | "\C-c\C-fc" mh-to-field | 225 | "\C-c\C-fc" mh-to-field |
| 231 | "\C-c\C-fd" mh-to-field | 226 | "\C-c\C-fd" mh-to-field |
| 232 | "\C-c\C-ff" mh-to-field | 227 | "\C-c\C-ff" mh-to-field |
| 233 | "\C-c\C-fr" mh-to-field | 228 | "\C-c\C-fr" mh-to-field |
| 234 | "\C-c\C-fs" mh-to-field | 229 | "\C-c\C-fs" mh-to-field |
| 235 | "\C-c\C-ft" mh-to-field) | 230 | "\C-c\C-ft" mh-to-field) |
| 236 | 231 | ||
| 237 | (provide 'mh-pick) | 232 | (provide 'mh-pick) |
| 238 | 233 | ||
| 239 | ;;; Local Variables: | 234 | ;;; Local Variables: |
| 235 | ;;; indent-tabs-mode: nil | ||
| 240 | ;;; sentence-end-double-space: nil | 236 | ;;; sentence-end-double-space: nil |
| 241 | ;;; End: | 237 | ;;; End: |
| 242 | 238 | ||
diff --git a/lisp/mail/mh-seq.el b/lisp/mail/mh-seq.el index b6c1d4fd612..1175e420281 100644 --- a/lisp/mail/mh-seq.el +++ b/lisp/mail/mh-seq.el | |||
| @@ -67,7 +67,7 @@ | |||
| 67 | 67 | ||
| 68 | ;;; Change Log: | 68 | ;;; Change Log: |
| 69 | 69 | ||
| 70 | ;; $Id: mh-seq.el,v 1.71 2002/11/14 20:41:12 wohler Exp $ | 70 | ;; $Id: mh-seq.el,v 1.84 2003/01/07 21:15:33 satyaki Exp $ |
| 71 | 71 | ||
| 72 | ;;; Code: | 72 | ;;; Code: |
| 73 | 73 | ||
| @@ -137,56 +137,65 @@ redone to get the new thread tree. This makes incremental threading easier.") | |||
| 137 | (make-variable-buffer-local 'mh-thread-duplicates) | 137 | (make-variable-buffer-local 'mh-thread-duplicates) |
| 138 | (make-variable-buffer-local 'mh-thread-history) | 138 | (make-variable-buffer-local 'mh-thread-history) |
| 139 | 139 | ||
| 140 | ;;;###mh-autoload | ||
| 140 | (defun mh-delete-seq (sequence) | 141 | (defun mh-delete-seq (sequence) |
| 141 | "Delete the SEQUENCE." | 142 | "Delete the SEQUENCE." |
| 142 | (interactive (list (mh-read-seq-default "Delete" t))) | 143 | (interactive (list (mh-read-seq-default "Delete" t))) |
| 143 | (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note) | 144 | (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note) |
| 144 | sequence) | 145 | sequence) |
| 145 | (mh-undefine-sequence sequence '("all")) | 146 | (mh-undefine-sequence sequence '("all")) |
| 146 | (mh-delete-seq-locally sequence)) | 147 | (mh-delete-seq-locally sequence)) |
| 147 | 148 | ||
| 148 | ;; Avoid compiler warnings | 149 | ;; Avoid compiler warnings |
| 149 | (defvar view-exit-action) | 150 | (defvar view-exit-action) |
| 150 | 151 | ||
| 151 | (defun mh-list-sequences (folder) | 152 | ;;;###mh-autoload |
| 152 | "List the sequences defined in FOLDER." | 153 | (defun mh-list-sequences () |
| 153 | (interactive (list (mh-prompt-for-folder "List sequences in" | 154 | "List the sequences defined in the folder being visited." |
| 154 | mh-current-folder t))) | 155 | (interactive) |
| 155 | (let ((temp-buffer mh-temp-sequences-buffer) | 156 | (let ((folder mh-current-folder) |
| 156 | (seq-list mh-seq-list)) | 157 | (temp-buffer mh-temp-sequences-buffer) |
| 158 | (seq-list mh-seq-list) | ||
| 159 | (max-len 0)) | ||
| 157 | (with-output-to-temp-buffer temp-buffer | 160 | (with-output-to-temp-buffer temp-buffer |
| 158 | (save-excursion | 161 | (save-excursion |
| 159 | (set-buffer temp-buffer) | 162 | (set-buffer temp-buffer) |
| 160 | (erase-buffer) | 163 | (erase-buffer) |
| 161 | (message "Listing sequences ...") | 164 | (message "Listing sequences ...") |
| 162 | (insert "Sequences in folder " folder ":\n") | 165 | (insert "Sequences in folder " folder ":\n") |
| 163 | (while seq-list | 166 | (let ((seq-list seq-list)) |
| 164 | (let ((name (mh-seq-name (car seq-list))) | 167 | (while seq-list |
| 165 | (sorted-seq-msgs | 168 | (setq max-len |
| 166 | (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)) | 169 | (max (length (symbol-name (mh-seq-name (pop seq-list)))) |
| 167 | (last-col (- (window-width) 4)) | 170 | max-len))) |
| 168 | name-spec) | 171 | (setq max-len (+ 2 max-len))) |
| 169 | (insert (setq name-spec (format "%20s:" name))) | 172 | (while seq-list |
| 170 | (while sorted-seq-msgs | 173 | (let ((name (mh-seq-name (car seq-list))) |
| 171 | (if (> (current-column) last-col) | 174 | (sorted-seq-msgs |
| 172 | (progn | 175 | (mh-coalesce-msg-list |
| 173 | (insert "\n") | 176 | (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))) |
| 174 | (move-to-column (length name-spec)))) | 177 | name-spec) |
| 175 | (insert (format " %s" (car sorted-seq-msgs))) | 178 | (insert (setq name-spec (format (format "%%%ss:" max-len) name))) |
| 176 | (setq sorted-seq-msgs (cdr sorted-seq-msgs))) | 179 | (while sorted-seq-msgs |
| 177 | (insert "\n")) | 180 | (let ((next-element (format " %s" (pop sorted-seq-msgs)))) |
| 178 | (setq seq-list (cdr seq-list))) | 181 | (when (>= (+ (current-column) (length next-element)) |
| 179 | (goto-char (point-min)) | 182 | (window-width)) |
| 180 | (view-mode 1) | 183 | (insert "\n") |
| 181 | (setq view-exit-action 'kill-buffer) | 184 | (insert (format (format "%%%ss" (length name-spec)) ""))) |
| 182 | (message "Listing sequences...done"))))) | 185 | (insert next-element))) |
| 183 | 186 | (insert "\n")) | |
| 187 | (setq seq-list (cdr seq-list))) | ||
| 188 | (goto-char (point-min)) | ||
| 189 | (view-mode 1) | ||
| 190 | (setq view-exit-action 'kill-buffer) | ||
| 191 | (message "Listing sequences...done"))))) | ||
| 192 | |||
| 193 | ;;;###mh-autoload | ||
| 184 | (defun mh-msg-is-in-seq (message) | 194 | (defun mh-msg-is-in-seq (message) |
| 185 | "Display the sequences that contain MESSAGE (default: current message)." | 195 | "Display the sequences that contain MESSAGE (default: current message)." |
| 186 | (interactive (list (mh-get-msg-num t))) | 196 | (interactive (list (mh-get-msg-num t))) |
| 187 | (let* ((dest-folder (loop for seq in mh-refile-list | 197 | (let* ((dest-folder (loop for seq in mh-refile-list |
| 188 | when (member message (cdr seq)) | 198 | when (member message (cdr seq)) return (car seq))) |
| 189 | return (car seq))) | ||
| 190 | (deleted-flag (unless dest-folder (member message mh-delete-list)))) | 199 | (deleted-flag (unless dest-folder (member message mh-delete-list)))) |
| 191 | (message "Message %d%s is in sequences: %s" | 200 | (message "Message %d%s is in sequences: %s" |
| 192 | message | 201 | message |
| @@ -197,37 +206,39 @@ redone to get the new thread tree. This makes incremental threading easier.") | |||
| 197 | (mh-list-to-string (mh-seq-containing-msg message t)) | 206 | (mh-list-to-string (mh-seq-containing-msg message t)) |
| 198 | " ")))) | 207 | " ")))) |
| 199 | 208 | ||
| 209 | ;;;###mh-autoload | ||
| 200 | (defun mh-narrow-to-seq (sequence) | 210 | (defun mh-narrow-to-seq (sequence) |
| 201 | "Restrict display of this folder to just messages in SEQUENCE. | 211 | "Restrict display of this folder to just messages in SEQUENCE. |
| 202 | Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." | 212 | Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
| 203 | (interactive (list (mh-read-seq "Narrow to" t))) | 213 | (interactive (list (mh-read-seq "Narrow to" t))) |
| 204 | (with-mh-folder-updating (t) | 214 | (with-mh-folder-updating (t) |
| 205 | (cond ((mh-seq-to-msgs sequence) | 215 | (cond ((mh-seq-to-msgs sequence) |
| 206 | (mh-widen) | 216 | (mh-widen) |
| 207 | (mh-remove-all-notation) | 217 | (mh-remove-all-notation) |
| 208 | (let ((eob (point-max)) | 218 | (let ((eob (point-max)) |
| 209 | (msg-at-cursor (mh-get-msg-num nil))) | 219 | (msg-at-cursor (mh-get-msg-num nil))) |
| 210 | (setq mh-thread-old-scan-line-map mh-thread-scan-line-map) | 220 | (setq mh-thread-old-scan-line-map mh-thread-scan-line-map) |
| 211 | (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) | 221 | (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) |
| 212 | (mh-copy-seq-to-eob sequence) | 222 | (mh-copy-seq-to-eob sequence) |
| 213 | (narrow-to-region eob (point-max)) | 223 | (narrow-to-region eob (point-max)) |
| 214 | (mh-notate-user-sequences) | 224 | (mh-notate-user-sequences) |
| 215 | (mh-notate-deleted-and-refiled) | 225 | (mh-notate-deleted-and-refiled) |
| 216 | (mh-notate-seq 'cur mh-note-cur mh-cmd-note) | 226 | (mh-notate-seq 'cur mh-note-cur mh-cmd-note) |
| 217 | (when msg-at-cursor (mh-goto-msg msg-at-cursor t t)) | 227 | (when msg-at-cursor (mh-goto-msg msg-at-cursor t t)) |
| 218 | (make-variable-buffer-local 'mh-non-seq-mode-line-annotation) | 228 | (make-variable-buffer-local 'mh-non-seq-mode-line-annotation) |
| 219 | (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation) | 229 | (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation) |
| 220 | (setq mh-mode-line-annotation (symbol-name sequence)) | 230 | (setq mh-mode-line-annotation (symbol-name sequence)) |
| 221 | (mh-make-folder-mode-line) | 231 | (mh-make-folder-mode-line) |
| 222 | (mh-recenter nil) | 232 | (mh-recenter nil) |
| 223 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) | 233 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) |
| 224 | (set (make-local-variable 'tool-bar-map) | 234 | (set (make-local-variable 'tool-bar-map) |
| 225 | mh-folder-seq-tool-bar-map)) | 235 | mh-folder-seq-tool-bar-map)) |
| 226 | (setq mh-narrowed-to-seq sequence) | 236 | (setq mh-narrowed-to-seq sequence) |
| 227 | (push 'widen mh-view-ops))) | 237 | (push 'widen mh-view-ops))) |
| 228 | (t | 238 | (t |
| 229 | (error "No messages in sequence `%s'" (symbol-name sequence)))))) | 239 | (error "No messages in sequence `%s'" (symbol-name sequence)))))) |
| 230 | 240 | ||
| 241 | ;;;###mh-autoload | ||
| 231 | (defun mh-put-msg-in-seq (msg-or-seq sequence) | 242 | (defun mh-put-msg-in-seq (msg-or-seq sequence) |
| 232 | "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE. | 243 | "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE. |
| 233 | If optional prefix argument provided, then prompt for the message sequence. | 244 | If optional prefix argument provided, then prompt for the message sequence. |
| @@ -235,19 +246,18 @@ If variable `transient-mark-mode' is non-nil and the mark is active, then | |||
| 235 | the selected region is added to the sequence." | 246 | the selected region is added to the sequence." |
| 236 | (interactive (list (cond | 247 | (interactive (list (cond |
| 237 | ((mh-mark-active-p t) | 248 | ((mh-mark-active-p t) |
| 238 | (mh-region-to-sequence (region-beginning) (region-end)) | 249 | (mh-region-to-msg-list (region-beginning) (region-end))) |
| 239 | 'region) | ||
| 240 | (current-prefix-arg | 250 | (current-prefix-arg |
| 241 | (mh-read-seq-default "Add messages from" t)) | 251 | (mh-read-seq-default "Add messages from" t)) |
| 242 | (t | 252 | (t |
| 243 | (mh-get-msg-num t))) | 253 | (mh-get-msg-num t))) |
| 244 | (mh-read-seq-default "Add to" nil))) | 254 | (mh-read-seq-default "Add to" nil))) |
| 245 | (if (not (mh-internal-seq sequence)) | 255 | (if (not (mh-internal-seq sequence)) |
| 246 | (setq mh-last-seq-used sequence)) | 256 | (setq mh-last-seq-used sequence)) |
| 247 | (mh-add-msgs-to-seq (if (numberp msg-or-seq) | 257 | (mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq)) |
| 248 | msg-or-seq | 258 | ((listp msg-or-seq) msg-or-seq) |
| 249 | (mh-seq-to-msgs msg-or-seq)) | 259 | (t (mh-seq-to-msgs msg-or-seq))) |
| 250 | sequence)) | 260 | sequence)) |
| 251 | 261 | ||
| 252 | (defun mh-valid-view-change-operation-p (op) | 262 | (defun mh-valid-view-change-operation-p (op) |
| 253 | "Check if the view change operation can be performed. | 263 | "Check if the view change operation can be performed. |
| @@ -256,6 +266,7 @@ OP is one of 'widen and 'unthread." | |||
| 256 | (pop mh-view-ops)) | 266 | (pop mh-view-ops)) |
| 257 | (t nil))) | 267 | (t nil))) |
| 258 | 268 | ||
| 269 | ;;;###mh-autoload | ||
| 259 | (defun mh-widen () | 270 | (defun mh-widen () |
| 260 | "Remove restrictions from current folder, thereby showing all messages." | 271 | "Remove restrictions from current folder, thereby showing all messages." |
| 261 | (interactive) | 272 | (interactive) |
| @@ -304,16 +315,16 @@ refiled are present in `mh-refile-list'." | |||
| 304 | 315 | ||
| 305 | ;;; Commands to manipulate sequences. Sequences are stored in an alist | 316 | ;;; Commands to manipulate sequences. Sequences are stored in an alist |
| 306 | ;;; of the form: | 317 | ;;; of the form: |
| 307 | ;;; ((seq-name msgs ...) (seq-name msgs ...) ...) | 318 | ;;; ((seq-name msgs ...) (seq-name msgs ...) ...) |
| 308 | 319 | ||
| 309 | (defun mh-read-seq-default (prompt not-empty) | 320 | (defun mh-read-seq-default (prompt not-empty) |
| 310 | "Read and return sequence name with default narrowed or previous sequence. | 321 | "Read and return sequence name with default narrowed or previous sequence. |
| 311 | PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a | 322 | PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a |
| 312 | non-empty sequence is read." | 323 | non-empty sequence is read." |
| 313 | (mh-read-seq prompt not-empty | 324 | (mh-read-seq prompt not-empty |
| 314 | (or mh-narrowed-to-seq | 325 | (or mh-narrowed-to-seq |
| 315 | mh-last-seq-used | 326 | mh-last-seq-used |
| 316 | (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) | 327 | (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) |
| 317 | 328 | ||
| 318 | (defun mh-read-seq (prompt not-empty &optional default) | 329 | (defun mh-read-seq (prompt not-empty &optional default) |
| 319 | "Read and return a sequence name. | 330 | "Read and return a sequence name. |
| @@ -321,60 +332,65 @@ Prompt with PROMPT, raise an error if the sequence is empty and the NOT-EMPTY | |||
| 321 | flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%' | 332 | flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%' |
| 322 | defaults to the first sequence containing the current message." | 333 | defaults to the first sequence containing the current message." |
| 323 | (let* ((input (completing-read (format "%s %s %s" prompt "sequence:" | 334 | (let* ((input (completing-read (format "%s %s %s" prompt "sequence:" |
| 324 | (if default | 335 | (if default |
| 325 | (format "[%s] " default) | 336 | (format "[%s] " default) |
| 326 | "")) | 337 | "")) |
| 327 | (mh-seq-names mh-seq-list))) | 338 | (mh-seq-names mh-seq-list))) |
| 328 | (seq (cond ((equal input "%") | 339 | (seq (cond ((equal input "%") |
| 329 | (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) | 340 | (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) |
| 330 | ((equal input "") default) | 341 | ((equal input "") default) |
| 331 | (t (intern input)))) | 342 | (t (intern input)))) |
| 332 | (msgs (mh-seq-to-msgs seq))) | 343 | (msgs (mh-seq-to-msgs seq))) |
| 333 | (if (and (null msgs) not-empty) | 344 | (if (and (null msgs) not-empty) |
| 334 | (error "No messages in sequence `%s'" seq)) | 345 | (error "No messages in sequence `%s'" seq)) |
| 335 | seq)) | 346 | seq)) |
| 336 | 347 | ||
| 337 | (defun mh-seq-names (seq-list) | 348 | (defun mh-seq-names (seq-list) |
| 338 | "Return an alist containing the names of the SEQ-LIST." | 349 | "Return an alist containing the names of the SEQ-LIST." |
| 339 | (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry)))) | 350 | (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry)))) |
| 340 | seq-list)) | 351 | seq-list)) |
| 341 | 352 | ||
| 353 | ;;;###mh-autoload | ||
| 342 | (defun mh-rename-seq (sequence new-name) | 354 | (defun mh-rename-seq (sequence new-name) |
| 343 | "Rename SEQUENCE to have NEW-NAME." | 355 | "Rename SEQUENCE to have NEW-NAME." |
| 344 | (interactive (list (mh-read-seq "Old" t) | 356 | (interactive (list (mh-read-seq "Old" t) |
| 345 | (intern (read-string "New sequence name: ")))) | 357 | (intern (read-string "New sequence name: ")))) |
| 346 | (let ((old-seq (mh-find-seq sequence))) | 358 | (let ((old-seq (mh-find-seq sequence))) |
| 347 | (or old-seq | 359 | (or old-seq |
| 348 | (error "Sequence %s does not exist" sequence)) | 360 | (error "Sequence %s does not exist" sequence)) |
| 349 | ;; create new sequence first, since it might raise an error. | 361 | ;; create new sequence first, since it might raise an error. |
| 350 | (mh-define-sequence new-name (mh-seq-msgs old-seq)) | 362 | (mh-define-sequence new-name (mh-seq-msgs old-seq)) |
| 351 | (mh-undefine-sequence sequence (mh-seq-msgs old-seq)) | 363 | (mh-undefine-sequence sequence (mh-seq-msgs old-seq)) |
| 352 | (rplaca old-seq new-name))) | 364 | (rplaca old-seq new-name))) |
| 353 | 365 | ||
| 366 | ;;;###mh-autoload | ||
| 354 | (defun mh-map-to-seq-msgs (func seq &rest args) | 367 | (defun mh-map-to-seq-msgs (func seq &rest args) |
| 355 | "Invoke the FUNC at each message in the SEQ. | 368 | "Invoke the FUNC at each message in the SEQ. |
| 356 | The remaining ARGS are passed as arguments to FUNC." | 369 | SEQ can either be a list of messages or a MH sequence. The remaining ARGS are |
| 370 | passed as arguments to FUNC." | ||
| 357 | (save-excursion | 371 | (save-excursion |
| 358 | (let ((msgs (mh-seq-to-msgs seq))) | 372 | (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq)))) |
| 359 | (while msgs | 373 | (while msgs |
| 360 | (if (mh-goto-msg (car msgs) t t) | 374 | (if (mh-goto-msg (car msgs) t t) |
| 361 | (apply func (car msgs) args)) | 375 | (apply func (car msgs) args)) |
| 362 | (setq msgs (cdr msgs)))))) | 376 | (setq msgs (cdr msgs)))))) |
| 363 | 377 | ||
| 378 | ;;;###mh-autoload | ||
| 364 | (defun mh-notate-seq (seq notation offset) | 379 | (defun mh-notate-seq (seq notation offset) |
| 365 | "Mark the scan listing. | 380 | "Mark the scan listing. |
| 366 | All messages in SEQ are marked with NOTATION at OFFSET from the beginning of | 381 | All messages in SEQ are marked with NOTATION at OFFSET from the beginning of |
| 367 | the line." | 382 | the line." |
| 368 | (mh-map-to-seq-msgs 'mh-notate seq notation offset)) | 383 | (mh-map-to-seq-msgs 'mh-notate seq notation offset)) |
| 369 | 384 | ||
| 385 | ;;;###mh-autoload | ||
| 370 | (defun mh-add-to-sequence (seq msgs) | 386 | (defun mh-add-to-sequence (seq msgs) |
| 371 | "The sequence SEQ is augmented with the messages in MSGS." | 387 | "The sequence SEQ is augmented with the messages in MSGS." |
| 372 | ;; Add to a SEQUENCE each message the list of MSGS. | 388 | ;; Add to a SEQUENCE each message the list of MSGS. |
| 373 | (if (not (mh-folder-name-p seq)) | 389 | (if (not (mh-folder-name-p seq)) |
| 374 | (if msgs | 390 | (if msgs |
| 375 | (apply 'mh-exec-cmd "mark" mh-current-folder "-add" | 391 | (apply 'mh-exec-cmd "mark" mh-current-folder "-add" |
| 376 | "-sequence" (symbol-name seq) | 392 | "-sequence" (symbol-name seq) |
| 377 | (mh-coalesce-msg-list msgs))))) | 393 | (mh-coalesce-msg-list msgs))))) |
| 378 | 394 | ||
| 379 | ;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes | 395 | ;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes |
| 380 | ;; that the folder buffer is sorted. However in this case that assumption | 396 | ;; that the folder buffer is sorted. However in this case that assumption |
| @@ -397,20 +413,25 @@ the line." | |||
| 397 | (save-restriction | 413 | (save-restriction |
| 398 | (narrow-to-region (point) (point)) | 414 | (narrow-to-region (point) (point)) |
| 399 | (mh-regenerate-headers coalesced-msgs t) | 415 | (mh-regenerate-headers coalesced-msgs t) |
| 400 | (when (memq 'unthread mh-view-ops) | 416 | (cond ((memq 'unthread mh-view-ops) |
| 401 | ;; Populate restricted scan-line map | 417 | ;; Populate restricted scan-line map |
| 402 | (goto-char (point-min)) | 418 | (goto-char (point-min)) |
| 403 | (while (not (eobp)) | 419 | (while (not (eobp)) |
| 404 | (setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map) | 420 | (let ((msg (mh-get-msg-num nil))) |
| 405 | (mh-thread-parse-scan-line)) | 421 | (when (numberp msg) |
| 406 | (forward-line)) | 422 | (setf (gethash msg mh-thread-scan-line-map) |
| 407 | ;; Remove scan lines and read results from pre-computed thread tree | 423 | (mh-thread-parse-scan-line)))) |
| 408 | (delete-region (point-min) (point-max)) | 424 | (forward-line)) |
| 409 | (let ((thread-tree (mh-thread-generate mh-current-folder ())) | 425 | ;; Remove scan lines and read results from pre-computed tree |
| 410 | (mh-thread-body-width | 426 | (delete-region (point-min) (point-max)) |
| 411 | (- (window-width) mh-cmd-note | 427 | (let ((thread-tree (mh-thread-generate mh-current-folder ())) |
| 412 | (1- mh-scan-field-subject-start-offset)))) | 428 | (mh-thread-body-width |
| 413 | (mh-thread-generate-scan-lines thread-tree -2))))))) | 429 | (- (window-width) mh-cmd-note |
| 430 | (1- mh-scan-field-subject-start-offset))) | ||
| 431 | (mh-thread-last-ancestor nil)) | ||
| 432 | (mh-thread-generate-scan-lines thread-tree -2))) | ||
| 433 | (mh-index-data | ||
| 434 | (mh-index-insert-folder-headers))))))) | ||
| 414 | 435 | ||
| 415 | (defun mh-copy-line-to-point (msg location) | 436 | (defun mh-copy-line-to-point (msg location) |
| 416 | "Copy current message line to a specific location. | 437 | "Copy current message line to a specific location. |
| @@ -421,24 +442,25 @@ LOCATION." | |||
| 421 | (beginning-of-line) | 442 | (beginning-of-line) |
| 422 | (save-excursion | 443 | (save-excursion |
| 423 | (let ((beginning-of-line (point)) | 444 | (let ((beginning-of-line (point)) |
| 424 | end) | 445 | end) |
| 425 | (forward-line 1) | 446 | (forward-line 1) |
| 426 | (setq end (point)) | 447 | (setq end (point)) |
| 427 | (goto-char location) | 448 | (goto-char location) |
| 428 | (insert-buffer-substring (current-buffer) beginning-of-line end)))) | 449 | (insert-buffer-substring (current-buffer) beginning-of-line end)))) |
| 429 | 450 | ||
| 430 | (defun mh-region-to-sequence (begin end) | 451 | ;;;###mh-autoload |
| 431 | "Define sequence 'region as the messages between point and mark. | 452 | (defun mh-region-to-msg-list (begin end) |
| 432 | When called programmatically, use arguments BEGIN and END to define region." | 453 | "Return a list of messages within the region between BEGIN and END." |
| 433 | (interactive "r") | ||
| 434 | (mh-delete-seq-locally 'region) | ||
| 435 | (save-excursion | 454 | (save-excursion |
| 436 | ;; If end is end of buffer back up one position | 455 | ;; If end is end of buffer back up one position |
| 437 | (setq end (if (equal end (point-max)) (1- end) end)) | 456 | (setq end (if (equal end (point-max)) (1- end) end)) |
| 438 | (goto-char begin) | 457 | (goto-char begin) |
| 439 | (while (<= (point) end) | 458 | (let ((result ())) |
| 440 | (mh-add-msgs-to-seq (mh-get-msg-num t) 'region t) | 459 | (while (<= (point) end) |
| 441 | (forward-line 1)))) | 460 | (let ((index (mh-get-msg-num nil))) |
| 461 | (when (numberp index) (push index result))) | ||
| 462 | (forward-line 1)) | ||
| 463 | result))) | ||
| 442 | 464 | ||
| 443 | 465 | ||
| 444 | 466 | ||
| @@ -493,6 +515,7 @@ Return number of messages put in the sequence: | |||
| 493 | (t | 515 | (t |
| 494 | 0)))))) | 516 | 0)))))) |
| 495 | 517 | ||
| 518 | ;;;###mh-autoload | ||
| 496 | (defun mh-narrow-to-subject () | 519 | (defun mh-narrow-to-subject () |
| 497 | "Narrow to a sequence containing all following messages with same subject." | 520 | "Narrow to a sequence containing all following messages with same subject." |
| 498 | (interactive) | 521 | (interactive) |
| @@ -510,6 +533,7 @@ Return number of messages put in the sequence: | |||
| 510 | (if (numberp num) | 533 | (if (numberp num) |
| 511 | (mh-goto-msg num t t)))))) | 534 | (mh-goto-msg num t t)))))) |
| 512 | 535 | ||
| 536 | ;;;###mh-autoload | ||
| 513 | (defun mh-delete-subject () | 537 | (defun mh-delete-subject () |
| 514 | "Mark all following messages with same subject to be deleted. | 538 | "Mark all following messages with same subject to be deleted. |
| 515 | This puts the messages in a sequence named subject. You can undo the last | 539 | This puts the messages in a sequence named subject. You can undo the last |
| @@ -527,30 +551,42 @@ subject sequence." | |||
| 527 | (message "Marked %d messages for deletion" count) | 551 | (message "Marked %d messages for deletion" count) |
| 528 | (mh-delete-msg 'subject))))) | 552 | (mh-delete-msg 'subject))))) |
| 529 | 553 | ||
| 554 | ;;;###mh-autoload | ||
| 555 | (defun mh-delete-subject-or-thread () | ||
| 556 | "Mark messages for deletion intelligently. | ||
| 557 | If the folder is threaded then `mh-thread-delete' is used to mark the current | ||
| 558 | message and all its descendants for deletion. Otherwise `mh-delete-subject' is | ||
| 559 | used to mark the current message and all messages following it with the same | ||
| 560 | subject for deletion." | ||
| 561 | (interactive) | ||
| 562 | (if (memq 'unthread mh-view-ops) | ||
| 563 | (mh-thread-delete) | ||
| 564 | (mh-delete-subject))) | ||
| 565 | |||
| 530 | ;;; Message threading: | 566 | ;;; Message threading: |
| 531 | 567 | ||
| 532 | (defun mh-thread-initialize () | 568 | (defun mh-thread-initialize () |
| 533 | "Make hash tables, otherwise clear them." | 569 | "Make hash tables, otherwise clear them." |
| 534 | (cond | 570 | (cond |
| 535 | (mh-thread-id-hash | 571 | (mh-thread-id-hash |
| 536 | (clrhash mh-thread-id-hash) | 572 | (clrhash mh-thread-id-hash) |
| 537 | (clrhash mh-thread-subject-hash) | 573 | (clrhash mh-thread-subject-hash) |
| 538 | (clrhash mh-thread-id-table) | 574 | (clrhash mh-thread-id-table) |
| 539 | (clrhash mh-thread-id-index-map) | 575 | (clrhash mh-thread-id-index-map) |
| 540 | (clrhash mh-thread-index-id-map) | 576 | (clrhash mh-thread-index-id-map) |
| 541 | (clrhash mh-thread-scan-line-map) | 577 | (clrhash mh-thread-scan-line-map) |
| 542 | (clrhash mh-thread-subject-container-hash) | 578 | (clrhash mh-thread-subject-container-hash) |
| 543 | (clrhash mh-thread-duplicates) | 579 | (clrhash mh-thread-duplicates) |
| 544 | (setq mh-thread-history ())) | 580 | (setq mh-thread-history ())) |
| 545 | (t (setq mh-thread-id-hash (make-hash-table :test #'equal)) | 581 | (t (setq mh-thread-id-hash (make-hash-table :test #'equal)) |
| 546 | (setq mh-thread-subject-hash (make-hash-table :test #'equal)) | 582 | (setq mh-thread-subject-hash (make-hash-table :test #'equal)) |
| 547 | (setq mh-thread-id-table (make-hash-table :test #'eq)) | 583 | (setq mh-thread-id-table (make-hash-table :test #'eq)) |
| 548 | (setq mh-thread-id-index-map (make-hash-table :test #'eq)) | 584 | (setq mh-thread-id-index-map (make-hash-table :test #'eq)) |
| 549 | (setq mh-thread-index-id-map (make-hash-table :test #'eql)) | 585 | (setq mh-thread-index-id-map (make-hash-table :test #'eql)) |
| 550 | (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) | 586 | (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) |
| 551 | (setq mh-thread-subject-container-hash (make-hash-table :test #'eq)) | 587 | (setq mh-thread-subject-container-hash (make-hash-table :test #'eq)) |
| 552 | (setq mh-thread-duplicates (make-hash-table :test #'eq)) | 588 | (setq mh-thread-duplicates (make-hash-table :test #'eq)) |
| 553 | (setq mh-thread-history ())))) | 589 | (setq mh-thread-history ())))) |
| 554 | 590 | ||
| 555 | (defsubst mh-thread-id-container (id) | 591 | (defsubst mh-thread-id-container (id) |
| 556 | "Given ID, return the corresponding container in `mh-thread-id-table'. | 592 | "Given ID, return the corresponding container in `mh-thread-id-table'. |
| @@ -570,8 +606,8 @@ is updated." | |||
| 570 | (parent-container (mh-container-parent child-container))) | 606 | (parent-container (mh-container-parent child-container))) |
| 571 | (when parent-container | 607 | (when parent-container |
| 572 | (setf (mh-container-children parent-container) | 608 | (setf (mh-container-children parent-container) |
| 573 | (remove* child-container (mh-container-children parent-container) | 609 | (loop for elem in (mh-container-children parent-container) |
| 574 | :test #'eq)) | 610 | unless (eq child-container elem) collect elem)) |
| 575 | (setf (mh-container-parent child-container) nil)))) | 611 | (setf (mh-container-parent child-container) nil)))) |
| 576 | 612 | ||
| 577 | (defsubst mh-thread-add-link (parent child &optional at-end-p) | 613 | (defsubst mh-thread-add-link (parent child &optional at-end-p) |
| @@ -711,7 +747,7 @@ If CONTAINER is empty return the subject info of one of its children." | |||
| 711 | (setf (mh-container-real-child-p node) t))))))) | 747 | (setf (mh-container-real-child-p node) t))))))) |
| 712 | 748 | ||
| 713 | (defun mh-thread-prune-containers (roots) | 749 | (defun mh-thread-prune-containers (roots) |
| 714 | "Prune empty containers in the containers ROOTS." | 750 | "Prune empty containers in the containers ROOTS." |
| 715 | (let ((dfs-ordered-nodes ()) | 751 | (let ((dfs-ordered-nodes ()) |
| 716 | (work-list roots)) | 752 | (work-list roots)) |
| 717 | (while work-list | 753 | (while work-list |
| @@ -804,16 +840,18 @@ preference to something that has it." | |||
| 804 | Ideally this should have some regexp which will try to guess if a string | 840 | Ideally this should have some regexp which will try to guess if a string |
| 805 | between < and > is a message id and not an email address. For now it will | 841 | between < and > is a message id and not an email address. For now it will |
| 806 | take the last string inside angles." | 842 | take the last string inside angles." |
| 807 | (let ((end (search ">" reply-to-header :from-end t))) | 843 | (let ((end (mh-search-from-end ?> reply-to-header))) |
| 808 | (when (numberp end) | 844 | (when (numberp end) |
| 809 | (let ((begin (search "<" reply-to-header :from-end t :end2 end))) | 845 | (let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end)))) |
| 810 | (when (numberp begin) | 846 | (when (numberp begin) |
| 811 | (list (substring reply-to-header begin (1+ end)))))))) | 847 | (list (substring reply-to-header begin (1+ end)))))))) |
| 812 | 848 | ||
| 813 | (defun mh-thread-set-tables (folder) | 849 | (defun mh-thread-set-tables (folder) |
| 814 | "Use the tables of FOLDER in current buffer." | 850 | "Use the tables of FOLDER in current buffer." |
| 815 | (flet ((mh-get-table (symbol) | 851 | (flet ((mh-get-table (symbol) |
| 816 | (save-excursion (set-buffer folder) (symbol-value symbol)))) | 852 | (save-excursion |
| 853 | (set-buffer folder) | ||
| 854 | (symbol-value symbol)))) | ||
| 817 | (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash)) | 855 | (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash)) |
| 818 | (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash)) | 856 | (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash)) |
| 819 | (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table)) | 857 | (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table)) |
| @@ -851,7 +889,7 @@ Only information about messages in MSG-LIST are added to the tree." | |||
| 851 | #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil | 889 | #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil |
| 852 | "-width" "10000" "-format" | 890 | "-width" "10000" "-format" |
| 853 | "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n" | 891 | "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n" |
| 854 | (mapcar #'(lambda (x) (format "%s" x)) msg-list))) | 892 | folder (mapcar #'(lambda (x) (format "%s" x)) msg-list))) |
| 855 | (goto-char (point-min)) | 893 | (goto-char (point-min)) |
| 856 | (let ((roots ()) | 894 | (let ((roots ()) |
| 857 | (case-fold-search t)) | 895 | (case-fold-search t)) |
| @@ -859,8 +897,8 @@ Only information about messages in MSG-LIST are added to the tree." | |||
| 859 | (while (not (eobp)) | 897 | (while (not (eobp)) |
| 860 | (block process-message | 898 | (block process-message |
| 861 | (let* ((index-line | 899 | (let* ((index-line |
| 862 | (prog1 (buffer-substring (point) (line-end-position)) | 900 | (prog1 (buffer-substring (point) (line-end-position)) |
| 863 | (forward-line))) | 901 | (forward-line))) |
| 864 | (index (car (read-from-string index-line))) | 902 | (index (car (read-from-string index-line))) |
| 865 | (id (prog1 (buffer-substring (point) (line-end-position)) | 903 | (id (prog1 (buffer-substring (point) (line-end-position)) |
| 866 | (forward-line))) | 904 | (forward-line))) |
| @@ -901,6 +939,7 @@ Only information about messages in MSG-LIST are added to the tree." | |||
| 901 | (set-buffer folder) | 939 | (set-buffer folder) |
| 902 | (setq mh-thread-history history)))))) | 940 | (setq mh-thread-history history)))))) |
| 903 | 941 | ||
| 942 | ;;;###mh-autoload | ||
| 904 | (defun mh-thread-inc (folder start-point) | 943 | (defun mh-thread-inc (folder start-point) |
| 905 | "Update thread tree for FOLDER. | 944 | "Update thread tree for FOLDER. |
| 906 | All messages after START-POINT are added to the thread tree." | 945 | All messages after START-POINT are added to the thread tree." |
| @@ -909,22 +948,26 @@ All messages after START-POINT are added to the thread tree." | |||
| 909 | (let ((msg-list ())) | 948 | (let ((msg-list ())) |
| 910 | (while (not (eobp)) | 949 | (while (not (eobp)) |
| 911 | (let ((index (mh-get-msg-num nil))) | 950 | (let ((index (mh-get-msg-num nil))) |
| 912 | (push index msg-list) | 951 | (when (numberp index) |
| 913 | (setf (gethash index mh-thread-scan-line-map) | 952 | (push index msg-list) |
| 914 | (mh-thread-parse-scan-line)) | 953 | (setf (gethash index mh-thread-scan-line-map) |
| 954 | (mh-thread-parse-scan-line))) | ||
| 915 | (forward-line))) | 955 | (forward-line))) |
| 916 | (let ((thread-tree (mh-thread-generate folder msg-list)) | 956 | (let ((thread-tree (mh-thread-generate folder msg-list)) |
| 917 | (buffer-read-only nil) | 957 | (buffer-read-only nil) |
| 918 | (old-buffer-modified-flag (buffer-modified-p))) | 958 | (old-buffer-modified-flag (buffer-modified-p))) |
| 919 | (delete-region (point-min) (point-max)) | 959 | (delete-region (point-min) (point-max)) |
| 920 | (let ((mh-thread-body-width (- (window-width) mh-cmd-note | 960 | (let ((mh-thread-body-width (- (window-width) mh-cmd-note |
| 921 | (1- mh-scan-field-subject-start-offset)))) | 961 | (1- mh-scan-field-subject-start-offset))) |
| 962 | (mh-thread-last-ancestor nil)) | ||
| 922 | (mh-thread-generate-scan-lines thread-tree -2)) | 963 | (mh-thread-generate-scan-lines thread-tree -2)) |
| 923 | (mh-notate-user-sequences) | 964 | (mh-notate-user-sequences) |
| 924 | (mh-notate-deleted-and-refiled) | 965 | (mh-notate-deleted-and-refiled) |
| 925 | (mh-notate-seq 'cur mh-note-cur mh-cmd-note) | 966 | (mh-notate-seq 'cur mh-note-cur mh-cmd-note) |
| 926 | (set-buffer-modified-p old-buffer-modified-flag)))) | 967 | (set-buffer-modified-p old-buffer-modified-flag)))) |
| 927 | 968 | ||
| 969 | (defvar mh-thread-last-ancestor) | ||
| 970 | |||
| 928 | (defun mh-thread-generate-scan-lines (tree level) | 971 | (defun mh-thread-generate-scan-lines (tree level) |
| 929 | "Generate scan lines. | 972 | "Generate scan lines. |
| 930 | TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices | 973 | TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices |
| @@ -938,18 +981,31 @@ the message." | |||
| 938 | (duplicates (gethash id mh-thread-duplicates)) | 981 | (duplicates (gethash id mh-thread-duplicates)) |
| 939 | (new-level (+ level 2)) | 982 | (new-level (+ level 2)) |
| 940 | (dupl-flag t) | 983 | (dupl-flag t) |
| 984 | (force-angle-flag nil) | ||
| 941 | (increment-level-flag nil)) | 985 | (increment-level-flag nil)) |
| 942 | (dolist (scan-line (mapcar (lambda (x) | 986 | (dolist (scan-line (mapcar (lambda (x) |
| 943 | (gethash x mh-thread-scan-line-map)) | 987 | (gethash x mh-thread-scan-line-map)) |
| 944 | (reverse (cons index duplicates)))) | 988 | (reverse (cons index duplicates)))) |
| 945 | (when scan-line | 989 | (when scan-line |
| 990 | (when (and dupl-flag (equal level 0) | ||
| 991 | (mh-thread-ancestor-p mh-thread-last-ancestor tree)) | ||
| 992 | (setq level (+ level 2) | ||
| 993 | new-level (+ new-level 2) | ||
| 994 | force-angle-flag t)) | ||
| 995 | (when (equal level 0) | ||
| 996 | (setq mh-thread-last-ancestor tree) | ||
| 997 | (while (mh-container-parent mh-thread-last-ancestor) | ||
| 998 | (setq mh-thread-last-ancestor | ||
| 999 | (mh-container-parent mh-thread-last-ancestor)))) | ||
| 946 | (insert (car scan-line) | 1000 | (insert (car scan-line) |
| 947 | (format (format "%%%ss" | 1001 | (format (format "%%%ss" |
| 948 | (if dupl-flag level new-level)) "") | 1002 | (if dupl-flag level new-level)) "") |
| 949 | (if (and (mh-container-real-child-p tree) dupl-flag) | 1003 | (if (and (mh-container-real-child-p tree) dupl-flag |
| 1004 | (not force-angle-flag)) | ||
| 950 | "[" "<") | 1005 | "[" "<") |
| 951 | (cadr scan-line) | 1006 | (cadr scan-line) |
| 952 | (if (and (mh-container-real-child-p tree) dupl-flag) | 1007 | (if (and (mh-container-real-child-p tree) dupl-flag |
| 1008 | (not force-angle-flag)) | ||
| 953 | "]" ">") | 1009 | "]" ">") |
| 954 | (truncate-string-to-width | 1010 | (truncate-string-to-width |
| 955 | (caddr scan-line) (- mh-thread-body-width | 1011 | (caddr scan-line) (- mh-thread-body-width |
| @@ -984,14 +1040,16 @@ Otherwise uses the line at point as the scan line to parse." | |||
| 984 | (substring string (+ mh-cmd-note mh-scan-field-from-end-offset)) | 1040 | (substring string (+ mh-cmd-note mh-scan-field-from-end-offset)) |
| 985 | string))) | 1041 | string))) |
| 986 | 1042 | ||
| 1043 | ;;;###mh-autoload | ||
| 987 | (defun mh-thread-add-spaces (count) | 1044 | (defun mh-thread-add-spaces (count) |
| 988 | "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." | 1045 | "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." |
| 989 | (let ((spaces (format (format "%%%ss" count) ""))) | 1046 | (let ((spaces (format (format "%%%ss" count) ""))) |
| 990 | (while (not (eobp)) | 1047 | (while (not (eobp)) |
| 991 | (let* ((msg-num (mh-get-msg-num nil)) | 1048 | (let* ((msg-num (mh-get-msg-num nil)) |
| 992 | (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map)))) | 1049 | (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map)))) |
| 993 | (setf (gethash msg-num mh-thread-scan-line-map) | 1050 | (when (numberp msg-num) |
| 994 | (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))) | 1051 | (setf (gethash msg-num mh-thread-scan-line-map) |
| 1052 | (mh-thread-parse-scan-line (format "%s%s" spaces old-line))))) | ||
| 995 | (forward-line 1)))) | 1053 | (forward-line 1)))) |
| 996 | 1054 | ||
| 997 | (defun mh-thread-folder () | 1055 | (defun mh-thread-folder () |
| @@ -1000,23 +1058,24 @@ Otherwise uses the line at point as the scan line to parse." | |||
| 1000 | (mh-thread-initialize) | 1058 | (mh-thread-initialize) |
| 1001 | (goto-char (point-min)) | 1059 | (goto-char (point-min)) |
| 1002 | (while (not (eobp)) | 1060 | (while (not (eobp)) |
| 1003 | (setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map) | 1061 | (let ((index (mh-get-msg-num nil))) |
| 1004 | (mh-thread-parse-scan-line)) | 1062 | (when (numberp index) |
| 1063 | (setf (gethash index mh-thread-scan-line-map) | ||
| 1064 | (mh-thread-parse-scan-line)))) | ||
| 1005 | (forward-line)) | 1065 | (forward-line)) |
| 1006 | (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num)) | 1066 | (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num)) |
| 1007 | (thread-tree (mh-thread-generate (buffer-name) (list range))) | 1067 | (thread-tree (mh-thread-generate (buffer-name) (list range)))) |
| 1008 | (buffer-read-only nil) | ||
| 1009 | (old-buffer-modified-p (buffer-modified-p))) | ||
| 1010 | (delete-region (point-min) (point-max)) | 1068 | (delete-region (point-min) (point-max)) |
| 1011 | (let ((mh-thread-body-width (- (window-width) mh-cmd-note | 1069 | (let ((mh-thread-body-width (- (window-width) mh-cmd-note |
| 1012 | (1- mh-scan-field-subject-start-offset)))) | 1070 | (1- mh-scan-field-subject-start-offset))) |
| 1071 | (mh-thread-last-ancestor nil)) | ||
| 1013 | (mh-thread-generate-scan-lines thread-tree -2)) | 1072 | (mh-thread-generate-scan-lines thread-tree -2)) |
| 1014 | (mh-notate-user-sequences) | 1073 | (mh-notate-user-sequences) |
| 1015 | (mh-notate-deleted-and-refiled) | 1074 | (mh-notate-deleted-and-refiled) |
| 1016 | (mh-notate-seq 'cur mh-note-cur mh-cmd-note) | 1075 | (mh-notate-seq 'cur mh-note-cur mh-cmd-note) |
| 1017 | (set-buffer-modified-p old-buffer-modified-p) | ||
| 1018 | (message "Threading %s...done" (buffer-name)))) | 1076 | (message "Threading %s...done" (buffer-name)))) |
| 1019 | 1077 | ||
| 1078 | ;;;###mh-autoload | ||
| 1020 | (defun mh-toggle-threads () | 1079 | (defun mh-toggle-threads () |
| 1021 | "Toggle threaded view of folder. | 1080 | "Toggle threaded view of folder. |
| 1022 | The conversion of normal view to threaded view is exact, that is the same | 1081 | The conversion of normal view to threaded view is exact, that is the same |
| @@ -1024,24 +1083,32 @@ messages are displayed in the folder buffer before and after threading. However | |||
| 1024 | the conversion from threaded view to normal view is inexact. So more messages | 1083 | the conversion from threaded view to normal view is inexact. So more messages |
| 1025 | than were originally present may be shown as a result." | 1084 | than were originally present may be shown as a result." |
| 1026 | (interactive) | 1085 | (interactive) |
| 1027 | (let ((msg-at-point (mh-get-msg-num nil))) | 1086 | (let ((msg-at-point (mh-get-msg-num nil)) |
| 1087 | (old-buffer-modified-flag (buffer-modified-p)) | ||
| 1088 | (buffer-read-only nil)) | ||
| 1028 | (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq) | 1089 | (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq) |
| 1029 | (unless (mh-valid-view-change-operation-p 'unthread) | 1090 | (unless (mh-valid-view-change-operation-p 'unthread) |
| 1030 | (error "Can't unthread folder")) | 1091 | (error "Can't unthread folder")) |
| 1031 | (mh-scan-folder mh-current-folder | 1092 | (mh-scan-folder mh-current-folder |
| 1032 | (format "%s" mh-narrowed-to-seq) | 1093 | (format "%s" mh-narrowed-to-seq) |
| 1033 | t)) | 1094 | t) |
| 1095 | (when mh-index-data | ||
| 1096 | (mh-index-insert-folder-headers))) | ||
| 1034 | ((memq 'unthread mh-view-ops) | 1097 | ((memq 'unthread mh-view-ops) |
| 1035 | (unless (mh-valid-view-change-operation-p 'unthread) | 1098 | (unless (mh-valid-view-change-operation-p 'unthread) |
| 1036 | (error "Can't unthread folder")) | 1099 | (error "Can't unthread folder")) |
| 1037 | (mh-scan-folder mh-current-folder | 1100 | (mh-scan-folder mh-current-folder |
| 1038 | (format "%s-%s" mh-first-msg-num mh-last-msg-num) | 1101 | (format "%s-%s" mh-first-msg-num mh-last-msg-num) |
| 1039 | t)) | 1102 | t) |
| 1103 | (when mh-index-data | ||
| 1104 | (mh-index-insert-folder-headers))) | ||
| 1040 | (t (mh-thread-folder) | 1105 | (t (mh-thread-folder) |
| 1041 | (push 'unthread mh-view-ops))) | 1106 | (push 'unthread mh-view-ops))) |
| 1042 | (when msg-at-point (mh-goto-msg msg-at-point t t)) | 1107 | (when msg-at-point (mh-goto-msg msg-at-point t t)) |
| 1108 | (set-buffer-modified-p old-buffer-modified-flag) | ||
| 1043 | (mh-recenter nil))) | 1109 | (mh-recenter nil))) |
| 1044 | 1110 | ||
| 1111 | ;;;###mh-autoload | ||
| 1045 | (defun mh-thread-forget-message (index) | 1112 | (defun mh-thread-forget-message (index) |
| 1046 | "Forget the message INDEX from the threading tables." | 1113 | "Forget the message INDEX from the threading tables." |
| 1047 | (let* ((id (gethash index mh-thread-index-id-map)) | 1114 | (let* ((id (gethash index mh-thread-index-id-map)) |
| @@ -1058,9 +1125,152 @@ than were originally present may be shown as a result." | |||
| 1058 | (setf (gethash id mh-thread-duplicates) | 1125 | (setf (gethash id mh-thread-duplicates) |
| 1059 | (remove index duplicates)))))) | 1126 | (remove index duplicates)))))) |
| 1060 | 1127 | ||
| 1128 | |||
| 1129 | |||
| 1130 | ;;; Operations on threads | ||
| 1131 | |||
| 1132 | (defun mh-thread-current-indentation-level () | ||
| 1133 | "Find the number of spaces by which current message is indented." | ||
| 1134 | (save-excursion | ||
| 1135 | (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width | ||
| 1136 | mh-scan-date-width 1)) | ||
| 1137 | (level 0)) | ||
| 1138 | (beginning-of-line) | ||
| 1139 | (forward-char address-start-offset) | ||
| 1140 | (while (char-equal (char-after) ? ) | ||
| 1141 | (incf level) | ||
| 1142 | (forward-char)) | ||
| 1143 | level))) | ||
| 1144 | |||
| 1145 | ;;;###mh-autoload | ||
| 1146 | (defun mh-thread-next-sibling (&optional previous-flag) | ||
| 1147 | "Jump to next sibling. | ||
| 1148 | With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." | ||
| 1149 | (interactive) | ||
| 1150 | (cond ((not (memq 'unthread mh-view-ops)) | ||
| 1151 | (error "Folder isn't threaded")) | ||
| 1152 | ((eobp) | ||
| 1153 | (error "No message at point"))) | ||
| 1154 | (beginning-of-line) | ||
| 1155 | (let ((point (point)) | ||
| 1156 | (done nil) | ||
| 1157 | (my-level (mh-thread-current-indentation-level))) | ||
| 1158 | (while (and (not done) | ||
| 1159 | (equal (forward-line (if previous-flag -1 1)) 0) | ||
| 1160 | (not (eobp))) | ||
| 1161 | (let ((level (mh-thread-current-indentation-level))) | ||
| 1162 | (cond ((equal level my-level) | ||
| 1163 | (setq done 'success)) | ||
| 1164 | ((< level my-level) | ||
| 1165 | (message "No %s sibling" (if previous-flag "previous" "next")) | ||
| 1166 | (setq done 'failure))))) | ||
| 1167 | (cond ((eq done 'success) (mh-maybe-show)) | ||
| 1168 | ((eq done 'failure) (goto-char point)) | ||
| 1169 | (t (message "No %s sibling" (if previous-flag "previous" "next")) | ||
| 1170 | (goto-char point))))) | ||
| 1171 | |||
| 1172 | ;;;###mh-autoload | ||
| 1173 | (defun mh-thread-previous-sibling () | ||
| 1174 | "Jump to previous sibling." | ||
| 1175 | (interactive) | ||
| 1176 | (mh-thread-next-sibling t)) | ||
| 1177 | |||
| 1178 | (defun mh-thread-immediate-ancestor () | ||
| 1179 | "Jump to immediate ancestor in thread tree." | ||
| 1180 | (beginning-of-line) | ||
| 1181 | (let ((point (point)) | ||
| 1182 | (ancestor-level (- (mh-thread-current-indentation-level) 2)) | ||
| 1183 | (done nil)) | ||
| 1184 | (if (< ancestor-level 0) | ||
| 1185 | nil | ||
| 1186 | (while (and (not done) (equal (forward-line -1) 0)) | ||
| 1187 | (when (equal ancestor-level (mh-thread-current-indentation-level)) | ||
| 1188 | (setq done t))) | ||
| 1189 | (unless done | ||
| 1190 | (goto-char point)) | ||
| 1191 | done))) | ||
| 1192 | |||
| 1193 | ;;;###mh-autoload | ||
| 1194 | (defun mh-thread-ancestor (&optional thread-root-flag) | ||
| 1195 | "Jump to the ancestor of current message. | ||
| 1196 | If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the | ||
| 1197 | thread tree the message belongs to." | ||
| 1198 | (interactive "P") | ||
| 1199 | (beginning-of-line) | ||
| 1200 | (cond ((not (memq 'unthread mh-view-ops)) | ||
| 1201 | (error "Folder isn't threaded")) | ||
| 1202 | ((eobp) | ||
| 1203 | (error "No message at point"))) | ||
| 1204 | (let ((current-level (mh-thread-current-indentation-level))) | ||
| 1205 | (cond (thread-root-flag | ||
| 1206 | (while (mh-thread-immediate-ancestor)) | ||
| 1207 | (mh-maybe-show)) | ||
| 1208 | ((equal current-level 1) | ||
| 1209 | (message "Message has no ancestor")) | ||
| 1210 | (t (mh-thread-immediate-ancestor) | ||
| 1211 | (mh-maybe-show))))) | ||
| 1212 | |||
| 1213 | (defun mh-thread-find-children () | ||
| 1214 | "Return a region containing the current message and its children. | ||
| 1215 | The result is returned as a list of two elements. The first is the point at the | ||
| 1216 | start of the region and the second is the point at the end." | ||
| 1217 | (beginning-of-line) | ||
| 1218 | (if (eobp) | ||
| 1219 | nil | ||
| 1220 | (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width | ||
| 1221 | mh-scan-date-width 1)) | ||
| 1222 | (level (mh-thread-current-indentation-level)) | ||
| 1223 | spaces begin) | ||
| 1224 | (setq begin (point)) | ||
| 1225 | (setq spaces (format (format "%%%ss" (1+ level)) "")) | ||
| 1226 | (forward-line) | ||
| 1227 | (block nil | ||
| 1228 | (while (not (eobp)) | ||
| 1229 | (forward-char address-start-offset) | ||
| 1230 | (unless (equal (string-match spaces (buffer-substring-no-properties | ||
| 1231 | (point) (line-end-position))) | ||
| 1232 | 0) | ||
| 1233 | (beginning-of-line) | ||
| 1234 | (backward-char) | ||
| 1235 | (return)) | ||
| 1236 | (forward-line))) | ||
| 1237 | (list begin (point))))) | ||
| 1238 | |||
| 1239 | ;;;###mh-autoload | ||
| 1240 | (defun mh-thread-delete () | ||
| 1241 | "Mark current message and all its children for subsequent deletion." | ||
| 1242 | (interactive) | ||
| 1243 | (cond ((not (memq 'unthread mh-view-ops)) | ||
| 1244 | (error "Folder isn't threaded")) | ||
| 1245 | ((eobp) | ||
| 1246 | (error "No message at point")) | ||
| 1247 | (t (mh-delete-msg | ||
| 1248 | (apply #'mh-region-to-msg-list (mh-thread-find-children)))))) | ||
| 1249 | |||
| 1250 | ;; This doesn't handle mh-default-folder-for-message-function. We should | ||
| 1251 | ;; refactor that code so that we don't copy it. | ||
| 1252 | ;;;###mh-autoload | ||
| 1253 | (defun mh-thread-refile (folder) | ||
| 1254 | "Mark current message and all its children for refiling to FOLDER." | ||
| 1255 | (interactive (list | ||
| 1256 | (intern (mh-prompt-for-folder | ||
| 1257 | "Destination" | ||
| 1258 | (cond ((eq 'refile (car mh-last-destination-folder)) | ||
| 1259 | (symbol-name (cdr mh-last-destination-folder))) | ||
| 1260 | (t "")) | ||
| 1261 | t)))) | ||
| 1262 | (cond ((not (memq 'unthread mh-view-ops)) | ||
| 1263 | (error "Folder isn't threaded")) | ||
| 1264 | ((eobp) | ||
| 1265 | (error "No message at point")) | ||
| 1266 | (t (mh-refile-msg | ||
| 1267 | (apply #'mh-region-to-msg-list (mh-thread-find-children)) | ||
| 1268 | folder)))) | ||
| 1269 | |||
| 1061 | (provide 'mh-seq) | 1270 | (provide 'mh-seq) |
| 1062 | 1271 | ||
| 1063 | ;;; Local Variables: | 1272 | ;;; Local Variables: |
| 1273 | ;;; indent-tabs-mode: nil | ||
| 1064 | ;;; sentence-end-double-space: nil | 1274 | ;;; sentence-end-double-space: nil |
| 1065 | ;;; End: | 1275 | ;;; End: |
| 1066 | 1276 | ||
diff --git a/lisp/mail/mh-speed.el b/lisp/mail/mh-speed.el index 3e511d1d40e..beda52778e4 100644 --- a/lisp/mail/mh-speed.el +++ b/lisp/mail/mh-speed.el | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Bill Wohler <wohler@newt.com> | 5 | ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
| 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> | 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> |
| 7 | ;; Keywords: mail | 7 | ;; Keywords: mail |
| 8 | ;; See: mh-e.el | 8 | ;; See: mh-e.el |
| @@ -31,71 +31,15 @@ | |||
| 31 | 31 | ||
| 32 | ;;; Change Log: | 32 | ;;; Change Log: |
| 33 | 33 | ||
| 34 | ;; $Id: mh-speed.el,v 1.26 2002/11/13 19:36:00 wohler Exp $ | 34 | ;; $Id: mh-speed.el,v 1.34 2003/01/07 21:15:20 satyaki Exp $ |
| 35 | 35 | ||
| 36 | ;;; Code: | 36 | ;;; Code: |
| 37 | 37 | ||
| 38 | ;; Requires | 38 | ;; Requires |
| 39 | (require 'cl) | 39 | (require 'cl) |
| 40 | (require 'mh-utils) | ||
| 41 | (require 'mh-e) | 40 | (require 'mh-e) |
| 42 | (require 'speedbar) | 41 | (require 'speedbar) |
| 43 | 42 | ||
| 44 | ;; Autoloads | ||
| 45 | (autoload 'mh-index-goto-nearest-msg "mh-index") | ||
| 46 | (autoload 'mh-index-parse-folder "mh-index") | ||
| 47 | (autoload 'mh-visit-folder "mh-e") | ||
| 48 | |||
| 49 | ;; User customizable | ||
| 50 | (defcustom mh-large-folder 200 | ||
| 51 | "The number of messages that indicates a large folder. | ||
| 52 | If the number of messages in a folder exceeds this value, confirmation is | ||
| 53 | required when the folder is visited from the speedbar." | ||
| 54 | :type 'integer | ||
| 55 | :group 'mh) | ||
| 56 | |||
| 57 | (defcustom mh-speed-flists-interval 60 | ||
| 58 | "Time between calls to flists in seconds. | ||
| 59 | If 0, flists is not called repeatedly." | ||
| 60 | :type 'integer | ||
| 61 | :group 'mh) | ||
| 62 | |||
| 63 | (defcustom mh-speed-run-flists-flag t | ||
| 64 | "Non-nil means flists is used. | ||
| 65 | If non-nil, flists is executed every `mh-speed-flists-interval' seconds to | ||
| 66 | update the display of the number of unseen and total messages in each folder. | ||
| 67 | If resources are limited, this can be set to nil and the speedbar display can | ||
| 68 | be updated manually with the \\[mh-speed-flists] command." | ||
| 69 | :type 'boolean | ||
| 70 | :group 'mh) | ||
| 71 | |||
| 72 | (defface mh-speedbar-folder-face | ||
| 73 | '((((class color) (background light)) | ||
| 74 | (:foreground "blue4")) | ||
| 75 | (((class color) (background dark)) | ||
| 76 | (:foreground "light blue"))) | ||
| 77 | "Face used for folders in the speedbar buffer." | ||
| 78 | :group 'mh) | ||
| 79 | |||
| 80 | (defface mh-speedbar-selected-folder-face | ||
| 81 | '((((class color) (background light)) | ||
| 82 | (:foreground "red" :underline t)) | ||
| 83 | (((class color) (background dark)) | ||
| 84 | (:foreground "red" :underline t)) | ||
| 85 | (t (:underline t))) | ||
| 86 | "Face used for the current folder." | ||
| 87 | :group 'mh) | ||
| 88 | |||
| 89 | (defface mh-speedbar-folder-with-unseen-messages-face | ||
| 90 | '((t (:inherit mh-speedbar-folder-face :bold t))) | ||
| 91 | "Face used for folders in the speedbar buffer which have unread messages." | ||
| 92 | :group 'mh) | ||
| 93 | |||
| 94 | (defface mh-speedbar-selected-folder-with-unseen-messages-face | ||
| 95 | '((t (:inherit mh-speedbar-selected-folder-face :bold t))) | ||
| 96 | "Face used for the current folder when it has unread messages." | ||
| 97 | :group 'mh) | ||
| 98 | |||
| 99 | ;; Global variables | 43 | ;; Global variables |
| 100 | (defvar mh-speed-refresh-flag nil) | 44 | (defvar mh-speed-refresh-flag nil) |
| 101 | (defvar mh-speed-last-selected-folder nil) | 45 | (defvar mh-speed-last-selected-folder nil) |
| @@ -116,6 +60,7 @@ be updated manually with the \\[mh-speed-flists] command." | |||
| 116 | (cdr (assoc "files" speedbar-stealthy-function-list)))) | 60 | (cdr (assoc "files" speedbar-stealthy-function-list)))) |
| 117 | 61 | ||
| 118 | ;; Functions called by speedbar to initialize display... | 62 | ;; Functions called by speedbar to initialize display... |
| 63 | ;;;###mh-autoload | ||
| 119 | (defun mh-folder-speedbar-buttons (buffer) | 64 | (defun mh-folder-speedbar-buttons (buffer) |
| 120 | "Interface function to create MH-E speedbar buffer. | 65 | "Interface function to create MH-E speedbar buffer. |
| 121 | BUFFER is the MH-E buffer for which the speedbar buffer is to be created." | 66 | BUFFER is the MH-E buffer for which the speedbar buffer is to be created." |
| @@ -134,24 +79,22 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created." | |||
| 134 | (when mh-speed-run-flists-flag | 79 | (when mh-speed-run-flists-flag |
| 135 | (mh-speed-flists nil)))) | 80 | (mh-speed-flists nil)))) |
| 136 | 81 | ||
| 82 | ;;;###mh-autoload | ||
| 137 | (defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons) | 83 | (defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons) |
| 138 | (defalias 'mh-index-folder-speedbar-buttons 'mh-folder-speedbar-buttons) | 84 | ;;;###mh-autoload |
| 139 | (defalias 'mh-index-show-speedbar-buttons 'mh-folder-speedbar-buttons) | ||
| 140 | (defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons) | 85 | (defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons) |
| 141 | 86 | ||
| 142 | ;; Keymaps for speedbar... | 87 | ;; Keymaps for speedbar... |
| 143 | (defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap) | 88 | (defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap) |
| 144 | "Specialized speedbar keymap for MH-E buffers.") | 89 | "Specialized speedbar keymap for MH-E buffers.") |
| 145 | (gnus-define-keys mh-folder-speedbar-key-map | 90 | (gnus-define-keys mh-folder-speedbar-key-map |
| 146 | "+" mh-speed-expand-folder | 91 | "+" mh-speed-expand-folder |
| 147 | "-" mh-speed-contract-folder | 92 | "-" mh-speed-contract-folder |
| 148 | "\r" mh-speed-view | 93 | "\r" mh-speed-view |
| 149 | "f" mh-speed-flists | 94 | "f" mh-speed-flists |
| 150 | "i" mh-speed-invalidate-map) | 95 | "i" mh-speed-invalidate-map) |
| 151 | 96 | ||
| 152 | (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) | 97 | (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) |
| 153 | (defvar mh-index-folder-speedbar-key-map mh-folder-speedbar-key-map) | ||
| 154 | (defvar mh-index-show-speedbar-key-map mh-folder-speedbar-key-map) | ||
| 155 | (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) | 98 | (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) |
| 156 | 99 | ||
| 157 | ;; Menus for speedbar... | 100 | ;; Menus for speedbar... |
| @@ -171,8 +114,6 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created." | |||
| 171 | "Extra menu items for speedbar.") | 114 | "Extra menu items for speedbar.") |
| 172 | 115 | ||
| 173 | (defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) | 116 | (defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) |
| 174 | (defvar mh-index-folder-speedbar-menu-items mh-folder-speedbar-menu-items) | ||
| 175 | (defvar mh-index-show-speedbar-menu-items mh-folder-speedbar-menu-items) | ||
| 176 | (defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items) | 117 | (defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items) |
| 177 | 118 | ||
| 178 | (defmacro mh-speed-select-attached-frame () | 119 | (defmacro mh-speed-select-attached-frame () |
| @@ -193,12 +134,12 @@ own when you are trying to navigate around in the speedbar buffer. | |||
| 193 | 134 | ||
| 194 | The update is always carried out if FORCE is non-nil." | 135 | The update is always carried out if FORCE is non-nil." |
| 195 | (let* ((lastf (selected-frame)) | 136 | (let* ((lastf (selected-frame)) |
| 196 | (newcf (save-excursion | 137 | (newcf (save-excursion |
| 197 | (mh-speed-select-attached-frame) | 138 | (mh-speed-select-attached-frame) |
| 198 | (prog1 (mh-speed-extract-folder-name (buffer-name)) | 139 | (prog1 (mh-speed-extract-folder-name (buffer-name)) |
| 199 | (select-frame lastf)))) | 140 | (select-frame lastf)))) |
| 200 | (lastb (current-buffer)) | 141 | (lastb (current-buffer)) |
| 201 | (case-fold-search t)) | 142 | (case-fold-search t)) |
| 202 | (when (or force | 143 | (when (or force |
| 203 | (and mh-speed-refresh-flag (not (eq lastf speedbar-frame))) | 144 | (and mh-speed-refresh-flag (not (eq lastf speedbar-frame))) |
| 204 | (and (stringp newcf) | 145 | (and (stringp newcf) |
| @@ -271,7 +212,7 @@ The function will expand out parent folders of FOLDER if needed." | |||
| 271 | (suffix-list ()) | 212 | (suffix-list ()) |
| 272 | (last-slash t)) | 213 | (last-slash t)) |
| 273 | (while (and (not (gethash prefix mh-speed-folder-map)) last-slash) | 214 | (while (and (not (gethash prefix mh-speed-folder-map)) last-slash) |
| 274 | (setq last-slash (search "/" prefix :from-end t)) | 215 | (setq last-slash (mh-search-from-end ?/ prefix)) |
| 275 | (when (integerp last-slash) | 216 | (when (integerp last-slash) |
| 276 | (push (substring prefix (1+ last-slash)) suffix-list) | 217 | (push (substring prefix (1+ last-slash)) suffix-list) |
| 277 | (setq prefix (substring prefix 0 last-slash)))) | 218 | (setq prefix (substring prefix 0 last-slash)))) |
| @@ -306,15 +247,10 @@ Do the right thing for the different kinds of buffers that MH-E uses." | |||
| 306 | ((eq major-mode 'mh-show-mode) | 247 | ((eq major-mode 'mh-show-mode) |
| 307 | (set-buffer mh-show-folder-buffer) | 248 | (set-buffer mh-show-folder-buffer) |
| 308 | mh-current-folder) | 249 | mh-current-folder) |
| 309 | ((eq major-mode 'mh-index-folder-mode) | 250 | ((eq major-mode 'mh-letter-mode) |
| 310 | (save-excursion | ||
| 311 | (mh-index-goto-nearest-msg) | ||
| 312 | (mh-index-parse-folder))) | ||
| 313 | ((or (eq major-mode 'mh-index-show-mode) | ||
| 314 | (eq major-mode 'mh-letter-mode)) | ||
| 315 | (when (string-match mh-user-path buffer-file-name) | 251 | (when (string-match mh-user-path buffer-file-name) |
| 316 | (let* ((rel-path (substring buffer-file-name (match-end 0))) | 252 | (let* ((rel-path (substring buffer-file-name (match-end 0))) |
| 317 | (directory-end (search "/" rel-path :from-end t))) | 253 | (directory-end (mh-search-from-end ?/ rel-path))) |
| 318 | (when directory-end | 254 | (when directory-end |
| 319 | (format "+%s" (substring rel-path 0 directory-end))))))))) | 255 | (format "+%s" (substring rel-path 0 directory-end))))))))) |
| 320 | 256 | ||
| @@ -347,12 +283,14 @@ Do the right thing for the different kinds of buffers that MH-E uses." | |||
| 347 | (add-text-properties | 283 | (add-text-properties |
| 348 | (line-beginning-position) (1+ (line-beginning-position)) | 284 | (line-beginning-position) (1+ (line-beginning-position)) |
| 349 | `(mh-folder ,folder-name | 285 | `(mh-folder ,folder-name |
| 350 | mh-expanded nil | 286 | mh-expanded nil |
| 351 | mh-children-p ,(not (not (cdr f))) | 287 | mh-children-p ,(not (not (cdr f))) |
| 352 | ,@(if counts `(mh-count (,(car counts) . ,(cdr counts))) ()) | 288 | ,@(if counts `(mh-count |
| 353 | mh-level ,level)))))) | 289 | (,(car counts) . ,(cdr counts))) ()) |
| 290 | mh-level ,level)))))) | ||
| 354 | folder-list))) | 291 | folder-list))) |
| 355 | 292 | ||
| 293 | ;;;###mh-autoload | ||
| 356 | (defun mh-speed-toggle (&rest args) | 294 | (defun mh-speed-toggle (&rest args) |
| 357 | "Toggle the display of child folders. | 295 | "Toggle the display of child folders. |
| 358 | The otional ARGS are ignored and there for compatibilty with speedbar." | 296 | The otional ARGS are ignored and there for compatibilty with speedbar." |
| @@ -393,45 +331,14 @@ The otional ARGS are ignored and there for compatibilty with speedbar." | |||
| 393 | (defalias 'mh-speed-expand-folder 'mh-speed-toggle) | 331 | (defalias 'mh-speed-expand-folder 'mh-speed-toggle) |
| 394 | (defalias 'mh-speed-contract-folder 'mh-speed-toggle) | 332 | (defalias 'mh-speed-contract-folder 'mh-speed-toggle) |
| 395 | 333 | ||
| 396 | (defun mh-speed-folder-size () | 334 | ;;;###mh-autoload |
| 397 | "Find folder size if folder on current line." | ||
| 398 | (let ((folder (get-text-property (line-beginning-position) 'mh-folder))) | ||
| 399 | (or (cdr (get-text-property (line-beginning-position) 'mh-count)) | ||
| 400 | (and (null folder) 0) | ||
| 401 | (with-temp-buffer | ||
| 402 | (call-process (expand-file-name "flist" mh-progs) nil t nil | ||
| 403 | "-norecurse" folder) | ||
| 404 | (goto-char (point-min)) | ||
| 405 | (unless (re-search-forward "out of " (line-end-position) t) | ||
| 406 | (error "Call to flist failed on folder %s" folder)) | ||
| 407 | (car (read-from-string | ||
| 408 | (buffer-substring-no-properties (point) | ||
| 409 | (line-end-position)))))))) | ||
| 410 | |||
| 411 | (defun mh-speed-view (&rest args) | 335 | (defun mh-speed-view (&rest args) |
| 412 | "View folder on current line. | 336 | "View folder on current line. |
| 413 | Optional ARGS are ignored." | 337 | Optional ARGS are ignored." |
| 414 | (interactive) | 338 | (interactive) |
| 415 | (declare (ignore args)) | 339 | (declare (ignore args)) |
| 416 | (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) | 340 | (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) |
| 417 | (range | 341 | (range (and (stringp folder) (mh-read-msg-range folder)))) |
| 418 | (cond ((save-excursion | ||
| 419 | (beginning-of-line) | ||
| 420 | (re-search-forward "([1-9][0-9]*/[0-9]+)" | ||
| 421 | (line-end-position) t)) | ||
| 422 | mh-unseen-seq) | ||
| 423 | ((> (mh-speed-folder-size) mh-large-folder) | ||
| 424 | (let* ((size (mh-speed-folder-size)) | ||
| 425 | (prompt | ||
| 426 | (format "How many messages from %s (default: %s): " | ||
| 427 | folder size)) | ||
| 428 | (in (read-string prompt nil nil | ||
| 429 | (number-to-string size))) | ||
| 430 | (result (car (ignore-errors (read-from-string in))))) | ||
| 431 | (cond ((null result) (format "last:%s" size)) | ||
| 432 | ((numberp result) (format "last:%s" result)) | ||
| 433 | (t (format "%s" result))))) | ||
| 434 | (t nil)))) | ||
| 435 | (when (stringp folder) | 342 | (when (stringp folder) |
| 436 | (speedbar-with-attached-buffer | 343 | (speedbar-with-attached-buffer |
| 437 | (mh-visit-folder folder range) | 344 | (mh-visit-folder folder range) |
| @@ -463,19 +370,22 @@ aren't usually mail folders are hidden." | |||
| 463 | (apply #'call-process arg-list) | 370 | (apply #'call-process arg-list) |
| 464 | (goto-char (point-min)) | 371 | (goto-char (point-min)) |
| 465 | (while (not (and (eolp) (bolp))) | 372 | (while (not (and (eolp) (bolp))) |
| 466 | (let ((folder-end (or (search-forward "+ " (line-end-position) t) | 373 | (goto-char (line-end-position)) |
| 467 | (search-forward " " (line-end-position) t)))) | 374 | (let ((has-pos (search-backward " has " (line-beginning-position) t))) |
| 468 | (when (integerp folder-end) | 375 | (when (integerp has-pos) |
| 469 | (let ((name (buffer-substring (line-beginning-position) | 376 | (while (or (equal (char-after has-pos) ? ) |
| 470 | (match-beginning 0)))) | 377 | (equal (char-after has-pos) ?+)) |
| 378 | (decf has-pos)) | ||
| 379 | (incf has-pos) | ||
| 380 | (let ((name (buffer-substring (line-beginning-position) has-pos))) | ||
| 471 | (let ((first-char (substring name 0 1))) | 381 | (let ((first-char (substring name 0 1))) |
| 472 | (unless (or (string-equal first-char ".") | 382 | (unless (or (string-equal first-char ".") |
| 473 | (string-equal first-char "#") | 383 | (string-equal first-char "#") |
| 474 | (string-equal first-char ",")) | 384 | (string-equal first-char ",")) |
| 475 | (push | 385 | (push |
| 476 | (cons name | 386 | (cons name |
| 477 | (search-forward "(others)" (line-end-position) t)) | 387 | (search-forward "(others)" (line-end-position) t)) |
| 478 | results))))) | 388 | results))))) |
| 479 | (forward-line 1)))) | 389 | (forward-line 1)))) |
| 480 | (setq results (nreverse results)) | 390 | (setq results (nreverse results)) |
| 481 | (when (stringp folder) | 391 | (when (stringp folder) |
| @@ -487,6 +397,7 @@ aren't usually mail folders are hidden." | |||
| 487 | results)))) | 397 | results)))) |
| 488 | results)) | 398 | results)) |
| 489 | 399 | ||
| 400 | ;;;###mh-autoload | ||
| 490 | (defun mh-speed-flists (force) | 401 | (defun mh-speed-flists (force) |
| 491 | "Execute flists -recurse and update message counts. | 402 | "Execute flists -recurse and update message counts. |
| 492 | If FORCE is non-nil the timer is reset." | 403 | If FORCE is non-nil the timer is reset." |
| @@ -509,7 +420,8 @@ If FORCE is non-nil the timer is reset." | |||
| 509 | 'exit))) | 420 | 'exit))) |
| 510 | (setq mh-speed-flists-process | 421 | (setq mh-speed-flists-process |
| 511 | (start-process (expand-file-name "flists" mh-progs) nil | 422 | (start-process (expand-file-name "flists" mh-progs) nil |
| 512 | "flists" "-recurse")) | 423 | "flists" "-recurse" |
| 424 | "-sequence" (symbol-name mh-unseen-seq))) | ||
| 513 | (set-process-filter mh-speed-flists-process | 425 | (set-process-filter mh-speed-flists-process |
| 514 | 'mh-speed-parse-flists-output))))))) | 426 | 'mh-speed-parse-flists-output))))))) |
| 515 | 427 | ||
| @@ -527,61 +439,53 @@ next." | |||
| 527 | mh-speed-partial-line | 439 | mh-speed-partial-line |
| 528 | (substring output position line-end)) | 440 | (substring output position line-end)) |
| 529 | mh-speed-partial-line "") | 441 | mh-speed-partial-line "") |
| 530 | (when (string-match "+? " line) | 442 | (multiple-value-setq (folder unseen total) |
| 531 | (setq folder (format "+%s" (subseq line 0 (match-beginning 0)))) | 443 | (mh-parse-flist-output-line line)) |
| 532 | (when (string-match " has " line) | 444 | (when (and folder unseen total) |
| 533 | (setq unseen (car (read-from-string line (match-end 0)))) | 445 | (setf (gethash folder mh-speed-flists-cache) (cons unseen total)) |
| 534 | (when (string-match "; out of " line) | 446 | (save-excursion |
| 535 | (setq total (car (read-from-string line (match-end 0)))) | 447 | (when (buffer-live-p (get-buffer speedbar-buffer)) |
| 536 | (setf (gethash folder mh-speed-flists-cache) | 448 | (set-buffer speedbar-buffer) |
| 537 | (cons unseen total)) | 449 | (speedbar-with-writable |
| 538 | (save-excursion | 450 | (when (get-text-property (point-min) 'mh-level) |
| 539 | (when (buffer-live-p (get-buffer speedbar-buffer)) | 451 | (let ((pos (gethash folder mh-speed-folder-map)) |
| 540 | (set-buffer speedbar-buffer) | 452 | face) |
| 541 | (speedbar-with-writable | 453 | (when pos |
| 542 | (when (get-text-property (point-min) 'mh-level) | 454 | (goto-char pos) |
| 543 | (let ((pos (gethash folder mh-speed-folder-map)) | 455 | (goto-char (line-beginning-position)) |
| 544 | face) | 456 | (cond |
| 545 | (when pos | 457 | ((null (get-text-property (point) 'mh-count)) |
| 546 | (goto-char pos) | 458 | (goto-char (line-end-position)) |
| 547 | (goto-char (line-beginning-position)) | 459 | (setq face (get-text-property (1- (point)) 'face)) |
| 548 | (cond | 460 | (insert (format " (%s/%s)" unseen total)) |
| 549 | ((null (get-text-property (point) 'mh-count)) | 461 | (mh-speed-highlight 'unknown face) |
| 550 | (goto-char (line-end-position)) | 462 | (goto-char (line-beginning-position)) |
| 551 | (setq face (get-text-property (1- (point)) | 463 | (add-text-properties (point) (1+ (point)) |
| 552 | 'face)) | 464 | `(mh-count (,unseen . ,total)))) |
| 553 | (insert (format " (%s/%s)" unseen total)) | 465 | ((not (equal (get-text-property (point) 'mh-count) |
| 554 | (mh-speed-highlight 'unknown face) | 466 | (cons unseen total))) |
| 555 | (goto-char (line-beginning-position)) | 467 | (goto-char (line-end-position)) |
| 556 | (add-text-properties | 468 | (setq face (get-text-property (1- (point)) 'face)) |
| 557 | (point) (1+ (point)) | 469 | (re-search-backward " " (line-beginning-position) t) |
| 558 | `(mh-count (,unseen . ,total)))) | 470 | (delete-region (point) (line-end-position)) |
| 559 | ((not | 471 | (insert (format " (%s/%s)" unseen total)) |
| 560 | (equal (get-text-property (point) 'mh-count) | 472 | (mh-speed-highlight 'unknown face) |
| 561 | (cons unseen total))) | 473 | (goto-char (line-beginning-position)) |
| 562 | (goto-char (line-end-position)) | 474 | (add-text-properties |
| 563 | (setq face (get-text-property (1- (point)) | 475 | (point) (1+ (point)) |
| 564 | 'face)) | 476 | `(mh-count (,unseen . ,total)))))))))))) |
| 565 | (re-search-backward | ||
| 566 | " " (line-beginning-position) t) | ||
| 567 | (delete-region (point) (line-end-position)) | ||
| 568 | (insert (format " (%s/%s)" unseen total)) | ||
| 569 | (mh-speed-highlight 'unknown face) | ||
| 570 | (goto-char (line-beginning-position)) | ||
| 571 | (add-text-properties | ||
| 572 | (point) (1+ (point)) | ||
| 573 | `(mh-count (,unseen . ,total)))))))))))))) | ||
| 574 | (setq position (1+ line-end))) | 477 | (setq position (1+ line-end))) |
| 575 | (set-match-data prevailing-match-data)) | 478 | (set-match-data prevailing-match-data)) |
| 576 | (setq mh-speed-partial-line (subseq output position)))) | 479 | (setq mh-speed-partial-line (substring output position)))) |
| 577 | 480 | ||
| 481 | ;;;###mh-autoload | ||
| 578 | (defun mh-speed-invalidate-map (folder) | 482 | (defun mh-speed-invalidate-map (folder) |
| 579 | "Remove FOLDER from various optimization caches." | 483 | "Remove FOLDER from various optimization caches." |
| 580 | (interactive (list "")) | 484 | (interactive (list "")) |
| 581 | (save-excursion | 485 | (save-excursion |
| 582 | (set-buffer speedbar-buffer) | 486 | (set-buffer speedbar-buffer) |
| 583 | (let* ((speedbar-update-flag nil) | 487 | (let* ((speedbar-update-flag nil) |
| 584 | (last-slash (search "/" folder :from-end t)) | 488 | (last-slash (mh-search-from-end ?/ folder)) |
| 585 | (parent (if last-slash (substring folder 0 last-slash) nil)) | 489 | (parent (if last-slash (substring folder 0 last-slash) nil)) |
| 586 | (parent-position (gethash parent mh-speed-folder-map)) | 490 | (parent-position (gethash parent mh-speed-folder-map)) |
| 587 | (parent-change nil)) | 491 | (parent-change nil)) |
| @@ -615,13 +519,14 @@ next." | |||
| 615 | (when (equal folder "") | 519 | (when (equal folder "") |
| 616 | (clrhash mh-speed-folders-cache))))) | 520 | (clrhash mh-speed-folders-cache))))) |
| 617 | 521 | ||
| 522 | ;;;###mh-autoload | ||
| 618 | (defun mh-speed-add-folder (folder) | 523 | (defun mh-speed-add-folder (folder) |
| 619 | "Add FOLDER since it is being created. | 524 | "Add FOLDER since it is being created. |
| 620 | The function invalidates the latest ancestor that is present." | 525 | The function invalidates the latest ancestor that is present." |
| 621 | (save-excursion | 526 | (save-excursion |
| 622 | (set-buffer speedbar-buffer) | 527 | (set-buffer speedbar-buffer) |
| 623 | (let ((speedbar-update-flag nil) | 528 | (let ((speedbar-update-flag nil) |
| 624 | (last-slash (search "/" folder :from-end t)) | 529 | (last-slash (mh-search-from-end ?/ folder)) |
| 625 | (ancestor folder) | 530 | (ancestor folder) |
| 626 | (ancestor-pos nil)) | 531 | (ancestor-pos nil)) |
| 627 | (block while-loop | 532 | (block while-loop |
| @@ -630,7 +535,7 @@ The function invalidates the latest ancestor that is present." | |||
| 630 | (setq ancestor-pos (gethash ancestor mh-speed-folder-map)) | 535 | (setq ancestor-pos (gethash ancestor mh-speed-folder-map)) |
| 631 | (when ancestor-pos | 536 | (when ancestor-pos |
| 632 | (return-from while-loop)) | 537 | (return-from while-loop)) |
| 633 | (setq last-slash (search "/" ancestor :from-end t)))) | 538 | (setq last-slash (mh-search-from-end ?/ ancestor)))) |
| 634 | (unless ancestor-pos (setq ancestor nil)) | 539 | (unless ancestor-pos (setq ancestor nil)) |
| 635 | (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map))) | 540 | (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map))) |
| 636 | (speedbar-with-writable | 541 | (speedbar-with-writable |
| @@ -650,17 +555,18 @@ The function invalidates the latest ancestor that is present." | |||
| 650 | (save-excursion | 555 | (save-excursion |
| 651 | (beginning-of-line) | 556 | (beginning-of-line) |
| 652 | (if (re-search-forward "\\[.\\]" (line-end-position) t) | 557 | (if (re-search-forward "\\[.\\]" (line-end-position) t) |
| 653 | (speedbar-with-writable | 558 | (speedbar-with-writable |
| 654 | (backward-char 2) | 559 | (backward-char 2) |
| 655 | (delete-char 1) | 560 | (delete-char 1) |
| 656 | (insert-char char 1 t) | 561 | (insert-char char 1 t) |
| 657 | (put-text-property (point) (1- (point)) 'invisible nil) | 562 | (put-text-property (point) (1- (point)) 'invisible nil) |
| 658 | ;; make sure we fix the image on the text here. | 563 | ;; make sure we fix the image on the text here. |
| 659 | (speedbar-insert-image-button-maybe (- (point) 2) 3))))) | 564 | (speedbar-insert-image-button-maybe (- (point) 2) 3))))) |
| 660 | 565 | ||
| 661 | (provide 'mh-speed) | 566 | (provide 'mh-speed) |
| 662 | 567 | ||
| 663 | ;;; Local Variables: | 568 | ;;; Local Variables: |
| 569 | ;;; indent-tabs-mode: nil | ||
| 664 | ;;; sentence-end-double-space: nil | 570 | ;;; sentence-end-double-space: nil |
| 665 | ;;; End: | 571 | ;;; End: |
| 666 | 572 | ||
diff --git a/lisp/mail/mh-utils.el b/lisp/mail/mh-utils.el index 562e7752ff1..320cdf7cbfd 100644 --- a/lisp/mail/mh-utils.el +++ b/lisp/mail/mh-utils.el | |||
| @@ -30,12 +30,24 @@ | |||
| 30 | 30 | ||
| 31 | ;;; Change Log: | 31 | ;;; Change Log: |
| 32 | 32 | ||
| 33 | ;; $Id: mh-utils.el,v 1.177 2002/11/22 20:00:47 satyaki Exp $ | 33 | ;; $Id: mh-utils.el,v 1.193 2003/01/08 00:27:31 satyaki Exp $ |
| 34 | 34 | ||
| 35 | ;;; Code: | 35 | ;;; Code: |
| 36 | 36 | ||
| 37 | ;; Is this XEmacs-land? Located here since needed by mh-customize.el. | ||
| 38 | (defvar mh-xemacs-flag (featurep 'xemacs) | ||
| 39 | "Non-nil means the current Emacs is XEmacs.") | ||
| 40 | |||
| 37 | (require 'cl) | 41 | (require 'cl) |
| 38 | (require 'gnus-util) | 42 | (require 'gnus-util) |
| 43 | (require 'font-lock) | ||
| 44 | (require 'mh-loaddefs) | ||
| 45 | (require 'mh-customize) | ||
| 46 | |||
| 47 | (load "mm-decode" t t) ; Non-fatal dependency | ||
| 48 | (load "mm-view" t t) ; Non-fatal dependency | ||
| 49 | (load "executable" t t) ; Non-fatal dependency on | ||
| 50 | ; executable-find | ||
| 39 | 51 | ||
| 40 | ;; Shush the byte-compiler | 52 | ;; Shush the byte-compiler |
| 41 | (defvar font-lock-auto-fontify) | 53 | (defvar font-lock-auto-fontify) |
| @@ -43,188 +55,13 @@ | |||
| 43 | (defvar mark-active) | 55 | (defvar mark-active) |
| 44 | (defvar tool-bar-mode) | 56 | (defvar tool-bar-mode) |
| 45 | 57 | ||
| 46 | (load "mm-decode" t t) ; Non-fatal dependency | 58 | ;;; Autoloads |
| 47 | (load "mm-view" t t) ; Non-fatal dependency | ||
| 48 | |||
| 49 | (load "executable" t t) ; Non-fatal dependency on | ||
| 50 | ; executable-find | ||
| 51 | |||
| 52 | ;;; Autoload mh-seq | ||
| 53 | (autoload 'mh-add-to-sequence "mh-seq") | ||
| 54 | (autoload 'mh-notate-seq "mh-seq") | ||
| 55 | (autoload 'mh-read-seq-default "mh-seq") | ||
| 56 | (autoload 'mh-map-to-seq-msgs "mh-seq") | ||
| 57 | |||
| 58 | ;;; Autoload mh-e | ||
| 59 | (autoload 'mh-goto-cur-msg "mh-e") | ||
| 60 | (autoload 'mh-update-sequences "mh-e") | ||
| 61 | |||
| 62 | ;;; Autoload mh-mime | ||
| 63 | (autoload 'mh-add-missing-mime-version-header "mh-mime") | ||
| 64 | (autoload 'mh-mime-cleanup "mh-mime") | ||
| 65 | (autoload 'mh-buffer-data "mh-mime" nil nil t) | ||
| 66 | (autoload 'mh-make-buffer-data "mh-mime" nil nil) | ||
| 67 | (autoload 'mh-mime-display "mh-mime") | ||
| 68 | (autoload 'mh-display-smileys "mh-mime") | ||
| 69 | (autoload 'mh-display-emphasis "mh-mime") | ||
| 70 | |||
| 71 | ;;; Autoload mh-index | ||
| 72 | (autoload 'mh-index-search "mh-index" | ||
| 73 | "Perform an indexed search in an MH mail folder. | ||
| 74 | |||
| 75 | FOLDER is searched with SEARCH-REGEXP and the results are presented in an MH-E | ||
| 76 | folder. If FOLDER is \"+\" then mail in all folders are searched. Optional | ||
| 77 | prefix argument NEW-BUFFER-FLAG decides whether the results are presented in a | ||
| 78 | new buffer. This allows multiple search results to coexist. | ||
| 79 | |||
| 80 | Four indexing programs are supported; if none of these are present, then grep | ||
| 81 | is used. This function picks the first program that is available on your | ||
| 82 | system. If you would prefer to use a different program, set the customization | ||
| 83 | variable `mh-index-program' accordingly. | ||
| 84 | |||
| 85 | The documentation for the following functions describes how to generate the | ||
| 86 | index for each program: | ||
| 87 | |||
| 88 | - `mh-swish++-execute-search' | ||
| 89 | - `mh-swish-execute-search' | ||
| 90 | - `mh-namazu-execute-search' | ||
| 91 | - `mh-glimpse-execute-search'" | ||
| 92 | t) | ||
| 93 | ;;; These are here since their docstrings are needed before loading mh-index. | ||
| 94 | (autoload 'mh-swish++-execute-search "mh-index" | ||
| 95 | "Execute swish++ and read the results. | ||
| 96 | |||
| 97 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 98 | directory. | ||
| 99 | |||
| 100 | First create the directory /home/user/Mail/.swish++. Then create the file | ||
| 101 | /home/user/Mail/.swish++/swish++.conf with the following contents: | ||
| 102 | |||
| 103 | IncludeMeta Bcc Cc Comments Content-Description From Keywords | ||
| 104 | IncludeMeta Newsgroups Resent-To Subject To | ||
| 105 | IncludeFile Mail [0-9]* | ||
| 106 | IndexFile /home/user/Mail/.swish++/swish++.index | ||
| 107 | |||
| 108 | Use the following command line to generate the swish index. Run this | ||
| 109 | daily from cron: | ||
| 110 | |||
| 111 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail | ||
| 112 | |||
| 113 | On some systems (Debian GNU/Linux, for example), use index++ instead of index. | ||
| 114 | |||
| 115 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | ||
| 116 | t) | ||
| 117 | (autoload 'mh-swish-execute-search "mh-index" | ||
| 118 | "Execute swish-e and read the results. | ||
| 119 | |||
| 120 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 121 | directory. | ||
| 122 | |||
| 123 | First create the directory /home/user/Mail/.swish. Then create the file | ||
| 124 | /home/user/Mail/.swish/config with the following contents: | ||
| 125 | |||
| 126 | IndexDir /home/user/Mail | ||
| 127 | IndexFile /home/user/Mail/.swish/index | ||
| 128 | IndexName \"Mail Index\" | ||
| 129 | IndexDescription \"Mail Index\" | ||
| 130 | IndexPointer \"http://nowhere\" | ||
| 131 | IndexAdmin \"nobody\" | ||
| 132 | #MetaNames automatic | ||
| 133 | IndexReport 3 | ||
| 134 | FollowSymLinks no | ||
| 135 | UseStemming no | ||
| 136 | IgnoreTotalWordCountWhenRanking yes | ||
| 137 | WordCharacters abcdefghijklmnopqrstuvwxyz0123456789- | ||
| 138 | BeginCharacters abcdefghijklmnopqrstuvwxyz | ||
| 139 | EndCharacters abcdefghijklmnopqrstuvwxyz0123456789 | ||
| 140 | IgnoreLimit 50 1000 | ||
| 141 | IndexComments 0 | ||
| 142 | FileRules pathname contains /home/user/Mail/.swish | ||
| 143 | FileRules filename is index | ||
| 144 | FileRules filename is \..* | ||
| 145 | FileRules filename is #.* | ||
| 146 | FileRules filename is ,.* | ||
| 147 | FileRules filename is .*~ | ||
| 148 | |||
| 149 | If there are any directories you would like to ignore, append lines like the | ||
| 150 | following to config: | ||
| 151 | |||
| 152 | FileRules pathname contains /home/user/Mail/scripts | ||
| 153 | |||
| 154 | Use the following command line to generate the swish index. Run this | ||
| 155 | daily from cron: | ||
| 156 | |||
| 157 | swish-e -c /home/user/Mail/.swish/config | ||
| 158 | |||
| 159 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | ||
| 160 | t) | ||
| 161 | (autoload 'mh-namazu-execute-search "mh-index" | ||
| 162 | "Execute namazu and read the results. | ||
| 163 | |||
| 164 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 165 | directory. | ||
| 166 | |||
| 167 | First create the directory /home/user/Mail/.namazu. Then create the file | ||
| 168 | /home/user/Mail/.namazu/mknmzrc with the following contents: | ||
| 169 | |||
| 170 | package conf; # Don't remove this line! | ||
| 171 | $ADDRESS = 'user@localhost'; | ||
| 172 | $ALLOW_FILE = \"[0-9]*\"; | ||
| 173 | |||
| 174 | Use the following command line to generate the namazu index. Run this | ||
| 175 | daily from cron: | ||
| 176 | |||
| 177 | mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\ | ||
| 178 | /home/user/Mail | ||
| 179 | |||
| 180 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | ||
| 181 | t) | ||
| 182 | (autoload 'mh-glimpse-execute-search "mh-index" | ||
| 183 | "Execute glimpse and read the results. | ||
| 184 | |||
| 185 | In the examples below, replace /home/user/Mail with the path to your MH | ||
| 186 | directory. | ||
| 187 | |||
| 188 | First create the directory /home/user/Mail/.glimpse. Then create the file | ||
| 189 | /home/user/Mail/.glimpse/.glimpse_exclude with the following contents: | ||
| 190 | |||
| 191 | */.* | ||
| 192 | */#* | ||
| 193 | */,* | ||
| 194 | */*~ | ||
| 195 | ^/home/user/Mail/.glimpse | ||
| 196 | |||
| 197 | If there are any directories you would like to ignore, append lines like the | ||
| 198 | following to .glimpse_exclude: | ||
| 199 | |||
| 200 | ^/home/user/Mail/scripts | ||
| 201 | |||
| 202 | Use the following command line to generate the glimpse index. Run this | ||
| 203 | daily from cron: | ||
| 204 | |||
| 205 | glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail | ||
| 206 | |||
| 207 | FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." | ||
| 208 | t) | ||
| 209 | |||
| 210 | ;;; Autoload mh-speed | ||
| 211 | (autoload 'mh-speed-add-folder "mh-speed") | ||
| 212 | |||
| 213 | ;;; Autoload mh-comp | ||
| 214 | (autoload 'mh-reply "mh-comp" nil t) | ||
| 215 | |||
| 216 | ;;; Other Autoloads | ||
| 217 | (autoload 'gnus-article-highlight-citation "gnus-cite") | 59 | (autoload 'gnus-article-highlight-citation "gnus-cite") |
| 218 | (autoload 'mail-header-end "sendmail") | 60 | (autoload 'mail-header-end "sendmail") |
| 219 | (autoload 'Info-goto-node "info") | 61 | (autoload 'Info-goto-node "info") |
| 220 | (autoload 'font-lock-default-fontify-region "font-lock") | ||
| 221 | (unless (fboundp 'make-hash-table) | 62 | (unless (fboundp 'make-hash-table) |
| 222 | (autoload 'make-hash-table "cl")) | 63 | (autoload 'make-hash-table "cl")) |
| 223 | 64 | ||
| 224 | ;; Is this XEmacs-land? | ||
| 225 | (defvar mh-xemacs-flag (featurep 'xemacs) | ||
| 226 | "Non-nil means the current Emacs is XEmacs.") | ||
| 227 | |||
| 228 | ;;; Set for local environment: | 65 | ;;; Set for local environment: |
| 229 | ;;; mh-progs and mh-lib used to be set in paths.el, which tried to | 66 | ;;; mh-progs and mh-lib used to be set in paths.el, which tried to |
| 230 | ;;; figure out at build time which of several possible directories MH | 67 | ;;; figure out at build time which of several possible directories MH |
| @@ -254,217 +91,32 @@ This directory contains, among other things, the mhl program.") | |||
| 254 | ;;;###autoload | 91 | ;;;###autoload |
| 255 | (put 'mh-nmh-flag 'risky-local-variable t) | 92 | (put 'mh-nmh-flag 'risky-local-variable t) |
| 256 | 93 | ||
| 94 | ;;; CL Replacements | ||
| 95 | (defun mh-search-from-end (char string) | ||
| 96 | "Return the position of last occurrence of CHAR in STRING. | ||
| 97 | If CHAR is not present in STRING then return nil. The function is used in lieu | ||
| 98 | of `search' in the CL package." | ||
| 99 | (loop for index from (1- (length string)) downto 0 | ||
| 100 | when (equal (aref string index) char) return index | ||
| 101 | finally return nil)) | ||
| 102 | |||
| 257 | ;;; Macro to generate correct code for different emacs variants | 103 | ;;; Macro to generate correct code for different emacs variants |
| 258 | 104 | ||
| 259 | (defmacro mh-mark-active-p (check-transient-mark-mode-flag) | 105 | (defmacro mh-mark-active-p (check-transient-mark-mode-flag) |
| 260 | "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. | 106 | "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. |
| 261 | In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if | 107 | In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if |
| 262 | variable `transient-mark-mode' is active." | 108 | variable `transient-mark-mode' is active." |
| 263 | (cond (mh-xemacs-flag ;XEmacs | 109 | (cond (mh-xemacs-flag ;XEmacs |
| 264 | `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) | 110 | `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) |
| 265 | ((not check-transient-mark-mode-flag) ;GNU Emacs | 111 | ((not check-transient-mark-mode-flag) ;GNU Emacs |
| 266 | `(and (boundp 'mark-active) mark-active)) | 112 | `(and (boundp 'mark-active) mark-active)) |
| 267 | (t ;GNU Emacs | 113 | (t ;GNU Emacs |
| 268 | `(and (boundp 'transient-mark-mode) transient-mark-mode | 114 | `(and (boundp 'transient-mark-mode) transient-mark-mode |
| 269 | (boundp 'mark-active) mark-active)))) | 115 | (boundp 'mark-active) mark-active)))) |
| 270 | 116 | ||
| 271 | ;;; User preferences: | ||
| 272 | |||
| 273 | (defgroup mh-buffer nil | ||
| 274 | "Layout of MH-E buffers" | ||
| 275 | :prefix "mh-" | ||
| 276 | :group 'mh) | ||
| 277 | |||
| 278 | (defcustom mh-tool-bar-reply-3-buttons-flag nil | ||
| 279 | "*Non-nil means use three buttons for reply commands in tool-bar. | ||
| 280 | If you have room on your tool-bar because you are using a large font, you | ||
| 281 | may set this variable to expand the single reply button into three buttons | ||
| 282 | that won't lead to minibuffer prompt about who to reply to." | ||
| 283 | :type 'boolean | ||
| 284 | :group 'mh) | ||
| 285 | |||
| 286 | (defcustom mh-tool-bar-search-function 'mh-search-folder | ||
| 287 | "*Function called by the tool-bar search button. | ||
| 288 | See `mh-search-folder' and `mh-index-search' for details." | ||
| 289 | :type '(choice (const mh-search-folder) | ||
| 290 | (const mh-index-search) | ||
| 291 | (function :tag "Other function")) | ||
| 292 | :group 'mh) | ||
| 293 | |||
| 294 | (defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode"))) | ||
| 295 | "*Non-nil means that Gnus is used to show MIME attachments with Gnus." | ||
| 296 | :type 'boolean | ||
| 297 | :group 'mh-buffer) | ||
| 298 | |||
| 299 | (defcustom mh-auto-folder-collect-flag t | ||
| 300 | "*Non-nil means immediate collect folder names in the background. | ||
| 301 | If t, MH-E should start a background process to collect the names of all | ||
| 302 | folders as soon as MH-E is first used." | ||
| 303 | :type 'boolean | ||
| 304 | :group 'mh) | ||
| 305 | |||
| 306 | (defcustom mh-recursive-folders-flag nil | ||
| 307 | "*Non-nil means that commands which operate on folders do so recursively." | ||
| 308 | :type 'boolean | ||
| 309 | :group 'mh) | ||
| 310 | |||
| 311 | (defcustom mh-adaptive-cmd-note-flag t | ||
| 312 | "*Non-nil means that the message number width is determined dynamically. | ||
| 313 | This is done once when a folder is first opened by running scan on the last | ||
| 314 | message of the folder. The message number for the last message is extracted | ||
| 315 | and its width calculated. This width is used when calling `mh-set-cmd-note'. | ||
| 316 | |||
| 317 | If you prefer fixed-width message numbers, set this variable to nil and call | ||
| 318 | `mh-set-cmd-note' with the width specified by the scan format in | ||
| 319 | `mh-scan-format-file'. For example, the default width is 4, so you would use | ||
| 320 | \"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil." | ||
| 321 | :type 'boolean | ||
| 322 | :group 'mh) | ||
| 323 | |||
| 324 | (defcustom mh-clean-message-header-flag t | ||
| 325 | "*Non-nil means clean headers of messages that are displayed or inserted. | ||
| 326 | The variables `mh-visible-headers' and `mh-invisible-headers' control what | ||
| 327 | is removed." | ||
| 328 | :type 'boolean | ||
| 329 | :group 'mh-buffer) | ||
| 330 | |||
| 331 | (defcustom mh-visible-headers nil | ||
| 332 | "*Contains a regexp specifying the headers to keep when cleaning. | ||
| 333 | Only used if `mh-clean-message-header-flag' is non-nil. Setting this variable | ||
| 334 | overrides `mh-invisible-headers'." | ||
| 335 | :type '(choice (const nil) regexp) | ||
| 336 | :group 'mh-buffer) | ||
| 337 | |||
| 338 | (defcustom mh-show-use-xface-flag (and window-system | ||
| 339 | (not (null (cond | ||
| 340 | (mh-xemacs-flag | ||
| 341 | (locate-library "x-face")) | ||
| 342 | ((>= emacs-major-version 21) | ||
| 343 | (locate-library "x-face-e21")) | ||
| 344 | (t ;Emacs20 | ||
| 345 | nil)))) | ||
| 346 | (not (null (and (fboundp 'executable-find) | ||
| 347 | (executable-find | ||
| 348 | "uncompface"))))) | ||
| 349 | "*Non-nil means display faces in `mh-show-mode' with external x-face package. | ||
| 350 | It is available from ftp://ftp.jpl.org/pub/elisp/. Download it and put its | ||
| 351 | files in the Emacs `load-path' and MH-E will invoke it automatically for you if | ||
| 352 | this variable is non-nil. | ||
| 353 | |||
| 354 | The `uncompface' binary is also required to be in the execute PATH. It can | ||
| 355 | be obtained from: ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z" | ||
| 356 | :type 'boolean | ||
| 357 | :group 'mh-buffer) | ||
| 358 | |||
| 359 | (defcustom mh-show-maximum-size 0 | ||
| 360 | "*Maximum size of message (in bytes) to display automatically. | ||
| 361 | Provides an opportunity to skip over large messages which may be slow to load. | ||
| 362 | Use a value of 0 to display all messages automatically regardless of size." | ||
| 363 | :type 'integer | ||
| 364 | :group 'mh-buffer) | ||
| 365 | |||
| 366 | (defvar mh-invisible-headers | ||
| 367 | (concat | ||
| 368 | "^" | ||
| 369 | (let ((max-specpdl-size 1000)) ;workaround for insufficient default | ||
| 370 | (regexp-opt | ||
| 371 | (append | ||
| 372 | (if (not mh-show-use-xface-flag) | ||
| 373 | '("X-Face: ")) | ||
| 374 | '( ;; RFC 822 | ||
| 375 | "Received: " "Message-Id: " "Return-Path: " | ||
| 376 | ;; RFC 2045 | ||
| 377 | "Mime-Version" "Content-" | ||
| 378 | ;; sendmail | ||
| 379 | "X-Authentication-Warning: " "X-MIME-Autoconverted: " "From " | ||
| 380 | "Status: " | ||
| 381 | ;; X400 | ||
| 382 | "X400-" "P1-Message-Id: " "Original-Encoded-Information-Types: " | ||
| 383 | "P1-Recipient: " "P1-Content-Type: " "Ua-Content-Id: " | ||
| 384 | ;; MH | ||
| 385 | "Resent" "Prev-Resent" "Forwarded: " "Replied: " "Delivery-Date: " | ||
| 386 | "In-Reply-To: " "Remailed-" "Via: " "Mail-from: " | ||
| 387 | ;; gnus | ||
| 388 | "X-Gnus-Mail-Source: " | ||
| 389 | ;; MS Outlook | ||
| 390 | "X-Priority: " "X-Msmail-" "X-MimeOLE: " "X-Apparently-From: " | ||
| 391 | "Importance: " "Sensitivity: " "X-MS-TNEF-Correlator: " | ||
| 392 | ;; Juno | ||
| 393 | "X-Juno-" | ||
| 394 | ;; Hotmail | ||
| 395 | "X-OriginalArrivalTime: " "X-Originating-IP: " | ||
| 396 | ;; Netscape/Mozilla | ||
| 397 | "X-Accept-Language: " "X-Mozilla-Status: " | ||
| 398 | ;; NTMail | ||
| 399 | "X-Info: " "X-VSMLoop: " | ||
| 400 | ;; News | ||
| 401 | "NNTP-" "X-News: " | ||
| 402 | ;; Mailman mailing list manager | ||
| 403 | "List-" "X-Beenthere: " "X-Mailman-Version: " | ||
| 404 | ;; Egroups/yahoogroups mailing list manager | ||
| 405 | "X-eGroups-" "X-Apparently-To: " "Mailing-List: " "Delivered-To: " | ||
| 406 | ;; SourceForge mailing list manager | ||
| 407 | "X-Original-Date: " | ||
| 408 | ;; Unknown mailing list managers | ||
| 409 | "X-Mailing-List: " "X-Loop: " | ||
| 410 | "List-Subscribe: " "List-Unsubscribe: " | ||
| 411 | "X-List-Subscribe: " "X-List-Unsubscribe: " | ||
| 412 | "X-Listserver: " "List-" "X-List-Host: " | ||
| 413 | ;; Sieve filtering | ||
| 414 | "X-Sieve: " | ||
| 415 | ;; Spam | ||
| 416 | "X-Spam-Status: " "X-Spam-Level: " "X-Spam-Score: " | ||
| 417 | "X-SpamBouncer: " "X-SBClass: " "X-SBRule: " "X-SBNote: " | ||
| 418 | "X-SBPass: " "X-Folder: " | ||
| 419 | "X-Habeas-SWE-1: " "X-Habeas-SWE-2: " "X-Habeas-SWE-3: " | ||
| 420 | "X-Habeas-SWE-4: " "X-Habeas-SWE-5: " "X-Habeas-SWE-6: " | ||
| 421 | "X-Habeas-SWE-7: " "X-Habeas-SWE-8: " "X-Habeas-SWE-9: " | ||
| 422 | ;; Worldtalk gateways | ||
| 423 | "X-Wss-Id: " | ||
| 424 | ;; User added | ||
| 425 | "X-Qotd-" | ||
| 426 | ;; Miscellaneous | ||
| 427 | "X-Sender: " "X-Ack: " "Errors-To: " "Precedence: " "X-Message-Id" | ||
| 428 | "X-From-Line" "X-Cron-Env: " "Delivery: " "X-Delivered" | ||
| 429 | "X-Received: " "X-Vms-To: " "Xref: " "X-Request-" "X-UIDL: " | ||
| 430 | "X-Orcl-Content-Type: " "X-Server-Uuid: " "X-Envelope-Sender: " | ||
| 431 | "X-Envelope-To: " "Encoding: " "Old-Return-Path: " "Path: " | ||
| 432 | "References: " "Lines: " "Autoforwarded: " "Bestservhost: " | ||
| 433 | "X-pgp: " "X-Accept-Language: " "Priority: " "User-Agent: " | ||
| 434 | "X-MIMETrack: " "X-Abuse-Info: " "X-Complaints-To: " | ||
| 435 | "X-No-Archive: " "X-Original-Complaints-To: " | ||
| 436 | "X-Original-Trace: " "X-Received-Date: " "X-Server-Date: " | ||
| 437 | "X-Trace: " "X-UserInfo1: " "X-submission-address: " | ||
| 438 | "X-Scanned-By")) | ||
| 439 | t))) | ||
| 440 | "*Regexp matching lines in a message header that are not to be shown. | ||
| 441 | If `mh-visible-headers' is non-nil, it is used instead to specify what | ||
| 442 | to keep.") | ||
| 443 | |||
| 444 | ;;; Additional header fields that might someday be added: | 117 | ;;; Additional header fields that might someday be added: |
| 445 | ;;; "Sender: " "Reply-to: " | 118 | ;;; "Sender: " "Reply-to: " |
| 446 | 119 | ||
| 447 | (defcustom mh-bury-show-buffer-flag t | ||
| 448 | "*Non-nil means that the displayed show buffer for a folder is buried." | ||
| 449 | :type 'boolean | ||
| 450 | :group 'mh-buffer) | ||
| 451 | |||
| 452 | (defcustom mh-summary-height (or (and (fboundp 'frame-height) | ||
| 453 | (> (frame-height) 24) | ||
| 454 | (min 10 (/ (frame-height) 6))) | ||
| 455 | 4) | ||
| 456 | "*Number of lines in MH-Folder window (including the mode line)." | ||
| 457 | :type 'integer | ||
| 458 | :group 'mh-buffer) | ||
| 459 | |||
| 460 | ;; Use goto-addr if it was already loaded (which probably sets this | ||
| 461 | ;; variable to t), or if this variable is otherwise set to t. | ||
| 462 | (defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p) | ||
| 463 | goto-address-highlight-p) | ||
| 464 | "*Non-nil means URLs and e-mail addresses are highlighted using goto-addr while in `mh-show-mode'." | ||
| 465 | :type 'boolean | ||
| 466 | :group 'mh-buffer) | ||
| 467 | |||
| 468 | (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" | 120 | (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" |
| 469 | "Regexp to find the number of a message in a scan line. | 121 | "Regexp to find the number of a message in a scan line. |
| 470 | The message's number must be surrounded with \\( \\)") | 122 | The message's number must be surrounded with \\( \\)") |
| @@ -485,58 +137,6 @@ Use `0%d' for zero-filled message numbers.") | |||
| 485 | "Format string containing a regexp matching the scan listing for a message. | 137 | "Format string containing a regexp matching the scan listing for a message. |
| 486 | The desired message's number will be an argument to format.") | 138 | The desired message's number will be an argument to format.") |
| 487 | 139 | ||
| 488 | (defcustom mhl-formfile nil | ||
| 489 | "*Name of format file to be used by mhl to show and print messages. | ||
| 490 | A value of t means use the default format file. | ||
| 491 | nil means don't use mhl to format messages when showing; mhl is still used, | ||
| 492 | with the default format file, to format messages when printing them. | ||
| 493 | The format used should specify a non-zero value for overflowoffset so | ||
| 494 | the message continues to conform to RFC 822 and MH-E can parse the headers." | ||
| 495 | :type '(choice (const nil) (const t) string) | ||
| 496 | :group 'mh) | ||
| 497 | (put 'mhl-formfile 'info-file "mh-e") | ||
| 498 | |||
| 499 | (defvar mh-decode-quoted-printable-have-mimedecode | ||
| 500 | (not (null (and (fboundp 'executable-find)(executable-find "mimedecode")))) | ||
| 501 | "Whether the mimedecode command is installed on the system. | ||
| 502 | This sets the default value of variable `mh-decode-quoted-printable-flag' to | ||
| 503 | determine whether quoted-printable MIME parts are decoded by the mimedecode | ||
| 504 | command when viewed in `mh-show'. The source code for mimedecode can be | ||
| 505 | obtained from http://www.freesoft.org/CIE/FAQ/mimedeco.c") | ||
| 506 | |||
| 507 | (defcustom mh-decode-quoted-printable-flag | ||
| 508 | mh-decode-quoted-printable-have-mimedecode | ||
| 509 | "Non-nil means decode quoted-printable MIME part using mimedecode. | ||
| 510 | |||
| 511 | Determine whether to decode quoted-printable MIME parts in `mh-show' | ||
| 512 | using mimedecode. | ||
| 513 | |||
| 514 | Quoted printable content is translated to 8-bit characters in `mh-show' by | ||
| 515 | the gnus' mm-decode library if it is available. Otherwise (and for certain | ||
| 516 | cases mm-decode can't handle) this can be done using the 'mimedecode' | ||
| 517 | command. Setting this variable indicates to use 'mimedecode' when | ||
| 518 | mm-decode is not available or as a helper to it. The source code for | ||
| 519 | mimedecode can usually be obtained from | ||
| 520 | http://www.freesoft.org/CIE/FAQ/mimedeco.c" | ||
| 521 | :type 'boolean | ||
| 522 | :group 'mh-buffer) | ||
| 523 | |||
| 524 | (defcustom mh-update-sequences-after-mh-show-flag t | ||
| 525 | "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'. | ||
| 526 | If set, `mh-update-sequence' is run every time a message is shown, telling | ||
| 527 | MH or nmh that this is your current message. It's useful, for example, to | ||
| 528 | display MIME content using \"M-! mhshow RET\"" | ||
| 529 | :type 'boolean | ||
| 530 | :group 'mh-buffer) | ||
| 531 | |||
| 532 | (defcustom mh-highlight-citation-p 'gnus | ||
| 533 | "How to highlight citations in show buffers. | ||
| 534 | The gnus method uses a different color for each indentation." | ||
| 535 | :type '(choice (const :tag "Use gnus" gnus) | ||
| 536 | (const :tag "Use font-lock" font-lock) | ||
| 537 | (const :tag "Don't fontify" nil)) | ||
| 538 | :group 'mh-buffer) | ||
| 539 | |||
| 540 | (defvar mh-default-folder-for-message-function nil | 140 | (defvar mh-default-folder-for-message-function nil |
| 541 | "Function to select a default folder for refiling or Fcc. | 141 | "Function to select a default folder for refiling or Fcc. |
| 542 | If set to a function, that function is called with no arguments by | 142 | If set to a function, that function is called with no arguments by |
| @@ -575,24 +175,23 @@ Do not make this a regexp as it may be the argument to `insert' and it is | |||
| 575 | passed through `regexp-quote' before being used by functions like | 175 | passed through `regexp-quote' before being used by functions like |
| 576 | `re-search-forward'.") | 176 | `re-search-forward'.") |
| 577 | 177 | ||
| 578 | ;;; Hooks | 178 | ;; Variables for MIME display |
| 579 | |||
| 580 | (defcustom mh-find-path-hook nil | ||
| 581 | "Invoked by `mh-find-path' after reading the user's MH profile." | ||
| 582 | :type 'hook | ||
| 583 | :group 'mh-hook) | ||
| 584 | |||
| 585 | (defcustom mh-show-hook nil | ||
| 586 | "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message." | ||
| 587 | :type 'hook | ||
| 588 | :group 'mh-hook) | ||
| 589 | 179 | ||
| 590 | (defcustom mh-show-mode-hook nil | 180 | ;; Structure to keep track of MIME handles on a per buffer basis. |
| 591 | "Invoked upon entry to `mh-show-mode'." | 181 | (defstruct (mh-buffer-data (:conc-name mh-mime-) |
| 592 | :type 'hook | 182 | (:constructor mh-make-buffer-data)) |
| 593 | :group 'mh-hook) | 183 | (handles ()) ; List of MIME handles |
| 184 | (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of | ||
| 185 | ; nested messages | ||
| 186 | (parts-count 0) ; The button number is generated from | ||
| 187 | ; this number | ||
| 188 | (part-index-hash (make-hash-table))) ; Avoid incrementing the part number | ||
| 189 | ; for nested messages | ||
| 190 | ;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...) | ||
| 191 | (defmacro mh-buffer-data () | ||
| 192 | "Convenience macro to get the MIME data structures of the current buffer." | ||
| 193 | `(gethash (current-buffer) mh-globals-hash)) | ||
| 594 | 194 | ||
| 595 | ;; Variables for MIME display | ||
| 596 | (defvar mh-globals-hash (make-hash-table) | 195 | (defvar mh-globals-hash (make-hash-table) |
| 597 | "Keeps track of MIME data on a per buffer basis.") | 196 | "Keeps track of MIME data on a per buffer basis.") |
| 598 | 197 | ||
| @@ -661,8 +260,8 @@ passed through `regexp-quote' before being used by functions like | |||
| 661 | (locate-library "vcard")))) | 260 | (locate-library "vcard")))) |
| 662 | ("message/delivery-status" mm-inline-text identity) | 261 | ("message/delivery-status" mm-inline-text identity) |
| 663 | ("message/rfc822" mh-mm-inline-message identity) | 262 | ("message/rfc822" mh-mm-inline-message identity) |
| 664 | ;("message/partial" mm-inline-partial identity) | 263 | ;;("message/partial" mm-inline-partial identity) |
| 665 | ;("message/external-body" mm-inline-external-body identity) | 264 | ;;("message/external-body" mm-inline-external-body identity) |
| 666 | ("text/.*" mm-inline-text identity) | 265 | ("text/.*" mm-inline-text identity) |
| 667 | ("audio/wav" mm-inline-audio | 266 | ("audio/wav" mm-inline-audio |
| 668 | (lambda (handle) | 267 | (lambda (handle) |
| @@ -701,17 +300,42 @@ This buffer-local variable is used to remember if a MIME insertion was done. | |||
| 701 | Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.") | 300 | Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.") |
| 702 | (make-variable-buffer-local 'mh-mml-compose-insert-flag) | 301 | (make-variable-buffer-local 'mh-mml-compose-insert-flag) |
| 703 | 302 | ||
| 303 | ;; Copy of `goto-address-mail-regexp' | ||
| 304 | (defvar mh-address-mail-regexp | ||
| 305 | "[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+" | ||
| 306 | "A regular expression probably matching an e-mail address.") | ||
| 307 | |||
| 308 | ;; From goto-addr.el, which we don't want to force-load on users. | ||
| 309 | ;;;###mh-autoload | ||
| 310 | (defun mh-goto-address-find-address-at-point () | ||
| 311 | "Find e-mail address around or before point. | ||
| 312 | Then search backwards to beginning of line for the start of an e-mail | ||
| 313 | address. If no e-mail address found, return nil." | ||
| 314 | (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim) | ||
| 315 | (if (or (looking-at mh-address-mail-regexp) ; already at start | ||
| 316 | (and (re-search-forward mh-address-mail-regexp | ||
| 317 | (line-end-position) 'lim) | ||
| 318 | (goto-char (match-beginning 0)))) | ||
| 319 | (match-string-no-properties 0))) | ||
| 320 | |||
| 704 | (defun mh-in-header-p () | 321 | (defun mh-in-header-p () |
| 705 | "Return non-nil if the point is in the header of a draft message." | 322 | "Return non-nil if the point is in the header of a draft message." |
| 706 | (< (point) (mail-header-end))) | 323 | (< (point) (mail-header-end))) |
| 707 | 324 | ||
| 325 | (defun mh-header-field-beginning () | ||
| 326 | "Move to the beginning of the current header field. | ||
| 327 | Handles RFC 822 continuation lines." | ||
| 328 | (beginning-of-line) | ||
| 329 | (while (looking-at "^[ \t]") | ||
| 330 | (forward-line -1))) | ||
| 331 | |||
| 708 | (defun mh-header-field-end () | 332 | (defun mh-header-field-end () |
| 709 | "Move to the end of the current header field. | 333 | "Move to the end of the current header field. |
| 710 | Handles RFC 822 continuation lines." | 334 | Handles RFC 822 continuation lines." |
| 711 | (forward-line 1) | 335 | (forward-line 1) |
| 712 | (while (looking-at "^[ \t]") | 336 | (while (looking-at "^[ \t]") |
| 713 | (forward-line 1)) | 337 | (forward-line 1)) |
| 714 | (backward-char 1)) ;to end of previous line | 338 | (backward-char 1)) ;to end of previous line |
| 715 | 339 | ||
| 716 | (defun mh-letter-header-font-lock (limit) | 340 | (defun mh-letter-header-font-lock (limit) |
| 717 | "Return the entire mail header to font-lock. | 341 | "Return the entire mail header to font-lock. |
| @@ -733,12 +357,12 @@ Argument LIMIT limits search." | |||
| 733 | (let* ((mail-header-end (mail-header-end)) | 357 | (let* ((mail-header-end (mail-header-end)) |
| 734 | (lesser-limit (if (< mail-header-end limit) mail-header-end limit)) | 358 | (lesser-limit (if (< mail-header-end limit) mail-header-end limit)) |
| 735 | (case-fold-search t)) | 359 | (case-fold-search t)) |
| 736 | (when (and (< (point) mail-header-end) ;Only within header | 360 | (when (and (< (point) mail-header-end) ;Only within header |
| 737 | (re-search-forward (format "^%s" field) lesser-limit t)) | 361 | (re-search-forward (format "^%s" field) lesser-limit t)) |
| 738 | (let ((match-one-b (match-beginning 0)) | 362 | (let ((match-one-b (match-beginning 0)) |
| 739 | (match-one-e (match-end 0))) | 363 | (match-one-e (match-end 0))) |
| 740 | (mh-header-field-end) | 364 | (mh-header-field-end) |
| 741 | (if (> (point) limit) ;Don't search for end beyond limit | 365 | (if (> (point) limit) ;Don't search for end beyond limit |
| 742 | (goto-char limit)) | 366 | (goto-char limit)) |
| 743 | (set-match-data (list match-one-b match-one-e | 367 | (set-match-data (list match-one-b match-one-e |
| 744 | (1+ match-one-e) (point))) | 368 | (1+ match-one-e) (point))) |
| @@ -759,88 +383,6 @@ Argument LIMIT limits search." | |||
| 759 | Argument LIMIT limits search." | 383 | Argument LIMIT limits search." |
| 760 | (mh-header-field-font-lock "Subject:" limit)) | 384 | (mh-header-field-font-lock "Subject:" limit)) |
| 761 | 385 | ||
| 762 | (defvar mh-show-to-face 'mh-show-to-face | ||
| 763 | "Face for highlighting the To: header field.") | ||
| 764 | (if (boundp 'facemenu-unlisted-faces) | ||
| 765 | (add-to-list 'facemenu-unlisted-faces "^mh-show")) | ||
| 766 | (defface mh-show-to-face | ||
| 767 | '((((class grayscale) (background light)) | ||
| 768 | (:foreground "DimGray" :underline t)) | ||
| 769 | (((class grayscale) (background dark)) | ||
| 770 | (:foreground "LightGray" :underline t)) | ||
| 771 | (((class color) (background light)) (:foreground "SaddleBrown")) | ||
| 772 | (((class color) (background dark)) (:foreground "burlywood")) | ||
| 773 | (t (:underline t))) | ||
| 774 | "Face for highlighting the To: header field." | ||
| 775 | :group 'mh-buffer) | ||
| 776 | |||
| 777 | (defvar mh-show-from-face 'mh-show-from-face | ||
| 778 | "Face for highlighting the From: header field.") | ||
| 779 | (defface mh-show-from-face | ||
| 780 | '((((class color) (background light)) | ||
| 781 | (:foreground "red3")) | ||
| 782 | (((class color) (background dark)) | ||
| 783 | (:foreground "cyan")) | ||
| 784 | (t | ||
| 785 | (:bold t))) | ||
| 786 | "Face for highlighting the From: header field." | ||
| 787 | :group 'mh-buffer) | ||
| 788 | |||
| 789 | (defvar mh-folder-subject-face 'mh-folder-subject-face | ||
| 790 | "Face for highlighting subject text in MH-Folder buffers.") | ||
| 791 | (if (boundp 'facemenu-unlisted-faces) | ||
| 792 | (add-to-list 'facemenu-unlisted-faces "^mh-folder")) | ||
| 793 | (defface mh-folder-subject-face | ||
| 794 | '((((class color) (background light)) | ||
| 795 | (:foreground "blue4")) | ||
| 796 | (((class color) (background dark)) | ||
| 797 | (:foreground "yellow")) | ||
| 798 | (t | ||
| 799 | (:bold t))) | ||
| 800 | "Face for highlighting subject text in MH-Folder buffers." | ||
| 801 | :group 'mh) | ||
| 802 | (defvar mh-show-subject-face 'mh-show-subject-face | ||
| 803 | "Face for highlighting the Subject header field.") | ||
| 804 | (copy-face 'mh-folder-subject-face 'mh-show-subject-face) | ||
| 805 | |||
| 806 | (defvar mh-show-cc-face 'mh-show-cc-face | ||
| 807 | "Face for highlighting cc header fields.") | ||
| 808 | (defface mh-show-cc-face | ||
| 809 | '((((type tty) (class color)) (:foreground "yellow" :weight light)) | ||
| 810 | (((class grayscale) (background light)) | ||
| 811 | (:foreground "Gray90" :bold t :italic t)) | ||
| 812 | (((class grayscale) (background dark)) | ||
| 813 | (:foreground "DimGray" :bold t :italic t)) | ||
| 814 | (((class color) (background light)) (:foreground "DarkGoldenrod")) | ||
| 815 | (((class color) (background dark)) (:foreground "LightGoldenrod")) | ||
| 816 | (t (:bold t :italic t))) | ||
| 817 | "Face for highlighting cc header fields." | ||
| 818 | :group 'mh-buffer) | ||
| 819 | |||
| 820 | (defvar mh-show-date-face 'mh-show-date-face | ||
| 821 | "Face for highlighting the Date header field.") | ||
| 822 | (defface mh-show-date-face | ||
| 823 | '((((type tty) (class color)) (:foreground "green")) | ||
| 824 | (((class grayscale) (background light)) (:foreground "Gray90" :bold t)) | ||
| 825 | (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) | ||
| 826 | (((class color) (background light)) (:foreground "ForestGreen")) | ||
| 827 | (((class color) (background dark)) (:foreground "PaleGreen")) | ||
| 828 | (t (:bold t :underline t))) | ||
| 829 | "Face for highlighting the Date header field." | ||
| 830 | :group 'mh-buffer) | ||
| 831 | |||
| 832 | (defvar mh-show-header-face 'mh-show-header-face | ||
| 833 | "Face used to deemphasize unspecified header fields.") | ||
| 834 | (defface mh-show-header-face | ||
| 835 | '((((type tty) (class color)) (:foreground "green")) | ||
| 836 | (((class grayscale) (background light)) (:foreground "DimGray" :italic t)) | ||
| 837 | (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) | ||
| 838 | (((class color) (background light)) (:foreground "RosyBrown")) | ||
| 839 | (((class color) (background dark)) (:foreground "LightSalmon")) | ||
| 840 | (t (:italic t))) | ||
| 841 | "Face used to deemphasize unspecified header fields." | ||
| 842 | :group 'mh-buffer) | ||
| 843 | |||
| 844 | (eval-and-compile | 386 | (eval-and-compile |
| 845 | ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite' | 387 | ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite' |
| 846 | (defvar mh-show-font-lock-keywords | 388 | (defvar mh-show-font-lock-keywords |
| @@ -848,12 +390,12 @@ Argument LIMIT limits search." | |||
| 848 | (mh-header-to-font-lock (0 'default) (1 mh-show-to-face)) | 390 | (mh-header-to-font-lock (0 'default) (1 mh-show-to-face)) |
| 849 | (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face)) | 391 | (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face)) |
| 850 | ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$" | 392 | ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$" |
| 851 | (1 'default) (2 mh-show-from-face)) | 393 | (1 'default) (2 mh-show-from-face)) |
| 852 | (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face)) | 394 | (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face)) |
| 853 | ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)" | 395 | ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)" |
| 854 | (1 'default) (2 mh-show-cc-face)) | 396 | (1 'default) (2 mh-show-cc-face)) |
| 855 | ("^\\(In-reply-to\\|Date\\):\\(.*\\)$" | 397 | ("^\\(In-reply-to\\|Date\\):\\(.*\\)$" |
| 856 | (1 'default) (2 mh-show-date-face)) | 398 | (1 'default) (2 mh-show-date-face)) |
| 857 | (mh-letter-header-font-lock (0 mh-show-header-face append t))) | 399 | (mh-letter-header-font-lock (0 mh-show-header-face append t))) |
| 858 | "Additional expressions to highlight in MH-show mode.")) | 400 | "Additional expressions to highlight in MH-show mode.")) |
| 859 | 401 | ||
| @@ -895,9 +437,9 @@ message about the fontification operation." | |||
| 895 | (if mh-xemacs-flag | 437 | (if mh-xemacs-flag |
| 896 | (progn | 438 | (progn |
| 897 | (eval-and-compile | 439 | (eval-and-compile |
| 898 | (require 'gnus) | 440 | (require 'gnus) |
| 899 | (require 'gnus-art) | 441 | (require 'gnus-art) |
| 900 | (require 'gnus-cite)))) | 442 | (require 'gnus-cite)))) |
| 901 | 443 | ||
| 902 | (defun mh-gnus-article-highlight-citation () | 444 | (defun mh-gnus-article-highlight-citation () |
| 903 | "Highlight cited text in current buffer using gnus." | 445 | "Highlight cited text in current buffer using gnus." |
| @@ -914,9 +456,9 @@ message about the fontification operation." | |||
| 914 | ;; style? | 456 | ;; style? |
| 915 | (flet ((gnus-article-add-button (&rest args) nil)) | 457 | (flet ((gnus-article-add-button (&rest args) nil)) |
| 916 | (let* ((modified (buffer-modified-p)) | 458 | (let* ((modified (buffer-modified-p)) |
| 917 | (gnus-article-buffer (buffer-name)) | 459 | (gnus-article-buffer (buffer-name)) |
| 918 | (gnus-cite-face-list `(,@(cdr gnus-cite-face-list) | 460 | (gnus-cite-face-list `(,@(cdr gnus-cite-face-list) |
| 919 | ,(car gnus-cite-face-list)))) | 461 | ,(car gnus-cite-face-list)))) |
| 920 | (gnus-article-highlight-citation t) | 462 | (gnus-article-highlight-citation t) |
| 921 | (set-buffer-modified-p modified)))) | 463 | (set-buffer-modified-p modified)))) |
| 922 | 464 | ||
| @@ -993,9 +535,9 @@ message about the fontification operation." | |||
| 993 | "Change whether messages should be displayed. | 535 | "Change whether messages should be displayed. |
| 994 | With arg, display messages iff ARG is positive." | 536 | With arg, display messages iff ARG is positive." |
| 995 | (setq mh-showing-mode | 537 | (setq mh-showing-mode |
| 996 | (if (null arg) | 538 | (if (null arg) |
| 997 | (not mh-showing-mode) | 539 | (not mh-showing-mode) |
| 998 | (> (prefix-numeric-value arg) 0)))) | 540 | (> (prefix-numeric-value arg) 0)))) |
| 999 | 541 | ||
| 1000 | ;; The sequences of this folder. An alist of (seq . msgs). | 542 | ;; The sequences of this folder. An alist of (seq . msgs). |
| 1001 | (defvar mh-seq-list nil) | 543 | (defvar mh-seq-list nil) |
| @@ -1020,14 +562,14 @@ flag is unchanged, otherwise it is cleared." | |||
| 1020 | (setq save-modification-flag (car save-modification-flag)) ; CL style | 562 | (setq save-modification-flag (car save-modification-flag)) ; CL style |
| 1021 | `(prog1 | 563 | `(prog1 |
| 1022 | (let ((mh-folder-updating-mod-flag (buffer-modified-p)) | 564 | (let ((mh-folder-updating-mod-flag (buffer-modified-p)) |
| 1023 | (buffer-read-only nil) | 565 | (buffer-read-only nil) |
| 1024 | (buffer-file-name nil)) ;don't let the buffer get locked | 566 | (buffer-file-name nil)) ;don't let the buffer get locked |
| 1025 | (prog1 | 567 | (prog1 |
| 1026 | (progn | 568 | (progn |
| 1027 | ,@body) | 569 | ,@body) |
| 1028 | (mh-set-folder-modified-p mh-folder-updating-mod-flag))) | 570 | (mh-set-folder-modified-p mh-folder-updating-mod-flag))) |
| 1029 | ,@(if (not save-modification-flag) | 571 | ,@(if (not save-modification-flag) |
| 1030 | '((mh-set-folder-modified-p nil))))) | 572 | '((mh-set-folder-modified-p nil))))) |
| 1031 | 573 | ||
| 1032 | (put 'with-mh-folder-updating 'lisp-indent-hook 1) | 574 | (put 'with-mh-folder-updating 'lisp-indent-hook 1) |
| 1033 | 575 | ||
| @@ -1035,12 +577,12 @@ flag is unchanged, otherwise it is cleared." | |||
| 1035 | "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY). | 577 | "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY). |
| 1036 | Display buffer SHOW-BUFFER in other window and execute BODY in it. | 578 | Display buffer SHOW-BUFFER in other window and execute BODY in it. |
| 1037 | Stronger than `save-excursion', weaker than `save-window-excursion'." | 579 | Stronger than `save-excursion', weaker than `save-window-excursion'." |
| 1038 | (setq show-buffer (car show-buffer)) ; CL style | 580 | (setq show-buffer (car show-buffer)) ; CL style |
| 1039 | `(let ((mh-in-show-buffer-saved-window (selected-window))) | 581 | `(let ((mh-in-show-buffer-saved-window (selected-window))) |
| 1040 | (switch-to-buffer-other-window ,show-buffer) | 582 | (switch-to-buffer-other-window ,show-buffer) |
| 1041 | (if mh-bury-show-buffer-flag (bury-buffer (current-buffer))) | 583 | (if mh-bury-show-buffer-flag (bury-buffer (current-buffer))) |
| 1042 | (unwind-protect | 584 | (unwind-protect |
| 1043 | (progn | 585 | (progn |
| 1044 | ,@body) | 586 | ,@body) |
| 1045 | (select-window mh-in-show-buffer-saved-window)))) | 587 | (select-window mh-in-show-buffer-saved-window)))) |
| 1046 | 588 | ||
| @@ -1089,20 +631,21 @@ Stronger than `save-excursion', weaker than `save-window-excursion'." | |||
| 1089 | "Invalidate the show buffer so we must update it to use it." | 631 | "Invalidate the show buffer so we must update it to use it." |
| 1090 | (if (get-buffer mh-show-buffer) | 632 | (if (get-buffer mh-show-buffer) |
| 1091 | (save-excursion | 633 | (save-excursion |
| 1092 | (set-buffer mh-show-buffer) | 634 | (set-buffer mh-show-buffer) |
| 1093 | (mh-unvisit-file)))) | 635 | (mh-unvisit-file)))) |
| 1094 | 636 | ||
| 1095 | (defun mh-unvisit-file () | 637 | (defun mh-unvisit-file () |
| 1096 | "Separate current buffer from the message file it was visiting." | 638 | "Separate current buffer from the message file it was visiting." |
| 1097 | (or (not (buffer-modified-p)) | 639 | (or (not (buffer-modified-p)) |
| 1098 | (null buffer-file-name) ;we've been here before | 640 | (null buffer-file-name) ;we've been here before |
| 1099 | (yes-or-no-p (format "Message %s modified; flush changes? " | 641 | (yes-or-no-p (format "Message %s modified; flush changes? " |
| 1100 | (file-name-nondirectory buffer-file-name))) | 642 | (file-name-nondirectory buffer-file-name))) |
| 1101 | (error "Flushing changes not confirmed")) | 643 | (error "Flushing changes not confirmed")) |
| 1102 | (clear-visited-file-modtime) | 644 | (clear-visited-file-modtime) |
| 1103 | (unlock-buffer) | 645 | (unlock-buffer) |
| 1104 | (setq buffer-file-name nil)) | 646 | (setq buffer-file-name nil)) |
| 1105 | 647 | ||
| 648 | ;;;###mh-autoload | ||
| 1106 | (defun mh-get-msg-num (error-if-no-message) | 649 | (defun mh-get-msg-num (error-if-no-message) |
| 1107 | "Return the message number of the displayed message. | 650 | "Return the message number of the displayed message. |
| 1108 | If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is | 651 | If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is |
| @@ -1110,11 +653,11 @@ not pointing to a message." | |||
| 1110 | (save-excursion | 653 | (save-excursion |
| 1111 | (beginning-of-line) | 654 | (beginning-of-line) |
| 1112 | (cond ((looking-at mh-scan-msg-number-regexp) | 655 | (cond ((looking-at mh-scan-msg-number-regexp) |
| 1113 | (string-to-int (buffer-substring (match-beginning 1) | 656 | (string-to-int (buffer-substring (match-beginning 1) |
| 1114 | (match-end 1)))) | 657 | (match-end 1)))) |
| 1115 | (error-if-no-message | 658 | (error-if-no-message |
| 1116 | (error "Cursor not pointing to message")) | 659 | (error "Cursor not pointing to message")) |
| 1117 | (t nil)))) | 660 | (t nil)))) |
| 1118 | 661 | ||
| 1119 | (defun mh-folder-name-p (name) | 662 | (defun mh-folder-name-p (name) |
| 1120 | "Return non-nil if NAME is the name of a folder. | 663 | "Return non-nil if NAME is the name of a folder. |
| @@ -1122,31 +665,31 @@ A name (a string or symbol) can be a folder name if it begins with \"+\"." | |||
| 1122 | (if (symbolp name) | 665 | (if (symbolp name) |
| 1123 | (eq (aref (symbol-name name) 0) ?+) | 666 | (eq (aref (symbol-name name) 0) ?+) |
| 1124 | (and (> (length name) 0) | 667 | (and (> (length name) 0) |
| 1125 | (eq (aref name 0) ?+)))) | 668 | (eq (aref name 0) ?+)))) |
| 1126 | 669 | ||
| 1127 | 670 | ||
| 1128 | (defun mh-expand-file-name (filename &optional default) | 671 | (defun mh-expand-file-name (filename &optional default) |
| 1129 | "Expand FILENAME like `expand-file-name', but also handle MH folder names. | 672 | "Expand FILENAME like `expand-file-name', but also handle MH folder names. |
| 1130 | Any filename that starts with '+' is treated as a folder name. | 673 | Any filename that starts with '+' is treated as a folder name. |
| 1131 | See `expand-file-name' for description of DEFAULT." | 674 | See `expand-file-name' for description of DEFAULT." |
| 1132 | (if (mh-folder-name-p filename) | 675 | (if (mh-folder-name-p filename) |
| 1133 | (expand-file-name (substring filename 1) mh-user-path) | 676 | (expand-file-name (substring filename 1) mh-user-path) |
| 1134 | (expand-file-name filename default))) | 677 | (expand-file-name filename default))) |
| 1135 | 678 | ||
| 1136 | 679 | ||
| 1137 | (defun mh-msg-filename (msg &optional folder) | 680 | (defun mh-msg-filename (msg &optional folder) |
| 1138 | "Return the file name of MSG in FOLDER (default current folder)." | 681 | "Return the file name of MSG in FOLDER (default current folder)." |
| 1139 | (expand-file-name (int-to-string msg) | 682 | (expand-file-name (int-to-string msg) |
| 1140 | (if folder | 683 | (if folder |
| 1141 | (mh-expand-file-name folder) | 684 | (mh-expand-file-name folder) |
| 1142 | mh-folder-filename))) | 685 | mh-folder-filename))) |
| 1143 | 686 | ||
| 1144 | ;;; Infrastructure to generate show-buffer functions from folder functions | 687 | ;;; Infrastructure to generate show-buffer functions from folder functions |
| 1145 | ;;; XEmacs does not have deactivate-mark? What is the equivalent of | 688 | ;;; XEmacs does not have deactivate-mark? What is the equivalent of |
| 1146 | ;;; transient-mark-mode for XEmacs? Should we be restoring the mark in the | 689 | ;;; transient-mark-mode for XEmacs? Should we be restoring the mark in the |
| 1147 | ;;; folder buffer after the operation has been carried out. | 690 | ;;; folder buffer after the operation has been carried out. |
| 1148 | (defmacro mh-defun-show-buffer (function original-function | 691 | (defmacro mh-defun-show-buffer (function original-function |
| 1149 | &optional dont-return) | 692 | &optional dont-return) |
| 1150 | "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer. | 693 | "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer. |
| 1151 | If the buffer we start in is still visible and DONT-RETURN is nil then switch | 694 | If the buffer we start in is still visible and DONT-RETURN is nil then switch |
| 1152 | to it after that." | 695 | to it after that." |
| @@ -1186,9 +729,9 @@ still visible.\n") | |||
| 1186 | ;;; Generate interactive functions for the show buffer from the corresponding | 729 | ;;; Generate interactive functions for the show buffer from the corresponding |
| 1187 | ;;; folder functions. | 730 | ;;; folder functions. |
| 1188 | (mh-defun-show-buffer mh-show-previous-undeleted-msg | 731 | (mh-defun-show-buffer mh-show-previous-undeleted-msg |
| 1189 | mh-previous-undeleted-msg) | 732 | mh-previous-undeleted-msg) |
| 1190 | (mh-defun-show-buffer mh-show-next-undeleted-msg | 733 | (mh-defun-show-buffer mh-show-next-undeleted-msg |
| 1191 | mh-next-undeleted-msg) | 734 | mh-next-undeleted-msg) |
| 1192 | (mh-defun-show-buffer mh-show-quit mh-quit) | 735 | (mh-defun-show-buffer mh-show-quit mh-quit) |
| 1193 | (mh-defun-show-buffer mh-show-delete-msg mh-delete-msg) | 736 | (mh-defun-show-buffer mh-show-delete-msg mh-delete-msg) |
| 1194 | (mh-defun-show-buffer mh-show-refile-msg mh-refile-msg) | 737 | (mh-defun-show-buffer mh-show-refile-msg mh-refile-msg) |
| @@ -1199,22 +742,23 @@ still visible.\n") | |||
| 1199 | (mh-defun-show-buffer mh-show-forward mh-forward t) | 742 | (mh-defun-show-buffer mh-show-forward mh-forward t) |
| 1200 | (mh-defun-show-buffer mh-show-header-display mh-header-display) | 743 | (mh-defun-show-buffer mh-show-header-display mh-header-display) |
| 1201 | (mh-defun-show-buffer mh-show-refile-or-write-again | 744 | (mh-defun-show-buffer mh-show-refile-or-write-again |
| 1202 | mh-refile-or-write-again) | 745 | mh-refile-or-write-again) |
| 1203 | (mh-defun-show-buffer mh-show-show mh-show) | 746 | (mh-defun-show-buffer mh-show-show mh-show) |
| 1204 | (mh-defun-show-buffer mh-show-write-message-to-file | 747 | (mh-defun-show-buffer mh-show-write-message-to-file |
| 1205 | mh-write-msg-to-file) | 748 | mh-write-msg-to-file) |
| 1206 | (mh-defun-show-buffer mh-show-extract-rejected-mail | 749 | (mh-defun-show-buffer mh-show-extract-rejected-mail |
| 1207 | mh-extract-rejected-mail t) | 750 | mh-extract-rejected-mail t) |
| 1208 | (mh-defun-show-buffer mh-show-delete-msg-no-motion | 751 | (mh-defun-show-buffer mh-show-delete-msg-no-motion |
| 1209 | mh-delete-msg-no-motion) | 752 | mh-delete-msg-no-motion) |
| 1210 | (mh-defun-show-buffer mh-show-first-msg mh-first-msg) | 753 | (mh-defun-show-buffer mh-show-first-msg mh-first-msg) |
| 1211 | (mh-defun-show-buffer mh-show-last-msg mh-last-msg) | 754 | (mh-defun-show-buffer mh-show-last-msg mh-last-msg) |
| 1212 | (mh-defun-show-buffer mh-show-copy-msg mh-copy-msg) | 755 | (mh-defun-show-buffer mh-show-copy-msg mh-copy-msg) |
| 1213 | (mh-defun-show-buffer mh-show-edit-again mh-edit-again t) | 756 | (mh-defun-show-buffer mh-show-edit-again mh-edit-again t) |
| 1214 | (mh-defun-show-buffer mh-show-goto-msg mh-goto-msg) | 757 | (mh-defun-show-buffer mh-show-goto-msg mh-goto-msg) |
| 1215 | (mh-defun-show-buffer mh-show-inc-folder mh-inc-folder) | 758 | (mh-defun-show-buffer mh-show-inc-folder mh-inc-folder) |
| 1216 | (mh-defun-show-buffer mh-show-delete-subject | 759 | (mh-defun-show-buffer mh-show-delete-subject-or-thread |
| 1217 | mh-delete-subject) | 760 | mh-delete-subject-or-thread) |
| 761 | (mh-defun-show-buffer mh-show-delete-subject mh-delete-subject) | ||
| 1218 | (mh-defun-show-buffer mh-show-print-msg mh-print-msg) | 762 | (mh-defun-show-buffer mh-show-print-msg mh-print-msg) |
| 1219 | (mh-defun-show-buffer mh-show-send mh-send t) | 763 | (mh-defun-show-buffer mh-show-send mh-send t) |
| 1220 | (mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t) | 764 | (mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t) |
| @@ -1228,7 +772,7 @@ still visible.\n") | |||
| 1228 | (mh-defun-show-buffer mh-show-search-folder mh-search-folder t) | 772 | (mh-defun-show-buffer mh-show-search-folder mh-search-folder t) |
| 1229 | (mh-defun-show-buffer mh-show-undo-folder mh-undo-folder) | 773 | (mh-defun-show-buffer mh-show-undo-folder mh-undo-folder) |
| 1230 | (mh-defun-show-buffer mh-show-delete-msg-from-seq | 774 | (mh-defun-show-buffer mh-show-delete-msg-from-seq |
| 1231 | mh-delete-msg-from-seq) | 775 | mh-delete-msg-from-seq) |
| 1232 | (mh-defun-show-buffer mh-show-delete-seq mh-delete-seq) | 776 | (mh-defun-show-buffer mh-show-delete-seq mh-delete-seq) |
| 1233 | (mh-defun-show-buffer mh-show-list-sequences mh-list-sequences) | 777 | (mh-defun-show-buffer mh-show-list-sequences mh-list-sequences) |
| 1234 | (mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq) | 778 | (mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq) |
| @@ -1236,11 +780,11 @@ still visible.\n") | |||
| 1236 | (mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) | 780 | (mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) |
| 1237 | (mh-defun-show-buffer mh-show-widen mh-widen) | 781 | (mh-defun-show-buffer mh-show-widen mh-widen) |
| 1238 | (mh-defun-show-buffer mh-show-narrow-to-subject | 782 | (mh-defun-show-buffer mh-show-narrow-to-subject |
| 1239 | mh-narrow-to-subject) | 783 | mh-narrow-to-subject) |
| 1240 | (mh-defun-show-buffer mh-show-store-msg mh-store-msg) | 784 | (mh-defun-show-buffer mh-show-store-msg mh-store-msg) |
| 1241 | (mh-defun-show-buffer mh-show-page-digest mh-page-digest) | 785 | (mh-defun-show-buffer mh-show-page-digest mh-page-digest) |
| 1242 | (mh-defun-show-buffer mh-show-page-digest-backwards | 786 | (mh-defun-show-buffer mh-show-page-digest-backwards |
| 1243 | mh-page-digest-backwards) | 787 | mh-page-digest-backwards) |
| 1244 | (mh-defun-show-buffer mh-show-burst-digest mh-burst-digest) | 788 | (mh-defun-show-buffer mh-show-burst-digest mh-burst-digest) |
| 1245 | (mh-defun-show-buffer mh-show-page-msg mh-page-msg) | 789 | (mh-defun-show-buffer mh-show-page-msg mh-page-msg) |
| 1246 | (mh-defun-show-buffer mh-show-previous-page mh-previous-page) | 790 | (mh-defun-show-buffer mh-show-previous-page mh-previous-page) |
| @@ -1251,7 +795,16 @@ still visible.\n") | |||
| 1251 | (mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part) | 795 | (mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part) |
| 1252 | (mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part) | 796 | (mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part) |
| 1253 | (mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads) | 797 | (mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads) |
| 798 | (mh-defun-show-buffer mh-show-thread-delete mh-thread-delete) | ||
| 799 | (mh-defun-show-buffer mh-show-thread-refile mh-thread-refile) | ||
| 1254 | (mh-defun-show-buffer mh-show-update-sequences mh-update-sequences) | 800 | (mh-defun-show-buffer mh-show-update-sequences mh-update-sequences) |
| 801 | (mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg) | ||
| 802 | (mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg) | ||
| 803 | (mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor) | ||
| 804 | (mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling) | ||
| 805 | (mh-defun-show-buffer mh-show-thread-previous-sibling | ||
| 806 | mh-thread-previous-sibling) | ||
| 807 | (mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t) | ||
| 1255 | 808 | ||
| 1256 | ;;; Populate mh-show-mode-map | 809 | ;;; Populate mh-show-mode-map |
| 1257 | (gnus-define-keys mh-show-mode-map | 810 | (gnus-define-keys mh-show-mode-map |
| @@ -1276,18 +829,21 @@ still visible.\n") | |||
| 1276 | "f" mh-show-forward | 829 | "f" mh-show-forward |
| 1277 | "g" mh-show-goto-msg | 830 | "g" mh-show-goto-msg |
| 1278 | "i" mh-show-inc-folder | 831 | "i" mh-show-inc-folder |
| 1279 | "k" mh-show-delete-subject | 832 | "k" mh-show-delete-subject-or-thread |
| 1280 | "l" mh-show-print-msg | 833 | "l" mh-show-print-msg |
| 1281 | "m" mh-show-send | 834 | "m" mh-show-send |
| 1282 | "n" mh-show-next-undeleted-msg | 835 | "n" mh-show-next-undeleted-msg |
| 836 | "\M-n" mh-show-next-unread-msg | ||
| 1283 | "o" mh-show-refile-msg | 837 | "o" mh-show-refile-msg |
| 1284 | "p" mh-show-previous-undeleted-msg | 838 | "p" mh-show-previous-undeleted-msg |
| 839 | "\M-p" mh-show-previous-unread-msg | ||
| 1285 | "q" mh-show-quit | 840 | "q" mh-show-quit |
| 1286 | "r" mh-show-reply | 841 | "r" mh-show-reply |
| 1287 | "s" mh-show-send | 842 | "s" mh-show-send |
| 1288 | "t" mh-show-toggle-showing | 843 | "t" mh-show-toggle-showing |
| 1289 | "u" mh-show-undo | 844 | "u" mh-show-undo |
| 1290 | "x" mh-show-execute-commands | 845 | "x" mh-show-execute-commands |
| 846 | "v" mh-show-index-visit-folder | ||
| 1291 | "|" mh-show-pipe-msg) | 847 | "|" mh-show-pipe-msg) |
| 1292 | 848 | ||
| 1293 | (gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) | 849 | (gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) |
| @@ -1316,7 +872,12 @@ still visible.\n") | |||
| 1316 | 872 | ||
| 1317 | (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) | 873 | (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) |
| 1318 | "?" mh-prefix-help | 874 | "?" mh-prefix-help |
| 1319 | "t" mh-show-toggle-threads) | 875 | "u" mh-show-thread-ancestor |
| 876 | "p" mh-show-thread-previous-sibling | ||
| 877 | "n" mh-show-thread-next-sibling | ||
| 878 | "t" mh-show-toggle-threads | ||
| 879 | "d" mh-show-thread-delete | ||
| 880 | "o" mh-show-thread-refile) | ||
| 1320 | 881 | ||
| 1321 | (gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) | 882 | (gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) |
| 1322 | "?" mh-prefix-help | 883 | "?" mh-prefix-help |
| @@ -1331,13 +892,13 @@ still visible.\n") | |||
| 1331 | ;; Untested... | 892 | ;; Untested... |
| 1332 | (gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map) | 893 | (gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map) |
| 1333 | "?" mh-prefix-help | 894 | "?" mh-prefix-help |
| 1334 | " " mh-show-page-digest | 895 | " " mh-show-page-digest |
| 1335 | "\177" mh-show-page-digest-backwards | 896 | "\177" mh-show-page-digest-backwards |
| 1336 | "b" mh-show-burst-digest) | 897 | "b" mh-show-burst-digest) |
| 1337 | 898 | ||
| 1338 | (gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) | 899 | (gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) |
| 1339 | "?" mh-prefix-help | 900 | "?" mh-prefix-help |
| 1340 | "a" mh-mime-save-parts | 901 | "a" mh-mime-save-parts |
| 1341 | "v" mh-show-toggle-mime-part | 902 | "v" mh-show-toggle-mime-part |
| 1342 | "o" mh-show-save-mime-part | 903 | "o" mh-show-save-mime-part |
| 1343 | "i" mh-show-inline-mime-part | 904 | "i" mh-show-inline-mime-part |
| @@ -1409,91 +970,6 @@ still visible.\n") | |||
| 1409 | "--" | 970 | "--" |
| 1410 | ["Quit MH-E" mh-quit t])) | 971 | ["Quit MH-E" mh-quit t])) |
| 1411 | 972 | ||
| 1412 | (eval-when-compile (defvar tool-bar-map)) | ||
| 1413 | (defvar mh-show-tool-bar-map nil) | ||
| 1414 | (when (and (fboundp 'tool-bar-add-item) | ||
| 1415 | tool-bar-mode) | ||
| 1416 | (setq mh-show-tool-bar-map | ||
| 1417 | (let ((tool-bar-map (make-sparse-keymap))) | ||
| 1418 | (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder | ||
| 1419 | :help "Incorporate new mail in Inbox") | ||
| 1420 | (tool-bar-add-item "attach" 'mh-mime-save-parts | ||
| 1421 | 'mh-showtoolbar-mime-save-parts | ||
| 1422 | :help "Save MIME parts") | ||
| 1423 | |||
| 1424 | (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg | ||
| 1425 | 'mh-showtoolbar-prev :help "Previous message") | ||
| 1426 | (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page | ||
| 1427 | :help "Page this message") | ||
| 1428 | (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg | ||
| 1429 | 'mh-showtoolbar-next :help "Next message") | ||
| 1430 | |||
| 1431 | (tool-bar-add-item "close" 'mh-show-delete-msg 'mh-showtoolbar-delete | ||
| 1432 | :help "Mark for deletion") | ||
| 1433 | (tool-bar-add-item "refile" 'mh-show-refile-msg 'mh-showtoolbar-refile | ||
| 1434 | :help "Refile this message") | ||
| 1435 | (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo | ||
| 1436 | :help "Undo this mark") | ||
| 1437 | (tool-bar-add-item "execute" 'mh-show-execute-commands | ||
| 1438 | 'mh-showtoolbar-exec | ||
| 1439 | :help "Perform moves and deletes") | ||
| 1440 | |||
| 1441 | (tool-bar-add-item "show" 'mh-show-toggle-showing | ||
| 1442 | 'mh-showtoolbar-toggle-show | ||
| 1443 | :help "Toggle showing message") | ||
| 1444 | |||
| 1445 | (cond | ||
| 1446 | (mh-tool-bar-reply-3-buttons-flag | ||
| 1447 | (tool-bar-add-item "reply-from" | ||
| 1448 | (lambda (&optional arg) | ||
| 1449 | (interactive "P") | ||
| 1450 | (set-buffer mh-show-folder-buffer) | ||
| 1451 | (mh-reply (mh-get-msg-num nil) "from" arg)) | ||
| 1452 | 'mh-showtoolbar-reply-from | ||
| 1453 | :help "Reply to \"from\"") | ||
| 1454 | (tool-bar-add-item "reply-to" | ||
| 1455 | (lambda (&optional arg) | ||
| 1456 | (interactive "P") | ||
| 1457 | (set-buffer mh-show-folder-buffer) | ||
| 1458 | (mh-reply (mh-get-msg-num nil) "to" arg)) | ||
| 1459 | 'mh-showtoolbar-reply-to | ||
| 1460 | :help "Reply to \"to\"") | ||
| 1461 | (tool-bar-add-item "reply-all" | ||
| 1462 | (lambda (&optional arg) | ||
| 1463 | (interactive "P") | ||
| 1464 | (set-buffer mh-show-folder-buffer) | ||
| 1465 | (mh-reply (mh-get-msg-num nil) "all" arg)) | ||
| 1466 | 'mh-showtoolbar-reply-all | ||
| 1467 | :help "Reply to \"all\"")) | ||
| 1468 | (t | ||
| 1469 | (tool-bar-add-item "mail/reply2" 'mh-show-reply 'mh-showtoolbar-reply | ||
| 1470 | :help "Reply to this message"))) | ||
| 1471 | (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose | ||
| 1472 | :help "Compose new message") | ||
| 1473 | |||
| 1474 | (tool-bar-add-item "rescan" 'mh-show-rescan-folder | ||
| 1475 | 'mh-showtoolbar-rescan :help "Rescan this folder") | ||
| 1476 | (tool-bar-add-item "repack" 'mh-show-pack-folder 'mh-showtoolbar-pack | ||
| 1477 | :help "Repack this folder") | ||
| 1478 | |||
| 1479 | (tool-bar-add-item "search" | ||
| 1480 | (lambda (&optional arg) | ||
| 1481 | (interactive "P") | ||
| 1482 | (call-interactively mh-tool-bar-search-function)) | ||
| 1483 | 'mh-showtoolbar-search :help "Search") | ||
| 1484 | (tool-bar-add-item "fld_open" 'mh-visit-folder 'mh-showtoolbar-visit | ||
| 1485 | :help "Visit other folder") | ||
| 1486 | |||
| 1487 | (tool-bar-add-item "preferences" (lambda () | ||
| 1488 | (interactive) | ||
| 1489 | (customize-group "mh")) | ||
| 1490 | 'mh-showtoolbar-customize | ||
| 1491 | :help "MH-E preferences") | ||
| 1492 | (tool-bar-add-item "help" (lambda () | ||
| 1493 | (interactive) | ||
| 1494 | (Info-goto-node "(mh-e)Top")) | ||
| 1495 | 'mh-showtoolbar-help :help "Help") | ||
| 1496 | tool-bar-map))) | ||
| 1497 | 973 | ||
| 1498 | ;;; Ensure new buffers won't get this mode if default-major-mode is nil. | 974 | ;;; Ensure new buffers won't get this mode if default-major-mode is nil. |
| 1499 | (put 'mh-show-mode 'mode-class 'special) | 975 | (put 'mh-show-mode 'mode-class 'special) |
| @@ -1508,7 +984,7 @@ be called, with no arguments, upon entry to this mode." | |||
| 1508 | (mh-show-xface) | 984 | (mh-show-xface) |
| 1509 | (mh-show-addr) | 985 | (mh-show-addr) |
| 1510 | (make-local-variable 'font-lock-defaults) | 986 | (make-local-variable 'font-lock-defaults) |
| 1511 | ;(set (make-local-variable 'font-lock-support-mode) nil) | 987 | ;;(set (make-local-variable 'font-lock-support-mode) nil) |
| 1512 | (cond | 988 | (cond |
| 1513 | ((equal mh-highlight-citation-p 'font-lock) | 989 | ((equal mh-highlight-citation-p 'font-lock) |
| 1514 | (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) | 990 | (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) |
| @@ -1521,7 +997,7 @@ be called, with no arguments, upon entry to this mode." | |||
| 1521 | (t | 997 | (t |
| 1522 | (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) | 998 | (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) |
| 1523 | (if (and mh-xemacs-flag | 999 | (if (and mh-xemacs-flag |
| 1524 | font-lock-auto-fontify) | 1000 | font-lock-auto-fontify) |
| 1525 | (turn-on-font-lock)) | 1001 | (turn-on-font-lock)) |
| 1526 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) | 1002 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) |
| 1527 | (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)) | 1003 | (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)) |
| @@ -1550,7 +1026,7 @@ be called, with no arguments, upon entry to this mode." | |||
| 1550 | (if (fboundp 'x-face-xmas-wl-display-x-face) | 1026 | (if (fboundp 'x-face-xmas-wl-display-x-face) |
| 1551 | #'x-face-xmas-wl-display-x-face | 1027 | #'x-face-xmas-wl-display-x-face |
| 1552 | #'ignore)) | 1028 | #'ignore)) |
| 1553 | ((>= emacs-major-version 21) | 1029 | ((and (not mh-xemacs-flag) (>= emacs-major-version 21)) |
| 1554 | (load "x-face-e21" t t) | 1030 | (load "x-face-e21" t t) |
| 1555 | (if (fboundp 'x-face-decode-message-header) | 1031 | (if (fboundp 'x-face-decode-message-header) |
| 1556 | #'x-face-decode-message-header | 1032 | #'x-face-decode-message-header |
| @@ -1561,7 +1037,8 @@ be called, with no arguments, upon entry to this mode." | |||
| 1561 | (defun mh-show-xface () | 1037 | (defun mh-show-xface () |
| 1562 | "Display X-Face." | 1038 | "Display X-Face." |
| 1563 | (when (and mh-show-use-xface-flag | 1039 | (when (and mh-show-use-xface-flag |
| 1564 | (or mh-decode-mime-flag mhl-formfile mh-clean-message-header-flag)) | 1040 | (or mh-decode-mime-flag mhl-formfile |
| 1041 | mh-clean-message-header-flag)) | ||
| 1565 | (funcall mh-show-xface-function))) | 1042 | (funcall mh-show-xface-function))) |
| 1566 | 1043 | ||
| 1567 | (defun mh-maybe-show (&optional msg) | 1044 | (defun mh-maybe-show (&optional msg) |
| @@ -1601,22 +1078,23 @@ arguments, after the message has been displayed." | |||
| 1601 | (mh-showing-mode t) | 1078 | (mh-showing-mode t) |
| 1602 | (setq mh-page-to-next-msg-flag nil) | 1079 | (setq mh-page-to-next-msg-flag nil) |
| 1603 | (let ((folder mh-current-folder) | 1080 | (let ((folder mh-current-folder) |
| 1604 | (clean-message-header mh-clean-message-header-flag) | 1081 | (clean-message-header mh-clean-message-header-flag) |
| 1605 | (show-window (get-buffer-window mh-show-buffer))) | 1082 | (show-window (get-buffer-window mh-show-buffer))) |
| 1606 | (if (not (eq (next-window (minibuffer-window)) (selected-window))) | 1083 | (if (not (eq (next-window (minibuffer-window)) (selected-window))) |
| 1607 | (delete-other-windows)) ; force ourself to the top window | 1084 | (delete-other-windows)) ; force ourself to the top window |
| 1608 | (mh-in-show-buffer (mh-show-buffer) | 1085 | (mh-in-show-buffer (mh-show-buffer) |
| 1609 | (if (and show-window | 1086 | (if (and show-window |
| 1610 | (equal (mh-msg-filename msg folder) buffer-file-name)) | 1087 | (equal (mh-msg-filename msg folder) buffer-file-name)) |
| 1611 | (progn ;just back up to start | 1088 | (progn ;just back up to start |
| 1612 | (goto-char (point-min)) | 1089 | (goto-char (point-min)) |
| 1613 | (if (not clean-message-header) | 1090 | (if (not clean-message-header) |
| 1614 | (mh-start-of-uncleaned-message))) | 1091 | (mh-start-of-uncleaned-message))) |
| 1615 | (mh-display-msg msg folder)))) | 1092 | (mh-display-msg msg folder)))) |
| 1616 | (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split | 1093 | (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split |
| 1617 | (shrink-window (- (window-height) mh-summary-height))) | 1094 | (shrink-window (- (window-height) mh-summary-height))) |
| 1618 | (mh-recenter nil) | 1095 | (mh-recenter nil) |
| 1619 | (if (not (memq msg mh-seen-list)) (setq mh-seen-list (cons msg mh-seen-list))) | 1096 | (if (not (memq msg mh-seen-list)) |
| 1097 | (setq mh-seen-list (cons msg mh-seen-list))) | ||
| 1620 | (when mh-update-sequences-after-mh-show-flag | 1098 | (when mh-update-sequences-after-mh-show-flag |
| 1621 | (mh-update-sequences)) | 1099 | (mh-update-sequences)) |
| 1622 | (run-hooks 'mh-show-hook)) | 1100 | (run-hooks 'mh-show-hook)) |
| @@ -1706,16 +1184,16 @@ Sets the current buffer to the show buffer." | |||
| 1706 | (show-buffer mh-show-buffer) | 1184 | (show-buffer mh-show-buffer) |
| 1707 | (mm-inline-media-tests mh-mm-inline-media-tests)) | 1185 | (mm-inline-media-tests mh-mm-inline-media-tests)) |
| 1708 | (if (not (file-exists-p msg-filename)) | 1186 | (if (not (file-exists-p msg-filename)) |
| 1709 | (error "Message %d does not exist" msg-num)) | 1187 | (error "Message %d does not exist" msg-num)) |
| 1710 | (if (and (> mh-show-maximum-size 0) | 1188 | (if (and (> mh-show-maximum-size 0) |
| 1711 | (> (elt (file-attributes msg-filename) 7) | 1189 | (> (elt (file-attributes msg-filename) 7) |
| 1712 | mh-show-maximum-size) | 1190 | mh-show-maximum-size) |
| 1713 | (not (y-or-n-p | 1191 | (not (y-or-n-p |
| 1714 | (format | 1192 | (format |
| 1715 | "Message %d (%d bytes) exceeds %d bytes. Display it? " | 1193 | "Message %d (%d bytes) exceeds %d bytes. Display it? " |
| 1716 | msg-num (elt (file-attributes msg-filename) 7) | 1194 | msg-num (elt (file-attributes msg-filename) 7) |
| 1717 | mh-show-maximum-size)))) | 1195 | mh-show-maximum-size)))) |
| 1718 | (error "Message %d not displayed" msg-num)) | 1196 | (error "Message %d not displayed" msg-num)) |
| 1719 | (set-buffer show-buffer) | 1197 | (set-buffer show-buffer) |
| 1720 | (cond ((not (equal msg-filename buffer-file-name)) | 1198 | (cond ((not (equal msg-filename buffer-file-name)) |
| 1721 | (mh-unvisit-file) | 1199 | (mh-unvisit-file) |
| @@ -1724,11 +1202,11 @@ Sets the current buffer to the show buffer." | |||
| 1724 | ;; Changing contents, so this hook needs to be reinitialized. | 1202 | ;; Changing contents, so this hook needs to be reinitialized. |
| 1725 | ;; pgp.el uses this. | 1203 | ;; pgp.el uses this. |
| 1726 | (if (boundp 'write-contents-hooks) ;Emacs 19 | 1204 | (if (boundp 'write-contents-hooks) ;Emacs 19 |
| 1727 | (kill-local-variable 'write-contents-hooks)) | 1205 | (kill-local-variable 'write-contents-hooks)) |
| 1728 | (if formfile | 1206 | (if formfile |
| 1729 | (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" | 1207 | (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" |
| 1730 | (if (stringp formfile) | 1208 | (if (stringp formfile) |
| 1731 | (list "-form" formfile)) | 1209 | (list "-form" formfile)) |
| 1732 | msg-filename) | 1210 | msg-filename) |
| 1733 | (insert-file-contents msg-filename)) | 1211 | (insert-file-contents msg-filename)) |
| 1734 | (if mh-decode-quoted-printable-flag | 1212 | (if mh-decode-quoted-printable-flag |
| @@ -1781,27 +1259,27 @@ from the header. VISIBLE-HEADERS contains a regular expression specifying the | |||
| 1781 | lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." | 1259 | lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." |
| 1782 | (let ((case-fold-search t) | 1260 | (let ((case-fold-search t) |
| 1783 | (after-change-functions nil)) ;Work around emacs-20 font-lock bug | 1261 | (after-change-functions nil)) ;Work around emacs-20 font-lock bug |
| 1784 | ;causing an endless loop. | 1262 | ;causing an endless loop. |
| 1785 | (save-restriction | 1263 | (save-restriction |
| 1786 | (goto-char start) | 1264 | (goto-char start) |
| 1787 | (if (search-forward "\n\n" nil 'move) | 1265 | (if (search-forward "\n\n" nil 'move) |
| 1788 | (backward-char 1)) | 1266 | (backward-char 1)) |
| 1789 | (narrow-to-region start (point)) | 1267 | (narrow-to-region start (point)) |
| 1790 | (goto-char (point-min)) | 1268 | (goto-char (point-min)) |
| 1791 | (if visible-headers | 1269 | (if visible-headers |
| 1792 | (while (< (point) (point-max)) | 1270 | (while (< (point) (point-max)) |
| 1793 | (cond ((looking-at visible-headers) | 1271 | (cond ((looking-at visible-headers) |
| 1794 | (forward-line 1) | 1272 | (forward-line 1) |
| 1795 | (while (looking-at "[ \t]") (forward-line 1))) | 1273 | (while (looking-at "[ \t]") (forward-line 1))) |
| 1796 | (t | 1274 | (t |
| 1797 | (mh-delete-line 1) | 1275 | (mh-delete-line 1) |
| 1798 | (while (looking-at "[ \t]") | 1276 | (while (looking-at "[ \t]") |
| 1799 | (mh-delete-line 1))))) | 1277 | (mh-delete-line 1))))) |
| 1800 | (while (re-search-forward invisible-headers nil t) | 1278 | (while (re-search-forward invisible-headers nil t) |
| 1801 | (beginning-of-line) | 1279 | (beginning-of-line) |
| 1802 | (mh-delete-line 1) | 1280 | (mh-delete-line 1) |
| 1803 | (while (looking-at "[ \t]") | 1281 | (while (looking-at "[ \t]") |
| 1804 | (mh-delete-line 1)))) | 1282 | (mh-delete-line 1)))) |
| 1805 | (unlock-buffer)))) | 1283 | (unlock-buffer)))) |
| 1806 | 1284 | ||
| 1807 | (defun mh-delete-line (lines) | 1285 | (defun mh-delete-line (lines) |
| @@ -1813,12 +1291,12 @@ lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." | |||
| 1813 | Null MSG means the message at cursor." | 1291 | Null MSG means the message at cursor." |
| 1814 | (save-excursion | 1292 | (save-excursion |
| 1815 | (if (or (null msg) | 1293 | (if (or (null msg) |
| 1816 | (mh-goto-msg msg t t)) | 1294 | (mh-goto-msg msg t t)) |
| 1817 | (with-mh-folder-updating (t) | 1295 | (with-mh-folder-updating (t) |
| 1818 | (beginning-of-line) | 1296 | (beginning-of-line) |
| 1819 | (forward-char offset) | 1297 | (forward-char offset) |
| 1820 | (delete-char 1) | 1298 | (delete-char 1) |
| 1821 | (insert notation))))) | 1299 | (insert notation))))) |
| 1822 | 1300 | ||
| 1823 | (defun mh-find-msg-get-num (step) | 1301 | (defun mh-find-msg-get-num (step) |
| 1824 | "Return the message number of the message nearest the cursor. | 1302 | "Return the message number of the message nearest the cursor. |
| @@ -1826,18 +1304,18 @@ Jumps over non-message lines, such as inc errors. | |||
| 1826 | If we have to search, STEP tells whether to search forward or backward." | 1304 | If we have to search, STEP tells whether to search forward or backward." |
| 1827 | (or (mh-get-msg-num nil) | 1305 | (or (mh-get-msg-num nil) |
| 1828 | (let ((msg-num nil) | 1306 | (let ((msg-num nil) |
| 1829 | (nreverses 0)) | 1307 | (nreverses 0)) |
| 1830 | (while (and (not msg-num) | 1308 | (while (and (not msg-num) |
| 1831 | (< nreverses 2)) | 1309 | (< nreverses 2)) |
| 1832 | (cond ((eobp) | 1310 | (cond ((eobp) |
| 1833 | (setq step -1) | 1311 | (setq step -1) |
| 1834 | (setq nreverses (1+ nreverses))) | 1312 | (setq nreverses (1+ nreverses))) |
| 1835 | ((bobp) | 1313 | ((bobp) |
| 1836 | (setq step 1) | 1314 | (setq step 1) |
| 1837 | (setq nreverses (1+ nreverses)))) | 1315 | (setq nreverses (1+ nreverses)))) |
| 1838 | (forward-line step) | 1316 | (forward-line step) |
| 1839 | (setq msg-num (mh-get-msg-num nil))) | 1317 | (setq msg-num (mh-get-msg-num nil))) |
| 1840 | msg-num))) | 1318 | msg-num))) |
| 1841 | 1319 | ||
| 1842 | (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) | 1320 | (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) |
| 1843 | "Position the cursor at message NUMBER. | 1321 | "Position the cursor at message NUMBER. |
| @@ -1869,12 +1347,12 @@ Returns nil if the field is not in the buffer." | |||
| 1869 | (let ((case-fold-search t)) | 1347 | (let ((case-fold-search t)) |
| 1870 | (goto-char (point-min)) | 1348 | (goto-char (point-min)) |
| 1871 | (cond ((not (re-search-forward (format "^%s" field) nil t)) nil) | 1349 | (cond ((not (re-search-forward (format "^%s" field) nil t)) nil) |
| 1872 | ((looking-at "[\t ]*$") nil) | 1350 | ((looking-at "[\t ]*$") nil) |
| 1873 | (t | 1351 | (t |
| 1874 | (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) | 1352 | (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) |
| 1875 | (let ((start (match-beginning 1))) | 1353 | (let ((start (match-beginning 1))) |
| 1876 | (end-of-line) | 1354 | (end-of-line) |
| 1877 | (buffer-substring start (point))))))) | 1355 | (buffer-substring start (point))))))) |
| 1878 | 1356 | ||
| 1879 | (defvar mail-user-agent) | 1357 | (defvar mail-user-agent) |
| 1880 | (defvar read-mail-command) | 1358 | (defvar read-mail-command) |
| @@ -1897,44 +1375,44 @@ arguments, after these variable have been set." | |||
| 1897 | ;; Be sure profile is fully expanded before switching buffers | 1375 | ;; Be sure profile is fully expanded before switching buffers |
| 1898 | (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) | 1376 | (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) |
| 1899 | (set-buffer (get-buffer-create mh-temp-buffer)) | 1377 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 1900 | (setq buffer-offer-save nil) ;for people who set default to t | 1378 | (setq buffer-offer-save nil) ;for people who set default to t |
| 1901 | (erase-buffer) | 1379 | (erase-buffer) |
| 1902 | (condition-case err | 1380 | (condition-case err |
| 1903 | (insert-file-contents profile) | 1381 | (insert-file-contents profile) |
| 1904 | (file-error | 1382 | (file-error |
| 1905 | (mh-install profile err))) | 1383 | (mh-install profile err))) |
| 1906 | (setq mh-user-path (mh-get-profile-field "Path:")) | 1384 | (setq mh-user-path (mh-get-profile-field "Path:")) |
| 1907 | (if (not mh-user-path) | 1385 | (if (not mh-user-path) |
| 1908 | (setq mh-user-path "Mail")) | 1386 | (setq mh-user-path "Mail")) |
| 1909 | (setq mh-user-path | 1387 | (setq mh-user-path |
| 1910 | (file-name-as-directory | 1388 | (file-name-as-directory |
| 1911 | (expand-file-name mh-user-path (expand-file-name "~")))) | 1389 | (expand-file-name mh-user-path (expand-file-name "~")))) |
| 1912 | (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) | 1390 | (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) |
| 1913 | (if mh-draft-folder | 1391 | (if mh-draft-folder |
| 1914 | (progn | 1392 | (progn |
| 1915 | (if (not (mh-folder-name-p mh-draft-folder)) | 1393 | (if (not (mh-folder-name-p mh-draft-folder)) |
| 1916 | (setq mh-draft-folder (format "+%s" mh-draft-folder))) | 1394 | (setq mh-draft-folder (format "+%s" mh-draft-folder))) |
| 1917 | (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) | 1395 | (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) |
| 1918 | (error "Draft folder \"%s\" not found. Create it and try again" | 1396 | (error "Draft folder \"%s\" not found. Create it and try again" |
| 1919 | (mh-expand-file-name mh-draft-folder))))) | 1397 | (mh-expand-file-name mh-draft-folder))))) |
| 1920 | (setq mh-inbox (mh-get-profile-field "Inbox:")) | 1398 | (setq mh-inbox (mh-get-profile-field "Inbox:")) |
| 1921 | (cond ((not mh-inbox) | 1399 | (cond ((not mh-inbox) |
| 1922 | (setq mh-inbox "+inbox")) | 1400 | (setq mh-inbox "+inbox")) |
| 1923 | ((not (mh-folder-name-p mh-inbox)) | 1401 | ((not (mh-folder-name-p mh-inbox)) |
| 1924 | (setq mh-inbox (format "+%s" mh-inbox)))) | 1402 | (setq mh-inbox (format "+%s" mh-inbox)))) |
| 1925 | (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) | 1403 | (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) |
| 1926 | (if mh-unseen-seq | 1404 | (if mh-unseen-seq |
| 1927 | (setq mh-unseen-seq (intern mh-unseen-seq)) | 1405 | (setq mh-unseen-seq (intern mh-unseen-seq)) |
| 1928 | (setq mh-unseen-seq 'unseen)) ;old MH default? | 1406 | (setq mh-unseen-seq 'unseen)) ;old MH default? |
| 1929 | (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) | 1407 | (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) |
| 1930 | (if mh-previous-seq | 1408 | (if mh-previous-seq |
| 1931 | (setq mh-previous-seq (intern mh-previous-seq))) | 1409 | (setq mh-previous-seq (intern mh-previous-seq))) |
| 1932 | (run-hooks 'mh-find-path-hook))) | 1410 | (run-hooks 'mh-find-path-hook))) |
| 1933 | (and mh-auto-folder-collect-flag | 1411 | (and mh-auto-folder-collect-flag |
| 1934 | (let ((mh-no-install t)) ;only get folders if MH installed | 1412 | (let ((mh-no-install t)) ;only get folders if MH installed |
| 1935 | (condition-case err | 1413 | (condition-case err |
| 1936 | (mh-make-folder-list-background) | 1414 | (mh-make-folder-list-background) |
| 1937 | (file-error))))) ;so don't complain if not installed | 1415 | (file-error))))) ;so don't complain if not installed |
| 1938 | 1416 | ||
| 1939 | (defun mh-file-command-p (file) | 1417 | (defun mh-file-command-p (file) |
| 1940 | "Return t if file FILE is the name of a executable regular file." | 1418 | "Return t if file FILE is the name of a executable regular file." |
| @@ -1952,7 +1430,7 @@ directory names and set `mh-nmh-flag' if we detect nmh instead of MH." | |||
| 1952 | "/usr/bin/mh/" ;Ultrix 4.2, Linux | 1430 | "/usr/bin/mh/" ;Ultrix 4.2, Linux |
| 1953 | "/usr/new/mh/" ;Ultrix <4.2 | 1431 | "/usr/new/mh/" ;Ultrix <4.2 |
| 1954 | "/usr/contrib/mh/bin/" ;BSDI | 1432 | "/usr/contrib/mh/bin/" ;BSDI |
| 1955 | "/usr/pkg/bin/" ; NetBSD | 1433 | "/usr/pkg/bin/" ; NetBSD |
| 1956 | "/usr/local/bin/" | 1434 | "/usr/local/bin/" |
| 1957 | ) | 1435 | ) |
| 1958 | "mhparam")))) | 1436 | "mhparam")))) |
| @@ -1978,29 +1456,29 @@ directory names and set `mh-nmh-flag' if we detect nmh instead of MH." | |||
| 1978 | mh-nmh-flag t))) | 1456 | mh-nmh-flag t))) |
| 1979 | (kill-buffer tmp-buffer)))) | 1457 | (kill-buffer tmp-buffer)))) |
| 1980 | (unless (and mh-progs mh-lib mh-lib-progs) | 1458 | (unless (and mh-progs mh-lib mh-lib-progs) |
| 1981 | (error "Unable to determine paths from `mhparam' command"))))) | 1459 | (error "Unable to determine paths from `mhparam' command"))))) |
| 1982 | 1460 | ||
| 1983 | (defun mh-path-search (path file) | 1461 | (defun mh-path-search (path file) |
| 1984 | "Search PATH, a list of directory names, for FILE. | 1462 | "Search PATH, a list of directory names, for FILE. |
| 1985 | Returns the element of PATH that contains FILE, or nil if not found." | 1463 | Returns the element of PATH that contains FILE, or nil if not found." |
| 1986 | (while (and path | 1464 | (while (and path |
| 1987 | (not (funcall 'mh-file-command-p | 1465 | (not (funcall 'mh-file-command-p |
| 1988 | (expand-file-name file (car path))))) | 1466 | (expand-file-name file (car path))))) |
| 1989 | (setq path (cdr path))) | 1467 | (setq path (cdr path))) |
| 1990 | (car path)) | 1468 | (car path)) |
| 1991 | 1469 | ||
| 1992 | (defvar mh-no-install nil) ;do not run install-mh | 1470 | (defvar mh-no-install nil) ;do not run install-mh |
| 1993 | 1471 | ||
| 1994 | (defun mh-install (profile error-val) | 1472 | (defun mh-install (profile error-val) |
| 1995 | "Initialize the MH environment. | 1473 | "Initialize the MH environment. |
| 1996 | This is called if we fail to read the PROFILE file. ERROR-VAL is the error | 1474 | This is called if we fail to read the PROFILE file. ERROR-VAL is the error |
| 1997 | that made this call necessary." | 1475 | that made this call necessary." |
| 1998 | (if (or (getenv "MH") | 1476 | (if (or (getenv "MH") |
| 1999 | (file-exists-p profile) | 1477 | (file-exists-p profile) |
| 2000 | mh-no-install) | 1478 | mh-no-install) |
| 2001 | (signal (car error-val) | 1479 | (signal (car error-val) |
| 2002 | (list (format "Cannot read MH profile \"%s\"" profile) | 1480 | (list (format "Cannot read MH profile \"%s\"" profile) |
| 2003 | (car (cdr (cdr error-val)))))) | 1481 | (car (cdr (cdr error-val)))))) |
| 2004 | ;; The "install-mh" command will output a short note which | 1482 | ;; The "install-mh" command will output a short note which |
| 2005 | ;; mh-exec-cmd will display to the user. | 1483 | ;; mh-exec-cmd will display to the user. |
| 2006 | ;; The MH 5 version of install-mh might try prompt the user | 1484 | ;; The MH 5 version of install-mh might try prompt the user |
| @@ -2011,9 +1489,9 @@ that made this call necessary." | |||
| 2011 | (condition-case err | 1489 | (condition-case err |
| 2012 | (insert-file-contents profile) | 1490 | (insert-file-contents profile) |
| 2013 | (file-error | 1491 | (file-error |
| 2014 | (signal (car err) ;re-signal with more specific msg | 1492 | (signal (car err) ;re-signal with more specific msg |
| 2015 | (list (format "Cannot read MH profile \"%s\"" profile) | 1493 | (list (format "Cannot read MH profile \"%s\"" profile) |
| 2016 | (car (cdr (cdr err)))))))) | 1494 | (car (cdr (cdr err)))))))) |
| 2017 | 1495 | ||
| 2018 | (defun mh-set-folder-modified-p (flag) | 1496 | (defun mh-set-folder-modified-p (flag) |
| 2019 | "Mark current folder as modified or unmodified according to FLAG." | 1497 | "Mark current folder as modified or unmodified according to FLAG." |
| @@ -2042,37 +1520,21 @@ The message number width portion of the format is discovered using | |||
| 2042 | (substring fmt end)))) | 1520 | (substring fmt end)))) |
| 2043 | fmt)) | 1521 | fmt)) |
| 2044 | 1522 | ||
| 2045 | (defun mh-set-cmd-note (width) | ||
| 2046 | "Set `mh-cmd-note' to WIDTH characters (minimum of 2). | ||
| 2047 | |||
| 2048 | If `mh-scan-format-file' specifies nil or a filename, then this function | ||
| 2049 | will NOT update `mh-cmd-note'." | ||
| 2050 | ;; Add one to the width to always have whitespace in column zero. | ||
| 2051 | (setq width (max (1+ width) 2)) | ||
| 2052 | (if (and (equal mh-scan-format-file t) | ||
| 2053 | (not (eq mh-cmd-note width))) | ||
| 2054 | (progn | ||
| 2055 | (setq mh-cmd-note width) | ||
| 2056 | ;; Rachet up the default value | ||
| 2057 | (if (< (default-value 'mh-cmd-note) mh-cmd-note) | ||
| 2058 | (setq-default mh-cmd-note mh-cmd-note)))) | ||
| 2059 | mh-cmd-note) | ||
| 2060 | |||
| 2061 | (defun mh-message-number-width (folder) | 1523 | (defun mh-message-number-width (folder) |
| 2062 | "Return the widest message number in this FOLDER." | 1524 | "Return the widest message number in this FOLDER." |
| 2063 | (or mh-progs (mh-find-path)) | 1525 | (or mh-progs (mh-find-path)) |
| 2064 | (let ((tmp-buffer (get-buffer-create mh-temp-buffer)) | 1526 | (let ((tmp-buffer (get-buffer-create mh-temp-buffer)) |
| 2065 | (width 0)) | 1527 | (width 0)) |
| 2066 | (save-excursion | 1528 | (save-excursion |
| 2067 | (set-buffer tmp-buffer) | 1529 | (set-buffer tmp-buffer) |
| 2068 | (erase-buffer) | 1530 | (erase-buffer) |
| 2069 | (apply 'call-process | 1531 | (apply 'call-process |
| 2070 | (expand-file-name "scan" mh-progs) nil '(t nil) nil | 1532 | (expand-file-name "scan" mh-progs) nil '(t nil) nil |
| 2071 | (list folder "last" "-format" "%(msg)")) | 1533 | (list folder "last" "-format" "%(msg)")) |
| 2072 | (goto-char (point-min)) | 1534 | (goto-char (point-min)) |
| 2073 | (if (re-search-forward mh-scan-msg-number-regexp nil 0 1) | 1535 | (if (re-search-forward mh-scan-msg-number-regexp nil 0 1) |
| 2074 | (setq width (length (buffer-substring | 1536 | (setq width (length (buffer-substring |
| 2075 | (match-beginning 1) (match-end 1)))))) | 1537 | (match-beginning 1) (match-end 1)))))) |
| 2076 | width)) | 1538 | width)) |
| 2077 | 1539 | ||
| 2078 | (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag) | 1540 | (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag) |
| @@ -2083,14 +1545,14 @@ addition." | |||
| 2083 | (let ((entry (mh-find-seq seq))) | 1545 | (let ((entry (mh-find-seq seq))) |
| 2084 | (if (and msgs (atom msgs)) (setq msgs (list msgs))) | 1546 | (if (and msgs (atom msgs)) (setq msgs (list msgs))) |
| 2085 | (if (null entry) | 1547 | (if (null entry) |
| 2086 | (setq mh-seq-list | 1548 | (setq mh-seq-list |
| 2087 | (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) | 1549 | (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) |
| 2088 | mh-seq-list)) | 1550 | mh-seq-list)) |
| 2089 | (if msgs (setcdr entry (mh-canonicalize-sequence | 1551 | (if msgs (setcdr entry (mh-canonicalize-sequence |
| 2090 | (append msgs (mh-seq-msgs entry)))))) | 1552 | (append msgs (mh-seq-msgs entry)))))) |
| 2091 | (cond ((not internal-flag) | 1553 | (cond ((not internal-flag) |
| 2092 | (mh-add-to-sequence seq msgs) | 1554 | (mh-add-to-sequence seq msgs) |
| 2093 | (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note)))))) | 1555 | (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note)))))) |
| 2094 | 1556 | ||
| 2095 | (defun mh-canonicalize-sequence (msgs) | 1557 | (defun mh-canonicalize-sequence (msgs) |
| 2096 | "Sort MSGS in decreasing order and remove duplicates." | 1558 | "Sort MSGS in decreasing order and remove duplicates." |
| @@ -2122,54 +1584,54 @@ changed." | |||
| 2122 | ((equal "" default) "? ") | 1584 | ((equal "" default) "? ") |
| 2123 | (t (format " [%s]? " default)))) | 1585 | (t (format " [%s]? " default)))) |
| 2124 | (prompt (format "%s folder%s" prompt default-string)) | 1586 | (prompt (format "%s folder%s" prompt default-string)) |
| 2125 | read-name folder-name) | 1587 | read-name folder-name) |
| 2126 | (if (null mh-folder-list) | 1588 | (if (null mh-folder-list) |
| 2127 | (mh-set-folder-list)) | 1589 | (mh-set-folder-list)) |
| 2128 | (while (and (setq read-name (completing-read prompt mh-folder-list nil nil | 1590 | (while (and (setq read-name (completing-read prompt mh-folder-list nil nil |
| 2129 | "+" 'mh-folder-hist)) | 1591 | "+" 'mh-folder-hist)) |
| 2130 | (equal read-name "") | 1592 | (equal read-name "") |
| 2131 | (equal default ""))) | 1593 | (equal default ""))) |
| 2132 | (cond ((or (equal read-name "") (equal read-name "+")) | 1594 | (cond ((or (equal read-name "") (equal read-name "+")) |
| 2133 | (setq read-name default)) | 1595 | (setq read-name default)) |
| 2134 | ((not (mh-folder-name-p read-name)) | 1596 | ((not (mh-folder-name-p read-name)) |
| 2135 | (setq read-name (format "+%s" read-name)))) | 1597 | (setq read-name (format "+%s" read-name)))) |
| 2136 | (if (or (not read-name) (equal "" read-name)) | 1598 | (if (or (not read-name) (equal "" read-name)) |
| 2137 | (error "No folder specified")) | 1599 | (error "No folder specified")) |
| 2138 | (setq folder-name read-name) | 1600 | (setq folder-name read-name) |
| 2139 | (cond ((and (> (length folder-name) 0) | 1601 | (cond ((and (> (length folder-name) 0) |
| 2140 | (eq (aref folder-name (1- (length folder-name))) ?/)) | 1602 | (eq (aref folder-name (1- (length folder-name))) ?/)) |
| 2141 | (setq folder-name (substring folder-name 0 -1)))) | 1603 | (setq folder-name (substring folder-name 0 -1)))) |
| 2142 | (let ((new-file-flag | 1604 | (let ((new-file-flag |
| 2143 | (not (file-exists-p (mh-expand-file-name folder-name))))) | 1605 | (not (file-exists-p (mh-expand-file-name folder-name))))) |
| 2144 | (cond ((and new-file-flag | 1606 | (cond ((and new-file-flag |
| 2145 | (y-or-n-p | 1607 | (y-or-n-p |
| 2146 | (format "Folder %s does not exist. Create it? " | 1608 | (format "Folder %s does not exist. Create it? " |
| 2147 | folder-name))) | 1609 | folder-name))) |
| 2148 | (message "Creating %s" folder-name) | 1610 | (message "Creating %s" folder-name) |
| 2149 | (mh-exec-cmd-error nil "folder" folder-name) | 1611 | (mh-exec-cmd-error nil "folder" folder-name) |
| 2150 | (when (boundp 'mh-speed-folder-map) | 1612 | (when (boundp 'mh-speed-folder-map) |
| 2151 | (mh-speed-add-folder folder-name)) | 1613 | (mh-speed-add-folder folder-name)) |
| 2152 | (message "Creating %s...done" folder-name) | 1614 | (message "Creating %s...done" folder-name) |
| 2153 | (setq mh-folder-list (cons (list read-name) mh-folder-list)) | 1615 | (setq mh-folder-list (cons (list read-name) mh-folder-list)) |
| 2154 | (run-hooks 'mh-folder-list-change-hook)) | 1616 | (run-hooks 'mh-folder-list-change-hook)) |
| 2155 | (new-file-flag | 1617 | (new-file-flag |
| 2156 | (error "Folder %s is not created" folder-name)) | 1618 | (error "Folder %s is not created" folder-name)) |
| 2157 | ((not (file-directory-p (mh-expand-file-name folder-name))) | 1619 | ((not (file-directory-p (mh-expand-file-name folder-name))) |
| 2158 | (error "\"%s\" is not a directory" | 1620 | (error "\"%s\" is not a directory" |
| 2159 | (mh-expand-file-name folder-name))) | 1621 | (mh-expand-file-name folder-name))) |
| 2160 | ((and (null (assoc read-name mh-folder-list)) | 1622 | ((and (null (assoc read-name mh-folder-list)) |
| 2161 | (null (assoc (concat read-name "/") mh-folder-list))) | 1623 | (null (assoc (concat read-name "/") mh-folder-list))) |
| 2162 | (setq mh-folder-list (cons (list read-name) mh-folder-list)) | 1624 | (setq mh-folder-list (cons (list read-name) mh-folder-list)) |
| 2163 | (run-hooks 'mh-folder-list-change-hook)))) | 1625 | (run-hooks 'mh-folder-list-change-hook)))) |
| 2164 | folder-name)) | 1626 | folder-name)) |
| 2165 | 1627 | ||
| 2166 | (defvar mh-make-folder-list-process nil) ;The background process collecting | 1628 | (defvar mh-make-folder-list-process nil) ;The background process collecting |
| 2167 | ;the folder list. | 1629 | ;the folder list. |
| 2168 | 1630 | ||
| 2169 | (defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built. | 1631 | (defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built. |
| 2170 | 1632 | ||
| 2171 | (defvar mh-folder-list-partial-line "") ;Start of last incomplete line from | 1633 | (defvar mh-folder-list-partial-line "") ;Start of last incomplete line from |
| 2172 | ;folder process. | 1634 | ;folder process. |
| 2173 | 1635 | ||
| 2174 | (defun mh-set-folder-list () | 1636 | (defun mh-set-folder-list () |
| 2175 | "Set `mh-folder-list' correctly. | 1637 | "Set `mh-folder-list' correctly. |
| @@ -2198,47 +1660,47 @@ Call `mh-set-folder-list' to wait for the result." | |||
| 2198 | (mh-find-path)) | 1660 | (mh-find-path)) |
| 2199 | (let ((process-connection-type nil)) | 1661 | (let ((process-connection-type nil)) |
| 2200 | (setq mh-make-folder-list-process | 1662 | (setq mh-make-folder-list-process |
| 2201 | (start-process "folders" nil (expand-file-name "folders" mh-progs) | 1663 | (start-process "folders" nil (expand-file-name "folders" mh-progs) |
| 2202 | "-fast" | 1664 | "-fast" |
| 2203 | (if mh-recursive-folders-flag | 1665 | (if mh-recursive-folders-flag |
| 2204 | "-recurse" | 1666 | "-recurse" |
| 2205 | "-norecurse"))) | 1667 | "-norecurse"))) |
| 2206 | (set-process-filter mh-make-folder-list-process | 1668 | (set-process-filter mh-make-folder-list-process |
| 2207 | 'mh-make-folder-list-filter) | 1669 | 'mh-make-folder-list-filter) |
| 2208 | (process-kill-without-query mh-make-folder-list-process))))) | 1670 | (process-kill-without-query mh-make-folder-list-process))))) |
| 2209 | 1671 | ||
| 2210 | (defun mh-make-folder-list-filter (process output) | 1672 | (defun mh-make-folder-list-filter (process output) |
| 2211 | "Given the PROCESS \"folders -fast\", parse OUTPUT. | 1673 | "Given the PROCESS \"folders -fast\", parse OUTPUT. |
| 2212 | See also `set-process-filter'." | 1674 | See also `set-process-filter'." |
| 2213 | (let ((position 0) | 1675 | (let ((position 0) |
| 2214 | line-end | 1676 | line-end |
| 2215 | new-folder | 1677 | new-folder |
| 2216 | (prevailing-match-data (match-data))) | 1678 | (prevailing-match-data (match-data))) |
| 2217 | (unwind-protect | 1679 | (unwind-protect |
| 2218 | ;; make sure got complete line | 1680 | ;; make sure got complete line |
| 2219 | (while (setq line-end (string-match "\n" output position)) | 1681 | (while (setq line-end (string-match "\n" output position)) |
| 2220 | (setq new-folder (format "+%s%s" | 1682 | (setq new-folder (format "+%s%s" |
| 2221 | mh-folder-list-partial-line | 1683 | mh-folder-list-partial-line |
| 2222 | (substring output position line-end))) | 1684 | (substring output position line-end))) |
| 2223 | (setq mh-folder-list-partial-line "") | 1685 | (setq mh-folder-list-partial-line "") |
| 2224 | ;; is new folder a subfolder of previous? | 1686 | ;; is new folder a subfolder of previous? |
| 2225 | (if (and mh-folder-list-temp | 1687 | (if (and mh-folder-list-temp |
| 2226 | (string-match | 1688 | (string-match |
| 2227 | (regexp-quote | 1689 | (regexp-quote |
| 2228 | (concat (car (car mh-folder-list-temp)) "/")) | 1690 | (concat (car (car mh-folder-list-temp)) "/")) |
| 2229 | new-folder)) | 1691 | new-folder)) |
| 2230 | ;; append slash to parent folder for better completion | 1692 | ;; append slash to parent folder for better completion |
| 2231 | ;; (undone by mh-prompt-for-folder) | 1693 | ;; (undone by mh-prompt-for-folder) |
| 2232 | (setq mh-folder-list-temp | 1694 | (setq mh-folder-list-temp |
| 2233 | (cons | 1695 | (cons |
| 2234 | (list new-folder) | 1696 | (list new-folder) |
| 2235 | (cons | 1697 | (cons |
| 2236 | (list (concat (car (car mh-folder-list-temp)) "/")) | 1698 | (list (concat (car (car mh-folder-list-temp)) "/")) |
| 2237 | (cdr mh-folder-list-temp)))) | 1699 | (cdr mh-folder-list-temp)))) |
| 2238 | (setq mh-folder-list-temp | 1700 | (setq mh-folder-list-temp |
| 2239 | (cons (list new-folder) | 1701 | (cons (list new-folder) |
| 2240 | mh-folder-list-temp))) | 1702 | mh-folder-list-temp))) |
| 2241 | (setq position (1+ line-end))) | 1703 | (setq position (1+ line-end))) |
| 2242 | (set-match-data prevailing-match-data)) | 1704 | (set-match-data prevailing-match-data)) |
| 2243 | (setq mh-folder-list-partial-line (substring output position)))) | 1705 | (setq mh-folder-list-partial-line (substring output position)))) |
| 2244 | 1706 | ||
| @@ -2253,12 +1715,12 @@ The output is not read or parsed by MH-E." | |||
| 2253 | (set-buffer (get-buffer-create mh-temp-buffer)) | 1715 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 2254 | (erase-buffer) | 1716 | (erase-buffer) |
| 2255 | (apply 'call-process | 1717 | (apply 'call-process |
| 2256 | (expand-file-name command mh-progs) nil t nil | 1718 | (expand-file-name command mh-progs) nil t nil |
| 2257 | (mh-list-to-string args)) | 1719 | (mh-list-to-string args)) |
| 2258 | (if (> (buffer-size) 0) | 1720 | (if (> (buffer-size) 0) |
| 2259 | (save-window-excursion | 1721 | (save-window-excursion |
| 2260 | (switch-to-buffer-other-window mh-temp-buffer) | 1722 | (switch-to-buffer-other-window mh-temp-buffer) |
| 2261 | (sit-for 5))))) | 1723 | (sit-for 5))))) |
| 2262 | 1724 | ||
| 2263 | (defun mh-exec-cmd-error (env command &rest args) | 1725 | (defun mh-exec-cmd-error (env command &rest args) |
| 2264 | "In environment ENV, execute mh-command COMMAND with ARGS. | 1726 | "In environment ENV, execute mh-command COMMAND with ARGS. |
| @@ -2268,17 +1730,17 @@ Signals an error if process does not complete successfully." | |||
| 2268 | (set-buffer (get-buffer-create mh-temp-buffer)) | 1730 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 2269 | (erase-buffer) | 1731 | (erase-buffer) |
| 2270 | (let ((status | 1732 | (let ((status |
| 2271 | (if env | 1733 | (if env |
| 2272 | ;; the shell hacks necessary here shows just how broken Unix is | 1734 | ;; the shell hacks necessary here shows just how broken Unix is |
| 2273 | (apply 'call-process "/bin/sh" nil t nil "-c" | 1735 | (apply 'call-process "/bin/sh" nil t nil "-c" |
| 2274 | (format "%s %s ${1+\"$@\"}" | 1736 | (format "%s %s ${1+\"$@\"}" |
| 2275 | env | 1737 | env |
| 2276 | (expand-file-name command mh-progs)) | 1738 | (expand-file-name command mh-progs)) |
| 2277 | command | 1739 | command |
| 2278 | (mh-list-to-string args)) | 1740 | (mh-list-to-string args)) |
| 2279 | (apply 'call-process | 1741 | (apply 'call-process |
| 2280 | (expand-file-name command mh-progs) nil t nil | 1742 | (expand-file-name command mh-progs) nil t nil |
| 2281 | (mh-list-to-string args))))) | 1743 | (mh-list-to-string args))))) |
| 2282 | (mh-handle-process-error command status)))) | 1744 | (mh-handle-process-error command status)))) |
| 2283 | 1745 | ||
| 2284 | (defun mh-exec-cmd-daemon (command &rest args) | 1746 | (defun mh-exec-cmd-daemon (command &rest args) |
| @@ -2288,10 +1750,10 @@ Any output from command is displayed in an asynchronous pop-up window." | |||
| 2288 | (set-buffer (get-buffer-create mh-temp-buffer)) | 1750 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 2289 | (erase-buffer)) | 1751 | (erase-buffer)) |
| 2290 | (let* ((process-connection-type nil) | 1752 | (let* ((process-connection-type nil) |
| 2291 | (process (apply 'start-process | 1753 | (process (apply 'start-process |
| 2292 | command nil | 1754 | command nil |
| 2293 | (expand-file-name command mh-progs) | 1755 | (expand-file-name command mh-progs) |
| 2294 | (mh-list-to-string args)))) | 1756 | (mh-list-to-string args)))) |
| 2295 | (set-process-filter process 'mh-process-daemon))) | 1757 | (set-process-filter process 'mh-process-daemon))) |
| 2296 | 1758 | ||
| 2297 | (defun mh-process-daemon (process output) | 1759 | (defun mh-process-daemon (process output) |
| @@ -2309,14 +1771,20 @@ non-nil, in which case an error is signaled if `call-process' returns non-0." | |||
| 2309 | (set-buffer (get-buffer-create mh-temp-buffer)) | 1771 | (set-buffer (get-buffer-create mh-temp-buffer)) |
| 2310 | (erase-buffer) | 1772 | (erase-buffer) |
| 2311 | (let ((value | 1773 | (let ((value |
| 2312 | (apply 'call-process | 1774 | (apply 'call-process |
| 2313 | (expand-file-name command mh-progs) nil t nil | 1775 | (expand-file-name command mh-progs) nil t nil |
| 2314 | args))) | 1776 | args))) |
| 2315 | (goto-char (point-min)) | 1777 | (goto-char (point-min)) |
| 2316 | (if raise-error | 1778 | (if raise-error |
| 2317 | (mh-handle-process-error command value) | 1779 | (mh-handle-process-error command value) |
| 2318 | value))) | 1780 | value))) |
| 2319 | 1781 | ||
| 1782 | (defun mh-profile-component (component) | ||
| 1783 | "Return COMPONENT value from mhparam, or nil if unset." | ||
| 1784 | (save-excursion | ||
| 1785 | (mh-exec-cmd-quiet nil "mhparam" "-components" component) | ||
| 1786 | (mh-get-profile-field (concat component ":")))) | ||
| 1787 | |||
| 2320 | (defun mh-exchange-point-and-mark-preserving-active-mark () | 1788 | (defun mh-exchange-point-and-mark-preserving-active-mark () |
| 2321 | "Put the mark where point is now, and point where the mark is now. | 1789 | "Put the mark where point is now, and point where the mark is now. |
| 2322 | This command works even when the mark is not active, and preserves whether the | 1790 | This command works even when the mark is not active, and preserves whether the |
| @@ -2338,8 +1806,8 @@ Put the output into buffer after point. Set mark after inserted text. | |||
| 2338 | Output is expected to be shown to user, not parsed by MH-E." | 1806 | Output is expected to be shown to user, not parsed by MH-E." |
| 2339 | (push-mark (point) t) | 1807 | (push-mark (point) t) |
| 2340 | (apply 'call-process | 1808 | (apply 'call-process |
| 2341 | (expand-file-name command mh-progs) nil t display | 1809 | (expand-file-name command mh-progs) nil t display |
| 2342 | (mh-list-to-string args)) | 1810 | (mh-list-to-string args)) |
| 2343 | 1811 | ||
| 2344 | ;; The following is used instead of 'exchange-point-and-mark because the | 1812 | ;; The following is used instead of 'exchange-point-and-mark because the |
| 2345 | ;; latter activates the current region (between point and mark), which | 1813 | ;; latter activates the current region (between point and mark), which |
| @@ -2358,26 +1826,26 @@ Put the output into buffer after point. Set mark after inserted text." | |||
| 2358 | STATUS is return value from `call-process'. | 1826 | STATUS is return value from `call-process'. |
| 2359 | Program output is in current buffer. | 1827 | Program output is in current buffer. |
| 2360 | If output is too long to include in error message, display the buffer." | 1828 | If output is too long to include in error message, display the buffer." |
| 2361 | (cond ((eq status 0) ;success | 1829 | (cond ((eq status 0) ;success |
| 2362 | status) | 1830 | status) |
| 2363 | ((stringp status) ;kill string | 1831 | ((stringp status) ;kill string |
| 2364 | (error "%s: %s" command status)) | 1832 | (error "%s: %s" command status)) |
| 2365 | (t ;exit code | 1833 | (t ;exit code |
| 2366 | (cond | 1834 | (cond |
| 2367 | ((= (buffer-size) 0) ;program produced no error message | 1835 | ((= (buffer-size) 0) ;program produced no error message |
| 2368 | (error "%s: exit code %d" command status)) | 1836 | (error "%s: exit code %d" command status)) |
| 2369 | (t | 1837 | (t |
| 2370 | ;; will error message fit on one line? | 1838 | ;; will error message fit on one line? |
| 2371 | (goto-line 2) | 1839 | (goto-line 2) |
| 2372 | (if (and (< (buffer-size) (frame-width)) | 1840 | (if (and (< (buffer-size) (frame-width)) |
| 2373 | (eobp)) | 1841 | (eobp)) |
| 2374 | (error "%s" | 1842 | (error "%s" |
| 2375 | (buffer-substring 1 (progn (goto-char 1) | 1843 | (buffer-substring 1 (progn (goto-char 1) |
| 2376 | (end-of-line) | 1844 | (end-of-line) |
| 2377 | (point)))) | 1845 | (point)))) |
| 2378 | (display-buffer (current-buffer)) | 1846 | (display-buffer (current-buffer)) |
| 2379 | (error "%s failed with status %d. See error message in other window" | 1847 | (error "%s failed with status %d. See error message in other window" |
| 2380 | command status))))))) | 1848 | command status))))))) |
| 2381 | 1849 | ||
| 2382 | (defun mh-list-to-string (l) | 1850 | (defun mh-list-to-string (l) |
| 2383 | "Flatten the list L and make every element of the new list into a string." | 1851 | "Flatten the list L and make every element of the new list into a string." |
| @@ -2388,22 +1856,23 @@ If output is too long to include in error message, display the buffer." | |||
| 2388 | (let ((new-list nil)) | 1856 | (let ((new-list nil)) |
| 2389 | (while l | 1857 | (while l |
| 2390 | (cond ((null (car l))) | 1858 | (cond ((null (car l))) |
| 2391 | ((symbolp (car l)) | 1859 | ((symbolp (car l)) |
| 2392 | (setq new-list (cons (symbol-name (car l)) new-list))) | 1860 | (setq new-list (cons (symbol-name (car l)) new-list))) |
| 2393 | ((numberp (car l)) | 1861 | ((numberp (car l)) |
| 2394 | (setq new-list (cons (int-to-string (car l)) new-list))) | 1862 | (setq new-list (cons (int-to-string (car l)) new-list))) |
| 2395 | ((equal (car l) "")) | 1863 | ((equal (car l) "")) |
| 2396 | ((stringp (car l)) (setq new-list (cons (car l) new-list))) | 1864 | ((stringp (car l)) (setq new-list (cons (car l) new-list))) |
| 2397 | ((listp (car l)) | 1865 | ((listp (car l)) |
| 2398 | (setq new-list (nconc (mh-list-to-string-1 (car l)) | 1866 | (setq new-list (nconc (mh-list-to-string-1 (car l)) |
| 2399 | new-list))) | 1867 | new-list))) |
| 2400 | (t (error "Bad element in mh-list-to-string: %s" (car l)))) | 1868 | (t (error "Bad element in mh-list-to-string: %s" (car l)))) |
| 2401 | (setq l (cdr l))) | 1869 | (setq l (cdr l))) |
| 2402 | new-list)) | 1870 | new-list)) |
| 2403 | 1871 | ||
| 2404 | (provide 'mh-utils) | 1872 | (provide 'mh-utils) |
| 2405 | 1873 | ||
| 2406 | ;;; Local Variables: | 1874 | ;;; Local Variables: |
| 1875 | ;;; indent-tabs-mode: nil | ||
| 2407 | ;;; sentence-end-double-space: nil | 1876 | ;;; sentence-end-double-space: nil |
| 2408 | ;;; End: | 1877 | ;;; End: |
| 2409 | 1878 | ||
diff --git a/lisp/mail/mh-xemacs-compat.el b/lisp/mail/mh-xemacs-compat.el index f23a77de459..692d792a1bc 100644 --- a/lisp/mail/mh-xemacs-compat.el +++ b/lisp/mail/mh-xemacs-compat.el | |||
| @@ -28,7 +28,7 @@ | |||
| 28 | 28 | ||
| 29 | ;;; Change Log: | 29 | ;;; Change Log: |
| 30 | 30 | ||
| 31 | ;; $Id: mh-xemacs-compat.el,v 1.12 2002/11/02 19:56:50 wohler Exp $ | 31 | ;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $ |
| 32 | 32 | ||
| 33 | ;;; Code: | 33 | ;;; Code: |
| 34 | 34 | ||
| @@ -52,10 +52,10 @@ | |||
| 52 | (unless (fboundp 'cancel-timer) | 52 | (unless (fboundp 'cancel-timer) |
| 53 | (defalias 'cancel-timer 'delete-itimer)) | 53 | (defalias 'cancel-timer 'delete-itimer)) |
| 54 | 54 | ||
| 55 | |||
| 56 | (provide 'mh-xemacs-compat) | 55 | (provide 'mh-xemacs-compat) |
| 57 | 56 | ||
| 58 | ;;; Local Variables: | 57 | ;;; Local Variables: |
| 58 | ;;; indent-tabs-mode: nil | ||
| 59 | ;;; sentence-end-double-space: nil | 59 | ;;; sentence-end-double-space: nil |
| 60 | ;;; End: | 60 | ;;; End: |
| 61 | 61 | ||
diff --git a/lisp/toolbar/alias.pbm b/lisp/toolbar/alias.pbm new file mode 100644 index 00000000000..1ebe932c6d4 --- /dev/null +++ b/lisp/toolbar/alias.pbm | |||
| @@ -0,0 +1,3 @@ | |||
| 1 | P4 | ||
| 2 | 24 24 | ||
| 3 | ÿÿÿÿÿÿÿÿÿýŸÿðÿïûÿÿüïÿÏÿÏïÿÏïÿïÏÿï÷ÿÿãÿçõÿ÷üÿþÿÙÿÿù÷ÿÿ÷ÿÿüÿÿÿÿÿÿÿÿÿ \ No newline at end of file | ||
diff --git a/lisp/toolbar/alias.xpm b/lisp/toolbar/alias.xpm new file mode 100644 index 00000000000..8bf75063bdc --- /dev/null +++ b/lisp/toolbar/alias.xpm | |||
| @@ -0,0 +1,33 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char * alias_xpm[] = { | ||
| 3 | /* columns rows colors chars-per-pixel */ | ||
| 4 | "24 24 4 1", | ||
| 5 | " c None", | ||
| 6 | ". c #61b761b7600a", | ||
| 7 | "X c #a5d8a5d89550", | ||
| 8 | "o c black", | ||
| 9 | /* pixels */ | ||
| 10 | " ", | ||
| 11 | " ", | ||
| 12 | " ", | ||
| 13 | " ...... ", | ||
| 14 | " ...XXXX..XX ", | ||
| 15 | " o..ooooooo... ", | ||
| 16 | " ooo oooo..X ", | ||
| 17 | " o.X ooo... ", | ||
| 18 | " o.X ooo.XX ", | ||
| 19 | " o.X oo.. ", | ||
| 20 | " o.X oo. ", | ||
| 21 | " o... oo.. ", | ||
| 22 | " o.X o.. ", | ||
| 23 | " o.XX oX. ", | ||
| 24 | " o.... oo. ", | ||
| 25 | " o..XX oooo ", | ||
| 26 | " o...XXX XXoooo ", | ||
| 27 | " ooo........ooooo ", | ||
| 28 | " oooooXXooooo.oo ", | ||
| 29 | " ooo o..oo", | ||
| 30 | " o...", | ||
| 31 | " ooo", | ||
| 32 | " oo", | ||
| 33 | " "}; | ||