Upgraded to MH-E version 7.2.
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
This commit is contained in:
Bill Wohler
parent
6ed8207227
commit
3d7ca22355
19 changed files with 7602 additions and 649 deletions
|
|
@ -1,3 +1,7 @@
|
|||
2003-02-03 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* MH-E-NEWS: Upgraded to MH-E version 7.2.
|
||||
|
||||
2003-01-31 Joe Buehler <jhpb@draco.hekimian.com>
|
||||
|
||||
* MACHINES: Added Cygwin.
|
||||
|
|
|
|||
151
etc/MH-E-NEWS
151
etc/MH-E-NEWS
|
|
@ -1,4 +1,151 @@
|
|||
* Changes in mh-e 7.1
|
||||
* Changes in MH-E 7.2
|
||||
|
||||
This release includes the new features of filing hints, hierarchical
|
||||
file name completion, indexed search and pick integration, unification
|
||||
between `mh-visit-folder' and the speedbar, a displayed message
|
||||
indicator, buffer name organization, support for mairix indexed
|
||||
search, and last but not least, the MH-E logo has been added to the
|
||||
mode line. Code that handles sequences and message regions runs
|
||||
faster. Bugs have been fixed.
|
||||
|
||||
** New Features in MH-E 7.2
|
||||
|
||||
*** Filing Hints
|
||||
|
||||
When you file a message, MH-E now looks for an alias corresponding to
|
||||
the address of the sender and offers that as a default folder (closes
|
||||
SF #657096). The new variable `mh-default-folder-prefix' can be used
|
||||
to put these folders in a sub-folder. The new variable
|
||||
`mh-default-folder-must-exist-flag' means to suppress the suggested
|
||||
folder (thereby providing the previous folder used) if the folder
|
||||
doesn't already exist. The new variable `mh-default-folder-list' can
|
||||
be used to map additional addresses and folders.
|
||||
|
||||
*** Hierarchical File Name Completion
|
||||
|
||||
When you completed filenames in the past, you were presented with a
|
||||
list of all your folders at all depths in the tree. Now you are
|
||||
presented with only one level at a time (closes SF #664821).
|
||||
As a result, the variables `mh-auto-folder-collect-flag' and
|
||||
`mh-folder-list-change-hook' are obsolete.
|
||||
|
||||
*** Indexed Search and Pick Integration
|
||||
|
||||
The indexed and pick searches have been integrated (closes SF
|
||||
#664816). Both "F s (mh-search-folder)" and "F i (mh-index-search)"
|
||||
use the pick template for forming queries. To submit the query, use
|
||||
"C-c C-c (mh-do-search)" which will use the query method you selected.
|
||||
If you change your mind while forming the query, you can use "C-c C-i
|
||||
(mh-index-do-search)" or "C-c C-p (mh-pick-do-search)" to submit the
|
||||
query using the respective method.
|
||||
|
||||
Second, the results from a pick search are now saved in a sub-folder
|
||||
of +mhe-index like an indexed search.
|
||||
|
||||
Third, `pick' is now a valid choice for `mh-index-program'.
|
||||
|
||||
*** mh-visit-folder Metamorphosis Continues
|
||||
|
||||
When visiting a folder from the speedbar, only the unseen messages are
|
||||
shown if there are unseen messages. If there aren't any unseen
|
||||
messages, all of the messages are shown if there are fewer than
|
||||
`mh-large-folder' messages; otherwise, the user is prompted for the
|
||||
range of messages to display. The "F v (mh-visit-folder)" command has
|
||||
been modified to mimic this behavior. Use a prefix arg to force the
|
||||
message range prompt.
|
||||
|
||||
*** Displayed Message Indicator
|
||||
|
||||
In graphical Emacs, the message that is shown is marked by a triangle
|
||||
in the fringe. In textual Emacs, there is a ">" in the first column
|
||||
(closes SF #664824).
|
||||
|
||||
*** Buffer Name Organization
|
||||
|
||||
All ephemeral buffer names start with " *mh" while all interesting
|
||||
buffers start with "*MH-E ". The "*Folders*", "*Sequences*", and
|
||||
"*Recipients*" buffers were therefore renamed to "*MH-E Folders*",
|
||||
"*MH-E Sequences*" and "*MH-E Recipients*" respectively (programmers
|
||||
should see mh-utils.el for the names of the new constants). Also, the
|
||||
output of MH commands is saved in the "*MH-E Log*" buffer.
|
||||
|
||||
*** mh-index-program
|
||||
|
||||
Add choices for `mairix' and `pick'.
|
||||
|
||||
*** Logo Displayed on Mode Line
|
||||
|
||||
** New Variables in MH-E 7.2
|
||||
|
||||
The new variables have been discussed elsewhere.
|
||||
|
||||
** Bug Fixes in MH-E 7.2
|
||||
|
||||
*** mh-decode-content-transfer-encoded-message
|
||||
|
||||
Messages that had been encoded with base64 were not decoded. This has
|
||||
been fixed with this new function (closes SF #674190). As a result,
|
||||
the variable `mh-decode-quoted-printable-flag' has been renamed to
|
||||
`mh-decode-content-transfer-encoded-message-flag'.
|
||||
|
||||
*** mh-kill-folder
|
||||
|
||||
Now restores previous window configuration (closes SF #664828).
|
||||
|
||||
*** mh-mime-display
|
||||
|
||||
MH-E was not using the charset defined in the content-type
|
||||
header. This meant that mail in a different charset would not
|
||||
be properly displayed. This has been fixed (closes SF #655123).
|
||||
|
||||
*** mh-read-address
|
||||
|
||||
In XEmacs and Emacs20, this function would always prompt using "To: "
|
||||
instead of using the command argument. This has been fixed (closes SF
|
||||
#670913).
|
||||
|
||||
*** mh-rmail
|
||||
|
||||
Unseen messages are now shown in addition to new ones (closes SF
|
||||
#667542).
|
||||
|
||||
*** mh-scan-msg-overflow-regexp
|
||||
|
||||
Change the variable so that a space is always maintained in the
|
||||
beginning of the scan line.
|
||||
|
||||
*** mh-swish-execute-search
|
||||
|
||||
The example configuration file in the docstring didn't show the
|
||||
backslash in the FileRules filename. If the example had been used
|
||||
literally by the user, no files would be indexed! This has been fixed
|
||||
(closes SF #665888).
|
||||
|
||||
*** mh-thread-refile
|
||||
|
||||
The "T o (mh-thread-refile)" command did not provide refiling hints
|
||||
like `mh-refile-msg'. This has been fixed (closes SF #664829).
|
||||
|
||||
*** mh-toggle-threads
|
||||
|
||||
If the threaded view was modified and then toggled, the standard view
|
||||
may not have been accurate (as it contained a potentially old first
|
||||
message to last message range). This has been fixed (closes SF
|
||||
#626117).
|
||||
|
||||
*** mh-tool-bar-show-set, mh-tool-bar-letter-set, mh-tool-bar-folder-set
|
||||
|
||||
Clicking the customize and help buttons now deletes the other windows
|
||||
in the frame.
|
||||
|
||||
*** mh-version
|
||||
|
||||
The "M-x mh-version" command displayed "Aliasfile: aliases". This has
|
||||
been fixed (closes SF #664467). See Buffer Name Organization above.
|
||||
|
||||
|
||||
|
||||
* Changes in MH-E 7.1
|
||||
|
||||
This release includes the new features of multiple identities and
|
||||
alias completion. In addition, indexed searching has been revamped.
|
||||
|
|
@ -204,7 +351,7 @@ changed (closes SF #643701).
|
|||
|
||||
|
||||
|
||||
* Changes in mh-e 7.0
|
||||
* 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
|
||||
|
|
|
|||
2
etc/NEWS
2
etc/NEWS
|
|
@ -95,7 +95,7 @@ You can now put the init files .emacs and .emacs_SHELL under
|
|||
|
||||
** MH-E changes.
|
||||
|
||||
Upgraded to MH-E version 7.1. There have been major changes since
|
||||
Upgraded to MH-E version 7.2. There have been major changes since
|
||||
version 5.0.2; see MH-E-NEWS for details.
|
||||
|
||||
+++
|
||||
|
|
|
|||
6019
lisp/mh-e/ChangeLog
Normal file
6019
lisp/mh-e/ChangeLog
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -91,6 +91,10 @@
|
|||
;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
|
||||
;; an alias from the From line of the current message.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-alias.el,v 1.25 2003/01/27 04:16:47 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
|
|
@ -283,7 +287,7 @@ Blind aliases or users from /etc/passwd are not expanded."
|
|||
(multi-prompt "," nil prompt mh-alias-alist nil nil))
|
||||
(t
|
||||
(split-string
|
||||
(completing-read "To: " mh-alias-alist nil nil)
|
||||
(completing-read prompt mh-alias-alist nil nil)
|
||||
","))))))
|
||||
(if (not mh-alias-expand-aliases-flag)
|
||||
(mapconcat 'identity the-answer ", ")
|
||||
|
|
@ -447,14 +451,14 @@ Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
|
|||
(completing-read "Alias file [press Tab]: "
|
||||
(mapcar 'list autolist) nil t))))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-address-to-alias (address)
|
||||
"Return the ADDRESS alias if defined, or nil."
|
||||
(let* ((aliases (mh-alias-ali address t)))
|
||||
(if (string-equal aliases address)
|
||||
nil ; ali returned same string -> no.
|
||||
;; For the comma-separated aliases reyurned by ali, check that one of
|
||||
;; them doesn't expand into a list. e.g. we do have an individual
|
||||
;; alias for that adress.
|
||||
;; Double-check that we have an individual alias. This means that the
|
||||
;; alias doesn't expand into a list (of which this address is part).
|
||||
(car (delq nil (mapcar
|
||||
(function
|
||||
(lambda (alias)
|
||||
|
|
@ -501,7 +505,7 @@ after it."
|
|||
((string-match "^a" answer)
|
||||
(forward-line 1))
|
||||
(t
|
||||
error "Quitting."))))
|
||||
(error "Quitting")))))
|
||||
;; No, so sort-in at the right place
|
||||
;; search for "^alias", then "^alia", etc.
|
||||
((eq mh-alias-insertion-location 'sorted)
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-comp.el,v 1.26 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-comp.el,v 1.173 2003/01/26 19:37:22 jchonig Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -461,7 +461,7 @@ setting of the variable `mh-redist-full-contents'. See its documentation."
|
|||
"-component" "Resent:"
|
||||
"-text" (format "\"%s %s\"" to cc))
|
||||
(if mh-redist-background
|
||||
(mh-exec-cmd-daemon "/bin/sh" "-c"
|
||||
(mh-exec-cmd-daemon "/bin/sh" nil "-c"
|
||||
(format "mhdist=1 mhaltmsg=%s %s %s %s"
|
||||
(if mh-redist-full-contents
|
||||
buffer-file-name
|
||||
|
|
@ -1038,12 +1038,18 @@ called, with no arguments, before the signature is actually inserted."
|
|||
(let ((file-name buffer-file-name))
|
||||
(save-buffer)
|
||||
(message "Checking recipients...")
|
||||
(mh-in-show-buffer ("*Recipients*")
|
||||
(mh-in-show-buffer (mh-recipients-buffer)
|
||||
(bury-buffer (current-buffer))
|
||||
(erase-buffer)
|
||||
(mh-exec-cmd-output "whom" t file-name))
|
||||
(message "Checking recipients...done")))
|
||||
|
||||
(defun mh-tidy-draft-buffer ()
|
||||
"Run when a draft buffer is destroyed."
|
||||
(let ((buffer (get-buffer mh-recipients-buffer)))
|
||||
(if buffer
|
||||
(kill-buffer buffer))))
|
||||
|
||||
|
||||
|
||||
;;; Routines to compose and send a letter.
|
||||
|
|
@ -1067,20 +1073,29 @@ The versions of MH-E, Emacs, and MH are shown."
|
|||
;; Lazily initialize mh-x-mailer-string.
|
||||
(when (null mh-x-mailer-string)
|
||||
(save-window-excursion
|
||||
(mh-version)
|
||||
(set-buffer mh-temp-buffer)
|
||||
(if mh-nmh-flag
|
||||
(search-forward-regexp "^nmh-\\(\\S +\\)")
|
||||
(search-forward-regexp "^MH \\(\\S +\\)" nil t))
|
||||
(let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1))))
|
||||
(setq mh-x-mailer-string
|
||||
(format "MH-E %s; %s %s; %s %d.%d"
|
||||
mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
|
||||
(if mh-xemacs-flag
|
||||
"XEmacs"
|
||||
"Emacs")
|
||||
emacs-major-version emacs-minor-version)))
|
||||
(kill-buffer mh-temp-buffer)))
|
||||
;; User would be confused if version info buffer disappeared magically,
|
||||
;; so don't delete buffer if it already existed.
|
||||
(let ((info-buffer-exists-p (get-buffer mh-info-buffer)))
|
||||
(mh-version)
|
||||
(set-buffer mh-info-buffer)
|
||||
(if mh-nmh-flag
|
||||
(search-forward-regexp "^nmh-\\(\\S +\\)")
|
||||
(search-forward-regexp "^MH \\(\\S +\\)" nil t))
|
||||
(let ((x-mailer-mh (buffer-substring (match-beginning 1)
|
||||
(match-end 1))))
|
||||
(setq mh-x-mailer-string
|
||||
(format "MH-E %s; %s %s; %sEmacs %s"
|
||||
mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
|
||||
(if mh-xemacs-flag "X" "GNU ")
|
||||
(cond ((not mh-xemacs-flag) emacs-version)
|
||||
((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
|
||||
emacs-version)
|
||||
(match-string 0 emacs-version))
|
||||
(t (format "%s.%s"
|
||||
emacs-major-version
|
||||
emacs-minor-version))))))
|
||||
(if (not info-buffer-exists-p)
|
||||
(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"))
|
||||
|
|
@ -1152,7 +1167,9 @@ CONFIG is the window configuration to restore after sending the letter."
|
|||
(setq mh-annotate-char annotate-char)
|
||||
(setq mh-annotate-field annotate-field)
|
||||
(setq mh-previous-window-config config)
|
||||
(setq mode-line-buffer-identification (list "{%b}"))
|
||||
(setq mode-line-buffer-identification (list " {%b}"))
|
||||
(mh-logo-display)
|
||||
(add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
|
||||
(if (and (boundp 'mh-compose-letter-function)
|
||||
mh-compose-letter-function)
|
||||
;; run-hooks will not pass arguments.
|
||||
|
|
@ -1223,7 +1240,7 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
|
|||
(recenter -1)
|
||||
(set-buffer draft-buffer)) ; for annotation below
|
||||
(t
|
||||
(mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
|
||||
(mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose"
|
||||
mh-send-args file-name)))
|
||||
(if mh-annotate-char
|
||||
(mh-annotate-msg mh-sent-from-msg
|
||||
|
|
|
|||
|
|
@ -55,15 +55,21 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-customize.el,v 1.1 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-customize.el,v 1.30 2003/02/02 17:28:50 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
(provide 'mh-customize)
|
||||
(require 'mh-e)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-customize ()
|
||||
"Customize MH-E variables."
|
||||
(interactive)
|
||||
(customize-group 'mh))
|
||||
(defun mh-customize (&optional delete-other-windows-flag)
|
||||
"Customize MH-E variables.
|
||||
With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame
|
||||
are removed."
|
||||
(interactive "P")
|
||||
(customize-group 'mh)
|
||||
(when delete-other-windows-flag
|
||||
(delete-other-windows)))
|
||||
|
||||
;;; MH-E Customization Groups
|
||||
|
||||
|
|
@ -326,13 +332,14 @@ See `mh-search-folder' and `mh-index-search' for details."
|
|||
(if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
|
||||
(tool-bar-add-item "preferences" (lambda ()
|
||||
(interactive)
|
||||
(customize-group "mh"))
|
||||
(mh-customize t))
|
||||
'mh-showtoolbar-customize
|
||||
:help mh-tool-bar-item-prefs))
|
||||
(if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
|
||||
(tool-bar-add-item "help" (lambda ()
|
||||
(interactive)
|
||||
(Info-goto-node "(mh-e)Top"))
|
||||
(Info-goto-node "(mh-e)Top")
|
||||
(delete-other-windows))
|
||||
'mh-showtoolbar-help
|
||||
:help mh-tool-bar-item-help))
|
||||
tool-bar-map))))
|
||||
|
|
@ -373,13 +380,14 @@ See `mh-search-folder' and `mh-index-search' for details."
|
|||
(if (member mh-tool-bar-item-comp-prefs mh-tool-bar-letter-buttons)
|
||||
(tool-bar-add-item "preferences" (lambda ()
|
||||
(interactive)
|
||||
(customize-group "mh-compose"))
|
||||
(mh-customize t))
|
||||
'mh-lettertoolbar-customize
|
||||
:help mh-tool-bar-item-comp-prefs))
|
||||
(if (member mh-tool-bar-item-help mh-tool-bar-letter-buttons)
|
||||
(tool-bar-add-item "help" (lambda ()
|
||||
(interactive)
|
||||
(Info-goto-node "(mh-e)Draft Editing"))
|
||||
(Info-goto-node "(mh-e)Draft Editing")
|
||||
(delete-other-windows))
|
||||
'mh-lettertoolbar-help
|
||||
:help mh-tool-bar-item-help))
|
||||
tool-bar-map))))
|
||||
|
|
@ -485,13 +493,14 @@ See `mh-search-folder' and `mh-index-search' for details."
|
|||
(if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
|
||||
(tool-bar-add-item "preferences" (lambda ()
|
||||
(interactive)
|
||||
(customize-group "mh"))
|
||||
(mh-customize t))
|
||||
'mh-foldertoolbar-customize
|
||||
:help mh-tool-bar-item-prefs))
|
||||
(if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
|
||||
(tool-bar-add-item "help" (lambda ()
|
||||
(interactive)
|
||||
(Info-goto-node "(mh-e)Top"))
|
||||
(Info-goto-node "(mh-e)Top")
|
||||
(delete-other-windows))
|
||||
'mh-foldertoolbar-help
|
||||
:help mh-tool-bar-item-help))
|
||||
tool-bar-map))
|
||||
|
|
@ -631,6 +640,8 @@ be updated manually with the \\[mh-speed-flists] command."
|
|||
:type 'boolean
|
||||
:group 'mh-speed)
|
||||
|
||||
|
||||
|
||||
;;; Options for controlling scan listing (:group 'mh-folder)
|
||||
|
||||
(defcustom mh-adaptive-cmd-note-flag t
|
||||
|
|
@ -646,13 +657,37 @@ If you prefer fixed-width message numbers, set this variable to nil and call
|
|||
:type 'boolean
|
||||
:group 'mh-folder)
|
||||
|
||||
(defcustom mh-auto-folder-collect-flag t
|
||||
"*Non-nil means to collect all folder names at startup in the background.
|
||||
Otherwise, the internal list of folder names is built as folders are
|
||||
referenced."
|
||||
(defcustom mh-default-folder-list nil
|
||||
"*Alist of addresses and folders.
|
||||
When refiling messages, these folders are the default that is provided if the
|
||||
sender has the associated address. You do not need to list your aliases here
|
||||
as that lookup is already performed.
|
||||
See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more
|
||||
information."
|
||||
:type '(repeat (list (string :tag "Address")
|
||||
(string :tag "Folder")))
|
||||
:group 'mh-folder)
|
||||
|
||||
(defcustom mh-default-folder-must-exist-flag t
|
||||
"*Non-nil means guessed folder name must exist to be used.
|
||||
If this variable is t, then the guessed name is only used if the folder
|
||||
already exists\; if the folder doesn't exist, then the last folder name used
|
||||
is suggested. This is useful if you get mail from various people for whom you
|
||||
have an alias, but file them all in the same project folder.
|
||||
See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more
|
||||
information."
|
||||
:type 'boolean
|
||||
:group 'mh-folder)
|
||||
|
||||
(defcustom mh-default-folder-prefix ""
|
||||
"*Prefix used for guessed folder names.
|
||||
This can be used to put folders associated with your aliases in a sub-folder
|
||||
so as to not clutter your mail directory.
|
||||
See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more
|
||||
information."
|
||||
:type 'string
|
||||
:group 'mh-folder)
|
||||
|
||||
(defcustom mh-inc-prog "inc"
|
||||
"*Program to run to incorporate new mail into a folder.
|
||||
Normally \"inc\". This file is searched for relative to
|
||||
|
|
@ -742,6 +777,8 @@ display MIME content using \"M-! mhshow RET\""
|
|||
:type 'boolean
|
||||
:group 'mh-folder)
|
||||
|
||||
|
||||
|
||||
;;; Message display (:group 'mh-show)
|
||||
|
||||
(defcustom mh-bury-show-buffer-flag t
|
||||
|
|
@ -761,18 +798,18 @@ what is removed."
|
|||
:type 'boolean
|
||||
:group 'mh-show)
|
||||
|
||||
(defcustom mh-decode-quoted-printable-flag
|
||||
(not (null (and (fboundp 'executable-find)(executable-find "mimedecode"))))
|
||||
"Non-nil means decode quoted-printable MIME part with `mimedecode'.
|
||||
(defcustom mh-decode-content-transfer-encoded-message-flag
|
||||
(and (fboundp 'executable-find) (executable-find "mimencode") t)
|
||||
"Non-nil means decode messages with `mimencode', if necessary.
|
||||
|
||||
Quoted-printable message parts are translated to 8-bit characters by the
|
||||
`mimedecode' command. However, unless there is only one quoted-printable body
|
||||
part, Gnus will have already decoded the quoted-printable parts.
|
||||
Messages which are encoded as quoted-printable or base64 are translated into
|
||||
8-bit characters by the `mimencode' command.
|
||||
|
||||
This variable is initialized t if `mimedecode' is available.
|
||||
This variable is initialized to t if `mimencode' is available.
|
||||
|
||||
The source code for `mimedecode' can be obtained from
|
||||
http://www.freesoft.org/CIE/FAQ/mimedeco.c."
|
||||
The `mimencode' program is part of the metamail package. The source can be
|
||||
obtained from
|
||||
ftp://thumper.bellcore.com/pub/nsb/"
|
||||
:type 'boolean
|
||||
:group 'mh-show)
|
||||
|
||||
|
|
@ -812,7 +849,7 @@ list. The setting only has effect if `mh-decode-mime-flag' is non-nil."
|
|||
(defcustom mh-highlight-citation-p 'gnus
|
||||
"How to highlight citations in show buffers.
|
||||
The gnus method uses a different color for each indentation."
|
||||
:type '(choice (const :tag "Use gnus" gnus)
|
||||
:type '(choice (const :tag "Use Gnus" gnus)
|
||||
(const :tag "Use font-lock" font-lock)
|
||||
(const :tag "Don't fontify" nil))
|
||||
:group 'mh-show)
|
||||
|
|
@ -906,12 +943,11 @@ Done using `mh-invisible-header-fields' as input."
|
|||
(setq mh-invisible-headers
|
||||
(concat
|
||||
"^"
|
||||
(let ((max-specpdl-size 1000)) ;workaround for insufficient default
|
||||
(regexp-opt
|
||||
(append
|
||||
(if (not mh-show-use-xface-flag)
|
||||
'("X-Face: "))
|
||||
mh-invisible-header-fields))))))
|
||||
(let ((max-specpdl-size 1000) ;workaround for insufficient default
|
||||
(fields (append (if (not mh-show-use-xface-flag)
|
||||
'("X-Face: "))
|
||||
mh-invisible-header-fields)))
|
||||
(regexp-opt fields t)))))
|
||||
|
||||
(defun mh-invisible-header-fields-set (symbol value)
|
||||
"Update `mh-invisible-header-fields'.
|
||||
|
|
@ -1003,6 +1039,7 @@ variable `mh-invisible-fields' is set."
|
|||
"X-Mailing-List: " ; Unknown mailing list managers
|
||||
"X-Mailman-Version: " ; Mailman mailing list manager
|
||||
"X-Message-Id"
|
||||
"X-MHE-Checksum" ; Checksum added during index search
|
||||
"X-MimeOLE: " ; MS Outlook
|
||||
"X-Mozilla-Status: " ; Netscape/Mozilla
|
||||
"X-Msmail-" ; MS Outlook
|
||||
|
|
@ -1044,19 +1081,21 @@ variable `mh-invisible-fields' is set."
|
|||
"X400-" ; X400
|
||||
"Xref: ")
|
||||
"*List of header fields that are not to be shown.
|
||||
Regexps are not allowed. Unique fields should have a \": \" suffix;
|
||||
otherwise, the element can be used to render an entire class of fields
|
||||
that start with the same prefix invisible.
|
||||
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."
|
||||
:type '(repeat (string :tag "Header field"))
|
||||
:set 'mh-invisible-header-fields-set
|
||||
:group 'mh-show)
|
||||
|
||||
|
||||
|
||||
;;; Composing messages (:group 'mh-letter)
|
||||
|
||||
(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
|
||||
"Use either 'gnus or 'mhn to insert MIME message directives in messages."
|
||||
:type '(choice (const :tag "Use gnus" gnus)
|
||||
:type '(choice (const :tag "Use Gnus" gnus)
|
||||
(const :tag "Use mhn" mhn))
|
||||
:group 'mh-letter)
|
||||
|
||||
|
|
@ -1122,7 +1161,8 @@ This corresponds to:
|
|||
While it might be tempting to add a descriptive name to the mailing list
|
||||
address, consider that this field will appear in other people's outgoing
|
||||
mail in their To: field. It might be best to keep it simple."
|
||||
:type '(repeat (list (string :tag "regexp") (string :tag "address")))
|
||||
:type '(repeat (list (string :tag "Regexp")
|
||||
(string :tag "Address")))
|
||||
:group 'mh-letter)
|
||||
|
||||
(defcustom mh-insert-x-mailer-flag t
|
||||
|
|
@ -1225,6 +1265,8 @@ to the yanked region."
|
|||
:type '(choice function (const nil))
|
||||
:group 'mh-letter)
|
||||
|
||||
|
||||
|
||||
;;; Alias handling (:group 'mh-alias)
|
||||
|
||||
(defcustom mh-alias-system-aliases
|
||||
|
|
@ -1293,21 +1335,30 @@ Options are sorted alphabetically, at the top of the file or at the bottom."
|
|||
(const :tag "At the bottom of file" bottom))
|
||||
:group 'mh-alias)
|
||||
|
||||
|
||||
|
||||
;;; Indexed searching (:group 'mh-index)
|
||||
|
||||
(defcustom mh-index-program nil
|
||||
"Indexing program that MH-E shall use.
|
||||
The possible choices are swish++, swish-e, namazu, glimpse and grep. By
|
||||
default this variable is nil which means that the programs are tried in order
|
||||
and the first one found is used."
|
||||
:type '(choice (const :tag "auto-detect" nil)
|
||||
The possible choices are swish++, swish-e, mairix, namazu, glimpse, pick and
|
||||
grep. By default this variable is nil which means that the programs are tried
|
||||
in order and the first one found is used.
|
||||
|
||||
More information about setting up an indexing program to use with MH-E can be
|
||||
found in the documentation of `mh-index-search'."
|
||||
:type '(choice (const :tag "Auto-detect" nil)
|
||||
(const :tag "swish++" swish++)
|
||||
(const :tag "swish-e" swish)
|
||||
(const :tag "mairix" mairix)
|
||||
(const :tag "namazu" namazu)
|
||||
(const :tag "glimpse" glimpse)
|
||||
(const :tag "pick" pick)
|
||||
(const :tag "grep" grep))
|
||||
:group 'mh-index)
|
||||
|
||||
|
||||
|
||||
;;; Multiple personalities (:group 'mh-identity)
|
||||
|
||||
(defcustom mh-identity-list nil
|
||||
|
|
@ -1366,11 +1417,13 @@ This would produce the equivalent of:
|
|||
;; (const "work"))
|
||||
:type (append
|
||||
'(radio)
|
||||
(cons '(const :tag "none" nil)
|
||||
(cons '(const :tag "None" nil)
|
||||
(mapcar (function (lambda (arg) `(const ,arg)))
|
||||
(mapcar 'car mh-identity-list))))
|
||||
:group 'mh-identity)
|
||||
|
||||
|
||||
|
||||
;;; Hooks (:group 'mh-hooks + group where hook defined)
|
||||
|
||||
;;; These are alphabetized. All hooks should be placed in the 'mh-hook group;
|
||||
|
|
@ -1408,12 +1461,6 @@ See also `mh-quit-hook'."
|
|||
:group 'mh-hooks
|
||||
:group 'mh-folder)
|
||||
|
||||
(defcustom mh-folder-list-change-hook nil
|
||||
"Invoked whenever the cached folder list `mh-folder-list' is changed."
|
||||
:type 'hook
|
||||
:group 'mh-hooks
|
||||
:group 'mh-folder)
|
||||
|
||||
(defcustom mh-folder-mode-hook nil
|
||||
"Invoked in `mh-folder-mode' on a new folder."
|
||||
:type 'hook
|
||||
|
|
@ -1527,6 +1574,8 @@ will be removed from the unseen sequence."
|
|||
"Face used for the current folder when it has unread messages."
|
||||
:group 'mh-speed-faces)
|
||||
|
||||
|
||||
|
||||
;;; Faces used in scan listing (:group mh-folder-faces)
|
||||
|
||||
(defvar mh-folder-body-face 'mh-folder-body-face
|
||||
|
|
@ -1656,6 +1705,8 @@ will be removed from the unseen sequence."
|
|||
"Face for highlighting the To: string in MH-Folder buffers."
|
||||
:group 'mh-folder-faces)
|
||||
|
||||
|
||||
|
||||
;;; Faces used in message display (:group mh-show-faces)
|
||||
|
||||
(defvar mh-show-cc-face 'mh-show-cc-face
|
||||
|
|
@ -1727,6 +1778,8 @@ will be removed from the unseen sequence."
|
|||
"Face for highlighting the Subject header field.")
|
||||
(copy-face 'mh-folder-subject-face 'mh-show-subject-face)
|
||||
|
||||
|
||||
|
||||
;;; Faces used in indexed searches (:group mh-index-faces)
|
||||
|
||||
(defvar mh-index-folder-face 'mh-index-folder-face
|
||||
|
|
@ -1741,8 +1794,6 @@ will be removed from the unseen sequence."
|
|||
"Face for highlighting folders in MH-Index buffers."
|
||||
:group 'mh-index-faces)
|
||||
|
||||
(provide 'mh-customize)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
;; Author: Bill Wohler <wohler@newt.com>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Version: 7.1
|
||||
;; Version: 7.2
|
||||
;; Keywords: mail
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
|
@ -79,7 +79,7 @@
|
|||
;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
|
||||
;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
|
||||
|
||||
;; $Id: mh-e.el,v 1.34 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-e.el,v 1.262 2003/02/03 19:11:43 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -102,7 +102,7 @@
|
|||
(defvar font-lock-auto-fontify)
|
||||
(defvar font-lock-defaults)
|
||||
|
||||
(defconst mh-version "7.1" "Version number of MH-E.")
|
||||
(defconst mh-version "7.2" "Version number of MH-E.")
|
||||
|
||||
;;; Autoloads
|
||||
(autoload 'Info-goto-node "info")
|
||||
|
|
@ -457,6 +457,8 @@ is done highlighting.")
|
|||
(defvar mh-folder-mode-map (make-keymap)
|
||||
"Keymap for MH folders.")
|
||||
|
||||
(defvar mh-arrow-marker nil) ;Marker for arrow display in fringe.
|
||||
|
||||
(defvar mh-delete-list nil) ;List of msg numbers to delete.
|
||||
|
||||
(defvar mh-refile-list nil) ;List of folder names in mh-seq-list.
|
||||
|
|
@ -512,6 +514,8 @@ the Emacs front end to the MH mail system."
|
|||
(mh-find-path)
|
||||
(if arg
|
||||
(call-interactively 'mh-visit-folder)
|
||||
(unless (get-buffer mh-inbox)
|
||||
(mh-visit-folder mh-inbox (symbol-name mh-unseen-seq)))
|
||||
(mh-inc-folder)))
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -537,11 +541,11 @@ prompt for the message sequence. If variable `transient-mark-mode' is non-nil
|
|||
and the mark is active, then the selected region is marked for deletion."
|
||||
(interactive (list (cond
|
||||
((mh-mark-active-p t)
|
||||
(mh-region-to-msg-list (region-beginning) (region-end)))
|
||||
(cons (region-beginning) (region-end)))
|
||||
(current-prefix-arg
|
||||
(mh-read-seq-default "Delete" t))
|
||||
(t
|
||||
(mh-get-msg-num t)))))
|
||||
(cons (line-beginning-position) (line-end-position))))))
|
||||
(mh-delete-msg-no-motion msg-or-seq)
|
||||
(mh-next-msg))
|
||||
|
||||
|
|
@ -552,9 +556,13 @@ then prompt for the message sequence."
|
|||
(interactive (list (if current-prefix-arg
|
||||
(mh-read-seq-default "Delete" t)
|
||||
(mh-get-msg-num t))))
|
||||
(if (numberp msg-or-seq)
|
||||
(mh-delete-a-msg msg-or-seq)
|
||||
(mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
|
||||
(cond ((numberp msg-or-seq)
|
||||
(mh-delete-a-msg msg-or-seq))
|
||||
((and (consp msg-or-seq)
|
||||
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
|
||||
(mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
|
||||
(mh-delete-a-msg nil)))
|
||||
(t (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))))
|
||||
|
||||
(defun mh-execute-commands ()
|
||||
"Process outstanding delete and refile requests."
|
||||
|
|
@ -585,6 +593,7 @@ Type \"\\[mh-show]\" to show the message normally again."
|
|||
(mh-invalidate-show-buffer))
|
||||
(let ((mh-decode-mime-flag nil)
|
||||
(mhl-formfile nil)
|
||||
(mh-decode-content-transfer-encoded-message-flag nil)
|
||||
(mh-clean-message-header-flag nil))
|
||||
(mh-show-msg nil)
|
||||
(mh-in-show-buffer (mh-show-buffer)
|
||||
|
|
@ -645,6 +654,62 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
|
|||
(t (forward-line -1)
|
||||
(message "No more undeleted messages"))))
|
||||
|
||||
(defun mh-folder-from-address ()
|
||||
"Determine folder name from address in From field.
|
||||
Takes the address in the From: header field, and returns one of:
|
||||
|
||||
a) The folder name associated with the address in the alist
|
||||
`mh-default-folder-list'.
|
||||
|
||||
b) The address' corresponding alias from the user's personal
|
||||
aliases file prefixed by `mh-default-folder-prefix'.
|
||||
|
||||
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."
|
||||
;; Is address in mh-default-folder-list?
|
||||
(let* ((address
|
||||
(nth 1 (mail-extract-address-components
|
||||
(mh-extract-from-header-value))))
|
||||
(folder-name
|
||||
(nth 1 (assoc-ignore-case address mh-default-folder-list))))
|
||||
|
||||
;; If not, is there an alias for the address?
|
||||
(if (not folder-name)
|
||||
(let* ((alias (mh-alias-address-to-alias address)))
|
||||
(setq folder-name
|
||||
(and alias (concat "+" mh-default-folder-prefix alias)))))
|
||||
|
||||
;; If mh-default-folder-must-exist-flag set, check that folder exists.
|
||||
(if (and folder-name
|
||||
(or (not mh-default-folder-must-exist-flag)
|
||||
(file-exists-p (mh-expand-file-name folder-name))))
|
||||
folder-name)))
|
||||
|
||||
(defun mh-prompt-for-refile-folder ()
|
||||
"Prompt the user for a folder in which the message should be filed.
|
||||
The folder is returned as a string.
|
||||
|
||||
If `mh-default-folder-for-message-function' is a function then the message
|
||||
being refiled is yanked into a temporary buffer and the function is called to
|
||||
intelligently guess where the message is to be refiled.
|
||||
|
||||
Otherwise, a default folder name is generated by `mh-folder-from-address'."
|
||||
(mh-prompt-for-folder
|
||||
"Destination"
|
||||
(let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
(insert-file-contents refile-file)
|
||||
(or (and mh-default-folder-for-message-function
|
||||
(let ((buffer-file-name refile-file))
|
||||
(funcall mh-default-folder-for-message-function)))
|
||||
(mh-folder-from-address)
|
||||
(and (eq 'refile (car mh-last-destination-folder))
|
||||
(symbol-name (cdr mh-last-destination-folder)))
|
||||
"")))
|
||||
t))
|
||||
|
||||
(defun mh-refile-msg (msg-or-seq folder)
|
||||
"Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
|
||||
If optional prefix argument provided, then prompt for message sequence.
|
||||
|
|
@ -653,31 +718,21 @@ selected region is marked for refiling."
|
|||
(interactive
|
||||
(list (cond
|
||||
((mh-mark-active-p t)
|
||||
(mh-region-to-msg-list (region-beginning) (region-end)))
|
||||
(cons (region-beginning) (region-end)))
|
||||
(current-prefix-arg
|
||||
(mh-read-seq-default "Refile" t))
|
||||
(t
|
||||
(mh-get-msg-num t)))
|
||||
(intern
|
||||
(mh-prompt-for-folder
|
||||
"Destination"
|
||||
(or (and mh-default-folder-for-message-function
|
||||
(let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
(insert-file-contents refile-file)
|
||||
(let ((buffer-file-name refile-file))
|
||||
(funcall mh-default-folder-for-message-function)))))
|
||||
(and (eq 'refile (car mh-last-destination-folder))
|
||||
(symbol-name (cdr mh-last-destination-folder)))
|
||||
"")
|
||||
t))))
|
||||
(cons (line-beginning-position) (line-end-position))))
|
||||
(intern (mh-prompt-for-refile-folder))))
|
||||
(setq mh-last-destination (cons 'refile folder)
|
||||
mh-last-destination-folder mh-last-destination)
|
||||
(if (numberp msg-or-seq)
|
||||
(mh-refile-a-msg msg-or-seq folder)
|
||||
(mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
|
||||
(cond ((numberp msg-or-seq)
|
||||
(mh-refile-a-msg msg-or-seq folder))
|
||||
((and (consp msg-or-seq)
|
||||
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
|
||||
(mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
|
||||
(mh-refile-a-msg nil folder)))
|
||||
(t (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)))
|
||||
(mh-next-msg))
|
||||
|
||||
(defun mh-refile-or-write-again (message)
|
||||
|
|
@ -701,7 +756,9 @@ Restore the previous window configuration, if one exists.
|
|||
The value of `mh-before-quit-hook' is a list of functions to be called, with
|
||||
no arguments, immediately upon entry to this function.
|
||||
The value of `mh-quit-hook' is a list of functions to be called, with no
|
||||
arguments, upon exit of this function."
|
||||
arguments, upon exit of this function.
|
||||
MH-E working buffers (whose name begins with \" *mh-\" or \"*MH-E \") are
|
||||
killed."
|
||||
(interactive)
|
||||
(run-hooks 'mh-before-quit-hook)
|
||||
(let ((show-buffer (get-buffer mh-show-buffer)))
|
||||
|
|
@ -710,12 +767,13 @@ arguments, upon exit of this function."
|
|||
(mh-update-sequences)
|
||||
(mh-destroy-postponed-handles)
|
||||
(bury-buffer (current-buffer))
|
||||
(if (get-buffer mh-temp-buffer)
|
||||
(kill-buffer mh-temp-buffer))
|
||||
(if (get-buffer mh-temp-folders-buffer)
|
||||
(kill-buffer mh-temp-folders-buffer))
|
||||
(if (get-buffer mh-temp-sequences-buffer)
|
||||
(kill-buffer mh-temp-sequences-buffer))
|
||||
|
||||
;; Delete all MH-E temporary and working buffers.
|
||||
(dolist (buffer (buffer-list))
|
||||
(when (or (string-match "^ \\*mh-" (buffer-name buffer))
|
||||
(string-match "^\\*MH-E " (buffer-name buffer)))
|
||||
(kill-buffer buffer)))
|
||||
|
||||
(if mh-previous-window-config
|
||||
(set-window-configuration mh-previous-window-config))
|
||||
(run-hooks 'mh-quit-hook))
|
||||
|
|
@ -985,7 +1043,7 @@ If variable `transient-mark-mode' is non-nil and the mark is active, then the
|
|||
selected region is unmarked."
|
||||
(interactive (list (cond
|
||||
((mh-mark-active-p t)
|
||||
(mh-region-to-msg-list (region-beginning) (region-end)))
|
||||
(cons (region-beginning) (region-end)))
|
||||
(current-prefix-arg
|
||||
(mh-read-seq-default "Undo" t))
|
||||
(t
|
||||
|
|
@ -1006,6 +1064,10 @@ selected region is unmarked."
|
|||
(mh-maybe-show))
|
||||
(goto-char original-position)
|
||||
(error "Nothing to undo"))))
|
||||
((and (consp msg-or-seq)
|
||||
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
|
||||
(mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
|
||||
(mh-undo-msg nil)))
|
||||
(t
|
||||
(mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
|
||||
(if (not (mh-outstanding-commands-p))
|
||||
|
|
@ -1045,7 +1107,7 @@ compiled then macro expansion happens at compile time."
|
|||
"Display version information about MH-E and the MH mail handling system."
|
||||
(interactive)
|
||||
(mh-find-progs)
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(set-buffer (get-buffer-create mh-info-buffer))
|
||||
(erase-buffer)
|
||||
;; MH-E version.
|
||||
(insert "MH-E " mh-version "\n\n")
|
||||
|
|
@ -1079,10 +1141,13 @@ compiled then macro expansion happens at compile time."
|
|||
(call-process "uname" nil t nil "-a")
|
||||
(file-error))
|
||||
(goto-char (point-min))
|
||||
(display-buffer mh-temp-buffer))
|
||||
(display-buffer mh-info-buffer))
|
||||
|
||||
(defun mh-parse-flist-output-line (line)
|
||||
"Parse LINE to generate folder name, unseen messages and total messages."
|
||||
(defun mh-parse-flist-output-line (line &optional current-folder)
|
||||
"Parse LINE to generate folder name, unseen messages and total messages.
|
||||
If CURRENT-FOLDER is non-nil then it contains the current folder name and it is
|
||||
used to avoid problems in corner cases involving folders whose names end with a
|
||||
'+' character."
|
||||
(with-temp-buffer
|
||||
(insert line)
|
||||
(goto-char (point-max))
|
||||
|
|
@ -1096,23 +1161,24 @@ compiled then macro expansion happens at compile time."
|
|||
(when (search-backward " has " (point-min) t)
|
||||
(setq unseen (read-from-string (buffer-substring-no-properties
|
||||
(match-end 0) p)))
|
||||
(while (or (eq (char-after) ?+) (eq (char-after) ? ))
|
||||
(while (eq (char-after) ? )
|
||||
(backward-char))
|
||||
(setq folder (buffer-substring-no-properties
|
||||
(point-min) (1+ (point))))
|
||||
(when (and (equal (aref folder (1- (length folder))) ?+)
|
||||
(equal current-folder folder))
|
||||
(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."
|
||||
(with-temp-buffer
|
||||
(call-process (expand-file-name "flist" mh-progs) nil t nil
|
||||
"-norecurse" folder)
|
||||
"-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
|
||||
(goto-char (point-min))
|
||||
(multiple-value-bind (folder1 unseen total)
|
||||
(mh-parse-flist-output-line
|
||||
(buffer-substring (point) (line-end-position)))
|
||||
(unless (equal folder folder1)
|
||||
(error "Call to flist failed on folder %s" folder))
|
||||
(values total unseen))))
|
||||
|
||||
(defun mh-visit-folder (folder &optional range index-data)
|
||||
|
|
@ -1123,9 +1189,13 @@ If RANGE is nil (the default if it is omitted when called non-interactively),
|
|||
then all messages in FOLDER are displayed.
|
||||
|
||||
If an index buffer is being created then INDEX-DATA is used to initialize the
|
||||
index buffer specific data structures."
|
||||
index buffer specific data structures.
|
||||
|
||||
A prefix argument will cause a prompt for the RANGE of messages
|
||||
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))))
|
||||
(list folder-name
|
||||
(mh-read-msg-range folder-name current-prefix-arg))))
|
||||
(let ((config (current-window-configuration))
|
||||
(threaded-view-flag mh-show-threads-flag))
|
||||
(save-excursion
|
||||
|
|
@ -1171,7 +1241,7 @@ Flush MH-E's state out to MH. The message at the cursor becomes current."
|
|||
(mh-define-sequence 'cur (list new-cur))
|
||||
(beginning-of-line)
|
||||
(if (looking-at mh-scan-good-msg-regexp)
|
||||
(mh-notate nil mh-note-cur mh-cmd-note)))
|
||||
(mh-notate-cur)))
|
||||
(or folder-set
|
||||
(save-excursion
|
||||
;; psg - mh-current-folder is nil if mh-summary-height < 4 !
|
||||
|
|
@ -1186,26 +1256,36 @@ Flush MH-E's state out to MH. The message at the cursor becomes current."
|
|||
|
||||
(defun mh-delete-a-msg (msg)
|
||||
"Delete the MSG.
|
||||
If MSG is nil then the message at point is deleted.
|
||||
|
||||
The value of `mh-delete-msg-hook' is a list of functions to be called, with no
|
||||
arguments, after the message has been deleted."
|
||||
(save-excursion
|
||||
(mh-goto-msg msg nil t)
|
||||
(if (numberp msg)
|
||||
(mh-goto-msg msg nil t)
|
||||
(beginning-of-line)
|
||||
(setq msg (mh-get-msg-num t)))
|
||||
(if (looking-at mh-scan-refiled-msg-regexp)
|
||||
(error "Message %d is refiled. Undo refile before deleting" msg))
|
||||
(if (looking-at mh-scan-deleted-msg-regexp)
|
||||
nil
|
||||
(mh-set-folder-modified-p t)
|
||||
(setq mh-delete-list (cons msg mh-delete-list))
|
||||
(mh-notate msg mh-note-deleted mh-cmd-note)
|
||||
(mh-notate nil mh-note-deleted mh-cmd-note)
|
||||
(run-hooks 'mh-delete-msg-hook))))
|
||||
|
||||
(defun mh-refile-a-msg (msg folder)
|
||||
"Refile MSG in FOLDER.
|
||||
If MSG is nil then the message at point is refiled.
|
||||
|
||||
Folder is a symbol, not a string.
|
||||
The value of `mh-refile-msg-hook' is a list of functions to be called, with no
|
||||
arguments, after the message has been refiled."
|
||||
(save-excursion
|
||||
(mh-goto-msg msg nil t)
|
||||
(if (numberp msg)
|
||||
(mh-goto-msg msg nil t)
|
||||
(beginning-of-line)
|
||||
(setq msg (mh-get-msg-num t)))
|
||||
(cond ((looking-at mh-scan-deleted-msg-regexp)
|
||||
(error "Message %d is deleted. Undo delete before moving" msg))
|
||||
((looking-at mh-scan-refiled-msg-regexp)
|
||||
|
|
@ -1222,7 +1302,7 @@ arguments, after the message has been refiled."
|
|||
(push (list folder msg) mh-refile-list))
|
||||
((not (member msg (cdr (assoc folder mh-refile-list))))
|
||||
(push msg (cdr (assoc folder mh-refile-list)))))
|
||||
(mh-notate msg mh-note-refiled mh-cmd-note)
|
||||
(mh-notate nil mh-note-refiled mh-cmd-note)
|
||||
(run-hooks 'mh-refile-msg-hook)))))
|
||||
|
||||
(defun mh-next-msg ()
|
||||
|
|
@ -1271,15 +1351,21 @@ With optional argument COUNT, COUNT-1 unread messages are skipped."
|
|||
(mh-recenter nil)))
|
||||
|
||||
(defun mh-undo-msg (msg)
|
||||
"Undo the deletion or refile of one MSG."
|
||||
(cond ((memq msg mh-delete-list)
|
||||
(setq mh-delete-list (delq msg mh-delete-list)))
|
||||
(t
|
||||
(dolist (folder-msg-list mh-refile-list)
|
||||
(setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
|
||||
(setq mh-refile-list (loop for x in mh-refile-list
|
||||
unless (null (cdr x)) collect x))))
|
||||
(mh-notate msg ? mh-cmd-note))
|
||||
"Undo the deletion or refile of one MSG.
|
||||
If MSG is nil then act on the message at point"
|
||||
(save-excursion
|
||||
(if (numberp msg)
|
||||
(mh-goto-msg msg t t)
|
||||
(beginning-of-line)
|
||||
(setq msg (mh-get-msg-num t)))
|
||||
(cond ((memq msg mh-delete-list)
|
||||
(setq mh-delete-list (delq msg mh-delete-list)))
|
||||
(t
|
||||
(dolist (folder-msg-list mh-refile-list)
|
||||
(setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
|
||||
(setq mh-refile-list (loop for x in mh-refile-list
|
||||
unless (null (cdr x)) collect x))))
|
||||
(mh-notate nil ? mh-cmd-note)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -1423,6 +1509,9 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
|
|||
'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
|
||||
'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
|
||||
(file-name-as-directory (mh-expand-file-name (buffer-name)))
|
||||
'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
|
||||
'overlay-arrow-position nil ; Allow for simultaneous display in
|
||||
'overlay-arrow-string ">" ; different MH-E buffers.
|
||||
'mh-showing-mode nil ; Show message also?
|
||||
'mh-delete-list nil ; List of msgs nums to delete
|
||||
'mh-refile-list nil ; List of folder names in mh-seq-list
|
||||
|
|
@ -1489,15 +1578,8 @@ Return in the folder's buffer."
|
|||
(message "Folder %s is empty" folder)
|
||||
(message "No messages in %s, range %s" folder range))
|
||||
(mh-goto-cur-msg))
|
||||
(save-excursion
|
||||
(when dont-exec-pending
|
||||
;; Re-annotate messages to be refiled...
|
||||
(dolist (folder-msg-list mh-refile-list)
|
||||
(dolist (msg (cdr folder-msg-list))
|
||||
(mh-notate msg mh-note-refiled mh-cmd-note)))
|
||||
;; Re-annotate messages to be deleted...
|
||||
(dolist (msg mh-delete-list)
|
||||
(mh-notate msg mh-note-deleted mh-cmd-note)))))
|
||||
(when dont-exec-pending
|
||||
(mh-notate-deleted-and-refiled)))
|
||||
|
||||
(defun mh-set-cmd-note (width)
|
||||
"Set `mh-cmd-note' to WIDTH characters (minimum of 2).
|
||||
|
|
@ -1655,7 +1737,7 @@ Return in the current buffer."
|
|||
(keep-lines mh-scan-valid-regexp) ; Flush random scan lines
|
||||
(setq mh-seq-list (mh-read-folder-sequences folder t))
|
||||
(when (equal (point-max) start-of-inc)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note))
|
||||
(mh-notate-cur))
|
||||
(mh-notate-user-sequences)
|
||||
(if new-mail-flag
|
||||
(progn
|
||||
|
|
@ -1689,7 +1771,7 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
|
|||
(count-lines (point-min) (point-max))
|
||||
0))
|
||||
(setq mode-line-buffer-identification
|
||||
(list (format "{%%b%s} %s msg%s"
|
||||
(list (format " {%%b%s} %s msg%s"
|
||||
(if mh-mode-line-annotation
|
||||
(format "/%s" mh-mode-line-annotation)
|
||||
"")
|
||||
|
|
@ -1703,7 +1785,8 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
|
|||
mh-last-msg-num))
|
||||
(mh-first-msg-num
|
||||
(format " (%d)" mh-first-msg-num))
|
||||
("")))))))))
|
||||
(""))))))
|
||||
(mh-logo-display))))
|
||||
|
||||
(defun mh-unmark-all-headers (remove-all-flags)
|
||||
"Remove all '+' flags from the folder listing.
|
||||
|
|
@ -1737,14 +1820,16 @@ Optimized for speed (i.e., no regular expressions)."
|
|||
"Remove old cur notation."
|
||||
(let ((cur-msg (car (mh-seq-to-msgs 'cur))))
|
||||
(save-excursion
|
||||
(and cur-msg
|
||||
(mh-goto-msg cur-msg t t)
|
||||
(looking-at mh-scan-cur-msg-number-regexp)
|
||||
(mh-notate nil ? mh-cmd-note)))))
|
||||
(when (and cur-msg
|
||||
(mh-goto-msg cur-msg t t)
|
||||
(looking-at mh-scan-cur-msg-number-regexp))
|
||||
(mh-notate nil ? mh-cmd-note)
|
||||
(setq overlay-arrow-position nil)))))
|
||||
|
||||
(defun mh-remove-all-notation ()
|
||||
"Remove all notations on all scan lines that MH-E introduces."
|
||||
(save-excursion
|
||||
(setq overlay-arrow-position nil)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(unless (or (equal (char-after) ?+) (eolp))
|
||||
|
|
@ -1762,10 +1847,11 @@ recenter the folder buffer."
|
|||
(cond ((and cur-msg
|
||||
(mh-goto-msg cur-msg t t))
|
||||
(unless minimal-changes-flag
|
||||
(mh-notate nil mh-note-cur mh-cmd-note)
|
||||
(mh-notate-cur)
|
||||
(mh-recenter 0)
|
||||
(mh-maybe-show cur-msg)))
|
||||
(t
|
||||
(setq overlay-arrow-position nil)
|
||||
(message "No current message")))))
|
||||
|
||||
(defun mh-process-or-undo-commands (folder)
|
||||
|
|
@ -1976,12 +2062,14 @@ Expands ranges into set of individual numbers."
|
|||
(defun mh-notate-user-sequences ()
|
||||
"Mark the scan listing of all messages in user-defined sequences."
|
||||
(let ((seqs mh-seq-list)
|
||||
name)
|
||||
(while seqs
|
||||
(setq name (mh-seq-name (car seqs)))
|
||||
(if (not (mh-internal-seq name))
|
||||
(mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
|
||||
(setq seqs (cdr seqs)))))
|
||||
(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-messages-in-region msg (point-min) (point-max)
|
||||
(when (gethash msg msg-hash)
|
||||
(mh-notate nil mh-note-seq (1+ mh-cmd-note))))))
|
||||
|
||||
(defun mh-internal-seq (name)
|
||||
"Return non-nil if NAME is the name of an internal MH-E sequence."
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-funcs.el,v 1.9 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-funcs.el,v 1.43 2003/01/26 00:57:35 jchonig Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -80,49 +80,66 @@ Default is the displayed message. If optional prefix argument is provided,
|
|||
then prompt for the message sequence."
|
||||
(interactive (list (cond
|
||||
((mh-mark-active-p t)
|
||||
(mh-region-to-msg-list (region-beginning) (region-end)))
|
||||
(cons (region-beginning) (region-end)))
|
||||
(current-prefix-arg
|
||||
(mh-read-seq-default "Copy" t))
|
||||
(t
|
||||
(mh-get-msg-num t)))
|
||||
(cons (line-beginning-position) (line-end-position))))
|
||||
(mh-prompt-for-folder "Copy to" "" t)))
|
||||
(mh-exec-cmd "refile"
|
||||
(cond ((numberp msg-or-seq) msg-or-seq)
|
||||
((listp msg-or-seq) msg-or-seq)
|
||||
(t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq))))
|
||||
"-link" "-src" mh-current-folder folder)
|
||||
(if (numberp msg-or-seq)
|
||||
(mh-notate msg-or-seq mh-note-copied mh-cmd-note)
|
||||
(mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
|
||||
(let ((msg-list (cond ((numberp msg-or-seq) (list msg-or-seq))
|
||||
((symbolp msg-or-seq) (mh-seq-to-msgs msg-or-seq))
|
||||
((and (consp msg-or-seq) (numberp (car msg-or-seq))
|
||||
(numberp (cdr msg-or-seq)))
|
||||
(let ((result ()))
|
||||
(mh-iterate-on-messages-in-region msg
|
||||
(car msg-or-seq) (cdr msg-or-seq)
|
||||
(mh-notate nil mh-note-copied mh-cmd-note)
|
||||
(push msg result))
|
||||
result))
|
||||
(t msg-or-seq))))
|
||||
(mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)
|
||||
"-link" "-src" mh-current-folder folder)
|
||||
(cond ((numberp msg-or-seq)
|
||||
(mh-notate msg-or-seq mh-note-copied mh-cmd-note))
|
||||
((symbolp msg-or-seq)
|
||||
(mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-kill-folder ()
|
||||
"Remove the current folder and all included messages.
|
||||
Removes all of the messages (files) within the specified current folder,
|
||||
and then removes the folder (directory) itself.
|
||||
The value of `mh-folder-list-change-hook' is a list of functions to be called,
|
||||
with no arguments, after the folders has been removed."
|
||||
and then removes the folder (directory) itself."
|
||||
(interactive)
|
||||
(if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
|
||||
mh-current-folder))
|
||||
(let ((folder mh-current-folder))
|
||||
(if (null mh-folder-list)
|
||||
(mh-set-folder-list))
|
||||
(if (or mh-index-data
|
||||
(yes-or-no-p (format "Remove folder %s (and all included messages)?"
|
||||
mh-current-folder)))
|
||||
(let ((folder mh-current-folder)
|
||||
(window-config mh-previous-window-config))
|
||||
(mh-set-folder-modified-p t) ; lock folder to kill it
|
||||
(mh-exec-cmd-daemon "rmf" folder)
|
||||
(setq mh-folder-list
|
||||
(delq (assoc folder mh-folder-list) mh-folder-list))
|
||||
(mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder)
|
||||
(when (boundp 'mh-speed-folder-map)
|
||||
(mh-speed-invalidate-map folder))
|
||||
(run-hooks 'mh-folder-list-change-hook)
|
||||
(message "Folder %s removed" folder)
|
||||
(mh-remove-from-sub-folders-cache folder)
|
||||
(mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
|
||||
(if (get-buffer mh-show-buffer)
|
||||
(if (and mh-show-buffer (get-buffer mh-show-buffer))
|
||||
(kill-buffer mh-show-buffer))
|
||||
(if (get-buffer folder)
|
||||
(kill-buffer folder)))
|
||||
(kill-buffer folder))
|
||||
(when window-config
|
||||
(set-window-configuration window-config))
|
||||
(message "Folder %s removed" folder))
|
||||
(message "Folder not removed")))
|
||||
|
||||
(defun mh-rmf-daemon (process output)
|
||||
"The rmf PROCESS puts OUTPUT in temporary buffer.
|
||||
Display the results only if something went wrong."
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(insert-before-markers output)
|
||||
(when (save-excursion
|
||||
(beginning-of-buffer)
|
||||
(re-search-forward "^rmf: " (point-max) t))
|
||||
(display-buffer mh-temp-buffer)))
|
||||
|
||||
;; Avoid compiler warning...
|
||||
(defvar view-exit-action)
|
||||
|
||||
|
|
@ -130,7 +147,7 @@ with no arguments, after the folders has been removed."
|
|||
(defun mh-list-folders ()
|
||||
"List mail folders."
|
||||
(interactive)
|
||||
(let ((temp-buffer mh-temp-folders-buffer))
|
||||
(let ((temp-buffer mh-folders-buffer))
|
||||
(with-output-to-temp-buffer temp-buffer
|
||||
(save-excursion
|
||||
(set-buffer temp-buffer)
|
||||
|
|
@ -267,7 +284,7 @@ The messages are formatted by mhl. See the variable `mhl-formfile'."
|
|||
(format "Sequence from %s"
|
||||
mh-current-folder)))))))
|
||||
(if mh-print-background-flag
|
||||
(mh-exec-cmd-daemon shell-file-name "-c" print-command)
|
||||
(mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
|
||||
(call-process shell-file-name nil nil nil "-c" print-command))
|
||||
(if (numberp msg-or-seq)
|
||||
(mh-notate msg-or-seq mh-note-printed mh-cmd-note)
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-identity.el,v 1.1 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-identity.el,v 1.17 2002/12/03 15:54:27 psg Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
|
|||
|
|
@ -40,13 +40,14 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-index.el,v 1.2 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-index.el,v 1.83 2003/01/27 04:16:47 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
(require 'mh-e)
|
||||
(require 'mh-mime)
|
||||
(require 'mh-pick)
|
||||
|
||||
(autoload 'gnus-local-map-property "gnus-util")
|
||||
(autoload 'gnus-eval-format "gnus-spec")
|
||||
|
|
@ -56,15 +57,22 @@
|
|||
;; Support different indexing programs
|
||||
(defvar mh-indexer-choices
|
||||
'((swish++
|
||||
mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result)
|
||||
mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result
|
||||
mh-swish++-regexp-builder)
|
||||
(swish
|
||||
mh-swish-binary mh-swish-execute-search mh-swish-next-result)
|
||||
mh-swish-binary mh-swish-execute-search mh-swish-next-result nil)
|
||||
(mairix
|
||||
mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result
|
||||
mh-mairix-regexp-builder)
|
||||
(namazu
|
||||
mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result)
|
||||
mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
|
||||
(glimpse
|
||||
mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result)
|
||||
mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil)
|
||||
(pick
|
||||
mh-pick-binary mh-pick-execute-search mh-pick-next-result
|
||||
mh-pick-regexp-builder)
|
||||
(grep
|
||||
mh-grep-binary mh-grep-execute-search mh-grep-next-result))
|
||||
mh-grep-binary mh-grep-execute-search mh-grep-next-result nil))
|
||||
"List of possible indexer choices.")
|
||||
(defvar mh-indexer nil
|
||||
"Chosen index program.")
|
||||
|
|
@ -72,6 +80,8 @@
|
|||
"Function which executes the search program.")
|
||||
(defvar mh-index-next-result-function nil
|
||||
"Function to parse the next line of output.")
|
||||
(defvar mh-index-regexp-builder nil
|
||||
"Function used to construct search regexp.")
|
||||
|
||||
;; FIXME: This should be a defcustom...
|
||||
(defvar mh-index-folder "+mhe-index"
|
||||
|
|
@ -254,16 +264,26 @@ checksum -> (origin-folder, origin-index) map is updated too."
|
|||
"Given STRING generate a name which is suitable for use as a folder name.
|
||||
White space from the beginning and end are removed. All spaces in the name are
|
||||
replaced with underscores and all / are replaced with $. If STRING is longer
|
||||
than 20 it is truncated too."
|
||||
than 20 it is truncated too. STRING could be a list of strings in which case
|
||||
they are concatenated to construct the base name."
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(if (stringp string)
|
||||
(insert string)
|
||||
(when (car string) (insert (car string)))
|
||||
(dolist (s (cdr string))
|
||||
(insert "_" s)))
|
||||
(setq string (mh-replace-string "-lbrace" " "))
|
||||
(setq string (mh-replace-string "-rbrace" " "))
|
||||
(subst-char-in-region (point-min) (point-max) ?( ? t)
|
||||
(subst-char-in-region (point-min) (point-max) ?) ? t)
|
||||
(subst-char-in-region (point-min) (point-max) ?- ? t)
|
||||
(goto-char (point-min))
|
||||
(while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r)))
|
||||
(while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_)))
|
||||
(delete-char 1))
|
||||
(goto-char (point-max))
|
||||
(while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r)))
|
||||
(while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_)))
|
||||
(delete-backward-char 1))
|
||||
(subst-char-in-region (point-min) (point-max) ? ?_ t)
|
||||
(subst-char-in-region (point-min) (point-max) ? ?_ t)
|
||||
(subst-char-in-region (point-min) (point-max) ?\t ?_ t)
|
||||
(subst-char-in-region (point-min) (point-max) ?\n ?_ t)
|
||||
(subst-char-in-region (point-min) (point-max) ?\r ?_ t)
|
||||
|
|
@ -271,13 +291,16 @@ than 20 it is truncated too."
|
|||
(truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-search (redo-search-flag folder search-regexp)
|
||||
(defun* mh-index-search (redo-search-flag folder search-regexp
|
||||
&optional window-config)
|
||||
"Perform an indexed search in an MH mail folder.
|
||||
|
||||
If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
|
||||
index search, then the search is repeated. Otherwise, FOLDER is searched with
|
||||
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
|
||||
\"+\" then mail in all folders are searched.
|
||||
\"+\" 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.
|
||||
|
||||
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
|
||||
|
|
@ -289,9 +312,16 @@ index for each program:
|
|||
|
||||
- `mh-swish++-execute-search'
|
||||
- `mh-swish-execute-search'
|
||||
- `mh-mairix-execute-search'
|
||||
- `mh-namazu-execute-search'
|
||||
- `mh-glimpse-execute-search'
|
||||
|
||||
If none of these programs are present then we use pick. If desired grep can be
|
||||
used instead. Details about these methods can be found in:
|
||||
|
||||
- `mh-pick-execute-search'
|
||||
- `mh-grep-execute-search'
|
||||
|
||||
This and related functions use an X-MHE-Checksum header to cache the MD5
|
||||
checksum of a message. This means that already present X-MHE-Checksum headers
|
||||
in the incoming email could result in messages not being found. The following
|
||||
|
|
@ -306,18 +336,28 @@ This has the effect of renaming already present X-MHE-Checksum headers."
|
|||
(progn
|
||||
(unless mh-find-path-run (mh-find-path))
|
||||
(or (and current-prefix-arg (car mh-index-previous-search))
|
||||
(mh-prompt-for-folder "Search" "+" nil "all")))
|
||||
(mh-prompt-for-folder "Search" "+" nil "all" t)))
|
||||
(progn
|
||||
;; Yes, we do want to call mh-index-choose every time in case the
|
||||
;; user has switched the indexer manually.
|
||||
(unless (mh-index-choose) (error "No indexing program found"))
|
||||
(or (and current-prefix-arg (cadr mh-index-previous-search))
|
||||
mh-index-regexp-builder
|
||||
(read-string (format "%s regexp: "
|
||||
(upcase-initials
|
||||
(symbol-name mh-indexer))))))))
|
||||
(symbol-name mh-indexer))))))
|
||||
(if (and (not
|
||||
(and current-prefix-arg (cadr mh-index-previous-search)))
|
||||
mh-index-regexp-builder)
|
||||
(current-window-configuration)
|
||||
nil)))
|
||||
(when (symbolp search-regexp)
|
||||
(mh-search-folder folder window-config)
|
||||
(setq mh-searching-function 'mh-index-do-search)
|
||||
(return-from mh-index-search))
|
||||
(mh-checksum-choose)
|
||||
(let ((result-count 0)
|
||||
(old-window-config mh-previous-window-config)
|
||||
(old-window-config (or window-config mh-previous-window-config))
|
||||
(previous-search mh-index-previous-search)
|
||||
(index-folder (format "%s/%s" mh-index-folder
|
||||
(mh-index-generate-pretty-name search-regexp))))
|
||||
|
|
@ -373,7 +413,7 @@ This has the effect of renaming already present X-MHE-Checksum headers."
|
|||
(mh-recenter nil)
|
||||
|
||||
;; Maintain history
|
||||
(when (and redo-search-flag previous-search)
|
||||
(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))
|
||||
|
||||
|
|
@ -384,6 +424,123 @@ This has the effect of renaming already present X-MHE-Checksum headers."
|
|||
(loop for msg-hash being hash-values of mh-index-data
|
||||
count (> (hash-table-count msg-hash) 0))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-do-search ()
|
||||
"Construct appropriate regexp and call `mh-index-search'."
|
||||
(interactive)
|
||||
(unless (mh-index-choose) (error "No indexing program found"))
|
||||
(let* ((regexp-list (mh-pick-parse-search-buffer))
|
||||
(pattern (funcall mh-index-regexp-builder regexp-list)))
|
||||
(if pattern
|
||||
(mh-index-search nil mh-current-folder pattern
|
||||
mh-previous-window-config)
|
||||
(error "No search terms"))))
|
||||
|
||||
(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)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-parse-search-regexp (input-string)
|
||||
"Construct parse tree for INPUT-STRING.
|
||||
All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by AND, OR and
|
||||
NOT as appropriate. Then the resulting string is parsed."
|
||||
(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 ")
|
||||
(mh-replace-string " -and " " and ")
|
||||
;; synonyms of OR
|
||||
(mh-replace-string "|" " or ")
|
||||
(mh-replace-string " -or " " or ")
|
||||
;; synonyms of NOT
|
||||
(mh-replace-string "!" " not ")
|
||||
(mh-replace-string "~" " not ")
|
||||
(mh-replace-string " -not " " not ")
|
||||
;; synonyms of left brace
|
||||
(mh-replace-string "(" " ( ")
|
||||
(mh-replace-string " -lbrace " " ( ")
|
||||
;; synonyms of right brace
|
||||
(mh-replace-string ")" " ) ")
|
||||
(mh-replace-string " -rbrace " " ) ")
|
||||
;; get the normalized input
|
||||
(setq input (format "( %s )" (buffer-substring (point-min) (point-max)))))
|
||||
|
||||
(let ((tokens (mh-index-add-implicit-ops (split-string input)))
|
||||
(op-stack ())
|
||||
(operand-stack ())
|
||||
oper1)
|
||||
(dolist (token tokens)
|
||||
(cond ((equal token "(") (push 'paren op-stack))
|
||||
((equal token "not") (push 'not op-stack))
|
||||
((equal token "or") (push 'or op-stack))
|
||||
((equal token "and") (push 'and op-stack))
|
||||
((equal token ")")
|
||||
(multiple-value-setq (op-stack operand-stack)
|
||||
(mh-index-evaluate op-stack operand-stack))
|
||||
(when (eq (car op-stack) 'not)
|
||||
(pop op-stack)
|
||||
(push `(not ,(pop operand-stack)) operand-stack))
|
||||
(when (eq (car op-stack) 'and)
|
||||
(pop op-stack)
|
||||
(setq oper1 (pop operand-stack))
|
||||
(push `(and ,(pop operand-stack) ,oper1) operand-stack)))
|
||||
((eq (car op-stack) 'not)
|
||||
(pop op-stack)
|
||||
(push `(not ,token) operand-stack)
|
||||
(when (eq (car op-stack) 'and)
|
||||
(pop op-stack)
|
||||
(setq oper1 (pop operand-stack))
|
||||
(push `(and ,(pop operand-stack) ,oper1) operand-stack)))
|
||||
((eq (car op-stack) 'and)
|
||||
(pop op-stack)
|
||||
(push `(and ,(pop operand-stack) ,token) operand-stack))
|
||||
(t (push token operand-stack))))
|
||||
(prog1 (pop operand-stack)
|
||||
(when (or op-stack operand-stack)
|
||||
(error "Invalid regexp: %s" input))))))
|
||||
|
||||
(defun mh-index-add-implicit-ops (tokens)
|
||||
"Add implicit operators in the list TOKENS."
|
||||
(let ((result ())
|
||||
(literal-seen nil)
|
||||
current)
|
||||
(while tokens
|
||||
(setq current (pop tokens))
|
||||
(cond ((or (equal current ")") (equal current "and") (equal current "or"))
|
||||
(setq literal-seen nil)
|
||||
(push current result))
|
||||
((and literal-seen
|
||||
(push "and" result)
|
||||
(setq literal-seen nil)
|
||||
nil))
|
||||
(t
|
||||
(push current result)
|
||||
(unless (or (equal current "(") (equal current "not"))
|
||||
(setq literal-seen t)))))
|
||||
(nreverse result)))
|
||||
|
||||
(defun mh-index-evaluate (op-stack operand-stack)
|
||||
"Read expression till starting paren based on OP-STACK and OPERAND-STACK."
|
||||
(block mh-index-evaluate
|
||||
(let (op oper1)
|
||||
(while op-stack
|
||||
(setq op (pop op-stack))
|
||||
(cond ((eq op 'paren)
|
||||
(return-from mh-index-evaluate (values op-stack operand-stack)))
|
||||
((eq op 'not)
|
||||
(push `(not ,(pop operand-stack)) operand-stack))
|
||||
((or (eq op 'and) (eq op 'or))
|
||||
(setq oper1 (pop operand-stack))
|
||||
(push `(,op ,(pop operand-stack) ,oper1) operand-stack))))
|
||||
(error "Ran out of tokens"))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-next-folder (&optional backward-flag)
|
||||
"Jump to the next folder marker.
|
||||
|
|
@ -446,9 +603,9 @@ we find a new folder name."
|
|||
(setq chosen-name new-name)
|
||||
(return-from unique-name)))))
|
||||
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
|
||||
(mh-remove-from-sub-folders-cache chosen-name)
|
||||
(when (boundp 'mh-speed-folder-map)
|
||||
(mh-speed-add-folder chosen-name))
|
||||
(push (list chosen-name) mh-folder-list)
|
||||
chosen-name))
|
||||
|
||||
;;;###mh-autoload
|
||||
|
|
@ -476,6 +633,9 @@ we find a new folder name."
|
|||
(let ((cur-msg (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil))
|
||||
(while (and (not cur-msg) (not (eobp)))
|
||||
(forward-line)
|
||||
(setq cur-msg (mh-get-msg-num nil)))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
|
||||
|
|
@ -620,6 +780,43 @@ other matches left then return nil. If the current record is invalid return
|
|||
|
||||
|
||||
|
||||
;; Pick interface
|
||||
|
||||
(defvar mh-index-pick-folder)
|
||||
(defvar mh-pick-binary "pick")
|
||||
|
||||
(defun mh-pick-execute-search (folder-path search-regexp)
|
||||
"Execute pick.
|
||||
|
||||
Unlike the other index search programs \"pick\" only searches messages present
|
||||
in the folder itself and does not descend into any sub-folders that may be
|
||||
present.
|
||||
|
||||
FOLDER-PATH is the directory containing the mails to be searched and
|
||||
SEARCH-REGEXP is the pattern that pick gets."
|
||||
(set-buffer (get-buffer-create mh-index-temp-buffer))
|
||||
(erase-buffer)
|
||||
(setq mh-index-pick-folder
|
||||
(concat "+" (substring folder-path (length mh-user-path))))
|
||||
(apply #'call-process (expand-file-name "pick" mh-progs) nil '(t nil) nil
|
||||
mh-index-pick-folder "-list" search-regexp)
|
||||
(goto-char (point-min)))
|
||||
|
||||
(defun mh-pick-next-result ()
|
||||
"Return the next pick search result."
|
||||
(prog1 (block nil
|
||||
(when (eobp) (return nil))
|
||||
(unless (re-search-forward "^[1-9][0-9]*$" (line-end-position) t)
|
||||
(return 'error))
|
||||
(list mh-index-pick-folder
|
||||
(car (read-from-string (buffer-substring-no-properties
|
||||
(line-beginning-position)
|
||||
(line-end-position))))
|
||||
nil))
|
||||
(forward-line)))
|
||||
|
||||
|
||||
|
||||
;; Grep interface
|
||||
|
||||
(defvar mh-grep-binary (executable-find "grep"))
|
||||
|
|
@ -669,6 +866,140 @@ other matches left then return nil. If the current record is invalid return
|
|||
|
||||
|
||||
|
||||
;; Mairix interface
|
||||
|
||||
(defvar mh-mairix-binary (executable-find "mairix"))
|
||||
(defvar mh-mairix-directory ".mairix")
|
||||
(defvar mh-mairix-folder nil)
|
||||
|
||||
(defun mh-mairix-execute-search (folder-path search-regexp-list)
|
||||
"Execute mairix and read the results.
|
||||
|
||||
In the examples below replace /home/user/Mail with the path to your MH
|
||||
directory.
|
||||
|
||||
First create the directory /home/user/Mail/.mairix. Then create the file
|
||||
/home/user/Mail/.mairix/config with the following contents:
|
||||
|
||||
# This should contain the same thing as your `mh-user-path'
|
||||
base=/home/user/Mail
|
||||
|
||||
# List of folders that should be indexed. 3 dots at the end means there are
|
||||
# subfolders within the folder
|
||||
mh_folders=archive...:inbox:drafts:news:sent:trash
|
||||
|
||||
vfolder_format=raw
|
||||
database=/home/user/Mail/mairix/database
|
||||
|
||||
Use the following command line to generate the mairix index. Run this daily
|
||||
from cron:
|
||||
|
||||
mairix -f /home/user/Mail/.mairix/config
|
||||
|
||||
FOLDER-PATH is the directory in which SEARCH-REGEXP-LIST is used to search."
|
||||
(set-buffer (get-buffer-create mh-index-temp-buffer))
|
||||
(erase-buffer)
|
||||
(unless mh-mairix-binary
|
||||
(error "Set mh-mairix-binary appropriately"))
|
||||
(apply #'call-process mh-mairix-binary nil '(t nil) nil
|
||||
"-f" (format "%s%s/config" mh-user-path mh-mairix-directory)
|
||||
search-regexp-list)
|
||||
(goto-char (point-min))
|
||||
(setq mh-mairix-folder
|
||||
(let ((last-char (substring folder-path (1- (length folder-path)))))
|
||||
(if (equal last-char "/")
|
||||
folder-path
|
||||
(format "%s/" folder-path)))))
|
||||
|
||||
(defun mh-mairix-next-result ()
|
||||
"Return next result from mairix output."
|
||||
(prog1
|
||||
(block nil
|
||||
(when (or (eobp) (and (bolp) (eolp)))
|
||||
(return nil))
|
||||
(unless (eq (char-after) ?/)
|
||||
(return error))
|
||||
(let ((start (point))
|
||||
end msg-start)
|
||||
(setq end (line-end-position))
|
||||
(unless (search-forward mh-mairix-folder end t)
|
||||
(return 'error))
|
||||
(goto-char (match-beginning 0))
|
||||
(unless (equal (point) start)
|
||||
(return 'error))
|
||||
(goto-char end)
|
||||
(unless (search-backward "/" start t)
|
||||
(return 'error))
|
||||
(setq msg-start (1+ (point)))
|
||||
(goto-char start)
|
||||
(unless (search-forward mh-user-path end t)
|
||||
(return 'error))
|
||||
(list (format "+%s" (buffer-substring-no-properties
|
||||
(point) (1- msg-start)))
|
||||
(car (read-from-string
|
||||
(buffer-substring-no-properties msg-start end)))
|
||||
())))
|
||||
(forward-line)))
|
||||
|
||||
(defun mh-mairix-regexp-builder (regexp-list)
|
||||
"Generate query for mairix.
|
||||
REGEXP-LIST is an alist of fields and values."
|
||||
(let ((result ()))
|
||||
(dolist (pair regexp-list)
|
||||
(when (cdr pair)
|
||||
(push
|
||||
(concat
|
||||
(cond ((eq (car pair) 'to) "t:")
|
||||
((eq (car pair) 'from) "f:")
|
||||
((eq (car pair) 'cc) "c:")
|
||||
((eq (car pair) 'subject) "s:")
|
||||
((eq (car pair) 'date) "d:")
|
||||
(t ""))
|
||||
(let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair))))
|
||||
(final ""))
|
||||
(dolist (conjunct sop)
|
||||
(let ((expr-list (cdr conjunct))
|
||||
(expr-string ""))
|
||||
(dolist (e expr-list)
|
||||
(setq expr-string (concat expr-string "+"
|
||||
(if (atom e) "" "~")
|
||||
(if (atom e) e (cadr e)))))
|
||||
(setq final (concat final "," (substring expr-string 1)))))
|
||||
(substring final 1)))
|
||||
result)))
|
||||
result))
|
||||
|
||||
(defun mh-mairix-convert-to-sop* (expr)
|
||||
"Convert EXPR to sum of product form."
|
||||
(cond ((atom expr) `(or (and ,expr)))
|
||||
((eq (car expr) 'or)
|
||||
(cons 'or
|
||||
(loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr))
|
||||
append (cdr e))))
|
||||
((eq (car expr) 'and)
|
||||
(let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr)))
|
||||
result next-factor)
|
||||
(setq result (pop conjuncts))
|
||||
(while conjuncts
|
||||
(setq next-factor (pop conjuncts))
|
||||
(setq result (let ((res ()))
|
||||
(dolist (t1 (cdr result))
|
||||
(dolist (t2 (cdr next-factor))
|
||||
(push `(and ,@(cdr t1) ,@(cdr t2)) res)))
|
||||
(cons 'or res))))
|
||||
result))
|
||||
((atom (cadr expr)) `(or (and ,expr)))
|
||||
((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr)))
|
||||
((eq (caadr expr) 'and) (mh-mairix-convert-to-sop*
|
||||
`(or ,@(mapcar #'(lambda (x) `(not ,x))
|
||||
(cdadr expr)))))
|
||||
((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
|
||||
`(and ,@(mapcar #'(lambda (x) `(not ,x))
|
||||
(cdadr expr)))))
|
||||
(t (error "Unreachable: %s" expr))))
|
||||
|
||||
|
||||
|
||||
;; Swish interface
|
||||
|
||||
(defvar mh-swish-binary (executable-find "swish-e"))
|
||||
|
|
@ -704,7 +1035,7 @@ First create the directory /home/user/Mail/.swish. Then create the file
|
|||
FileRules pathname contains /home/user/Mail/.swish
|
||||
FileRules pathname contains /home/user/Mail/mhe-index
|
||||
FileRules filename is index
|
||||
FileRules filename is \..*
|
||||
FileRules filename is \\..*
|
||||
FileRules filename is #.*
|
||||
FileRules filename is ,.*
|
||||
FileRules filename is .*~
|
||||
|
|
@ -829,6 +1160,29 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
|
|||
|
||||
(defalias 'mh-swish++-next-result 'mh-swish-next-result)
|
||||
|
||||
(defun mh-swish++-regexp-builder (regexp-list)
|
||||
"Generate query for swish++.
|
||||
REGEXP-LIST is an alist of fields and values."
|
||||
(let ((regexp "") meta)
|
||||
(dolist (elem regexp-list)
|
||||
(when (cdr elem)
|
||||
(setq regexp (concat regexp " and "
|
||||
(if (car elem) "(" "")
|
||||
(if (car elem) (symbol-name (car elem)) "")
|
||||
(if (car elem) " = " "")
|
||||
(mh-swish++-print-regexp (cdr elem))
|
||||
(if (car elem) ")" "")))))
|
||||
(substring regexp 4)))
|
||||
|
||||
(defun mh-swish++-print-regexp (expr)
|
||||
"Return infix expression corresponding to EXPR."
|
||||
(cond ((atom expr) (format "%s" expr))
|
||||
((eq (car expr) 'not)
|
||||
(format "(not %s)" (mh-swish++-print-regexp (cadr expr))))
|
||||
(t (format "(%s %s %s)" (mh-swish++-print-regexp (cadr expr))
|
||||
(symbol-name (car expr))
|
||||
(mh-swish++-print-regexp (caddr expr))))))
|
||||
|
||||
|
||||
|
||||
;; Namazu interface
|
||||
|
|
@ -931,8 +1285,9 @@ system."
|
|||
(executable (symbol-value (cadr current))))
|
||||
(when executable
|
||||
(setq mh-indexer (car current))
|
||||
(setq mh-index-execute-search-function (caddr current))
|
||||
(setq mh-index-next-result-function (cadddr current))
|
||||
(setq mh-index-execute-search-function (nth 2 current))
|
||||
(setq mh-index-next-result-function (nth 3 current))
|
||||
(setq mh-index-regexp-builder (nth 4 current))
|
||||
(return mh-indexer))))
|
||||
nil)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,11 @@
|
|||
;;; mh-loaddefs.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Copyright (C) 2003 Free Software Foundation, Inc.
|
||||
;;; Author: Bill Wohler <wohler@newt.com>
|
||||
;;; Keywords: mail
|
||||
;;; Commentary:
|
||||
;;; Change Log:
|
||||
;; $Id: mh-loaddefs.el,v 1.36 2003/02/03 19:15:13 wohler Exp $
|
||||
;;; Code:
|
||||
|
||||
;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
|
||||
|
|
@ -8,7 +13,7 @@
|
|||
;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
|
||||
;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
|
||||
;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
|
||||
;;;;;; (15899 19356))
|
||||
;;;;;; (15924 43423))
|
||||
;;; Generated autoloads from mh-comp.el
|
||||
|
||||
(autoload (quote mh-edit-again) "mh-comp" "\
|
||||
|
|
@ -145,11 +150,13 @@ passing the prefix ARG if any." t nil)
|
|||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set
|
||||
;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15899 29873))
|
||||
;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15933 21842))
|
||||
;;; Generated autoloads from mh-customize.el
|
||||
|
||||
(autoload (quote mh-customize) "mh-customize" "\
|
||||
Customize MH-E variables." t nil)
|
||||
Customize MH-E variables.
|
||||
With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame
|
||||
are removed." t nil)
|
||||
|
||||
(autoload (quote mh-tool-bar-letter-set) "mh-customize" "\
|
||||
Construct toolbar for `mh-letter-mode'." nil nil)
|
||||
|
|
@ -160,7 +167,7 @@ Construct toolbar for `mh-folder-mode'." nil nil)
|
|||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
|
||||
;;;;;; "mh-e" "mh-e.el" (15899 29921))
|
||||
;;;;;; "mh-e" "mh-e.el" (15934 48879))
|
||||
;;; Generated autoloads from mh-e.el
|
||||
|
||||
(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
|
||||
|
|
@ -183,7 +190,7 @@ recenter the folder buffer." nil nil)
|
|||
;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
|
||||
;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
|
||||
;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
|
||||
;;;;;; (15886 19303))
|
||||
;;;;;; (15923 15465))
|
||||
;;; Generated autoloads from mh-funcs.el
|
||||
|
||||
(autoload (quote mh-burst-digest) "mh-funcs" "\
|
||||
|
|
@ -199,9 +206,7 @@ then prompt for the message sequence." t nil)
|
|||
(autoload (quote mh-kill-folder) "mh-funcs" "\
|
||||
Remove the current folder and all included messages.
|
||||
Removes all of the messages (files) within the specified current folder,
|
||||
and then removes the folder (directory) itself.
|
||||
The value of `mh-folder-list-change-hook' is a list of functions to be called,
|
||||
with no arguments, after the folders has been removed." t nil)
|
||||
and then removes the folder (directory) itself." t nil)
|
||||
|
||||
(autoload (quote mh-list-folders) "mh-funcs" "\
|
||||
List mail folders." t nil)
|
||||
|
|
@ -260,7 +265,7 @@ Display cheat sheet for the commands of the current prefix in minibuffer." t nil
|
|||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
|
||||
;;;;;; "mh-identity" "mh-identity.el" (15852 60439))
|
||||
;;;;;; "mh-identity" "mh-identity.el" (15900 46388))
|
||||
;;; Generated autoloads from mh-identity.el
|
||||
|
||||
(autoload (quote mh-identity-make-menu) "mh-identity" "\
|
||||
|
|
@ -281,8 +286,9 @@ Edit the `mh-identity-list' variable to define identity." t nil)
|
|||
;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search
|
||||
;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands
|
||||
;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers
|
||||
;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-search
|
||||
;;;;;; mh-index-update-maps) "mh-index" "mh-index.el" (15899 19358))
|
||||
;;;;;; 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" (15924 45743))
|
||||
;;; Generated autoloads from mh-index.el
|
||||
|
||||
(autoload (quote mh-index-update-maps) "mh-index" "\
|
||||
|
|
@ -298,7 +304,9 @@ Perform an indexed search in an MH mail folder.
|
|||
If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
|
||||
index search, then the search is repeated. Otherwise, FOLDER is searched with
|
||||
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
|
||||
\"+\" then mail in all folders are searched.
|
||||
\"+\" 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.
|
||||
|
||||
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
|
||||
|
|
@ -310,9 +318,16 @@ index for each program:
|
|||
|
||||
- `mh-swish++-execute-search'
|
||||
- `mh-swish-execute-search'
|
||||
- `mh-mairix-execute-search'
|
||||
- `mh-namazu-execute-search'
|
||||
- `mh-glimpse-execute-search'
|
||||
|
||||
If none of these programs are present then we use pick. If desired grep can be
|
||||
used instead. Details about these methods can be found in:
|
||||
|
||||
- `mh-pick-execute-search'
|
||||
- `mh-grep-execute-search'
|
||||
|
||||
This and related functions use an X-MHE-Checksum header to cache the MD5
|
||||
checksum of a message. This means that already present X-MHE-Checksum headers
|
||||
in the incoming email could result in messages not being found. The following
|
||||
|
|
@ -323,6 +338,14 @@ procmail recipe should avoid this:
|
|||
|
||||
This has the effect of renaming already present X-MHE-Checksum headers." t nil)
|
||||
|
||||
(autoload (quote mh-index-do-search) "mh-index" "\
|
||||
Construct appropriate regexp and call `mh-index-search'." t nil)
|
||||
|
||||
(autoload (quote mh-index-parse-search-regexp) "mh-index" "\
|
||||
Construct parse tree for INPUT-STRING.
|
||||
All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by AND, OR and
|
||||
NOT as appropriate. Then the resulting string is parsed." nil nil)
|
||||
|
||||
(autoload (quote mh-index-next-folder) "mh-index" "\
|
||||
Jump to the next folder marker.
|
||||
The function is only applicable to folders displaying index search results.
|
||||
|
|
@ -408,7 +431,7 @@ First create the directory /home/user/Mail/.swish. Then create the file
|
|||
FileRules pathname contains /home/user/Mail/.swish
|
||||
FileRules pathname contains /home/user/Mail/mhe-index
|
||||
FileRules filename is index
|
||||
FileRules filename is ..*
|
||||
FileRules filename is \\..*
|
||||
FileRules filename is #.*
|
||||
FileRules filename is ,.*
|
||||
FileRules filename is .*~
|
||||
|
|
@ -501,7 +524,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
|
|||
;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime
|
||||
;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
|
||||
;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
|
||||
;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15858 6046))
|
||||
;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15923 15465))
|
||||
;;; Generated autoloads from mh-mime.el
|
||||
|
||||
(autoload (quote mh-compose-insertion) "mh-mime" "\
|
||||
|
|
@ -665,30 +688,45 @@ Toggle display of the raw MIME part." t nil)
|
|||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-do-pick-search mh-search-folder) "mh-pick"
|
||||
;;;;;; "mh-pick.el" (15854 20166))
|
||||
;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search
|
||||
;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (15924 45743))
|
||||
;;; Generated autoloads from mh-pick.el
|
||||
|
||||
(autoload (quote mh-search-folder) "mh-pick" "\
|
||||
Search FOLDER for messages matching a pattern.
|
||||
This function uses the MH command `pick' to do the work.
|
||||
Add the messages found to the sequence named `search'." t nil)
|
||||
Add the messages found to the sequence named `search'.
|
||||
Argument WINDOW-CONFIG is the current window configuration and is used when
|
||||
the search folder is dismissed." t nil)
|
||||
|
||||
(autoload (quote mh-do-pick-search) "mh-pick" "\
|
||||
Find messages that match the qualifications in the current pattern buffer.
|
||||
Messages are searched for in the folder named in `mh-searching-folder'.
|
||||
Add the messages found to the sequence named `search'.
|
||||
|
||||
This is a deprecated function and `mh-pick-do-search' should be used instead." t nil)
|
||||
|
||||
(autoload (quote mh-pick-do-search) "mh-pick" "\
|
||||
Find messages that match the qualifications in the current pattern buffer.
|
||||
Messages are searched for in the folder named in `mh-searching-folder'.
|
||||
Add the messages found to the sequence named `search'." t nil)
|
||||
|
||||
(autoload (quote mh-do-search) "mh-pick" "\
|
||||
Use the default searching function.
|
||||
If \\[mh-search-folder] was used to create the search pattern then pick is used
|
||||
to search the folder. Otherwise if \\[mh-index-search] was used then the
|
||||
indexing program specified in `mh-index-program' is used." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor
|
||||
;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message
|
||||
;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
|
||||
;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list
|
||||
;;;;;; mh-add-to-sequence mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
|
||||
;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
|
||||
;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (15899
|
||||
;;;;;; 19358))
|
||||
;;;;;; 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" (15923 15465))
|
||||
;;; Generated autoloads from mh-seq.el
|
||||
|
||||
(autoload (quote mh-delete-seq) "mh-seq" "\
|
||||
|
|
@ -726,9 +764,21 @@ Mark the scan listing.
|
|||
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
|
||||
the line." nil nil)
|
||||
|
||||
(autoload (quote mh-notate-cur) "mh-seq" "\
|
||||
Mark the MH sequence cur.
|
||||
In addition to notating the current message with `mh-note-cur' the function
|
||||
uses `overlay-arrow-position' to put a marker in the fringe." nil nil)
|
||||
|
||||
(autoload (quote mh-add-to-sequence) "mh-seq" "\
|
||||
The sequence SEQ is augmented with the messages in MSGS." nil nil)
|
||||
|
||||
(autoload (quote mh-iterate-on-messages-in-region) "mh-seq" "\
|
||||
Iterate over region.
|
||||
VAR is bound to the message on the current line as we loop starting from BEGIN
|
||||
till END. In each step BODY is executed.
|
||||
|
||||
If VAR is nil then the loop is executed without any binding." nil (quote macro))
|
||||
|
||||
(autoload (quote mh-region-to-msg-list) "mh-seq" "\
|
||||
Return a list of messages within the region between BEGIN and END." nil nil)
|
||||
|
||||
|
|
@ -756,11 +806,7 @@ All messages after START-POINT are added to the thread tree." nil nil)
|
|||
Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
|
||||
|
||||
(autoload (quote mh-toggle-threads) "mh-seq" "\
|
||||
Toggle threaded view of folder.
|
||||
The conversion of normal view to threaded view is exact, that is the same
|
||||
messages are displayed in the folder buffer before and after threading. However
|
||||
the conversion from threaded view to normal view is inexact. So more messages
|
||||
than were originally present may be shown as a result." t nil)
|
||||
Toggle threaded view of folder." t nil)
|
||||
|
||||
(autoload (quote mh-thread-forget-message) "mh-seq" "\
|
||||
Forget the message INDEX from the threading tables." nil nil)
|
||||
|
|
@ -787,7 +833,7 @@ Mark current message and all its children for refiling to FOLDER." t nil)
|
|||
|
||||
;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
|
||||
;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
|
||||
;;;;;; "mh-speed" "mh-speed.el" (15899 19358))
|
||||
;;;;;; "mh-speed" "mh-speed.el" (15933 21584))
|
||||
;;; Generated autoloads from mh-speed.el
|
||||
|
||||
(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
|
||||
|
|
@ -820,7 +866,7 @@ The function invalidates the latest ancestor that is present." nil nil)
|
|||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
|
||||
;;;;;; "mh-utils" "mh-utils.el" (15899 28827))
|
||||
;;;;;; "mh-utils" "mh-utils.el" (15924 47279))
|
||||
;;; Generated autoloads from mh-utils.el
|
||||
|
||||
(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
|
||||
|
|
@ -836,9 +882,10 @@ not pointing to a message." nil nil)
|
|||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field
|
||||
;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-letter-expand-alias
|
||||
;;;;;; mh-alias-minibuffer-confirm-address mh-read-address mh-alias-reload)
|
||||
;;;;;; "mh-alias" "mh-alias.el" (15899 29102))
|
||||
;;;;;; 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"
|
||||
;;;;;; (15924 45743))
|
||||
;;; Generated autoloads from mh-alias.el
|
||||
|
||||
(autoload (quote mh-alias-reload) "mh-alias" "\
|
||||
|
|
@ -853,6 +900,9 @@ Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." t nil)
|
|||
(autoload (quote mh-alias-letter-expand-alias) "mh-alias" "\
|
||||
Expand mail alias before point." nil nil)
|
||||
|
||||
(autoload (quote mh-alias-address-to-alias) "mh-alias" "\
|
||||
Return the ADDRESS alias if defined, or nil." nil nil)
|
||||
|
||||
(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
|
||||
Return t is From has no current alias set." nil nil)
|
||||
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-mime.el,v 1.12 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-mime.el,v 1.100 2003/01/25 19:18:51 satyaki Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -787,7 +787,16 @@ displayed."
|
|||
(setq handles pre-dissected-handles)
|
||||
(setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
|
||||
(setf (mh-mime-handles (mh-buffer-data))
|
||||
(mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))))
|
||||
(mm-merge-handles handles (mh-mime-handles (mh-buffer-data))))
|
||||
|
||||
;; Use charset to decode body...
|
||||
(unless handles
|
||||
(let* ((ct (ignore-errors
|
||||
(mail-header-parse-content-type
|
||||
(message-fetch-field "Content-Type" t))))
|
||||
(charset (mail-content-type-get ct 'charset)))
|
||||
(when (stringp charset)
|
||||
(mm-decode-body charset)))))
|
||||
|
||||
(when (and handles (or (not (stringp (car handles))) (cdr handles)))
|
||||
;; Goto start of message body
|
||||
|
|
@ -1215,14 +1224,9 @@ Parameter EL is unused."
|
|||
The function decodes the message and displays it. It avoids decoding the same
|
||||
message multiple times."
|
||||
(let ((b (point))
|
||||
(charset (mail-content-type-get (mm-handle-type handle) 'charset))
|
||||
(clean-message-header mh-clean-message-header-flag)
|
||||
(invisible-headers mh-invisible-headers)
|
||||
(visible-headers mh-visible-headers))
|
||||
(when (and charset (stringp charset))
|
||||
(setq charset (intern (downcase charset)))
|
||||
(when (eq charset 'us-ascii)
|
||||
(setq charset nil)))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region b b)
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-pick.el,v 1.10 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-pick.el,v 1.30 2003/01/27 04:16:47 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -44,28 +44,34 @@
|
|||
"Keymap for searching folder.")
|
||||
|
||||
(defvar mh-searching-folder nil) ;Folder this pick is searching.
|
||||
(defvar mh-searching-function nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-search-folder (folder)
|
||||
(defun mh-search-folder (folder window-config)
|
||||
"Search FOLDER for messages matching a pattern.
|
||||
This function uses the MH command `pick' to do the work.
|
||||
Add the messages found to the sequence named `search'."
|
||||
(interactive (list (mh-prompt-for-folder "Search"
|
||||
mh-current-folder
|
||||
t)))
|
||||
(switch-to-buffer-other-window "pick-pattern")
|
||||
(if (or (zerop (buffer-size))
|
||||
(not (y-or-n-p "Reuse pattern? ")))
|
||||
(mh-make-pick-template)
|
||||
(message ""))
|
||||
(setq mh-searching-folder folder)
|
||||
(message "%s" (substitute-command-keys
|
||||
(concat "Type \\[mh-do-pick-search] to search messages, "
|
||||
"\\[mh-help] for help."))))
|
||||
Add the messages found to the sequence named `search'.
|
||||
Argument WINDOW-CONFIG is the current window configuration and is used when
|
||||
the search folder is dismissed."
|
||||
(interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t)
|
||||
(current-window-configuration)))
|
||||
(let ((pick-folder (if (equal folder "+") mh-current-folder folder)))
|
||||
(switch-to-buffer-other-window "search-pattern")
|
||||
(if (or (zerop (buffer-size))
|
||||
(not (y-or-n-p "Reuse pattern? ")))
|
||||
(mh-make-pick-template)
|
||||
(message ""))
|
||||
(setq mh-searching-function 'mh-pick-do-search
|
||||
mh-searching-folder pick-folder
|
||||
mh-current-folder folder
|
||||
mh-previous-window-config window-config)
|
||||
(message "%s" (substitute-command-keys
|
||||
(concat "Type \\[mh-do-search] to search messages, "
|
||||
"\\[mh-help] for help.")))))
|
||||
|
||||
(defun mh-make-pick-template ()
|
||||
"Initialize the current buffer with a template for a pick pattern."
|
||||
(erase-buffer)
|
||||
(let ((inhibit-read-only t)) (erase-buffer))
|
||||
(insert "From: \n"
|
||||
"To: \n"
|
||||
"Cc: \n"
|
||||
|
|
@ -74,20 +80,29 @@ Add the messages found to the sequence named `search'."
|
|||
"---------\n")
|
||||
(mh-pick-mode)
|
||||
(goto-char (point-min))
|
||||
(end-of-line))
|
||||
(dotimes (i 5)
|
||||
(add-text-properties (point) (1+ (point)) '(front-sticky t))
|
||||
(add-text-properties (- (line-end-position) 2) (1- (line-end-position))
|
||||
'(rear-nonsticky t))
|
||||
(add-text-properties (point) (1- (line-end-position)) '(read-only t))
|
||||
(forward-line))
|
||||
(add-text-properties (point) (1+ (point)) '(front-sticky t))
|
||||
(add-text-properties (point) (1- (line-end-position)) '(read-only t))
|
||||
(goto-char (point-max)))
|
||||
|
||||
;;; 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]))
|
||||
["Execute the Search" mh-pick-do-search t]))
|
||||
|
||||
|
||||
;;; Help Messages
|
||||
;;; Group messages logically, more or less.
|
||||
(defvar mh-pick-mode-help-messages
|
||||
'((nil
|
||||
"Search messages: \\[mh-do-pick-search]\n"
|
||||
"Search messages using pick: \\[mh-pick-do-search]\n"
|
||||
"Search messages using index: \\[mh-index-do-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.
|
||||
|
|
@ -111,7 +126,7 @@ value does not matter for the search, leave it empty. To search the
|
|||
entire message, supply the pattern in the \"body\" of the template.
|
||||
Each non-empty field must be matched for a message to be selected.
|
||||
To effect a logical \"or\", use \\[mh-search-folder] multiple times.
|
||||
When you have finished, type \\[mh-do-pick-search] to do the search.
|
||||
When you have finished, type \\[mh-pick-do-search] to do the search.
|
||||
|
||||
The value of `mh-pick-mode-hook' is a list of functions to be called,
|
||||
with no arguments, upon entry to this mode.
|
||||
|
|
@ -119,8 +134,9 @@ with no arguments, upon entry to this mode.
|
|||
\\{mh-pick-mode-map}"
|
||||
|
||||
(make-local-variable 'mh-searching-folder)
|
||||
(easy-menu-add mh-pick-menu)
|
||||
(make-local-variable 'mh-searching-function)
|
||||
(make-local-variable 'mh-help-messages)
|
||||
(easy-menu-add mh-pick-menu)
|
||||
(setq mh-help-messages mh-pick-mode-help-messages)
|
||||
(run-hooks 'mh-pick-mode-hook))
|
||||
|
||||
|
|
@ -128,41 +144,58 @@ with no arguments, upon entry to this mode.
|
|||
(defun mh-do-pick-search ()
|
||||
"Find messages that match the qualifications in the current pattern buffer.
|
||||
Messages are searched for in the folder named in `mh-searching-folder'.
|
||||
Add the messages found to the sequence named `search'.
|
||||
|
||||
This is a deprecated function and `mh-pick-do-search' should be used instead."
|
||||
(interactive)
|
||||
(mh-pick-do-search))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-pick-do-search ()
|
||||
"Find messages that match the qualifications in the current pattern buffer.
|
||||
Messages are searched for in the folder named in `mh-searching-folder'.
|
||||
Add the messages found to the sequence named `search'."
|
||||
(interactive)
|
||||
(let ((pattern-buffer (buffer-name))
|
||||
(searching-buffer mh-searching-folder)
|
||||
range
|
||||
msgs
|
||||
(pattern nil)
|
||||
(new-buffer nil))
|
||||
(let ((pattern-list (mh-pick-parse-search-buffer))
|
||||
(folder mh-searching-folder)
|
||||
(new-buffer-flag nil)
|
||||
(window-config mh-previous-window-config)
|
||||
range pick-args msgs)
|
||||
(unless pattern-list
|
||||
(error "No search pattern specified"))
|
||||
(save-excursion
|
||||
(cond ((get-buffer searching-buffer)
|
||||
(set-buffer searching-buffer)
|
||||
(setq range (list (format "%d-%d"
|
||||
mh-first-msg-num mh-last-msg-num))))
|
||||
(cond ((get-buffer folder)
|
||||
(set-buffer folder)
|
||||
(setq range (if (and mh-first-msg-num mh-last-msg-num)
|
||||
(format "%d-%d" mh-first-msg-num mh-last-msg-num)
|
||||
"all")))
|
||||
(t
|
||||
(mh-make-folder searching-buffer)
|
||||
(setq range '("all"))
|
||||
(setq new-buffer t))))
|
||||
(message "Searching...")
|
||||
(goto-char (point-min))
|
||||
(while (and range
|
||||
(setq pattern (mh-next-pick-field pattern-buffer)))
|
||||
(setq msgs (mh-seq-from-command searching-buffer
|
||||
'search
|
||||
(mh-list-to-string
|
||||
(list "pick" pattern searching-buffer
|
||||
"-list"
|
||||
(mh-coalesce-msg-list range)))))
|
||||
(setq range msgs)) ;restrict the pick range for next pass
|
||||
(mh-make-folder folder)
|
||||
(setq range "all")
|
||||
(setq new-buffer-flag t))))
|
||||
(setq pick-args (mh-pick-regexp-builder pattern-list))
|
||||
(when pick-args
|
||||
(setq msgs (mh-seq-from-command folder 'search
|
||||
`("pick" ,folder ,range ,@pick-args))))
|
||||
(message "Searching...done")
|
||||
(if new-buffer
|
||||
(mh-scan-folder searching-buffer msgs)
|
||||
(switch-to-buffer searching-buffer))
|
||||
(if (not new-buffer-flag)
|
||||
(switch-to-buffer folder)
|
||||
(mh-scan-folder folder msgs)
|
||||
(setq mh-previous-window-config window-config))
|
||||
(mh-add-msgs-to-seq msgs 'search)
|
||||
(delete-other-windows)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-do-search ()
|
||||
"Use the default searching function.
|
||||
If \\[mh-search-folder] was used to create the search pattern then pick is used
|
||||
to search the folder. Otherwise if \\[mh-index-search] was used then the
|
||||
indexing program specified in `mh-index-program' is used."
|
||||
(interactive)
|
||||
(if (symbolp mh-searching-function)
|
||||
(funcall mh-searching-function)
|
||||
(error "No searching function defined")))
|
||||
|
||||
(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
|
||||
|
|
@ -181,31 +214,66 @@ and the subsequent elements are its arguments, all strings."
|
|||
(setq msgs (nreverse msgs)) ;put in ascending order
|
||||
msgs)))
|
||||
|
||||
(defun mh-next-pick-field (buffer)
|
||||
"Return the next piece of a pick argument extracted from BUFFER.
|
||||
Return a list like (\"--fieldname\" \"pattern\") or (\"-search\" \"bodypat\")
|
||||
or nil if no pieces remain."
|
||||
(set-buffer buffer)
|
||||
(let ((case-fold-search t))
|
||||
(cond ((eobp)
|
||||
nil)
|
||||
((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
|
||||
nil t)
|
||||
(let* ((component
|
||||
(format "--%s"
|
||||
(downcase (buffer-substring (match-beginning 1)
|
||||
(match-end 1)))))
|
||||
(pat (buffer-substring (match-beginning 2) (match-end 2))))
|
||||
(forward-line 1)
|
||||
(list component pat)))
|
||||
((re-search-forward "^-*$" nil t)
|
||||
(forward-char 1)
|
||||
(let ((body (buffer-substring (point) (point-max))))
|
||||
(if (and (> (length body) 0) (not (equal body "\n")))
|
||||
(list "-search" body)
|
||||
nil)))
|
||||
(t
|
||||
nil))))
|
||||
(defun mh-pick-parse-search-buffer ()
|
||||
"Parse the search buffer contents.
|
||||
The function returns a alist. The car of each element is either the header name
|
||||
to search in or nil to search the whole message. The cdr of the element is the
|
||||
pattern to search."
|
||||
(save-excursion
|
||||
(let ((pattern-list ())
|
||||
(in-body-flag nil)
|
||||
start begin)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (search-forward "--------" (line-end-position) t)
|
||||
(setq in-body-flag t)
|
||||
(beginning-of-line)
|
||||
(setq begin (point))
|
||||
(setq start (if in-body-flag
|
||||
(point)
|
||||
(search-forward ":" (line-end-position) t)
|
||||
(point)))
|
||||
(push (cons (and (not in-body-flag)
|
||||
(intern (downcase
|
||||
(buffer-substring-no-properties
|
||||
begin (1- start)))))
|
||||
(mh-index-parse-search-regexp
|
||||
(buffer-substring-no-properties
|
||||
start (line-end-position))))
|
||||
pattern-list))
|
||||
(forward-line))
|
||||
pattern-list)))
|
||||
|
||||
|
||||
|
||||
;; Functions specific to how pick works...
|
||||
(defun mh-pick-construct-regexp (expr component)
|
||||
"Construct pick compatible expression corresponding to EXPR.
|
||||
COMPONENT is the component to search."
|
||||
(cond ((atom expr) (list component expr))
|
||||
((eq (car expr) 'and)
|
||||
`("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-and"
|
||||
,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace"))
|
||||
((eq (car expr) 'or)
|
||||
`("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-or"
|
||||
,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace"))
|
||||
((eq (car expr) 'not)
|
||||
`("-lbrace" "-not" ,@(mh-pick-construct-regexp (cadr expr) component)
|
||||
"-rbrace"))
|
||||
(t (error "Unknown operator '%s' seen" (car expr)))))
|
||||
|
||||
(defun mh-pick-regexp-builder (pattern-list)
|
||||
"Generate pick search expression from PATTERN-LIST."
|
||||
(let ((result ()))
|
||||
(dolist (pattern pattern-list)
|
||||
(when (cdr pattern)
|
||||
(setq result `(,@result "-and" "-lbrace"
|
||||
,@(mh-pick-construct-regexp
|
||||
(cdr pattern) (if (car pattern)
|
||||
(format "-%s" (car pattern))
|
||||
"-search"))
|
||||
"-rbrace"))))
|
||||
(cdr result)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -213,7 +281,9 @@ or nil if no pieces remain."
|
|||
;;; 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-i" mh-index-do-search
|
||||
"\C-c\C-p" mh-pick-do-search
|
||||
"\C-c\C-c" mh-do-search
|
||||
"\C-c\C-f\C-b" mh-to-field
|
||||
"\C-c\C-f\C-c" mh-to-field
|
||||
"\C-c\C-f\C-d" mh-to-field
|
||||
|
|
|
|||
|
|
@ -48,26 +48,27 @@
|
|||
;; -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
|
||||
;; I would really appreciate it if someone would help me with this.
|
||||
;;
|
||||
;; (2) Implement heuristics to recognize message-id's in In-Reply-To:
|
||||
;; header. Right now it just assumes that the last text between angles
|
||||
;; (< and >) is the message-id. There is the chance that this will
|
||||
;; incorrectly use an email address like a message-id.
|
||||
;; (2) Implement heuristics to recognize message identifiers in
|
||||
;; In-Reply-To: header. Right now it just assumes that the last text
|
||||
;; between angles (< and >) is the message identifier. There is the
|
||||
;; chance that this will incorrectly use an email address like a
|
||||
;; message identifier.
|
||||
;;
|
||||
;; (3) Error checking of found message-id's should be done.
|
||||
;; (3) Error checking of found message identifiers should be done.
|
||||
;;
|
||||
;; (4) Since this breaks the assumption that message indices increase as
|
||||
;; one goes down the buffer, the binary search based mh-goto-msg
|
||||
;; doesn't work. I have a simpler replacement which may be less
|
||||
;; efficient.
|
||||
;;
|
||||
;; (5) Better canonicalizing for message-id and subject strings.
|
||||
;; (5) Better canonicalizing for message identifier and subject strings.
|
||||
;;
|
||||
|
||||
;; Internal support for MH-E package.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-seq.el,v 1.10 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-seq.el,v 1.101 2003/01/26 00:57:35 jchonig Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -100,15 +101,15 @@
|
|||
|
||||
;;; Maps and hashes...
|
||||
(defvar mh-thread-id-hash nil
|
||||
"Hashtable used to canonicalize message-id strings.")
|
||||
"Hashtable used to canonicalize message identifiers.")
|
||||
(defvar mh-thread-subject-hash nil
|
||||
"Hashtable used to canonicalize subject strings.")
|
||||
(defvar mh-thread-id-table nil
|
||||
"Thread ID table maps from message-id's to message containers.")
|
||||
"Thread ID table maps from message identifiers to message containers.")
|
||||
(defvar mh-thread-id-index-map nil
|
||||
"Table to lookup message index number from message-id.")
|
||||
"Table to look up message index number from message identifier.")
|
||||
(defvar mh-thread-index-id-map nil
|
||||
"Table to lookup message-id from message index.")
|
||||
"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
|
||||
|
|
@ -117,7 +118,7 @@ This is the original map that is stored when the folder is narrowed.")
|
|||
(defvar mh-thread-subject-container-hash nil
|
||||
"Hashtable used to group messages by subject.")
|
||||
(defvar mh-thread-duplicates nil
|
||||
"Hashtable used to remember multiple messages with the same message-id.")
|
||||
"Hashtable used to associate messages with the same message identifier.")
|
||||
(defvar mh-thread-history ()
|
||||
"Variable to remember the transformations to the thread tree.
|
||||
When new messages are added, these transformations are rewound, then the
|
||||
|
|
@ -141,10 +142,12 @@ redone to get the new thread tree. This makes incremental threading easier.")
|
|||
(defun mh-delete-seq (sequence)
|
||||
"Delete the SEQUENCE."
|
||||
(interactive (list (mh-read-seq-default "Delete" t)))
|
||||
(mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
|
||||
sequence)
|
||||
(mh-undefine-sequence sequence '("all"))
|
||||
(mh-delete-seq-locally sequence))
|
||||
(let ((msg-list (mh-seq-to-msgs sequence)))
|
||||
(mh-undefine-sequence sequence '("all"))
|
||||
(mh-delete-seq-locally sequence)
|
||||
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
|
||||
(when (and (member msg msg-list) (not (mh-seq-containing-msg msg nil)))
|
||||
(mh-notate nil ? (1+ mh-cmd-note))))))
|
||||
|
||||
;; Avoid compiler warnings
|
||||
(defvar view-exit-action)
|
||||
|
|
@ -154,7 +157,7 @@ redone to get the new thread tree. This makes incremental threading easier.")
|
|||
"List the sequences defined in the folder being visited."
|
||||
(interactive)
|
||||
(let ((folder mh-current-folder)
|
||||
(temp-buffer mh-temp-sequences-buffer)
|
||||
(temp-buffer mh-sequences-buffer)
|
||||
(seq-list mh-seq-list)
|
||||
(max-len 0))
|
||||
(with-output-to-temp-buffer temp-buffer
|
||||
|
|
@ -223,7 +226,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
|
|||
(narrow-to-region eob (point-max))
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note)
|
||||
(mh-notate-cur)
|
||||
(when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
|
||||
(make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
|
||||
(setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
|
||||
|
|
@ -246,18 +249,28 @@ If variable `transient-mark-mode' is non-nil and the mark is active, then
|
|||
the selected region is added to the sequence."
|
||||
(interactive (list (cond
|
||||
((mh-mark-active-p t)
|
||||
(mh-region-to-msg-list (region-beginning) (region-end)))
|
||||
(cons (region-beginning) (region-end)))
|
||||
(current-prefix-arg
|
||||
(mh-read-seq-default "Add messages from" t))
|
||||
(t
|
||||
(mh-get-msg-num t)))
|
||||
(cons (line-beginning-position) (line-end-position))))
|
||||
(mh-read-seq-default "Add to" nil)))
|
||||
(if (not (mh-internal-seq sequence))
|
||||
(setq mh-last-seq-used sequence))
|
||||
(mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq))
|
||||
((listp msg-or-seq) msg-or-seq)
|
||||
(t (mh-seq-to-msgs msg-or-seq)))
|
||||
sequence))
|
||||
(let ((internal-seq-flag (mh-internal-seq sequence))
|
||||
msg-list)
|
||||
(cond ((and (consp msg-or-seq)
|
||||
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
|
||||
(mh-iterate-on-messages-in-region m (car msg-or-seq) (cdr msg-or-seq)
|
||||
(push m msg-list)
|
||||
(unless internal-seq-flag
|
||||
(mh-notate nil mh-note-seq (1+ mh-cmd-note))))
|
||||
(mh-add-msgs-to-seq msg-list sequence internal-seq-flag t))
|
||||
((or (numberp msg-or-seq) (listp msg-or-seq))
|
||||
(when (numberp msg-or-seq)
|
||||
(setq msg-or-seq (list msg-or-seq)))
|
||||
(mh-add-msgs-to-seq msg-or-seq sequence internal-seq-flag))
|
||||
(t (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) sequence)))
|
||||
(if (not internal-seq-flag)
|
||||
(setq mh-last-seq-used sequence))))
|
||||
|
||||
(defun mh-valid-view-change-operation-p (op)
|
||||
"Check if the view change operation can be performed.
|
||||
|
|
@ -289,7 +302,7 @@ OP is one of 'widen and 'unthread."
|
|||
(mh-goto-msg msg t t))
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note)
|
||||
(mh-notate-cur)
|
||||
(mh-recenter nil)))
|
||||
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
|
||||
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
|
||||
|
|
@ -301,15 +314,18 @@ OP is one of 'widen and 'unthread."
|
|||
"Notate messages marked for deletion or refiling.
|
||||
Messages to be deleted are given by `mh-delete-list' while messages to be
|
||||
refiled are present in `mh-refile-list'."
|
||||
(mh-mapc #'(lambda (msg) (mh-notate msg mh-note-deleted mh-cmd-note))
|
||||
mh-delete-list)
|
||||
(mh-mapc #'(lambda (dest-msg-list)
|
||||
;; foreach folder name, get the keyed sequence from mh-seq-list
|
||||
(let ((msg-list (cdr dest-msg-list)))
|
||||
(mh-mapc #'(lambda (msg)
|
||||
(mh-notate msg mh-note-refiled mh-cmd-note))
|
||||
msg-list)))
|
||||
mh-refile-list))
|
||||
(let ((refiled-hash (make-hash-table))
|
||||
(deleted-hash (make-hash-table)))
|
||||
(dolist (msg mh-delete-list)
|
||||
(setf (gethash msg deleted-hash) t))
|
||||
(dolist (dest-msg-list mh-refile-list)
|
||||
(dolist (msg (cdr dest-msg-list))
|
||||
(setf (gethash msg refiled-hash) t)))
|
||||
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
|
||||
(cond ((gethash msg refiled-hash)
|
||||
(mh-notate nil mh-note-refiled mh-cmd-note))
|
||||
((gethash msg deleted-hash)
|
||||
(mh-notate nil mh-note-deleted mh-cmd-note))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -380,7 +396,22 @@ passed as arguments to FUNC."
|
|||
"Mark the scan listing.
|
||||
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
|
||||
the line."
|
||||
(mh-map-to-seq-msgs 'mh-notate seq notation offset))
|
||||
(let ((msg-list (mh-seq-to-msgs seq)))
|
||||
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
|
||||
(when (member msg msg-list)
|
||||
(mh-notate nil notation offset)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-notate-cur ()
|
||||
"Mark the MH sequence cur.
|
||||
In addition to notating the current message with `mh-note-cur' the function
|
||||
uses `overlay-arrow-position' to put a marker in the fringe."
|
||||
(let ((cur (car (mh-seq-to-msgs 'cur))))
|
||||
(when (and cur (mh-goto-msg cur t t))
|
||||
(mh-notate nil mh-note-cur mh-cmd-note)
|
||||
(beginning-of-line)
|
||||
(setq mh-arrow-marker (set-marker mh-arrow-marker (point)))
|
||||
(setq overlay-arrow-position mh-arrow-marker))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-add-to-sequence (seq msgs)
|
||||
|
|
@ -448,19 +479,33 @@ LOCATION."
|
|||
(goto-char location)
|
||||
(insert-buffer-substring (current-buffer) beginning-of-line end))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body)
|
||||
"Iterate over region.
|
||||
VAR is bound to the message on the current line as we loop starting from BEGIN
|
||||
till END. In each step BODY is executed.
|
||||
|
||||
If VAR is nil then the loop is executed without any binding."
|
||||
(unless (symbolp var)
|
||||
(error "Can not bind the non-symbol %s" var))
|
||||
(let ((binding-needed-flag var))
|
||||
`(save-excursion
|
||||
(goto-char ,begin)
|
||||
(while (and (<= (point) ,end) (not (eobp)))
|
||||
(when (looking-at mh-scan-valid-regexp)
|
||||
(let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())
|
||||
,@body))
|
||||
(forward-line 1)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-region-to-msg-list (begin end)
|
||||
"Return a list of messages within the region between BEGIN and END."
|
||||
(save-excursion
|
||||
;; If end is end of buffer back up one position
|
||||
(setq end (if (equal end (point-max)) (1- end) end))
|
||||
(goto-char begin)
|
||||
(let ((result ()))
|
||||
(while (<= (point) end)
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(when (numberp index) (push index result)))
|
||||
(forward-line 1))
|
||||
result)))
|
||||
;; If end is end of buffer back up one position
|
||||
(setq end (if (equal end (point-max)) (1- end) end))
|
||||
(let ((result))
|
||||
(mh-iterate-on-messages-in-region index begin end
|
||||
(when (numberp index) (push index result)))
|
||||
result))
|
||||
|
||||
|
||||
|
||||
|
|
@ -877,13 +922,14 @@ table."
|
|||
|
||||
;;; Generate Threads...
|
||||
|
||||
(defvar mh-message-id-regexp "^<.*@.*>$"
|
||||
"Regexp to recognize whether a string is a message identifier.")
|
||||
|
||||
(defun mh-thread-generate (folder msg-list)
|
||||
"Scan FOLDER to get info for threading.
|
||||
Only information about messages in MSG-LIST are added to the tree."
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create "*mh-thread*"))
|
||||
(with-temp-buffer
|
||||
(mh-thread-set-tables folder)
|
||||
(erase-buffer)
|
||||
(when msg-list
|
||||
(apply
|
||||
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
|
||||
|
|
@ -917,7 +963,9 @@ Only information about messages in MSG-LIST are added to the tree."
|
|||
(multiple-value-setq (subject subject-re-p)
|
||||
(mh-thread-prune-subject subject))
|
||||
(setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
|
||||
(setq refs (append (split-string refs) in-reply-to))
|
||||
(setq refs (loop for x in (append (split-string refs) in-reply-to)
|
||||
when (string-match mh-message-id-regexp x)
|
||||
collect x))
|
||||
(setq id (mh-thread-canonicalize-id id))
|
||||
(mh-thread-update-id-index-maps id index)
|
||||
(setq refs (mapcar #'mh-thread-canonicalize-id refs))
|
||||
|
|
@ -963,7 +1011,7 @@ All messages after START-POINT are added to the thread tree."
|
|||
(mh-thread-generate-scan-lines thread-tree -2))
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note)
|
||||
(mh-notate-cur)
|
||||
(set-buffer-modified-p old-buffer-modified-flag))))
|
||||
|
||||
(defvar mh-thread-last-ancestor)
|
||||
|
|
@ -997,20 +1045,19 @@ the message."
|
|||
(while (mh-container-parent mh-thread-last-ancestor)
|
||||
(setq mh-thread-last-ancestor
|
||||
(mh-container-parent mh-thread-last-ancestor))))
|
||||
(insert (car scan-line)
|
||||
(format (format "%%%ss"
|
||||
(if dupl-flag level new-level)) "")
|
||||
(if (and (mh-container-real-child-p tree) dupl-flag
|
||||
(not force-angle-flag))
|
||||
"[" "<")
|
||||
(cadr scan-line)
|
||||
(if (and (mh-container-real-child-p tree) dupl-flag
|
||||
(not force-angle-flag))
|
||||
"]" ">")
|
||||
(truncate-string-to-width
|
||||
(caddr scan-line) (- mh-thread-body-width
|
||||
(if dupl-flag level new-level)))
|
||||
"\n")
|
||||
(let* ((lev (if dupl-flag level new-level))
|
||||
(square-flag (or (and (mh-container-real-child-p tree)
|
||||
(not force-angle-flag)
|
||||
dupl-flag)
|
||||
(equal lev 0))))
|
||||
(insert (car scan-line)
|
||||
(format (format "%%%ss" lev) "")
|
||||
(if square-flag "[" "<")
|
||||
(cadr scan-line)
|
||||
(if square-flag "]" ">")
|
||||
(truncate-string-to-width
|
||||
(caddr scan-line) (- mh-thread-body-width lev))
|
||||
"\n"))
|
||||
(setq increment-level-flag t)
|
||||
(setq dupl-flag nil)))
|
||||
(unless increment-level-flag (setq new-level level))
|
||||
|
|
@ -1057,51 +1104,50 @@ Otherwise uses the line at point as the scan line to parse."
|
|||
(message "Threading %s..." (buffer-name))
|
||||
(mh-thread-initialize)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(when (numberp index)
|
||||
(setf (gethash index mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line))))
|
||||
(forward-line))
|
||||
(let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num))
|
||||
(thread-tree (mh-thread-generate (buffer-name) (list range))))
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
|
||||
(1- mh-scan-field-subject-start-offset)))
|
||||
(mh-thread-last-ancestor nil))
|
||||
(mh-thread-generate-scan-lines thread-tree -2))
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note)
|
||||
(message "Threading %s...done" (buffer-name))))
|
||||
(let ((msg-list ()))
|
||||
(while (not (eobp))
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(when (numberp index)
|
||||
(push index msg-list)
|
||||
(setf (gethash index mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line))))
|
||||
(forward-line))
|
||||
(let* ((range (mh-coalesce-msg-list msg-list))
|
||||
(thread-tree (mh-thread-generate (buffer-name) range)))
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
|
||||
(1- mh-scan-field-subject-start-offset)))
|
||||
(mh-thread-last-ancestor nil))
|
||||
(mh-thread-generate-scan-lines thread-tree -2))
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-cur)
|
||||
(message "Threading %s...done" (buffer-name)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-toggle-threads ()
|
||||
"Toggle threaded view of folder.
|
||||
The conversion of normal view to threaded view is exact, that is the same
|
||||
messages are displayed in the folder buffer before and after threading. However
|
||||
the conversion from threaded view to normal view is inexact. So more messages
|
||||
than were originally present may be shown as a result."
|
||||
"Toggle threaded view of folder."
|
||||
(interactive)
|
||||
(let ((msg-at-point (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil))
|
||||
(cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq)
|
||||
(cond ((memq 'unthread mh-view-ops)
|
||||
(unless (mh-valid-view-change-operation-p 'unthread)
|
||||
(error "Can't unthread folder"))
|
||||
(mh-scan-folder mh-current-folder
|
||||
(format "%s" mh-narrowed-to-seq)
|
||||
t)
|
||||
(let ((msg-list ()))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(let ((index (mh-get-msg-num t)))
|
||||
(when index
|
||||
(push index msg-list)))
|
||||
(forward-line))
|
||||
(mh-scan-folder mh-current-folder
|
||||
(mapcar #'(lambda (x) (format "%s" x))
|
||||
(mh-coalesce-msg-list msg-list))
|
||||
t))
|
||||
(when mh-index-data
|
||||
(mh-index-insert-folder-headers)))
|
||||
((memq 'unthread mh-view-ops)
|
||||
(unless (mh-valid-view-change-operation-p 'unthread)
|
||||
(error "Can't unthread folder"))
|
||||
(mh-scan-folder mh-current-folder
|
||||
(format "%s-%s" mh-first-msg-num mh-last-msg-num)
|
||||
t)
|
||||
(when mh-index-data
|
||||
(mh-index-insert-folder-headers)))
|
||||
(mh-index-insert-folder-headers)
|
||||
(mh-notate-cur)))
|
||||
(t (mh-thread-folder)
|
||||
(push 'unthread mh-view-ops)))
|
||||
(when msg-at-point (mh-goto-msg msg-at-point t t))
|
||||
|
|
@ -1244,28 +1290,23 @@ start of the region and the second is the point at the end."
|
|||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point"))
|
||||
(t (mh-delete-msg
|
||||
(apply #'mh-region-to-msg-list (mh-thread-find-children))))))
|
||||
(t (let ((region (mh-thread-find-children)))
|
||||
(mh-iterate-on-messages-in-region () (car region) (cadr region)
|
||||
(mh-delete-a-msg nil))
|
||||
(mh-next-msg)))))
|
||||
|
||||
;; This doesn't handle mh-default-folder-for-message-function. We should
|
||||
;; refactor that code so that we don't copy it.
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-refile (folder)
|
||||
"Mark current message and all its children for refiling to FOLDER."
|
||||
(interactive (list
|
||||
(intern (mh-prompt-for-folder
|
||||
"Destination"
|
||||
(cond ((eq 'refile (car mh-last-destination-folder))
|
||||
(symbol-name (cdr mh-last-destination-folder)))
|
||||
(t ""))
|
||||
t))))
|
||||
(interactive (list (intern (mh-prompt-for-refile-folder))))
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point"))
|
||||
(t (mh-refile-msg
|
||||
(apply #'mh-region-to-msg-list (mh-thread-find-children))
|
||||
folder))))
|
||||
(t (let ((region (mh-thread-find-children)))
|
||||
(mh-iterate-on-messages-in-region () (car region) (cadr region)
|
||||
(mh-refile-a-msg nil folder))
|
||||
(mh-next-msg)))))
|
||||
|
||||
(provide 'mh-seq)
|
||||
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-speed.el,v 1.2 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-speed.el,v 1.37 2003/01/31 03:18:18 satyaki Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -44,7 +44,6 @@
|
|||
(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)
|
||||
|
|
@ -256,7 +255,7 @@ Do the right thing for the different kinds of buffers that MH-E uses."
|
|||
|
||||
(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)))
|
||||
(let ((folder-list (mh-sub-folders folder)))
|
||||
(mapc
|
||||
(lambda (f)
|
||||
(let* ((folder-name (format "%s%s%s" (or folder "+")
|
||||
|
|
@ -344,58 +343,7 @@ Optional ARGS are ignored."
|
|||
(mh-visit-folder folder range)
|
||||
(delete-other-windows)))))
|
||||
|
||||
(defun mh-speed-folders (folder)
|
||||
"Find the subfolders of FOLDER.
|
||||
The function avoids running folders unnecessarily by caching the results of
|
||||
the actual folders call."
|
||||
(let ((match (gethash folder mh-speed-folders-cache 'no-result)))
|
||||
(cond ((eq match 'no-result)
|
||||
(setf (gethash folder mh-speed-folders-cache)
|
||||
(mh-speed-folders-actual folder)))
|
||||
(t match))))
|
||||
|
||||
(defun mh-speed-folders-actual (folder)
|
||||
"Execute the command folders to return the sub-folders of FOLDER.
|
||||
Filters out the folder names that start with \".\" so that directories that
|
||||
aren't usually mail folders are hidden."
|
||||
(let* ((folder (cond ((and (stringp folder)
|
||||
(equal (substring folder 0 1) "+"))
|
||||
folder)
|
||||
(t nil)))
|
||||
(arg-list `(,(expand-file-name "folders" mh-progs)
|
||||
nil (t nil) nil "-noheader" "-norecurse"
|
||||
,@(if (stringp folder) (list folder) ())))
|
||||
(results ()))
|
||||
(with-temp-buffer
|
||||
(apply #'call-process arg-list)
|
||||
(goto-char (point-min))
|
||||
(while (not (and (eolp) (bolp)))
|
||||
(goto-char (line-end-position))
|
||||
(let ((has-pos (search-backward " has " (line-beginning-position) t)))
|
||||
(when (integerp has-pos)
|
||||
(while (or (equal (char-after has-pos) ? )
|
||||
(equal (char-after has-pos) ?+))
|
||||
(decf has-pos))
|
||||
(incf has-pos)
|
||||
(let ((name (buffer-substring (line-beginning-position) has-pos)))
|
||||
(let ((first-char (substring name 0 1)))
|
||||
(unless (or (string-equal first-char ".")
|
||||
(string-equal first-char "#")
|
||||
(string-equal first-char ","))
|
||||
(push
|
||||
(cons name
|
||||
(search-forward "(others)" (line-end-position) t))
|
||||
results)))))
|
||||
(forward-line 1))))
|
||||
(setq results (nreverse results))
|
||||
(when (stringp folder)
|
||||
(setq results (cdr results))
|
||||
(let ((folder-name-len (length (format "%s/" (substring folder 1)))))
|
||||
(setq results (mapcar (lambda (f)
|
||||
(cons (substring (car f) folder-name-len)
|
||||
(cdr f)))
|
||||
results))))
|
||||
results))
|
||||
(defvar mh-speed-current-folder nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-flists (force)
|
||||
|
|
@ -418,9 +366,17 @@ If FORCE is non-nil the timer is reset."
|
|||
(unless (and (processp mh-speed-flists-process)
|
||||
(not (eq (process-status mh-speed-flists-process)
|
||||
'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))))
|
||||
"+"))
|
||||
(setq mh-speed-flists-process
|
||||
(start-process (expand-file-name "flists" mh-progs) nil
|
||||
"flists" "-recurse"
|
||||
(start-process "*flists*" nil
|
||||
(expand-file-name "flists" mh-progs)
|
||||
"-recurse"
|
||||
"-sequence" (symbol-name mh-unseen-seq)))
|
||||
(set-process-filter mh-speed-flists-process
|
||||
'mh-speed-parse-flists-output)))))))
|
||||
|
|
@ -440,7 +396,7 @@ next."
|
|||
(substring output position line-end))
|
||||
mh-speed-partial-line "")
|
||||
(multiple-value-setq (folder unseen total)
|
||||
(mh-parse-flist-output-line line))
|
||||
(mh-parse-flist-output-line line mh-speed-current-folder))
|
||||
(when (and folder unseen total)
|
||||
(setf (gethash folder mh-speed-flists-cache) (cons unseen total))
|
||||
(save-excursion
|
||||
|
|
@ -489,10 +445,8 @@ next."
|
|||
(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)))
|
||||
(let ((parent-kids (mh-sub-folders parent)))
|
||||
(cond ((null parent-kids)
|
||||
(setq parent-change ?+))
|
||||
((and (null (cdr parent-kids))
|
||||
|
|
@ -517,7 +471,7 @@ next."
|
|||
(setq mh-speed-last-selected-folder nil)
|
||||
(setq mh-speed-refresh-flag t)))
|
||||
(when (equal folder "")
|
||||
(clrhash mh-speed-folders-cache)))))
|
||||
(clrhash mh-sub-folders-cache)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-add-folder (folder)
|
||||
|
|
@ -545,7 +499,6 @@ The function invalidates the latest ancestor that is present."
|
|||
`(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
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-utils.el,v 1.34 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-utils.el,v 1.214 2003/01/27 04:42:23 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -121,7 +121,7 @@ variable `transient-mark-mode' is active."
|
|||
"Regexp to find the number of a message in a scan line.
|
||||
The message's number must be surrounded with \\( \\)")
|
||||
|
||||
(defvar mh-scan-msg-overflow-regexp "^\\?[0-9]"
|
||||
(defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]"
|
||||
"Regexp to find a scan line in which the message number overflowed.
|
||||
The message's number is left truncated in this case.")
|
||||
|
||||
|
|
@ -149,7 +149,7 @@ default, or nil to calculate the default the usual way.
|
|||
NOTE: This variable is not an ordinary hook;
|
||||
It may not be a list of functions.")
|
||||
|
||||
(defvar mh-show-buffer-mode-line-buffer-id "{show-%s} %d"
|
||||
(defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d"
|
||||
"Format string to produce `mode-line-buffer-identification' for show buffers.
|
||||
First argument is folder name. Second is message number.")
|
||||
|
||||
|
|
@ -464,11 +464,6 @@ message about the fontification operation."
|
|||
|
||||
;;; Internal bookkeeping variables:
|
||||
|
||||
;; The value of `mh-folder-list-change-hook' is called whenever
|
||||
;; mh-folder-list variable is set.
|
||||
;; List of folder names for completion.
|
||||
(defvar mh-folder-list nil)
|
||||
|
||||
;; Cached value of the `Path:' component in the user's MH profile.
|
||||
;; User's mail folder directory.
|
||||
(defvar mh-user-path nil)
|
||||
|
|
@ -492,14 +487,20 @@ message about the fontification operation."
|
|||
;; Name of the Inbox folder.
|
||||
(defvar mh-inbox nil)
|
||||
|
||||
;; Name of MH-E scratch buffer.
|
||||
(defconst mh-temp-buffer " *mh-temp*")
|
||||
;; The names of ephemeral buffers have a " *mh-" prefix (so that they are
|
||||
;; hidden and can be programmatically removed in mh-quit), and the variable
|
||||
;; names have the form mh-temp-.*-buffer.
|
||||
(defconst mh-temp-buffer " *mh-temp*") ;scratch
|
||||
|
||||
;; Name of the MH-E folder list buffer.
|
||||
(defconst mh-temp-folders-buffer "*Folders*")
|
||||
|
||||
;; Name of the MH-E sequences list buffer.
|
||||
(defconst mh-temp-sequences-buffer "*Sequences*")
|
||||
;; The names of MH-E buffers that are not ephemeral and can be used by the
|
||||
;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix
|
||||
;; (so they can be programmatically removed in mh-quit), and the variable
|
||||
;; names have the form mh-.*-buffer.
|
||||
(defconst mh-folders-buffer "*MH-E Folders*") ;folder list
|
||||
(defconst mh-info-buffer "*MH-E Info*") ;version information buffer
|
||||
(defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on
|
||||
(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent
|
||||
(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list
|
||||
|
||||
;; Window configuration before MH-E command.
|
||||
(defvar mh-previous-window-config nil)
|
||||
|
|
@ -530,6 +531,19 @@ message about the fontification operation."
|
|||
(defvar mh-show-folder-buffer nil
|
||||
"Keeps track of folder whose message is being displayed.")
|
||||
|
||||
(defvar mh-logo-cache nil)
|
||||
|
||||
(defun mh-logo-display ()
|
||||
"Modify mode line to display MH-E logo."
|
||||
(when (fboundp 'find-image)
|
||||
(add-text-properties
|
||||
0 2
|
||||
`(display ,(or mh-logo-cache
|
||||
(setq mh-logo-cache
|
||||
(find-image '((:type xpm :ascent center
|
||||
:file "mh-logo.xpm"))))))
|
||||
(car mode-line-buffer-identification))))
|
||||
|
||||
;;; This holds a documentation string used by describe-mode.
|
||||
(defun mh-showing-mode (&optional arg)
|
||||
"Change whether messages should be displayed.
|
||||
|
|
@ -1133,22 +1147,25 @@ The message is displayed in raw form."
|
|||
(delete-other-windows)
|
||||
(switch-to-buffer edit-buffer)))
|
||||
|
||||
(defun mh-decode-quoted-printable ()
|
||||
"Run mimedecode on current buffer, replacing its contents."
|
||||
(let ((case-fold-search t))
|
||||
(defun mh-decode-content-transfer-encoded-message ()
|
||||
"Run mimencode on message body, if needed."
|
||||
(let ((case-fold-search t)
|
||||
(header-end (mail-header-end)))
|
||||
(goto-char (point-min))
|
||||
(when (and (re-search-forward
|
||||
"^content-transfer-encoding:[ \t]*quoted-printable"
|
||||
(if mh-decode-mime-flag (mail-header-end) nil) t)
|
||||
(search-forward "\n\n" nil t))
|
||||
(message "Converting quoted-printable characters...")
|
||||
(let ((modified (buffer-modified-p))
|
||||
(command "mimedecode"))
|
||||
(shell-command-on-region (point-min) (point-max) command t t)
|
||||
(if (fboundp 'deactivate-mark)
|
||||
(deactivate-mark))
|
||||
(set-buffer-modified-p modified))
|
||||
(message "Converting quoted-printable characters... done."))))
|
||||
(when (re-search-forward "^content-transfer-encoding: " header-end t)
|
||||
(let ((enc (buffer-substring-no-properties (point) (line-end-position)))
|
||||
cmdline)
|
||||
(setq cmdline
|
||||
(cond ((string-match "base64" enc) (list "-u" "-b" "-p"))
|
||||
((string-match "quoted-printable" enc) (list "-u" "-q"))
|
||||
(t nil)))
|
||||
(when cmdline
|
||||
(beginning-of-line)
|
||||
(insert "Removed-")
|
||||
(setq header-end (mail-header-end))
|
||||
(goto-char (1+ header-end))
|
||||
(apply #'call-process-region (1+ header-end) (point-max) "mimencode"
|
||||
t t nil cmdline))))))
|
||||
|
||||
(defun mh-show-unquote-From ()
|
||||
"Decode >From at beginning of lines for `mh-show-mode'."
|
||||
|
|
@ -1208,9 +1225,9 @@ Sets the current buffer to the show buffer."
|
|||
(if (stringp formfile)
|
||||
(list "-form" formfile))
|
||||
msg-filename)
|
||||
(insert-file-contents msg-filename))
|
||||
(if mh-decode-quoted-printable-flag
|
||||
(mh-decode-quoted-printable))
|
||||
(insert-file-contents-literally msg-filename))
|
||||
(if mh-decode-content-transfer-encoded-message-flag
|
||||
(mh-decode-content-transfer-encoded-message))
|
||||
;; Cleanup old mime handles
|
||||
(mh-mime-cleanup)
|
||||
;; Use mm to display buffer
|
||||
|
|
@ -1248,6 +1265,7 @@ Sets the current buffer to the show buffer."
|
|||
(setq mode-line-buffer-identification
|
||||
(list (format mh-show-buffer-mode-line-buffer-id
|
||||
folder-name msg-num)))
|
||||
(mh-logo-display)
|
||||
(set-buffer folder)
|
||||
(setq mh-showing-with-headers nil))))))
|
||||
|
||||
|
|
@ -1407,12 +1425,7 @@ arguments, after these variable have been set."
|
|||
(setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
|
||||
(if mh-previous-seq
|
||||
(setq mh-previous-seq (intern mh-previous-seq)))
|
||||
(run-hooks 'mh-find-path-hook)))
|
||||
(and mh-auto-folder-collect-flag
|
||||
(let ((mh-no-install t)) ;only get folders if MH installed
|
||||
(condition-case err
|
||||
(mh-make-folder-list-background)
|
||||
(file-error))))) ;so don't complain if not installed
|
||||
(run-hooks 'mh-find-path-hook))))
|
||||
|
||||
(defun mh-file-command-p (file)
|
||||
"Return t if file FILE is the name of a executable regular file."
|
||||
|
|
@ -1537,11 +1550,14 @@ The message number width portion of the format is discovered using
|
|||
(match-beginning 1) (match-end 1))))))
|
||||
width))
|
||||
|
||||
(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
|
||||
(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag dont-annotate-flag)
|
||||
"Add MSGS to SEQ.
|
||||
Remove duplicates and keep sequence sorted. If optional INTERNAL-FLAG is
|
||||
non-nil, do not mark the message in the scan listing or inform MH of the
|
||||
addition."
|
||||
addition.
|
||||
|
||||
If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are
|
||||
not updated."
|
||||
(let ((entry (mh-find-seq seq)))
|
||||
(if (and msgs (atom msgs)) (setq msgs (list msgs)))
|
||||
(if (null entry)
|
||||
|
|
@ -1552,7 +1568,8 @@ addition."
|
|||
(append msgs (mh-seq-msgs entry))))))
|
||||
(cond ((not internal-flag)
|
||||
(mh-add-to-sequence seq msgs)
|
||||
(mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))
|
||||
(unless dont-annotate-flag
|
||||
(mh-notate-seq seq mh-note-seq (1+ mh-cmd-note)))))))
|
||||
|
||||
(defun mh-canonicalize-sequence (msgs)
|
||||
"Sort MSGS in decreasing order and remove duplicates."
|
||||
|
|
@ -1564,19 +1581,193 @@ addition."
|
|||
(setq head (cdr head))))
|
||||
sorted-msgs))
|
||||
|
||||
(defvar mh-sub-folders-cache (make-hash-table :test #'equal))
|
||||
|
||||
(defun mh-normalize-folder-name (folder &optional empty-string-okay
|
||||
dont-remove-trailing-slash)
|
||||
"Normalizes FOLDER name.
|
||||
Makes sure that two '/' characters never occur next to each other. Also all
|
||||
occurrences of \"..\" and \".\" are suitably processed. So \"+inbox/../news\"
|
||||
will be normalized to \"+news\".
|
||||
|
||||
If optional argument EMPTY-STRING-OKAY is nil then a '+' is added at the
|
||||
front if FOLDER lacks one. If non-nil and FOLDER is the empty string then
|
||||
nothing is added.
|
||||
|
||||
If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a trailing '/'
|
||||
if present is retained (if present), otherwise it is removed."
|
||||
(when (stringp folder)
|
||||
;; Replace two or more consecutive '/' characters with a single '/'
|
||||
(while (string-match "//" folder)
|
||||
(setq folder (replace-match "/" nil t folder)))
|
||||
(let* ((length (length folder))
|
||||
(trailing-slash-present (and (> length 0)
|
||||
(equal (aref folder (1- length)) ?/))))
|
||||
(let ((components (split-string folder "/"))
|
||||
(result ()))
|
||||
;; Remove .. and . from the pathname.
|
||||
(dolist (component components)
|
||||
(cond ((and (equal component "..") result)
|
||||
(pop result))
|
||||
((equal component ".."))
|
||||
((equal component "."))
|
||||
(t (push component result))))
|
||||
(setq folder "")
|
||||
(dolist (component result)
|
||||
(setq folder (concat component "/" folder)))
|
||||
;; Remove trailing '/' if needed.
|
||||
(unless (and trailing-slash-present dont-remove-trailing-slash)
|
||||
(when (not (equal folder ""))
|
||||
(setq folder (substring folder 0 (1- (length folder))))))))
|
||||
(cond ((and empty-string-okay (equal folder "")))
|
||||
((equal folder "") (setq folder "+"))
|
||||
((not (equal (aref folder 0) ?+)) (setq folder (concat "+" folder)))))
|
||||
folder)
|
||||
|
||||
(defun mh-sub-folders (folder &optional add-trailing-slash-flag)
|
||||
"Find the subfolders of FOLDER.
|
||||
The function avoids running folders unnecessarily by caching the results of
|
||||
the actual folders call.
|
||||
|
||||
If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a slash is added
|
||||
to each of the sub-folder names that may have nested folders within them."
|
||||
(let* ((folder (mh-normalize-folder-name folder))
|
||||
(match (gethash folder mh-sub-folders-cache 'no-result))
|
||||
(sub-folders (cond ((eq match 'no-result)
|
||||
(setf (gethash folder mh-sub-folders-cache)
|
||||
(mh-sub-folders-actual folder)))
|
||||
(t match))))
|
||||
(if add-trailing-slash-flag
|
||||
(mapcar #'(lambda (x)
|
||||
(if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
|
||||
sub-folders)
|
||||
sub-folders)))
|
||||
|
||||
(defun mh-sub-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 ((arg-list `(,(expand-file-name "folders" mh-progs)
|
||||
nil (t nil) nil "-noheader" "-norecurse" "-nototal"
|
||||
,@(if (stringp folder) (list folder) ())))
|
||||
(results ())
|
||||
(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))))
|
||||
"+")))
|
||||
(with-temp-buffer
|
||||
(apply #'call-process arg-list)
|
||||
(goto-char (point-min))
|
||||
(while (not (and (eolp) (bolp)))
|
||||
(goto-char (line-end-position))
|
||||
(let ((has-pos (search-backward " has " (line-beginning-position) t)))
|
||||
(when (integerp has-pos)
|
||||
(while (equal (char-after has-pos) ? )
|
||||
(decf has-pos))
|
||||
(incf has-pos)
|
||||
(let* ((name (buffer-substring (line-beginning-position) has-pos))
|
||||
(first-char (aref name 0))
|
||||
(last-char (aref name (1- (length name)))))
|
||||
(unless (member first-char '(?. ?# ?,))
|
||||
(when (and (equal last-char ?+) (equal name current-folder))
|
||||
(setq name (substring name 0 (1- (length name)))))
|
||||
(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-remove-from-sub-folders-cache (folder)
|
||||
"Remove FOLDER and its parent from `mh-sub-folders-cache'.
|
||||
FOLDER should be unconditionally removed from the cache. Also the last ancestor
|
||||
of FOLDER present in the cache must be removed as well.
|
||||
|
||||
To see why this is needed assume we have a folder +foo which has a single
|
||||
sub-folder qux. Now we create the folder +foo/bar/baz. Here we will need to
|
||||
invalidate the cached sub-folders of +foo, otherwise completion on +foo won't
|
||||
tell us about the option +foo/bar!"
|
||||
(remhash folder mh-sub-folders-cache)
|
||||
(block ancestor-found
|
||||
(let ((parent folder)
|
||||
(one-ancestor-found nil)
|
||||
last-slash)
|
||||
(while (setq last-slash (mh-search-from-end ?/ parent))
|
||||
(setq parent (substring parent 0 last-slash))
|
||||
(unless (eq (gethash parent mh-sub-folders-cache 'none) 'none)
|
||||
(remhash parent mh-sub-folders-cache)
|
||||
(if one-ancestor-found
|
||||
(return-from ancestor-found)
|
||||
(setq one-ancestor-found t))))
|
||||
(remhash nil mh-sub-folders-cache))))
|
||||
|
||||
(defvar mh-folder-hist nil)
|
||||
(defvar mh-speed-folder-map)
|
||||
(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map))
|
||||
(define-key mh-folder-completion-map " " 'minibuffer-complete)
|
||||
|
||||
(defun mh-folder-completion-function (name predicate flag)
|
||||
"Programmable completion for folder names.
|
||||
NAME is the partial folder name that has been input. PREDICATE if non-nil is a
|
||||
function that is used to filter the possible choices and FLAG determines
|
||||
whether the completion is over."
|
||||
(let* ((orig-name name)
|
||||
(name (mh-normalize-folder-name name nil t))
|
||||
(last-slash (mh-search-from-end ?/ name))
|
||||
(last-complete (if last-slash (substring name 0 last-slash) nil))
|
||||
(remainder (cond (last-complete (substring name (1+ last-slash)))
|
||||
((and (> (length name) 0) (equal (aref name 0) ?+))
|
||||
(substring name 1))
|
||||
(t ""))))
|
||||
(cond ((eq flag nil)
|
||||
(let ((try-res (try-completion
|
||||
name
|
||||
(mapcar (lambda (x)
|
||||
(cons (if (not last-complete)
|
||||
(concat "+" (car x))
|
||||
(concat last-complete "/" (car x)))
|
||||
(cdr x)))
|
||||
(mh-sub-folders last-complete t))
|
||||
predicate)))
|
||||
(cond ((eq try-res nil) nil)
|
||||
((and (eq try-res t) (equal name orig-name)) t)
|
||||
((eq try-res t) name)
|
||||
(t try-res))))
|
||||
((eq flag t)
|
||||
(all-completions
|
||||
remainder (mh-sub-folders last-complete t) predicate))
|
||||
((eq flag 'lambda)
|
||||
(file-exists-p
|
||||
(concat mh-user-path
|
||||
(substring (mh-normalize-folder-name name) 1)))))))
|
||||
|
||||
(defun mh-folder-completing-read (prompt default)
|
||||
"Read folder name with PROMPT and default result DEFAULT."
|
||||
(mh-normalize-folder-name
|
||||
(let ((minibuffer-local-completion-map mh-folder-completion-map))
|
||||
(completing-read prompt 'mh-folder-completion-function nil nil nil
|
||||
'mh-folder-hist default))
|
||||
t))
|
||||
|
||||
(defun mh-prompt-for-folder (prompt default can-create
|
||||
&optional default-string)
|
||||
&optional default-string allow-root-folder-flag)
|
||||
"Prompt for a folder name with PROMPT.
|
||||
Returns the folder's name as a string. DEFAULT is used if the folder exists
|
||||
and the user types return. If the CAN-CREATE flag is t, then a folder is
|
||||
created if it doesn't already exist. If optional argument DEFAULT-STRING is
|
||||
non-nil, use it in the prompt instead of DEFAULT.
|
||||
The value of `mh-folder-list-change-hook' is a list of functions to be called,
|
||||
with no arguments, whenever the cached folder list `mh-folder-list' is
|
||||
changed."
|
||||
non-nil, use it in the prompt instead of DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is
|
||||
non-nil then the function will accept the folder +, which means all folders
|
||||
when used in searching."
|
||||
(if (null default)
|
||||
(setq default ""))
|
||||
(let* ((default-string (cond (default-string (format " [%s]? "
|
||||
|
|
@ -1585,13 +1776,11 @@ changed."
|
|||
(t (format " [%s]? " default))))
|
||||
(prompt (format "%s folder%s" prompt default-string))
|
||||
read-name folder-name)
|
||||
(if (null mh-folder-list)
|
||||
(mh-set-folder-list))
|
||||
(while (and (setq read-name (completing-read prompt mh-folder-list nil nil
|
||||
"+" 'mh-folder-hist))
|
||||
(while (and (setq read-name (mh-folder-completing-read prompt default))
|
||||
(equal read-name "")
|
||||
(equal default "")))
|
||||
(cond ((or (equal read-name "") (equal read-name "+"))
|
||||
(cond ((or (equal read-name "")
|
||||
(and (equal read-name "+") (not allow-root-folder-flag)))
|
||||
(setq read-name default))
|
||||
((not (mh-folder-name-p read-name))
|
||||
(setq read-name (format "+%s" read-name))))
|
||||
|
|
@ -1609,101 +1798,17 @@ changed."
|
|||
folder-name)))
|
||||
(message "Creating %s" folder-name)
|
||||
(mh-exec-cmd-error nil "folder" folder-name)
|
||||
(mh-remove-from-sub-folders-cache folder-name)
|
||||
(when (boundp 'mh-speed-folder-map)
|
||||
(mh-speed-add-folder folder-name))
|
||||
(message "Creating %s...done" folder-name)
|
||||
(setq mh-folder-list (cons (list read-name) mh-folder-list))
|
||||
(run-hooks 'mh-folder-list-change-hook))
|
||||
(message "Creating %s...done" folder-name))
|
||||
(new-file-flag
|
||||
(error "Folder %s is not created" folder-name))
|
||||
((not (file-directory-p (mh-expand-file-name folder-name)))
|
||||
(error "\"%s\" is not a directory"
|
||||
(mh-expand-file-name folder-name)))
|
||||
((and (null (assoc read-name mh-folder-list))
|
||||
(null (assoc (concat read-name "/") mh-folder-list)))
|
||||
(setq mh-folder-list (cons (list read-name) mh-folder-list))
|
||||
(run-hooks 'mh-folder-list-change-hook))))
|
||||
(mh-expand-file-name folder-name)))))
|
||||
folder-name))
|
||||
|
||||
(defvar mh-make-folder-list-process nil) ;The background process collecting
|
||||
;the folder list.
|
||||
|
||||
(defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built.
|
||||
|
||||
(defvar mh-folder-list-partial-line "") ;Start of last incomplete line from
|
||||
;folder process.
|
||||
|
||||
(defun mh-set-folder-list ()
|
||||
"Set `mh-folder-list' correctly.
|
||||
A useful function for the command line or for when you need to
|
||||
sync by hand. Format is in a form suitable for completing read.
|
||||
The value of `mh-folder-list-change-hook' is a list of functions to be called,
|
||||
with no arguments, once the list of folders has been created."
|
||||
(message "Collecting folder names...")
|
||||
(if (not mh-make-folder-list-process)
|
||||
(mh-make-folder-list-background))
|
||||
(while (eq (process-status mh-make-folder-list-process) 'run)
|
||||
(accept-process-output mh-make-folder-list-process))
|
||||
(setq mh-folder-list mh-folder-list-temp)
|
||||
(run-hooks 'mh-folder-list-change-hook)
|
||||
(setq mh-folder-list-temp nil)
|
||||
(delete-process mh-make-folder-list-process)
|
||||
(setq mh-make-folder-list-process nil)
|
||||
(message "Collecting folder names...done"))
|
||||
|
||||
(defun mh-make-folder-list-background ()
|
||||
"Start a background process to compute a list of the user's folders.
|
||||
Call `mh-set-folder-list' to wait for the result."
|
||||
(cond
|
||||
((not mh-make-folder-list-process)
|
||||
(unless mh-inbox
|
||||
(mh-find-path))
|
||||
(let ((process-connection-type nil))
|
||||
(setq mh-make-folder-list-process
|
||||
(start-process "folders" nil (expand-file-name "folders" mh-progs)
|
||||
"-fast"
|
||||
(if mh-recursive-folders-flag
|
||||
"-recurse"
|
||||
"-norecurse")))
|
||||
(set-process-filter mh-make-folder-list-process
|
||||
'mh-make-folder-list-filter)
|
||||
(process-kill-without-query mh-make-folder-list-process)))))
|
||||
|
||||
(defun mh-make-folder-list-filter (process output)
|
||||
"Given the PROCESS \"folders -fast\", parse OUTPUT.
|
||||
See also `set-process-filter'."
|
||||
(let ((position 0)
|
||||
line-end
|
||||
new-folder
|
||||
(prevailing-match-data (match-data)))
|
||||
(unwind-protect
|
||||
;; make sure got complete line
|
||||
(while (setq line-end (string-match "\n" output position))
|
||||
(setq new-folder (format "+%s%s"
|
||||
mh-folder-list-partial-line
|
||||
(substring output position line-end)))
|
||||
(setq mh-folder-list-partial-line "")
|
||||
;; is new folder a subfolder of previous?
|
||||
(if (and mh-folder-list-temp
|
||||
(string-match
|
||||
(regexp-quote
|
||||
(concat (car (car mh-folder-list-temp)) "/"))
|
||||
new-folder))
|
||||
;; append slash to parent folder for better completion
|
||||
;; (undone by mh-prompt-for-folder)
|
||||
(setq mh-folder-list-temp
|
||||
(cons
|
||||
(list new-folder)
|
||||
(cons
|
||||
(list (concat (car (car mh-folder-list-temp)) "/"))
|
||||
(cdr mh-folder-list-temp))))
|
||||
(setq mh-folder-list-temp
|
||||
(cons (list new-folder)
|
||||
mh-folder-list-temp)))
|
||||
(setq position (1+ line-end)))
|
||||
(set-match-data prevailing-match-data))
|
||||
(setq mh-folder-list-partial-line (substring output position))))
|
||||
|
||||
;;; Issue commands to MH.
|
||||
|
||||
(defun mh-exec-cmd (command &rest args)
|
||||
|
|
@ -1712,14 +1817,14 @@ The side effects are what is desired.
|
|||
Any output is assumed to be an error and is shown to the user.
|
||||
The output is not read or parsed by MH-E."
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(set-buffer (get-buffer-create mh-log-buffer))
|
||||
(erase-buffer)
|
||||
(apply 'call-process
|
||||
(expand-file-name command mh-progs) nil t nil
|
||||
(mh-list-to-string args))
|
||||
(if (> (buffer-size) 0)
|
||||
(save-window-excursion
|
||||
(switch-to-buffer-other-window mh-temp-buffer)
|
||||
(switch-to-buffer-other-window mh-log-buffer)
|
||||
(sit-for 5)))))
|
||||
|
||||
(defun mh-exec-cmd-error (env command &rest args)
|
||||
|
|
@ -1743,24 +1848,30 @@ Signals an error if process does not complete successfully."
|
|||
(mh-list-to-string args)))))
|
||||
(mh-handle-process-error command status))))
|
||||
|
||||
(defun mh-exec-cmd-daemon (command &rest args)
|
||||
"Execute MH command COMMAND with ARGS in the background.
|
||||
Any output from command is displayed in an asynchronous pop-up window."
|
||||
(defun mh-exec-cmd-daemon (command filter &rest args)
|
||||
"Execute MH command COMMAND in the background.
|
||||
|
||||
If FILTER is non-nil then it is used to process the output otherwise the
|
||||
default filter `mh-process-daemon' is used. See `set-process-filter' for more
|
||||
details of FILTER.
|
||||
|
||||
ARGS are passed to COMMAND as command line arguments."
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(set-buffer (get-buffer-create mh-log-buffer))
|
||||
(erase-buffer))
|
||||
(let* ((process-connection-type nil)
|
||||
(process (apply 'start-process
|
||||
command nil
|
||||
(expand-file-name command mh-progs)
|
||||
(mh-list-to-string args))))
|
||||
(set-process-filter process 'mh-process-daemon)))
|
||||
(set-process-filter process (or filter 'mh-process-daemon))))
|
||||
|
||||
(defun mh-process-daemon (process output)
|
||||
"PROCESS daemon that puts OUTPUT into a temporary buffer."
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
"PROCESS daemon that puts OUTPUT into a temporary buffer.
|
||||
Any output from the process is displayed in an asynchronous pop-up window."
|
||||
(set-buffer (get-buffer-create mh-log-buffer))
|
||||
(insert-before-markers output)
|
||||
(display-buffer mh-temp-buffer))
|
||||
(display-buffer mh-log-buffer))
|
||||
|
||||
(defun mh-exec-cmd-quiet (raise-error command &rest args)
|
||||
"Signal RAISE-ERROR if COMMAND with ARGS fails.
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-xemacs-compat.el,v 1.3 2003/01/08 23:21:16 wohler Exp $
|
||||
;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
|
|||
22
lisp/toolbar/mh-logo.xpm
Normal file
22
lisp/toolbar/mh-logo.xpm
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
/* XPM */
|
||||
static char *mh-e[] = {
|
||||
/* width height num_colors chars_per_pixel */
|
||||
" 18 13 2 1",
|
||||
/* colors */
|
||||
"# c #666699",
|
||||
". c None s None",
|
||||
/* pixels */
|
||||
"........##........",
|
||||
".......####.......",
|
||||
"......######......",
|
||||
"......######......",
|
||||
"....#########.....",
|
||||
"..##############..",
|
||||
".##...######....#.",
|
||||
"##...#.#.####...#.",
|
||||
"....#..#.##.#...#.",
|
||||
"...#..##.#.#.#....",
|
||||
"...#..#..#..#.#...",
|
||||
"...#..#.##..#.##..",
|
||||
"...#..#.#..#....#."
|
||||
};
|
||||
Loading…
Add table
Reference in a new issue