procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Upgraded to MH-E version 7.0.

Browse source
This commit is contained in:
Bill Wohler 2002-11-29 18:15:21 +00:00
parent 68f2d6419c
commit bdcfe844b8
20 changed files with 7773 additions and 1663 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2002-11-29 Bill Wohler <wohler@newt.com>
* MH-E-NEWS: Upgraded to MH-E version 7.0.
2002-11-22 Juanma Barranquero <lektu@terra.es>
* TUTORIAL.es: Extensively changed and updated by Rafael Sep,Az(Blveda

376
etc/MH-E-NEWS
View file

@ -1,3 +1,377 @@
* Changes in mh-e 7.0
This is a major release which includes a lot of new features including
improved MIME handling, speedbar folder browsing, and indexed
searching. In this version, MH-E runs under XEmacs, passes checkdoc,
and compiles clean under all supported platforms.
The "passes checkdoc" feature above required changing the name of
several user-visible variables. It is likely that this affects you.
Please be sure to see the table at the end of these notes and rename
your variables accordingly.
MH-E has been written mh-e, Mh-e, MH-e and MH-E. We have decided that
the proper term should be MH-E. Please try to use MH-E in your
writing.
** New Features in MH-E 7.0
*** Speedbar
There is now support for the speedbar. Try "M-x speedbar" (closes SF
#503727).
Press the middle mouse button on the `+' icons to open a folder,
middle mouse button on a folder name to open the folder. Folders with
unseen messages are shown in bold, so this is a handy way to browse
new messages that you have filed with procmail or slocal.
See the new customization variable `mh-large-folder,' which controls
when the speedbar asks for how many messages to scan when opening a
large folder and `mh-speed-run-flists-flag' whose default value of t
means to use the flists command to populate the count of unseen and
total messages in each folder.
*** Indexed Search
Interoperability with swish++, swish, glimpse, and namazu has been
added to enable lightening-fast searches of your mail. If none of
these are present, grep is used. Try "F i (mh-index-search)".
For more information, read the documentation for the functions
`mh-swish++-execute-search,' `mh-swish-execute-search,'
`mh-namazu-execute-search,' or `mh-glimpse-execute-search' depending
on your preferred indexing program to see what kind of setup is needed
to generate the index.
*** Threading
Use "T t (mh-toggle-threads)" to view the threads in the folder. Use
it again to return to a non-threaded view.
*** Brief Help
Use "? (mh-help)" and "X ? (mh-prefix-help)," where X is a prefix
character, for a brief synopsis in the minibuffer of frequently used
commands. In the MH-Letter or MH-Pick buffers, use "C-c ? (mh-help)"
(closes SF #493740).
*** Folder Keymap Shared by Show Buffer
You can now use the MH-Folder mode commands from the MH-Show buffer.
Because of this, the MH-Show buffer is now read-only (closes SF
#493749 and SF #527946) and you now have to use "M (mh-modify)" to
edit a message.
*** Better Scanning
You no longer have to modify your scan format if your folders have
more than 9999 messages in them. If you've only modified your scan
format file to allow for the wider message numbers, consider using the
default behavior of MH-E and simplify your MH-E configuration
considerably (closes SF #635791).
To do this, you may have to remove your modifications of
`mh-scan.*-regexp' and `mh-cmd-note' and your customization of
`mh-scan-format-file'.
You may still want the updated format files for running MH commands
outside of MH-E; the default of `mh-scan-format-file' will cause them
to be ignored.
If you prefer fixed-width message numbers, set the new customization
variable to nil , set this variable to
nil and call `mh-set-cmd-note' with the width specified by the scan format in
`mh-scan-format-file'. For example, the default width is 4, so you would use
"(mh-set-cmd-note 4)" if `mh-scan-format-file' were nil.
*** X-Face
MH-E now displays the content of the X-Face header field in the From
field. When sending a message, an X-Face field is appended to the
header if it doesn't already exist and "~/.face" is present. See the
new customization variables `mh-show-use-xface-flag' and `mh-x-face-file'
(closes SF #480770).
MH-E depends on the external x-face package found in
ftp://ftp.jpl.org/pub/elisp/ to do this. The `uncompface' binary is
also required to be in the execute PATH. It can be obtained from:
http://freshmeat.net/redir/compface/1439/url_tgz/compface-1.4.tar.gz.
It has also been observed that if you don't see the faces, you might
have to do this (for unknown reasons):
mv /usr/local/include/compface.h /usr/include/
*** Graphical Smileys
Smiley's are now converted to cute little images. See the new
customization variable `mh-graphical-smileys-flag.'
*** Text Emphasis
ASCII formatting is now converted to the appropriate font. For
example, _underline_ is underlined, *bold* appears in bold, /italic/
appears in italic, etc. See `gnus-emphasis-alist' for the whole list.
See the new customization variables `mh-decode-mime' and
`mh-graphical-emphasis-flag.'
*** Attachment Handling
Inline attachments are now displayed. Regular attachments appear as
buttons in show buffer. Use "K TAB (mh-next-button)" or "K SHIFT-TAB
(mh-prev-button)" to cycle through these buttons. Use "K v
(mh-folder-toggle-mime-part)" to view, "K o
(mh-folder-save-mime-part)" to save one part or "K-a
(mh-save-mime-parts)" to save all parts, or "K i
(mh-folder-inline-mime-part)" to view the attachment inline.
See the new customization variable `mh-decode-mime' for additional
information. Other customization variables that affect this new feature
include `mh-store-mime-parts-default-directory' and
`mh-display-buttons-for-inline-parts-flag'.
HTML documents can be viewed inline if Gnus v5.10 and w3 or w3m lisp
packages are present. Set the customization variable
`mm-text-html-renderer' accordingly (closes SF #453352).
*** Quoted-printable Handling
Quoted-printable body parts are now decoded.
*** More Choices for `mh-yank-from-start-of-msg'
Historically, if this variable was t, the entire message, with full
headers would be included and every line would begin with
`mh-ins-buf-prefix.' This usage is deprecated in favor of the setting
`supercite' below. The default has been changed to `attribution.' The
following symbols are now understood:
`body': yank the message minus the header.
`supercite': include the entire message, with full headers. This also
causes the invocation of `sc-cite-original' without the setting of
`mail-citation-hook', now deprecated practice.
`autosupercite': do as for `supercite' automatically when show buffer
matches the message being replied-to.
`attribution': yank the message minus the header and add a simple
attribution line at the top.
`autoattrib': do as for `attribution' automatically when show buffer
matches the message being replied-to.
There is a new customization variable called
`mh-extract-from-attribution-verb' which is used for attribution which
provides a method for setting a different language.
*** Use Gnus mml Instead of mhn
When inserting attachments into a message draft, Gnus mml directives
are now used instead of mhn directives. One beneficial side-effect of
this is that attachments can now appear inline as well as separate.
The new customization variable `mh-compose-insertion' controls whether
Gnus or mhn is used to insert MIME message directives in messages
(default: 'gnus, if the mml library exists).
*** Content-Type Now Obtained Automatically
The value of the Content-Type no longer needs to be entered by the
user.
*** Attachments Automatically Included Upon Send
You no longer have to run "C-c C-e (mh-edit-mhn)" before sending a
message with attachments--this is done automatically when you send the
message with "C-c C-c (mh-send-letter)". There is, however, a new key
binding "C-c C-m m (mh-mml-to-mime)" which is analogous to "C-c C-e
(mh-edit-mhn)".
*** GPG Handling
Messages that have been signed or encrypted with GPG are verified and
decrypted automatically. To sign or encrypt a message, use "C-c RET
C-s (mh-mml-secure-message-sign-pgpmime)" and "C-c C-m C-e
(mh-mml-secure-message-encrypt-pgpmime)." You need Gnus version 5.10
for this feature. These functions are provided by the pgg.el package.
Users report "flashing" with the pgg.el package and prefer the gpg.el
package instead. To use gpg.el instead of the pgg.el package you need:
(setq mml2015-use 'gpg)
To mimic automatic encryption in gpg.el, use:
(setq mm-verify-option 'always)
(setq mm-decrypt-option 'always)
The venerable mailcrypt package is also an option. However, now that
show buffers are read-only, mailcrypt version 3.5.6 and older fail
when they attempt to decrypt the contents.
*** Mail-Followup-To Header Field
Support for this controversial field has been added because nmh
supports it (closes SF #627035). If you want to add it to outgoing
mail for selected mailing lists, add those mailing lists to the new
customization variable `mh-insert-mail-followup-to-list.' If you think
this field is evil, set the new customization variable
`mh-insert-mail-followup-to-flag' to nil.
*** Gnus Issues
If you update Gnus, you must recompile MH-E. Note that if you are
running the stock version of MH-E that comes with Emacs or the MH-E
package on a Debian GNU/Linux, this is done for you.
** New Variables in MH-E 7.0
New customization variables not mentioned earlier include:
*** mh-letter-insert-signature-hook
Invoked at the beginning of the "C-c C-s (mh-insert-signature)"
command. Can be used to determine which signature file to use based on
message content. On return, if `mh-signature-file-name' is non-nil
that file will be inserted at the current point in the buffer.
*** mh-show-maximum-size
Maximum size of message (in bytes) to display automatically. Provides
an opportunity to skip over large messages which may be slow to load.
Use a value of 0 to display all messages automatically regardless of
size (closes SF #488696).
*** mh-tool-bar-reply-3-buttons-flag
Non-nil means use three buttons for reply commands in tool-bar. If you
have room on your tool-bar because you are using a large font, you may
set this variable to expand the single reply button into three buttons
that won't lead to minibuffer prompt about who to reply to.
** Bug Fixes in MH-E 7.0
*** mh-delete-msg, mh-refile-msg, mh-undo
Mandrake Linux includes XEmacs initialization code that binds
`transient-mark-mode' which causes problems in MH-E. These problems
have been fixed (closes SF #541915).
*** mh-edit-again
This would sometimes yield a read-only buffer. This has been fixed
(closes SF #624283 and SF #625538).
*** mh-forward
When using nmh, always specify -mime so as to preserve the original
message(s).
*** mh-inc-folder
If you had narrowed to a sequence and then incorporated new mail,
those new messages would not be present in your +inbox when you
widened. This has been fixed (closes SF #489430, SF #489437, SF
#629233).
*** mh-insert-letter
No longer uses mhl to include a message as this mangled the header and
gave supercite fits (closes SF #629153).
*** mh-letter-mode
"M-q (fill-paragraph)" now fills quoted paragraphs (for example,
starting with "> ") correctly (closes SF #489927).
*** mh-next-undeleted-msg, mh-previous-undeleted-msg
If there are no more undeleted messages the point remains at its
original position and a message is produced (closes SF #494304).
*** mh-pick-mode
Now calls `mh-pick-mode-hook' as documented.
*** mh-put-msg-in-seq
Now puts all messages in region in sequence (closes SF #630324).
*** mh-refile-msg, mh-write-msg-to-file
These functions stomped on the variables that held the name of the
last file and folder respectively for the other function. This has
been fixed so that the last folder or file name is preserved (closes
SF #580772).
*** mh-region-to-sequence
If the region in MH-Folder was set with "C-x h (mark-whole-buffer)",
you couldn't perform operations on all of the messages as you would
expect. This has been fixed (closes SF #621632).
*** mh-reply
Performing an undo the first thing after replying would blank out the
entire draft. Now just the insertion of the yanked message is undone
leaving the header and signature intact for additional editing (closes
SF #623693).
*** mh-show-mode
Now calls `mh-show-mode-hook' as documented (closes SF #627222).
*** mh-subject-thread-to-sequence
Make 'subject sequence a real one, exported to MH. This means you can,
for example, mh-forward it. But it also shows up with a mark in the
scan output (closes SF #489445).
*** Other Bug Fixes
The following bugs have also been closed:
SF #495450: Folder buffer read-only after inc
SF #489706: mh-page-msg bombs out
SF #580772: mh-last-destination is overloaded
*** Variables renamed to conform with Emacs coding conventions
The coding conventions require that boolean variables end in -flag.
The following two tables show which variables were affected (closes SF
#627015).
Customization Variables (defcustom)
Old Name New Name
mh-auto-folder-collect mh-auto-folder-collect-flag
mh-bury-show-buffer mh-bury-show-buffer-flag
mh-clean-message-header mh-clean-message-header-flag
mh-decode-quoted-printable mh-decode-quoted-printable-flag
mh-delete-yanked-msg-window mh-delete-yanked-msg-window-flag
mh-do-not-confirm mh-do-not-confirm-flag
mh-highlight-citation-p mh-highlight-citation
mh-insert-x-mailer-p mh-insert-x-mailer-flag
mh-print-background mh-print-background-flag
mh-recenter-summary-p mh-recenter-summary-flag
mh-recursive-folders mh-recursive-folders-flag
mh-reply-show-message-p mh-reply-show-message-flag
mh-show-use-goto-addr mh-show-use-goto-addr-flag
mh-update-sequences-after-mh-show mh-update-sequences-after-mh-show-flag
Regular Variables (defvar)
Old Name New Name
mh-mhn-compose-insert-p mh-mhn-compose-insert-flag
mh-nmh-p mh-nmh-flag
mh-page-to-next-msg-p mh-page-to-next-msg-flag
* Changes in mh-e 6.1
This is a minor release which includes a few bug fixes. The
@ -34,7 +408,7 @@ Fixed to work under XEmacs. Thanks to Will Partain
*** mh-quit
mh-quit now cleans up the buffers named `mh-temp-buffer,
mh-quit now cleans up the buffers named `mh-temp-buffer,'
'mh-temp-folders-buffer' and 'mh-temp-sequences-buffer.'

2
etc/NEWS
View file

@ -90,7 +90,7 @@ You can now put the init files .emacs and .emacs_SHELL under
** MH-E changes.
Upgraded to mh-e version 6.1.1. There have been major changes since
Upgraded to mh-e version 7.0. There have been major changes since
version 5.0.2; see MH-E-NEWS for details.
+++

15
lisp/ChangeLog
View file

@ -1,3 +1,18 @@
2002-11-29 Bill Wohler <wohler@newt.com>
* mail/mh-comp.el, mail/mh-e.el, mail/mh-funcs.el,
mail/mh-mime.el, mail/mh-pick.el, mail/mh-seq.el,
mail/mh-utils.el, mail/mh-xemacs-compat.el: Upgraded to MH-E
version 7.0.
* mail/mh-index.el, mail/mh-speed.el: New files for indexed
searches and speedbar support in MH-E version 7.0.
* toolbar/reply-all.pbm, toolbar/reply-all.xpm,
toolbar/reply-from.pbm, toolbar/reply-from.xpm,
toolbar/reply-to.pbm, toolbar/reply-to.xpm: New toolbar images for
MH-E version 7.0.
2002-11-29 Markus Rost <rost@math.ohio-state.edu>
* mwheel.el (mouse-wheel-inhibit-click-time): Fix custom type.

1100
lisp/mail/mh-comp.el
View file

File diff suppressed because it is too large Load diff

1623
lisp/mail/mh-e.el
View file

File diff suppressed because it is too large Load diff

103
lisp/mail/mh-funcs.el
View file

@ -1,4 +1,4 @@
;;; mh-funcs.el --- mh-e functions not everyone will use right away
;;; mh-funcs.el --- MH-E functions not everyone will use right away
;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
@ -26,19 +26,22 @@
;;; Commentary:
;; Internal support for mh-e package.
;; Putting these functions in a separate file lets mh-e start up faster,
;; Internal support for MH-E package.
;; Putting these functions in a separate file lets MH-E start up faster,
;; since less Lisp code needs to be loaded all at once.
;;; Change Log:
;; $Id: mh-funcs.el,v 1.12 2002/04/07 19:20:56 wohler Exp $
;; $Id: mh-funcs.el,v 1.28 2002/11/11 23:01:27 mbaushke Exp $
;;; Code:
(provide 'mh-funcs)
(require 'mh-e)
;;; autoload
(autoload 'mh-notate-seq "mh-seq")
(autoload 'mh-speed-invalidate-map "mh-speed")
;;; customization
(defvar mh-sortm-args nil
@ -54,7 +57,7 @@ For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
(defvar mh-note-printed "P"
"String whose first character is used to notate printed messages.")
;;; functions
;;; Functions
(defun mh-burst-digest ()
"Burst apart the current message, which should be a digest.
@ -73,11 +76,10 @@ digest are inserted into the folder after that message."
(mh-goto-cur-msg)
(message "Bursting digest...done")))
(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."
Default is the displayed message. If optional prefix argument is provided,
then prompt for the message sequence."
(interactive (list (if current-prefix-arg
(mh-read-seq-default "Copy" t)
(mh-get-msg-num t))
@ -90,7 +92,9 @@ provided, then prompt for the message sequence."
(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-folder-list-change-hook' is a list of functions to be called,
with no arguments, after the folders has been removed."
(interactive)
(if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
mh-current-folder))
@ -101,6 +105,8 @@ and then removes the folder (directory) itself."
(mh-exec-cmd-daemon "rmf" folder)
(setq mh-folder-list
(delq (assoc folder mh-folder-list) mh-folder-list))
(when (boundp 'mh-speed-folder-map)
(mh-speed-invalidate-map folder))
(run-hooks 'mh-folder-list-change-hook)
(message "Folder %s removed" folder)
(mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
@ -110,6 +116,8 @@ and then removes the folder (directory) itself."
(kill-buffer folder)))
(message "Folder not removed")))
;; Avoid compiler warning...
(defvar view-exit-action)
(defun mh-list-folders ()
"List mail folders."
@ -120,7 +128,7 @@ and then removes the folder (directory) itself."
(set-buffer temp-buffer)
(erase-buffer)
(message "Listing folders...")
(mh-exec-cmd-output "folders" t (if mh-recursive-folders
(mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
"-recurse"
"-norecurse"))
(goto-char (point-min))
@ -128,12 +136,11 @@ and then removes the folder (directory) itself."
(setq view-exit-action 'kill-buffer)
(message "Listing folders...done")))))
(defun mh-pack-folder (range)
"Renumber the messages of a folder to be 1..n.
First, offer to execute any outstanding commands for the current folder.
If optional prefix argument provided, prompt for the RANGE of messages
to display after packing. Otherwise, show the entire folder."
First, offer to execute any outstanding commands for the current folder. If
optional prefix argument provided, prompt for the RANGE of messages to display
after packing. Otherwise, show the entire folder."
(interactive (list (if current-prefix-arg
(mh-read-msg-range
"Range to scan after packing [all]? ")
@ -142,18 +149,19 @@ to display after packing. Otherwise, show the entire folder."
(mh-goto-cur-msg)
(message "Packing folder...done"))
(defun mh-pack-folder-1 (range)
;; Close and pack the current folder.
"Close and pack the current folder.
Display the given RANGE of messages after packing. If RANGE is nil, show the
entire folder."
(mh-process-or-undo-commands mh-current-folder)
(message "Packing folder...")
(mh-set-folder-modified-p t) ; lock folder while packing
(save-excursion
(mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
"-norecurse" "-fast"))
(mh-reset-threads-and-narrowing)
(mh-regenerate-headers range))
(defun mh-pipe-msg (command include-headers)
"Pipe the current message through the given shell COMMAND.
If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
@ -171,7 +179,6 @@ Otherwise just send the message's body without the headers."
(let ((default-directory message-directory))
(shell-command-on-region (point) (point-max) command nil)))))
(defun mh-page-digest ()
"Advance displayed message to next digested message."
(interactive)
@ -188,7 +195,6 @@ Otherwise just send the message's body without the headers."
(forward-line 2)
(mh-recenter 0)))
(defun mh-page-digest-backwards ()
"Back up displayed message to previous digested message."
(interactive)
@ -205,12 +211,11 @@ Otherwise just send the message's body without the headers."
(forward-line 2))
(mh-recenter 0)))
(defun mh-print-msg (msg-or-seq)
"Print MSG-OR-SEQ (default: displayed message) on printer.
If optional prefix argument provided, then prompt for the message sequence.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'."
The messages are formatted by mhl. See the variable `mhl-formfile'."
(interactive (list (if current-prefix-arg
(reverse (mh-seq-to-msgs
(mh-read-seq-default "Print" t)))
@ -244,7 +249,7 @@ The messages are formatted by mhl. See the variable `mhl-formfile'."
msg-or-seq)
(format "Sequence from %s"
mh-current-folder)))))))
(if mh-print-background
(if mh-print-background-flag
(mh-exec-cmd-daemon shell-file-name "-c" print-command)
(call-process shell-file-name nil nil nil "-c" print-command))
(if (numberp msg-or-seq)
@ -255,17 +260,15 @@ The messages are formatted by mhl. See the variable `mhl-formfile'."
(message "Printing message...done")
(message "Printing sequence...done"))))
(defun mh-msg-filenames (msgs &optional folder)
;; Return a list of file names for MSGS in FOLDER (default current folder).
"Return a list of file names for MSGS in FOLDER (default current folder)."
(mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
(defun mh-sort-folder (&optional extra-args)
"Sort the messages in the current folder by date.
Calls the MH program sortm to do the work.
The arguments in the list `mh-sortm-args' are passed to sortm
if the optional argument EXTRA-ARGS is given."
The arguments in the list `mh-sortm-args' are passed to sortm if the optional
argument EXTRA-ARGS is given."
(interactive "P")
(mh-process-or-undo-commands mh-current-folder)
(setq mh-next-direction 'forward)
@ -275,12 +278,11 @@ if the optional argument EXTRA-ARGS is given."
(message "Sorting folder...done")
(mh-scan-folder mh-current-folder "all"))
(defun mh-undo-folder (&rest ignore)
"Undo all pending deletes and refiles in current folder.
Argument IGNORE is deprecated."
(interactive)
(cond ((or mh-do-not-confirm
(cond ((or mh-do-not-confirm-flag
(yes-or-no-p "Undo all commands in folder? "))
(setq mh-delete-list nil
mh-refile-list nil
@ -292,7 +294,6 @@ Argument IGNORE is deprecated."
(message "Commands not undone.")
(sit-for 2))))
(defun mh-store-msg (directory)
"Store the file(s) contained in the current message into DIRECTORY.
The message can contain a shar file or uuencoded file.
@ -313,7 +314,8 @@ Default directory is the last directory used, or initially the value of
The buffer can contain a shar file or uuencoded file.
Default directory is the last directory used, or initially the value of
`mh-store-default-directory' or the current directory."
(interactive (list (let ((udir (or mh-store-default-directory default-directory)))
(interactive (list (let ((udir (or mh-store-default-directory
default-directory)))
(read-file-name "Store buffer in directory: "
udir udir nil))))
(let ((store-directory (expand-file-name directory))
@ -362,5 +364,42 @@ Default directory is the last directory used, or initially the value of
(set-buffer log-buffer)
(mh-handle-process-error command value))
(insert "\n(mh-store finished)\n")))
;;; Help Functions
(defun mh-ephem-message (string)
"Display STRING in the minibuffer momentarily."
(message "%s" string)
(sit-for 5)
(message ""))
(defun mh-help ()
"Display cheat sheet for the MH-Folder commands in minibuffer."
(interactive)
(mh-ephem-message
(substitute-command-keys
(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
(defun mh-prefix-help ()
"Display cheat sheet for the commands of the current prefix in minibuffer."
(interactive)
;; We got here because the user pressed a `?', but he pressed a prefix key
;; before that. Since the the key vector starts at index 0, the index of the
;; last keystroke is length-1 and thus the second to last keystroke is at
;; length-2. We use that information to obtain a suitable prefix character
;; from the recent keys.
(let* ((keys (recent-keys))
(prefix-char (elt keys (- (length keys) 2))))
(mh-ephem-message
(substitute-command-keys
(mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
(provide 'mh-funcs)
;;; Local Variables:
;;; sentence-end-double-space: nil
;;; End:
;;; mh-funcs.el ends here

1290
lisp/mail/mh-index.el Normal file
View file

File diff suppressed because it is too large Load diff

1052
lisp/mail/mh-mime.el
View file

File diff suppressed because it is too large Load diff

96
lisp/mail/mh-pick.el
View file

@ -1,4 +1,4 @@
;;; mh-pick.el --- make a search pattern and search for a message in mh-e
;;; mh-pick.el --- make a search pattern and search for a message in MH-E
;; Copyright (C) 1993, 1995, 2001 Free Software Foundation, Inc.
@ -26,21 +26,24 @@
;;; Commentary:
;; Internal support for mh-e package.
;; Internal support for MH-E package.
;;; Change Log:
;; $Id: mh-pick.el,v 1.11 2001/12/29 00:10:41 wohler Exp $
;; $Id: mh-pick.el,v 1.21 2002/11/05 21:43:16 wohler Exp $
;;; Code:
(provide 'mh-pick)
(require 'mh-e)
(require 'easymenu)
(require 'gnus-util)
(defvar mh-pick-mode-hook nil
"Invoked in `mh-pick-mode' on a new pattern.")
;;; Hooks
(defcustom mh-pick-mode-hook nil
"Invoked upon entry to `mh-pick-mode'."
:type 'hook
:group 'mh-hook)
;;; Internal variables:
@ -51,6 +54,7 @@
(defun mh-search-folder (folder)
"Search FOLDER for messages matching a pattern.
This function uses the MH command `pick' to do the work.
Add the messages found to the sequence named `search'."
(interactive (list (mh-prompt-for-folder "Search"
mh-current-folder
@ -60,10 +64,13 @@ Add the messages found to the sequence named `search'."
(not (y-or-n-p "Reuse pattern? ")))
(mh-make-pick-template)
(message ""))
(setq mh-searching-folder folder))
(setq mh-searching-folder folder)
(message "%s" (substitute-command-keys
(concat "Type \\[mh-do-pick-search] to search messages, "
"\\[mh-help] for help."))))
(defun mh-make-pick-template ()
;; Initialize the current buffer with a template for a pick pattern.
"Initialize the current buffer with a template for a pick pattern."
(erase-buffer)
(insert "From: \n"
"To: \n"
@ -75,10 +82,35 @@ Add the messages found to the sequence named `search'."
(goto-char (point-min))
(end-of-line))
;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
(easy-menu-define
mh-pick-menu mh-pick-mode-map "Menu for MH-E pick-mode"
'("Pick"
["Execute the Search" mh-do-pick-search t]))
;;; Help Messages
;;; Group messages logically, more or less.
(defvar mh-pick-mode-help-messages
'((nil
"Search messages: \\[mh-do-pick-search]\n"
"Move to a field by typing C-c C-f C-<field>\n"
"where <field> is the first letter of the desired field."))
"Key binding cheat sheet.
This is an associative array which is used to show the most common commands.
The key is a prefix char. The value is one or more strings which are
concatenated together and displayed in the minibuffer if ? is pressed after
the prefix character. The special key nil is used to display the
non-prefixed commands.
The substitutions described in `substitute-command-keys' are performed as
well.")
(put 'mh-pick-mode 'mode-class 'special)
(define-derived-mode mh-pick-mode fundamental-mode "MH-Pick"
"Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
"Mode for creating search templates in MH-E.\\<mh-pick-mode-map>
After each field name, enter the pattern to search for. If a field's
value does not matter for the search, leave it empty. To search the
@ -87,13 +119,16 @@ Each non-empty field must be matched for a message to be selected.
To effect a logical \"or\", use \\[mh-search-folder] multiple times.
When you have finished, type \\[mh-do-pick-search] to do the search.
This mode runs the hook `mh-pick-mode-hook'.
The value of `mh-pick-mode-hook' is a list of functions to be called,
with no arguments, upon entry to this mode.
\\{mh-pick-mode-map}"
(make-local-variable 'mh-searching-folder)
(easy-menu-add mh-pick-menu))
(easy-menu-add mh-pick-menu)
(make-local-variable 'mh-help-messages)
(setq mh-help-messages mh-pick-mode-help-messages)
(run-hooks 'mh-pick-mode-hook))
(defun mh-do-pick-search ()
"Find messages that match the qualifications in the current pattern buffer.
@ -104,7 +139,6 @@ Add the messages found to the sequence named `search'."
(searching-buffer mh-searching-folder)
range
msgs
(finding-messages t)
(pattern nil)
(new-buffer nil))
(save-excursion
@ -134,17 +168,16 @@ Add the messages found to the sequence named `search'."
(mh-add-msgs-to-seq msgs 'search)
(delete-other-windows)))
(defun mh-seq-from-command (folder seq seq-command)
;; In FOLDER, make a sequence named SEQ by executing COMMAND.
;; COMMAND is a list. The first element is a program name
;; and the subsequent elements are its arguments, all strings.
(defun mh-seq-from-command (folder seq command)
"In FOLDER, make a sequence named SEQ by executing COMMAND.
COMMAND is a list. The first element is a program name
and the subsequent elements are its arguments, all strings."
(let ((msg)
(msgs ())
(case-fold-search t))
(save-excursion
(save-window-excursion
(if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command))
(if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
;; "pick" outputs one number per line
(while (setq msg (car (mh-read-msg-list)))
(setq msgs (cons msg msgs))
@ -153,17 +186,16 @@ Add the messages found to the sequence named `search'."
(setq msgs (nreverse msgs)) ;put in ascending order
msgs)))
(defun mh-next-pick-field (buffer)
;; Return the next piece of a pick argument that can be extracted from the
;; BUFFER.
;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat")
;; or NIL if no pieces remain.
"Return the next piece of a pick argument extracted from BUFFER.
Return a list like (\"--fieldname\" \"pattern\") or (\"-search\" \"bodypat\")
or nil if no pieces remain."
(set-buffer buffer)
(let ((case-fold-search t))
(cond ((eobp)
nil)
((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
nil t)
(let* ((component
(format "--%s"
(downcase (buffer-substring (match-beginning 1)
@ -180,8 +212,12 @@ Add the messages found to the sequence named `search'."
(t
nil))))
;;; Build the pick-mode keymap:
;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
(gnus-define-keys mh-pick-mode-map
"\C-c?" mh-help
"\C-c\C-c" mh-do-pick-search
"\C-c\C-f\C-b" mh-to-field
"\C-c\C-f\C-c" mh-to-field
@ -198,10 +234,10 @@ Add the messages found to the sequence named `search'."
"\C-c\C-fs" mh-to-field
"\C-c\C-ft" mh-to-field)
;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
(easy-menu-define
mh-pick-menu mh-pick-mode-map "Menu for mh-e pick-mode"
'("Pick"
["Execute the Search" mh-do-pick-search t]))
(provide 'mh-pick)
;;; Local Variables:
;;; sentence-end-double-space: nil
;;; End:
;;; mh-pick.el ends here

884
lisp/mail/mh-seq.el
View file

File diff suppressed because it is too large Load diff

667
lisp/mail/mh-speed.el Normal file
View file

@ -0,0 +1,667 @@
;;; mh-speed.el --- Speedbar interface for MH-E.
;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Future versions should only use flists.
;; Speedbar support for MH-E package.
;;; Change Log:
;; $Id: mh-speed.el,v 1.26 2002/11/13 19:36:00 wohler Exp $
;;; Code:
;; Requires
(require 'cl)
(require 'mh-utils)
(require 'mh-e)
(require 'speedbar)
;; Autoloads
(autoload 'mh-index-goto-nearest-msg "mh-index")
(autoload 'mh-index-parse-folder "mh-index")
(autoload 'mh-visit-folder "mh-e")
;; User customizable
(defcustom mh-large-folder 200
"The number of messages that indicates a large folder.
If the number of messages in a folder exceeds this value, confirmation is
required when the folder is visited from the speedbar."
:type 'integer
:group 'mh)
(defcustom mh-speed-flists-interval 60
"Time between calls to flists in seconds.
If 0, flists is not called repeatedly."
:type 'integer
:group 'mh)
(defcustom mh-speed-run-flists-flag t
"Non-nil means flists is used.
If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
update the display of the number of unseen and total messages in each folder.
If resources are limited, this can be set to nil and the speedbar display can
be updated manually with the \\[mh-speed-flists] command."
:type 'boolean
:group 'mh)
(defface mh-speedbar-folder-face
'((((class color) (background light))
(:foreground "blue4"))
(((class color) (background dark))
(:foreground "light blue")))
"Face used for folders in the speedbar buffer."
:group 'mh)
(defface mh-speedbar-selected-folder-face
'((((class color) (background light))
(:foreground "red" :underline t))
(((class color) (background dark))
(:foreground "red" :underline t))
(t (:underline t)))
"Face used for the current folder."
:group 'mh)
(defface mh-speedbar-folder-with-unseen-messages-face
'((t (:inherit mh-speedbar-folder-face :bold t)))
"Face used for folders in the speedbar buffer which have unread messages."
:group 'mh)
(defface mh-speedbar-selected-folder-with-unseen-messages-face
'((t (:inherit mh-speedbar-selected-folder-face :bold t)))
"Face used for the current folder when it has unread messages."
:group 'mh)
;; Global variables
(defvar mh-speed-refresh-flag nil)
(defvar mh-speed-last-selected-folder nil)
(defvar mh-speed-folder-map (make-hash-table :test #'equal))
(defvar mh-speed-folders-cache (make-hash-table :test #'equal))
(defvar mh-speed-flists-cache (make-hash-table :test #'equal))
(defvar mh-speed-flists-process nil)
(defvar mh-speed-flists-timer nil)
(defvar mh-speed-partial-line "")
;; Add our stealth update function
(unless (member 'mh-speed-stealth-update
(cdr (assoc "files" speedbar-stealthy-function-list)))
;; Is changing constant lists in elisp safe?
(setq speedbar-stealthy-function-list
(copy-tree speedbar-stealthy-function-list))
(push 'mh-speed-stealth-update
(cdr (assoc "files" speedbar-stealthy-function-list))))
;; Functions called by speedbar to initialize display...
(defun mh-folder-speedbar-buttons (buffer)
"Interface function to create MH-E speedbar buffer.
BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
(unless (get-text-property (point-min) 'mh-level)
(erase-buffer)
(clrhash mh-speed-folder-map)
(speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil
'mh-speedbar-folder-face 0)
(forward-line -1)
(setf (gethash nil mh-speed-folder-map)
(set-marker (make-marker) (1+ (line-beginning-position))))
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
`(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
(mh-speed-stealth-update t)
(when mh-speed-run-flists-flag
(mh-speed-flists nil))))
(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
(defalias 'mh-index-folder-speedbar-buttons 'mh-folder-speedbar-buttons)
(defalias 'mh-index-show-speedbar-buttons 'mh-folder-speedbar-buttons)
(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
;; Keymaps for speedbar...
(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
"Specialized speedbar keymap for MH-E buffers.")
(gnus-define-keys mh-folder-speedbar-key-map
"+" mh-speed-expand-folder
"-" mh-speed-contract-folder
"\r" mh-speed-view
"f" mh-speed-flists
"i" mh-speed-invalidate-map)
(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
(defvar mh-index-folder-speedbar-key-map mh-folder-speedbar-key-map)
(defvar mh-index-show-speedbar-key-map mh-folder-speedbar-key-map)
(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
;; Menus for speedbar...
(defvar mh-folder-speedbar-menu-items
'(["Visit Folder" mh-speed-view
(save-excursion
(set-buffer speedbar-buffer)
(get-text-property (line-beginning-position) 'mh-folder))]
["Expand nested folders" mh-speed-expand-folder
(and (get-text-property (line-beginning-position) 'mh-children-p)
(not (get-text-property (line-beginning-position) 'mh-expanded)))]
["Contract nested folders" mh-speed-contract-folder
(and (get-text-property (line-beginning-position) 'mh-children-p)
(get-text-property (line-beginning-position) 'mh-expanded))]
["Run Flists" mh-speed-flists t]
["Invalidate cached folders" mh-speed-invalidate-map t])
"Extra menu items for speedbar.")
(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
(defvar mh-index-folder-speedbar-menu-items mh-folder-speedbar-menu-items)
(defvar mh-index-show-speedbar-menu-items mh-folder-speedbar-menu-items)
(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
(defmacro mh-speed-select-attached-frame ()
"Compatibility macro to handle speedbar versions 0.11a and 0.14beta4."
(cond ((fboundp 'dframe-select-attached-frame)
'(dframe-select-attached-frame speedbar-frame))
((boundp 'speedbar-attached-frame)
'(select-frame speedbar-attached-frame))
(t (error "Installed speedbar version not supported by MH-E"))))
(defun mh-speed-update-current-folder (force)
"Update speedbar highlighting of the current folder.
The function tries to be smart so that work done is minimized. The currently
highlighted folder is cached and no highlighting happens unless it changes.
Also highlighting is suspended while the speedbar frame is selected.
Otherwise you get the disconcerting behavior of folders popping open on their
own when you are trying to navigate around in the speedbar buffer.
The update is always carried out if FORCE is non-nil."
(let* ((lastf (selected-frame))
(newcf (save-excursion
(mh-speed-select-attached-frame)
(prog1 (mh-speed-extract-folder-name (buffer-name))
(select-frame lastf))))
(lastb (current-buffer))
(case-fold-search t))
(when (or force
(and mh-speed-refresh-flag (not (eq lastf speedbar-frame)))
(and (stringp newcf)
(equal (substring newcf 0 1) "+")
(not (equal newcf mh-speed-last-selected-folder))))
(setq mh-speed-refresh-flag nil)
(select-frame speedbar-frame)
(set-buffer speedbar-buffer)
;; Remove highlight from previous match...
(mh-speed-highlight mh-speed-last-selected-folder
'mh-speedbar-folder-face)
;; If we found a match highlight it...
(when (mh-speed-goto-folder newcf)
(mh-speed-highlight newcf 'mh-speedbar-selected-folder-face))
(setq mh-speed-last-selected-folder newcf)
(speedbar-position-cursor-on-line)
(set-window-point (frame-first-window speedbar-frame) (point))
(set-buffer lastb)
(select-frame lastf))
(when (eq lastf speedbar-frame)
(setq mh-speed-refresh-flag t))))
(defun mh-speed-normal-face (face)
"Return normal face for given FACE."
(cond ((eq face 'mh-speedbar-folder-with-unseen-messages-face)
'mh-speedbar-folder-face)
((eq face 'mh-speedbar-selected-folder-with-unseen-messages-face)
'mh-speedbar-selected-folder-face)
(t face)))
(defun mh-speed-bold-face (face)
"Return bold face for given FACE."
(cond ((eq face 'mh-speedbar-folder-face)
'mh-speedbar-folder-with-unseen-messages-face)
((eq face 'mh-speedbar-selected-folder-face)
'mh-speedbar-selected-folder-with-unseen-messages-face)
(t face)))
(defun mh-speed-highlight (folder face)
"Set FOLDER to FACE."
(save-excursion
(speedbar-with-writable
(goto-char (gethash folder mh-speed-folder-map (point)))
(beginning-of-line)
(if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
(setq face (mh-speed-bold-face face))
(setq face (mh-speed-normal-face face)))
(beginning-of-line)
(when (re-search-forward "\\[.\\] " (line-end-position) t)
(put-text-property (point) (line-end-position) 'face face)))))
(defun mh-speed-stealth-update (&optional force)
"Do stealth update.
With non-nil FORCE, the update is always carried out."
(cond ((save-excursion (set-buffer speedbar-buffer)
(get-text-property (point-min) 'mh-level))
;; Execute this hook and *don't* run anything else
(mh-speed-update-current-folder force)
nil)
;; Otherwise on to your regular programming
(t t)))
(defun mh-speed-goto-folder (folder)
"Move point to line containing FOLDER.
The function will expand out parent folders of FOLDER if needed."
(let ((prefix folder)
(suffix-list ())
(last-slash t))
(while (and (not (gethash prefix mh-speed-folder-map)) last-slash)
(setq last-slash (search "/" prefix :from-end t))
(when (integerp last-slash)
(push (substring prefix (1+ last-slash)) suffix-list)
(setq prefix (substring prefix 0 last-slash))))
(let ((prefix-position (gethash prefix mh-speed-folder-map)))
(if prefix-position
(goto-char prefix-position)
(goto-char (point-min))
(mh-speed-toggle)
(unless (get-text-property (point) 'mh-expanded)
(mh-speed-toggle))
(goto-char (gethash prefix mh-speed-folder-map))))
(while suffix-list
;; We always need atleast one toggle. We need two if the directory list
;; is stale since a folder was added.
(when (equal prefix (get-text-property (line-beginning-position)
'mh-folder))
(mh-speed-toggle)
(unless (get-text-property (point) 'mh-expanded)
(mh-speed-toggle)))
(setq prefix (format "%s/%s" prefix (pop suffix-list)))
(goto-char (gethash prefix mh-speed-folder-map (point))))
(beginning-of-line)
(equal folder (get-text-property (point) 'mh-folder))))
(defun mh-speed-extract-folder-name (buffer)
"Given an MH-E BUFFER find the folder that should be highlighted.
Do the right thing for the different kinds of buffers that MH-E uses."
(save-excursion
(set-buffer buffer)
(cond ((eq major-mode 'mh-folder-mode)
mh-current-folder)
((eq major-mode 'mh-show-mode)
(set-buffer mh-show-folder-buffer)
mh-current-folder)
((eq major-mode 'mh-index-folder-mode)
(save-excursion
(mh-index-goto-nearest-msg)
(mh-index-parse-folder)))
((or (eq major-mode 'mh-index-show-mode)
(eq major-mode 'mh-letter-mode))
(when (string-match mh-user-path buffer-file-name)
(let* ((rel-path (substring buffer-file-name (match-end 0)))
(directory-end (search "/" rel-path :from-end t)))
(when directory-end
(format "+%s" (substring rel-path 0 directory-end)))))))))
(defun mh-speed-add-buttons (folder level)
"Add speedbar button for FOLDER which is at indented by LEVEL amount."
(let ((folder-list (mh-speed-folders folder)))
(mapc
(lambda (f)
(let* ((folder-name (format "%s%s%s" (or folder "+")
(if folder "/" "") (car f)))
(counts (gethash folder-name mh-speed-flists-cache)))
(speedbar-with-writable
(speedbar-make-tag-line
'bracket (if (cdr f) ?+ ? )
'mh-speed-toggle nil
(format "%s%s"
(car f)
(if counts
(format " (%s/%s)" (car counts) (cdr counts))
""))
'mh-speed-view nil
(if (and counts (> (car counts) 0))
'mh-speedbar-folder-with-unseen-messages-face
'mh-speedbar-folder-face)
level)
(save-excursion
(forward-line -1)
(setf (gethash folder-name mh-speed-folder-map)
(set-marker (make-marker) (1+ (line-beginning-position))))
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
`(mh-folder ,folder-name
mh-expanded nil
mh-children-p ,(not (not (cdr f)))
,@(if counts `(mh-count (,(car counts) . ,(cdr counts))) ())
mh-level ,level))))))
folder-list)))
(defun mh-speed-toggle (&rest args)
"Toggle the display of child folders.
The otional ARGS are ignored and there for compatibilty with speedbar."
(interactive)
(declare (ignore args))
(beginning-of-line)
(let ((parent (get-text-property (point) 'mh-folder))
(kids-p (get-text-property (point) 'mh-children-p))
(expanded (get-text-property (point) 'mh-expanded))
(level (get-text-property (point) 'mh-level))
(point (point))
start-region)
(speedbar-with-writable
(cond ((not kids-p) nil)
(expanded
(forward-line)
(setq start-region (point))
(while (and (get-text-property (point) 'mh-level)
(> (get-text-property (point) 'mh-level) level))
(remhash (get-text-property (point) 'mh-folder)
mh-speed-folder-map)
(forward-line))
(delete-region start-region (point))
(forward-line -1)
(speedbar-change-expand-button-char ?+)
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
'(mh-expanded nil)))
(t
(forward-line)
(mh-speed-add-buttons parent (1+ level))
(goto-char point)
(speedbar-change-expand-button-char ?-)
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
`(mh-expanded t)))))))
(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
(defun mh-speed-folder-size ()
"Find folder size if folder on current line."
(let ((folder (get-text-property (line-beginning-position) 'mh-folder)))
(or (cdr (get-text-property (line-beginning-position) 'mh-count))
(and (null folder) 0)
(with-temp-buffer
(call-process (expand-file-name "flist" mh-progs) nil t nil
"-norecurse" folder)
(goto-char (point-min))
(unless (re-search-forward "out of " (line-end-position) t)
(error "Call to flist failed on folder %s" folder))
(car (read-from-string
(buffer-substring-no-properties (point)
(line-end-position))))))))
(defun mh-speed-view (&rest args)
"View folder on current line.
Optional ARGS are ignored."
(interactive)
(declare (ignore args))
(let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
(range
(cond ((save-excursion
(beginning-of-line)
(re-search-forward "([1-9][0-9]*/[0-9]+)"
(line-end-position) t))
mh-unseen-seq)
((> (mh-speed-folder-size) mh-large-folder)
(let* ((size (mh-speed-folder-size))
(prompt
(format "How many messages from %s (default: %s): "
folder size))
(in (read-string prompt nil nil
(number-to-string size)))
(result (car (ignore-errors (read-from-string in)))))
(cond ((null result) (format "last:%s" size))
((numberp result) (format "last:%s" result))
(t (format "%s" result)))))
(t nil))))
(when (stringp folder)
(speedbar-with-attached-buffer
(mh-visit-folder folder range)
(delete-other-windows)))))
(defun mh-speed-folders (folder)
"Find the subfolders of FOLDER.
The function avoids running folders unnecessarily by caching the results of
the actual folders call."
(let ((match (gethash folder mh-speed-folders-cache 'no-result)))
(cond ((eq match 'no-result)
(setf (gethash folder mh-speed-folders-cache)
(mh-speed-folders-actual folder)))
(t match))))
(defun mh-speed-folders-actual (folder)
"Execute the command folders to return the sub-folders of FOLDER.
Filters out the folder names that start with \".\" so that directories that
aren't usually mail folders are hidden."
(let* ((folder (cond ((and (stringp folder)
(equal (substring folder 0 1) "+"))
folder)
(t nil)))
(arg-list `(,(expand-file-name "folders" mh-progs)
nil (t nil) nil "-noheader" "-norecurse"
,@(if (stringp folder) (list folder) ())))
(results ()))
(with-temp-buffer
(apply #'call-process arg-list)
(goto-char (point-min))
(while (not (and (eolp) (bolp)))
(let ((folder-end (or (search-forward "+ " (line-end-position) t)
(search-forward " " (line-end-position) t))))
(when (integerp folder-end)
(let ((name (buffer-substring (line-beginning-position)
(match-beginning 0))))
(let ((first-char (substring name 0 1)))
(unless (or (string-equal first-char ".")
(string-equal first-char "#")
(string-equal first-char ","))
(push
(cons name
(search-forward "(others)" (line-end-position) t))
results)))))
(forward-line 1))))
(setq results (nreverse results))
(when (stringp folder)
(setq results (cdr results))
(let ((folder-name-len (length (format "%s/" (substring folder 1)))))
(setq results (mapcar (lambda (f)
(cons (substring (car f) folder-name-len)
(cdr f)))
results))))
results))
(defun mh-speed-flists (force)
"Execute flists -recurse and update message counts.
If FORCE is non-nil the timer is reset."
(interactive (list t))
(when force
(when (timerp mh-speed-flists-timer)
(cancel-timer mh-speed-flists-timer))
(setq mh-speed-flists-timer nil)
(when (and (processp mh-speed-flists-process)
(not (eq (process-status mh-speed-flists-process) 'exit)))
(kill-process mh-speed-flists-process)
(setq mh-speed-flists-process nil)))
(unless mh-speed-flists-timer
(setq mh-speed-flists-timer
(run-at-time
nil mh-speed-flists-interval
(lambda ()
(unless (and (processp mh-speed-flists-process)
(not (eq (process-status mh-speed-flists-process)
'exit)))
(setq mh-speed-flists-process
(start-process (expand-file-name "flists" mh-progs) nil
"flists" "-recurse"))
(set-process-filter mh-speed-flists-process
'mh-speed-parse-flists-output)))))))
;; Copied from mh-make-folder-list-filter...
(defun mh-speed-parse-flists-output (process output)
"Parse the incremental results from flists.
PROCESS is the flists process and OUTPUT is the results that must be handled
next."
(let ((prevailing-match-data (match-data))
(position 0)
line-end line folder unseen total)
(unwind-protect
(while (setq line-end (string-match "\n" output position))
(setq line (format "%s%s"
mh-speed-partial-line
(substring output position line-end))
mh-speed-partial-line "")
(when (string-match "+? " line)
(setq folder (format "+%s" (subseq line 0 (match-beginning 0))))
(when (string-match " has " line)
(setq unseen (car (read-from-string line (match-end 0))))
(when (string-match "; out of " line)
(setq total (car (read-from-string line (match-end 0))))
(setf (gethash folder mh-speed-flists-cache)
(cons unseen total))
(save-excursion
(when (buffer-live-p (get-buffer speedbar-buffer))
(set-buffer speedbar-buffer)
(speedbar-with-writable
(when (get-text-property (point-min) 'mh-level)
(let ((pos (gethash folder mh-speed-folder-map))
face)
(when pos
(goto-char pos)
(goto-char (line-beginning-position))
(cond
((null (get-text-property (point) 'mh-count))
(goto-char (line-end-position))
(setq face (get-text-property (1- (point))
'face))
(insert (format " (%s/%s)" unseen total))
(mh-speed-highlight 'unknown face)
(goto-char (line-beginning-position))
(add-text-properties
(point) (1+ (point))
`(mh-count (,unseen . ,total))))
((not
(equal (get-text-property (point) 'mh-count)
(cons unseen total)))
(goto-char (line-end-position))
(setq face (get-text-property (1- (point))
'face))
(re-search-backward
" " (line-beginning-position) t)
(delete-region (point) (line-end-position))
(insert (format " (%s/%s)" unseen total))
(mh-speed-highlight 'unknown face)
(goto-char (line-beginning-position))
(add-text-properties
(point) (1+ (point))
`(mh-count (,unseen . ,total))))))))))))))
(setq position (1+ line-end)))
(set-match-data prevailing-match-data))
(setq mh-speed-partial-line (subseq output position))))
(defun mh-speed-invalidate-map (folder)
"Remove FOLDER from various optimization caches."
(interactive (list ""))
(save-excursion
(set-buffer speedbar-buffer)
(let* ((speedbar-update-flag nil)
(last-slash (search "/" folder :from-end t))
(parent (if last-slash (substring folder 0 last-slash) nil))
(parent-position (gethash parent mh-speed-folder-map))
(parent-change nil))
(remhash parent mh-speed-folders-cache)
(remhash folder mh-speed-folders-cache)
(when parent-position
(let ((parent-kids (mh-speed-folders parent)))
(cond ((null parent-kids)
(setq parent-change ?+))
((and (null (cdr parent-kids))
(equal (if last-slash
(substring folder (1+ last-slash))
(substring folder 1))
(caar parent-kids)))
(setq parent-change ? ))))
(goto-char parent-position)
(when (equal (get-text-property (line-beginning-position) 'mh-folder)
parent)
(when (get-text-property (line-beginning-position) 'mh-expanded)
(mh-speed-toggle))
(when parent-change
(speedbar-with-writable
(mh-speedbar-change-expand-button-char parent-change)
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
`(mh-children-p ,(equal parent-change ?+)))))
(mh-speed-highlight mh-speed-last-selected-folder
'mh-speedbar-folder-face)
(setq mh-speed-last-selected-folder nil)
(setq mh-speed-refresh-flag t)))
(when (equal folder "")
(clrhash mh-speed-folders-cache)))))
(defun mh-speed-add-folder (folder)
"Add FOLDER since it is being created.
The function invalidates the latest ancestor that is present."
(save-excursion
(set-buffer speedbar-buffer)
(let ((speedbar-update-flag nil)
(last-slash (search "/" folder :from-end t))
(ancestor folder)
(ancestor-pos nil))
(block while-loop
(while last-slash
(setq ancestor (substring ancestor 0 last-slash))
(setq ancestor-pos (gethash ancestor mh-speed-folder-map))
(when ancestor-pos
(return-from while-loop))
(setq last-slash (search "/" ancestor :from-end t))))
(unless ancestor-pos (setq ancestor nil))
(goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
(speedbar-with-writable
(mh-speedbar-change-expand-button-char ?+)
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
`(mh-children-p t)))
(when (get-text-property (line-beginning-position) 'mh-expanded)
(mh-speed-toggle))
(remhash ancestor mh-speed-folders-cache)
(setq mh-speed-refresh-flag t))))
;; Make it slightly more general to allow for [ ] buttons to be changed to
;; [+].
(defun mh-speedbar-change-expand-button-char (char)
"Change the expansion button character to CHAR for the current line."
(save-excursion
(beginning-of-line)
(if (re-search-forward "\\[.\\]" (line-end-position) t)
(speedbar-with-writable
(backward-char 2)
(delete-char 1)
(insert-char char 1 t)
(put-text-property (point) (1- (point)) 'invisible nil)
;; make sure we fix the image on the text here.
(speedbar-insert-image-button-maybe (- (point) 2) 3)))))
(provide 'mh-speed)
;;; Local Variables:
;;; sentence-end-double-space: nil
;;; End:
;;; mh-speed.el ends here

2031
lisp/mail/mh-utils.el
View file

File diff suppressed because it is too large Load diff

79
lisp/mail/mh-xemacs-compat.el
View file

@ -28,76 +28,35 @@
;;; Change Log:
;; $Id: mh-xemacs-compat.el,v 1.7 2002/04/07 19:20:55 wohler Exp $
;; $Id: mh-xemacs-compat.el,v 1.12 2002/11/02 19:56:50 wohler Exp $
;;; Code:
;;; Some requires:
(require 'rfc822)
;;; Simple compatibility:
(unless (fboundp 'match-string-no-properties)
(defalias 'match-string-no-properties 'match-string))
(defsubst match-string-no-properties (match)
(buffer-substring-no-properties
(match-beginning match) (match-end match))))
;;; Functions from simple.el of Emacs-21.1
;;; simple.el --- basic editing commands for Emacs
(unless (fboundp 'line-beginning-position)
(defalias 'line-beginning-position 'point-at-bol))
(unless (fboundp 'line-end-position)
(defalias 'line-end-position 'point-at-eol))
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
;; Free Software Foundation, Inc.
(unless (fboundp 'timerp)
(defalias 'timerp 'itimerp))
(unless (fboundp 'cancel-timer)
(defalias 'cancel-timer 'delete-itimer))
(defun rfc822-goto-eoh ()
;; Go to header delimiter line in a mail message, following RFC822 rules
(goto-char (point-min))
(while (looking-at "^[^: \n]+:\\|^[ \t]")
(forward-line 1))
(point))
;;; Functions from sendmail.el of Emacs-21.1
;;; sendmail.el --- mail sending commands for Emacs.
;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001
;; Free Software Foundation, Inc.
(defun mail-header-end ()
"Return the buffer location of the end of headers, as a number."
(save-restriction
(widen)
(save-excursion
(rfc822-goto-eoh)
(point))))
(defun mail-mode-fill-paragraph (arg)
;; Do something special only if within the headers.
(if (< (point) (mail-header-end))
(let (beg end fieldname)
(when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
(setq beg (point)))
(setq fieldname
(downcase (buffer-substring beg (1- (match-end 0))))))
(forward-line 1)
;; Find continuation lines and get rid of their continuation markers.
(while (looking-at "[ \t]")
(delete-horizontal-space)
(forward-line 1))
(setq end (point-marker))
(goto-char beg)
;; If this field contains addresses,
;; make sure we can fill after each address.
(if (member fieldname
'("to" "cc" "bcc" "from" "reply-to"
"resent-to" "resent-cc" "resent-bcc"
"resent-from" "resent-reply-to"))
(while (search-forward "," end t)
(or (looking-at "[ \t]")
(insert " "))))
(fill-region-as-paragraph beg end)
;; Mark all lines except the first as continuations.
(goto-char beg)
(forward-line 1)
(while (< (point) end)
(insert " ")
(forward-line 1))
(move-marker end nil)
t)))
(provide 'mh-xemacs-compat)
;;; Local Variables:
;;; sentence-end-double-space: nil
;;; End:
;;; mh-xemacs-compat.el ends here

BIN
lisp/toolbar/reply-all.pbm Normal file
View file

Binary file not shown.

38
lisp/toolbar/reply-all.xpm Normal file
View file

@ -0,0 +1,38 @@
/* XPM */
static char * reply_all_xpm[] = {
/* columns rows colors chars-per-pixel */
"24 24 9 1",
" c None",
". 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 ",
" "};

BIN
lisp/toolbar/reply-from.pbm Normal file
View file

Binary file not shown.

38
lisp/toolbar/reply-from.xpm Normal file
View file

@ -0,0 +1,38 @@
/* XPM */
static char * reply_from_xpm[] = {
/* columns rows colors chars-per-pixel */
"24 24 9 1",
" c None",
". 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 . ",
" "};

BIN
lisp/toolbar/reply-to.pbm Normal file
View file

Binary file not shown.

38
lisp/toolbar/reply-to.xpm Normal file
View file

@ -0,0 +1,38 @@
/* XPM */
static char * reply_to_xpm[] = {
/* columns rows colors chars-per-pixel */
"24 24 9 1",
" c None",
". 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 .... ",
" "};