Mercurial > emacs
changeset 56406:d36b00b98db0
Upgraded to MH-E version 7.4.4.
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
| author | Bill Wohler <wohler@newt.com> |
|---|---|
| date | Tue, 13 Jul 2004 03:06:25 +0000 |
| parents | 10b68aa88abe |
| children | 964174c8a4e8 |
| files | etc/ChangeLog etc/MH-E-NEWS etc/NEWS lisp/mail/reply2.pbm lisp/mh-e/ChangeLog lisp/mh-e/mh-alias.el lisp/mh-e/mh-comp.el lisp/mh-e/mh-customize.el lisp/mh-e/mh-e.el lisp/mh-e/mh-funcs.el lisp/mh-e/mh-gnus.el lisp/mh-e/mh-identity.el lisp/mh-e/mh-index.el lisp/mh-e/mh-junk.el lisp/mh-e/mh-loaddefs.el lisp/mh-e/mh-mime.el lisp/mh-e/mh-seq.el lisp/mh-e/mh-speed.el lisp/mh-e/mh-utils.el lisp/mh-e/mh-xemacs-compat.el lisp/mh-e/mh-xemacs-icons.el lisp/toolbar/alias.pbm lisp/toolbar/execute.pbm lisp/toolbar/highlight.pbm lisp/toolbar/page-down.pbm lisp/toolbar/refile.pbm lisp/toolbar/repack.pbm lisp/toolbar/reply-all.pbm lisp/toolbar/reply-from.pbm lisp/toolbar/reply-to.pbm lisp/toolbar/rescan.pbm lisp/toolbar/show.pbm lisp/toolbar/widen.pbm |
| diffstat | 33 files changed, 4173 insertions(+), 2586 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/ChangeLog Tue Jul 13 01:32:18 2004 +0000 +++ b/etc/ChangeLog Tue Jul 13 03:06:25 2004 +0000 @@ -1,3 +1,7 @@ +2004-07-12 Bill Wohler <wohler@newt.com> + + * NEWS, MH-E-NEWS: Upgraded to MH-E version 7.4.4. + 2004-07-08 David Kastrup <dak@gnu.org> * NEWS (Lisp changes in 21.4): document (match-data t) change.
--- a/etc/MH-E-NEWS Tue Jul 13 01:32:18 2004 +0000 +++ b/etc/MH-E-NEWS Tue Jul 13 03:06:25 2004 +0000 @@ -1,9 +1,242 @@ -Copyright (C) 2003 Free Software Foundation, Inc. +* COPYRIGHT + +Copyright (C) 2003, 2004 Free Software Foundation, Inc. Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. +* Changes in MH-E 7.4.4 + +Version 7.4.4 addresses programmatic issues from the FSF and prepares +MH-E for inclusion into an impending GNU Emacs release (21.4). There +are no user-visible changes (unless you are using XEmacs on DOS or +don't have the cl package installed). Filenames are now unique in +their first 8 characters (DOS 8.3 requirement). The runtime dependency +on the cl package has been removed. Desktop saving and restoration +code moved here from desktop.el. + +* Changes in MH-E 7.4.3 + +Version 7.4.3 fixes the problem where mh-identity-list was not getting +set from .emacs. + +* Changes in MH-E 7.4.2 + +Version 7.4.2 fixes the accidental dependence on nmh (closes SF +#791021). + +* Changes in MH-E 7.4.1 + +Version 7.4.1 fixes the Makefile so it no longer tries to compile +mh-unit.el. + +* Changes in MH-E 7.4 + +Version 7.4 contains many new useful features including arbitrary MH +range handling, new draft features such as draft form editing, as well +as sequence propagation and manipulation. We've also fixed bugs and +added a handful of new variables. + +** New Features in MH-E 7.4 + +*** Add Arbitrary Ranges to MH-E UI + +MH-E now handles any legal MH range (such as last:5 or 4 8 10-12) +wherever you're prompted for a message number or sequence (closes SF +#728638). + +*** Remove Prompting in mh-send + +Brian Reid's original mhe didn't do prompting anywhere but used forms +instead. While we won't go that far, we eliminated prompting where a +form is already involved, such as in composing a message. + +The new customization variable `mh-compose-prompt-flag' can be set to +t to get the original behavior (closes SF #745622). + +*** Use TAB to Switch Fields in Header + +When composing a message, TAB and SHIFT-TAB can be used to move +quickly between header fields. The new customization variable, +`mh-compose-skipped-header-fields', contains a list of header fields +that are skipped and truncated if they are too long (closes SF +#745627). + +*** Alias Completion in Composition Buffer + +Aliases can be completed in the draft with "M-TAB +(mh-letter-complete)". Or, if the customization variable +`mh-compose-space-does-completion-flag' is set to t, then a "SPC +(mh-letter-complete-or-space)" with do the same thing. If +`mh-alias-flash-on-comma' is non-nil, ", (mh-letter-confirm-address)" +will show the alias expansion in the minibuffer (closes SF #745634). + +*** Auto Fields Should be Inserted During Send + +Fields that were inserted by the multiple personality code when the +draft was sent now insert the header fields when the draft is composed +to give you a chance to edit them (closes SF #747890). + +*** mh-index-tick-messages + +The command "F ' (mh-index-ticked-messages)" creates a buffer with all +messages ticked with "' (mh-toggle-tick)" in the folders listed in the +new customization variable `mh-index-ticked-messages-folders'. Chances +are that if you set `mh-index-new-messages-folders', you'll want to +set `mh-index-ticked-messages-folders' accordingly. + +In addition, a general function, "F q (mh-index-sequenced-messages)" +has been provided that displays messages in the `mh-unseen-seq' in the +folders listed `mh-index-new-messages-folders', unless a prefix +argument is given, in which case you can provide both a list of +folders and a sequence (closes SF #718833). + +*** Narrow to Region + +If there is a region, "/ r (mh-narrow-to-range)" will only consider +those messages in the region. In addition, there is now a stack of +folder limits which can be popped with "/ w (mh-widen)". With a prefix +arg, all the restrictions are popped off of the stack (closes SF +#732823). + +*** Narrow to Ticked Sequence + +The buffer can now be narrowed to ticked messages with "S ' +(mh-narrow-to-tick)" (closes SF #732825). + +*** Display Multiple Buttons for multipart/alternative + +A new customizable variable, +`mh-display-buttons-for-alternatives-flag', was added to display +buttons for the alternatives. The default value is nil to retain the +current behavior (closes SF #741288). + +*** Identity Menu Changes + +A menu item has been added that inserts custom fields if the To or Cc +header fields match `mh-auto-fields-list'. + +** New Variables in MH-E 7.4 + +*** mh-alias-local-users-prefix + +This string is prepended to the real names of users from the passwd +file. If nil, use the username string unmodified instead of the real +name from the gecos field of the passwd file. + +*** mh-alias-passwd-gecos-comma-separator-flag + +Non-nil means the gecos field in the passwd file uses comma as a +separator. Used to construct aliases for users in the passwd file." + +*** mh-interpret-number-as-range-flag + +Non-nil means interpret a number as a range. If the variable is +non-nil, and you use an integer, N, when asked for a range to scan, +then MH-E uses the range "last:N". + +*** mh-kill-folder-suppress-prompt-hook + +This new hook is invoked at the beginning of the `F k +(mh-kill-folder)' command. It is a list of functions to be called, +with no arguments, which should return a value of non-nil if you +should not be asked if you're sure that you want to remove the folder. +This is useful for folders that are easily regenerated. + +The default value of `mh-index-p' suppresses the prompt on folders +generated by an index search. + +WARNING: Use this hook with care. If there is a bug in your hook which +returns t on +inbox and you hit `F k' by accident in the +inbox +buffer, you will not be happy. + +*** mh-refile-preserves-sequences-flag + +Non-nil means that sequences are preserved when messages are refiled. +If this variable is non-nil and a message belonging to a sequence +other than cur or Previous-Sequence (see mh-profile 5) is refiled then +it is put in the same sequence in the destination folder. Additional +sequences that should not to be preserved can be specified by setting +`mh-unpropagated-sequences' appropriately. + +*** mh-visible-header-fields + +Customize this instead of `mh-visible-headers', which is now a defvar. +This was done to mimic the relationship between +`mh-invisible-header-fields' and `mh-invisible-fields'. + +** Variables Deleted in MH-E 7.4 + +*** mh-visible-headers + +See the paragraph for `mh-visible-header-fields' above. + +** Bug Fixes in MH-E 7.4 + +*** Aliases Constantly Reloaded + +The system aliases are not loaded as often as they were, so the +completion speed has been dramatically improved if your passwd file is +large (closes SF #693859). + +*** Folders in MH-Index View Not Saved + +When you perform a search to produce an MH-Index buffer, the folders +that contain the messages are shown. If the MH-Index buffer was +deleted, or Emacs was restarted and the corresponding folder +rescanned, the folder information would be lost. This has been fixed +by saving the information in a file called ".mhe_index" (closes SF +#701762). + +*** Ticking Messages in +mhe-index/new + +If a new message in a buffer created by "F n" was ticked (with "'"), +the message would not be added to the tick sequence in the source +folder. This has been fixed so that any sequence changes in any index +folder (from within MH-E of course) are now reflected back to the +corresponding source folder (closes SF #709664). + +*** Custom Vars Set by a Function + +The default setting of customization variable `mh-summary-height' is +now `nil' which means MH-E will change the size dynamically according +to the size of the frame (closes SF #723267). + +*** Folder Completion Slow + +The first folder completion was very slow. This has been fixed (closes +SF #730426). + +*** Tick Sequence Persistent When Refiled + +Sequences are now preserved when messages are refiled (closes SF +#737128). + +*** Auto-inserted Header Fields Inconsistent + +For consistency, all automatically inserted header fields (such as +X-Mailer and X-Face) are added when the draft is first presented to +you. This also gives you a chance to edit or delete them if necessary +(closes SF #745624). Note that we would be distressed if you deleted +the X-Mailer field. + +*** Toolbar Spec Error + +The following message appeared when displaying a message in XEmacs: + + Signaling: (error "Toolbar spec must be list or nil" ) + +This has been fixed (closes SF #745655). + +*** mh-index-search Doesn't Find Short Acronyms + +Swish typically ignores words with fewer than four letters, but will +still look for acronyms. Unfortunately, MH-E was downcasing the input +words which defeated this feature. This has been fixed (closes SF +#755718). + + * Changes in MH-E 7.3
--- a/etc/NEWS Tue Jul 13 01:32:18 2004 +0000 +++ b/etc/NEWS Tue Jul 13 03:06:25 2004 +0000 @@ -649,7 +649,7 @@ ** MH-E changes. -Upgraded to MH-E version 7.3. There have been major changes since +Upgraded to MH-E version 7.4.4. There have been major changes since version 5.0.2; see MH-E-NEWS for details. +++
--- a/lisp/mh-e/ChangeLog Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/ChangeLog Tue Jul 13 03:06:25 2004 +0000 @@ -1,5 +1,1264 @@ -2004-04-26 Lars Hansen <larsh@math.ku.dk> - * mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t. +2004-07-10 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.4.4. + + * MH-E-NEWS, README: Updated for release 7.4.4. + + * mh-e.el (Version, mh-version): Updated for release 7.4.4. + + * This patch release contains the following patches: + + * mh-xemacs.el: New file from concatenation of mh-xemacs-compat.el + and mh-xemacs-icons.el which were removed since their names + exceeded DOS 8+3 limits. + + * Makefile: + (mh-e-autoloads.el): Add target to make `mh-e-autoloads.el', a + file containg usual entry commands into MH-E to be used for users + installing MH-E separately from Emacs. + (XEMACS_LOADDEFS_FILE): New. Used to generate mh-loaddefs.el + in XEmacs. + (XEMACS_LOADDEFS_COOKIE): Ditto. + (XEMACS_LOADDEFS_PKG_NAME): Ditto. + (XEMACS_OPTIONS): Add '-no-autoloads' to give a cleaner build + environment. + (MH-E-SRC): Moved mh-xemacs.el to new variable MH-E-XEMACS-SRC. + (MH-E-XEMACS-SRC): New variable to hold XEmacs source files. + (MH-E-XEMACS-OBJ): New variable to hold XEmacs object files. + (clean): Moved XEmacs-specific code to clean-xemacs. + (xemacs): Added clean-xemacs prerequisite. Moved down to XEmacs + section of file. Add target to build mh-loaddefs.el in XEmacs + (loaddefs-xemacs): New rule to build mh-loaddefs.el in XEmacs. + (clean-xemacs): New target to remove XEmacs-specific files. + (compile-xemacs): New. It allows for the '-no-autoloads' option + and byte-compiles all the source files with a single instance of + XEmacs. + (dist): Added $(MH-E-XEMACS-SRC) to tarball. + (AUTO_PRELOADS): Removed, in favour of 'AUTOLOAD_PACKAGE_NAME' and + 'AUTOLOAD_FILE'. + (AUTOLOAD_PACKAGE_NAME): New. + (AUTOLOAD_FILE): New. + (all): Don't set $EMACS_HOME if building with XEmacs. + (xemacs): Use 'compile-xemacs' instead of 'compile'. + (auto-autoloads.elc): Use new $AUTOLOAD_* vars and allow for + '-no-autoloads'. + (custom-load.elc): Allow for '-no-autoloads'. + + * mh-e.el: Don't require mh-xemacs-compat which no longer exists. + The XEmacs stuff gets required by mh-customize.el which is + required by mh-utils.el which is required by mh-e.el. This all + happens before mh-xemacs-compat was required, so all should be + well. + (mh-restore-desktop-buffer): Move from desktop.el. Add Parameters. + (mh-restore-desktop-buffer): Delete with-no-warnings. + (mh-folder-mode): Bind desktop-save-buffer to t. + (Courtesy Lars Hansen). + + * mh-alias.el (mh-assoc-ignore-case): New macro to use + assoc-string when available (Emacs 21.4+); assoc-ignore-case + otherwise. + (mh-alias-reload, mh-alias-expand, + mh-alias-minibuffer-confirm-address): Use it. + + * mh-seq.el: Added mh-autoload to mh-read-seq-default. + + * mh-utils.el (mh-require-cl): The Emacs coding conventions + require that the cl package not be required at runtime. However, + the cl package in versions of Emacs prior to 21.4 left cl routines + in their macro expansions. Use mh-require-cl to provide the cl + routines in the best way possible. + (require 'mouse): To shush compiler. + + * Use new function mh-require-cl throughout. + + * Add arch taglines (courtesy Miles Bader). + + * mh-unit.el (mh-unit-files): Replaced mh-xemacs-compat.el and + mh-xemacs-icons.el with mh-xemacs.el. + + * import-emacs: Also grab the ChangeLog. + + * *.pbm: Regenerated using GIMP to be consistent with other Emacs + icons. + 1. Edit .xpm image in GIMP. + 2. Image > Mode > Indexed. Check Use Black/White Palette and No + Color Dithering. + 3. File > Save As file.xbm. + 4. Run xbmtopbm < file.xbm > file.pbm. + Thanks to jan.h.d@swipnet.se for the help. + +2003-11-18 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.4.3. + + * MH-E-NEWS, README: Updated for release 7.4.3. + + * mh-e.el (Version, mh-version): Updated for release 7.4.3. + + * mh-identity.el (mh-identity-make-menu): Removed condition on + mh-auto-fields-list. Use it to enable or disable menu item + instead. + + * mh-customize.el (mh-identity-list): Removed defvar and moved + defcustom before mh-auto-fields-list so that defvar wouldn't + clobber user's customization settings. + +2003-08-19 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.4.2. + + * MH-E-NEWS, README: Updated for release 7.4.2. + + * mh-e.el (Version, mh-version): Updated for release 7.4.2. + + * mh-e.el (mh-folder-size, mh-folder-size-folder) + (mh-folder-size-flist): If flist is not present use folder to find + the number of messages in the folder. Also the .mh_sequences file + is read to find the number of unseen messages (patch from 1.349 + and branched for 7.4.2, closes SF #791021). + + * mh-utils.el (mh-flists-present-flag, mh-find-progs): Introduce a + new variable to test for the presence of the flists program and + set it in mh-find-progs. + (mh-collect-folder-names): Use folders instead of flists. One + advantage is that folders is available on MH while flists is not. + Another is that if an explicit -sequence argument isn't given and + Unseen-Sequence profile is not present then flists croaks while + folders doesn't. + (mh-collect-folder-names-filter): Don't consider folder names that + start with a `.' character. This is needed since the folders + command doesn't filter them out like flists does. + (patches from 1.307 and 1.309 and branched for 7.4.2, closes SF + #791021). + +2003-06-25 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.4.1. + + * MH-E-NEWS, README: Updated for release 7.4.1. + + * mh-e.el (Version, mh-version): Updated for release 7.4.1. + +2003-06-25 Bill Wohler <wohler@newt.com> + + * mh-unit.el (require 'cl): Added. Needed when compiling + separately. + + * Makefile (clean): Now a double-colon rule. Added a second clean + target to remove mh-unit.elc. + (compile): Removed mh-unit.elc. + (mh-unit.elc): New target used to compile mh-unit. + +2003-06-24 Bill Wohler <wohler@newt.com> + + * mh-e.el (Version, mh-version): Set to 7.4+cvs. + +2003-06-24 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.4. + + * MH-E-NEWS, README: Updated for release 7.4. + + * mh-e.el (Version, mh-version): Updated for release 7.4. + +2003-06-24 Bill Wohler <wohler@newt.com> + + * mh-alias.el (mh-alias-gecos-name, mh-alias-local-users) + (mh-alias-suggest-alias): s/gcos/gecos. The original acronym was + GECOS but was later renamed to GCOS (see + http://info.astrian.net/jargon/terms/g/GCOS.html). But the term + really needs to match the field named pw_gecos in struct passwd in + /usr/include/pwd.h + + * mh-customize.el (mh-letter-faces): New group to house + mh-letter-header-field-face. + (mh-interpret-number-as-range-flag) + (mh-kill-folder-suppress-prompt-hook): Use "you" instead of "the + user" to make text more friendly. + (mh-index-ticked-messages-folders, mh-visible-headers) + (mh-visible-header-fields): Alphabetized. + (mh-alias-passwd-gcos-comma-separator-flag): Alphabetized and + s/gcos/gecos. + (mh-alias-local-users-prefix): Fixed docstring. Prefixes are + prepended, not appended. Additional checkdoc fix. + (mh-letter-header-field-face): Set group to new group + mh-letter-faces and moved option into this group. + + * mh-index.el (mh-index-sequenced-messages): Improved wording of + docstring and mentioned use of prefix argument. + + * mh-seq.el (mh-widen): Made docstring more accurate (hopefully!). + +2003-06-18 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-replace-string): Modified to preserve case of + replacement text. + (mh-index-parse-search-regexp): Preserve case of search terms. + This is needed to take advantage of the acronym indexing in + swish++ (closes SF #755718). + +2003-06-13 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-show-index-sequenced-messages): Interactive + function callable from the show buffer. + (mh-show-folder-map): Add key binding for "F q". + + * mh-e.el (mh-folder-map): Same as above. + + * mh-index.el (mh-index-sequenced-messages): Add interactive spec + to the function (closes SF #718833). + +2003-06-13 Bill Wohler <wohler@newt.com> + + * mh-index.el (mh-flists-execute): Needed to expand mhpath too. + +2003-06-12 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-flists-execute): Modified so that flists + present in mh-progs is called. + +2003-06-07 Jeffrey C Honig <jch@honig.net> + + * mh-comp.el (mh-forward, mh-forward): Use (mh-mail-header-end) to + find the end of headers instead of doing an re-search-forward + based on mh-mail-header-separator. + +2003-06-06 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-toggle-header-field-display): Make the + function callable from the show buffer. This means that the + buffer is temporarily made writable and the modification status + of the buffer restored to the original value. + +2003-06-06 Peter S Galbraith <psg@debian.org> + + * mh-utils.el (mh-address-mail-regexp): Bug fix! It wasn't a true + copy of the goto-addr variable. My modification only recognized + addresses with one dot after the @. Sorry about that. + +2003-06-05 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-replace-in-string): Move comment into doc + string to satisfy checkdoc. + + * mh-alias.el (mh-alias-apropos): Checkdoc fix. + +2003-06-05 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-identity-list): Fixed typo in docstring. + +2003-06-05 Peter S Galbraith <psg@debian.org> + + * mh-comp.el (mh-letter-complete-function-alist): Add bcc an reply-to. + +2003-06-04 Peter S Galbraith <psg@debian.org> + + * mh-comp.el (mh-letter-complete-function-alist): Add dcc. + +2003-06-03 Peter S Galbraith <psg@debian.org> + + * mh-utils.el (mh-replace-in-string): New function name instead of + `dired-replace-in-string'. + * mh-alias.el (mh-alias-gcos-name): Use it. + + * mh-alias.el (mh-alias-apropos): New command. Show all aliases + that match REGEXP either in name or content. + + * mh-alias.el (mh-alias-suggest-alias): Add no-comma-swap optional + arg. + (mh-alias-canonicalize-suggestion): Change a comma to a period in + created aliases. + (mh-alias-local-users): Call `mh-alias-suggest-alias' with + `no-comma-swap' arg set to t. + + * mh-alias.el (mh-alias-local-users): Fix case of nil + `mh-alias-passwd-gcos-comma-separator-flag'. + + * mh-alias.el (mh-alias-gcos-name): Fix for case of empty gcos + name field. + (mh-alias-local-users): Fix same. + + * mh-alias.el (mh-alias-canonicalize-suggestion): Replace use by + verbose `replace-regexp' by a looped `replace-match' + +2003-06-02 Peter S Galbraith <psg@debian.org> + + * mh-utils.el (dired-replace-in-string): Bind if not already + defined. Borrowed from dired.el + + * mh-alias.el (mh-alias-gcos-name): switch to using + dired-replace-in-string. + +2003-06-02 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-letter-font-lock-keywords): Fontify header + fields in the draft buffer that aren't skipped when navigating + with TAB (or S-TAB). + + * mh-customize.el (mh-clean-message-header-flag) + (mh-invisible-headers, mh-invisible-header-fields) + (mh-alias-passwd-gcos-comma-separator-flag): Checkdoc fix. + (mh-letter-header-field-face): New face to fontify the header + fields. + + * mh-comp.el (mh-insert-auto-fields-done-local): Checkdoc fix. + (mh-letter-mode, mh-letter-mail-header-end-marker): Remember the + end of the message header in a marker. This is used to fontify the + header fields. + (mh-font-lock-field-data, mh-letter-header-end): Functions used + to fontify message header fields. + + * mh-alias.el (mh-alias-gcos-name): Checkdoc fix. + +2003-06-02 Peter S Galbraith <psg@debian.org> + + * mh-alias.el (mh-alias-gcos-name): New function. Return a usable + address string from a GCOS-NAME and USERNAME. + (mh-alias-local-users): Use it. + + * mh-customize.el (mh-alias-passwd-gcos-comma-separator-flag): New + defcustom. Whether the gcos field in the passwd file uses comma as + a separator. + + * mh-customize.el (mh-alias-local-users-prefix): New + defcustom. String to append to the real names of users from the + passwd file. If nil, use the username string unmodified instead of + the real name from the gcos field of the passwd file. + + * mh-alias.el (mh-alias-local-users): Use it to generate aliases + which by default are now the real name prefixed by "local." + +2003-06-01 Peter S Galbraith <psg@debian.org> + + * mh-comp.el (mh-modify-header-field): Bug fix. Calling with with + a value that was already inserted causes it to get inserted a + second time. I have wrapped the value around \b word delimiters. + Hope there are no side effects for other code. + + * mh-comp.el (mh-insert-auto-fields): Attempt regardless of + `mh-insert-auto-fields-done-local' flag in interactive use. + + * mh-comp.el (mh-insert-auto-fields-done-local): Keep track of + whether `mh-insert-auto-fields' was called in a buffer. + (mh-insert-auto-fields): Set it and use it. Also, don't enter an + identity if one was already entered manually. + (mh-send-letter): Call `mh-insert-auto-fields' again when sending + message. + (mh-compose-and-send-mail): Call `mh-insert-auto-fields' _after_ + `mh-letter-mode' so `mh-identity-local' doesn't get cleared by the + mode invocation. + +2003-06-01 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-seq.el (mh-thread-parse-scan-line): The value of + mh-scan-field-from-start-offset was hardcoded in one place. The + change fixes that. + + * mh-utils.el (mh-show-mode): Setup mh-show-mode to display + elipsis for truncated header fields and to skip over them quickly. + (mh-clean-msg-header): Make another pass over the message header + fields truncating long headers. + + * mh-comp.el (mh-letter-complete): Remove unnecessary autoload. + (mh-letter-toggle-header-field-display): Take into account that + an empty line can also end the message header. The function was + originally written with the draft buffer in mind. + +2003-06-01 Mark D. Baushke <mdb@gnu.org> + + * mh-comp.el (mh-letter-mode-map): Do not steal C-t. Use C-c C-t + for the mh-letter-toggle-header-field-display command. + +2003-05-31 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-visible-headers): Changed to a defvar that + will be set using new `mh-visible-headers' function using + `mh-visible-header-fields' as input. + (mh-visible-headers): New function, described above. + (mh-visible-header-fields): New defcustom. The UI to set + `mh-visible-headers'. + (mh-invisible-header-fields-set): Deleted. Code merged into + defcustom since it's so short. + +2003-05-31 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-toggle-header-field-display): Extended to + truncate headers if they are too long. + (mh-letter-truncate-header-field): Make code that would be + duplicated into a function. + (mh-letter-hide-all-skipped-fields): Modified so that fields that + are important are hidden if they are too long. + +2003-05-31 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el ("tool-bar"): Since tool-bar isn't available on + XEmacs, requiring it causes problems. So load it instead. + (mh-do-at-event-location): New macro to do stuff at location of + events. This has been refactored out of mh-push-button. + + * mh-mime.el (mh-push-button): Simplified since it now uses the + mh-do-at-event-location macro. + + * mh-comp.el (mh-hidden-header-keymap): Keymap to make mouse + clicks on header toggle its display. + (mh-letter-toggle-header-field-display-button): Interactive + function to toggle header display when mouse button is clicked. + +2003-05-31 Peter S Galbraith <psg@debian.org> + + * mh-e.el (mh-folder-mode): Remove conditional on tool-bar-mode. + + * mh-comp.el (mh-letter-mode): Same. + + * mh-utils.el (mh-show-mode): Same. + +2003-05-30 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (tool-bar): Load tool-bar explicitly. This avoids + problems with incorrect initialization of tool-bar-map otherwise. + +2003-05-30 Peter S Galbraith <psg@mixed.dyndns.org> + + * mh-comp.el (mh-modify-header-field): Minor fix of spaces for + when an entry already existed. + (mh-insert-auto-fields): Make interactive. Add optional `quiet' + arg for use when called systematically on every buffer. Won't be + used interactively for more verbose output. + (mh-letter-mode-map): Add \C-c\M-d keybinding for + mh-insert-auto-fields. + + * mh-identity.el (mh-identity-make-menu): Add a menu entry in + Identity menu for mh-insert-auto-fields. + + * mh-customize.el (mh-invisible-header-fields): Add entries for + `Envelope-to' and `X-Original-To'. + +2003-05-30 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-mode): Skip over invisible text quickly. + +2003-05-30 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-mode): Use text properties to achieve + invisibility. This is more portable and the same code can be used + for all Emacs versions. + (mh-letter-toggle-header-field-display): Rewritten to use text + properties. + (mh-dead-overlay-p, mh-letter-hidden-header-fields)): Removed. + +2003-05-29 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-hidden-header-fields, mh-letter-mode): Add + a hash table, initialized it in mh-letter-mode, to remember the + overlays introduced to hide long headers fields. + (mh-insert-x-mailer): checkdoc fix. + (mh-compose-and-send-mail): Hide unimportant message header + fields. + (mh-letter-header-field-regexp, mh-letter-header-field-at-point) + (mh-letter-next-header-field, mh-letter-previous-header-field): + Add a variable that contains the header-field name regexp and use + it instead of the regexp directly. + (mh-letter-toggle-header-field-display, mh-letter-mode-map): Add + new key binding in mh-letter-mode that toggles display of long + header fields, in mh-letter-mode. + (mh-dead-overlay-p): A predicate which checks if a given header + field has an active overlay hiding it. + (mh-letter-hide-all-skipped-fields): New function that shortens + uninteresting headers. + +2003-05-29 Eric Ding <ericding@acorn.bethesda.net> + + * mh-comp.el (mh-letter-next-header-field-or-indent): Call + indent-relative rather than indent-for-tab-command. + +2003-05-29 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-complete-or-space): The meaning of the + customizable variable was reversed. Also make the doc string more + accurate. + +2003-05-28 Satyaki Das <satyakid@stanford.edu> + + * mh-customize.el (mh-compose-skipped-header-fields): New + customizable variable that lists headers that are skipped. + (mh-compose-space-does-completion-flag): Option to do completion + with space (closes SF #745634). + + * mh-comp.el (mh-insert-x-mailer): Check the value of + mh-insert-x-mailer-flag in this function instead of in its caller. + (mh-compose-and-send-mail, mh-send-letter): Insert X-Mailer and + X-Face headers when the draft is first presented to the user + instead of when the mail is sent (closes SF #745624). + (mh-letter-complete-or-space): Allow for this key binding to be + overridden. + (mh-letter-next-header-field): Fix a problem with multiline header + fields. + (mh-letter-next-header-field, mh-letter-previous-header-field): + Make these functions skip unwanted header fields. + (mh-letter-skipped-header-field-p): New predicate that checks if a + header field is to be skipped. + + * mh-seq.el (mh-thread-inc): Inc'ing email in threaded mode was + causing duplication of the current notation. The change fixes that. + +2003-05-28 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-beginning-of-word): Generalize it to skip + arbitrary number of words. + (mh-letter-complete-or-space): New interactive function that + allows space character to be used for completion. + (mh-letter-mode-map): Add key binding to allow space to be used + for completion. + +2003-05-27 Satyaki Das <satyakid@stanford.edu> + + * mh-customize.el (mh-compose-prompt-flag): Customizable variable + that controls whether the user is prompted when composing a draft. + It replaces mh-dont-prompt-for-address-flag (closes SF #745622). + + * mh-comp.el (mh-letter-next-header-field): If the point is in + the header field name, then go the start of the header field + instead of the next field. + (mh-interactive-read-address, mh-interactive-read-string) + (mh-letter-adjust-point): Use mh-compose-prompt-flag instead of + mh-dont-prompt-for-address-flag. + +2003-05-27 Satyaki Das <satyakid@stanford.edu> + + * mh-customize.el (mh-tool-bar-define): Fix incorrect usage of + set-specifier (closes SF #745655). Also the button enabling code + interacts poorly with font-lock in XEmacs. So disable that. + +2003-05-26 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-folder-from-address): The function + message-fetch-field expects that the buffer is narrowed to the + mail header. The change makes sure that this is indeed the case. + + * mh-mime.el (mh-add-missing-mime-version-header) + (mh-decode-message-body): Same as above. + +2003-05-25 Satyaki Das <satyakid@stanford.edu> + + * mh-alias.el (mh-alias-minibuffer-confirm-address): Modified to + use mh-beginning-of-word. + + * mh-comp.el (mh-letter-confirm-address): Calling + mh-alias-reload-maybe can be expensive. So do it only if we really + need to. + +2003-05-25 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-comp.el (mh-letter-confirm-address): Load aliases if not yet + loaded. + + * mh-alias.el (mh-alias-reload-maybe): Autoload it since it is + used in mh-comp.el. + +2003-05-24 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-skip-leading-whitespace-in-header-field): + New function to skip leading space and tab characters when placing + point in a header field. + (mh-letter-next-header-field, mh-letter-previous-header-field): + Skip leading whitespace when using TAB to navigate to header + fields. + (mh-letter-confirm-address): New interactive function that + displays the last expansion of the last alias when "," is typed. + (mh-letter-mode-map): Add key binding for "," (closes SF #745634). + +2003-05-23 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-edit-again, mh-forward, mh-send) + (mh-send-other-window, mh-send-sub): Modified so that if + mh-dont-prompt-for-address-flag is non-nil, then MH-E won't prompt + for addresses to send mail to and instead directly jump to the + draft (closes SF #745622). + (mh-letter-complete-function-alist): An alist that is used to + decide which completion function to use in which header. This + variable should probably be customizable. + (mh-letter-complete): Now uses mh-letter-complete-function-alist. + (mh-letter-header-field-at-point, mh-letter-next-header-field) + (mh-letter-next-header-field-or-indent) + (mh-letter-previous-header-field): Commands for easier navigation + to header fields. + (mh-dont-prompt-for-address-flag): Variable which controls + whether MH-E prompts for addresses. + (mh-interactive-read-address, mh-interactive-read-string): Two + functions to ask user for input depending on the value of the + above flag. + (mh-letter-adjust-point): New function that sets point to the + first header field. + (mh-letter-mode-map): Add key bindings for TAB and S-TAB (closes + SF #745627). + +2003-05-23 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-comp.el (mh-complete-word): New function which is + approximately equivalent to mail-abbrev-complete-alias. + (mh-beginning-of-word): Refactor repeated code into its own + function. + (mh-folder-expand-at-point): Make Fcc completion work in XEmacs + by not using mail-abbrev-complete-alias. + + * mh-alias.el (mh-alias-letter-expand-alias): Make alias + expansion work in XEmacs. Replace the use of the function + mail-abbrev-complete-alias, which isn't present in XEmacs. + + * mh-mime.el (mh-mml-to-mime): If a MIME message is created + immediately after starting MH-E then invoking mh-mml-to-mime + causes an error because "message" isn't being loaded. The change + works around this problem. + (mh-mime-maybe-display-alternatives): Give better indication of + which MIME parts are alternatives. + +2003-05-22 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-add-sequence-notation, mh-remove-sequence-notation): + Just delete and add the same character in the scan line to make + font-lock refontify it. The previous trick of removing all text + properties didn't work in XEmacs. + + * mh-seq.el (mh-put-msg-in-seq): Complain if the user tries to + create an invalid MH sequence. + + * mh-mime.el (mh-mime-display-alternative): Modified to + optionally display alternatives as buttons. + (mh-mime-maybe-display-alternatives): New function which displays + alternative MIME parts as buttons. + (mh-mime-save-part): Initially mh-mime-save-parts-directory is + nil and calling file-name-as-directory with nil arg leads to an + error. So fall back on the default-directory in that case. + + * mh-customize.el (mh-display-buttons-for-alternatives-flag): New + customizable variable that controls display of the alternative + MIME parts (closes SF #741288). + +2003-05-22 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-invisible-header-fields): Commented out + "User-Agent:". It's similar to X-Mailer, so display it. + +2003-05-21 Satyaki Das <satyakid@stanford.edu> + + * mh-customize.el (mh-tool-bar-define): Add an optional argument + to the button description that can dynamically enable/disable + buttons. + (mh-tool-bar-define): The alias grabbing button is disabled if the + current message doesn't have a From header or if the sender is + already in the user's alias. This functionality was inadvertently + lost when the Emacs/XEmacs toolbar unification took place. + +2003-05-20 Satyaki Das <satyakid@stanford.edu> + + * mh-unit.el (mh-unit-construct-call-graph): Be more aggressive + and flag interactive functions that aren't autoloaded or have no + key bindings. + (mh-unit-interactive-function-p): Remove now unused function. + (mh-unit, mh-unit-construct-call-graph): Replace mh-files with + mh-unit-files. + +2003-05-20 Bill Wohler <wohler@newt.com> + + * mh-unit.el (mh-prune-trailing-spaces): Renamed to + mh-unit-prune-trailing-spaces to clean up the namespace. + (mh-files): Renamed to mh-unit-files. Ditto. + (mh-unit): Checkdoc fix. + + * mh-index.el (mh-index-p): Added autoload cookie since mh-index-p + is used by mh-customize.el. This calls for another mh-unit test + that looks for mh-autoloads for functions that are no longer used + in other files. + + * mh-loaddefs.el: Regenerated. + +2003-05-20 Satyaki Das <satyakid@stanford.edu> + + * mh-unit.el (mh-unit-construct-call-graph): Factor out the code + to read the lisp files to a separate function. Also change it to + construct a function call-graph. Autoloaded functions are taken + into account. + (mh-unit-find-all-used-functions, mh-unit-called-functions) + (mh-unit-find-all-unused-functions): Find all unused functions by + computing a fixed point starting from the set of top level + functions. + (mh-unit-analyze-block): Removed. + (mh-unit-update-call-graph): mh-unit-functions-called was renamed + with modifications to update the function call graph. + +2003-05-19 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-utils.el (mh-notate): Modified to keep track of notation + that was replaced when sequence notation is added. Thus when the + sequence is deleted, the original notation is recovered. + (mh-add-msgs-to-seq): Modified to work with the new sequence + notation code. + + * mh-seq.el (mh-delete-seq, mh-put-msg-in-seq): Simplified since + we don't need to handle tick and unseen sequences specially any + more. + (mh-narrow-to-seq): Don't need to call mh-notate-user-sequences + since mh-copy-seq-to-eob already does that. + (mh-widen): Remove sequence notation, so that notation when + messages are replied to aren't lost. + (mh-copy-seq-to-eob): Simplified with the use of + mh-iterate-on-range. + (mh-thread-inc): This function doesn't need to notate user + sequences since its callers already do that. + (mh-thread-parse-scan-line): Simplified since mh-note-seq doesn't + appear in scan lines it is given as arguments. + (mh-thread-update-scan-line-map): Remove the test, since its + caller already does the required check. + (mh-thread-folder): Simplified by the use of mh-iterate-on-range. + (mh-tick-add-overlay, mh-tick-remove-overlay, mh-notate-tick): + These functions aren't needed any more, since overlays aren't used + any more. Also overlays aren't portable to XEmacs, so nasty + conditional code that used overlays in Emacs and extents in Xemacs + have been eliminated. + (mh-toggle-tick): Generalize it to work on a range of messages + like the other interactive messages. + + * mh-funcs.el (mh-undo-folder): Use mh-remove-all-notation + instead of mh-unmark-all-headers. + + * mh-e.el (mh-folder-font-lock-keywords): The entry for unseen + sequence highlighting is now done by the macro. + (mh-generate-sequence-font-lock): New macro to highlight any + arbitrary sequence. This macro is invoked twice to get the + highlighting for unseen and tick sequences. + (mh-sequence-notation-history, mh-folder-mode): New variable that + keeps track of the old notation when a message is notated with + mh-note-seq. + (mh-regenerate-headers, mh-get-new-mail): Add appropriate calls to + mh-notate-user-sequences and mh-remove-all-notation. + (mh-unmark-all-headers): Add comment that this function shouldn't + be used any more. + (mh-add-sequence-notation, mh-remove-sequence-notation): New + functions to notate message with mh-note-seq and to remove it. + (mh-remove-all-notation): Simplified to use mh-iterate-on-range. + (mh-process-commands): Use mh-remove-all-notation instead of + mh-unmark-all-headers. + (mh-notate-user-sequences, mh-delete-msg-from-seq): Simplified + since the tick and unseen sequences don't need special handling + any more. + (mh-internal-seq): Make it possible to dynamically change what + sequences are treated as internal (internal means font lock is + used to highlight the sequence). + (mh-clear-text-properties): Removed since it isn't needed + anymore. + +2003-05-19 Satyaki Das <satyakid@stanford.edu> + + * mh-unit.el (mh-unit-analyze-block, mh-unit-interactive-function-p) + (mh-unit-find-all-unused-functions): Change argument name bl to + block. + +2003-05-19 Satyaki Das <satyakid@stanford.edu> + + * mh-unit.el (mh-unit-find-all-unused-functions): New interactive + function to find all unused functions in MH-E. + (mh-unit-analyze-block, mh-unit-interactive-function-p) + (mh-unit-functions-called): Functions used by + mh-unit-find-all-unused-functions do its job. + + * Makefile (compile): Byte-compile mh-unit.el, since the analysis + to find unused code runs faster when compiled. + +2003-05-18 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-seq.el (mh-notate-deleted-and-refiled): Add autoload + declaration since this function is used in mh-index.el. + + * mh-e.el, mh-customize.el, mh-utils.el: Adjust require/provide + statements so that mh-e.el isn't loaded twice. + +2003-05-15 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-defun-show-buffer): Arrange for the current + line in the folder buffer to be highlighted even when we are in + the show buffer. + +2003-05-14 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-read-range): Allow this to work on invalid + sequences that only MH-E knows about. + + * mh-index.el (mh-create-sequence-map, mh-index-add-to-sequence) + (mh-index-delete-from-sequence): Don't consider sequences that + aren't valid MH sequences. + + * mh-e.el (mh-valid-seq-p): New predicate to check if a symbol + could be a MH sequence. + (mh-undefine-sequence, mh-define-sequence): Don't execute "mark" + unless the sequence name is a valid MH sequence. + + * mh-utils.el (mh-exec-cmd): In case an error happens in the + call-process and non-strings are present in ARGS, then the error + message isn't properly displayed. The change fixes this. + +2003-05-14 Peter S Galbraith <psg@debian.org> + + * mh-mime.el (mh-mime-save-part): Bug Fix: Make sure + `mm-default-directory' gets a trailing "/" if + `mh-mime-save-parts-directory' doesn't have one. Otherwise the + default in the prompt of `mh-mm-save-part' will be wrong. Perhaps + `mh-mm-save-part' needs to do this check itself. + +2003-05-14 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-unpropagated-sequences): New function and + variable to keep track of sequences that shouldn't be propagated. + (mh-create-sequence-map, mh-index-add-to-sequence) + (mh-index-delete-from-sequence): Use mh-unpropagated-sequences to + stop changes to some sequences being reflected back to the source + folders. + +2003-05-13 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-e.el (mh-process-commands): Preserve sequences when messages + are refiled (closes SF #737128). + + * mh-index.el (mh-create-sequence-map) + (mh-index-create-sequences): Refactor code that is reused into a + new function. + + * mh-customize.el (mh-refile-preserves-sequences-flag): New + customizable flag that controls whether sequences are preserved + when messages are refiled. + +2003-05-13 Eric Ding <ericding@alum.mit.edu> + + * mh-e.el (mh-scan-format): The argument for scan format files + should be -form, not -format. + +2003-05-13 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-widen): The scan line map stack was not being + properly updated when ALL-FLAG is non-nil. The change fixes that. + + * mh-e.el (mh-reset-threads-and-narrowing): The change resets the + scan line map stack. + +2003-05-12 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-seq.el (mh-thread-scan-line-map-stack) + (mh-thread-old-scan-line-map): Instead of the old scan line map, + now we need to maintain a stack of scan line maps. + (mh-narrow-to-seq): Modified so that multiple level of narrowings + can be done. We now maintain a stack of old views instead of + hiding the old scan lines. This makes it possible to have + multiple levels of narrowings. + (mh-widen): A optional prefix arg was added to allow undoing all + narrowing. + (mh-read-seq-default, mh-read-range): Don't use + mh-narrowed-to-seq, since it doesn't exist any more. + (mh-thread-initialize-hash, mh-thread-initialize): The + mh-thread-initialize function has been refactored. + (mh-thread-update-scan-line-map): Maintain notations in the stack + of scan line maps. + (mh-notate-tick, mh-toggle-tick): Simplified, since we don't have + mh-narrowed-to-seq any more. This means there is a slight loss of + functionality. Earlier if we narrowed to the tick sequence the + ticked messages weren't highlighted. This feature isn't present + any more. + + * mh-e.el (mh-execute-commands, mh-reset-threads-and-narrowing) + (mh-folder-sequence-menu, mh-get-new-mail): Use + mh-folder-view-stack instead of the now removed + mh-narrowed-to-seq. + (mh-narrowed-to-seq, mh-tick-seq-changed-when-narrowed-flag): + These variables have been removed. + (mh-folder-view-stack): New variable to keep track of a stack of + narrowings. + (mh-execute-commands, mh-get-new-mail): Add extra argument to + mh-widen so that all narrowings are undone. + + * Makefile (MH-E-SRC, MH-E-OTHERS): Move mh-gnus.el from MH-E-SRC + to MH-E-OTHERS so that it isn't byte compiled. + +2003-05-10 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-read-seq): Improve the function a bit by adding + history to the sequence prompt. + +2003-05-09 Satyaki Das <satyakid@stanford.edu> + + * mh-gnus.el: New file that won't be byte-compiled. From now on + having different Gnus versions at run-time and compile-time won't + cause errors in MH-E. + + * mh-mime.el (mh-small-show-buffer-p, mh-display-smileys) + (mh-display-emphasis): Handle all legal values of + font-lock-maximum-size. The existing code assumed didn't consider + the case where it could be an alist. + (mh-small-image-p): Simplified, so that aliasing XEmacs functions + in Emacs isn't necessary any more. + (mh-mm-display-part): Remove unnecessary call to fboundp. The + mh-funcall-if-exists does that for us any way. + (mh-defun-compat, gnus-local-map-property, mm-merge-handles) + (mm-set-handle-multipart-parameter, mm-readable-p) + (mm-long-lines-p, mm-keep-viewer-alive-p, mm-destroy-parts) + (mh-mm-save-part, mm-handle-multipart-ctl-parameter): These + compatibility functions have been moved to mh-gnus.el. + + * Makefile (MH-E-SRC): Add mh-gnus.el. + + * mh-seq.el (mh-narrow-to-header-field) + (mh-current-message-header-field): Checkdoc fixes. + + * mh-e.el (mh-undefine-sequence): Since mh-coalesce-msg-list + returns a list, apply is needed. + +2003-05-09 Noel Cragg <noel@red-bean.com> (tiny change) + + * mh-junk.el (mh-spamassassin-blacklist): Separate "--local" and + "--no-rebuild" arguments to call-process. + [Patch committed by satyaki] + +2003-05-08 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-translate-range): Take into account differnt + semantics of split-string in Emacs and XEmacs. + (mh-read-pick-regexp, mh-narrow-to-from, mh-narrow-to-cc) + (mh-narrow-to-to, mh-narrow-to-header-field) + (mh-current-message-header-field, mh-narrow-to-range): New + narrowing functions that can select messages based on different + message headers. + + * mh-utils.el (mh-show-limit-map): Add new narrowing functions + callable from the show buffer. + + * mh-e.el (mh-help-messages): Add help text for new functions. + (mh-limit-map): Add new narrowing functions (closes SF #732823). + +2003-05-07 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-collect-folder-names): Use mh-exec-daemon to + run flists. This means we don't have to remember to expand the MH + executable in the mh-progs path. + (mh-exec-cmd-daemon): Return the new process object produced. + +2003-05-06 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-folder-font-lock-unseen): Use mh-seq-list to do + unseen sequence highlighting instead of reading the .mh_sequences + file from disk every time. + +2003-05-05 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-show-sequence-map): Add key binding for S' + (closes SF #732825). + + * mh-e.el (mh-sequence-map): Ditto. + (mh-help-messages): Updated for S'. + +2003-05-04 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-index-write-data): The with-temp-buffer macro + is a bit better than write-file, so use that instead. + +2003-05-03 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-index-update-maps, mh-index-search) + (mh-index-sequenced-messages): Write index data to disk. This + allows us to recover index folder information if Emacs is + restarted, or the index folder is visited after the buffer has + been killed (closes SF #701762). + (mh-index-write-data, mh-index-read-data) + (mh-index-write-hashtable, mh-index-read-hashtable): Functions to + store and read index data information to disk. + (mh-index-insert-folder-headers, mh-index-group-by-folder): We + can no longer use object identity to compare strings, since they + might have been read back from disk. + + * mh-e.el (mh-index-data-file): New variable that stores the name + of the file that keeps track of index folder data. + (mh-make-folder): Read index folder data if available. + + * mh-utils.el (mh-show, mh-summary-height, mh-modify): Make + checkdoc happy. + + * mh-seq.el (mh-tick-add-overlay): Rearrange code to make code + more uniform. + + * mh-loaddefs.el: Regenerated. + +2003-05-02 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-tick-add-overlay): If a message with a short scan + line is ticked, then the highlighting didn't extend to the right + margin. This change fixes that. + +2003-05-01 Bill Wohler <wohler@newt.com> + + * mh-e.el (mh-help-messages): Added brackets around / and + downcased limit to be consistent with other commands with + punctuation keybindings. Don't document aliases. + +2003-05-01 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-seq.el (mh-read-range): Fix comment. + +2003-04-30 Mark D. Baushke <mdb@gnu.org> + + * mh-e.el (mh-help-messages): Better documentation for the F map. + +2003-04-30 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-find-path): Cache folder names so that + folder name completion is always fast. + (mh-flists-partial-line, mh-flists-process): Variables used for + pre-caching folder names. + (mh-collect-folder-names, mh-collect-folder-names-filter) + (mh-populate-sub-folders-cache): Functions to pre-cache folder + names. + (mh-exec-cmd): Produce more info in *MH-E Log*. + + * mh-index.el (mh-index-search): Call the correct function. + (mh-index-sequenced-messages): If folders is nil, then all mail + is searched. The change restores that. + +2003-04-30 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-summary-height): Move variable integer out + of defcustom, and instead specify that `nil' means to calculate + that size dynamically. Fixes SF #723267. + + * mh-utils.el (mh-summary-height): New function. Return ideal + mh-summary-height value for current frame height. + (mh-show-msg): Use it. + +2003-04-30 Mark D. Baushke <mdb@gnu.org> + + * mh-index.el (mh-index-ticked-messages): Fix prompt and + description string. + (mh-index-new-messages): Ditto. + + * mh-loaddefs.el: Regenerated. + + * mh-index.el (mh-index-sequenced-messages): Renamed from + mh-index-new-messages with minor argument change. + (mh-index-new-messages): Implement by calling + mh-index-sequenced-messages with the appropriate arguments. + (mh-index-ticked-messages): New function. Does the same thing as + mh-index-new-messages, but on its own set of folders and using the + mh-tick-seq instead of mh-unseen-seq. + + * mh-e.el (mh-folder-map): Add "F'" to the map for + mh-index-ticked-messages. + (mh-help-messages): Replace broken [t]hread with [n]ew messages. + + * mh-customize.el (mh-index-ticked-messages-folders): New user + customizable flag that controls the folders to be searched by + mh-index-ticked-messages. + + * mh-utils.el (mh-show-index-ticked-messages): Wrapper for + mh-index-ticked-messages. + (mh-show-folder-map): Add "F'" to the map for + mh-index-ticked-messages. + +2003-04-30 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-index-search): The old cur in the source folder + might not exist. This could cause mh-exec-cmd to fail. So don't + add an error message in that case. + +2003-04-29 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-folder-from-address): Modified to allow multiple + Cc: headers to work properly. + (mh-inc-folder, mh-visit-folder): Fix an off by one error. + + * mh-utils.el (mh-notate): Update the scan line map. This fixes a + tiny bug. In threaded view, if a message is replied to then the + message is notated with a "-". Now if inc is done then the "-" + added is lost. The change fixes this. + + * mh-seq.el (mh-translate-range): Use the correct function. + (mh-thread-update-scan-line-map): New function that updates the + scan line map when a message is notated. + +2003-04-28 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-index-parse-search-regexp): Avoid compiler + warning in GNU Emacs 21.3. + + * mh-seq.el (mh-widen): Ditto. + +2003-04-28 Satyaki Das <satyakid@stanford.edu> + + * mh-customize.el (mh-interpret-number-as-range-flag): New user + customizable flag that controls whether a single number, N is + interpreted as the range last:N. + + * mh-seq.el (mh-read-range): Generalize it for use when reading + range to scan. + (mh-interactive-range): Modified to use the new mh-read-range. + + * mh-speed.el (mh-speed-view): Use mh-read-range instead of the + now removed mh-read-msg-range function. + + * mh-funcs.el (mh-pack-folder): Ditto. + + * mh-e.el (mh-rescan-folder, mh-visit-folder): Ditto. + (mh-read-msg-range): Removed. + + * mh-loaddefs.el: Regenerated + +2003-04-27 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-seq.el (mh-range-completion-function): Fix checkdoc warning. + (mh-iterate-on-range): Mention that the macro can iterate over a + MH message range too. + +2003-04-27 Bill Wohler <wohler@newt.com> + + * mh-unit.el (mh-unit): As it turns out, lm-crack-copyright has + been updated to handle multiple-line copyrights in 21.3, so + updated code to run lm-verify only if user has 21.3 or greater. + Delete buffers after use, unless user already had buffer open. + +2003-04-27 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-index.el (mh-index-search): The MH command "refile" changes + cur. The change restores cur in source folders. + (mh-index-new-messages): Use the appropriate arguments for + mh-read-seq. + + * mh-seq.el (mh-read-seq-default, mh-read-seq): Restore these + functions to just read sequence names. + (mh-range-seq-names, mh-range-history, mh-range-completion-map) + (mh-range-completion-function, mh-read-range): New function which + reads MH range with completion and history. + (mh-interactive-range): Use mh-read-range instead of + mh-read-seq-default. + (mh-put-msg-in-seq): Change documentation about MH message range. + + * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Change + documentation about MH message range. + + * mh-funcs.el (mh-copy-msg, mh-print-msg): Ditto. + + * mh-e.el (mh-delete-msg, mh-delete-msg-no-motion) + (mh-refile-msg, mh-undo, mh-delete-msg-from-seq): Ditto. + + * mh-comp.el (mh-forward): Ditto. + +2003-04-26 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el, mh-e.el, mh-funcs.el, mh-junk.el, mh-seq.el: + Replace msg-or-seq with range everywhere. + + * mh-loaddefs.el: Regenerated. + +2003-04-25 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-index-sequence-search-flag, mh-folder-mode): New + local variable to remember that a folder buffer contains results + from a sequence search. This is needed so that "C-u F i" will work + as expected. + (mh-visit-folder): Create sequences in the index folder. + (mh-process-commands, mh-delete-msg-from-seq): If speedbar is on + then update the speedbar message counts immediately. + (mh-delete-msg-from-seq): Make the code faster by calling "mark" + just once. Also update source folder sequence if messages are + being deleted from a sequence in an index folder. + (mh-undefine-sequence): Simplified to remove the speedbar updating + code. Also DTRT and don't change any sequence when called with an + empty list of messages. + (mh-refile-msg, mh-delete-msg): Move to next message only if the + current message has been deleted or refiled, as the case may be. + + * mh-utils.el (mh-show-msg): Update the message counts in the + speedbar, if it is on, immediately. + (mh-speed-flists-active-p, mh-speed-flists-inhibit-flag): A new + flag has been added which inhibits updating of the speedbar. This + is used to avoid needless speedbar updates when + mh-execute-commands is called in index folders. + + * mh-speed.el (mh-speed-flists): Extended so that multiple + folders can be given as arguments. Also the code that kept track + of the current folder, needed since flists adds an extra ?+ char + at the end of the current folder name, wasn't entirely correct. + That has also been fixed. + + * mh-seq.el (mh-delete-seq, mh-put-msg-in-seq): Modified so that + sequence in source folder is updated if we delete a sequence in an + index folder. + (mh-read-seq, mh-read-seq-default, mh-translate-range) + (mh-interactive-msg-or-seq): The mh-interactive-msg-or-seq + function can read in an arbitrary MH message range. + (mh-iterate-on-msg-or-seq): The macro has been extended to work on + a MH range. + (mh-subject-to-sequence, mh-subject-to-sequence-unthreaded) + (mh-subject-to-sequence-threaded, mh-thread-find-msg-subject): Fix + the mh-subject-to-sequence function so that it will work in + threaded folders too. + (mh-tick-add-overlay): Fix a leak of overlays. + (mh-toggle-tick): Ticking, or unticking, messages in the index + folder is propagated to the source folders (closes SF #709664). + + * mh-index.el (mh-flists-results-folder, mh-flists-sequence) + (mh-flists-called-flag): New variables to implement searching for + arbitrary sequences. + (mh-index-generate-pretty-name): Updated so that folder names are + generated for flists search that can take any sequence name. + (mh-index-search): Since sequences are now properly maintained the + unseen-flag argument isn't needed and hence removed. Also redoing + a sequence search with "C-u F i" is handled correctly. Finally + the speedbar is updated to reflect the new index folder created. + (mh-index-create-sequences): New function that creates sequences + in the index folder. + (mh-index-matching-source-msgs, mh-index-execute-commands): + Improved so that scan lines for refiled/deleted messages are + removed from the source folders as well. + (mh-index-add-to-sequence, mh-index-delete-from-sequence): New + functions to update sequences in source folder to reflect changes + in index folder. + (mh-index-quote-for-shell): A utility function to that quotes + characters with special meaning to /bin/sh. + (mh-flists-execute, mh-index-new-messages): Updated to search for + arbitrary sequences (closes SF #718833). + + * mh-loaddefs.el: Regenerated. + +2003-04-25 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-kill-folder-suppress-prompt-hook): New hook + used by mh-kill-folder to suppress the prompt. + + * mh-funcs.el (mh-kill-folder): Suppress prompt not if + mh-index-data is non-nil, but if any functions in + mh-kill-folder-suppress-prompt-hook return non-nil. + + * mh-index.el (mh-index-p): New function with returns non-nil if + the current folder was generated by an index search for use by + mh-kill-folder-suppress-prompt-hook + + * mh-unit.el (mh-unit): Commented out lm-verify step until code + updated to handle split Copyright lines. + + * mh-e.el (mh-version): Set to 7.3+cvs. 2003-04-24 Bill Wohler <wohler@newt.com> @@ -50,10 +1309,6 @@ runs checkdoc and lm-verify which is useful before releasing the software. It can and should be expanded to do real unit tests. -2004-04-22 Lars Hansen <larsh@math.ku.dk> - - * mh-e.el (mh-restore-desktop-buffer): Delete with-no-warnings. - 2003-04-22 Mark D Baushke <mdb@gnu.org> * mh-alias.el: Update Copyright. @@ -78,11 +1333,6 @@ Emacs. (mh-exec-cmd-error): Add a comment, so that we change it later on. -2004-04-21 Lars Hansen <larsh@math.ku.dk> - - * mh-e.el (mh-restore-desktop-buffer): Move from - desktop.el. Add Parameters. - 2003-04-18 Steve Youngs <youngs@xemacs.org> * mh-xemacs-icons.el (mh-xemacs-icons): Provide 'mh-xemacs-icons' @@ -7589,7 +8839,7 @@ (dist): Leave release in current directory. -Copyright (C) 2003 Free Software Foundation, Inc. +Copyright (C) 2003, 2004 Free Software Foundation, Inc. Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright
--- a/lisp/mh-e/mh-alias.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-alias.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,7 +1,7 @@ ;;; mh-alias.el --- MH-E mail alias completion and expansion ;; ;; Copyright (C) 1994, 95, 96, 1997, -;; 2001, 02, 2003 Free Software Foundation, Inc. +;; 2001, 02, 03, 2004 Free Software Foundation, Inc. ;; Author: Peter S. Galbraith <psg@debian.org> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -128,6 +128,14 @@ ;;; Alias Loading +(defmacro mh-assoc-ignore-case (key alist) + "Search for string KEY in ALIST. +This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid +`assoc-ignore-case' which is now an obsolete function." + (cond ((fboundp 'assoc-string) `(assoc-string ,key ,alist t)) + ((fboundp 'assoc-ignore-case) `(assoc-ignore-case ,key ,alist)) + (t (error "The macro mh-assoc-ignore-case not implemented properly")))) + (defun mh-alias-tstamp (arg) "Check whether alias files have been modified. Return t if any file listed in the MH profile component Aliasfile has been @@ -169,6 +177,29 @@ (append userlist mh-alias-system-aliases)) userlist)))) +(defun mh-alias-gecos-name (gecos-name username comma-separator) + "Return a usable address string from a GECOS-NAME and USERNAME. +Use only part of the GECOS-NAME up to the first comma if COMMA-SEPARATOR is +non-nil." + (let ((res gecos-name)) + ;; Keep only string until first comma if COMMA-SEPARATOR is t. + (if (and comma-separator + (string-match "^\\([^,]+\\)," res)) + (setq res (match-string 1 res))) + ;; Replace "&" with capitalized username + (if (string-match "&" res) + (setq res (mh-replace-in-string "&" (capitalize username) res))) + ;; Remove " character + (if (string-match "\"" res) + (setq res (mh-replace-in-string "\"" "" res))) + ;; If empty string, use username instead + (if (string-equal "" res) + (setq res username)) + ;; Surround by quotes if doesn't consist of simple characters + (if (not (string-match "^[ a-zA-Z0-9-]+$" res)) + (setq res (concat "\"" res "\""))) + res)) + (defun mh-alias-local-users () "Return an alist of local users from /etc/passwd." (let (passwd-alist) @@ -185,23 +216,23 @@ (goto-char (point-min)))) (while (< (point) (point-max)) (cond - ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]") + ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):") (when (> (string-to-int (match-string 2)) 200) (let* ((username (match-string 1)) (gecos-name (match-string 3)) - (realname - (if (string-match "&" gecos-name) - (concat - (substring gecos-name 0 (match-beginning 0)) - (capitalize username) - (substring gecos-name (match-end 0))) - gecos-name))) + (realname (mh-alias-gecos-name + gecos-name username + mh-alias-passwd-gecos-comma-separator-flag))) (setq passwd-alist - (cons (list username - (if (string-equal "" realname) - (concat "<" username ">") - (concat realname " <" username ">"))) - passwd-alist)))))) + (cons + (list (if mh-alias-local-users-prefix + (concat mh-alias-local-users-prefix + (mh-alias-suggest-alias realname t)) + username) + (if (string-equal username realname) + (concat "<" username ">") + (concat realname " <" username ">"))) + passwd-alist)))))) (forward-line 1))) passwd-alist)) @@ -219,12 +250,12 @@ (cond ((looking-at "^[ \t]")) ;Continuation line ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias - (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist)) + (when (not (mh-assoc-ignore-case (match-string 1) mh-alias-blind-alist)) (setq mh-alias-blind-alist (cons (list (match-string 1)) mh-alias-blind-alist)) (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) ((looking-at "\\(.+\\): .*$") ; A new MH alias - (when (not (assoc-ignore-case (match-string 1) mh-alias-alist)) + (when (not (mh-assoc-ignore-case (match-string 1) mh-alias-alist)) (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))) (forward-line 1))) @@ -235,11 +266,12 @@ user) (while local-users (setq user (car local-users)) - (if (not (assoc-ignore-case (car user) mh-alias-alist)) + (if (not (mh-assoc-ignore-case (car user) mh-alias-alist)) (setq mh-alias-alist (append mh-alias-alist (list user)))) (setq local-users (cdr local-users))))) (message "Loading MH aliases...done")) +;;;###mh-autoload (defun mh-alias-reload-maybe () "Load new MH aliases." (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it. @@ -269,10 +301,10 @@ "Return expansion for ALIAS. Blind aliases or users from /etc/passwd are not expanded." (cond - ((assoc-ignore-case alias mh-alias-blind-alist) + ((mh-assoc-ignore-case alias mh-alias-blind-alist) alias) ; Don't expand a blind alias - ((assoc-ignore-case alias mh-alias-passwd-alist) - (cadr (assoc-ignore-case alias mh-alias-passwd-alist))) + ((mh-assoc-ignore-case alias mh-alias-passwd-alist) + (cadr (mh-assoc-ignore-case alias mh-alias-passwd-alist))) (t (mh-alias-ali alias)))) @@ -302,26 +334,12 @@ (defun mh-alias-minibuffer-confirm-address () "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." (interactive) - (if (not mh-alias-flash-on-comma) - () + (when mh-alias-flash-on-comma (save-excursion (let* ((case-fold-search t) - (the-name (buffer-substring - (progn (skip-chars-backward " \t")(point)) - ;; This moves over to previous comma, if any - (progn (or (and (not (= 0 (skip-chars-backward "^,"))) - ;; the skips over leading whitespace - (skip-chars-forward " ")) - ;; no comma, then to beginning of word - (skip-chars-backward "^ \t")) - ;; In Emacs21, the beginning of the prompt - ;; line is accessible, which wasn't the case - ;; in emacs20. Skip over it. - (if (looking-at "^[^ \t]+:") - (skip-chars-forward "^ \t")) - (skip-chars-forward " ") - (point))))) - (if (assoc-ignore-case the-name mh-alias-alist) + (beg (mh-beginning-of-word)) + (the-name (buffer-substring-no-properties beg (point)))) + (if (mh-assoc-ignore-case the-name mh-alias-alist) (message "%s -> %s" the-name (mh-alias-expand the-name)) ;; Check if if was a single word likely to be an alias (if (and (equal mh-alias-flash-on-comma 1) @@ -335,30 +353,26 @@ (defun mh-alias-letter-expand-alias () "Expand mail alias before point." (mh-alias-reload-maybe) - (let ((mail-abbrevs mh-alias-alist)) - (mh-funcall-if-exists mail-abbrev-complete-alias)) - (when mh-alias-expand-aliases-flag - (let* ((end (point)) - (syntax-table (syntax-table)) - (beg (unwind-protect - (save-excursion - (set-syntax-table mail-abbrev-syntax-table) - (backward-word 1) - (point)) - (set-syntax-table syntax-table))) - (alias (buffer-substring beg end)) - (expansion (mh-alias-expand alias))) - (delete-region beg end) - (insert expansion)))) + (let* ((end (point)) + (begin (mh-beginning-of-word)) + (input (buffer-substring-no-properties begin end))) + (mh-complete-word input mh-alias-alist begin end) + (when mh-alias-expand-aliases-flag + (let* ((end (point)) + (expansion (mh-alias-expand (buffer-substring begin end)))) + (delete-region begin end) + (insert expansion))))) ;;; Adding addresses to alias file. -(defun mh-alias-suggest-alias (string) - "Suggest an alias for STRING." +(defun mh-alias-suggest-alias (string &optional no-comma-swap) + "Suggest an alias for STRING. +Don't reverse the order of strings separated by a comma if NO-COMMA-SWAP is +non-nil." (cond ((string-match "^<\\(.*\\)>$" string) ;; <somename@foo.bar> -> recurse, stripping brackets. - (mh-alias-suggest-alias (match-string 1 string))) + (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) ((string-match "^\\sw+$" string) ;; One word -> downcase it. (downcase string)) @@ -372,47 +386,59 @@ (downcase (match-string 1 string))) ((string-match "^\"\\(.*\\)\".*" string) ;; "Some name" <somename@foo.bar> -> recurse -> "Some name" - (mh-alias-suggest-alias (match-string 1 string))) + (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) ((string-match "^\\(.*\\) +<.*>$" string) ;; Some name <somename@foo.bar> -> recurse -> Some name - (mh-alias-suggest-alias (match-string 1 string))) + (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string) ;; somename@foo.bar (Some name) -> recurse -> Some name - (mh-alias-suggest-alias (match-string 1 string))) + (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string) ;; Strip out title - (mh-alias-suggest-alias (match-string 2 string))) + (mh-alias-suggest-alias (match-string 2 string) no-comma-swap)) ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string) ;; Strip out tails with comma - (mh-alias-suggest-alias (match-string 1 string))) + (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string) ;; Strip out tails - (mh-alias-suggest-alias (match-string 1 string))) + (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string) ;; Strip out initials (mh-alias-suggest-alias - (format "%s %s" (match-string 1 string) (match-string 2 string)))) - ((string-match "^\\([^,]+\\), +\\(.*\\)$" string) - ;; Reverse order of comma-separated fields + (format "%s %s" (match-string 1 string) (match-string 2 string)) + no-comma-swap)) + ((and (not no-comma-swap) + (string-match "^\\([^,]+\\), +\\(.*\\)$" string)) + ;; Reverse order of comma-separated fields to handle: + ;; From: "Galbraith, Peter" <psg@debian.org> + ;; but don't this for a name string extracted from the passwd file + ;; with mh-alias-passwd-gecos-comma-separator-flag set to nil. (mh-alias-suggest-alias - (format "%s %s" (match-string 2 string) (match-string 1 string)))) + (format "%s %s" (match-string 2 string) (match-string 1 string)) + no-comma-swap)) (t ;; Output string, with spaces replaced by dots. (mh-alias-canonicalize-suggestion string)))) (defun mh-alias-canonicalize-suggestion (string) - "Process STRING to replace spacess by periods. -First all spaces are replaced by periods. Then every run of consecutive periods -are replaced with a single period. Finally the string is converted to lower -case." + "Process STRING to replace spaces by periods. +First all spaces and commas are replaced by periods. Then every run of +consecutive periods are replaced with a single period. Finally the string +is converted to lower case." (with-temp-buffer (insert string) ;; Replace spaces with periods (goto-char (point-min)) - (replace-regexp " +" ".") + (while (re-search-forward " +" nil t) + (replace-match "." nil nil)) + ;; Replace commas with periods + (goto-char (point-min)) + (while (re-search-forward ",+" nil t) + (replace-match "." nil nil)) ;; Replace consecutive periods with a single period (goto-char (point-min)) - (replace-regexp "\\.\\.+" ".") + (while (re-search-forward "\\.\\.+" nil t) + (replace-match "." nil nil)) ;; Convert to lower case (downcase-region (point-min) (point-max)) ;; Whew! all done... @@ -617,6 +643,63 @@ (mh-alias-add-alias nil address) (message "No email address found under point.")))) +;;;###mh-autoload +(defun mh-alias-apropos (regexp) + "Show all aliases that match REGEXP either in name or content." + (interactive "sAlias regexp: ") + (if mh-alias-local-users + (mh-alias-reload-maybe)) + (let ((matches "")(group-matches "")(passwd-matches)) + (save-excursion + (message "Reading MH aliases...") + (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") + (message "Reading MH aliases...done. Parsing...") + (while (re-search-forward regexp nil t) + (beginning-of-line) + (cond + ((looking-at "^[ \t]") ;Continuation line + (setq group-matches + (concat group-matches + (buffer-substring + (save-excursion + (or (re-search-backward "^[^ \t]" nil t) + (point))) + (progn + (if (re-search-forward "^[^ \t]" nil t) + (forward-char -1)) + (point)))))) + (t + (setq matches + (concat matches + (buffer-substring (point)(progn (end-of-line)(point))) + "\n"))))) + (message "Reading MH aliases...done. Parsing...done.") + (when mh-alias-local-users + (message + "Reading MH aliases...done. Parsing...done. Passwd aliases...") + (setq passwd-matches + (mapconcat + '(lambda (elem) + (if (or (string-match regexp (car elem)) + (string-match regexp (cadr elem))) + (format "%s: %s\n" (car elem) (cadr elem)))) + mh-alias-passwd-alist "")) + (message + "Reading MH aliases...done. Parsing...done. Passwd aliases...done."))) + (if (and (string-equal "" matches) + (string-equal "" group-matches) + (string-equal "" passwd-matches)) + (message "No matches") + (with-output-to-temp-buffer "*Help*" + (if (not (string-equal "" matches)) + (princ matches)) + (when (not (string-equal group-matches "")) + (princ "\nGroup Aliases:\n\n") + (princ group-matches)) + (when (not (string-equal passwd-matches "")) + (princ "\nLocal User Aliases:\n\n") + (princ passwd-matches)))))) + (provide 'mh-alias) ;;; Local Variables:
--- a/lisp/mh-e/mh-comp.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-comp.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,7 +1,7 @@ ;;; mh-comp.el --- MH-E functions for composing messages ;; Copyright (C) 1993, 95, 1997, -;; 2000, 01, 02, 2003 Free Software Foundation, Inc. +;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -36,7 +36,8 @@ (require 'mh-e) (require 'gnus-util) (require 'easymenu) -(require 'cl) +(require 'mh-utils) +(mh-require-cl) (eval-when (compile load eval) (ignore-errors (require 'mailabbrev))) @@ -199,6 +200,10 @@ (defvar mh-annotate-field nil "Field name for message annotation.") +(defvar mh-insert-auto-fields-done-local nil + "Buffer-local variable set when `mh-insert-auto-fields' successfully called.") +(make-variable-buffer-local 'mh-insert-auto-fields-done-local) + ;;;###autoload (defun mh-smail () "Compose and send mail with the MH mail system. @@ -279,7 +284,8 @@ (save-buffer) (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil config) - (mh-letter-mode-message))) + (mh-letter-mode-message) + (mh-letter-adjust-point))) ;;;###mh-autoload (defun mh-extract-rejected-mail (msg) @@ -309,22 +315,20 @@ (mh-letter-mode-message))) ;;;###mh-autoload -(defun mh-forward (to cc &optional msg-or-seq) +(defun mh-forward (to cc &optional range) "Forward messages to the recipients TO and CC. -Use optional MSG-OR-SEQ argument to specify a message or sequence to forward. +Use optional RANGE argument to specify a message or sequence to forward. Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is forwarded. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. See also documentation for `\\[mh-send]' function." - (interactive (list (mh-read-address "To: ") - (mh-read-address "Cc: ") - (mh-interactive-msg-or-seq "Forward"))) + (interactive (list (mh-interactive-read-address "To: ") + (mh-interactive-read-address "Cc: ") + (mh-interactive-range "Forward"))) (let* ((folder mh-current-folder) - (msgs (mh-msg-or-seq-to-msg-list msg-or-seq)) + (msgs (mh-range-to-msg-list range)) (config (current-window-configuration)) (fwd-msg-file (mh-msg-filename (car msgs) folder)) ;; forw always leaves file in "draft" since it doesn't have -draft @@ -355,8 +359,7 @@ ;; If using MML, translate mhn (if (equal mh-compose-insertion 'gnus) (save-excursion - (re-search-forward (format "^\\(%s\\)?$" - mh-mail-header-separator)) + (goto-char (mh-mail-header-end)) (while (re-search-forward "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" @@ -376,7 +379,7 @@ ;; Postition just before forwarded message (if (re-search-forward "^------- Forwarded Message" nil t) (forward-line -1) - (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator)) + (goto-char (mh-mail-header-end)) (forward-line 1)) (delete-other-windows) (mh-add-msgs-to-seq msgs 'forwarded t) @@ -384,7 +387,8 @@ to forw-subject cc mh-note-forw "Forwarded:" config) - (mh-letter-mode-message))))) + (mh-letter-mode-message) + (mh-letter-adjust-point))))) (defun mh-forwarded-letter-subject (from subject) "Return a Subject suitable for a forwarded message. @@ -567,9 +571,9 @@ If `mh-compose-letter-function' is defined, it is called on the draft and passed three arguments: TO, CC, and SUBJECT." (interactive (list - (mh-read-address "To: ") - (mh-read-address "Cc: ") - (read-string "Subject: "))) + (mh-interactive-read-address "To: ") + (mh-interactive-read-address "Cc: ") + (mh-interactive-read-string "Subject: "))) (let ((config (current-window-configuration))) (delete-other-windows) (mh-send-sub to cc subject config))) @@ -587,9 +591,9 @@ If `mh-compose-letter-function' is defined, it is called on the draft and passed three arguments: TO, CC, and SUBJECT." (interactive (list - (mh-read-address "To: ") - (mh-read-address "Cc: ") - (read-string "Subject: "))) + (mh-interactive-read-address "To: ") + (mh-interactive-read-address "Cc: ") + (mh-interactive-read-string "Subject: "))) (let ((pop-up-windows t)) (mh-send-sub to cc subject (current-window-configuration)))) @@ -630,7 +634,8 @@ (mh-compose-and-send-mail draft "" folder msg-num to subject cc nil nil config) - (mh-letter-mode-message)))) + (mh-letter-mode-message) + (mh-letter-adjust-point)))) (defun mh-read-draft (use initial-contents delete-contents-file) "Read draft file into a draft buffer and make that buffer the current one. @@ -695,7 +700,7 @@ (save-excursion (cond ((get-buffer buffer) ; Buffer may be deleted (set-buffer buffer) - (mh-iterate-on-msg-or-seq nil msg + (mh-iterate-on-range nil msg (mh-notate nil note (1+ mh-cmd-note))))))) (defun mh-insert-fields (&rest name-values) @@ -867,7 +872,6 @@ `mh-letter-mode-hook' are run. \\{mh-letter-mode-map}" - (or mh-user-path (mh-find-path)) (make-local-variable 'mh-send-args) (make-local-variable 'mh-annotate-char) @@ -879,6 +883,14 @@ (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el (make-local-variable 'mh-help-messages) (setq mh-help-messages mh-letter-mode-help-messages) + (setq buffer-invisibility-spec '((vanish . t) t)) + (set (make-local-variable 'line-move-ignore-invisible) t) + + ;; Set mh-mail-header-end-marker to remember end of message header. + (set (make-local-variable 'mh-letter-mail-header-end-marker) + (set-marker (make-marker) (save-excursion + (goto-char (mh-mail-header-end)) + (line-beginning-position 2)))) ;; From sendmail.el for proper paragraph fill ;; sendmail.el also sets a normal-auto-fill-function (not done here) @@ -908,8 +920,7 @@ ;; Enable undo since a show-mode buffer might have been reused. (buffer-enable-undo) - (if (and (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) + (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map) (mh-funcall-if-exists mh-toolbar-init :letter) (make-local-variable 'font-lock-defaults) (cond @@ -919,7 +930,7 @@ ;; is that gnus uses static text properties which are not appropriate ;; for a buffer that will be edited. So the choice here is either fontify ;; the citations and header... - (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) + (setq font-lock-defaults '(mh-letter-font-lock-keywords t))) (t ;; ...or the header only (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) @@ -930,6 +941,36 @@ (make-local-variable 'auto-fill-function) (setq auto-fill-function 'mh-auto-fill-for-letter))) +(defun mh-font-lock-field-data (limit) + "Find header field region between point and LIMIT." + (and (< (point) (mh-letter-header-end)) + (< (point) limit) + (let ((end (min limit (mh-letter-header-end))) + (point (point)) + data-end data-begin field) + (end-of-line) + (setq data-end (if (re-search-forward "^[^ \t]" end t) + (match-beginning 0) + end)) + (goto-char (1- data-end)) + (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t)) + (setq data-begin (point-min)) + (setq data-begin (match-end 0)) + (setq field (match-string 1))) + (setq data-begin (max point data-begin)) + (if (and field (mh-letter-skipped-header-field-p field)) + (set-match-data nil) + (set-match-data (list data-begin data-end data-begin data-end))) + (goto-char (if (equal point data-end) (1+ data-end) data-end)) + t))) + +(defun mh-letter-header-end () + "Find the end of header from `mh-letter-mail-header-end-marker'." + (save-excursion + (goto-char (marker-position mh-letter-mail-header-end-marker)) + (forward-line -1) + (point))) + (defun mh-auto-fill-for-letter () "Perform auto-fill for message. Header is treated specially by inserting a tab before continuation lines." @@ -1061,7 +1102,7 @@ The versions of MH-E, Emacs, and MH are shown." ;; Lazily initialize mh-x-mailer-string. - (when (null mh-x-mailer-string) + (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string)) (save-window-excursion ;; User would be confused if version info buffer disappeared magically, ;; so don't delete buffer if it already existed. @@ -1088,7 +1129,8 @@ (kill-buffer mh-info-buffer))))) ;; Insert X-Mailer, but only if it doesn't already exist. (save-excursion - (when (null (mh-goto-header-field "X-Mailer")) + (when (and mh-insert-x-mailer-flag + (null (mh-goto-header-field "X-Mailer"))) (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) (defun mh-regexp-in-field-p (regexp &rest fields) @@ -1106,39 +1148,60 @@ (setq fields (cdr fields)))) search-result))) -(defun mh-insert-auto-fields () - "Insert custom fields if To or Cc match `mh-auto-fields-list'." - (save-excursion - (when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))) - (let ((list mh-auto-fields-list)) - (while list - (let ((regexp (nth 0 (car list))) - (entries (nth 1 (car list)))) - (when (mh-regexp-in-field-p regexp "To:" "cc:") - (let ((entry-list entries)) - (while entry-list - (let ((field (caar entry-list)) - (value (cdar entry-list))) - (cond - ((equal "identity" field) - (when (assoc value mh-identity-list) - (mh-insert-identity value))) - (t - (mh-modify-header-field field value - (equal field "From"))))) - (setq entry-list (cdr entry-list)))))) - (setq list (cdr list))))))) +;;;###mh-autoload +(defun mh-insert-auto-fields (&optional non-interactive) + "Insert custom fields if To or Cc match `mh-auto-fields-list'. +Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted +something. If NON-INTERACTIVE is non-nil, do not be verbose and only +attempt matches if `mh-insert-auto-fields-done-local' is nil. + +An `identity' entry is skipped if one was already entered manually." + (interactive) + (when (or (not non-interactive) (not mh-insert-auto-fields-done-local)) + (save-excursion + (when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))) + (let ((list mh-auto-fields-list)) + (while list + (let ((regexp (nth 0 (car list))) + (entries (nth 1 (car list)))) + (when (mh-regexp-in-field-p regexp "To:" "cc:") + (setq mh-insert-auto-fields-done-local t) + (if (not non-interactive) + (message "Matched for regexp %s" regexp)) + (let ((entry-list entries)) + (while entry-list + (let ((field (caar entry-list)) + (value (cdar entry-list))) + (cond + ((equal "identity" field) + (when (and (not mh-identity-local) + (assoc value mh-identity-list)) + (mh-insert-identity value))) + (t + (mh-modify-header-field field value + (equal field "From"))))) + (setq entry-list (cdr entry-list)))))) + (setq list (cdr list)))))))) (defun mh-modify-header-field (field value &optional overwrite-flag) "To header FIELD add VALUE. If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded." - (cond ((mh-goto-header-field (concat field ":")) - (insert value) - (if overwrite-flag - (delete-region (point) (line-end-position)) - (insert ", "))) - (t (mh-goto-header-end 0) - (insert field ": " value "\n")))) + (cond ((and overwrite-flag + (mh-goto-header-field (concat field ":"))) + (insert " " value) + (delete-region (point) (line-end-position))) + ((and (not overwrite-flag) + (mh-regexp-in-field-p (concat "\\b" value "\\b") field)) + ;; Already there, do nothing. + ) + ((and (not overwrite-flag) + (mh-goto-header-field (concat field ":"))) + (insert " " value ",")) + (t + (mh-goto-header-end 0) + (insert field ": " value "\n")))) + +(defvar mh-letter-mail-header-end-marker nil) (defun mh-compose-and-send-mail (draft send-args sent-from-folder sent-from-msg @@ -1157,8 +1220,8 @@ for `mh-annotate-msg'. CONFIG is the window configuration to restore after sending the letter." (pop-to-buffer draft) - (mh-insert-auto-fields) (mh-letter-mode) + (mh-insert-auto-fields t) ;; mh-identity support (if (and (boundp 'mh-identity-default) @@ -1170,6 +1233,12 @@ (mh-identity-make-menu) (easy-menu-add mh-identity-menu)) + ;; Extra fields + (mh-insert-x-mailer) + (mh-insert-x-face) + ;; Hide skipped fields + (mh-letter-hide-all-skipped-fields) + (setq mh-sent-from-folder sent-from-folder) (setq mh-sent-from-msg sent-from-msg) (setq mh-send-args send-args) @@ -1209,12 +1278,11 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists." (interactive "P") (run-hooks 'mh-before-send-letter-hook) + (mh-insert-auto-fields t) (cond ((mh-mhn-directive-present-p) (mh-edit-mhn)) ((mh-mml-directive-present-p) (mh-mml-to-mime))) - (if mh-insert-x-mailer-flag (mh-insert-x-mailer)) - (mh-insert-x-face) (save-buffer) (message "Sending...") (let ((draft-buffer (current-buffer)) @@ -1481,52 +1549,285 @@ (mh-do-in-xemacs (defvar mail-abbrevs)) +;;;###mh-autoload +(defun mh-complete-word (word choices begin end) + "Complete WORD at from CHOICES. +Any match found replaces the text from BEGIN to END." + (let ((completion (try-completion word choices))) + (cond ((eq completion t) + (message "Completed: %s" word)) + ((null completion) + (message "No completion for `%s'" word)) + ((stringp completion) + (if (equal word completion) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list (all-completions word choices))) + (delete-region begin end) + (insert completion)))))) + +;;;###mh-autoload +(defun mh-beginning-of-word (&optional n) + "Return position of the N th word backwards." + (unless n (setq n 1)) + (let ((syntax-table (syntax-table))) + (unwind-protect + (save-excursion + (mh-funcall-if-exists mail-abbrev-make-syntax-table) + (set-syntax-table mail-abbrev-syntax-table) + (backward-word n) + (point)) + (set-syntax-table syntax-table)))) + (defun mh-folder-expand-at-point () "Do folder name completion in Fcc header field." (let* ((end (point)) - (syntax-table (syntax-table)) - (beg (unwind-protect - (save-excursion - (mh-funcall-if-exists mail-abbrev-make-syntax-table) - (set-syntax-table mail-abbrev-syntax-table) - (backward-word 1) - (point)) - (set-syntax-table syntax-table))) + (beg (mh-beginning-of-word)) (folder (buffer-substring beg end)) (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+))) (last-slash (mh-search-from-end ?/ folder)) (prefix (and last-slash (substring folder 0 last-slash))) - (mail-abbrevs - (mapcar #'(lambda (x) - (list (cond (prefix (format "%s/%s" prefix x)) - (leading-plus (format "+%s" x)) - (t x)))) - (mh-folder-completion-function folder nil t)))) - (if (fboundp 'mail-abbrev-complete-alias) - (mh-funcall-if-exists mail-abbrev-complete-alias) - (error "Fcc completion not supported in your version of Emacs")))) + (choices (mapcar #'(lambda (x) + (list (cond (prefix (format "%s/%s" prefix x)) + (leading-plus (format "+%s" x)) + (t x)))) + (mh-folder-completion-function folder nil t)))) + (mh-complete-word folder choices beg end))) -;;;###mh-autoload +;; XXX: This should probably be customizable +(defvar mh-letter-complete-function-alist + '((cc . mh-alias-letter-expand-alias) + (bcc . mh-alias-letter-expand-alias) + (dcc . mh-alias-letter-expand-alias) + (fcc . mh-folder-expand-at-point) + (from . mh-alias-letter-expand-alias) + (mail-followup-to . mh-alias-letter-expand-alias) + (reply-to . mh-alias-letter-expand-alias) + (to . mh-alias-letter-expand-alias)) + "Alist of header fields and completion functions to use.") + (defun mh-letter-complete (arg) "Perform completion on header field or word preceding point. -Alias completion is done within the mail header on selected fields and -by the function designated by `mh-letter-complete-function' elsewhere, -passing the prefix ARG if any." +Alias completion is done within the mail header on selected fields based on +the matches in `mh-letter-complete-function-alist'. Elsewhere the function +designated by `mh-letter-complete-function' is used and given the prefix ARG, +if present." + (interactive "P") + (let ((func nil)) + (cond ((not (mh-in-header-p)) + (funcall mh-letter-complete-function arg)) + ((setq func (cdr (assoc (mh-letter-header-field-at-point) + mh-letter-complete-function-alist))) + (funcall func)) + (t (funcall mh-letter-complete-function arg))))) + +(defun mh-letter-complete-or-space (arg) + "Perform completion or insert space. +If `mh-compose-space-does-completion-flag' is nil (the default) a space is +inserted. + +Otherwise, if point is in the message header and the preceding character is +not whitespace then do completion. Otherwise insert a space character. + +ARG is the number of spaces inserted." + (interactive "p") + (let ((func nil) + (end-of-prev (save-excursion + (goto-char (mh-beginning-of-word)) + (mh-beginning-of-word -1)))) + (cond ((not mh-compose-space-does-completion-flag) + (self-insert-command arg)) + ((not (mh-in-header-p)) (self-insert-command arg)) + ((> (point) end-of-prev) (self-insert-command arg)) + ((setq func (cdr (assoc (mh-letter-header-field-at-point) + mh-letter-complete-function-alist))) + (funcall func)) + (t (self-insert-command arg))))) + +(defun mh-letter-confirm-address () + "Flash alias expansion if `mh-alias-flash-on-comma' is non-nil." + (interactive) + (cond ((not (mh-in-header-p)) (self-insert-command 1)) + ((eq (cdr (assoc (mh-letter-header-field-at-point) + mh-letter-complete-function-alist)) + 'mh-alias-letter-expand-alias) + (mh-alias-reload-maybe) + (mh-alias-minibuffer-confirm-address)) + (t (self-insert-command 1)))) + +(defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):") + +(defun mh-letter-header-field-at-point () + "Return the header field name at point. +A symbol is returned whose name is the string obtained by downcasing the field +name." + (save-excursion + (end-of-line) + (and (re-search-backward mh-letter-header-field-regexp nil t) + (intern (downcase (match-string 1)))))) + +;;;###mh-autoload +(defun mh-letter-next-header-field-or-indent (arg) + "Move to next field or indent depending on point. +In the message header, go to the next field. Elsewhere call +`indent-relative' as usual with optional prefix ARG." (interactive "P") - (let ((case-fold-search t)) - (cond - ((and (mh-in-header-p) - (save-excursion - (mh-header-field-beginning) - (looking-at "^fcc:"))) - (mh-folder-expand-at-point)) - ((and (mh-in-header-p) - (save-excursion - (mh-header-field-beginning) - (looking-at "^.*\\(to\\|cc\\|from\\):"))) - (mh-alias-letter-expand-alias)) - (t - (funcall mh-letter-complete-function arg))))) + (let ((header-end (save-excursion + (goto-char (mh-mail-header-end)) + (forward-line) + (point)))) + (if (> (point) header-end) + (indent-relative arg) + (mh-letter-next-header-field)))) + +(defun mh-letter-next-header-field () + "Cycle to the next header field. +If we are at the last header field go to the start of the message body." + (let ((header-end (mh-mail-header-end))) + (cond ((>= (point) header-end) (goto-char (point-min))) + ((< (point) (progn + (beginning-of-line) + (re-search-forward mh-letter-header-field-regexp + (line-end-position) t) + (point))) + (beginning-of-line)) + (t (end-of-line))) + (cond ((re-search-forward mh-letter-header-field-regexp header-end t) + (if (mh-letter-skipped-header-field-p (match-string 1)) + (mh-letter-next-header-field) + (mh-letter-skip-leading-whitespace-in-header-field))) + (t (goto-char header-end) + (forward-line))))) + +;;;###mh-autoload +(defun mh-letter-previous-header-field () + "Cycle to the previous header field. +If we are at the first header field go to the start of the message body." + (interactive) + (let ((header-end (mh-mail-header-end))) + (if (>= (point) header-end) + (goto-char header-end) + (mh-header-field-beginning)) + (cond ((re-search-backward mh-letter-header-field-regexp nil t) + (if (mh-letter-skipped-header-field-p (match-string 1)) + (mh-letter-previous-header-field) + (goto-char (match-end 0)) + (mh-letter-skip-leading-whitespace-in-header-field))) + (t (goto-char header-end) + (forward-line))))) + +(defun mh-letter-skipped-header-field-p (field) + "Check if FIELD is to be skipped." + (let ((field (downcase field))) + (loop for x in mh-compose-skipped-header-fields + when (equal (downcase x) field) return t + finally return nil))) + +(defun mh-letter-skip-leading-whitespace-in-header-field () + "Skip leading whitespace in a header field. +If the header field doesn't have at least one space after the colon then a +space character is added." + (let ((need-space t)) + (while (memq (char-after) '(?\t ?\ )) + (forward-char) + (setq need-space nil)) + (when need-space (insert " ")))) + +(defvar mh-hidden-header-keymap + (let ((map (make-sparse-keymap))) + (mh-do-in-gnu-emacs + (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button)) + (mh-do-in-xemacs + (define-key map '(button2) + 'mh-letter-toggle-header-field-display-button)) + map)) + +(defun mh-letter-toggle-header-field-display-button (event) + "Toggle header field display at location of EVENT. +This function does the same thing as `mh-letter-toggle-header-field-display' +except that it is callable from a mouse button." + (interactive "e") + (mh-do-at-event-location event + (mh-letter-toggle-header-field-display nil))) + +(defun mh-letter-toggle-header-field-display (arg) + "Toggle display of header field at point. +If the header is long or spread over multiple lines then hiding it will show +the first few characters and replace the rest with an ellipsis. + +If ARG is negative then header is hidden, if positive it is displayed. If ARG +is the symbol `long' then keep at most the first 4 lines." + (interactive (list nil)) + (when (and (mh-in-header-p) + (progn + (end-of-line) + (re-search-backward mh-letter-header-field-regexp nil t))) + (let ((buffer-read-only nil) + (modified-flag (buffer-modified-p)) + (begin (point)) + end) + (end-of-line) + (setq end (1- (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + (point-max)))) + (goto-char begin) + ;; Make it clickable... + (add-text-properties begin end `(keymap ,mh-hidden-header-keymap + mouse-face highlight)) + (unwind-protect + (cond ((or (and (not arg) + (text-property-any begin end 'invisible 'vanish)) + (and (numberp arg) (>= arg 0)) + (and (eq arg 'long) (> (line-beginning-position 5) end))) + (remove-text-properties begin end '(invisible nil)) + (search-forward ":" (line-end-position) t) + (mh-letter-skip-leading-whitespace-in-header-field)) + ((eq arg 'long) + (end-of-line 4) + (mh-letter-truncate-header-field end) + (beginning-of-line)) + (t (end-of-line) + (mh-letter-truncate-header-field end) + (beginning-of-line))) + (set-buffer-modified-p modified-flag))))) + +(defun mh-letter-truncate-header-field (end) + "Replace text from current line till END with an ellipsis. +If the current line is too long truncate a part of it as well." + (let ((max-len (min (window-width) 62))) + (when (> (+ (current-column) 4) max-len) + (backward-char (- (+ (current-column) 5) max-len))) + (when (> end (point)) + (add-text-properties (point) end '(invisible vanish))))) + +(defun mh-letter-hide-all-skipped-fields () + "Hide all skipped fields." + (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point) (mh-mail-header-end)) + (while (re-search-forward mh-letter-header-field-regexp nil t) + (if (mh-letter-skipped-header-field-p (match-string 1)) + (mh-letter-toggle-header-field-display -1) + (mh-letter-toggle-header-field-display 'long)) + (beginning-of-line 2))))) + +(defun mh-interactive-read-address (prompt) + "Read an address. +If `mh-compose-prompt-flag' is non-nil, then read an address with PROMPT. +Otherwise return the empty string." + (if mh-compose-prompt-flag (mh-read-address prompt) "")) + +(defun mh-interactive-read-string (prompt) + "Read a string. +If `mh-compose-prompt-flag' is non-nil, then read a string with PROMPT. +Otherwise return the empty string." + (if mh-compose-prompt-flag (read-string prompt) "")) + +(defun mh-letter-adjust-point () + "Move cursor to first header field if are using the no prompt mode." + (unless mh-compose-prompt-flag + (goto-char (point-max)) + (mh-letter-next-header-field))) ;;; Build the letter-mode keymap: ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. @@ -1534,6 +1835,7 @@ "\C-c?" mh-help "\C-c\C-c" mh-send-letter "\C-c\C-d" mh-insert-identity + "\C-c\M-d" mh-insert-auto-fields "\C-c\C-e" mh-edit-mhn "\C-c\C-f\C-b" mh-to-field "\C-c\C-f\C-c" mh-to-field @@ -1569,7 +1871,12 @@ "\C-c\C-^" mh-insert-signature ;if no C-s "\C-c\C-w" mh-check-whom "\C-c\C-y" mh-yank-cur-msg - "\M-\t" mh-letter-complete) + "\C-c\C-t" mh-letter-toggle-header-field-display + " " mh-letter-complete-or-space + "\M-\t" mh-letter-complete + "\t" mh-letter-next-header-field-or-indent + [backtab] mh-letter-previous-header-field + "," mh-letter-confirm-address) ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
--- a/lisp/mh-e/mh-customize.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-customize.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,6 +1,6 @@ ;;; mh-customize.el --- MH-E customization -;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -57,7 +57,10 @@ ;;; Code: (provide 'mh-customize) -(require 'mh-e) +(require 'mh-utils) + +(when mh-xemacs-flag + (require 'mh-xemacs)) ;;;###mh-autoload (defun mh-customize (&optional delete-other-windows-flag) @@ -158,6 +161,13 @@ :group 'mh-faces :group 'mh-folder) +(defgroup mh-index-faces nil + "Faces used in indexed searches." + :link '(custom-manual "(mh-e)Customizing mh-e") + :prefix "mh-" + :group 'mh-faces + :group 'mh-index) + (defgroup mh-show-faces nil "Faces used in message display." :link '(custom-manual "(mh-e)Customizing mh-e") @@ -165,12 +175,12 @@ :group 'mh-faces :group 'mh-show) -(defgroup mh-index-faces nil - "Faces used in indexed searches." +(defgroup mh-letter-faces nil + "Faces used when composing messages." :link '(custom-manual "(mh-e)Customizing mh-e") :prefix "mh-" :group 'mh-faces - :group 'mh-index) + :group 'mh-letter) @@ -230,7 +240,6 @@ ;; XEmacs has a couple of extra customizations... (mh-do-in-xemacs - (require 'mh-xemacs-icons) (defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar) (featurep 'xpm) (device-on-window-system-p)) @@ -283,9 +292,10 @@ :letter then the default buttons in the letter mode are listed. FUNC1, FUNC2, FUNC3, ... are the names of the functions that the buttons would execute. -Each element of BUTTONS is a list of four things: +Each element of BUTTONS is a list consisting of four mandatory items and one +optional item as follows: - (FUNCTION MODES ICON DOC) + (FUNCTION MODES ICON DOC &optional ENABLE-EXPR) where, @@ -308,7 +318,11 @@ DOC is the documentation for the button. It is used in tool-tips and in providing other help to the user. GNU Emacs uses only the first line of the string. So the DOC should be formatted such that the first line is useful and - complete without the rest of the string." + complete without the rest of the string. + + Optional item ENABLE-EXPR is an arbitrary lisp expression. If it evaluates + to nil, then the button is deactivated, otherwise it is active. If is in't + present then the button is always active." ;; The following variable names have been carefully chosen to make code ;; generation easier. Modifying the names should be done carefully. (let (folder-buttons folder-docs folder-button-setter sequence-button-setter @@ -320,7 +334,8 @@ (cond ((eq (car x) :folder) (setq folder-defaults (cdr x))) ((eq (car x) :letter) (setq letter-defaults (cdr x))))) (dolist (button buttons) - (unless (and (listp button) (equal (length button) 4)) + (unless (and (listp button) + (or (equal (length button) 4) (equal (length button) 5))) (error "Incorrect MH-E tool-bar button specification: %s" button)) (let* ((name (nth 0 button)) (name-str (symbol-name name)) @@ -331,6 +346,7 @@ (doc (if (string-match "\\(.*\\)\n" full-doc) (match-string 1 full-doc) full-doc)) + (enable-expr (or (nth 4 button) t)) (modes (nth 1 button)) functions show-sym) (when (memq 'letter modes) (setq functions `(:letter ,name))) @@ -369,7 +385,8 @@ (add-to-list setter `(when (member ',name ,list) (mh-funcall-if-exists - tool-bar-add-item ,icon ',function ',key :help ,doc))) + tool-bar-add-item ,icon ',function ',key + :help ,doc :enable ',enable-expr))) (add-to-list mbuttons name) (if docs (add-to-list docs doc)))))) (setq folder-buttons (nreverse folder-buttons) @@ -464,22 +481,22 @@ (when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag) (cond ((eq mh-xemacs-toolbar-position 'top) - (set-specifier top-toolbar (cons buffer toolbar)) + (set-specifier top-toolbar toolbar buffer) (set-specifier top-toolbar-visible-p t) (set-specifier top-toolbar-height height)) ((eq mh-xemacs-toolbar-position 'bottom) - (set-specifier bottom-toolbar (cons buffer toolbar)) + (set-specifier bottom-toolbar toolbar buffer) (set-specifier bottom-toolbar-visible-p t) (set-specifier bottom-toolbar-height height)) ((eq mh-xemacs-toolbar-position 'left) - (set-specifier left-toolbar (cons buffer toolbar)) + (set-specifier left-toolbar toolbar buffer) (set-specifier left-toolbar-visible-p t) (set-specifier left-toolbar-width width)) ((eq mh-xemacs-toolbar-position 'right) - (set-specifier right-toolbar (cons buffer toolbar)) + (set-specifier right-toolbar toolbar buffer) (set-specifier right-toolbar-visible-p t) (set-specifier right-toolbar-width width)) - (t (set-specifier default-toolbar (cons buffer toolbar)))))))) + (t (set-specifier default-toolbar toolbar buffer))))))) ;; Declare customizable toolbars (custom-declare-variable 'mh-tool-bar-folder-buttons @@ -541,7 +558,8 @@ (mh-reply (folder) "mail/reply2" "Reply to this message\nThis button runs `mh-reply'") (mh-alias-grab-from-field (folder) "alias" - "Grab From alias\nThis button runs `mh-alias-grab-from-field'") + "Grab From alias\nThis button runs `mh-alias-grab-from-field'" + (mh-alias-from-has-no-alias-p)) (mh-send (folder) "mail_compose" "Compose new message\nThis button runs `mh-send'") (mh-rescan-folder (folder) "rescan" @@ -661,7 +679,6 @@ :type 'string :group 'mh-folder) - (defcustom mh-inc-spool-list nil "*Alist of alternate spool files, corresponding folders and keybindings. Here's an example. Suppose you have subscribed to the MH-E devel mailing @@ -699,6 +716,13 @@ :set 'mh-inc-spool-list-set :group 'mh-folder) +(defcustom mh-interpret-number-as-range-flag t + "Non-nil means interpret a number as a range. +If the variable is non-nil, and you use an integer, N, when asked for a +range to scan, then MH-E uses the range \"last:N\"." + :type 'boolean + :group 'mh-folder) + (defcustom mh-lpr-command-format "lpr -J '%s'" "*Format for Unix command that prints a message. The string should be a Unix command line, with the string '%s' where @@ -734,6 +758,18 @@ :type 'boolean :group 'mh-folder) +;;; If `mh-unpropagated-sequences' becomes a defcustom, add the following tot +;;; he docstring: "Additional sequences that should not to be preserved can be +;;; specified by setting `mh-unpropagated-sequences' appropriately." XXX + +(defcustom mh-refile-preserves-sequences-flag t + "*Non-nil means that sequences are preserved when messages are refiled. +If this variable is non-nil and a message belonging to a sequence other than +cur or Previous-Sequence (see mh-profile 5) is refiled then it is put in the +same sequence in the destination folder." + :type 'boolean + :group 'mh-folder) + (defcustom mh-scan-format-file t "Specifies the format file to pass to the scan program. If t, the format string will be taken from the either `mh-scan-format-mh' @@ -819,6 +855,16 @@ (const :tag "grep" grep)) :group 'mh-index) +(defcustom mh-index-ticked-messages-folders t + "Folders searched for `mh-tick-seq'. +If t, then `mh-inbox' is searched. If nil, all the top level folders are +searched. Otherwise the list of folders specified as strings are searched. +See also `mh-recursive-folders-flag'." + :group 'mh-index + :type '(choice (const :tag "Inbox" t) + (const :tag "All" nil) + (repeat :tag "Choose folders" (string :tag "Folder")))) + ;;; Spam Handling (:group 'mh-junk) @@ -878,8 +924,9 @@ (defcustom mh-clean-message-header-flag t "*Non-nil means clean headers of messages that are displayed or inserted. -The variables `mh-invisible-headers' and `mh-visible-headers' control -what is removed." +The variable `mh-invisible-headers' if set determines the header fields that +are displayed. If it isn't set, then the variable `mh-invisible-headers' +determines the header fields that are removed." :type 'boolean :group 'mh-show) @@ -888,6 +935,14 @@ :type 'boolean :group 'mh-show) +(defcustom mh-display-buttons-for-alternatives-flag nil + "*Non-nil means display buttons for all MIME alternatives. +Default behavior is to display only the preferred alternative. If this +variable is non-nil, then the preferred part is shown inline and buttons +are shown for each of the other alternatives." + :type 'boolean + :group 'mh-show) + (defcustom mh-display-buttons-for-inline-parts-flag nil "*Non-nil means display buttons for all inline MIME parts. If non-nil, buttons are displayed for all MIME parts. Inline parts start off @@ -949,27 +1004,23 @@ (defvar mh-invisible-headers nil "*Regexp matching lines in a message header that are not to be shown. -Use the function `mh-invisible-headers' to generate this variable. -If `mh-visible-headers' is non-nil, it is used instead to specify what -to keep.") +Customize the variable `mh-invisible-header-fields' to generate this variable; +It will in turn automatically use the function `mh-invisible-headers' to +generate this variable. +If the variable `mh-visible-headers' is non-nil, it is used instead to specify +what to keep.") (defun mh-invisible-headers () "Make or remake the variable `mh-invisible-headers'. Done using `mh-invisible-header-fields' as input." - (setq mh-invisible-headers - (concat - "^" - (let ((max-specpdl-size 1000) ;workaround for insufficient default - (fields mh-invisible-header-fields)) - (regexp-opt fields t))))) - -(defun mh-invisible-header-fields-set (symbol value) - "Update `mh-invisible-header-fields'. -The function is called with SYMBOL bound to `mh-invisible-header-fields' and -VALUE is the the list of headers that are invisible. As a side effect, the -variable `mh-invisible-fields' is set." - (set-default symbol value) - (mh-invisible-headers)) + (if mh-invisible-header-fields + (setq mh-invisible-headers + (concat + "^" + (let ((max-specpdl-size 1000) ;workaround for insufficient default + (fields mh-invisible-header-fields)) + (regexp-opt fields t)))) + (setq mh-invisible-headers nil))) ;; Keep fields alphabetized. Mention source, if known. (defcustom mh-invisible-header-fields @@ -982,6 +1033,7 @@ "Delivery-Date:" ; MH "Delivery:" "Encoding:" + "Envelope-to:" "Errors-To:" "Face:" ; Gnus Face header "Forwarded:" ; MH @@ -1023,7 +1075,7 @@ "Sensitivity:" ; MS Outlook "Status:" ; sendmail "Ua-Content-Id:" ; X400 - "User-Agent:" +;; "User-Agent:" ; Similar to X-Mailer, so display it. "Via:" ; MH "X-Abuse-Info:" "X-Accept-Language:" @@ -1076,6 +1128,7 @@ "X-Orcl-Content-Type:" "X-Original-Complaints-To:" "X-Original-Date:" ; SourceForge mailing list manager + "X-Original-To:" "X-Original-Trace:" "X-OriginalArrivalTime:" ; Hotmail "X-Originating-IP:" ; Hotmail @@ -1113,9 +1166,11 @@ Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise, the element can be used to render invisible an entire class of fields that start with the same prefix. -This variable is ignored if `mh-visible-headers' is set." +This variable is ignored if the variable `mh-visible-headers' is set." :type '(repeat (string :tag "Header field")) - :set 'mh-invisible-header-fields-set + :set (lambda (symbol value) + (set-default symbol value) + (mh-invisible-headers)) :group 'mh-show) (defcustom mh-max-inline-image-height nil @@ -1185,19 +1240,43 @@ :type 'boolean :group 'mh-show) -(defcustom mh-summary-height (or (and (fboundp 'frame-height) - (> (frame-height) 24) - (min 10 (/ (frame-height) 6))) - 4) +(defcustom mh-summary-height nil "*Number of lines in MH-Folder window (including the mode line)." - :type 'integer + :type '(choice (const :tag "Automatic" nil) + (integer :tag "Fixed sized")) :group 'mh-show) -(defcustom mh-visible-headers nil - "*Contains a regexp specifying the headers to keep when cleaning. +(defvar mh-visible-headers nil + "*Regexp matching lines in a message header that are to be shown. +Customize the variable `mh-visible-header-fields' to generate this variable; +It will in turn automatically use the function `mh-visible-headers' to +generate this variable. Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides -the variable `mh-invisible-headers'." - :type '(choice (const nil) regexp) +the variable `mh-invisible-headers'.") + +(defun mh-visible-headers () + "Make or remake the variable `mh-visible-headers'. +Done using `mh-visible-header-fields' as input." + (if mh-visible-header-fields + (setq mh-visible-headers + (concat + "^" + (let ((max-specpdl-size 1000) ;workaround for insufficient default + (fields mh-visible-header-fields)) + (regexp-opt fields t)))) + (setq mh-visible-headers nil))) + +(defcustom mh-visible-header-fields nil +"*List of header fields that are to be shown. +Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise, +the element can be used to render visible an entire class of fields that +start with the same prefix. +Only used if `mh-clean-message-header-flag' is non-nil. +Setting it overrides the variable `mh-invisible-headers'." + :type '(repeat (string :tag "Header field")) + :set (lambda (symbol value) + (set-default symbol value) + (mh-visible-headers)) :group 'mh-show) (defcustom mhl-formfile nil @@ -1227,6 +1306,23 @@ :type '(choice (const nil) function) :group 'mh-letter) +(defcustom mh-compose-prompt-flag nil + "*Non-nil means prompt for header fields when composing a new draft." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-compose-skipped-header-fields + '("from" "organization" "references" "in-reply-to" "x-face" "face" + "x-mailer") + "List of header fields to skip over when navigating in draft." + :type '(repeat (string :tag "Field")) + :group 'mh-letter) + +(defcustom mh-compose-space-does-completion-flag nil + "*Non-nil means that SPACE does completion in message header." + :type 'boolean + :group 'mh-letter) + (defcustom mh-delete-yanked-msg-window-flag nil "*Non-nil means delete any window displaying the message. Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. @@ -1428,6 +1524,33 @@ :type '(choice (boolean) (string)) :group 'mh-alias) +(defcustom mh-alias-local-users-prefix "local." + "*String prepended to the real names of users from the passwd file. +If nil, use the username string unmodified instead of the real name from +the gecos field of the passwd file. + +For example, given the following passwd file line: + + psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh + +here are the derived aliases for different values of this variable: + + \"local.\" -> local.peter.galbraith + \"\" -> peter.galbraith + nii -> psg + +This variable is only meaningful if the variable `mh-alias-local-users' is +non-nil." + :type '(choice (const :tag "Use username instead of real name" nil) + (string)) + :group 'mh-alias) + +(defcustom mh-alias-passwd-gecos-comma-separator-flag t + "*Non-nil means the gecos field in the passwd file uses comma as a separator. +Used to construct aliases for users in the passwd file." + :type 'boolean + :group 'mh-alias) + (defcustom mh-alias-system-aliases '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd") "*A list of system files from which to cull aliases. @@ -1442,7 +1565,52 @@ ;;; Multiple personalities (:group 'mh-identity) -(defvar mh-identity-list ()) +(defcustom mh-identity-list nil + "*List holding MH-E identity. +Omit the colon and trailing space from the field names. +The keyword name \"none\" is reserved for internal use. +Use the keyname name \"signature\" to specify either a signature file or a +function to call to insert a signature at point. + +Providing an empty Value (\"\") will cause the field to be deleted. + +Example entries using the customize interface: + Keyword name: work + From + Value: John Doe <john@work.com> + Organization + Value: Acme Inc. + Keyword name: home + From + Value: John Doe <johndoe@home.net> + Organization + Value: + +This would produce the equivalent of: + (setq mh-identity-list + '((\"work\" + ((\"From\" . \"John Doe <john@work.com>\") + (\"Organization\" . \"Acme Inc.\"))) + (\"home\" + ((\"From\" . \"John Doe <johndoe@home.net>\") + (\"Organization\" . \"\")))))" + :type '(repeat (list :tag "" + (string :tag "Keyword name") + (repeat :tag "At least one pair from below" + (choice (cons :tag "From field" + (const "From") + (string :tag "Value")) + (cons :tag "Organization field" + (const "Organization") + (string :tag "Value")) + (cons :tag "Signature" + (const "signature") + (choice (file) (function))) + (cons :tag "Other field & value pair" + (string :tag "Field") + (string :tag "Value")))))) + :set 'mh-identity-list-set + :group 'mh-identity) (defcustom mh-auto-fields-list nil "Alist of addresses for which header lines are automatically inserted. @@ -1491,53 +1659,6 @@ (mapcar 'car mh-identity-list)))) :group 'mh-identity) -(defcustom mh-identity-list nil - "*List holding MH-E identity. -Omit the colon and trailing space from the field names. -The keyword name \"none\" is reversed for internal use. -Use the keyname name \"signature\" to specify either a signature file or a -function to call to insert a signature at point. - -Providing an empty Value (\"\") will cause the field to be deleted. - -Example entries using the customize interface: - Keyword name: work - From - Value: John Doe <john@work.com> - Organization - Value: Acme Inc. - Keyword name: home - From - Value: John Doe <johndoe@home.net> - Organization - Value: - -This would produce the equivalent of: - (setq mh-identity-list - '((\"work\" - ((\"From\" . \"John Doe <john@work.com>\") - (\"Organization\" . \"Acme Inc.\"))) - (\"home\" - ((\"From\" . \"John Doe <johndoe@home.net>\") - (\"Organization\" . \"\")))))" - :type '(repeat (list :tag "" - (string :tag "Keyword name") - (repeat :tag "At least one pair from below" - (choice (cons :tag "From field" - (const "From") - (string :tag "Value")) - (cons :tag "Organization field" - (const "Organization") - (string :tag "Value")) - (cons :tag "Signature" - (const "signature") - (choice (file) (function))) - (cons :tag "Other field & value pair" - (string :tag "Field") - (string :tag "Value")))))) - :set 'mh-identity-list-set - :group 'mh-identity) - ;;; Hooks (:group 'mh-hooks + group where hook defined) @@ -1597,6 +1718,23 @@ :group 'mh-hooks :group 'mh-folder) +(defcustom mh-kill-folder-suppress-prompt-hook '(mh-index-p) + "Invoked at the beginning of the \\<mh-folder-mode-map>`\\[mh-kill-folder]' command. +This hook is a list of functions to be called, with no arguments, which should +return a value of non-nil if you should not be asked if you're sure that you +want to remove the folder. This is useful for folders that are easily +regenerated. + +The default value of `mh-index-p' suppresses the prompt on folders generated +by an index search. + +WARNING: Use this hook with care. If there is a bug in your hook which returns +t on +inbox and you hit \\<mh-folder-mode-map>`\\[mh-kill-folder]' by accident +in the +inbox buffer, you will not be happy." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + (defcustom mh-letter-insert-signature-hook nil "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command. Can be used to determine which signature file to use based on message content. @@ -1917,6 +2055,19 @@ "Face for highlighting folders in MH-Index buffers." :group 'mh-index-faces) + + +;;; Faces used when composing messages. + +(defface mh-letter-header-field-face + '((((class color) (background light)) + (:background "gray90")) + (((class color) (background dark)) + (:background "gray10")) + (t (:bold t))) + "Face for displaying header fields in draft buffers." + :group 'mh-letter-faces) + ;;; Local Variables: ;;; indent-tabs-mode: nil ;;; sentence-end-double-space: nil
--- a/lisp/mh-e/mh-e.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-e.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,11 +1,11 @@ ;;; mh-e.el --- GNU Emacs interface to the MH mail system ;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999, -;; 2000, 01, 02, 2003 Free Software Foundation, Inc. +;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 7.3 +;; Version: 7.4.4 ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -82,7 +82,9 @@ ;;; Code: -(require 'cl) +(provide 'mh-e) +(require 'mh-utils) +(mh-require-cl) (defvar recursive-load-depth-limit) (eval-when (compile load eval) @@ -92,17 +94,14 @@ (setq recursive-load-depth-limit 50))) (require 'mh-inc) -(require 'mh-utils) (require 'gnus-util) (require 'easymenu) -(if mh-xemacs-flag - (require 'mh-xemacs-compat)) ;; Shush the byte-compiler (defvar font-lock-auto-fontify) (defvar font-lock-defaults) -(defconst mh-version "7.3" "Version number of MH-E.") +(defconst mh-version "7.4.3" "Version number of MH-E.") ;;; Autoloads (autoload 'Info-goto-node "info") @@ -283,9 +282,7 @@ '(3 mh-folder-scan-format-face)) ;; Current message line (list mh-scan-cur-msg-regexp - '(1 mh-folder-cur-msg-face prepend t)) - ;; Unseen messages in bold - '(mh-folder-font-lock-unseen (1 'bold append t))) + '(1 mh-folder-cur-msg-face prepend t))) "Regexp keywords used to fontify the MH-Folder buffer.") (defvar mh-scan-cmd-note-width 1 @@ -399,50 +396,61 @@ (goto-char (point-min)) (sort (mh-read-msg-list) '<))))))))) -(defvar mh-folder-unseen-seq-cache nil - "Internal cache variable used for font-lock in MH-E. +(defmacro mh-generate-sequence-font-lock (seq prefix face) + "Generate the appropriate code to fontify messages in SEQ. +PREFIX is used to generate unique names for the variables and functions +defined by the macro. So a different prefix should be provided for every +invocation. +FACE is the font-lock face used to display the matching scan lines." + (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix))) + (func (intern (format "mh-folder-font-lock-%s" prefix)))) + `(progn + (defvar ,cache nil + "Internal cache variable used for font-lock in MH-E. Should only be non-nil through font-lock stepping, and nil once font-lock is done highlighting.") -(make-variable-buffer-local 'mh-folder-unseen-seq-cache) + (make-variable-buffer-local ',cache) -(defun mh-folder-font-lock-unseen (limit) - "Return unseen message lines to font-lock between point and LIMIT." - (if (not mh-folder-unseen-seq-cache) - (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list))) - (let ((cur-msg (mh-get-msg-num nil))) - (cond - ((not mh-folder-unseen-seq-cache) - nil) - ((>= (point) limit) ;Presumably at end of buffer - (setq mh-folder-unseen-seq-cache nil) - nil) - ((member cur-msg mh-folder-unseen-seq-cache) - (let ((bpoint (progn (beginning-of-line)(point))) - (epoint (progn (forward-line 1)(point)))) - (if (<= limit (point)) - (setq mh-folder-unseen-seq-cache nil)) - (set-match-data (list bpoint epoint bpoint epoint)) - t)) - (t - ;; move forward one line at a time, checking each message number. - (while (and - (= 0 (forward-line 1)) - (> limit (point)) - (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache)))) - ;; Examine how we must have exited the loop... - (let ((cur-msg (mh-get-msg-num nil))) - (cond - ((or (<= limit (point)) - (not (member cur-msg mh-folder-unseen-seq-cache))) - (setq mh-folder-unseen-seq-cache nil) - nil) - ((member cur-msg mh-folder-unseen-seq-cache) - (let ((bpoint (progn (beginning-of-line)(point))) - (epoint (progn (forward-line 1)(point)))) - (if (<= limit (point)) - (setq mh-folder-unseen-seq-cache nil)) - (set-match-data (list bpoint epoint bpoint epoint)) - t)))))))) + (defun ,func (limit) + "Return unseen message lines to font-lock between point and LIMIT." + (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq)))) + (let ((cur-msg (mh-get-msg-num nil))) + (cond ((not ,cache) + nil) + ((>= (point) limit) ;Presumably at end of buffer + (setq ,cache nil) + nil) + ((member cur-msg ,cache) + (let ((bpoint (progn (beginning-of-line)(point))) + (epoint (progn (forward-line 1)(point)))) + (if (<= limit (point)) (setq ,cache nil)) + (set-match-data (list bpoint epoint bpoint epoint)) + t)) + (t + ;; move forward one line at a time, checking each message + (while (and (= 0 (forward-line 1)) + (> limit (point)) + (not (member (mh-get-msg-num nil) ,cache)))) + ;; Examine how we must have exited the loop... + (let ((cur-msg (mh-get-msg-num nil))) + (cond ((or (<= limit (point)) + (not (member cur-msg ,cache))) + (setq ,cache nil) + nil) + ((member cur-msg ,cache) + (let ((bpoint (progn (beginning-of-line) (point))) + (epoint (progn (forward-line 1) (point)))) + (if (<= limit (point)) (setq ,cache nil)) + (set-match-data + (list bpoint epoint bpoint epoint)) + t)))))))) + + (setq mh-folder-font-lock-keywords + (append mh-folder-font-lock-keywords + (list (list ',func (list 1 '',face 'prepend t)))))))) + +(mh-generate-sequence-font-lock mh-unseen-seq unseen bold) +(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick-face) @@ -464,20 +472,15 @@ (defvar mh-next-direction 'forward) ;Direction to move to next message. -(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or - ;nil if not narrowed. - -(defvar mh-tick-seq-changed-when-narrowed-flag nil) - ;Has tick sequence changed while the - ;folder was narrowed to it? - (defvar mh-view-ops ()) ;Stack of ops that change the folder ;view (such as narrowing or threading). +(defvar mh-folder-view-stack ()) ;Stack of previous folder views. (defvar mh-index-data nil) ;Info about index search results (defvar mh-index-previous-search nil) (defvar mh-index-msg-checksum-map nil) (defvar mh-index-checksum-origin-map nil) +(defvar mh-index-sequence-search-flag nil) (defvar mh-first-msg-num nil) ;Number of first msg in buffer. @@ -485,6 +488,10 @@ (defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. +(defvar mh-sequence-notation-history nil) + ;Rememeber original notation that + ;is overwritten by `mh-note-seq'. + ;;; Macros and generic functions: (defun mh-mapc (function list) @@ -494,7 +501,7 @@ (setq list (cdr list)))) (defun mh-scan-format () - "Return \"-format\" argument for the scan program." + "Return the output format argument for the scan program." (if (equal mh-scan-format-file t) (list "-format" (if mh-nmh-flag (list (mh-update-scan-format @@ -502,7 +509,7 @@ (list (mh-update-scan-format mh-scan-format-mh mh-cmd-note)))) (if (not (equal mh-scan-format-file nil)) - (list "-format" mh-scan-format-file)))) + (list "-form" mh-scan-format-file)))) @@ -536,34 +543,29 @@ ;;; User executable MH-E commands: -(defun mh-delete-msg (msg-or-seq) - "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next. +(defun mh-delete-msg (range) + "Mark the specified RANGE for subsequent deletion and move to the next. Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is marked for deletion. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence." - (interactive (list (mh-interactive-msg-or-seq "Delete"))) - (mh-delete-msg-no-motion msg-or-seq) - (mh-next-msg)) + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Delete"))) + (mh-delete-msg-no-motion range) + (if (looking-at mh-scan-deleted-msg-regexp) (mh-next-msg))) -(defun mh-delete-msg-no-motion (msg-or-seq) - "Mark the specified MSG-OR-SEQ for subsequent deletion. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is marked for deletion. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence." - (interactive (list (mh-interactive-msg-or-seq "Delete"))) - (mh-iterate-on-msg-or-seq () msg-or-seq +(defun mh-delete-msg-no-motion (range) + "Mark the specified RANGE for subsequent deletion. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Delete"))) + (mh-iterate-on-range () range (mh-delete-a-msg nil))) (defun mh-execute-commands () "Process outstanding delete and refile requests." (interactive) - (if mh-narrowed-to-seq (mh-widen)) + (if mh-folder-view-stack (mh-widen t)) (mh-process-commands mh-current-folder) (mh-set-scan-mode) (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency @@ -626,7 +628,7 @@ (save-excursion (goto-char (point-min)) (or (null mh-large-folder) - (not (equal (forward-line mh-large-folder) 0)) + (not (equal (forward-line (1+ mh-large-folder)) 0)) (and (message "Not threading since the number of messages exceeds `mh-large-folder'") nil)))) (mh-toggle-threads)) @@ -673,31 +675,19 @@ Returns nil if the address was not found in either place or if the variable `mh-default-folder-must-exist-flag' is nil and the folder does not exist." ;; Loop for all entries in mh-default-folder-list - (save-excursion - (let ((folder-name - (car - (delq nil - (mapcar - (lambda (list) - (let ((address-regexp (nth 0 list)) - (folder (nth 1 list)) - (to-flag (nth 2 list))) - (when (or - (mh-goto-header-field (if to-flag "To:" "From:")) - ; if the To: field is missing, try Cc: - (and to-flag (mh-goto-header-field "cc:"))) - (let ((endfield (save-excursion - (mh-header-field-end)(point)))) - (if (re-search-forward address-regexp endfield t) - folder - (when to-flag ;Try Cc: as well - (mh-goto-header-field "cc:") - (let ((endfield (save-excursion - (mh-header-field-end)(point)))) - (when (re-search-forward - address-regexp endfield t) - folder)))))))) - mh-default-folder-list))))) + (save-restriction + (goto-char (point-min)) + (re-search-forward "\n\n" nil t) + (narrow-to-region (point-min) (point)) + (let ((to/cc (concat (or (message-fetch-field "to") "") ", " + (or (message-fetch-field "cc") ""))) + (from (or (message-fetch-field "from") "")) + folder-name) + (setq folder-name + (loop for list in mh-default-folder-list + when (string-match (nth 0 list) (if (nth 2 list) to/cc from)) + return (nth 1 list) + finally return nil)) ;; Make sure a result from `mh-default-folder-list' begins with "+" ;; since 'mh-expand-file-name below depends on it @@ -746,27 +736,23 @@ ""))) t)) -(defun mh-refile-msg (msg-or-seq folder - &optional dont-update-last-destination-flag) - "Refile MSG-OR-SEQ into FOLDER. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is marked for refiling. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. +(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag) + "Refile RANGE into FOLDER. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the variables `mh-last-destination' and `mh-last-destination-folder' are not updated." - (interactive (list (mh-interactive-msg-or-seq "Refile") + (interactive (list (mh-interactive-range "Refile") (intern (mh-prompt-for-refile-folder)))) (unless dont-update-last-destination-flag (setq mh-last-destination (cons 'refile folder) mh-last-destination-folder mh-last-destination)) - (mh-iterate-on-msg-or-seq () msg-or-seq + (mh-iterate-on-range () range (mh-refile-a-msg nil folder)) - (mh-next-msg)) + (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg))) (defun mh-refile-or-write-again (message) "Re-execute the last refile or write command on the given MESSAGE. @@ -1015,11 +1001,14 @@ (when (consp part-index) (setq part-index (car part-index))) (mh-folder-mime-action part-index #'mh-mime-save-part nil)) +(defvar mh-thread-scan-line-map-stack) + (defun mh-reset-threads-and-narrowing () "Reset all variables pertaining to threads and narrowing. Also removes all content from the folder buffer." (setq mh-view-ops ()) - (setq mh-narrowed-to-seq nil) + (setq mh-folder-view-stack ()) + (setq mh-thread-scan-line-map-stack ()) (let ((buffer-read-only nil)) (erase-buffer))) (defun mh-rescan-folder (&optional range dont-exec-pending) @@ -1029,7 +1018,8 @@ If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and refiles aren't carried out." (interactive (list (if current-prefix-arg - (mh-read-msg-range mh-current-folder t) + (mh-read-range "Rescan" mh-current-folder t nil t + mh-interpret-number-as-range-flag) nil))) (setq mh-next-direction 'forward) (let ((threaded-flag (memq 'unthread mh-view-ops))) @@ -1073,16 +1063,13 @@ (mh-set-scan-mode) (mh-show))) -(defun mh-undo (msg-or-seq) - "Undo the pending deletion or refile of the specified MSG-OR-SEQ. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is unmarked. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence." - (interactive (list (mh-interactive-msg-or-seq "Undo"))) - (cond ((numberp msg-or-seq) +(defun mh-undo (range) + "Undo the pending deletion or refile of the specified RANGE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Undo"))) + (cond ((numberp range) (let ((original-position (point))) (beginning-of-line) (while (not (or (looking-at mh-scan-deleted-msg-regexp) @@ -1098,7 +1085,7 @@ (mh-maybe-show)) (goto-char original-position) (error "Nothing to undo")))) - (t (mh-iterate-on-msg-or-seq () msg-or-seq + (t (mh-iterate-on-range () range (mh-undo-msg nil)))) (if (not (mh-outstanding-commands-p)) (mh-set-folder-modified-p nil))) @@ -1200,8 +1187,20 @@ (setq folder (substring folder 0 (1- (length folder))))) (values (format "+%s" folder) (car unseen) (car total)))))))) -(defun mh-folder-size (folder) - "Find size of FOLDER." +(defun mh-folder-size-folder (folder) + "Find size of FOLDER using `folder'." + (with-temp-buffer + (let ((u (length (cdr (assoc mh-unseen-seq + (mh-read-folder-sequences folder nil)))))) + (call-process (expand-file-name "folder" mh-progs) nil t nil + "-norecurse" folder) + (goto-char (point-min)) + (if (re-search-forward " has \\([0-9]+\\) " nil t) + (values (car (read-from-string (match-string 1))) u folder) + (values 0 u folder))))) + +(defun mh-folder-size-flist (folder) + "Find size of FOLDER using `flist'." (with-temp-buffer (call-process (expand-file-name "flist" mh-progs) nil t nil "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) @@ -1211,6 +1210,12 @@ (buffer-substring (point) (line-end-position))) (values total unseen folder)))) +(defun mh-folder-size (folder) + "Find size of FOLDER." + (if mh-flists-present-flag + (mh-folder-size-flist folder) + (mh-folder-size-folder folder))) + (defun mh-visit-folder (folder &optional range index-data) "Visit FOLDER and display RANGE of messages. Do not call this function from outside MH-E; see \\[mh-rmail] instead. @@ -1225,7 +1230,9 @@ regardless of the size of the `mh-large-folder' variable." (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t))) (list folder-name - (mh-read-msg-range folder-name current-prefix-arg)))) + (mh-read-range "Scan" folder-name t nil + current-prefix-arg + mh-interpret-number-as-range-flag)))) (let ((config (current-window-configuration)) (current-buffer (current-buffer)) (threaded-view-flag mh-show-threads-flag)) @@ -1238,13 +1245,14 @@ (setq mh-index-data (car index-data) mh-index-msg-checksum-map (make-hash-table :test #'equal) mh-index-checksum-origin-map (make-hash-table :test #'equal)) - (mh-index-update-maps folder (cadr index-data))) + (mh-index-update-maps folder (cadr index-data)) + (mh-index-create-sequences)) (mh-scan-folder folder (or range "all")) (cond ((and threaded-view-flag (save-excursion (goto-char (point-min)) (or (null mh-large-folder) - (not (equal (forward-line mh-large-folder) 0)) + (not (equal (forward-line (1+ mh-large-folder)) 0)) (and (message "Not threading since the number of messages exceeds `mh-large-folder'") nil)))) (mh-toggle-threads)) @@ -1405,6 +1413,9 @@ ;;; The folder data abstraction. +(defvar mh-index-data-file ".mhe_index" + "MH-E specific file where index seach info is stored.") + (defun mh-make-folder (name) "Create a new mail folder called NAME. Make it the current folder." @@ -1417,6 +1428,9 @@ (mh-folder-mode) (mh-set-folder-modified-p nil) (setq buffer-file-name mh-folder-filename) + (when (and (not mh-index-data) + (file-exists-p (concat buffer-file-name mh-index-data-file))) + (mh-index-read-data)) (mh-make-folder-mode-line)) ;;; Ensure new buffers won't get this mode if default-major-mode is nil. @@ -1437,7 +1451,7 @@ ["List Sequences in Folder..." mh-list-sequences t] ["Delete Sequence..." mh-delete-seq t] ["Narrow to Sequence..." mh-narrow-to-seq t] - ["Widen from Sequence" mh-widen mh-narrowed-to-seq] + ["Widen from Sequence" mh-widen mh-folder-view-stack] "--" ["Narrow to Subject Sequence" mh-narrow-to-subject t] ["Narrow to Tick Sequence" mh-narrow-to-tick @@ -1512,9 +1526,6 @@ (set-specifier horizontal-scrollbar-visible-p nil (cons (current-buffer) nil))))) -;; Avoid compiler warnings in XEmacs and GNU Emacs 20 -(eval-when-compile (defvar tool-bar-mode)) - (defmacro mh-write-file-functions-compat () "Return `write-file-functions' if it exists. Otherwise return `local-write-file-hooks'. This macro exists purely for @@ -1524,8 +1535,11 @@ ''write-file-functions ;Emacs 21.4 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs -;; Avoid compiler warning -(defvar tool-bar-map) +;; Avoid compiler warnings in non-bleeding edge versions of Emacs. +(eval-when-compile + (defvar tool-bar-mode) + (defvar tool-bar-map) + (defvar desktop-save-buffer)) ;Emacs 21.4 (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> @@ -1564,22 +1578,25 @@ 'mh-seq-list nil ; Alist of (seq . msgs) nums 'mh-seen-list nil ; List of displayed messages 'mh-next-direction 'forward ; Direction to move to next message - 'mh-narrowed-to-seq nil ; Sequence display is narrowed to - 'mh-tick-seq-changed-when-narrowed-flag nil - ; Tick seq changed while narrowed 'mh-view-ops () ; Stack that keeps track of the order ; in which narrowing/threading has been ; carried out. + 'mh-folder-view-stack () ; Stack of previous views of the + ; folder. 'mh-index-data nil ; If the folder was created by a call ; to mh-index-search this contains info ; about the search results. 'mh-index-previous-search nil ; Previous folder and search-regexp 'mh-index-msg-checksum-map nil ; msg -> checksum map 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) + 'mh-index-sequence-search-flag nil ; folder resulted from sequence search 'mh-first-msg-num nil ; Number of first msg in buffer 'mh-last-msg-num nil ; Number of last msg in buffer 'mh-msg-count nil ; Number of msgs in buffer 'mh-mode-line-annotation nil ; Indicates message range + 'mh-sequence-notation-history (make-hash-table) + ; Remember what is overwritten by + ; mh-note-seq. 'mh-previous-window-config nil) ; Previous window configuration (mh-remove-xemacs-horizontal-scrollbar) (setq truncate-lines t) @@ -1597,8 +1614,7 @@ (easy-menu-add mh-folder-sequence-menu) (easy-menu-add mh-folder-message-menu) (easy-menu-add mh-folder-folder-menu) - (if (and (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) + (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map) (mh-funcall-if-exists mh-toolbar-init :folder) (if (and mh-xemacs-flag font-lock-auto-fontify) @@ -1611,6 +1627,15 @@ (set (make-local-variable (car pairs)) (car (cdr pairs))) (setq pairs (cdr (cdr pairs))))) +;;;###autoload +(defun mh-restore-desktop-buffer (desktop-buffer-file-name + desktop-buffer-name + desktop-buffer-misc) + "Restore an MH folder buffer specified in a desktop file." + (mh-find-path) + (mh-visit-folder desktop-buffer-name) + (current-buffer)) + (defun mh-scan-folder (folder range &optional dont-exec-pending) "Scan the FOLDER over the RANGE. If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and @@ -1651,6 +1676,7 @@ (range (if (and range (atom range)) (list range) range)) scan-start) (message "Scanning %s..." folder) + (mh-remove-all-notation) (with-mh-folder-updating (nil) (if update (goto-char (point-max)) @@ -1742,8 +1768,8 @@ (message "inc %s..." folder)) (setq mh-next-direction 'forward) (goto-char (point-max)) + (mh-remove-all-notation) (let ((start-of-inc (point))) - (mh-remove-cur-notation) (if maildrop-name ;; I think MH 5 used "-ms-file" instead of "-file", ;; which would make inc'ing from maildrops fail. @@ -1763,11 +1789,12 @@ (re-search-forward "^inc: no mail" nil t)) (message "No new mail%s%s" (if maildrop-name " in " "") (if maildrop-name maildrop-name ""))) - ((and (when mh-narrowed-to-seq + ((and (when mh-folder-view-stack (let ((saved-text (buffer-substring-no-properties start-of-inc (point-max)))) (delete-region start-of-inc (point-max)) - (unwind-protect (mh-widen) + (unwind-protect (mh-widen t) + (mh-remove-all-notation) (goto-char (point-max)) (setq start-of-inc (point)) (insert saved-text) @@ -1789,7 +1816,6 @@ (setq mh-seq-list (mh-read-folder-sequences folder t)) (when (equal (point-max) start-of-inc) (mh-notate-cur)) - (mh-notate-user-sequences) (if new-mail-flag (progn (mh-make-folder-mode-line) @@ -1798,7 +1824,9 @@ (when (memq 'unthread mh-view-ops) (mh-thread-inc folder start-of-inc)) (mh-goto-cur-msg)) - (goto-char point-before-inc)))))) + (goto-char point-before-inc)) + (mh-notate-user-sequences) + (mh-notate-deleted-and-refiled))))) (defun mh-make-folder-mode-line (&optional ignored) "Set the fields of the mode line for a folder buffer. @@ -1841,10 +1869,13 @@ ("")))))) (mh-logo-display)))) +;;; XXX: Remove this function, if no one uses it any more... (defun mh-unmark-all-headers (remove-all-flags) "Remove all '+' flags from the folder listing. With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too. -Optimized for speed (i.e., no regular expressions)." +Optimized for speed (i.e., no regular expressions). + +This function is deprecated. Use `mh-remove-all-notation' instead." (save-excursion (let ((case-fold-search nil) (last-line (1- (point-max))) @@ -1869,6 +1900,39 @@ (insert " "))))) (forward-line))))) +(defun mh-add-sequence-notation (msg internal-seq-flag) + "Add sequence notation to the MSG on the current line. +If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the +current line, so that font-lock would automatically refontify it." + (with-mh-folder-updating (t) + (save-excursion + (beginning-of-line) + (if internal-seq-flag + (mh-notate nil nil mh-cmd-note) + (forward-char (1+ mh-cmd-note)) + (let ((stack (gethash msg mh-sequence-notation-history))) + (setf (gethash msg mh-sequence-notation-history) + (cons (char-after) stack))) + (mh-notate nil mh-note-seq (1+ mh-cmd-note)))))) + +(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all) + "Remove sequence notation from the MSG on the current line. +If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to highlight the +sequence. In that case, no notation needs to be removed. Otherwise the effect +of inserting `mh-note-seq' needs to be reversed. +If ALL is non-nil, then all sequence marks on the scan line are removed." + (with-mh-folder-updating (t) + ;; This takes care of internal sequences... + (mh-notate nil nil mh-cmd-note) + (unless internal-seq-flag + ;; ... and this takes care of user sequences. + (let ((stack (gethash msg mh-sequence-notation-history))) + (while (and all (cdr stack)) + (setq stack (cdr stack))) + (when stack + (mh-notate nil (car stack) (1+ mh-cmd-note))) + (setf (gethash msg mh-sequence-notation-history) (cdr stack)))))) + (defun mh-remove-cur-notation () "Remove old cur notation." (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) @@ -1884,12 +1948,10 @@ (save-excursion (setq overlay-arrow-position nil) (goto-char (point-min)) - (while (not (eobp)) - (unless (or (equal (char-after) ?+) (eolp)) - (mh-notate nil ? mh-cmd-note) - (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0)) - (mh-notate nil ? (1+ mh-cmd-note)))) - (forward-line)))) + (mh-iterate-on-range msg (cons (point-min) (point-max)) + (mh-notate nil ? mh-cmd-note) + (mh-remove-sequence-notation msg nil t)) + (clrhash mh-sequence-notation-history))) ;;;###mh-autoload (defun mh-goto-cur-msg (&optional minimal-changes-flag) @@ -1934,22 +1996,47 @@ ;; Update the unseen sequence if it exists (mh-update-unseen) - (let ((redraw-needed-flag mh-index-data)) + (let ((redraw-needed-flag mh-index-data) + (folders-changed (list mh-current-folder)) + (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag + (mh-create-sequence-map mh-seq-list))) + (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag + (make-hash-table)))) ;; Remove invalid scan lines if we are in an index folder and then remove ;; the real messages (when mh-index-data (mh-index-delete-folder-headers) - (mh-index-execute-commands)) + (setq folders-changed + (append folders-changed (mh-index-execute-commands)))) ;; Then refile messages (mh-mapc #'(lambda (folder-msg-list) - (let ((dest-folder (symbol-name (car folder-msg-list))) - (msgs (cdr folder-msg-list))) + (let* ((dest-folder (symbol-name (car folder-msg-list))) + (last (car (mh-translate-range dest-folder "last"))) + (msgs (cdr folder-msg-list))) + (push dest-folder folders-changed) (setq redraw-needed-flag t) (apply #'mh-exec-cmd "refile" "-src" folder dest-folder (mh-coalesce-msg-list msgs)) - (mh-delete-scan-msgs msgs))) + (mh-delete-scan-msgs msgs) + ;; Preserve sequences in destination folder... + (when (and mh-refile-preserves-sequences-flag + (numberp last)) + (clrhash dest-map) + (loop for i from (1+ last) + for msg in (sort (copy-sequence msgs) #'<) + do (loop for seq-name in (gethash msg seq-map) + do (push i (gethash seq-name dest-map)))) + (maphash + #'(lambda (seq msgs) + ;; Run it in the background, since we don't care + ;; about the results. + (apply #'mh-exec-cmd-daemon "mark" #'ignore + "-sequence" (symbol-name seq) dest-folder + "-add" (mapcar #'(lambda (x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) + dest-map)))) mh-refile-list) (setq mh-refile-list ()) @@ -1969,7 +2056,7 @@ ;; Redraw folder buffer if needed (when (and redraw-needed-flag) (when (mh-speed-flists-active-p) - (mh-speed-flists t mh-current-folder)) + (apply #'mh-speed-flists t folders-changed)) (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max))) (mh-index-data (mh-index-insert-folder-headers))))) @@ -1980,7 +2067,7 @@ (mh-invalidate-show-buffer)) (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) - (mh-unmark-all-headers t) + (mh-remove-all-notation) (mh-notate-user-sequences) (message "Processing deletes and refiles for %s...done" folder))) @@ -2115,55 +2202,67 @@ (setq msgs (cons num msgs))))) msgs)) -(defun mh-notate-user-sequences (&optional msg-or-seq) - "Mark user-defined sequences in the messages specified by MSG-OR-SEQ. -The optional argument MSG-OR-SEQ can be a message number, a list of message -numbers, a sequence, a region in a cons cell, or nil in which case all -messages in the folder buffer are notated." - (unless msg-or-seq - (setq msg-or-seq (cons (point-min) (point-max)))) +(defun mh-notate-user-sequences (&optional range) + "Mark user-defined sequences in the messages specified by RANGE. +The optional argument RANGE can be a message number, a list of message +numbers, a sequence, a region in a cons cell. If nil all messages are notated." + (unless range + (setq range (cons (point-min) (point-max)))) (let ((seqs mh-seq-list) - (msg-hash (make-hash-table)) - (tick-msgs (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))) + (msg-hash (make-hash-table))) (dolist (seq seqs) - (unless (mh-internal-seq (mh-seq-name seq)) - (dolist (msg (mh-seq-msgs seq)) - (setf (gethash msg msg-hash) t)))) - (mh-iterate-on-msg-or-seq msg msg-or-seq - (when (gethash msg msg-hash) - (mh-notate nil mh-note-seq (1+ mh-cmd-note))) - (mh-notate-tick msg tick-msgs)))) + (dolist (msg (mh-seq-msgs seq)) + (push (car seq) (gethash msg msg-hash)))) + (mh-iterate-on-range msg range + (loop for seq in (gethash msg msg-hash) + do (mh-add-sequence-notation msg (mh-internal-seq seq)))))) + +(defvar mh-internal-seqs '(answered cur deleted forwarded printed)) (defun mh-internal-seq (name) "Return non-nil if NAME is the name of an internal MH-E sequence." - (or (memq name '(answered cur deleted forwarded printed)) + (or (memq name mh-internal-seqs) (eq name mh-unseen-seq) (and mh-tick-seq (eq name mh-tick-seq)) (eq name mh-previous-seq) (mh-folder-name-p name))) -(defun mh-delete-msg-from-seq (msg-or-seq sequence &optional internal-flag) - "Delete MSG-OR-SEQ from SEQUENCE. -Default value of MSG-OR-SEQ is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is deleted from SEQUENCE.. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence; optional third arg INTERNAL-FLAG non-nil -means do not inform MH of the change." - (interactive (list (mh-interactive-msg-or-seq "Delete") +(defun mh-valid-seq-p (name) + "Return non-nil if NAME is a valid MH sequence name." + (and (symbolp name) + (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name)))) + +(defun mh-delete-msg-from-seq (range sequence &optional internal-flag) + "Delete RANGE from SEQUENCE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. + +Optional third arg INTERNAL-FLAG non-nil means do not inform MH of the +change." + (interactive (list (mh-interactive-range "Delete") (mh-read-seq-default "Delete from" t) nil)) - (let ((entry (mh-find-seq sequence))) + (let ((entry (mh-find-seq sequence)) + (user-sequence-flag (not (mh-internal-seq sequence))) + (folders-changed (list mh-current-folder)) + (msg-list ())) (when entry - (mh-iterate-on-msg-or-seq msg msg-or-seq - (when (memq msg (mh-seq-msgs entry)) - (mh-notate nil ? (1+ mh-cmd-note))) - (mh-delete-a-msg-from-seq msg sequence internal-flag) - (mh-clear-text-properties nil)) - (mh-notate-user-sequences msg-or-seq) + (mh-iterate-on-range msg range + (push msg msg-list) + ;; Calling "mark" repeatedly takes too long. So we will pretend here + ;; that we are just modifying an internal sequence... + (when (memq msg (cdr entry)) + (mh-remove-sequence-notation msg (not user-sequence-flag))) + (mh-delete-a-msg-from-seq msg sequence t)) + ;; ... and here we will "mark" all the messages at one go. + (unless internal-flag (mh-undefine-sequence sequence msg-list)) + (when (and mh-index-data (not internal-flag)) + (setq folders-changed + (append folders-changed + (mh-index-delete-from-sequence sequence msg-list)))) (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) - (mh-speed-flists t mh-current-folder))))) + (apply #'mh-speed-flists t folders-changed))))) (defun mh-delete-a-msg-from-seq (msg sequence internal-flag) "Delete MSG from SEQUENCE. @@ -2174,31 +2273,18 @@ (mh-undefine-sequence sequence (list msg))) (setcdr entry (delq msg (mh-seq-msgs entry)))))) -(defun mh-clear-text-properties (message) - "Clear all text properties (except mh-tick) from the scan line for MESSAGE." - (save-excursion - (with-mh-folder-updating (t) - (when (or (not message) (mh-goto-msg message t t)) - (beginning-of-line) - (let ((tick-property (get-text-property (point) 'mh-tick))) - (set-text-properties (point) (line-end-position) nil) - (when tick-property - (add-text-properties (point) (line-end-position) - `(mh-tick ,tick-property)))))))) - (defun mh-undefine-sequence (seq msgs) "Remove from the SEQ the list of MSGS." - (prog1 (mh-exec-cmd "mark" mh-current-folder "-delete" - "-sequence" (symbol-name seq) - (mh-coalesce-msg-list msgs)) - (when (and (eq seq mh-unseen-seq) (mh-speed-flists-active-p)) - (mh-speed-flists t mh-current-folder)))) + (when (and (mh-valid-seq-p seq) msgs) + (apply #'mh-exec-cmd "mark" mh-current-folder "-delete" + "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs)))) (defun mh-define-sequence (seq msgs) "Define the SEQ to contain the list of MSGS. Do not mark pseudo-sequences or empty sequences. Signals an error if SEQ is an illegal name." (if (and msgs + (mh-valid-seq-p seq) (not (mh-folder-name-p seq))) (save-excursion (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" @@ -2237,31 +2323,6 @@ -;;; User prompting commands. - -(defun mh-read-msg-range (folder &optional always-prompt-flag) - "Prompt for message range from FOLDER. -If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for -range." - (multiple-value-bind (total unseen) (mh-folder-size folder) - (cond - ((and (not always-prompt-flag) (numberp unseen) (> unseen 0)) - (list (symbol-name mh-unseen-seq))) - ((or (null mh-large-folder) (not (numberp total))) - (list "all")) - ((and (numberp total) (or always-prompt-flag (> total mh-large-folder))) - (let* ((prompt - (format "Range or number of messages to read (default: %s): " - total)) - (in (read-string prompt nil nil (number-to-string total)))) - (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in) - (list (format "last:%s" (car (read-from-string in))))) - ((equal in "") (list "all")) - (t (split-string in))))) - (t (list "all"))))) - - - ;;; Build the folder-mode keymap: (suppress-keymap mh-folder-mode-map) @@ -2319,6 +2380,7 @@ (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) "?" mh-prefix-help + "'" mh-index-ticked-messages "S" mh-sort-folder "f" mh-alt-visit-folder "i" mh-index-search @@ -2327,6 +2389,7 @@ "n" mh-index-new-messages "o" mh-alt-visit-folder "p" mh-pack-folder + "q" mh-index-sequenced-messages "r" mh-rescan-folder "s" mh-search-folder "u" mh-undo-folder @@ -2340,6 +2403,7 @@ "w" mh-junk-whitelist) (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) + "'" mh-narrow-to-tick "?" mh-prefix-help "d" mh-delete-msg-from-seq "k" mh-delete-seq @@ -2361,7 +2425,11 @@ (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) "'" mh-narrow-to-tick "?" mh-prefix-help + "c" mh-narrow-to-cc + "f" mh-narrow-to-from + "r" mh-narrow-to-range "s" mh-narrow-to-subject + "t" mh-narrow-to-to "w" mh-widen) (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) @@ -2411,16 +2479,16 @@ "[d]elete, [o]refile, e[x]ecute,\n" "[s]end, [r]eply.\n" "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys," - "\n [T]hread, / Limit, e[X]tract, [D]igest, [I]nc spools.") + "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.") - (?F "[l]ist, [v]isit folder;\n" - "[t]hread; [s]earch; [i]ndexed search;\n" + (?F "[l]ist; [v]isit folder;\n" + "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n" "[p]ack; [S]ort; [r]escan; [k]ill") - (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n" + (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n" "[s]equences, [l]ist,\n" "[d]elete message from sequence, [k]ill sequence") (?T "[t]oggle, [d]elete, [o]refile thread") - (?/ "Limit to [s]ubject; [w]iden") + (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden") (?X "un[s]har, [u]udecode message") (?D "[b]urst digest") (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" @@ -2443,17 +2511,6 @@ "^There is no other window$")) (add-to-list 'debug-ignored-errors mess)) -;;;; Desktop support - -;;;###autoload -(defun mh-restore-desktop-buffer (desktop-buffer-file-name - desktop-buffer-name - desktop-buffer-misc) - "Restore an mh folder buffer specified in a desktop file." - (mh-find-path) - (mh-visit-folder desktop-buffer-name) - (current-buffer)) - (provide 'mh-e) ;;; Local Variables:
--- a/lisp/mh-e/mh-funcs.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-funcs.el Tue Jul 13 03:06:25 2004 +0000 @@ -72,18 +72,15 @@ (message "Bursting digest...done"))) ;;;###mh-autoload -(defun mh-copy-msg (msg-or-seq folder) - "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is copied. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence." - (interactive (list (mh-interactive-msg-or-seq "Copy") +(defun mh-copy-msg (range folder) + "Copy the specified RANGE to another FOLDER without deleting them. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Copy") (mh-prompt-for-folder "Copy to" "" t))) (let ((msg-list (let ((result ())) - (mh-iterate-on-msg-or-seq msg msg-or-seq + (mh-iterate-on-range msg range (mh-notate nil mh-note-copied mh-cmd-note) (push msg result)) result))) @@ -94,9 +91,13 @@ (defun mh-kill-folder () "Remove the current folder and all included messages. Removes all of the messages (files) within the specified current folder, -and then removes the folder (directory) itself." +and then removes the folder (directory) itself. +The value of `mh-kill-folder-suppress-prompt-hook' is a list of functions to +be called, with no arguments, which should return a value of non-nil if +verification is not desired." (interactive) - (if (or mh-index-data + (if (or (run-hook-with-args-until-success + 'mh-kill-folder-suppress-prompt-hook) (yes-or-no-p (format "Remove folder %s (and all included messages)? " mh-current-folder))) (let ((folder mh-current-folder) @@ -154,7 +155,8 @@ optional prefix argument provided, prompt for the RANGE of messages to display after packing. Otherwise, show the entire folder." (interactive (list (if current-prefix-arg - (mh-read-msg-range mh-current-folder t) + (mh-read-range "Scan" mh-current-folder t nil t + mh-interpret-number-as-range-flag) '("all")))) (let ((threaded-flag (memq 'unthread mh-view-ops))) (mh-pack-folder-1 range) @@ -231,22 +233,19 @@ (mh-recenter 0))) ;;;###mh-autoload -(defun mh-print-msg (msg-or-seq) - "Print MSG-OR-SEQ on printer. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is printed. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. +(defun mh-print-msg (range) + "Print RANGE on printer. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. The variable `mh-lpr-command-format' is used to generate the print command. The messages are formatted by mhl. See the variable `mhl-formfile'." - (interactive (list (mh-interactive-msg-or-seq "Print"))) + (interactive (list (mh-interactive-range "Print"))) (message "Printing...") (let (msgs) ;; Gather message numbers and add them to "printed" sequence. - (mh-iterate-on-msg-or-seq msg msg-or-seq + (mh-iterate-on-range msg range (mh-add-msgs-to-seq msg 'printed t) (mh-notate nil mh-note-printed mh-cmd-note) (push msg msgs)) @@ -258,12 +257,12 @@ (mh-coalesce-msg-list msgs)) " ")) (lpr-command (format mh-lpr-command-format - (cond ((listp msg-or-seq) + (cond ((listp range) (format "Folder: %s, Messages: %s" mh-current-folder msgs-string)) - ((symbolp msg-or-seq) + ((symbolp range) (format "Folder: %s, Sequence: %s" - mh-current-folder msg-or-seq))))) + mh-current-folder range))))) (scan-command (format "scan %s | %s" msgs-string lpr-command))) (if mh-print-background-flag @@ -319,7 +318,7 @@ mh-seq-list nil mh-next-direction 'forward) (with-mh-folder-updating (nil) - (mh-unmark-all-headers t))) + (mh-remove-all-notation))) (t (message "Commands not undone.") ;; Remove by 2003-06-30 if nothing seems amiss. XXX
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mh-e/mh-gnus.el Tue Jul 13 03:06:25 2004 +0000 @@ -0,0 +1,142 @@ +;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus. + +;; Copyright (C) 2003 Free Software Foundation, Inc. + +;; Author: Satyaki Das <satyaki@theforce.stanford.edu> +;; Maintainer: Bill Wohler <wohler@newt.com> +;; Keywords: mail +;; See: mh-e.el + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Change Log: + +;;; Code: + +(load "mm-decode" t t) ; Non-fatal dependency +(load "mm-uu" t t) ; Non-fatal dependency +(load "mailcap" t t) ; Non-fatal dependency +(load "smiley" t t) ; Non-fatal dependency + +(defmacro mh-defun-compat (function arg-list &rest body) + "This is a macro to define functions which are not defined. +It is used for Gnus utility functions which were added recently. If FUNCTION +is not defined then it is defined to have argument list, ARG-LIST and body, +BODY." + (let ((defined-p (fboundp function))) + (unless defined-p + `(defun ,function ,arg-list ,@body)))) +(put 'mh-defun-compat 'lisp-indent-function 'defun) + +(defmacro mh-defmacro-compat (function arg-list &rest body) + "This is a macro to define functions which are not defined. +It is used for Gnus utility functions which were added recently. If FUNCTION +is not defined then it is defined to have argument list, ARG-LIST and body, +BODY." + (let ((defined-p (fboundp function))) + (unless defined-p + `(defmacro ,function ,arg-list ,@body)))) +(put 'mh-defmacro-compat 'lisp-indent-function 'defun) + +;; Copy of original function from gnus-util.el +(mh-defun-compat gnus-local-map-property (map) + "Return a list suitable for a text property list specifying keymap MAP." + (cond (mh-xemacs-flag (list 'keymap map)) + ((>= emacs-major-version 21) (list 'keymap map)) + (t (list 'local-map map)))) + +;; Copy of original function from mm-decode.el +(mh-defun-compat mm-merge-handles (handles1 handles2) + (append (if (listp (car handles1)) handles1 (list handles1)) + (if (listp (car handles2)) handles2 (list handles2)))) + +;; Copy of function from mm-decode.el +(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value) + ;; HANDLE could be a CTL. + (if handle + (put-text-property 0 (length (car handle)) parameter value + (car handle)))) + +;; Copy of original macro is in mm-decode.el +(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter) + `(get-text-property 0 ,parameter (car ,handle))) + +(mh-do-in-xemacs (defvar default-enable-multibyte-characters)) + +;; Copy of original function in mm-decode.el +(mh-defun-compat mm-readable-p (handle) + "Say whether the content of HANDLE is readable." + (and (< (with-current-buffer (mm-handle-buffer handle) + (buffer-size)) 10000) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (and (eq (mm-body-7-or-8) '7bit) + (not (mm-long-lines-p 76)))))) + +;; Copy of original function in mm-bodies.el +(mh-defun-compat mm-long-lines-p (length) + "Say whether any of the lines in the buffer is longer than LENGTH." + (save-excursion + (goto-char (point-min)) + (end-of-line) + (while (and (not (eobp)) + (not (> (current-column) length))) + (forward-line 1) + (end-of-line)) + (and (> (current-column) length) + (current-column)))) + +(mh-defun-compat mm-keep-viewer-alive-p (handle) + ;; Released Gnus doesn't keep handles associated with externally displayed + ;; MIME parts. So this will always return nil. + nil) + +(mh-defun-compat mm-destroy-parts (list) + "Older emacs don't have this function." + nil) + +;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is +;;; buggy (the args to read-file-name are incorrect). When all supported +;;; versions of Emacs come with at least Gnus 5.10, we can delete this +;;; function and rename calls to mh-mm-save-part to mm-save-part. +(defun mh-mm-save-part (handle) + "Write HANDLE to a file." + (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) + (filename (mail-content-type-get + (mm-handle-disposition handle) 'filename)) + file) + (when filename + (setq filename (file-name-nondirectory filename))) + (setq file (read-file-name "Save MIME part to: " + (or mm-default-directory + default-directory) + nil nil (or filename name ""))) + (setq mm-default-directory (file-name-directory file)) + (and (or (not (file-exists-p file)) + (yes-or-no-p (format "File %s already exists; overwrite? " + file))) + (mm-save-part-to-file handle file)))) + +(provide 'mh-gnus) +;;; Local Variables: +;;; no-byte-compile: t +;;; no-update-autoloads: t +;;; End: +;;; mh-gnus.el ends here
--- a/lisp/mh-e/mh-identity.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-identity.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,6 +1,6 @@ ;;; mh-identity.el --- Multiple identify support for MH-E. -;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Peter S. Galbraith <psg@debian.org> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -40,7 +40,8 @@ ;;; Code: -(require 'cl) +(require 'mh-utils) +(mh-require-cl) (eval-when (compile load eval) (defvar mh-comp-loaded nil) @@ -63,6 +64,8 @@ ;; ["home" (mh-insert-identity "home") ;; :style radio :active (not (equal mh-identity-local "home")) ;; :selected (equal mh-identity-local "home")] + '(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list] + "--") (mapcar (function (lambda (arg) `[,arg (mh-insert-identity ,arg) :style radio
--- a/lisp/mh-e/mh-index.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-index.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,6 +1,6 @@ ;;; mh-index -- MH-E interface to indexing programs -;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -43,7 +43,8 @@ ;;; Code: -(require 'cl) +(require 'mh-utils) +(mh-require-cl) (require 'mh-e) (require 'mh-mime) (require 'mh-pick) @@ -259,10 +260,60 @@ (save-excursion (set-buffer folder) (mh-index-update-single-msg msg checksum origin-map))) - (forward-line)))))) + (forward-line))))) + (mh-index-write-data)) + +(defvar mh-unpropagated-sequences '(cur range subject search) + "List of sequences that aren't preserved.") + +(defun mh-unpropagated-sequences () + "Return a list of sequences that aren't propagated to the source folders. +It is just the sequences in the variable `mh-unpropagated-sequences' in +addition to the Previous-Sequence (see mh-profile 5)." + (if mh-previous-seq + (cons mh-previous-seq mh-unpropagated-sequences) + mh-unpropagated-sequences)) + +;;;###mh-autoload +(defun mh-create-sequence-map (seq-list) + "Return a map from msg number to list of sequences in which it is present. +SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the +list of messages in that sequence." + (loop with map = (make-hash-table) + for seq in seq-list + when (and (not (memq (car seq) (mh-unpropagated-sequences))) + (mh-valid-seq-p (car seq))) + do (loop for msg in (cdr seq) + do (push (car seq) (gethash msg map))) + finally return map)) -(defvar mh-flists-results-folder "new" +;;;###mh-autoload +(defun mh-index-create-sequences () + "Mirror sequences present in source folders in index folder." + (let ((seq-hash (make-hash-table :test #'equal)) + (seq-list ())) + (loop for folder being the hash-keys of mh-index-data + do (setf (gethash folder seq-hash) + (mh-create-sequence-map + (mh-read-folder-sequences folder nil)))) + (dolist (msg (mh-translate-range mh-current-folder "all")) + (let* ((checksum (gethash msg mh-index-msg-checksum-map)) + (pair (gethash checksum mh-index-checksum-origin-map)) + (ofolder (car pair)) + (omsg (cdr pair))) + (loop for seq in (gethash omsg (gethash ofolder seq-hash)) + do (if (assoc seq seq-list) + (push msg (cdr (assoc seq seq-list))) + (push (list seq msg) seq-list))))) + (loop for seq in seq-list + do (apply #'mh-exec-cmd "mark" mh-current-folder + "-sequence" (symbol-name (car seq)) "-add" + (mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) + +(defvar mh-flists-results-folder "sequence" "Subfolder for `mh-index-folder' where flists output is placed.") +(defvar mh-flists-sequence) +(defvar mh-flists-called-flag nil) (defun mh-index-generate-pretty-name (string) "Given STRING generate a name which is suitable for use as a folder name. @@ -293,13 +344,14 @@ (subst-char-in-region (point-min) (point-max) ?\r ?_ t) (subst-char-in-region (point-min) (point-max) ?/ ?$ t) (let ((out (truncate-string-to-width (buffer-string) 20))) - (cond ((eq mh-indexer 'flists) mh-flists-results-folder) + (cond ((eq mh-indexer 'flists) + (format "%s/%s" mh-flists-results-folder mh-flists-sequence)) ((equal out mh-flists-results-folder) (concat out "1")) (t out))))) ;;;###mh-autoload (defun* mh-index-search (redo-search-flag folder search-regexp - &optional window-config unseen-flag) + &optional window-config) "Perform an indexed search in an MH mail folder. Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. @@ -308,8 +360,7 @@ SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is \"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG stores the window configuration that will be restored after the user quits the -folder containing the index search results. If optional argument UNSEEN-FLAG -is non-nil, then all the messages are marked as unseen. +folder containing the index search results. Four indexing programs are supported; if none of these are present, then grep is used. This function picks the first program that is available on your @@ -344,7 +395,8 @@ (list current-prefix-arg (progn (unless mh-find-path-run (mh-find-path)) - (or (and current-prefix-arg (car mh-index-previous-search)) + (or (and current-prefix-arg mh-index-sequence-search-flag) + (and current-prefix-arg (car mh-index-previous-search)) (mh-prompt-for-folder "Search" "+" nil "all" t))) (progn ;; Yes, we do want to call mh-index-choose every time in case the @@ -360,6 +412,13 @@ mh-index-regexp-builder) (current-window-configuration) nil))) + ;; Redoing a sequence search? + (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag + (not mh-flists-called-flag)) + (let ((mh-flists-called-flag t)) + (apply #'mh-index-sequenced-messages mh-index-previous-search)) + (return-from mh-index-search)) + ;; We have fancy query parsing (when (symbolp search-regexp) (mh-search-folder folder window-config) (setq mh-searching-function 'mh-index-do-search) @@ -401,23 +460,23 @@ ;; Copy the search results over (maphash #'(lambda (folder msgs) - (let ((msgs (sort (loop for msg being the hash-keys of msgs + (let ((cur (car (mh-translate-range folder "cur"))) + (msgs (sort (loop for msg being the hash-keys of msgs collect msg) #'<))) (mh-exec-cmd "refile" msgs "-src" folder "-link" index-folder) + ;; Restore cur to old value, that refile changed + (when cur + (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" + "-sequence" "cur" (format "%s" cur))) (loop for msg in msgs do (incf result-count) (setf (gethash result-count origin-map) (cons folder msg))))) folder-results-map) - ;; Mark messages as unseen (if needed) - (when (and unseen-flag (> result-count 0)) - (mh-exec-cmd "mark" index-folder "all" - "-sequence" (symbol-name mh-unseen-seq) "-add")) - - ;; Generate scan lines for the hits. + ;; Vist the results folder (mh-visit-folder index-folder () (list folder-results-map origin-map)) (goto-char (point-min)) @@ -425,11 +484,18 @@ (mh-update-sequences) (mh-recenter nil) + ;; Update the speedbar, if needed + (when (mh-speed-flists-active-p) + (mh-speed-flists t mh-current-folder)) + ;; Maintain history (when (or (and redo-search-flag previous-search) window-config) (setq mh-previous-window-config old-window-config)) (setq mh-index-previous-search (list folder search-regexp)) + ;; Write out data to disk + (unless mh-flists-called-flag (mh-index-write-data)) + (message "%s found %s matches in %s folders" (upcase-initials (symbol-name mh-indexer)) (loop for msg-hash being hash-values of mh-index-data @@ -437,6 +503,78 @@ (loop for msg-hash being hash-values of mh-index-data count (> (hash-table-count msg-hash) 0)))))) + + +;;; Functions to serialize index data... + +(defun mh-index-write-data () + "Write index data to file." + (ignore-errors + (unless (eq major-mode 'mh-folder-mode) + (error "Can't be called from folder in `%s'" major-mode)) + (let ((data mh-index-data) + (msg-checksum-map mh-index-msg-checksum-map) + (checksum-origin-map mh-index-checksum-origin-map) + (previous-search mh-index-previous-search) + (sequence-search-flag mh-index-sequence-search-flag) + (outfile (concat buffer-file-name mh-index-data-file)) + (print-length nil) + (print-level nil)) + (with-temp-file outfile + (mh-index-write-hashtable + data (lambda (x) (loop for y being the hash-keys of x collect y))) + (mh-index-write-hashtable msg-checksum-map #'identity) + (mh-index-write-hashtable checksum-origin-map #'identity) + (pp previous-search (current-buffer)) (insert "\n") + (pp sequence-search-flag (current-buffer)) (insert "\n"))))) + +;;;###mh-autoload +(defun mh-index-read-data () + "Read index data from file." + (ignore-errors + (unless (eq major-mode 'mh-folder-mode) + (error "Can't be called from folder in `%s'" major-mode)) + (let ((infile (concat buffer-file-name mh-index-data-file)) + t1 t2 t3 t4 t5) + (with-temp-buffer + (insert-file-contents-literally infile) + (goto-char (point-min)) + (setq t1 (mh-index-read-hashtable + (lambda (data) + (loop with table = (make-hash-table :test #'equal) + for x in data do (setf (gethash x table) t) + finally return table))) + t2 (mh-index-read-hashtable #'identity) + t3 (mh-index-read-hashtable #'identity) + t4 (read (current-buffer)) + t5 (read (current-buffer)))) + (setq mh-index-data t1 + mh-index-msg-checksum-map t2 + mh-index-checksum-origin-map t3 + mh-index-previous-search t4 + mh-index-sequence-search-flag t5)))) + +(defun mh-index-write-hashtable (table proc) + "Write TABLE to `current-buffer'. +PROC is used to serialize the values corresponding to the hash table keys." + (pp (loop for x being the hash-keys of table + collect (cons x (funcall proc (gethash x table)))) + (current-buffer)) + (insert "\n")) + +(defun mh-index-read-hashtable (proc) + "From BUFFER read a hash table serialized as a list. +PROC is used to convert the value to actual data." + (loop with table = (make-hash-table :test #'equal) + for pair in (read (current-buffer)) + do (setf (gethash (car pair) table) (funcall proc (cdr pair))) + finally return table)) + +;;;###mh-autoload +(defun mh-index-p () + "Non-nil means that this folder was generated by an index search." + mh-index-data) + ;;;###mh-autoload (defun mh-index-do-search () "Construct appropriate regexp and call `mh-index-search'." @@ -452,8 +590,9 @@ (defun mh-replace-string (old new) "Replace all occurrences of OLD with NEW in the current buffer." (goto-char (point-min)) - (while (search-forward old nil t) - (replace-match new))) + (let ((case-fold-search t)) + (while (search-forward old nil t) + (replace-match new t t)))) ;;;###mh-autoload (defun mh-index-parse-search-regexp (input-string) @@ -463,16 +602,18 @@ (let (input) (with-temp-buffer (insert input-string) - (downcase-region (point-min) (point-max)) ;; replace tabs (mh-replace-string "\t" " ") ;; synonyms of AND + (mh-replace-string " AND " " and ") (mh-replace-string "&" " and ") (mh-replace-string " -and " " and ") ;; synonyms of OR + (mh-replace-string " OR " " or ") (mh-replace-string "|" " or ") (mh-replace-string " -or " " or ") ;; synonyms of NOT + (mh-replace-string " NOT " " not ") (mh-replace-string "!" " not ") (mh-replace-string "~" " not ") (mh-replace-string " -not " " not ") @@ -498,21 +639,21 @@ (multiple-value-setq (op-stack operand-stack) (mh-index-evaluate op-stack operand-stack)) (when (eq (car op-stack) 'not) - (pop op-stack) + (setq op-stack (cdr op-stack)) (push `(not ,(pop operand-stack)) operand-stack)) (when (eq (car op-stack) 'and) - (pop op-stack) + (setq op-stack (cdr op-stack)) (setq oper1 (pop operand-stack)) (push `(and ,(pop operand-stack) ,oper1) operand-stack))) ((eq (car op-stack) 'not) - (pop op-stack) + (setq op-stack (cdr op-stack)) (push `(not ,token) operand-stack) (when (eq (car op-stack) 'and) - (pop op-stack) + (setq op-stack (cdr op-stack)) (setq oper1 (pop operand-stack)) (push `(and ,(pop operand-stack) ,oper1) operand-stack))) ((eq (car op-stack) 'and) - (pop op-stack) + (setq op-stack (cdr op-stack)) (push `(and ,(pop operand-stack) ,token) operand-stack)) (t (push token operand-stack)))) (prog1 (pop operand-stack) @@ -632,7 +773,7 @@ (setq current-folder (car (gethash (gethash (mh-get-msg-num nil) mh-index-msg-checksum-map) mh-index-checksum-origin-map))) - (when (and current-folder (not (eq current-folder last-folder))) + (when (and current-folder (not (equal current-folder last-folder))) (insert (if last-folder "\n" "") current-folder "\n") (setq last-folder current-folder)) (forward-line)) @@ -646,7 +787,7 @@ list of messages originally from that folder." (save-excursion (goto-char (point-min)) - (let ((result-table (make-hash-table))) + (let ((result-table (make-hash-table :test #'equal))) (loop for msg being hash-keys of mh-index-msg-checksum-map do (push msg (gethash (car (gethash (gethash msg mh-index-msg-checksum-map) @@ -722,24 +863,113 @@ (string-equal (buffer-substring-no-properties (point) (line-end-position)) checksum))) +(defun mh-index-matching-source-msgs (msgs &optional delete-from-index-data) + "Return a table of original messages and folders for messages in MSGS. +If optional argument DELETE-FROM-INDEX-DATA is non-nil, then each of the +messages, whose counter-part is found in some source folder, is removed from +`mh-index-data'." + (let ((table (make-hash-table :test #'equal))) + (dolist (msg msgs) + (let* ((checksum (gethash msg mh-index-msg-checksum-map)) + (pair (gethash checksum mh-index-checksum-origin-map))) + (when (and checksum (car pair) (cdr pair) + (mh-index-match-checksum (cdr pair) (car pair) checksum)) + (push (cdr pair) (gethash (car pair) table)) + (when delete-from-index-data + (remhash (cdr pair) (gethash (car pair) mh-index-data)))))) + table)) + ;;;###mh-autoload (defun mh-index-execute-commands () "Delete/refile the actual messages. The copies in the searched folder are then deleted/refiled to get the desired result. Before deleting the messages we make sure that the message being deleted is identical to the one that the user has marked in the index buffer." - (let ((message-table (make-hash-table :test #'equal))) - (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list))) - (dolist (msg msg-list) - (let* ((checksum (gethash msg mh-index-msg-checksum-map)) - (pair (gethash checksum mh-index-checksum-origin-map))) - (when (and checksum (car pair) (cdr pair) - (mh-index-match-checksum (cdr pair) (car pair) checksum)) - (push (cdr pair) (gethash (car pair) message-table)) - (remhash (cdr pair) (gethash (car pair) mh-index-data)))))) - (maphash (lambda (folder msgs) - (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))) - message-table))) + (save-excursion + (let ((folders ()) + (mh-speed-flists-inhibit-flag t)) + (maphash + (lambda (folder msgs) + (push folder folders) + (if (not (get-buffer folder)) + ;; If source folder not open, just delete the messages... + (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)) + ;; Otherwise delete the messages in the source buffer... + (save-excursion + (set-buffer folder) + (let ((old-refile-list mh-refile-list) + (old-delete-list mh-delete-list)) + (setq mh-refile-list nil + mh-delete-list msgs) + (unwind-protect (mh-execute-commands) + (setq mh-refile-list + (mapcar (lambda (x) + (cons (car x) + (loop for y in (cdr x) + unless (memq y msgs) collect y))) + old-refile-list) + mh-delete-list + (loop for x in old-delete-list + unless (memq x msgs) collect x)) + (mh-set-folder-modified-p (mh-outstanding-commands-p)) + (when (mh-outstanding-commands-p) + (mh-notate-deleted-and-refiled))))))) + (mh-index-matching-source-msgs (append (loop for x in mh-refile-list + append (cdr x)) + mh-delete-list) + t)) + folders))) + +;;;###mh-autoload +(defun mh-index-add-to-sequence (seq msgs) + "Add to SEQ the messages in the list MSGS. +This function updates the source folder sequences. Also makes an attempt to +update the source folder buffer if we have it open." + ;; Don't need to do anything for cur + (save-excursion + (when (and (not (memq seq (mh-unpropagated-sequences))) + (mh-valid-seq-p seq)) + (let ((folders ()) + (mh-speed-flists-inhibit-flag t)) + (maphash (lambda (folder msgs) + (push folder folders) + ;; Add messages to sequence in source folder... + (apply #'mh-exec-cmd-quiet nil "mark" folder + "-add" "-nozero" "-sequence" (symbol-name seq) + (mapcar (lambda (x) (format "%s" x)) + (mh-coalesce-msg-list msgs))) + ;; Update source folder buffer if we have it open... + (when (get-buffer folder) + (save-excursion + (set-buffer folder) + (mh-put-msg-in-seq msgs seq)))) + (mh-index-matching-source-msgs msgs)) + folders)))) + +;;;###mh-autoload +(defun mh-index-delete-from-sequence (seq msgs) + "Delete from SEQ the messages in MSGS. +This function updates the source folder sequences. Also makes an attempt to +update the source folder buffer if present." + (save-excursion + (when (and (not (memq seq (mh-unpropagated-sequences))) + (mh-valid-seq-p seq)) + (let ((folders ()) + (mh-speed-flists-inhibit-flag t)) + (maphash (lambda (folder msgs) + (push folder folders) + ;; Remove messages from sequence in source folder... + (apply #'mh-exec-cmd-quiet nil "mark" folder + "-del" "-nozero" "-sequence" (symbol-name seq) + (mapcar (lambda (x) (format "%s" x)) + (mh-coalesce-msg-list msgs))) + ;; Update source folder buffer if we have it open... + (when (get-buffer folder) + (save-excursion + (set-buffer folder) + (mh-delete-msg-from-seq msgs seq t)))) + (mh-index-matching-source-msgs msgs)) + folders)))) @@ -1051,61 +1281,114 @@ (defvar mh-flists-search-folders) +;; XXX: This should probably be in mh-utils.el and used in other places where +;; MH-E calls out to /bin/sh. +(defun mh-index-quote-for-shell (string) + "Quote STRING for /bin/sh." + (concat "\"" + (loop for x across string + concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) + "\"")) + (defun mh-flists-execute (&rest args) - "Search for unseen messages in `mh-flists-search-folders'. -If `mh-recursive-folders-flag' is t, then the folders are searched -recursively. All parameters ARGS are ignored." + "Execute flists. +Search for messages belonging to `mh-flists-sequence' in the folders +specified by `mh-flists-search-folders'. If `mh-recursive-folders-flag' is t, +then the folders are searched recursively. All parameters ARGS are ignored." (set-buffer (get-buffer-create mh-index-temp-buffer)) (erase-buffer) (unless (executable-find "sh") (error "Didn't find sh")) (with-temp-buffer - (let ((unseen (symbol-name mh-unseen-seq))) - (insert "for folder in `flists " - (cond ((eq mh-flists-search-folders t) mh-inbox) + (let ((seq (symbol-name mh-flists-sequence))) + (insert "for folder in `" (expand-file-name "flists" mh-progs) " " + (cond ((eq mh-flists-search-folders t) + (mh-index-quote-for-shell mh-inbox)) ((eq mh-flists-search-folders nil) "") ((listp mh-flists-search-folders) (loop for folder in mh-flists-search-folders - concat (concat " " folder)))) + concat + (concat " " (mh-index-quote-for-shell folder))))) (if mh-recursive-folders-flag " -recurse" "") - " -sequence " unseen " -noshowzero -fast` ; do\n" - "mhpath \"+$folder\" " unseen "\n" "done\n")) + " -sequence " seq " -noshowzero -fast` ; do\n" + (expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n" + "done\n")) (call-process-region (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer)))) ;;;###mh-autoload -(defun mh-index-new-messages (folders) - "Display new messages. -All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed. +(defun mh-index-sequenced-messages (folders sequence) + "Display messages from FOLDERS in SEQUENCE. By default the folders specified by `mh-index-new-messages-folders' are searched. With a prefix argument, enter a space-separated list of folders, or -nothing to search all folders." +nothing to search all folders. + +Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the +function searches for in each of the FOLDERS. With a prefix argument, enter a +sequence to use." (interactive (list (if current-prefix-arg - (split-string (read-string "Folders to search: ")) - mh-index-new-messages-folders))) + (split-string (read-string "Search folder(s) [all]? ")) + mh-index-new-messages-folders) + (mh-read-seq-default "Search" nil))) + (unless sequence (setq sequence mh-unseen-seq)) (let* ((mh-flists-search-folders folders) + (mh-flists-sequence sequence) + (mh-flists-called-flag t) (mh-indexer 'flists) (mh-index-execute-search-function 'mh-flists-execute) (mh-index-next-result-function 'mh-mairix-next-result) (mh-mairix-folder mh-user-path) (mh-index-regexp-builder nil) - (new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder)) + (new-folder (format "%s/%s/%s" mh-index-folder + mh-flists-results-folder sequence)) (window-config (if (equal new-folder mh-current-folder) mh-previous-window-config (current-window-configuration))) - (redo-flag nil)) + (redo-flag nil) + message) (cond ((buffer-live-p (get-buffer new-folder)) ;; The destination folder is being visited. Trick `mh-index-search' - ;; into thinking that the folder was the result of a previous search. + ;; into thinking that the folder resulted from a previous search. (set-buffer new-folder) - (setq mh-index-previous-search (list "+" mh-flists-results-folder)) + (setq mh-index-previous-search (list folders sequence)) (setq redo-flag t)) ((mh-folder-exists-p new-folder) ;; Folder exists but we don't have it open. That means they are ;; stale results from a old flists search. Clear it out. (mh-exec-cmd-quiet nil "rmf" new-folder))) - (mh-index-search redo-flag "+" mh-flists-results-folder window-config t))) + (setq message (mh-index-search redo-flag "+" mh-flists-results-folder + window-config) + mh-index-sequence-search-flag t + mh-index-previous-search (list folders sequence)) + (mh-index-write-data) + (when (stringp message) (message message)))) + +;;;###mh-autoload +(defun mh-index-new-messages (folders) + "Display unseen messages. +All messages in the `unseen' sequence from FOLDERS are displayed. +By default the folders specified by `mh-index-new-messages-folders' +are searched. With a prefix argument, enter a space-separated list of +folders, or nothing to search all folders." + (interactive + (list (if current-prefix-arg + (split-string (read-string "Search folder(s) [all]? ")) + mh-index-new-messages-folders))) + (mh-index-sequenced-messages folders mh-unseen-seq)) + +;;;###mh-autoload +(defun mh-index-ticked-messages (folders) + "Display ticked messages. +All messages in the `tick' sequence from FOLDERS are displayed. +By default the folders specified by `mh-index-ticked-messages-folders' +are searched. With a prefix argument, enter a space-separated list of +folders, or nothing to search all folders." + (interactive + (list (if current-prefix-arg + (split-string (read-string "Search folder(s) [all]? ")) + mh-index-ticked-messages-folders))) + (mh-index-sequenced-messages folders mh-tick-seq))
--- a/lisp/mh-e/mh-junk.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-junk.el Tue Jul 13 03:06:25 2004 +0000 @@ -36,14 +36,11 @@ ;; Interactive functions callable from the folder buffer ;;;###mh-autoload -(defun mh-junk-blacklist (msg-or-seq) - "Blacklist MSG-OR-SEQ as spam. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is blacklisted. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. +(defun mh-junk-blacklist (range) + "Blacklist RANGE as spam. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. First the appropriate function is called depending on the value of `mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is @@ -58,7 +55,7 @@ - `mh-bogofilter-blacklist' - `mh-spamprobe-blacklist' - `mh-spamassassin-blacklist'" - (interactive (list (mh-interactive-msg-or-seq "Blacklist"))) + (interactive (list (mh-interactive-range "Blacklist"))) (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist)))) (unless blacklist-func (error "Customize `mh-junk-program' appropriately")) @@ -70,7 +67,7 @@ (concat mh-current-folder "/" (substring mh-junk-mail-folder 1))) (t (concat "+" mh-junk-mail-folder))))) - (mh-iterate-on-msg-or-seq msg msg-or-seq + (mh-iterate-on-range msg range (funcall (symbol-function blacklist-func) msg) (if dest (mh-refile-a-msg nil (intern dest)) @@ -78,25 +75,22 @@ (mh-next-msg)))) ;;;###mh-autoload -(defun mh-junk-whitelist (msg-or-seq) - "Whitelist MSG-OR-SEQ incorrectly classified as spam. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is whitelisted. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. +(defun mh-junk-whitelist (range) + "Whitelist RANGE incorrectly classified as spam. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. First the appropriate function is called depending on the value of `mh-junk-choice'. Then the message is refiled to `mh-inbox'. To change the spam program being used, customize `mh-junk-program'. Directly setting `mh-junk-choice' is not recommended." - (interactive (list (mh-interactive-msg-or-seq "Whitelist"))) + (interactive (list (mh-interactive-range "Whitelist"))) (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist)))) (unless whitelist-func (error "Customize `mh-junk-program' appropriately")) - (mh-iterate-on-msg-or-seq msg msg-or-seq + (mh-iterate-on-range msg range (funcall (symbol-function whitelist-func) msg) (mh-refile-a-msg nil (intern mh-inbox))) (mh-next-msg))) @@ -302,7 +296,7 @@ (when mh-sa-learn-executable (message "Recategorizing this message as spam...") (call-process mh-sa-learn-executable msg-file mh-log-buffer nil - "--single" "--spam" "--local --no-rebuild")) + "--single" "--spam" "--local" "--no-rebuild")) (message "Blacklisting address...") (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer)
--- a/lisp/mh-e/mh-loaddefs.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-loaddefs.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,18 +1,19 @@ ;;; mh-loaddefs.el --- automatically extracted autoloads ;; -;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ;;; Author: Bill Wohler <wohler@newt.com> ;;; Keywords: mail ;;; Commentary: ;;; Change Log: ;;; Code: -;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft -;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom -;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function +;;;### (autoloads (mh-letter-previous-header-field mh-letter-next-header-field-or-indent +;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft +;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-insert-auto-fields +;;;;;; mh-check-whom mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function ;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward ;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el" -;;;;;; (16040 52697)) +;;;;;; (16625 53169)) ;;; Generated autoloads from mh-comp.el (autoload (quote mh-edit-again) "mh-comp" "\ @@ -29,13 +30,11 @@ (autoload (quote mh-forward) "mh-comp" "\ Forward messages to the recipients TO and CC. -Use optional MSG-OR-SEQ argument to specify a message or sequence to forward. +Use optional RANGE argument to specify a message or sequence to forward. Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is forwarded. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. See also documentation for `\\[mh-send]' function." t nil) @@ -104,6 +103,14 @@ (autoload (quote mh-check-whom) "mh-comp" "\ Verify recipients of the current letter, showing expansion of any aliases." t nil) +(autoload (quote mh-insert-auto-fields) "mh-comp" "\ +Insert custom fields if To or Cc match `mh-auto-fields-list'. +Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted +something. If NON-INTERACTIVE is non-nil, do not be verbose and only +attempt matches if `mh-insert-auto-fields-done-local' is nil. + +An `identity' entry is skipped if one was already entered manually." t nil) + (autoload (quote mh-send-letter) "mh-comp" "\ Send the draft letter in the current buffer. If optional prefix argument ARG is provided, monitor delivery. @@ -143,16 +150,26 @@ In addition, insert newline and quoting characters before text after point. This is useful in breaking up paragraphs in replies." t nil) -(autoload (quote mh-letter-complete) "mh-comp" "\ -Perform completion on header field or word preceding point. -Alias completion is done within the mail header on selected fields and -by the function designated by `mh-letter-complete-function' elsewhere, -passing the prefix ARG if any." t nil) +(autoload (quote mh-complete-word) "mh-comp" "\ +Complete WORD at from CHOICES. +Any match found replaces the text from BEGIN to END." nil nil) + +(autoload (quote mh-beginning-of-word) "mh-comp" "\ +Return position of the N th word backwards." nil nil) + +(autoload (quote mh-letter-next-header-field-or-indent) "mh-comp" "\ +Move to next field or indent depending on point. +In the message header, go to the next field. Elsewhere call +`indent-relative' as usual with optional prefix ARG." t nil) + +(autoload (quote mh-letter-previous-header-field) "mh-comp" "\ +Cycle to the previous header field. +If we are at the first header field go to the start of the message body." t nil) ;;;*** ;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el" -;;;;;; (16040 52697)) +;;;;;; (16625 53481)) ;;; Generated autoloads from mh-customize.el (autoload (quote mh-customize) "mh-customize" "\ @@ -163,7 +180,7 @@ ;;;*** ;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p) -;;;;;; "mh-e" "mh-e.el" (16040 52698)) +;;;;;; "mh-e" "mh-e.el" (16627 18152)) ;;; Generated autoloads from mh-e.el (autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\ @@ -186,7 +203,7 @@ ;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards ;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders ;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el" -;;;;;; (16040 52698)) +;;;;;; (16625 54011)) ;;; Generated autoloads from mh-funcs.el (autoload (quote mh-burst-digest) "mh-funcs" "\ @@ -195,18 +212,18 @@ digest are inserted into the folder after that message." t nil) (autoload (quote mh-copy-msg) "mh-funcs" "\ -Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is copied. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence." t nil) +Copy the specified RANGE to another FOLDER without deleting them. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." t nil) (autoload (quote mh-kill-folder) "mh-funcs" "\ Remove the current folder and all included messages. Removes all of the messages (files) within the specified current folder, -and then removes the folder (directory) itself." t nil) +and then removes the folder (directory) itself. +The value of `mh-kill-folder-suppress-prompt-hook' is a list of functions to +be called, with no arguments, which should return a value of non-nil if +verification is not desired." t nil) (autoload (quote mh-list-folders) "mh-funcs" "\ List mail folders." t nil) @@ -229,13 +246,10 @@ Back up displayed message to previous digested message." t nil) (autoload (quote mh-print-msg) "mh-funcs" "\ -Print MSG-OR-SEQ on printer. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is printed. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. +Print RANGE on printer. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. The variable `mh-lpr-command-format' is used to generate the print command. The messages are formatted by mhl. See the variable `mhl-formfile'." t nil) @@ -274,7 +288,7 @@ ;;;*** ;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu) -;;;;;; "mh-identity" "mh-identity.el" (16040 52698)) +;;;;;; "mh-identity" "mh-identity.el" (16625 54171)) ;;; Generated autoloads from mh-identity.el (autoload (quote mh-identity-make-menu) "mh-identity" "\ @@ -292,8 +306,8 @@ ;;;*** -;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16040 -;;;;;; 52698)) +;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16625 +;;;;;; 54212)) ;;; Generated autoloads from mh-inc.el (autoload (quote mh-inc-spool-list-set) "mh-inc" "\ @@ -304,12 +318,15 @@ ;;;*** ;;;### (autoloads (mh-index-choose mh-namazu-execute-search mh-swish++-execute-search -;;;;;; mh-swish-execute-search mh-index-new-messages mh-glimpse-execute-search -;;;;;; mh-index-execute-commands mh-index-update-unseen mh-index-visit-folder -;;;;;; mh-index-delete-folder-headers mh-index-group-by-folder mh-index-insert-folder-headers -;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-parse-search-regexp -;;;;;; mh-index-do-search mh-index-search mh-index-update-maps) -;;;;;; "mh-index" "mh-index.el" (16040 52698)) +;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages +;;;;;; mh-index-sequenced-messages mh-glimpse-execute-search mh-index-delete-from-sequence +;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-update-unseen +;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-group-by-folder +;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder +;;;;;; mh-index-parse-search-regexp mh-index-do-search mh-index-p +;;;;;; mh-index-read-data mh-index-search mh-index-create-sequences +;;;;;; mh-create-sequence-map mh-index-update-maps) "mh-index" "mh-index.el" +;;;;;; (16625 54348)) ;;; Generated autoloads from mh-index.el (autoload (quote mh-index-update-maps) "mh-index" "\ @@ -319,6 +336,14 @@ folder and message from whence it was copied. If present the checksum -> (origin-folder, origin-index) map is updated too." nil nil) +(autoload (quote mh-create-sequence-map) "mh-index" "\ +Return a map from msg number to list of sequences in which it is present. +SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the +list of messages in that sequence." nil nil) + +(autoload (quote mh-index-create-sequences) "mh-index" "\ +Mirror sequences present in source folders in index folder." nil nil) + (autoload (quote mh-index-search) "mh-index" "\ Perform an indexed search in an MH mail folder. Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. @@ -328,8 +353,7 @@ SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is \"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG stores the window configuration that will be restored after the user quits the -folder containing the index search results. If optional argument UNSEEN-FLAG -is non-nil, then all the messages are marked as unseen. +folder containing the index search results. Four indexing programs are supported; if none of these are present, then grep is used. This function picks the first program that is available on your @@ -361,6 +385,12 @@ This has the effect of renaming already present X-MHE-Checksum headers." t nil) +(autoload (quote mh-index-read-data) "mh-index" "\ +Read index data from file." nil nil) + +(autoload (quote mh-index-p) "mh-index" "\ +Non-nil means that this folder was generated by an index search." nil nil) + (autoload (quote mh-index-do-search) "mh-index" "\ Construct appropriate regexp and call `mh-index-search'." t nil) @@ -402,6 +432,16 @@ result. Before deleting the messages we make sure that the message being deleted is identical to the one that the user has marked in the index buffer." nil nil) +(autoload (quote mh-index-add-to-sequence) "mh-index" "\ +Add to SEQ the messages in the list MSGS. +This function updates the source folder sequences. Also makes an attempt to +update the source folder buffer if we have it open." nil nil) + +(autoload (quote mh-index-delete-from-sequence) "mh-index" "\ +Delete from SEQ the messages in MSGS. +This function updates the source folder sequences. Also makes an attempt to +update the source folder buffer if present." nil nil) + (autoload (quote mh-glimpse-execute-search) "mh-index" "\ Execute glimpse and read the results. @@ -435,12 +475,29 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil) -(autoload (quote mh-index-new-messages) "mh-index" "\ -Display new messages. -All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed. +(autoload (quote mh-index-sequenced-messages) "mh-index" "\ +Display messages from FOLDERS in SEQUENCE. By default the folders specified by `mh-index-new-messages-folders' are searched. With a prefix argument, enter a space-separated list of folders, or -nothing to search all folders." t nil) +nothing to search all folders. + +Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the +function searches for in each of the FOLDERS. With a prefix argument, enter a +sequence to use." t nil) + +(autoload (quote mh-index-new-messages) "mh-index" "\ +Display unseen messages. +All messages in the `unseen' sequence from FOLDERS are displayed. +By default the folders specified by `mh-index-new-messages-folders' +are searched. With a prefix argument, enter a space-separated list of +folders, or nothing to search all folders." t nil) + +(autoload (quote mh-index-ticked-messages) "mh-index" "\ +Display ticked messages. +All messages in the `tick' sequence from FOLDERS are displayed. +By default the folders specified by `mh-index-ticked-messages-folders' +are searched. With a prefix argument, enter a space-separated list of +folders, or nothing to search all folders." t nil) (autoload (quote mh-swish-execute-search) "mh-index" "\ Execute swish-e and read the results. @@ -564,17 +621,14 @@ ;;;*** ;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk" -;;;;;; "mh-junk.el" (16040 52698)) +;;;;;; "mh-junk.el" (16625 54386)) ;;; Generated autoloads from mh-junk.el (autoload (quote mh-junk-blacklist) "mh-junk" "\ -Blacklist MSG-OR-SEQ as spam. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is blacklisted. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. +Blacklist RANGE as spam. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. First the appropriate function is called depending on the value of `mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is @@ -591,13 +645,10 @@ - `mh-spamassassin-blacklist'" t nil) (autoload (quote mh-junk-whitelist) "mh-junk" "\ -Whitelist MSG-OR-SEQ incorrectly classified as spam. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is whitelisted. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence. +Whitelist RANGE incorrectly classified as spam. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. First the appropriate function is called depending on the value of `mh-junk-choice'. Then the message is refiled to `mh-inbox'. @@ -616,7 +667,7 @@ ;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit ;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar ;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward -;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16040 52699)) +;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16625 54523)) ;;; Generated autoloads from mh-mime.el (autoload (quote mh-compose-insertion) "mh-mime" "\ @@ -792,7 +843,7 @@ ;;;*** ;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search -;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16040 52699)) +;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16625 54571)) ;;; Generated autoloads from mh-pick.el (autoload (quote mh-search-folder) "mh-pick" "\ @@ -822,16 +873,19 @@ ;;;*** -;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-notate-tick -;;;;;; mh-thread-refile mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling +;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-thread-refile +;;;;;; mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling ;;;;;; mh-thread-next-sibling mh-thread-forget-message mh-toggle-threads -;;;;;; mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread -;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list -;;;;;; mh-interactive-msg-or-seq mh-msg-or-seq-to-msg-list mh-iterate-on-msg-or-seq -;;;;;; mh-iterate-on-messages-in-region mh-add-to-sequence mh-notate-cur -;;;;;; mh-notate-seq mh-map-to-seq-msgs mh-rename-seq mh-widen mh-put-msg-in-seq -;;;;;; mh-narrow-to-seq mh-msg-is-in-seq mh-list-sequences mh-delete-seq) -;;;;;; "mh-seq" "mh-seq.el" (16040 52700)) +;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc +;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range +;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject +;;;;;; mh-region-to-msg-list mh-interactive-range mh-range-to-msg-list +;;;;;; mh-iterate-on-range mh-iterate-on-messages-in-region mh-add-to-sequence +;;;;;; mh-notate-cur mh-notate-seq mh-map-to-seq-msgs mh-rename-seq +;;;;;; mh-translate-range mh-read-range mh-read-seq-default mh-notate-deleted-and-refiled +;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq +;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (16625 +;;;;;; 54690)) ;;; Generated autoloads from mh-seq.el (autoload (quote mh-delete-seq) "mh-seq" "\ @@ -849,16 +903,64 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) (autoload (quote mh-put-msg-in-seq) "mh-seq" "\ -Add MSG-OR-SEQ to SEQUENCE. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is added to the sequence. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence." t nil) +Add RANGE to SEQUENCE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." t nil) (autoload (quote mh-widen) "mh-seq" "\ -Remove restrictions from current folder, thereby showing all messages." t nil) +Remove last restriction from current folder. +If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning +of the view stack thereby showing all messages that the buffer originally +contained." t nil) + +(autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\ +Notate messages marked for deletion or refiling. +Messages to be deleted are given by `mh-delete-list' while messages to be +refiled are present in `mh-refile-list'." nil nil) + +(autoload (quote mh-read-seq-default) "mh-seq" "\ +Read and return sequence name with default narrowed or previous sequence. +PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a +non-empty sequence is read." nil nil) + +(autoload (quote mh-read-range) "mh-seq" "\ +Read a message range with PROMPT. + +If FOLDER is non-nil then a range is read from that folder, otherwise use +`mh-current-folder'. + +If DEFAULT is a string then use that as default range to return. If DEFAULT is +nil then ask user with default answer a range based on the sequences that seem +relevant. Finally if DEFAULT is t, try to avoid prompting the user. Unseen +messages, if present, are returned. If the folder has fewer than +`mh-large-folder' messages then \"all\" messages are returned. Finally as a +last resort prompt the user. + +If EXPAND-FLAG is non-nil then a list of message numbers corresponding to the +input is returned. If this list is empty then an error is raised. If +EXPAND-FLAG is nil just return the input string. In this case we don't check +if the range is empty. + +If ASK-FLAG is non-nil, then the user is always queried for a range of +messages. If ASK-FLAG is nil, then the function checks if the unseen sequence +is non-empty. If that is the case, `mh-unseen-seq', or the list of messages in +it depending on the value of EXPAND, is returned. Otherwise if the folder has +fewer than `mh-large-folder' messages then the list of messages corresponding +to \"all\" is returned. If neither of the above holds then as a last resort +the user is queried for a range of messages. + +If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as input, it +is interpreted as the range \"last:N\". + +This function replaces the existing function `mh-read-msg-range'. Calls to: + (mh-read-msg-range folder flag) +should be replaced with: + (mh-read-range \"Suitable prompt\" folder t nil flag + mh-interpret-number-as-range-flag)" nil nil) + +(autoload (quote mh-translate-range) "mh-seq" "\ +In FOLDER, translate the string EXPR to a list of messages numbers." nil nil) (autoload (quote mh-rename-seq) "mh-seq" "\ Rename SEQUENCE to have NEW-NAME." t nil) @@ -888,33 +990,39 @@ If VAR is nil then the loop is executed without any binding." nil (quote macro)) -(autoload (quote mh-iterate-on-msg-or-seq) "mh-seq" "\ +(autoload (quote mh-iterate-on-range) "mh-seq" "\ Iterate an operation over a region or sequence. -VAR is bound to each message in turn in a loop over MSG-OR-SEQ, which can be a -message number, a list of message numbers, a sequence, or a region in a cons -cell. In each iteration, BODY is executed. +VAR is bound to each message in turn in a loop over RANGE, which can be a +message number, a list of message numbers, a sequence, a region in a cons +cell, or a MH range (something like last:20) in a string. In each iteration, +BODY is executed. -The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq' +The parameter RANGE is usually created with `mh-interactive-range' in order to provide a uniform interface to MH-E functions." nil (quote macro)) -(autoload (quote mh-msg-or-seq-to-msg-list) "mh-seq" "\ -Return a list of messages for MSG-OR-SEQ. -MSG-OR-SEQ can be a message number, a list of message numbers, a sequence, or +(autoload (quote mh-range-to-msg-list) "mh-seq" "\ +Return a list of messages for RANGE. +RANGE can be a message number, a list of message numbers, a sequence, or a region in a cons cell." nil nil) -(autoload (quote mh-interactive-msg-or-seq) "mh-seq" "\ -Return interactive specification for message, sequence, or region. -By convention, the name of this argument is msg-or-seq. +(autoload (quote mh-interactive-range) "mh-seq" "\ +Return interactive specification for message, sequence, range or region. +By convention, the name of this argument is RANGE. If variable `transient-mark-mode' is non-nil and the mark is active, then this function returns a cons-cell of the region. -If optional prefix argument provided, then prompt for message sequence with -SEQUENCE-PROMPT and return sequence. + +If optional prefix argument is provided, then prompt for message range with +RANGE-PROMPT. A list of messages in that range is returned. + +If a MH range is given, say something like last:20, then a list containing +the messages in that range is returned. + Otherwise, the message number at point is returned. -This function is usually used with `mh-iterate-on-msg-or-seq' in order to -provide a uniform interface to MH-E functions." nil nil) +This function is usually used with `mh-iterate-on-range' in order to provide +a uniform interface to MH-E functions." nil nil) (autoload (quote mh-region-to-msg-list) "mh-seq" "\ Return a list of messages within the region between BEGIN and END." nil nil) @@ -922,6 +1030,27 @@ (autoload (quote mh-narrow-to-subject) "mh-seq" "\ Narrow to a sequence containing all following messages with same subject." t nil) +(autoload (quote mh-narrow-to-from) "mh-seq" "\ +Limit to messages with the same From header field as the message at point. +With a prefix argument, prompt for the regular expression, REGEXP given to +pick." t nil) + +(autoload (quote mh-narrow-to-cc) "mh-seq" "\ +Limit to messages with the same Cc header field as the message at point. +With a prefix argument, prompt for the regular expression, REGEXP given to +pick." t nil) + +(autoload (quote mh-narrow-to-to) "mh-seq" "\ +Limit to messages with the same To header field as the message at point. +With a prefix argument, prompt for the regular expression, REGEXP given to +pick." t nil) + +(autoload (quote mh-narrow-to-range) "mh-seq" "\ +Limit to messages in RANGE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." t nil) + (autoload (quote mh-delete-subject) "mh-seq" "\ Mark all following messages with same subject to be deleted. This puts the messages in a sequence named subject. You can undo the last @@ -939,6 +1068,10 @@ Update thread tree for FOLDER. All messages after START-POINT are added to the thread tree." nil nil) +(autoload (quote mh-thread-update-scan-line-map) "mh-seq" "\ +In threaded view update `mh-thread-scan-line-map'. +MSG is the message being notated with NOTATION at OFFSET." nil nil) + (autoload (quote mh-thread-add-spaces) "mh-seq" "\ Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil) @@ -966,13 +1099,8 @@ (autoload (quote mh-thread-refile) "mh-seq" "\ Mark current message and all its children for refiling to FOLDER." t nil) -(autoload (quote mh-notate-tick) "mh-seq" "\ -Highlight current line if MSG is in TICKED-MSGS. -If optional argument IGNORE-NARROWING is non-nil then highlighting is carried -out even if folder is narrowed to `mh-tick-seq'." nil nil) - (autoload (quote mh-toggle-tick) "mh-seq" "\ -Toggle tick mark of all messages in region BEGIN to END." t nil) +Toggle tick mark of all messages in RANGE." t nil) (autoload (quote mh-narrow-to-tick) "mh-seq" "\ Restrict display of this folder to just messages in `mh-tick-seq'. @@ -982,7 +1110,7 @@ ;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists ;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons) -;;;;;; "mh-speed" "mh-speed.el" (16040 52700)) +;;;;;; "mh-speed" "mh-speed.el" (16625 54721)) ;;; Generated autoloads from mh-speed.el (autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\ @@ -1003,7 +1131,9 @@ (autoload (quote mh-speed-flists) "mh-speed" "\ Execute flists -recurse and update message counts. -If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run +If FORCE is non-nil the timer is reset. + +Any number of optional FOLDERS can be specified. If specified, flists is run only for that one folder." t nil) (autoload (quote mh-speed-invalidate-map) "mh-speed" "\ @@ -1016,7 +1146,7 @@ ;;;*** ;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point) -;;;;;; "mh-utils" "mh-utils.el" (16040 52700)) +;;;;;; "mh-utils" "mh-utils.el" (16625 54979)) ;;; Generated autoloads from mh-utils.el (autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\ @@ -1031,16 +1161,19 @@ ;;;*** -;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field -;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-address-to-alias -;;;;;; mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address -;;;;;; mh-read-address mh-alias-reload) "mh-alias" "mh-alias.el" -;;;;;; (16040 52696)) +;;;### (autoloads (mh-alias-apropos mh-alias-add-address-under-point +;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-from-has-no-alias-p +;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address +;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias" +;;;;;; "mh-alias.el" (16625 53006)) ;;; Generated autoloads from mh-alias.el (autoload (quote mh-alias-reload) "mh-alias" "\ Load MH aliases into `mh-alias-alist'." t nil) +(autoload (quote mh-alias-reload-maybe) "mh-alias" "\ +Load new MH aliases." nil nil) + (autoload (quote mh-read-address) "mh-alias" "\ Read an address from the minibuffer with PROMPT." nil nil) @@ -1071,6 +1204,9 @@ (autoload (quote mh-alias-add-address-under-point) "mh-alias" "\ Insert an alias for email address under point." t nil) +(autoload (quote mh-alias-apropos) "mh-alias" "\ +Show all aliases that match REGEXP either in name or content." t nil) + ;;;*** (provide 'mh-loaddefs) @@ -1079,6 +1215,5 @@ ;;; no-byte-compile: t ;;; no-update-autoloads: t ;;; End: - ;;; arch-tag: bc36a104-1edb-45d5-8aad-a85b45648378 ;;; mh-loaddefs.el ends here
--- a/lisp/mh-e/mh-mime.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-mime.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,6 +1,6 @@ ;;; mh-mime.el --- MH-E support for composing MIME messages -;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -34,14 +34,11 @@ ;;; Code: -(require 'cl) +(require 'mh-utils) +(mh-require-cl) (require 'mh-comp) -(require 'mh-utils) -(load "mm-decode" t t) ; Non-fatal dependency -(load "mm-uu" t t) ; Non-fatal dependency -(load "mailcap" t t) ; Non-fatal dependency -(load "smiley" t t) ; Non-fatal dependency (require 'gnus-util) +(require 'mh-gnus) (autoload 'gnus-article-goto-header "gnus-art") (autoload 'article-emphasize "gnus-art") @@ -450,6 +447,7 @@ This step is performed automatically when sending the message, but this function may be called manually before sending the draft as well." (interactive) + (require 'message) (when mh-gnus-pgp-support-flag ;; This is only needed for PGP (message-options-set-recipient)) (mml-to-mime)) @@ -529,99 +527,6 @@ -;;; MIME decoding - -(defmacro mh-defun-compat (function arg-list &rest body) - "This is a macro to define functions which are not defined. -It is used for Gnus utility functions which were added recently. If FUNCTION -is not defined then it is defined to have argument list, ARG-LIST and body, -BODY." - (let ((defined-p (fboundp function))) - (unless defined-p - `(defun ,function ,arg-list ,@body)))) -(put 'mh-defun-compat 'lisp-indent-function 'defun) - -;; Copy of original function from gnus-util.el -(mh-defun-compat gnus-local-map-property (map) - "Return a list suitable for a text property list specifying keymap MAP." - (cond (mh-xemacs-flag (list 'keymap map)) - ((>= emacs-major-version 21) (list 'keymap map)) - (t (list 'local-map map)))) - -;; Copy of original function from mm-decode.el -(mh-defun-compat mm-merge-handles (handles1 handles2) - (append (if (listp (car handles1)) handles1 (list handles1)) - (if (listp (car handles2)) handles2 (list handles2)))) - -;; Copy of function from mm-decode.el -(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value) - ;; HANDLE could be a CTL. - (if handle - (put-text-property 0 (length (car handle)) parameter value - (car handle)))) - -;; Copy of original macro is in mm-decode.el -(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter) - (get-text-property 0 parameter (car handle))) - -(mh-do-in-xemacs (defvar default-enable-multibyte-characters)) - -;; Copy of original function in mm-decode.el -(mh-defun-compat mm-readable-p (handle) - "Say whether the content of HANDLE is readable." - (and (< (with-current-buffer (mm-handle-buffer handle) - (buffer-size)) 10000) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (and (eq (mm-body-7-or-8) '7bit) - (not (mm-long-lines-p 76)))))) - -;; Copy of original function in mm-bodies.el -(mh-defun-compat mm-long-lines-p (length) - "Say whether any of the lines in the buffer is longer than LINES." - (save-excursion - (goto-char (point-min)) - (end-of-line) - (while (and (not (eobp)) - (not (> (current-column) length))) - (forward-line 1) - (end-of-line)) - (and (> (current-column) length) - (current-column)))) - -(mh-defun-compat mm-keep-viewer-alive-p (handle) - ;; Released Gnus doesn't keep handles associated with externally displayed - ;; MIME parts. So this will always return nil. - nil) - -(mh-defun-compat mm-destroy-parts (list) - "Older emacs don't have this function." - nil) - -;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is -;;; buggy (the args to read-file-name are incorrect). When all supported -;;; versions of Emacs come with at least Gnus 5.10, we can delete this -;;; function and rename calls to mh-mm-save-part to mm-save-part. -(defun mh-mm-save-part (handle) - "Write HANDLE to a file." - (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) - (filename (mail-content-type-get - (mm-handle-disposition handle) 'filename)) - file) - (when filename - (setq filename (file-name-nondirectory filename))) - (setq file (read-file-name "Save MIME part to: " - (or mm-default-directory - default-directory) - nil nil (or filename name ""))) - (setq mm-default-directory (file-name-directory file)) - (and (or (not (file-exists-p file)) - (yes-or-no-p (format "File %s already exists; overwrite? " - file))) - (mm-save-part-to-file handle file)))) - - - ;;; MIME cleanup ;;;###mh-autoload @@ -668,28 +573,36 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)" (save-excursion (goto-char (point-min)) - (when (and (message-fetch-field "content-type") - (not (message-fetch-field "mime-version"))) - (when (search-forward "\n\n" nil t) - (forward-line -1) + (re-search-forward "\n\n" nil t) + (save-restriction + (narrow-to-region (point-min) (point)) + (when (and (message-fetch-field "content-type") + (not (message-fetch-field "mime-version"))) + (goto-char (point-min)) (insert "MIME-Version: 1.0\n"))))) +(defun mh-small-show-buffer-p () + "Check if show buffer is small. +This is used to decide if smileys and graphical emphasis will be displayed." + (let ((max nil)) + (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size) + (cond ((numberp font-lock-maximum-size) + (setq max font-lock-maximum-size)) + ((listp font-lock-maximum-size) + (setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size) + (assoc t font-lock-maximum-size))))))) + (or (not (numberp max)) (>= (/ max 8) (buffer-size))))) + ;;;###mh-autoload (defun mh-display-smileys () "Function to display smileys." - (when (and mh-graphical-smileys-flag - (fboundp 'smiley-region) - (boundp 'font-lock-maximum-size) - font-lock-maximum-size - (>= (/ font-lock-maximum-size 8) (buffer-size))) - (smiley-region (point-min) (point-max)))) + (when (and mh-graphical-smileys-flag (mh-small-show-buffer-p)) + (mh-funcall-if-exists smiley-region (point-min) (point-max)))) ;;;###mh-autoload (defun mh-display-emphasis () "Function to display graphical emphasis." - (when (and mh-graphical-emphasis-flag - (if font-lock-maximum-size - (>= (/ font-lock-maximum-size 8) (buffer-size)))) + (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) (flet ((article-goto-body ())) ; shadow this function to do nothing (save-excursion (goto-char (point-min)) @@ -799,10 +712,15 @@ (defun mh-decode-message-body () "Decode message based on charset. If message has been encoded for transfer take that into account." - (let* ((ct (ignore-errors (mail-header-parse-content-type - (message-fetch-field "Content-Type" t)))) - (charset (mail-content-type-get ct 'charset)) - (cte (message-fetch-field "Content-Transfer-Encoding"))) + (let (ct charset cte) + (goto-char (point-min)) + (re-search-forward "\n\n" nil t) + (save-restriction + (narrow-to-region (point-min) (point)) + (setq ct (ignore-errors (mail-header-parse-content-type + (message-fetch-field "Content-Type" t))) + charset (mail-content-type-get ct 'charset) + cte (message-fetch-field "Content-Transfer-Encoding"))) (when (stringp cte) (setq cte (mail-header-strip cte))) (when (or (not ct) (equal (car ct) "text/plain")) (save-restriction @@ -881,16 +799,31 @@ (defun mh-mime-display-alternative (handles) "Choose among the alternatives, HANDLES the part that will be displayed. If no part is preferred then all the parts are displayed." - (let ((preferred (mm-preferred-alternative handles))) + (let* ((preferred (mm-preferred-alternative handles)) + (others (loop for x in handles unless (eq x preferred) collect x))) (cond ((and preferred (stringp (car preferred))) - (mh-mime-display-part preferred)) + (mh-mime-display-part preferred) + (mh-mime-maybe-display-alternatives others)) (preferred (save-restriction (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) (mh-mime-display-single preferred) + (mh-mime-maybe-display-alternatives others) (goto-char (point-max)))) (t (mh-mime-display-mixed handles))))) +(defun mh-mime-maybe-display-alternatives (alternatives) + "Show buttons for ALTERNATIVES. +If `mh-mime-display-alternatives-flag' is non-nil then display buttons for +alternative parts that are usually suppressed." + (when (and mh-display-buttons-for-alternatives-flag alternatives) + (insert "\n----------------------------------------------------\n") + (insert "Alternatives:\n") + (dolist (x alternatives) + (insert "\n") + (mh-insert-mime-button x (mh-mime-part-index x) nil)) + (insert "\n----------------------------------------------------\n"))) + (defun mh-mime-display-mixed (handles) "Display the list of MIME parts, HANDLES recursively." (mapcar #'mh-mime-display-part handles)) @@ -904,12 +837,6 @@ (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) (incf (mh-mime-parts-count (mh-buffer-data)))))) -;;; Avoid compiler warnings for XEmacs functions... -(eval-when (compile) - (loop for function in '(glyph-width window-pixel-width - glyph-height window-pixel-height) - do (or (fboundp function) (defalias function 'ignore)))) - (defun mh-small-image-p (handle) "Decide whether HANDLE is a \"small\" image that can be displayed inline. This is only useful if a Content-Disposition header is not present." @@ -922,27 +849,20 @@ ; this only tells us if the image is ; something that emacs can display (let* ((image (mm-get-image handle))) - (cond ((fboundp 'glyph-width) - ;; XEmacs -- totally untested, copied from gnus - (and (mh-funcall-if-exists glyphp image) - (< (glyph-width image) - (or mh-max-inline-image-width - (window-pixel-width))) - (< (glyph-height image) - (or mh-max-inline-image-height - (window-pixel-height))))) - ((fboundp 'image-size) - ;; Emacs21 -- copied from gnus - (let ((size (mh-funcall-if-exists image-size image))) - (and size - (< (cdr size) - (or mh-max-inline-image-height - (1- (window-height)))) - (< (car size) - (or mh-max-inline-image-width (window-width)))))) - (t - ;; Can't show image inline - nil)))))) + (or (mh-do-in-xemacs + (and (mh-funcall-if-exists glyphp image) + (< (glyph-width image) + (or mh-max-inline-image-width (window-pixel-width))) + (< (glyph-height image) + (or mh-max-inline-image-height + (window-pixel-height))))) + (mh-do-in-gnu-emacs + (let ((size (mh-funcall-if-exists image-size image))) + (and size + (< (cdr size) (or mh-max-inline-image-height + (1- (window-height)))) + (< (car size) (or mh-max-inline-image-width + (window-width))))))))))) (defun mh-inline-vcard-p (handle) "Decide if HANDLE is a vcard that must be displayed inline." @@ -1062,7 +982,7 @@ (progn ;; Delete the button and displayed part (if any) (let ((region (get-text-property point 'mh-region))) - (when (and region (fboundp 'remove-images)) + (when region (mh-funcall-if-exists remove-images (car region) (cdr region))) (mm-display-part handle) @@ -1130,33 +1050,14 @@ displayed. This function is called when the mouse is used to click the MIME button." (interactive "e") - (save-excursion - (let* ((event-window - (or (mh-funcall-if-exists posn-window (event-start event));GNU Emacs - (mh-funcall-if-exists event-window event))) ;XEmacs - (event-position - (or (mh-funcall-if-exists posn-point (event-start event)) ;GNU Emacs - (mh-funcall-if-exists event-closest-point event))) ;XEmacs - (original-window (selected-window)) - (original-position (progn - (set-buffer (window-buffer event-window)) - (set-marker (make-marker) (point)))) - (folder mh-show-folder-buffer) - (mm-inline-media-tests mh-mm-inline-media-tests) - (data (get-text-property event-position 'mh-data)) - (function (get-text-property event-position 'mh-callback)) - (buffer-read-only nil)) - (unwind-protect - (progn - (select-window event-window) - (flet ((mm-handle-set-external-undisplayer (handle func) - (mh-handle-set-external-undisplayer folder handle func))) - (goto-char event-position) - (and function (funcall function data)))) - (set-buffer-modified-p nil) - (goto-char original-position) - (set-marker original-position nil) - (select-window original-window))))) + (mh-do-at-event-location event + (let ((folder mh-show-folder-buffer) + (mm-inline-media-tests mh-mm-inline-media-tests) + (data (get-text-property (point) 'mh-data)) + (function (get-text-property (point) 'mh-callback))) + (flet ((mm-handle-set-external-undisplayer (handle func) + (mh-handle-set-external-undisplayer folder handle func))) + (and function (funcall function data)))))) ;;;###mh-autoload (defun mh-mime-save-part () @@ -1164,7 +1065,9 @@ (interactive) (let ((data (get-text-property (point) 'mh-data))) (when data - (let ((mm-default-directory mh-mime-save-parts-directory)) + (let ((mm-default-directory + (file-name-as-directory (or mh-mime-save-parts-directory + default-directory)))) (mh-mm-save-part data) (setq mh-mime-save-parts-directory mm-default-directory)))))
--- a/lisp/mh-e/mh-seq.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-seq.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,6 +1,6 @@ ;;; mh-seq.el --- MH-E sequences support -;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -70,7 +70,8 @@ ;;; Code: -(require 'cl) +(require 'mh-utils) +(mh-require-cl) (require 'mh-e) ;; Shush the byte-compiler @@ -110,7 +111,7 @@ "Table to look up message identifier from message index.") (defvar mh-thread-scan-line-map nil "Map of message index to various parts of the scan line.") -(defvar mh-thread-old-scan-line-map nil +(defvar mh-thread-scan-line-map-stack nil "Old map of message index to various parts of the scan line. This is the original map that is stored when the folder is narrowed.") (defvar mh-thread-subject-container-hash nil @@ -131,7 +132,7 @@ (make-variable-buffer-local 'mh-thread-id-index-map) (make-variable-buffer-local 'mh-thread-index-id-map) (make-variable-buffer-local 'mh-thread-scan-line-map) -(make-variable-buffer-local 'mh-thread-old-scan-line-map) +(make-variable-buffer-local 'mh-thread-scan-line-map-stack) (make-variable-buffer-local 'mh-thread-subject-container-hash) (make-variable-buffer-local 'mh-thread-duplicates) (make-variable-buffer-local 'mh-thread-history) @@ -140,14 +141,19 @@ (defun mh-delete-seq (sequence) "Delete the SEQUENCE." (interactive (list (mh-read-seq-default "Delete" t))) - (let ((msg-list (mh-seq-to-msgs sequence))) + (let ((msg-list (mh-seq-to-msgs sequence)) + (internal-flag (mh-internal-seq sequence)) + (folders-changed (list mh-current-folder))) + (mh-iterate-on-range msg sequence + (mh-remove-sequence-notation msg internal-flag)) (mh-undefine-sequence sequence '("all")) (mh-delete-seq-locally sequence) - (mh-iterate-on-messages-in-region msg (point-min) (point-max) - (cond ((and mh-tick-seq (eq sequence mh-tick-seq)) - (mh-notate-tick msg ())) - ((and (member msg msg-list) (not (mh-seq-containing-msg msg nil))) - (mh-notate nil ? (1+ mh-cmd-note))))))) + (when mh-index-data + (setq folders-changed + (append folders-changed + (mh-index-delete-from-sequence sequence msg-list)))) + (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) + (apply #'mh-speed-flists t folders-changed)))) ;; Avoid compiler warnings (defvar view-exit-action) @@ -221,16 +227,15 @@ (interactive (list (mh-read-seq "Narrow to" t))) (with-mh-folder-updating (t) (cond ((mh-seq-to-msgs sequence) - (mh-widen) (mh-remove-all-notation) (let ((eob (point-max)) (msg-at-cursor (mh-get-msg-num nil))) - (setq mh-thread-old-scan-line-map mh-thread-scan-line-map) + (push mh-thread-scan-line-map mh-thread-scan-line-map-stack) (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) (mh-copy-seq-to-eob sequence) - (narrow-to-region eob (point-max)) - (setq mh-narrowed-to-seq sequence) - (mh-notate-user-sequences) + (push (buffer-substring-no-properties (point-min) eob) + mh-folder-view-stack) + (delete-region (point-min) eob) (mh-notate-deleted-and-refiled) (mh-notate-cur) (when msg-at-cursor (mh-goto-msg msg-at-cursor t t)) @@ -252,29 +257,31 @@ (error "No messages in sequence `%s'" (symbol-name sequence)))))) ;;;###mh-autoload -(defun mh-put-msg-in-seq (msg-or-seq sequence) - "Add MSG-OR-SEQ to SEQUENCE. -Default is the displayed message. -If optional prefix argument is provided, then prompt for the message sequence. -If variable `transient-mark-mode' is non-nil and the mark is active, then the -selected region is added to the sequence. -In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a -region in a cons cell, or a sequence." - (interactive (list (mh-interactive-msg-or-seq "Add messages from") +(defun mh-put-msg-in-seq (range sequence) + "Add RANGE to SEQUENCE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Add messages from") (mh-read-seq-default "Add to" nil))) - (when (and (interactive-p) mh-tick-seq (eq sequence mh-tick-seq)) - (error "Use `mh-toggle-tick' to add messages to %s" mh-tick-seq)) + (unless (mh-valid-seq-p sequence) + (error "Can't put message in invalid sequence `%s'" sequence)) (let* ((internal-seq-flag (mh-internal-seq sequence)) - (note-seq (if internal-seq-flag nil mh-note-seq)) + (original-msgs (mh-seq-msgs (mh-find-seq sequence))) + (folders (list mh-current-folder)) (msg-list ())) - (mh-iterate-on-msg-or-seq m msg-or-seq + (mh-iterate-on-range m range (push m msg-list) - (mh-notate nil note-seq (1+ mh-cmd-note))) + (unless (memq m original-msgs) + (mh-add-sequence-notation m internal-seq-flag))) (mh-add-msgs-to-seq msg-list sequence nil t) (if (not internal-seq-flag) (setq mh-last-seq-used sequence)) + (when mh-index-data + (setq folders + (append folders (mh-index-add-to-sequence sequence msg-list)))) (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) - (mh-speed-flists t mh-current-folder)))) + (apply #'mh-speed-flists t folders)))) (defun mh-valid-view-change-operation-p (op) "Check if the view change operation can be performed. @@ -284,33 +291,46 @@ (t nil))) ;;;###mh-autoload -(defun mh-widen () - "Remove restrictions from current folder, thereby showing all messages." - (interactive) +(defun mh-widen (&optional all-flag) + "Remove last restriction from current folder. +If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning +of the view stack thereby showing all messages that the buffer originally +contained." + (interactive "P") (let ((msg (mh-get-msg-num nil))) - (when mh-narrowed-to-seq - (cond ((mh-valid-view-change-operation-p 'widen) nil) + (when mh-folder-view-stack + (cond (all-flag + (while (cdr mh-view-ops) + (setq mh-view-ops (cdr mh-view-ops))) + (when (eq (car mh-view-ops) 'widen) + (setq mh-view-ops (cdr mh-view-ops)))) + ((mh-valid-view-change-operation-p 'widen) nil) ((memq 'widen mh-view-ops) (while (not (eq (car mh-view-ops) 'widen)) (setq mh-view-ops (cdr mh-view-ops))) - (pop mh-view-ops)) + (setq mh-view-ops (cdr mh-view-ops))) (t (error "Widening is not applicable"))) - (when (memq 'unthread mh-view-ops) - (setq mh-thread-scan-line-map mh-thread-old-scan-line-map)) + ;; If ALL-FLAG is non-nil then rewind stacks + (when all-flag + (while (cdr mh-thread-scan-line-map-stack) + (setq mh-thread-scan-line-map-stack + (cdr mh-thread-scan-line-map-stack))) + (while (cdr mh-folder-view-stack) + (setq mh-folder-view-stack (cdr mh-folder-view-stack)))) + (setq mh-thread-scan-line-map (pop mh-thread-scan-line-map-stack)) (with-mh-folder-updating (t) (delete-region (point-min) (point-max)) - (widen) + (insert (pop mh-folder-view-stack)) + (mh-remove-all-notation) (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation) (mh-make-folder-mode-line)) (if msg (mh-goto-msg msg t t)) - (setq mh-narrowed-to-seq nil) - (setq mh-tick-seq-changed-when-narrowed-flag nil) (mh-notate-deleted-and-refiled) (mh-notate-user-sequences) (mh-notate-cur) (mh-recenter nil))) - (when (and (boundp 'tool-bar-mode) tool-bar-mode) + (when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode) (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map) (when (buffer-live-p (get-buffer mh-show-buffer)) (save-excursion @@ -319,6 +339,7 @@ ;; FIXME? We may want to clear all notations and add one for current-message ;; and process user sequences. +;;;###mh-autoload (defun mh-notate-deleted-and-refiled () "Notate messages marked for deletion or refiling. Messages to be deleted are given by `mh-delete-list' while messages to be @@ -342,13 +363,15 @@ ;;; of the form: ;;; ((seq-name msgs ...) (seq-name msgs ...) ...) +(defvar mh-sequence-history ()) + +;;;###mh-autoload (defun mh-read-seq-default (prompt not-empty) "Read and return sequence name with default narrowed or previous sequence. PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a non-empty sequence is read." (mh-read-seq prompt not-empty - (or mh-narrowed-to-seq - mh-last-seq-used + (or mh-last-seq-used (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) (defun mh-read-seq (prompt not-empty &optional default) @@ -360,7 +383,8 @@ (if default (format "[%s] " default) "")) - (mh-seq-names mh-seq-list))) + (mh-seq-names mh-seq-list) + nil nil nil 'mh-sequence-history)) (seq (cond ((equal input "%") (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) ((equal input "") default) @@ -370,6 +394,126 @@ (error "No messages in sequence `%s'" seq)) seq)) +;;; Functions to read ranges with completion... +(defvar mh-range-seq-names) +(defvar mh-range-history ()) +(defvar mh-range-completion-map (copy-keymap minibuffer-local-completion-map)) +(define-key mh-range-completion-map " " 'self-insert-command) + +(defun mh-range-completion-function (string predicate flag) + "Programmable completion of message ranges. +STRING is the user input that is to be completed. PREDICATE if non-nil is a +function used to filter the possible choices and FLAG determines whether the +completion is over." + (let* ((candidates mh-range-seq-names) + (last-char (and (not (equal string "")) + (aref string (1- (length string))))) + (last-word (cond ((null last-char) "") + ((memq last-char '(? ?- ?:)) "") + (t (car (last (split-string string "[ -:]+")))))) + (prefix (substring string 0 (- (length string) (length last-word))))) + (cond ((eq flag nil) + (let ((res (try-completion last-word candidates predicate))) + (cond ((null res) nil) + ((eq res t) t) + (t (concat prefix res))))) + ((eq flag t) + (all-completions last-word candidates predicate)) + ((eq flag 'lambda) + (loop for x in candidates + when (equal x last-word) return t + finally return nil))))) + +;;;###mh-autoload +(defun mh-read-range (prompt &optional folder default + expand-flag ask-flag number-as-range-flag) + "Read a message range with PROMPT. + +If FOLDER is non-nil then a range is read from that folder, otherwise use +`mh-current-folder'. + +If DEFAULT is a string then use that as default range to return. If DEFAULT is +nil then ask user with default answer a range based on the sequences that seem +relevant. Finally if DEFAULT is t, try to avoid prompting the user. Unseen +messages, if present, are returned. If the folder has fewer than +`mh-large-folder' messages then \"all\" messages are returned. Finally as a +last resort prompt the user. + +If EXPAND-FLAG is non-nil then a list of message numbers corresponding to the +input is returned. If this list is empty then an error is raised. If +EXPAND-FLAG is nil just return the input string. In this case we don't check +if the range is empty. + +If ASK-FLAG is non-nil, then the user is always queried for a range of +messages. If ASK-FLAG is nil, then the function checks if the unseen sequence +is non-empty. If that is the case, `mh-unseen-seq', or the list of messages in +it depending on the value of EXPAND, is returned. Otherwise if the folder has +fewer than `mh-large-folder' messages then the list of messages corresponding +to \"all\" is returned. If neither of the above holds then as a last resort +the user is queried for a range of messages. + +If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as input, it +is interpreted as the range \"last:N\". + +This function replaces the existing function `mh-read-msg-range'. Calls to: + (mh-read-msg-range folder flag) +should be replaced with: + (mh-read-range \"Suitable prompt\" folder t nil flag + mh-interpret-number-as-range-flag)" + (setq default (or default mh-last-seq-used + (car (mh-seq-containing-msg (mh-get-msg-num nil) t))) + prompt (format "%s range" prompt)) + (let* ((folder (or folder mh-current-folder)) + (default (cond ((or (eq default t) (stringp default)) default) + ((symbolp default) (symbol-name default)))) + (guess (eq default t)) + (counts (and guess (mh-folder-size folder))) + (unseen (and counts (> (cadr counts) 0))) + (large (and counts mh-large-folder (> (car counts) mh-large-folder))) + (str (cond ((and guess large + (setq default (format "last:%s" mh-large-folder) + prompt (format "%s (folder has %s messages)" + prompt (car counts))) + nil)) + ((and guess (not large) (setq default "all") nil)) + ((eq default nil) "") + (t (format "[%s] " default)))) + (minibuffer-local-completion-map mh-range-completion-map) + (seq-list (if (eq folder mh-current-folder) + mh-seq-list + (mh-read-folder-sequences folder nil))) + (mh-range-seq-names + (append '(("first") ("last") ("all") ("prev") ("next")) + (mh-seq-names seq-list))) + (input (cond ((and (not ask-flag) unseen) (symbol-name mh-unseen-seq)) + ((and (not ask-flag) (not large)) "all") + (t (completing-read (format "%s: %s" prompt str) + 'mh-range-completion-function nil nil + nil 'mh-range-history default)))) + msg-list) + (when (and number-as-range-flag + (string-match "^[ \t]*\\([0-9]+\\)[ \t]*$" input)) + (setq input (concat "last:" (match-string 1 input)))) + (cond ((not expand-flag) input) + ((assoc (intern input) seq-list) + (cdr (assoc (intern input) seq-list))) + ((setq msg-list (mh-translate-range folder input)) msg-list) + (t (error "No messages in range `%s'" input))))) + +;;;###mh-autoload +(defun mh-translate-range (folder expr) + "In FOLDER, translate the string EXPR to a list of messages numbers." + (save-excursion + (let ((strings (delete "" (split-string expr "[ \t\n]"))) + (result ())) + (ignore-errors + (apply #'mh-exec-cmd-quiet nil "mhpath" folder strings) + (set-buffer mh-temp-buffer) + (goto-char (point-min)) + (while (re-search-forward "/\\([0-9]*\\)$" nil t) + (push (car (read-from-string (match-string 1))) result)) + (nreverse result))))) + (defun mh-seq-names (seq-list) "Return an alist containing the names of the SEQ-LIST." (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry)))) @@ -427,7 +571,7 @@ (defun mh-add-to-sequence (seq msgs) "The sequence SEQ is augmented with the messages in MSGS." ;; Add to a SEQUENCE each message the list of MSGS. - (if (not (mh-folder-name-p seq)) + (if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq))) (if msgs (apply 'mh-exec-cmd "mark" mh-current-folder "-add" "-sequence" (symbol-name seq) @@ -458,17 +602,15 @@ (mh-regenerate-headers coalesced-msgs t) (cond ((memq 'unthread mh-view-ops) ;; Populate restricted scan-line map - (goto-char (point-min)) - (while (not (eobp)) - (let ((msg (mh-get-msg-num nil))) - (when (numberp msg) - (setf (gethash msg mh-thread-scan-line-map) - (mh-thread-parse-scan-line)))) - (forward-line)) + (mh-remove-all-notation) + (mh-iterate-on-range msg (cons (point-min) (point-max)) + (setf (gethash msg mh-thread-scan-line-map) + (mh-thread-parse-scan-line))) ;; Remove scan lines and read results from pre-computed tree (delete-region (point-min) (point-max)) (mh-thread-print-scan-lines - (mh-thread-generate mh-current-folder ()))) + (mh-thread-generate mh-current-folder ())) + (mh-notate-user-sequences)) (mh-index-data (mh-index-insert-folder-headers))))))) @@ -509,32 +651,36 @@ (put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun) ;;;###mh-autoload -(defmacro mh-iterate-on-msg-or-seq (var msg-or-seq &rest body) +(defmacro mh-iterate-on-range (var range &rest body) "Iterate an operation over a region or sequence. -VAR is bound to each message in turn in a loop over MSG-OR-SEQ, which can be a -message number, a list of message numbers, a sequence, or a region in a cons -cell. In each iteration, BODY is executed. +VAR is bound to each message in turn in a loop over RANGE, which can be a +message number, a list of message numbers, a sequence, a region in a cons +cell, or a MH range (something like last:20) in a string. In each iteration, +BODY is executed. -The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq' +The parameter RANGE is usually created with `mh-interactive-range' in order to provide a uniform interface to MH-E functions." (unless (symbolp var) (error "Can not bind the non-symbol %s" var)) (let ((binding-needed-flag var) (msgs (make-symbol "msgs")) (seq-hash-table (make-symbol "seq-hash-table"))) - `(cond ((numberp ,msg-or-seq) - (when (mh-goto-msg ,msg-or-seq t t) - (let ,(if binding-needed-flag `((,var ,msg-or-seq)) ()) + `(cond ((numberp ,range) + (when (mh-goto-msg ,range t t) + (let ,(if binding-needed-flag `((,var ,range)) ()) ,@body))) - ((and (consp ,msg-or-seq) - (numberp (car ,msg-or-seq)) (numberp (cdr ,msg-or-seq))) + ((and (consp ,range) + (numberp (car ,range)) (numberp (cdr ,range))) (mh-iterate-on-messages-in-region ,var - (car ,msg-or-seq) (cdr ,msg-or-seq) + (car ,range) (cdr ,range) ,@body)) - (t (let ((,msgs (if (and ,msg-or-seq (symbolp ,msg-or-seq)) - (mh-seq-to-msgs ,msg-or-seq) - ,msg-or-seq)) + (t (let ((,msgs (cond ((and ,range (symbolp ,range)) + (mh-seq-to-msgs ,range)) + ((stringp ,range) + (mh-translate-range mh-current-folder + ,range)) + (t ,range))) (,seq-hash-table (make-hash-table))) (dolist (msg ,msgs) (setf (gethash msg ,seq-hash-table) t)) @@ -543,38 +689,39 @@ (let ,(if binding-needed-flag `((,var v)) ()) ,@body)))))))) -(put 'mh-iterate-on-msg-or-seq 'lisp-indent-hook 'defun) +(put 'mh-iterate-on-range 'lisp-indent-hook 'defun) ;;;###mh-autoload -(defun mh-msg-or-seq-to-msg-list (msg-or-seq) - "Return a list of messages for MSG-OR-SEQ. -MSG-OR-SEQ can be a message number, a list of message numbers, a sequence, or +(defun mh-range-to-msg-list (range) + "Return a list of messages for RANGE. +RANGE can be a message number, a list of message numbers, a sequence, or a region in a cons cell." (let (msg-list) - (mh-iterate-on-msg-or-seq msg msg-or-seq + (mh-iterate-on-range msg range (push msg msg-list)) (nreverse msg-list))) ;;;###mh-autoload -(defun mh-interactive-msg-or-seq (sequence-prompt) - "Return interactive specification for message, sequence, or region. -By convention, the name of this argument is msg-or-seq. +(defun mh-interactive-range (range-prompt) + "Return interactive specification for message, sequence, range or region. +By convention, the name of this argument is RANGE. If variable `transient-mark-mode' is non-nil and the mark is active, then this function returns a cons-cell of the region. -If optional prefix argument provided, then prompt for message sequence with -SEQUENCE-PROMPT and return sequence. + +If optional prefix argument is provided, then prompt for message range with +RANGE-PROMPT. A list of messages in that range is returned. + +If a MH range is given, say something like last:20, then a list containing +the messages in that range is returned. + Otherwise, the message number at point is returned. -This function is usually used with `mh-iterate-on-msg-or-seq' in order to -provide a uniform interface to MH-E functions." - (cond - ((mh-mark-active-p t) - (cons (region-beginning) (region-end))) - (current-prefix-arg - (mh-read-seq-default sequence-prompt t)) - (t - (mh-get-msg-num t)))) +This function is usually used with `mh-iterate-on-range' in order to provide +a uniform interface to MH-E functions." + (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) + (current-prefix-arg (mh-read-range range-prompt nil nil t t)) + (t (mh-get-msg-num t)))) ;;;###mh-autoload (defun mh-region-to-msg-list (begin end) @@ -591,6 +738,8 @@ ;;; Commands to handle new 'subject sequence. ;;; Or "Poor man's threading" by psg. +;;; XXX: The function mh-subject-to-sequence-unthreaded uses the magic number +;;; 41 for the max size of the subject part. Avoiding this would be desirable. (defun mh-subject-to-sequence (all) "Put all following messages with same subject in sequence 'subject. If arg ALL is t, move to beginning of folder buffer to collect all messages. @@ -601,6 +750,21 @@ nil -> there was no subject line. 0 -> there were no later messages with the same subject (sequence not made) >1 -> the total number of messages including current one." + (if (memq 'unthread mh-view-ops) + (mh-subject-to-sequence-threaded all) + (mh-subject-to-sequence-unthreaded all))) + +(defun mh-subject-to-sequence-unthreaded (all) + "Put all following messages with same subject in sequence 'subject. +This function only works with an unthreaded folder. If arg ALL is t, move to +beginning of folder buffer to collect all messages. If arg ALL is nil, collect +only messages fron current one on forward. + +Return number of messages put in the sequence: + + nil -> there was no subject line. + 0 -> there were no later messages with the same subject (sequence not made) + >1 -> the total number of messages including current one." (if (not (eq major-mode 'mh-folder-mode)) (error "Not in a folder buffer")) (save-excursion @@ -628,8 +792,7 @@ ;; If we created a new sequence, add the initial message to it too. (if (not (member (mh-get-msg-num t) list)) (setq list (cons (mh-get-msg-num t) list))) - (if (member '("subject") (mh-seq-names mh-seq-list)) - (mh-delete-seq 'subject)) + (if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject)) ;; sort the result into a sequence (let ((sorted-list (sort (copy-sequence list) 'mh-lessp))) (while sorted-list @@ -639,6 +802,39 @@ (t 0)))))) +(defun mh-subject-to-sequence-threaded (all) + "Put all messages with the same subject in the 'subject sequence. +This function works when the folder is threaded. In this situation the subject +could get truncated and so the normal matching doesn't work. + +The parameter ALL is non-nil then all the messages in the buffer are +considered, otherwise only the messages after the current one are taken into +account." + (let* ((cur (mh-get-msg-num nil)) + (subject (mh-thread-find-msg-subject cur)) + region msgs) + (if (null subject) + (and (message "No subject line") nil) + (setq region (cons (if all (point-min) (point)) (point-max))) + (mh-iterate-on-range msg region + (when (eq (mh-thread-find-msg-subject msg) subject) + (push msg msgs))) + (setq msgs (sort msgs #'mh-lessp)) + (if (null msgs) + 0 + (when (assoc 'subject mh-seq-list) + (mh-delete-seq 'subject)) + (mh-add-msgs-to-seq msgs 'subject) + (length msgs))))) + +(defun mh-thread-find-msg-subject (msg) + "Find canonicalized subject of MSG. +This function can only be used the folder is threaded." + (ignore-errors + (mh-message-subject + (mh-container-message (gethash (gethash msg mh-thread-index-id-map) + mh-thread-id-table))))) + ;;;###mh-autoload (defun mh-narrow-to-subject () "Narrow to a sequence containing all following messages with same subject." @@ -657,6 +853,99 @@ (if (numberp num) (mh-goto-msg num t t)))))) +(defun mh-read-pick-regexp (default) + "With prefix arg read a pick regexp. +If no prefix arg is given, then return DEFAULT." + (let ((default-string (loop for x in default concat (format " %s" x)))) + (if (or current-prefix-arg (equal default-string "")) + (delete "" (split-string (read-string "Pick regexp: " default-string))) + default))) + +;;;###mh-autoload +(defun mh-narrow-to-from (&optional regexp) + "Limit to messages with the same From header field as the message at point. +With a prefix argument, prompt for the regular expression, REGEXP given to +pick." + (interactive + (list (mh-read-pick-regexp (mh-current-message-header-field 'from)))) + (mh-narrow-to-header-field 'from regexp)) + +;;;###mh-autoload +(defun mh-narrow-to-cc (&optional regexp) + "Limit to messages with the same Cc header field as the message at point. +With a prefix argument, prompt for the regular expression, REGEXP given to +pick." + (interactive + (list (mh-read-pick-regexp (mh-current-message-header-field 'cc)))) + (mh-narrow-to-header-field 'cc regexp)) + +;;;###mh-autoload +(defun mh-narrow-to-to (&optional regexp) + "Limit to messages with the same To header field as the message at point. +With a prefix argument, prompt for the regular expression, REGEXP given to +pick." + (interactive + (list (mh-read-pick-regexp (mh-current-message-header-field 'to)))) + (mh-narrow-to-header-field 'to regexp)) + +(defun mh-narrow-to-header-field (header-field regexp) + "Limit to messages whose HEADER-FIELD match REGEXP. +The MH command pick is used to do the match." + (let ((folder mh-current-folder) + (original (mh-coalesce-msg-list + (mh-range-to-msg-list (cons (point-min) (point-max))))) + (msg-list ())) + (with-temp-buffer + (apply #'mh-exec-cmd-output "pick" nil folder + (append original (list "-list") regexp)) + (goto-char (point-min)) + (while (not (eobp)) + (let ((num (read-from-string + (buffer-substring (point) (line-end-position))))) + (when (numberp (car num)) (push (car num) msg-list)) + (forward-line)))) + (if (null msg-list) + (message "No matches") + (when (assoc 'header mh-seq-list) (mh-delete-seq 'header)) + (mh-add-msgs-to-seq msg-list 'header) + (mh-narrow-to-seq 'header)))) + +(defun mh-current-message-header-field (header-field) + "Return a pick regexp to match HEADER-FIELD of the message at point." + (let ((num (mh-get-msg-num nil))) + (when num + (let ((folder mh-current-folder)) + (with-temp-buffer + (insert-file-contents-literally (mh-msg-filename num folder)) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (narrow-to-region (point-min) (point))) + (let* ((field (or (message-fetch-field (format "%s" header-field)) + "")) + (field-option (format "-%s" header-field)) + (patterns (loop for x in (split-string field "[ ]*,[ ]*") + unless (equal x "") + collect (if (string-match "<\\(.*@.*\\)>" x) + (match-string 1 x) + x)))) + (when patterns + (loop with accum = `(,field-option ,(car patterns)) + for e in (cdr patterns) + do (setq accum `(,field-option ,e "-or" ,@accum)) + finally return accum)))))))) + +;;;###mh-autoload +(defun mh-narrow-to-range (range) + "Limit to messages in RANGE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Narrow to"))) + (when (assoc 'range mh-seq-list) (mh-delete-seq 'range)) + (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range) + (mh-narrow-to-seq 'range)) + + ;;;###mh-autoload (defun mh-delete-subject () "Mark all following messages with same subject to be deleted. @@ -689,28 +978,23 @@ ;;; Message threading: +(defmacro mh-thread-initialize-hash (var test) + "Initialize the hash table in VAR. +TEST is the test to use when creating a new hash table." + (unless (symbolp var) (error "Expected a symbol: %s" var)) + `(if ,var (clrhash ,var) (setq ,var (make-hash-table :test ,test)))) + (defun mh-thread-initialize () - "Make hash tables, otherwise clear them." - (cond - (mh-thread-id-hash - (clrhash mh-thread-id-hash) - (clrhash mh-thread-subject-hash) - (clrhash mh-thread-id-table) - (clrhash mh-thread-id-index-map) - (clrhash mh-thread-index-id-map) - (clrhash mh-thread-scan-line-map) - (clrhash mh-thread-subject-container-hash) - (clrhash mh-thread-duplicates) - (setq mh-thread-history ())) - (t (setq mh-thread-id-hash (make-hash-table :test #'equal)) - (setq mh-thread-subject-hash (make-hash-table :test #'equal)) - (setq mh-thread-id-table (make-hash-table :test #'eq)) - (setq mh-thread-id-index-map (make-hash-table :test #'eq)) - (setq mh-thread-index-id-map (make-hash-table :test #'eql)) - (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) - (setq mh-thread-subject-container-hash (make-hash-table :test #'eq)) - (setq mh-thread-duplicates (make-hash-table :test #'eq)) - (setq mh-thread-history ())))) + "Make new hash tables, or clear them if already present." + (mh-thread-initialize-hash mh-thread-id-hash #'equal) + (mh-thread-initialize-hash mh-thread-subject-hash #'equal) + (mh-thread-initialize-hash mh-thread-id-table #'eq) + (mh-thread-initialize-hash mh-thread-id-index-map #'eq) + (mh-thread-initialize-hash mh-thread-index-id-map #'eql) + (mh-thread-initialize-hash mh-thread-scan-line-map #'eql) + (mh-thread-initialize-hash mh-thread-subject-container-hash #'eq) + (mh-thread-initialize-hash mh-thread-duplicates #'eq) + (setq mh-thread-history ())) (defsubst mh-thread-id-container (id) "Given ID, return the corresponding container in `mh-thread-id-table'. @@ -959,7 +1243,7 @@ (push root results))))) (nreverse results))) -(defsubst mh-thread-process-in-reply-to (reply-to-header) +(defun mh-thread-process-in-reply-to (reply-to-header) "Extract message id's from REPLY-TO-HEADER. Ideally this should have some regexp which will try to guess if a string between < and > is a message id and not an email address. For now it will @@ -1071,6 +1355,7 @@ "Update thread tree for FOLDER. All messages after START-POINT are added to the thread tree." (mh-thread-rewind-pruning) + (mh-remove-all-notation) (goto-char start-point) (let ((msg-list ())) (while (not (eobp)) @@ -1085,7 +1370,6 @@ (old-buffer-modified-flag (buffer-modified-p))) (delete-region (point-min) (point-max)) (mh-thread-print-scan-lines thread-tree) - (mh-notate-user-sequences) (mh-notate-deleted-and-refiled) (mh-notate-cur) (set-buffer-modified-p old-buffer-modified-flag)))) @@ -1150,18 +1434,30 @@ (let* ((string (or string (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - (first-string (substring string 0 (+ mh-cmd-note 8)))) - (setf (elt first-string mh-cmd-note) ? ) - (when (equal (elt first-string (1+ mh-cmd-note)) (elt mh-note-seq 0)) - (setf (elt first-string (1+ mh-cmd-note)) ? )) + (address-start (+ mh-cmd-note mh-scan-field-from-start-offset)) + (body-start (+ mh-cmd-note mh-scan-field-from-end-offset)) + (first-string (substring string 0 address-start))) (list first-string - (substring string - (+ mh-cmd-note mh-scan-field-from-start-offset) - (+ mh-cmd-note mh-scan-field-from-end-offset -2)) - (substring string (+ mh-cmd-note mh-scan-field-from-end-offset)) + (substring string address-start (- body-start 2)) + (substring string body-start) string))) ;;;###mh-autoload +(defun mh-thread-update-scan-line-map (msg notation offset) + "In threaded view update `mh-thread-scan-line-map'. +MSG is the message being notated with NOTATION at OFFSET." + (let* ((msg (or msg (mh-get-msg-num nil))) + (cur-scan-line (and mh-thread-scan-line-map + (gethash msg mh-thread-scan-line-map))) + (old-scan-lines (loop for map in mh-thread-scan-line-map-stack + collect (and map (gethash msg map)))) + (notation (if (stringp notation) (aref notation 0) notation))) + (when cur-scan-line + (setf (aref (car cur-scan-line) offset) notation)) + (dolist (line old-scan-lines) + (when line (setf (aref (car line) offset) notation))))) + +;;;###mh-autoload (defun mh-thread-add-spaces (count) "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." (let ((spaces (format (format "%%%ss" count) ""))) @@ -1197,14 +1493,11 @@ (message "Threading %s..." (buffer-name)) (mh-thread-initialize) (goto-char (point-min)) + (mh-remove-all-notation) (let ((msg-list ())) - (while (not (eobp)) - (let ((index (mh-get-msg-num nil))) - (when (numberp index) - (push index msg-list) - (setf (gethash index mh-thread-scan-line-map) - (mh-thread-parse-scan-line)))) - (forward-line)) + (mh-iterate-on-range msg (cons (point-min) (point-max)) + (setf (gethash msg mh-thread-scan-line-map) (mh-thread-parse-scan-line)) + (push msg msg-list)) (let* ((range (mh-coalesce-msg-list msg-list)) (thread-tree (mh-thread-generate (buffer-name) range))) (delete-region (point-min) (point-max)) @@ -1403,68 +1696,31 @@ ;; Tick mark handling -;; Functions to highlight and unhighlight ticked messages. -(defun mh-tick-add-overlay () - "Add tick overlay to current line." - (with-mh-folder-updating (t) - (let ((overlay - (or (mh-funcall-if-exists make-overlay (point) (line-end-position)) - (mh-funcall-if-exists make-extent (point) (line-end-position))))) - (or (mh-funcall-if-exists overlay-put overlay 'face 'mh-folder-tick-face) - (mh-funcall-if-exists set-extent-face overlay 'mh-folder-tick-face)) - (mh-funcall-if-exists set-extent-priority overlay 10) - (add-text-properties (point) (line-end-position) `(mh-tick ,overlay))))) - -(defun mh-tick-remove-overlay () - "Remove tick overlay from current line." - (let ((overlay (get-text-property (point) 'mh-tick))) - (when overlay - (with-mh-folder-updating (t) - (or (mh-funcall-if-exists delete-overlay overlay) - (mh-funcall-if-exists delete-extent overlay)) - (remove-text-properties (point) (line-end-position) `(mh-tick nil)))))) - ;;;###mh-autoload -(defun mh-notate-tick (msg ticked-msgs &optional ignore-narrowing) - "Highlight current line if MSG is in TICKED-MSGS. -If optional argument IGNORE-NARROWING is non-nil then highlighting is carried -out even if folder is narrowed to `mh-tick-seq'." - (when mh-tick-seq - (let ((narrowed-to-tick (and (not ignore-narrowing) - (eq mh-narrowed-to-seq mh-tick-seq))) - (overlay (get-text-property (point) 'mh-tick)) - (in-tick (member msg ticked-msgs))) - (cond (narrowed-to-tick (mh-tick-remove-overlay)) - ((and (not overlay) in-tick) (mh-tick-add-overlay)) - ((and overlay (not in-tick)) (mh-tick-remove-overlay)))))) - -;; Interactive function to toggle tick. -;;;###mh-autoload -(defun mh-toggle-tick (begin end) - "Toggle tick mark of all messages in region BEGIN to END." - (interactive (cond ((mh-mark-active-p t) - (list (region-beginning) (region-end))) - (t (list (line-beginning-position) (line-end-position))))) +(defun mh-toggle-tick (range) + "Toggle tick mark of all messages in RANGE." + (interactive (list (mh-interactive-range "Tick"))) (unless mh-tick-seq (error "Enable ticking by customizing `mh-tick-seq'")) (let* ((tick-seq (mh-find-seq mh-tick-seq)) - (tick-seq-msgs (mh-seq-msgs tick-seq))) - (mh-iterate-on-messages-in-region msg begin end + (tick-seq-msgs (mh-seq-msgs tick-seq)) + (ticked ()) + (unticked ())) + (mh-iterate-on-range msg range (cond ((member msg tick-seq-msgs) - (mh-undefine-sequence mh-tick-seq (list msg)) + (push msg unticked) (setcdr tick-seq (delq msg (cdr tick-seq))) (when (null (cdr tick-seq)) (setq mh-last-seq-used nil)) - (mh-tick-remove-overlay)) + (mh-remove-sequence-notation msg t)) (t - (mh-add-msgs-to-seq (list msg) mh-tick-seq nil t) + (push msg ticked) (setq mh-last-seq-used mh-tick-seq) - (mh-tick-add-overlay)))) - (when (and (eq mh-tick-seq mh-narrowed-to-seq) - (not mh-tick-seq-changed-when-narrowed-flag)) - (setq mh-tick-seq-changed-when-narrowed-flag t) - (let ((ticked-msgs (mh-seq-msgs (mh-find-seq mh-tick-seq)))) - (mh-iterate-on-messages-in-region msg (point-min) (point-max) - (mh-notate-tick msg ticked-msgs t)))))) + (mh-add-sequence-notation msg t)))) + (mh-add-msgs-to-seq ticked mh-tick-seq nil t) + (mh-undefine-sequence mh-tick-seq unticked) + (when mh-index-data + (mh-index-add-to-sequence mh-tick-seq ticked) + (mh-index-delete-from-sequence mh-tick-seq unticked)))) ;;;###mh-autoload (defun mh-narrow-to-tick ()
--- a/lisp/mh-e/mh-speed.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-speed.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,6 +1,6 @@ ;;; mh-speed.el --- Speedbar interface for MH-E. -;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -34,7 +34,8 @@ ;;; Code: ;; Requires -(require 'cl) +(require 'mh-utils) +(mh-require-cl) (require 'mh-e) (require 'speedbar) @@ -340,7 +341,9 @@ (interactive) (declare (ignore args)) (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) - (range (and (stringp folder) (mh-read-msg-range folder)))) + (range (and (stringp folder) + (mh-read-range "Scan" folder t nil nil + mh-interpret-number-as-range-flag)))) (when (stringp folder) (speedbar-with-attached-buffer (mh-visit-folder folder range) @@ -350,9 +353,11 @@ (defvar mh-speed-flists-folder nil) ;;;###mh-autoload -(defun mh-speed-flists (force &optional folder) +(defun mh-speed-flists (force &rest folders) "Execute flists -recurse and update message counts. -If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run +If FORCE is non-nil the timer is reset. + +Any number of optional FOLDERS can be specified. If specified, flists is run only for that one folder." (interactive (list t)) (when force @@ -365,7 +370,7 @@ (kill-process mh-speed-flists-process) (setq mh-speed-partial-line "") (setq mh-speed-flists-process nil))) - (setq mh-speed-flists-folder folder) + (setq mh-speed-flists-folder folders) (unless mh-speed-flists-timer (setq mh-speed-flists-timer (run-at-time @@ -376,17 +381,19 @@ 'exit))) (setq mh-speed-current-folder (concat - (with-temp-buffer - (call-process (expand-file-name "folder" mh-progs) - nil '(t nil) nil "-fast") - (buffer-substring (point-min) (1- (point-max)))) + (if mh-speed-flists-folder + (substring (car (reverse mh-speed-flists-folder)) 1) + (with-temp-buffer + (call-process (expand-file-name "folder" mh-progs) + nil '(t nil) nil "-fast") + (buffer-substring (point-min) (1- (point-max))))) "+")) (setq mh-speed-flists-process - (start-process "*flists*" nil - (expand-file-name "flists" mh-progs) - (or mh-speed-flists-folder "-recurse") - (if mh-speed-flists-folder "-noall" "-all") - "-sequence" (symbol-name mh-unseen-seq))) + (apply #'start-process "*flists*" nil + (expand-file-name "flists" mh-progs) + (if mh-speed-flists-folder "-noall" "-all") + "-sequence" (symbol-name mh-unseen-seq) + (or mh-speed-flists-folder '("-recurse")))) ;; Run flists on all folders the next time around... (setq mh-speed-flists-folder nil) (set-process-filter mh-speed-flists-process
--- a/lisp/mh-e/mh-utils.el Tue Jul 13 01:32:18 2004 +0000 +++ b/lisp/mh-e/mh-utils.el Tue Jul 13 03:06:25 2004 +0000 @@ -1,7 +1,7 @@ ;;; mh-utils.el --- MH-E code needed for both sending and reading ;; Copyright (C) 1993, 95, 1997, -;; 2000, 01, 02, 2003 Free Software Foundation, Inc. +;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -37,14 +37,28 @@ (defvar mh-xemacs-flag (featurep 'xemacs) "Non-nil means the current Emacs is XEmacs.") -(require 'cl) +;; The Emacs coding conventions require that the cl package not be required at +;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl +;; routines in their macro expansions. Use mh-require-cl to provide the cl +;; routines in the best way possible. +(eval-when-compile (require 'cl)) +(defmacro mh-require-cl () + (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) + `(require 'cl) + `(eval-when-compile (require 'cl)))) + +(mh-require-cl) (require 'gnus-util) (require 'font-lock) +(require 'mouse) +(load "tool-bar" t t) (require 'mh-loaddefs) (require 'mh-customize) +(require 'mh-inc) (load "mm-decode" t t) ; Non-fatal dependency (load "mm-view" t t) ; Non-fatal dependency +(load "hl-line" t t) ; Non-fatal dependency (load "executable" t t) ; Non-fatal dependency on ; executable-find @@ -52,7 +66,6 @@ (defvar font-lock-auto-fontify) (defvar font-lock-defaults) (defvar mark-active) -(defvar tool-bar-mode) ;;; Autoloads (autoload 'gnus-article-highlight-citation "gnus-cite") @@ -81,6 +94,9 @@ (defvar mh-nmh-flag nil "Non-nil means nmh is installed on this system instead of MH.") +(defvar mh-flists-present-flag nil + "Non-nil means that we have `flists'.") + ;;;###autoload (put 'mh-progs 'risky-local-variable t) ;;;###autoload @@ -311,7 +327,7 @@ ;; Copy of `goto-address-mail-regexp' (defvar mh-address-mail-regexp - "[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+" + "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" "A regular expression probably matching an e-mail address.") ;; From goto-addr.el, which we don't want to force-load on users. @@ -435,6 +451,10 @@ (4 font-lock-comment-face nil t))))))) "Additional expressions to highlight in MH-show mode.") +(defvar mh-letter-font-lock-keywords + `(,@mh-show-font-lock-keywords-with-cite + (mh-font-lock-field-data (1 'mh-letter-header-field-face prepend t)))) + (defun mh-show-font-lock-fontify-region (beg end loudly) "Limit font-lock in `mh-show-mode' to the header. Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be @@ -632,6 +652,39 @@ (put 'mh-in-show-buffer 'lisp-indent-hook 'defun) +(defmacro mh-do-at-event-location (event &rest body) + "Switch to the location of EVENT and execute BODY. +After BODY has been executed return to original window. The modification flag +of the buffer in the event window is preserved." + (let ((event-window (make-symbol "event-window")) + (event-position (make-symbol "event-position")) + (original-window (make-symbol "original-window")) + (original-position (make-symbol "original-position")) + (modified-flag (make-symbol "modified-flag"))) + `(save-excursion + (let* ((,event-window + (or (mh-funcall-if-exists posn-window (event-start ,event)) + (mh-funcall-if-exists event-window ,event))) + (,event-position + (or (mh-funcall-if-exists posn-point (event-start ,event)) + (mh-funcall-if-exists event-closest-point ,event))) + (,original-window (selected-window)) + (,original-position (progn + (set-buffer (window-buffer ,event-window)) + (set-marker (make-marker) (point)))) + (,modified-flag (buffer-modified-p)) + (buffer-read-only nil)) + (unwind-protect (progn + (select-window ,event-window) + (goto-char ,event-position) + ,@body) + (set-buffer-modified-p ,modified-flag) + (goto-char ,original-position) + (set-marker ,original-position nil) + (select-window ,original-window)))))) + +(put 'mh-do-at-event-location 'lisp-indent-hook 'defun) + (defmacro mh-make-seq (name msgs) "Create sequence NAME with the given MSGS." (list 'cons name msgs)) @@ -761,6 +814,8 @@ (prog1 (call-interactively (function ,original-function)) (setq normal-exit t)) (mh-funcall-if-exists deactivate-mark) + (when (eq major-mode 'mh-folder-mode) + (mh-funcall-if-exists hl-line-highlight)) (cond ((not normal-exit) (set-window-configuration config)) ,(if dont-return @@ -823,8 +878,11 @@ (mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq) (mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) (mh-defun-show-buffer mh-show-widen mh-widen) -(mh-defun-show-buffer mh-show-narrow-to-subject - mh-narrow-to-subject) +(mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject) +(mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from) +(mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc) +(mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range) +(mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to) (mh-defun-show-buffer mh-show-store-msg mh-store-msg) (mh-defun-show-buffer mh-show-page-digest mh-page-digest) (mh-defun-show-buffer mh-show-page-digest-backwards @@ -854,6 +912,9 @@ (mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist) (mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) (mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) +(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) +(mh-defun-show-buffer mh-show-index-sequenced-messages + mh-index-sequenced-messages) ;;; Populate mh-show-mode-map (gnus-define-keys mh-show-mode-map @@ -898,6 +959,7 @@ (gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) "?" mh-prefix-help + "'" mh-index-ticked-messages "S" mh-show-sort-folder "f" mh-show-visit-folder "i" mh-index-search @@ -905,6 +967,7 @@ "l" mh-show-list-folders "n" mh-index-new-messages "o" mh-show-visit-folder + "q" mh-show-index-sequenced-messages "r" mh-show-rescan-folder "s" mh-show-search-folder "t" mh-show-toggle-threads @@ -912,6 +975,7 @@ "v" mh-show-visit-folder) (gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map) + "'" mh-show-narrow-to-tick "?" mh-prefix-help "d" mh-show-delete-msg-from-seq "k" mh-show-delete-seq @@ -940,7 +1004,11 @@ (gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) "'" mh-show-narrow-to-tick "?" mh-prefix-help + "c" mh-show-narrow-to-cc + "f" mh-show-narrow-to-from + "r" mh-show-narrow-to-range "s" mh-show-narrow-to-subject + "t" mh-show-narrow-to-to "w" mh-show-widen) (gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map) @@ -1039,8 +1107,10 @@ ;;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-show-mode 'mode-class 'special) -;; Avoid compiler warning -(defvar tool-bar-map) +;; Avoid compiler warnings in XEmacs and Emacs 20 +(eval-when-compile + (defvar tool-bar-mode) + (defvar tool-bar-map)) (define-derived-mode mh-show-mode text-mode "MH-Show" "Major mode for showing messages in MH-E.\\<mh-show-mode-map> @@ -1051,6 +1121,8 @@ (mh-show-unquote-From) (mh-show-xface) (mh-show-addr) + (setq buffer-invisibility-spec '((vanish . t) t)) + (set (make-local-variable 'line-move-ignore-invisible) t) (make-local-variable 'font-lock-defaults) ;;(set (make-local-variable 'font-lock-support-mode) nil) (cond @@ -1067,8 +1139,7 @@ (if (and mh-xemacs-flag font-lock-auto-fontify) (turn-on-font-lock)) - (if (and (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)) + (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map) (mh-funcall-if-exists mh-toolbar-init :show) (when mh-decode-mime-flag (mh-make-local-hook 'kill-buffer-hook) @@ -1318,8 +1389,8 @@ (defun mh-show (&optional message) "Show message at cursor. If optional argument MESSAGE is non-nil, display that message instead. -Force a two-window display with the folder window on top (size -`mh-summary-height') and the show buffer below it. +Force a two-window display with the folder window on top (size given by the +variable `mh-summary-height') and the show buffer below it. If the message is already visible, display the start of the message. Display of the message is controlled by setting the variables @@ -1338,6 +1409,14 @@ (mouse-set-point EVENT) (mh-show)) +(defun mh-summary-height () + "Return ideal value for the variable `mh-summary-height'. +The current frame height is taken into consideration." + (or (and (fboundp 'frame-height) + (> (frame-height) 24) + (min 10 (/ (frame-height) 6))) + 4)) + (defun mh-show-msg (msg) "Show MSG. The value of `mh-show-hook' is a list of functions to be called, with no @@ -1347,6 +1426,7 @@ (mh-showing-mode t) (setq mh-page-to-next-msg-flag nil) (let ((folder mh-current-folder) + (folders (list mh-current-folder)) (clean-message-header mh-clean-message-header-flag) (show-window (get-buffer-window mh-show-buffer))) (if (not (eq (next-window (minibuffer-window)) (selected-window))) @@ -1358,22 +1438,29 @@ (goto-char (point-min)) (if (not clean-message-header) (mh-start-of-uncleaned-message))) - (mh-display-msg msg folder)))) - (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split - (shrink-window (- (window-height) mh-summary-height))) - (mh-recenter nil) - (if (not (memq msg mh-seen-list)) - (setq mh-seen-list (cons msg mh-seen-list))) - (when mh-update-sequences-after-mh-show-flag - (if mh-index-data (mh-index-update-unseen msg)) - (mh-update-sequences)) - (run-hooks 'mh-show-hook)) + (mh-display-msg msg folder))) + (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split + (shrink-window (- (window-height) (or mh-summary-height + (mh-summary-height))))) + (mh-recenter nil) + (if (not (memq msg mh-seen-list)) + (setq mh-seen-list (cons msg mh-seen-list))) + (when mh-update-sequences-after-mh-show-flag + (mh-update-sequences) + (when mh-index-data + (setq folders + (append (mh-index-delete-from-sequence mh-unseen-seq (list msg)) + folders))) + (when (mh-speed-flists-active-p) + (apply #'mh-speed-flists t folders))) + (run-hooks 'mh-show-hook))) (defun mh-modify (&optional message) "Edit message at cursor. If optional argument MESSAGE is non-nil, edit that message instead. -Force a two-window display with the folder window on top (size -`mh-summary-height') and the message editing buffer below it. +Force a two-window display with the folder window on top (size given by the +value of the variable `mh-summary-height') and the message editing buffer below +it. The message is displayed in raw form." (interactive) @@ -1533,8 +1620,10 @@ (beginning-of-line) (mh-delete-line 1) (while (looking-at "[ \t]") - (mh-delete-line 1)))) - (unlock-buffer)))) + (mh-delete-line 1))))) + (let ((mh-compose-skipped-header-fields ())) + (mh-letter-hide-all-skipped-fields)) + (unlock-buffer))) (defun mh-delete-line (lines) "Delete the next LINES lines." @@ -1550,9 +1639,26 @@ (with-mh-folder-updating (t) (beginning-of-line) (forward-char offset) - (let ((notation (or notation (char-after)))) - (delete-char 1) - (insert notation)))))) + (let* ((change-stack-flag (and (stringp notation) + (equal offset (1+ mh-cmd-note)) + (not (eq notation mh-note-seq)))) + (msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) + (stack (and msg (gethash msg mh-sequence-notation-history))) + (notation (or notation (char-after)))) + (if stack + ;; The presence of the stack tells us that we don't need to + ;; notate the message, since the notation would be replaced + ;; by a sequence notation. So we will just put the notation + ;; at the bottom of the stack. If the sequence is deleted, + ;; the correct notation will be shown. + (setf (gethash msg mh-sequence-notation-history) + (reverse (cons (aref notation 0) (cdr (reverse stack))))) + ;; Since we don't have any sequence notations in the way, just + ;; notate the scan line. + (delete-char 1) + (insert notation)) + (when change-stack-flag + (mh-thread-update-scan-line-map msg notation offset))))))) (defun mh-find-msg-get-num (step) "Return the message number of the message nearest the cursor. @@ -1666,7 +1772,8 @@ (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) (if mh-previous-seq (setq mh-previous-seq (intern mh-previous-seq))) - (run-hooks 'mh-find-path-hook)))) + (run-hooks 'mh-find-path-hook) + (mh-collect-folder-names)))) (defun mh-file-command-p (file) "Return t if file FILE is the name of a executable regular file." @@ -1710,7 +1817,9 @@ mh-nmh-flag t))) (kill-buffer tmp-buffer)))) (unless (and mh-progs mh-lib mh-lib-progs) - (error "Unable to determine paths from `mhparam' command"))))) + (error "Unable to determine paths from `mhparam' command")) + (setq mh-flists-present-flag + (file-exists-p (expand-file-name "flists" mh-progs)))))) (defun mh-path-search (path file) "Search PATH, a list of directory names, for FILE. @@ -1799,18 +1908,21 @@ If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are not updated." - (let ((entry (mh-find-seq seq))) + (let ((entry (mh-find-seq seq)) + (internal-seq-flag (mh-internal-seq seq))) (if (and msgs (atom msgs)) (setq msgs (list msgs))) + (unless internal-flag + (mh-add-to-sequence seq msgs) + (when (not dont-annotate-flag) + (mh-iterate-on-range msg msgs + (unless (memq msg (cdr entry)) + (mh-add-sequence-notation msg internal-seq-flag))))) (if (null entry) (setq mh-seq-list (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) mh-seq-list)) (if msgs (setcdr entry (mh-canonicalize-sequence - (append msgs (mh-seq-msgs entry)))))) - (cond ((not internal-flag) - (mh-add-to-sequence seq msgs) - (unless dont-annotate-flag - (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))) + (append msgs (mh-seq-msgs entry)))))))) (defun mh-canonicalize-sequence (msgs) "Sort MSGS in decreasing order and remove duplicates." @@ -1824,6 +1936,54 @@ (defvar mh-sub-folders-cache (make-hash-table :test #'equal)) (defvar mh-current-folder-name nil) +(defvar mh-flists-partial-line "") +(defvar mh-flists-process nil) + +;; Initialize mh-sub-folders-cache... +(defun mh-collect-folder-names () + "Collect folder names by running `flists'." + (unless mh-flists-process + (setq mh-flists-process + (mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter + "-recurse" "-fast")))) + +(defun mh-collect-folder-names-filter (process output) + "Read folder names. +PROCESS is the flists process that was run to collect folder names and the +function is called when OUTPUT is available." + (let ((position 0) + (prevailing-match-data (match-data)) + line-end folder) + (unwind-protect + (while (setq line-end (string-match "\n" output position)) + (setq folder (format "+%s%s" + mh-flists-partial-line + (substring output position line-end))) + (setq mh-flists-partial-line "") + (unless (equal (aref folder 1) ?.) + (mh-populate-sub-folders-cache folder)) + (setq position (1+ line-end))) + (set-match-data prevailing-match-data)) + (setq mh-flists-partial-line (substring output position)))) + +(defun mh-populate-sub-folders-cache (folder) + "Tell `mh-sub-folders-cache' about FOLDER." + (let* ((last-slash (mh-search-from-end ?/ folder)) + (child1 (substring folder (1+ (or last-slash 0)))) + (parent (and last-slash (substring folder 0 last-slash))) + (parent-slash (and parent (mh-search-from-end ?/ parent))) + (child2 (and parent (substring parent (1+ (or parent-slash 0))))) + (grand-parent (and parent-slash (substring parent 0 parent-slash))) + (cache-entry (gethash parent mh-sub-folders-cache))) + (unless (loop for x in cache-entry when (equal (car x) child1) return t + finally return nil) + (push (list child1) cache-entry) + (setf (gethash parent mh-sub-folders-cache) + (sort cache-entry (lambda (x y) (string< (car x) (car y))))) + (when parent + (loop for x in (gethash grand-parent mh-sub-folders-cache) + when (equal (car x) child2) + do (progn (setf (cdr x) t) (return))))))) (defun mh-normalize-folder-name (folder &optional empty-string-okay dont-remove-trailing-slash) @@ -1979,9 +2139,12 @@ (defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) (define-key mh-folder-completion-map " " 'minibuffer-complete) +(defvar mh-speed-flists-inhibit-flag nil) + (defun mh-speed-flists-active-p () "Check if speedbar is running with message counts enabled." (and (featurep 'mh-speed) + (not mh-speed-flists-inhibit-flag) (> (hash-table-count mh-speed-flists-cache) 0))) (defun mh-folder-completion-function (name predicate flag) @@ -2119,14 +2282,19 @@ The output is not read or parsed by MH-E." (save-excursion (set-buffer (get-buffer-create mh-log-buffer)) - (let ((initial-size (mh-truncate-log-buffer))) - (apply 'call-process - (expand-file-name command mh-progs) nil t nil - (mh-list-to-string args)) - (if (> (buffer-size) initial-size) - (save-window-excursion - (switch-to-buffer-other-window mh-log-buffer) - (sit-for 5)))))) + (let* ((initial-size (mh-truncate-log-buffer)) + (start (point)) + (args (mh-list-to-string args))) + (apply 'call-process (expand-file-name command mh-progs) nil t nil args) + (when (> (buffer-size) initial-size) + (save-excursion + (goto-char start) + (insert "Errors when executing: " command) + (loop for arg in args do (insert " " arg)) + (insert "\n")) + (save-window-excursion + (switch-to-buffer-other-window mh-log-buffer) + (sit-for 5)))))) (defun mh-exec-cmd-error (env command &rest args) "In environment ENV, execute mh-command COMMAND with ARGS. @@ -2161,7 +2329,8 @@ command nil (expand-file-name command mh-progs) (mh-list-to-string args)))) - (set-process-filter process (or filter 'mh-process-daemon)))) + (set-process-filter process (or filter 'mh-process-daemon)) + process)) (defun mh-exec-cmd-env-daemon (env command filter &rest args) "In ennvironment ENV, execute mh-command COMMAND in the background. @@ -2283,6 +2452,23 @@ (setq l (cdr l))) new-list)) +(defun mh-replace-in-string (regexp newtext string) + "Replace REGEXP with NEWTEXT everywhere in STRING and return result. +NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. + +The function body was copied from `dired-replace-in-string' in dired.el. +Emacs21 has `replace-regexp-in-string' while XEmacs has `replace-in-string'. +Neither is present in Emacs20. The file gnus-util.el in Gnus 5.10.1 and above +has `gnus-replace-in-string'. We should use that when we decide to not support +older versions of Gnus." + (let ((result "") (start 0) mb me) + (while (string-match regexp string start) + (setq mb (match-beginning 0) + me (match-end 0) + result (concat result (substring string start mb) newtext) + start me)) + (concat result (substring string start)))) + (provide 'mh-utils) ;;; Local Variables:
--- a/lisp/mh-e/mh-xemacs-compat.el Tue Jul 13 01:32:18 2004 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,99 +0,0 @@ -;;; mh-xemacs-compat.el --- GNU Emacs Functions needed by XEmacs - -;; Copyright (C) 2001, 02, 2003 Free Software Foundation, Inc. - -;; Author: FSF -;; Maintainer: Bill Wohler <wohler@newt.com> -;; Keywords: mail -;; See: mh-e.el - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Change Log: - -;;; Code: - -;;; Some requires: -(require 'rfc822) - -(eval-when-compile (require 'mh-utils)) - -;;; Simple compatibility: - -(unless (fboundp 'match-string-no-properties) - (defsubst match-string-no-properties (match) - (buffer-substring-no-properties - (match-beginning match) (match-end match)))) - -(unless (fboundp 'line-beginning-position) - (defalias 'line-beginning-position 'point-at-bol)) -(unless (fboundp 'line-end-position) - (defalias 'line-end-position 'point-at-eol)) - -(unless (fboundp 'timerp) - (defalias 'timerp 'itimerp)) -(unless (fboundp 'cancel-timer) - (defalias 'cancel-timer 'delete-itimer)) - -;; Set up the modeline glyph -(defconst mh-modeline-logo - "/* XPM */ -static char * file[] = { -\"18 13 2 1\", -\"# c #666699\", -\". c None s None\", -\"........##........\", -\".......####.......\", -\"......######......\", -\"......######......\", -\"....#########.....\", -\"..##############..\", -\".##...######....#.\", -\"##...#.#.####...#.\", -\"....#..#.##.#...#.\", -\"...#..##.#.#.#....\", -\"...#..#..#..#.#...\", -\"...#..#.##..#.##..\", -\"...#..#.#..#....#.\"};" - "The image for the modeline logo.") - -(mh-do-in-xemacs - (defvar mh-modeline-glyph - (progn - (let* ((data mh-modeline-logo) - (glyph (make-glyph - (cond ((and (featurep 'xpm) - (device-on-window-system-p) - has-modeline-p) - `[xpm :data ,data]) - (t [string :data "MH-E"]))))) - (set-glyph-face glyph 'modeline-buffer-id) - glyph)) - "Cute little logo to put in the modeline of MH-E buffers.")) - -(provide 'mh-xemacs-compat) - -;;; Local Variables: -;;; indent-tabs-mode: nil -;;; sentence-end-double-space: nil -;;; End: - -;;; arch-tag: f531e3cc-98ba-4f9f-b6a1-e282173a6aa9 -;;; mh-xemacs-compat.el ends here
--- a/lisp/mh-e/mh-xemacs-icons.el Tue Jul 13 01:32:18 2004 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1307 +0,0 @@ -;;; mh-xemacs-icons.el --- icons for the MH-E toolbars under XEmacs -;; -;; Copyright (C) 2003 Free Software Foundation, Inc. - -;; Author: Various (See below) -;; Maintainer: Bill Wohler <wohler@newt.com> -;; Keywords: mail toolbar -;; See: mh-e.el - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file contains the toolbar icons that MH-E uses under XEmacs. Some -;; icons were created for MH-E and others were copied from other Emacs modes. -;; The XPM files are copied into defconst's and the background colour is -;; changed. - -;; The alist `mh-xemacs-icon-map' contains a map of the icon file names under -;; GNU Emacs to the constant name under XEmacs. To add new icons for XEmacs -;; this variable should be updated as well. - -;;; Change Log: - -;;; Code: - -;; Avoid compiler warning -(eval-and-compile - (require 'mh-utils) - (defvar mh-xemacs-toolbar-folder-toolbar nil) - (defvar mh-xemacs-toolbar-letter-toolbar nil)) - - - -;; Define the toolbar icons. - -;; Derived From lisp/toolbar/mail.xpm -(defconst mh-xemacs-toolbar-inc-folder-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 5 1\", -\" c Gray0\", -\". c #673e666663d4\", -\"X c #a852a7bea3d2\", -\"o c #eb46ea1de471\", -\"O c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOO OOOOOO\", -\"OOOOOOOOO .ooX OOOOO\", -\"OOOO .XooooooX OOOOO\", -\"OOO .Xoooooooooo.XX OOOO\", -\"OOO o..ooooooooX.Xo OOOO\", -\"OOO XoX..oooooo.Xoo OOOO\", -\"OOOO oooXX.Xoo...ooX OOO\", -\"OOOO oooooXX..XoX.Xo OOO\", -\"OOOO Xoooo.ooooooo.X OOO\", -\"OOOOO oooXXoooooooo.X OO\", -\"OOOOO ooo.oooooooooX OO\", -\"OOOOO XoXXooooooX OOOO\", -\"OOOOOO o.ooooX OOOOOOO\", -\"OOOOOO .XoX OOOOOOOOOO\", -\"OOOOOO .. OOOOOOOOOOOOO\", -\"OOOOOOO OOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\"};") - "*MH inc folder icon.") - -;; Derived from lisp/toolbar/attach.pbm -(defconst mh-xemacs-toolbar-mime-save-parts-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"24 24 2 1\", -\". c Gray75 s backgroundToolBarColor\", -\" c black\", -/* pixels */ -\"........................\", -\"........................\", -\"........................\", -\"........... ...........\", -\".......... .. ..........\", -\"......... .... .........\", -\"......... .... .........\", -\"......... .... .........\", -\"......... . .. .........\", -\"......... . .. .........\", -\"......... . .. . .......\", -\"......... . .. . .......\", -\"......... . .. . .......\", -\"......... . .. . .......\", -\"......... . .. . .......\", -\"......... . .. . .......\", -\"......... . .. . .......\", -\"......... .. .. .......\", -\".......... .... ........\", -\"........... .. .........\", -\"............ ..........\", -\"........................\", -\"........................\", -\"........................\"};") - "*MH save MIME parts icon.") - -;; Derived from lisp/toolbar/right_arrow.xpm -(defconst mh-xemacs-toolbar-next-undeleted-msg-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * right_arrow_xpm[] = { -\"24 24 9 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c #020202\", -\"+ c #1A1A1A\", -\"@ c #779D6D\", -\"# c #88AE80\", -\"$ c #97B78B\", -\"% c #9EBA92\", -\"& c #E9EFE8\", -\"* c #3C5936\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" .. \", -\" .&.. \", -\" .&&&.. \", -\" .&&&&&.. \", -\" .&&&&&&&.. \", -\" .&&&&&&&&&+. \", -\" +&&&&&&&&&&%.. \", -\" .%#######@@*.. \", -\" .%#####@@*.. \", -\" .%###@@*.. \", -\" .$#@@*.. \", -\" .#@*.. \", -\" .*.. \", -\" .. \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - "*MH previous message icon.") - -;; Derived from mh-e/page-down.xpm -(defconst mh-xemacs-toolbar-page-msg-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * mail_page_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 5 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #ea03ea03d271\", -\"o c #a5d8a5d89550\", -\"O c #d305d305bc3c\", -/* pixels */ -\" \", -\" \", -\" .................. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XoooooooooooooXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .Xoooooooooo..oXX. \", -\" .XXXXXXXXXXX..XXX. \", -\" .XXXXXXXXXXX..XXX. \", -\" .XooooooXXXX..XXX. \", -\" .XXXXXXXXXXX..XXX. \", -\" .XXXXXXXXX.O..O.X. \", -\" .Xoooooooo.....XX. \", -\" .XXXXXXXXXX....XX. \", -\" .XXXXXXXXXXX..XXX. \", -\" .XXXXXXXXXXXooXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .................. \", -\" \", -\" \", -\" \"};") - "MH page message icon.") - -;; Derived from lisp/toolbar/left_arrow.xpm -(defconst mh-xemacs-toolbar-previous-undeleted-msg-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * left_arrow_xpm[] = { -\"24 24 9 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c #020202\", -\"+ c #121A12\", -\"@ c #78A16E\", -\"# c #86AD7D\", -\"$ c #B2C6AE\", -\"% c #263222\", -\"& c #E7EDE6\", -\"* c #497241\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" .. \", -\" ..$. \", -\" ..&&$. \", -\" ..&&&&$. \", -\" ..&&&&&&$. \", -\" .+&&&&&&&&$. \", -\" ..$&&&&&&&&&$% \", -\" ..**@@@#####@. \", -\" ..**@#@###@. \", -\" ..**@#@#@. \", -\" ..**@@@. \", -\" ..*@*. \", -\" ..*. \", -\" .. \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - "MH next message icon.") - -;; Derived from lisp/toolbar/close.xpm -(defconst mh-xemacs-toolbar-delete-msg-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 2 1\", -\" c Gray0\", -\". c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"....... .... ..........\", -\"....... .. .........\", -\"........ . ..........\", -\"........ ...........\", -\"......... ............\", -\"......... ...........\", -\"........ ..........\", -\"........ . .........\", -\"....... ... ........\", -\"....... ..... .........\", -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"........................\"};") - "MH delete message icon.") - -;; Derived from mh-e/refile.xpm -(defconst mh-xemacs-toolbar-refile-msg-icon - (mh-funcall-if-exists toolbar-make-button-list -"/* XPM */ -static char * refile_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 7 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #a5d8a5d89550\", -\"o c #d305d305bc3c\", -\"O c #ea03ea03d271\", -\"+ c #828282827474\", -\"@ c #61b761b7600a\", -/* pixels */ -\" . \", -\" ..X. \", -\" ..XoO.... \", -\" ..XooooO.+. \", -\" ..XooooooOX.. .. \", -\" .@@ooooooOOO@. ... \", -\" .O@oooooOOOOO..@@. \", -\" .OO@oooOOOOOO..@@. \", -\" ...OO@XooOOOOO...@@. \", -\" ..+.O@XooOOOO..@@@@@. \", -\" .++..XooOOOO..@@@@@@. \", -\" .++.@oooOO...@@@@@@@. \", -\" ..+.XooOOO..@@@@@@@. \", -\" .++.OOOO.@@@@@@@@. \", -\" .+.oOO..@@@@@@@. \", -\" .++.OO.@@@@@@@. \", -\" .++.O.@@@@@.. \", -\" ..+.O.@@@@@. \", -\" .++..@@@@. \", -\" ..++.@@@. \", -\" .+.@@. \", -\" ...@. \", -\" ... \", -\" . \"};") - "MH refile message icon.") - -;; Derived from lisp/toolbar/undo.xpm -(defconst mh-xemacs-toolbar-undo-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 5 1\", -\" c Gray0\", -\". c #ae6e66e76a0a\", -\"X c #c6c67d7d8181\", -\"o c #e4e4e4e4dcdc\", -\"O c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOO OOOOOOOOOOOOOO\", -\"OOOOOOOO OOOOOOOOOOOOOO\", -\"OOOOOOO oX OOOOOOOOOOO\", -\"OOOOOO ooooX. OOOOOOOOO\", -\"OOOOOOO oo .. OOOOOOOO\", -\"OOOOOOOO OOO . OOOOOOOO\", -\"OOOOOOOOO OOOO . OOOOOOO\", -\"OOOOOOOOOOOOOOO OOOOOOO\", -\"OOOOOOOOOOOOOOO OOOOOOO\", -\"OOOOOOOOOOOOOOO OOOOOOOO\", -\"OOOOOOOOOOOOOO OOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\"};") - "MH undo icon.") - -;; Derived from mh-e/execute.xpm -(defconst mh-xemacs-toolbar-execute-commands-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * mail_exec_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 6 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #a5d8a5d89550\", -\"o c #d305d305bc3c\", -\"O c #ea03ea03d271\", -\"+ c white\", -/* pixels */ -\" \", -\" \", -\" \", -\" .. \", -\" XX .. \", -\" oo XX .. \", -\" OO oo XX .. \", -\" OO oo XX .. \", -\" OO oo XX .. \", -\" OO oo XX .. \", -\" OO oo XX .. \", -\" OO oo XX .. \", -\" OO oo XX .. \", -\" OO oo XX \", -\" OO oo \", -\" OO + .. \", -\" XX .. \", -\" oo XX \", -\" OO oo \", -\" OO \", -\" \", -\" \", -\" \", -\" \"};") - "MH execute commands icon.") - -;; Derived from mh-e/highlight.xpm -(defconst mh-xemacs-toolbar-toggle-tick-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * highlight_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 4 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #828282827474\", -\"o c #dd00df007e00\", -/* pixels */ -\" ..... \", -\" ..XXX.. \", -\" .XXXXX. \", -\" .XXXXX.. \", -\" .XXXXX. \", -\" .XXXXX. \", -\" .XXXXX. \", -\" .ooXX. \", -\" ..ooo. \", -\" oooo .... \", -\"oo.ooo....oo ... \", -\"o.o.ooo.oo.o.ooo.o \", -\".ooo.oo.oo.o.ooooo \", -\".ooo.oo.oo.o.ooooo \", -\".ooo.oo...oo.ooooo \", -\".....oo.oo.o.ooooo \", -\".ooo.oo.oo.o.ooooo \", -\".ooo.oo.oo.o.ooo.o \", -\". oo.o....ooo...o \", -\" oo oooo \", -\" \", -\" \", -\" \", -\" \"};") - "MH toggle tick icon.") - -;; Derived from mh-e/show.xpm -(defconst mh-xemacs-toolbar-toggle-showing-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * mail_show_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 4 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #ea03ea03d271\", -\"o c #a5d8a5d89550\", -/* pixels */ -\" \", -\" \", -\" .................. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XoooooooooooooXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XoooooooooooooXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XooooooXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XoooooooooXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .XXXXXXXXXXXXXXXX. \", -\" .................. \", -\" \", -\" \", -\" \"};") - "MH toggle showing icon.") - -;; Derived from mh-e/reply-all.xpm -(defconst mh-xemacs-toolbar-reply-all-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * reply_all_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 9 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #673e666663d4\", -\"o c #eb46ea1de471\", -\"O c #a852a7bea3d2\", -\"+ c #ae51c17b9b26\", -\"@ c #8d4d97577838\", -\"# c #7c7c8b8b6e6e\", -\"$ c #5e0868be52d3\", -/* pixels */ -\" \", -\" \", -\" .... \", -\" .....XooO. \", -\" .....XOooooooO. \", -\" .XOooooooooooXOO. \", -\" .oXXooooooooOXOo. \", -\" .OoOXXooooooXOoo. \", -\" .oooOOXOooXXXooO. \", -\" ........XXOoOXOo. \", -\" ..++++@.ooooooXO. \", -\" ..+@@@.oooooooXO. \", -\" ..+@@@#.oooooooO.. \", -\" ..++@@@#$.ooooO... \", -\" .++++@@#.$ .. \", -\" .+@@@#.o .. .O .O \", -\" .+@#$. .O. .O .O \", -\" .#$. .O .o .O .O \", -\" .$. . .O .O .O \", -\" . ....O .O .O \", -\" .O .O .O .O \", -\" .O .O .O .O \", -\" .O .O .O .O \", -\" \"};") - "Reply to \"All\" icon.") - -;; Derived from mh-e/reply-from.xpm -(defconst mh-xemacs-toolbar-reply-from-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * reply_from_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 9 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #673e666663d4\", -\"o c #eb46ea1de471\", -\"O c #a852a7bea3d2\", -\"+ c #ae51c17b9b26\", -\"@ c #8d4d97577838\", -\"# c #7c7c8b8b6e6e\", -\"$ c #5e0868be52d3\", -/* pixels */ -\" \", -\" \", -\" .... \", -\" .....XooO. \", -\" .....XOooooooO. \", -\" .XOooooooooooXOO. \", -\" .oXXooooooooOXOo. \", -\" .OoOXXooooooXOoo. \", -\" .oooOOXOooXXXooO. \", -\" ........XXOoOXOo. \", -\" ..++++@.ooooooXO. \", -\" ..+@@@.oooooooXO. \", -\" ..+@@@#.oooooooO.. \", -\" ..++@@@#$.ooooO... \", -\" #.$.oO... \", -\" ...O . .... \", -\" ...O \", -\" .O \", -\" ...O ..O .... .O O. \", -\" ...O ..O .OO. ..... \", -\" .O .O . . . . . \", -\" .O .O .OO. . . . \", -\" .O .O .... . O . \", -\" \"};") - "Reply to \"From\" icon..") - -;; Derived from mh-e/reply-to.xpm -(defconst mh-xemacs-toolbar-reply-to-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * reply_to_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 9 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #673e666663d4\", -\"o c #eb46ea1de471\", -\"O c #a852a7bea3d2\", -\"+ c #ae51c17b9b26\", -\"@ c #8d4d97577838\", -\"# c #7c7c8b8b6e6e\", -\"$ c #5e0868be52d3\", -/* pixels */ -\" \", -\" \", -\" .... \", -\" .....XooO. \", -\" .....XOooooooO. \", -\" .XOooooooooooXOO. \", -\" .oXXooooooooOXOo. \", -\" .OoOXXooooooXOoo. \", -\" .oooOOXOooXXXooO. \", -\" ........XXOoOXOo. \", -\" ..++++@.ooooooXO. \", -\" ..+@@@.oooooooXO. \", -\" ..+@@@#.oooooooO.. \", -\" ..++@@@#$.ooooO... \", -\" .++++@@#.$ \", -\" .+@@@#.o ...... \", -\" .+@#$. OO.OOO \", -\" .#$. .O \", -\" .$. .O .... \", -\" . .O .OO. \", -\" .O . . \", -\" .O .OO. \", -\" .O .... \", -\" \"};") - "Reply to \"To\" icon..") - -;; Derived from mh-e/mail/reply2.xpm -(defconst mh-xemacs-toolbar-reply-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * mail_reply_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 9 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #673e666663d4\", -\"o c #eb46ea1de471\", -\"O c #a852a7bea3d2\", -\"+ c #ae51c17b9b26\", -\"@ c #8d4d97577838\", -\"# c #7c7c8b8b6e6e\", -\"$ c #5e0868be52d3\", -/* pixels */ -\" \", -\" \", -\" \", -\" \", -\" \", -\" .... \", -\" .....XooO. \", -\" .....XOooooooO. \", -\" .XOooooooooooXOO. \", -\" .oXXooooooooOXOo. \", -\" .OoOXXooooooXOoo. \", -\" .oooOOXOooXXXooO. \", -\" ........XXOoOXOo. \", -\" ..++++@.ooooooXO. \", -\" ..+@@@.oooooooXO. \", -\" ..+@@@#.oooooooO.. \", -\" ..++@@@#$.ooooO... \", -\" .++++@@#.$.oO... \", -\" .+@@@#.o.... \", -\" .+@#$... \", -\" .#$. \", -\" .$. \", -\" . \", -\" \"};") - "Reply to current message icon.") - -;; Derived from mh-e/alias.xpm -(defconst mh-xemacs-toolbar-alias-grab-from-field-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * alias_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 4 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c #61b761b7600a\", -\"X c #a5d8a5d89550\", -\"o c black\", -/* pixels */ -\" \", -\" \", -\" \", -\" ...... \", -\" ...XXXX..XX \", -\" o..ooooooo... \", -\" ooo oooo..X \", -\" o.X ooo... \", -\" o.X ooo.XX \", -\" o.X oo.. \", -\" o.X oo. \", -\" o... oo.. \", -\" o.X o.. \", -\" o.XX oX. \", -\" o.... oo. \", -\" o..XX oooo \", -\" o...XXX XXoooo \", -\" ooo........ooooo \", -\" oooooXXooooo.oo \", -\" ooo o..oo\", -\" o...\", -\" ooo\", -\" oo\", -\" \"};") - "MH alias grab from field icon.") - -;; Derived from toolbar/mail_send.xpm -(defconst mh-xemacs-toolbar-send-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 9 1\", -\" c Gray0\", -\". c #757560602020\", -\"X c #6711662663d9\", -\"o c #8e8e7d7d4545\", -\"O c #adad8e8e3030\", -\"+ c #d8d8bebe6a6a\", -\"@ c #a8fba84da483\", -\"# c #eb79ea70e4f4\", -\"$ c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"$$$$$$$$$$$$$$$$$$$$$$$$\", -\"$$$$$$$$$$$$$$$$$$$$$$$$\", -\"$$$$$$$$$$$$$ $$$$$$$\", -\"$$$$$$$$ X##@ $$$$$$\", -\"$$$ X@######@ $$$$$$\", -\"$$ X@##########X@@ $$$$$\", -\"$$ #XX########@X@# $$$$$\", -\"$$ @#@XX######X@## $$$$$\", -\"$$$ ###@@X@##XXX##@ $ $$\", -\"$$$ #####@@XX@#@X@# + $\", -\"$$$ @####X#######X@ +o $\", -\"$$$$ ###@@######## +o $$\", -\"$$$$ ###X######## +o $$$\", -\"$$$$ @#@@######@ +o $$$$\", -\"$$$$$ #X####@ +o $$$$$\", -\"$$$$$ X@#@ $ +o $$$$$$\", -\"$$$$$ XX $$$ +o $$$$$$$\", -\"$$$$$$ $$$$ +o $$$$$$$$\", -\"$$$$$$$$$$$O. $$$$$$$$$\", -\"$$$$$$$$$$$ $$$$$$$$$$$\", -\"$$$$$$$$$$$$$$$$$$$$$$$$\", -\"$$$$$$$$$$$$$$$$$$$$$$$$\", -\"$$$$$$$$$$$$$$$$$$$$$$$$\", -\"$$$$$$$$$$$$$$$$$$$$$$$$\"};") - "MH send icon.") - -;; Derived from mh-e/rescan.xpm -(defconst mh-xemacs-toolbar-rescan-folder-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * mail_rescan_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 6 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #a5d8a5d89550\", -\"o c #d305d305bc3c\", -\"O c #ea03ea03d271\", -\"+ c #828282827474\", -/* pixels */ -\" \", -\" \", -\" .............. \", -\" .XXXXXXXXXXXX.. \", -\" .XXXXXXXXXXXX.X. \", -\" .XXXXXXXXXXXX.oo. \", -\" ..............ooo. \", -\" .OOOOOOOOOOOO.ooo. \", -\" .O++++++++++O.ooo. \", -\" .O+XXXXXXXX+O.ooo. \", -\" .O+XXXXXXXX+O.ooo. \", -\" .O+XXXXXXXX+O.ooo. \", -\" .O+XXXXXXXX+O.ooo. \", -\" .O++++++++++O.ooo. \", -\" .OOOOOOOOOOOO.ooo. \", -\" .O++++++++++O.ooo. \", -\" .O+XXXXXXXX+O.ooo. \", -\" .O+XXXXXXXX+O.ooX. \", -\" .O+XXXXXXXX+O.oo.. \", -\" .O++++++++++O.o.. \", -\" ..OOOOOOOOOOOO... \", -\" ................ \", -\" \", -\" \"};") - "MH rescan folder icon.") - -;; Derived from mh-e/repack.xpm -(defconst mh-xemacs-toolbar-pack-folder-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * mail_repack_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 6 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c black\", -\"X c #a5d8a5d89550\", -\"o c #d305d305bc3c\", -\"O c #ea03ea03d271\", -\"+ c #828282827474\", -/* pixels */ -\" \", -\" \", -\" .............. \", -\" .XXXXXXXXXXXX.. \", -\" .XXXXXXXXXXXX.X. \", -\" .XXXXXXXXXXXX.oo. \", -\" ..............ooo. \", -\" .OOOOOOOOOOOO.oo. \", -\" .O++++++++++O.oo. \", -\" .O+XXXXXXXX+O.o. \", -\" .+XXXXXXXX+.o.. \", -\" .+XX...XXX+.... \", -\" ....o.......oo. \", -\" ....o.....Oooo. \", -\" .OOO...OOOO.oooo. \", -\" .++++++++++.oooo. \", -\" .+XXXXXXXX+.oooo. \", -\" .O+XXXXXXXX+O.ooX. \", -\" .O+XXXXXXXX+O.oo.. \", -\" .O++++++++++O.o.. \", -\" ..OOOOOOOOOOOO... \", -\" ................ \", -\" \", -\" \"};") - "MH repack folder icon.") - -;; Derived from lisp/toolbar/search.xpm -(defconst mh-xemacs-toolbar-search-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 8 1\", -\" c #011801180102\", -\". c #464646463e3e\", -\"X c #5c5c5c5c57a0\", -\"o c #878787877979\", -\"O c #a910a91097af\", -\"+ c #ce5ace5ab851\", -\"@ c #e79de79dd134\", -\"# c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"########################\", -\"########################\", -\"############# ##########\", -\"########### O #########\", -\"######### O@@.#########\", -\"####### O@@@@@ ########\", -\"##### O+@@@@@@O #######\", -\"#### XX@++@@@@@@.#######\", -\"#### @.O+@@@@@@@@ ######\", -\"#### @@.++@@@@@@@O #####\", -\"#### @@.o+O. .+@@ #####\", -\"#### @XO+O.O++o.+@@ ####\", -\"#### O+@.O@@+Oo.@@+ ###\", -\"#### X@@@ +#+OOO @@@@ ##\", -\"#### O@@@ +@OOOo @@@o ##\", -\"##### @@@.oOOOoX.@@ ###\", -\"##### O@@O.oOOX @ #####\", -\"######X@@@O. .X ######\", -\"###### @@@@@@@+ #####\", -\"####### @@@@@O ## ####\", -\"####### O@@+. #### ###\", -\"######## @O ####### ###\", -\"######### #############\", -\"########################\"};") - "MH search icon.") - -;; Derived from lisp/toolbar/fld_open.xpm -(defconst mh-xemacs-toolbar-visit-folder-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 4 1\", -\" c Gray0\", -\". c #909090909090\", -\"X c #fefefefefefe\", -\"o c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"oooooooooooooooooooooooo\", -\"oooooooooooooooooooooooo\", -\"oooooooooooooooooooooooo\", -\"oooooooooooooooooooooooo\", -\"oooooooooooooooooooooooo\", -\"oooooooooooooo oooooooo\", -\"ooooooooooo .. ooooooo\", -\"oooo oo ....XXo ooo\", -\"ooo .. ....XXXX .. ooo\", -\"ooo .....XXXXX .... ooo\", -\"oooo ..XXXXX ...... ooo\", -\"oooo ..XXX ........ ooo\", -\"ooooo .XX .......... ooo\", -\"ooooo ..X .......... ooo\", -\"oooooo .X .......... ooo\", -\"oooooo .. ........ oooo\", -\"ooooooo . ...... oooooo\", -\"ooooooo . ..... oooooooo\", -\"oooooooo ... ooooooooo\", -\"oooooooo . ooooooooooo\", -\"ooooooooo ooooooooooooo\", -\"oooooooooooooooooooooooo\", -\"oooooooooooooooooooooooo\", -\"oooooooooooooooooooooooo\"};") - "MH visit folder icon.") - -;; Derived from lisp/toolbar/help.xpm -(defconst mh-xemacs-toolbar-help-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 6 1\", -\" c Gray0\", -\". c #65658b8b5e5e\", -\"X c #934ab2448dfb\", -\"o c #b35dc8c8afaf\", -\"O c #e0b2e944df83\", -\"+ c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"++++++++++++++++++++++++\", -\"++++++++++++++++++++++++\", -\"++++++++++++++++++++++++\", -\"++++++++++++++++++++++++\", -\"+++++++++ ++++++++++\", -\"++++++++ oOOOO +++++++++\", -\"+++++++ OOOOOOO ++++++++\", -\"++++++ oOo oOo +++++++\", -\"+++++++ O +++ OO +++++++\", -\"+++++++O ++++ Oo +++++++\", -\"++++++++++++ OO. +++++++\", -\"+++++++++++ OOX ++++++++\", -\"++++++++++ OOX +++++++++\", -\"+++++++++ XOX ++++++++++\", -\"+++++++++ OX +++++++++++\", -\"+++++++++ +++++++++++\", -\"++++++++++++++++++++++++\", -\"++++++++++ ++++++++++++\", -\"+++++++++ Oo +++++++++++\", -\"+++++++++ oX +++++++++++\", -\"++++++++++ ++++++++++++\", -\"++++++++++++++++++++++++\", -\"++++++++++++++++++++++++\", -\"++++++++++++++++++++++++\"};") - "MH help icon.") - -;; Derived from lisp/toolbar/mail_send.xpm -(defconst mh-xemacs-toolbar-send-letter-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 9 1\", -\" c Gray0\", -\". c #675e6580613e\", -\"X c #8c8c7c7c6969\", -\"o c #9b458d377822\", -\"O c #a941a6459f3e\", -\"+ c #c8c8b2b29898\", -\"@ c #dadac2c2a5a5\", -\"# c #eb4dea2fe4ad\", -\"$ c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"$$$$$$$$$$$$$$$$$$$$$$$$\", -\"$$$$$$$$$$$$$$$$$$$$$$$$\", -\"$$$$$$$$$$$$$ $$$$$$$\", -\"$$$$$$$$ .@#+ $$$$$$\", -\"$$$ .+#####@O $$$$$$\", -\"$$ .+##########.+O $$$$$\", -\"$$ @..########O.+# $$$$$\", -\"$$ O@O..@#####.+## $$$$$\", -\"$$$ ###+O.O##...##O $$$$\", -\"$$$ @####@+..O#O.+# $$$$\", -\"$$$ O####.#######.O $$$$\", -\"$$$$ ###+O########.O $$$\", -\"$$$$ ###.########@O $$$\", -\"$$$$ +#+O#####@O $$$$$\", -\"$$$$$ #.###@O $$$$$$\", -\"$$$$$ .O@O $$ .. $$$$$\", -\"$$$$$ .. $$$$ .oo. $$$$\", -\"$$$$$$ $$$$$ oo $$$\", -\"$$$$$$$$$$$$$$$ Oo $$$$$\", -\"$$$$$$$$$$$$$$ oOOX $$$$\", -\"$$$$$$$$$$$$$$ ++++ $$$$\", -\"$$$$$$$$$$$$$ O@@@@O $$$\", -\"$$$$$$$$$$$$$ $$$\", -\"$$$$$$$$$$$$$$$$$$$$$$$$\"};") - "MH send letter icon.") - -;; This is the same icon as `mh-xemacs-toolbar-mime-save-parts-icon', -;; so there is no point in duplicating it. -(defconst mh-xemacs-toolbar-compose-insertion-icon - mh-xemacs-toolbar-mime-save-parts-icon - "MH compose insertion icon.") - -;; Derived from lisp/toolbar/spell.xpm -(defconst mh-xemacs-toolbar-ispell-message-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 5 1\", -\" c Gray0\", -\". c #41415b5b3939\", -\"X c #4c2f6b4e42d1\", -\"o c #5fe086865454\", -\"O c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOO OO OOO OOOOOOOO\", -\"OOO OO O OO O OO OOOOOOO\", -\"OOO O OO OOOOOOOOOO\", -\"OOO OO O OO O OO OOOOOOO\", -\"OOO OO O OOO OOOO OO\", -\"OOOOOOOOOOOOOOOOOOO OOO\", -\"OOOOOOOOOOO OOOOO OOOO\", -\"OOOOOOOOOOO X OOO . OOOO\", -\"OOOOOOOOOOOO X O X OOOOO\", -\"OOOOOOOOOOOO Xo o. OOOOO\", -\"OOOOOOOOOOOOO XoX OOOOOO\", -\"OOOOOOOOOOOOO Xo. OOOOOO\", -\"OOOOOOOOOOOOOO X OOOOOOO\", -\"OOOOOOOOOOOOOO X OOOOOOO\", -\"OOOOOOOOOOOOOOO OOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\"};") - "MH Ispell message icon.") - -;; Derived from lisp/toolbar/save.xpm -(defconst mh-xemacs-toolbar-save-buffer-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 5 1\", -\" c #01be01be01be\", -\". c #62dd62dd62dd\", -\"X c Gray62\", -\"o c #e625e625e625\", -\"O c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOO OOOOOOOOO\", -\"OOOOOOOOOOO X. OOOOOOOO\", -\"OOOOOOOOO oXoX OOOOOOOO\", -\"OOOOOOO oXoooXX OOOOOOO\", -\"OOOOO oXoooooo. OOOOOOO\", -\"OOO XoooooooooX OOOOOO\", -\"OO XooooooooooooX OOOOOO\", -\"OO .XoooooooooooX. OOOOO\", -\"OOO XooooooooooXXX OOOOO\", -\"OOO .XoooooooXX..X. OOOO\", -\"OOOO XoooooXX...X.X OOOO\", -\"OOOO .XooXX.Xoo.X.X. OOO\", -\"OOOOO XXX.oooooX.X. OOO\", -\"OOOOO .XXoo.ooooXX OOO\", -\"OOOOOO XX.o XooX. OOOOO\", -\"OOOOOO .XXooXoX OOOOOOO\", -\"OOOOOOO .X.oX OOOOOOOOO\", -\"OOOOOOOO OOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\"};") - "MH save buffer icon.") - -;; Derived from lisp/toolbar/cut.xpm -(defconst mh-xemacs-toolbar-kill-region-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 2 1\", -\" c Gray0\", -\". c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\"........................\", -\".................. .....\", -\"................ ......\", -\"............... .......\", -\".............. ........\", -\"............. .........\", -\".... .... ..... ..\", -\"... ... .. ... ....\", -\"... ... ......\", -\".... ... .........\", -\".......... ............\", -\"......... ............\", -\"........ .. ............\", -\"....... ... ............\", -\"....... .. .............\", -\"....... ..............\", -\"........................\", -\"........................\", -\"........................\", -\"........................\"};") - "MH kill region icon.") - -;; Derived from lisp/toolbar/copy.xpm -(defconst mh-xemacs-toolbar-kill-ring-save-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 7 1\", -\" c Gray0\", -\". c #424242423a3a\", -\"X c #68e968e96363\", -\"o c #a8b1a8b1992b\", -\"O c #d3d3d3d3bdbd\", -\"+ c #e419e419cd6b\", -\"@ c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"@@@@@@@@@@@@@@@@@@@@@@@@\", -\"@@@@@@@@@@@@@@@@@@@@@@@@\", -\"@@@@@@@@@@@@@@@@@@@@@@@@\", -\"@@@@@@@@@@@@@@@@@@@@@@@@\", -\"@@@@@@@@@@@@@@@@@@@@@@@@\", -\"@@@@@@@@ @@@@@@@@@@@@@@\", -\"@@@@@@ Oo @@@@@@@@@@@@@\", -\"@@@@ .ooOO @@@@ @@@@@@@\", -\"@@@@ +XoOOo @ Oo @@@@@@\", -\"@@@@ +.oO++ .ooOO @@@@@@\", -\"@@@@ XoO+++ +XoOOo @@@@@\", -\"@@@@ oOO+++ +.oO++ @@@@@\", -\"@@@@ oO++++ XoOO++o @@@@\", -\"@@@@@ +++++ oOO++++o @@@\", -\"@@@@@ o++++ oO++++++ @@@\", -\"@@@@@@ ++o +++++++o @@\", -\"@@@@@@ o @@ o++++o @@@\", -\"@@@@@@@ @@@@@ ++o @@@@@\", -\"@@@@@@@@@@ @@ o @@@@@@@\", -\"@@@@@@@ @@ @@@@@@@@@\", -\"@@@@@@@ @@@@@@@@@@@@\", -\"@@@@@@@@@@ @@@@@@@@@@@@@\", -\"@@@@@@@@@@@@@@@@@@@@@@@@\", -\"@@@@@@@@@@@@@@@@@@@@@@@@\"};") - "MH kill ring save icon.") - -;; Derived from lisp/toolbar/paste.xpm -(defconst mh-xemacs-toolbar-yank-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 5 1\", -\" c Gray0\", -\". c #62ee62ee62ee\", -\"X c Gray68\", -\"o c Gray82\", -\"O c Gray75 s backgroundToolBarColor\", -/* pixels */ -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOO OOOOOOOOOOOO\", -\"OOOOOOO ooo OOOOOO OOOO\", -\"OOOOO ooooo OOO OOO\", -\"OOO oo. .Xoo OO OOO\", -\"OO ooo.oX..oo OOOOO OOOO\", -\"OO ooo.X..oooo OOOOOOOOO\", -\"OOO oo..Xooooo O OOOOOO\", -\"OOO oooooooooo oX OOOOO\", -\"OOOO ooooooo XXoo OOOOO\", -\"OOOO ooooooo o.XooX OOOO\", -\"OOOOO oooooo o.Xooo OOOO\", -\"OOOOO oooooo .XooooX OOO\", -\"OOOOOO ooooX XooooooX OO\", -\"OOOOOO XXOXX Xooooooo OO\", -\"OOOOOOO XXXX oooooooX O\", -\"OOOOOOO XX O XooooX OO\", -\"OOOOOOOO OOOO ooX OOOO\", -\"OOOOOOOOOOOOOO X OOOOOO\", -\"OOOOOOOOOOOOOOO OOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\", -\"OOOOOOOOOOOOOOOOOOOOOOOO\"};") - "MH yank icon.") - -;; This is the same icon as `mh-xemacs-toolbar-delete-msg-icon' -;; so there is no point in duplicating it here. -(defconst mh-xemacs-toolbar-fully-kill-draft-icon - mh-xemacs-toolbar-delete-msg-icon - "MH fully kill draft icon.") - -;; Derived from lisp/toolbar/preferences.xpm -(defconst mh-xemacs-toolbar-preferences-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * preferences_xpm[] = { -\"24 24 8 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c #000000\", -\"+ c #E1E0E0\", -\"@ c #D7C99B\", -\"# c #9A6C4E\", -\"$ c #A4A199\", -\"% c #858579\", -\"& c #AD8E30\", -\" \", -\" \", -\" \", -\" .. \", -\" ..++. . \", -\" ..++++. .@. \", -\" ...+++++++. .@#. \", -\" ..++++++++++. .@#. \", -\" .++++++#++++++.@#. \", -\" .+++++#++++++.@#. \", -\" .++#+#+++++.@#. \", -\" .++#$#++++.@#.+. \", -\" .++##+++.@#.++@. \", -\" .++++++.@#.+++@%. \", -\" .++++&+..@$$$$%. \", -\" .++++..$$$$$$@. \", -\" .+$%%$+++++.. \", -\" .+++++++++. \", -\" .++++++.. \", -\" .++++@. \", -\" .++.. \", -\" .. \", -\" \", -\" \"};") - "MH preferences icon.") - -;; This is the same icon as `mh-xemacs-toolbar-help-icon' so there is -;; no point in duplicating it here. -(defconst mh-xemacs-toolbar-letter-help-icon - mh-xemacs-toolbar-help-icon - "MH letter help icon.") - -;; Derived from mh-e/widen.xpm -(defconst mh-xemacs-toolbar-widen-icon - (mh-funcall-if-exists toolbar-make-button-list - "/* XPM */ -static char * widen_xpm[] = { -/* columns rows colors chars-per-pixel */ -\"24 24 3 1\", -\" c Gray75 s backgroundToolBarColor\", -\". c #8d4d97577838\", -\"X c black\", -/* pixels */ -\" \", -\" \", -\" \", -\" . . \", -\" . . \", -\" . . \", -\" . . \", -\" . . \", -\" . XX XX . \", -\" . XX XX . \", -\" . XX XX . \", -\" .XXXXXXXX XXXXXXXX. \", -\" .XXXXXXXX XXXXXXXX. \", -\" . XX XX . \", -\" . XX XX . \", -\" . XX XX . \", -\" . . \", -\" . . \", -\" . . \", -\" . . \", -\" . . \", -\" \", -\" \", -\" \"};") - "MH widen icon.") - -(defvar mh-xemacs-icon-map - '((mail . mh-xemacs-toolbar-inc-folder-icon) - (attach . mh-xemacs-toolbar-mime-save-parts-icon) - (right_arrow . mh-xemacs-toolbar-next-undeleted-msg-icon) - (page-down . mh-xemacs-toolbar-page-msg-icon) - (left_arrow . mh-xemacs-toolbar-previous-undeleted-msg-icon) - (close . mh-xemacs-toolbar-delete-msg-icon) - (refile . mh-xemacs-toolbar-refile-msg-icon) - (undo . mh-xemacs-toolbar-undo-icon) - (execute . mh-xemacs-toolbar-execute-commands-icon) - (highlight . mh-xemacs-toolbar-toggle-tick-icon) - (show . mh-xemacs-toolbar-toggle-showing-icon) - (reply-from . mh-xemacs-toolbar-reply-from-icon) - (reply-to . mh-xemacs-toolbar-reply-to-icon) - (reply-all . mh-xemacs-toolbar-reply-all-icon) - (mail/reply2 . mh-xemacs-toolbar-reply-icon) - (alias . mh-xemacs-toolbar-alias-grab-from-field-icon) - (mail_compose . mh-xemacs-toolbar-send-icon) - (rescan . mh-xemacs-toolbar-rescan-folder-icon) - (repack . mh-xemacs-toolbar-pack-folder-icon) - (search . mh-xemacs-toolbar-search-icon) - (fld_open . mh-xemacs-toolbar-visit-folder-icon) - (mail_send . mh-xemacs-toolbar-send-letter-icon) - (spell . mh-xemacs-toolbar-ispell-message-icon) - (save . mh-xemacs-toolbar-save-buffer-icon) - (cut . mh-xemacs-toolbar-kill-region-icon) - (copy . mh-xemacs-toolbar-kill-ring-save-icon) - (paste . mh-xemacs-toolbar-yank-icon) - (preferences . mh-xemacs-toolbar-preferences-icon) - (help . mh-xemacs-toolbar-help-icon) - (widen . mh-xemacs-toolbar-widen-icon)) - "Map GNU Emacs icon file names to XEmacs image constants.") - - - -(provide 'mh-xemacs-icons) - -;;; Local Variables: -;;; indent-tabs-mode: nil -;;; sentence-end-double-space: nil -;;; End: - -;;; arch-tag: 5b06d860-a468-4a0f-a61b-255a148985e4 -;;; mh-xemacs-icons.el ends here