Upgraded to MH-E version 7.1.
This commit is contained in:
Bill Wohler
parent
21bd170dde
commit
c3d9274aea
20 changed files with 6734 additions and 4333 deletions
|
|
@ -1,3 +1,7 @@
|
|||
2003-01-08 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* MH-E-NEWS: Upgraded to MH-E version 7.1.
|
||||
|
||||
2003-01-01 Steven Tamm <steventamm@mac.com>
|
||||
|
||||
* MACHINES: Added pointer to Mac OS X install instructions.
|
||||
|
|
|
|||
208
etc/MH-E-NEWS
208
etc/MH-E-NEWS
|
|
@ -1,3 +1,209 @@
|
|||
* Changes in mh-e 7.1
|
||||
|
||||
This release includes the new features of multiple identities and
|
||||
alias completion. In addition, indexed searching has been revamped.
|
||||
Various other features have been added and a few bugs were fixed.
|
||||
|
||||
** New Features in MH-E 7.1
|
||||
|
||||
*** Multiple Identities
|
||||
|
||||
MH-E now supports multiple identities (closes SF #628782). That means
|
||||
that you can have different From and Organization header fields (or
|
||||
any other header field of your choice) as well as different signatures
|
||||
depending on your context. Usually, the contexts are home and work.
|
||||
|
||||
Add your identities to the variable `mh-identity-list' and set the
|
||||
default identity with the variable `mh-identity-default'. Your
|
||||
identity can be switched on the fly by using the Identity menu or by
|
||||
calling "M-x mh-insert-identity RET".
|
||||
|
||||
This functionality can be customized within the mh-identity group.
|
||||
|
||||
*** Alias Completion and Harvesting
|
||||
|
||||
The contributed file mh-alias.el has been rewritten and incorporated
|
||||
into MH-E.
|
||||
|
||||
By default, aliases are culled from the system files
|
||||
"/etc/nmh/MailAliases," "/usr/lib/mh/MailAliases," and "/etc/passwd"
|
||||
(see `mh-alias-system-aliases') and from your "AliasFile" MH profile
|
||||
component. These aliases are then used for completion in the
|
||||
minibuffer when entering addresses. Within the header of the message
|
||||
draft, "M-TAB (mh-letter-complete)" is used to do alias completion.
|
||||
|
||||
The package also provides for alias creation based upon the From
|
||||
header field of the current message. Use the lasso button
|
||||
(mh-alias-grab-from-field).
|
||||
|
||||
This functionality can be customized within the mh-alias group.
|
||||
|
||||
*** Index Folder Updates
|
||||
|
||||
The results of an index search "F i (mh-index-search)" are now stored
|
||||
in a bona fide folder so that you can refile messages and reply to
|
||||
messages directly from the result folder. This folder is a sub-folder
|
||||
of +mhe-index and the name is based upon the search string (closes SF
|
||||
#623321).
|
||||
|
||||
If a prefix argument is given then the search in the current index
|
||||
buffer is redone.
|
||||
|
||||
The index folder lists the names of the source folders as before.
|
||||
However, instead of using RET on the name of the folder to visit the
|
||||
folder, use "v (mh-show-index-visit-folder)" anywhere within the
|
||||
results to visit that folder narrowed to the results of the search.
|
||||
Additional functions have been added to navigate including "TAB
|
||||
(mh-index-next-folder)", and "SHIFT-TAB (mh-index-previous-folder)."
|
||||
|
||||
*** mh-visit-folder Interface Updated
|
||||
|
||||
A change was made to the prompting of the message range. In general,
|
||||
you can use the same format for messages and sequences as you can in
|
||||
MH with a single exception: a single number means to scan that many
|
||||
messages, rather than scan that message number. This turns out to be
|
||||
much more useful than visiting a single message and is consistent with
|
||||
Gnus and the MH-E speedbar (closes SF #655891).
|
||||
|
||||
If mh-visit-folder is called non-interactively and RANGE is nil then
|
||||
all messages are displayed. This behavior is now documented and
|
||||
provides backwards compatibility.
|
||||
|
||||
*** Threading Improvements
|
||||
|
||||
After incorporating new mail into a threaded folder, unseen messages
|
||||
can be spread about. Two new functions have been added to make it
|
||||
easier to find them: these are "M-n (mh-next-unread-msg)" and "M-p
|
||||
(mh-previous-unread-msg)" (closes SF #630328)
|
||||
|
||||
Two new functions were added to delete and refile threads. They are "T
|
||||
d (mh-thread-delete)" and "T o (mh-thread-refile)" respectively
|
||||
(closes SF #630493).
|
||||
|
||||
In addition, the key "k" used to be bound to the function
|
||||
`mh-delete-subject': it is now bound to
|
||||
`mh-show-delete-subject-or-thread'.
|
||||
|
||||
New functions to navigate threads include "T u (mh-thread-ancestor)",
|
||||
which can jump to the root message of the current thread given an
|
||||
optional argument, "T n (mh-thread-next-sibling)", and "T p
|
||||
(mh-thread-previous-sibling)"
|
||||
|
||||
*** Refiling of Messages in Region
|
||||
|
||||
If mark is active and `transient-mark-mode' is enabled then all the
|
||||
messages in the region are refiled.
|
||||
|
||||
*** vCard Handling
|
||||
|
||||
If a signature cannot be identified, but there is a vCard attachment,
|
||||
then that vCard will be presented as a signature (closes SF #649216).
|
||||
|
||||
*** New Info Added to mh-version
|
||||
|
||||
Information about Gnus versions available at both compile time and run
|
||||
time has been added.
|
||||
|
||||
** New Variables in MH-E 7.1
|
||||
|
||||
The defcustom groups were reorganized. Rather than iterate the
|
||||
specific changes here, you are invited to browse the groups with "M-x
|
||||
mh-customize RET".
|
||||
|
||||
*** mh-alias-completion-ignore-case-flag
|
||||
|
||||
Non-nil means don't consider case significant in MH alias completion.
|
||||
This is the default in plain MH, so it is the default here as well. It
|
||||
can be useful to set this to t if, for example, you use lowercase
|
||||
aliases for people and uppercase for mailing lists.
|
||||
|
||||
*** mh-alias-expand-aliases-flag
|
||||
|
||||
Non-nil means to expand aliases entered in the minibuffer. In other
|
||||
words, aliases entered in the minibuffer will be expanded to the full
|
||||
address in the message draft. By default, this expansion is not
|
||||
performed.
|
||||
|
||||
*** mh-alias-flash-on-comma
|
||||
|
||||
Specify whether to flash the translation of the alias or warn if there
|
||||
isn't a translation of the alias.
|
||||
|
||||
*** mh-alias-insert-file
|
||||
|
||||
Filename to use to store new MH-E aliases. This variable can also be a
|
||||
list of filenames, in which case MH-E will prompt for one of them. If
|
||||
nil, the default, then MH-E will use the first file found in the
|
||||
"AliasFile" component of the MH profile.
|
||||
|
||||
*** mh-alias-insertion-location
|
||||
|
||||
Specifies where new aliases are entered in alias files. Options are
|
||||
sorted alphabetically (the default), at the top of the file or at the
|
||||
bottom.
|
||||
|
||||
*** mh-alias-local-users
|
||||
|
||||
If t, local users are completed in MH-E To: and Cc: prompts.
|
||||
|
||||
If you set this variable to a string, it will be executed to generate
|
||||
a password file. A value of "ypcat passwd" is helpful if NIS is in
|
||||
use.
|
||||
|
||||
*** mh-alias-system-aliases
|
||||
|
||||
A list of system files from which to cull aliases. If these files are
|
||||
modified, they are automatically reread. This list need include only
|
||||
system aliases and the passwd file, since personal alias files listed
|
||||
in your "AliasFile" MH profile component are automatically included.
|
||||
|
||||
*** mh-identity-default
|
||||
|
||||
Default identity to use when `mh-letter-mode' is called.
|
||||
|
||||
*** mh-identity-list
|
||||
|
||||
List holding MH-E identity.
|
||||
|
||||
*** mh-invisible-header-fields
|
||||
|
||||
Simple user interface to change `mh-invisible-headers'.
|
||||
|
||||
*** mh-letter-complete-function
|
||||
|
||||
Function to call when completing outside of fields specific to
|
||||
aliases. By default, it is bound to 'ispell-complete-word.
|
||||
|
||||
*** mh-show-threads-flag
|
||||
|
||||
Non-nil means new folders start in threaded mode. Threading large
|
||||
number of messages can be time consuming. So if the flag is non-nil
|
||||
then threading will be done only if the number of messages being
|
||||
threaded is less than `mh-large-folder' (closes SF #646794).
|
||||
|
||||
*** mh-tool-bar-folder-buttons
|
||||
|
||||
Buttons to include in MH-E folder/show toolbar.
|
||||
|
||||
*** mh-tool-bar-letter-buttons
|
||||
|
||||
Buttons to include in MH-E letter toolbar.
|
||||
|
||||
** Bug Fixes in MH-E 7.1
|
||||
|
||||
*** mh-get-new-mail
|
||||
|
||||
Call new function `mh-add-cur-notation' to undo the work of
|
||||
`mh-remove-cur-notation' if there was no new mail (closes SF #647681).
|
||||
|
||||
*** mh-set-cmd-note
|
||||
|
||||
No longer updates the default `mh-cmd-note' value. This resulted in
|
||||
the misplacement of the current mark when the message number width
|
||||
changed (closes SF #643701).
|
||||
|
||||
|
||||
|
||||
* Changes in mh-e 7.0
|
||||
|
||||
This is a major release which includes a lot of new features including
|
||||
|
|
@ -62,7 +268,7 @@ You can now use the MH-Folder mode commands from the MH-Show buffer.
|
|||
Because of this, the MH-Show buffer is now read-only (closes SF
|
||||
#493749 and SF #527946) and you now have to use "M (mh-modify)" to
|
||||
edit a message.
|
||||
|
||||
|
||||
*** Better Scanning
|
||||
|
||||
You no longer have to modify your scan format if your folders have
|
||||
|
|
|
|||
2
etc/NEWS
2
etc/NEWS
|
|
@ -90,7 +90,7 @@ You can now put the init files .emacs and .emacs_SHELL under
|
|||
|
||||
** MH-E changes.
|
||||
|
||||
Upgraded to mh-e version 7.0. There have been major changes since
|
||||
Upgraded to MH-E version 7.1. There have been major changes since
|
||||
version 5.0.2; see MH-E-NEWS for details.
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -1,3 +1,13 @@
|
|||
2003-01-08 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* mail/mh-alias.el, mail/mh-customize.el, mail/mh-identity.el,
|
||||
mail/mh-loaddefs.el, toolbar/alias.pbm, toolbar/alias.xpm: Added.
|
||||
|
||||
* mail/mh-comp.el, mail/mh-e.el, mail/mh-funcs.el,
|
||||
mail/mh-index.el, mail/mh-mime.el, mail/mh-pick.el,
|
||||
mail/mh-seq.el, mail/mh-speed.el, mail/mh-utils.el,
|
||||
mail/mh-xemacs-compat.el: Upgraded to MH-E version 7.1.
|
||||
|
||||
2003-01-08 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* mail/undigest.el (unforward-rmail-message): Don't use global
|
||||
|
|
|
|||
590
lisp/mail/mh-alias.el
Normal file
590
lisp/mail/mh-alias.el
Normal file
|
|
@ -0,0 +1,590 @@
|
|||
;;; mh-alias.el --- MH-E mail alias completion and expansion
|
||||
;;
|
||||
;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Peter S. Galbraith <psg@debian.org>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; [To be deleted when documented in MH-E manual.]
|
||||
;;
|
||||
;; This module provides mail alias completion when entering addresses.
|
||||
;;
|
||||
;; Use the TAB key to complete aliases (and optionally local usernames) when
|
||||
;; initially composing a message in the To: and Cc: minibuffer prompts. You
|
||||
;; may enter multiple addressees separated with a comma (but do *not* add any
|
||||
;; space after the comma).
|
||||
;;
|
||||
;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
|
||||
;; complete aliases. This is useful when you want to add an addressee as an
|
||||
;; afterthought when creating a message, or when adding an additional
|
||||
;; addressee to a reply.
|
||||
;;
|
||||
;; By default, completion is case-insensitive. This can be changed by
|
||||
;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
|
||||
;; useful, for example, to differentiate between people aliases in lowercase
|
||||
;; such as:
|
||||
;;
|
||||
;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
|
||||
;;
|
||||
;; and lists in uppercase such as:
|
||||
;;
|
||||
;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
|
||||
;;
|
||||
;; Note that this variable affects minibuffer completion only. If you have an
|
||||
;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
|
||||
;; be expanded in the letter buffer because MH is case-insensitive.
|
||||
;;
|
||||
;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
|
||||
;; the minibuffer, the expansion for the previous mail alias appears briefly.
|
||||
;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
|
||||
;;
|
||||
;; The addresses and aliases entered in the minibuffer are added to the
|
||||
;; message draft. To expand the aliases before they are added to the draft,
|
||||
;; customize the variable `mh-alias-expand-aliases-flag'.
|
||||
;;
|
||||
;; Completion is also performed on usernames extracted from the /etc/passwd
|
||||
;; file. This can be a handy tool on a machine where you and co-workers
|
||||
;; exchange messages, but should probably be disabled on a system with
|
||||
;; thousands of users you don't know. This is done by customizing the
|
||||
;; variable `mh-alias-local-users'. This variable also takes a string which
|
||||
;; is executed to generate the password file. For example, you'd use "ypcat
|
||||
;; passwd" for NIS.
|
||||
;;
|
||||
;; Aliases are loaded the first time you send mail and get the "To:" prompt
|
||||
;; and whenever a source of aliases changes. Sources of system aliases are
|
||||
;; defined in the customization variable `mh-alias-system-aliases' and
|
||||
;; include:
|
||||
;;
|
||||
;; /etc/nmh/MailAliases
|
||||
;; /usr/lib/mh/MailAliases
|
||||
;; /etc/passwd
|
||||
;;
|
||||
;; Sources of personal aliases are read from the files listed in your MH
|
||||
;; profile component Aliasfile. Multiple files are separated by white space
|
||||
;; and are relative to your mail directory.
|
||||
;;
|
||||
;; Alias Insertions
|
||||
;; ~~~~~~~~~~~~~~~~
|
||||
;; There are commands to insert new aliases into your alias file(s) (defined
|
||||
;; by the `Aliasfile' component in the .mh_profile file or by the variable
|
||||
;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
|
||||
;; an alias from the From line of the current message.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
(load "cmr" t t) ; Non-fatal dependency for
|
||||
; completing-read-multiple.
|
||||
(eval-when-compile (defvar mail-abbrev-syntax-table))
|
||||
|
||||
;;; Autoloads
|
||||
(autoload 'mail-abbrev-complete-alias "mailabbrev")
|
||||
(autoload 'multi-prompt "multi-prompt")
|
||||
|
||||
(defvar mh-alias-alist nil
|
||||
"Alist of MH aliases.")
|
||||
(defvar mh-alias-blind-alist nil
|
||||
"Alist of MH aliases that are blind lists.")
|
||||
(defvar mh-alias-passwd-alist nil
|
||||
"Alist of aliases extracted from passwd file and their expansions.")
|
||||
(defvar mh-alias-tstamp nil
|
||||
"Time aliases were last loaded.")
|
||||
(defvar mh-alias-read-address-map nil)
|
||||
(if mh-alias-read-address-map
|
||||
()
|
||||
(setq mh-alias-read-address-map
|
||||
(copy-keymap minibuffer-local-completion-map))
|
||||
(if mh-alias-flash-on-comma
|
||||
(define-key mh-alias-read-address-map
|
||||
"," 'mh-alias-minibuffer-confirm-address))
|
||||
(define-key mh-alias-read-address-map " " 'self-insert-command))
|
||||
|
||||
|
||||
;;; Alias Loading
|
||||
|
||||
(defun mh-alias-tstamp (arg)
|
||||
"Check whether alias files have been modified.
|
||||
Return t if any file listed in the MH profile component Aliasfile has been
|
||||
modified since the timestamp.
|
||||
If ARG is non-nil, set timestamp with the current time."
|
||||
(if arg
|
||||
(let ((time (current-time)))
|
||||
(setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
|
||||
(let ((stamp))
|
||||
(car (memq t (mapcar
|
||||
(function
|
||||
(lambda (file)
|
||||
(when (and file (file-exists-p file))
|
||||
(setq stamp (nth 5 (file-attributes file)))
|
||||
(or (> (car stamp) (car mh-alias-tstamp))
|
||||
(and (= (car stamp) (car mh-alias-tstamp))
|
||||
(> (cadr stamp) (cadr mh-alias-tstamp)))))))
|
||||
(mh-alias-filenames t)))))))
|
||||
|
||||
(defun mh-alias-filenames (arg)
|
||||
"Return list of filenames that contain aliases.
|
||||
The filenames come from the MH profile component Aliasfile and are expanded.
|
||||
If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
|
||||
(or mh-progs (mh-find-path))
|
||||
(save-excursion
|
||||
(let* ((filename (mh-profile-component "Aliasfile"))
|
||||
(filelist (and filename (split-string filename "[ \t]+")))
|
||||
(userlist
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (file)
|
||||
(if (and mh-user-path file
|
||||
(file-exists-p (expand-file-name file mh-user-path)))
|
||||
(expand-file-name file mh-user-path))))
|
||||
filelist)))
|
||||
(if arg
|
||||
(if (stringp mh-alias-system-aliases)
|
||||
(append userlist (list mh-alias-system-aliases))
|
||||
(append userlist mh-alias-system-aliases))
|
||||
userlist))))
|
||||
|
||||
(defun mh-alias-local-users ()
|
||||
"Return an alist of local users from /etc/passwd."
|
||||
(let (passwd-alist)
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
(cond
|
||||
((eq mh-alias-local-users t)
|
||||
(if (file-readable-p "/etc/passwd")
|
||||
(insert-file-contents "/etc/passwd")))
|
||||
((stringp mh-alias-local-users)
|
||||
(insert mh-alias-local-users "\n")
|
||||
(shell-command-on-region (point-min)(point-max) mh-alias-local-users t)
|
||||
(goto-char (point-min))))
|
||||
(while (< (point) (point-max))
|
||||
(cond
|
||||
((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]")
|
||||
(when (> (string-to-int (match-string 2)) 200)
|
||||
(let* ((username (match-string 1))
|
||||
(gecos-name (match-string 3))
|
||||
(realname
|
||||
(if (string-match "&" gecos-name)
|
||||
(concat
|
||||
(substring gecos-name 0 (match-beginning 0))
|
||||
(capitalize username)
|
||||
(substring gecos-name (match-end 0)))
|
||||
gecos-name)))
|
||||
(setq passwd-alist
|
||||
(cons (list username
|
||||
(if (string-equal "" realname)
|
||||
(concat "<" username ">")
|
||||
(concat realname " <" username ">")))
|
||||
passwd-alist))))))
|
||||
(forward-line 1)))
|
||||
passwd-alist))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-reload ()
|
||||
"Load MH aliases into `mh-alias-alist'."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(message "Loading MH aliases...")
|
||||
(mh-alias-tstamp t)
|
||||
(mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
|
||||
(setq mh-alias-alist nil)
|
||||
(setq mh-alias-blind-alist nil)
|
||||
(while (< (point) (point-max))
|
||||
(cond
|
||||
((looking-at "^[ \t]")) ;Continuation line
|
||||
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
|
||||
(when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist))
|
||||
(setq mh-alias-blind-alist
|
||||
(cons (list (match-string 1)) mh-alias-blind-alist))
|
||||
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
|
||||
((looking-at "\\(.+\\): .*$") ; A new MH alias
|
||||
(when (not (assoc-ignore-case (match-string 1) mh-alias-alist))
|
||||
(setq mh-alias-alist
|
||||
(cons (list (match-string 1)) mh-alias-alist)))))
|
||||
(forward-line 1)))
|
||||
(when mh-alias-local-users
|
||||
(setq mh-alias-passwd-alist (mh-alias-local-users))
|
||||
;; Update aliases with local users, but leave existing aliases alone.
|
||||
(let ((local-users mh-alias-passwd-alist)
|
||||
user)
|
||||
(while local-users
|
||||
(setq user (car local-users))
|
||||
(if (not (assoc-ignore-case (car user) mh-alias-alist))
|
||||
(setq mh-alias-alist (append mh-alias-alist (list user))))
|
||||
(setq local-users (cdr local-users)))))
|
||||
(message "Loading MH aliases...done"))
|
||||
|
||||
(defun mh-alias-reload-maybe ()
|
||||
"Load new MH aliases."
|
||||
(if (or (not mh-alias-alist) ; Doesn't exist, so create it.
|
||||
(mh-alias-tstamp nil)) ; Out of date, so recreate it.
|
||||
(mh-alias-reload)))
|
||||
|
||||
|
||||
;;; Alias Expansion
|
||||
|
||||
(defun mh-alias-ali (alias &optional user)
|
||||
"Return ali expansion for ALIAS.
|
||||
ALIAS must be a string for a single alias.
|
||||
If USER is t, then assume ALIAS is an address and call ali -user.
|
||||
ali returns the string unchanged if not defined. The same is done here."
|
||||
(save-excursion
|
||||
(let ((user-arg (if user "-user" "-nouser")))
|
||||
(mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
|
||||
(goto-char (point-max))
|
||||
(if (looking-at "^$") (delete-backward-char 1))
|
||||
(buffer-substring (point-min)(point-max))))
|
||||
|
||||
(defun mh-alias-expand (alias)
|
||||
"Return expansion for ALIAS.
|
||||
Blind aliases or users from /etc/passwd are not expanded."
|
||||
(cond
|
||||
((assoc-ignore-case alias mh-alias-blind-alist)
|
||||
alias) ; Don't expand a blind alias
|
||||
((assoc-ignore-case alias mh-alias-passwd-alist)
|
||||
(cadr (assoc-ignore-case alias mh-alias-passwd-alist)))
|
||||
(t
|
||||
(mh-alias-ali alias))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-read-address (prompt)
|
||||
"Read an address from the minibuffer with PROMPT."
|
||||
(mh-alias-reload-maybe)
|
||||
(if (not mh-alias-alist) ; If still no aliases, just prompt
|
||||
(read-string prompt)
|
||||
(let* ((minibuffer-local-completion-map mh-alias-read-address-map)
|
||||
(completion-ignore-case mh-alias-completion-ignore-case-flag)
|
||||
(the-answer
|
||||
(or (cond
|
||||
((fboundp 'completing-read-multiple)
|
||||
(completing-read-multiple prompt mh-alias-alist nil nil))
|
||||
((featurep 'multi-prompt)
|
||||
(multi-prompt "," nil prompt mh-alias-alist nil nil))
|
||||
(t
|
||||
(split-string
|
||||
(completing-read "To: " mh-alias-alist nil nil)
|
||||
","))))))
|
||||
(if (not mh-alias-expand-aliases-flag)
|
||||
(mapconcat 'identity the-answer ", ")
|
||||
;; Loop over all elements, checking if in passwd aliast or blind first
|
||||
(mapconcat 'mh-alias-expand the-answer ",\n ")))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-minibuffer-confirm-address ()
|
||||
"Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
|
||||
(interactive)
|
||||
(if (not mh-alias-flash-on-comma)
|
||||
()
|
||||
(save-excursion
|
||||
(let* ((case-fold-search t)
|
||||
(the-name (buffer-substring
|
||||
(progn (skip-chars-backward " \t")(point))
|
||||
;; This moves over to previous comma, if any
|
||||
(progn (or (and (not (= 0 (skip-chars-backward "^,")))
|
||||
;; the skips over leading whitespace
|
||||
(skip-chars-forward " "))
|
||||
;; no comma, then to beginning of word
|
||||
(skip-chars-backward "^ \t"))
|
||||
;; In Emacs21, the beginning of the prompt
|
||||
;; line is accessible, which wasn't the case
|
||||
;; in emacs20. Skip over it.
|
||||
(if (looking-at "^[^ \t]+:")
|
||||
(skip-chars-forward "^ \t"))
|
||||
(skip-chars-forward " ")
|
||||
(point)))))
|
||||
(if (assoc-ignore-case the-name mh-alias-alist)
|
||||
(message "%s -> %s" the-name (mh-alias-expand the-name))
|
||||
;; Check if if was a single word likely to be an alias
|
||||
(if (and (equal mh-alias-flash-on-comma 1)
|
||||
(not (string-match " " the-name)))
|
||||
(message "No alias for %s" the-name))))))
|
||||
(self-insert-command 1))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-letter-expand-alias ()
|
||||
"Expand mail alias before point."
|
||||
(mh-alias-reload-maybe)
|
||||
(let ((mail-abbrevs mh-alias-alist))
|
||||
(mail-abbrev-complete-alias))
|
||||
(when mh-alias-expand-aliases-flag
|
||||
(let* ((end (point))
|
||||
(syntax-table (syntax-table))
|
||||
(beg (unwind-protect
|
||||
(save-excursion
|
||||
(set-syntax-table mail-abbrev-syntax-table)
|
||||
(backward-word 1)
|
||||
(point))
|
||||
(set-syntax-table syntax-table)))
|
||||
(alias (buffer-substring beg end))
|
||||
(expansion (mh-alias-expand alias)))
|
||||
(delete-region beg end)
|
||||
(insert expansion))))
|
||||
|
||||
;;; Adding addresses to alias file.
|
||||
|
||||
(defun mh-alias-suggest-alias (string)
|
||||
"Suggest an alias for STRING."
|
||||
(cond
|
||||
((string-match "^\\sw+$" string)
|
||||
;; One word -> downcase it.
|
||||
(downcase string))
|
||||
((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
|
||||
;; Two words -> first.last
|
||||
(downcase
|
||||
(format "%s.%s" (match-string 1 string) (match-string 2 string))))
|
||||
((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
|
||||
string)
|
||||
;; email only -> downcase username
|
||||
(downcase (match-string 1 string)))
|
||||
((string-match "^\"\\(.*\\)\".*" string)
|
||||
;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
|
||||
(mh-alias-suggest-alias (match-string 1 string)))
|
||||
((string-match "^\\(.*\\) +<.*>$" string)
|
||||
;; Some name <somename@foo.bar> -> recurse -> Some name
|
||||
(mh-alias-suggest-alias (match-string 1 string)))
|
||||
((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
|
||||
;; somename@foo.bar (Some name) -> recurse -> Some name
|
||||
(mh-alias-suggest-alias (match-string 1 string)))
|
||||
((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
|
||||
;; Strip out title
|
||||
(mh-alias-suggest-alias (match-string 2 string)))
|
||||
((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
|
||||
;; Strip out tails with comma
|
||||
(mh-alias-suggest-alias (match-string 1 string)))
|
||||
((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
|
||||
;; Strip out tails
|
||||
(mh-alias-suggest-alias (match-string 1 string)))
|
||||
((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
|
||||
;; Strip out initials
|
||||
(mh-alias-suggest-alias
|
||||
(format "%s %s" (match-string 1 string) (match-string 2 string))))
|
||||
((string-match "^\\([^,]+\\), +\\(.*\\)$" string)
|
||||
;; Reverse order of comma-separated fields
|
||||
(mh-alias-suggest-alias
|
||||
(format "%s %s" (match-string 2 string) (match-string 1 string))))
|
||||
(t
|
||||
;; Output string, with spaces replaced by dots.
|
||||
(downcase (replace-regexp-in-string
|
||||
"\\.\\.+" "."
|
||||
(replace-regexp-in-string " +" "." string))))))
|
||||
|
||||
(defun mh-alias-which-file-has-alias (alias file-list)
|
||||
"Return the name of writable file which defines ALIAS from list FILE-LIST."
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(let ((the-list file-list)
|
||||
(found))
|
||||
(while the-list
|
||||
(erase-buffer)
|
||||
(when (file-writable-p (car file-list))
|
||||
(insert-file-contents (car file-list))
|
||||
(if (re-search-forward (concat "^" (regexp-quote alias) ":"))
|
||||
(setq found (car file-list)
|
||||
the-list nil)
|
||||
(setq the-list (cdr the-list)))))
|
||||
found)))
|
||||
|
||||
(defun mh-alias-insert-file (&optional alias)
|
||||
"Return the alias file to write a new entry for ALIAS in.
|
||||
Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component
|
||||
value.
|
||||
If ALIAS is specified and it already exists, try to return the file that
|
||||
contains it."
|
||||
(cond
|
||||
((and mh-alias-insert-file (listp mh-alias-insert-file))
|
||||
(if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
|
||||
(car mh-alias-insert-file)
|
||||
(if (or (not alias)
|
||||
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
|
||||
(completing-read "Alias file [press Tab]: "
|
||||
(mapcar 'list mh-alias-insert-file) nil t)
|
||||
(or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
|
||||
(completing-read "Alias file [press Tab]: "
|
||||
(mapcar 'list mh-alias-insert-file) nil t)))))
|
||||
((and mh-alias-insert-file (stringp mh-alias-insert-file))
|
||||
mh-alias-insert-file)
|
||||
(t
|
||||
;; writable ones returned from (mh-alias-filenames):
|
||||
(let ((autolist (delq nil (mapcar (lambda (file)
|
||||
(if (and (file-writable-p file)
|
||||
(not (string-equal
|
||||
file "/etc/passwd")))
|
||||
file))
|
||||
(mh-alias-filenames t)))))
|
||||
(cond
|
||||
((not autolist)
|
||||
(error "No writable alias file.
|
||||
Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
|
||||
((not (elt autolist 1)) ; Only one entry, use it
|
||||
(car autolist))
|
||||
((or (not alias)
|
||||
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
|
||||
(completing-read "Alias file [press Tab]: "
|
||||
(mapcar 'list autolist) nil t))
|
||||
(t
|
||||
(or (mh-alias-which-file-has-alias alias autolist)
|
||||
(completing-read "Alias file [press Tab]: "
|
||||
(mapcar 'list autolist) nil t))))))))
|
||||
|
||||
(defun mh-alias-address-to-alias (address)
|
||||
"Return the ADDRESS alias if defined, or nil."
|
||||
(let* ((aliases (mh-alias-ali address t)))
|
||||
(if (string-equal aliases address)
|
||||
nil ; ali returned same string -> no.
|
||||
;; For the comma-separated aliases reyurned by ali, check that one of
|
||||
;; them doesn't expand into a list. e.g. we do have an individual
|
||||
;; alias for that adress.
|
||||
(car (delq nil (mapcar
|
||||
(function
|
||||
(lambda (alias)
|
||||
(let ((recurse (mh-alias-ali alias nil)))
|
||||
(if (string-match ".*,.*" recurse)
|
||||
nil
|
||||
alias))))
|
||||
(split-string aliases ", +")))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-from-has-no-alias-p ()
|
||||
"Return t is From has no current alias set."
|
||||
(mh-alias-reload-maybe)
|
||||
(save-excursion
|
||||
(if (not (mh-folder-line-matches-show-buffer-p))
|
||||
nil ;No corresponding show buffer
|
||||
(if (eq major-mode 'mh-folder-mode)
|
||||
(set-buffer mh-show-buffer))
|
||||
(not (mh-alias-address-to-alias (mh-extract-from-header-value))))))
|
||||
|
||||
(defun mh-alias-add-alias-to-file (alias address &optional file)
|
||||
"Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
|
||||
Prompt for alias file if not provided and there is more than one candidate.
|
||||
If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend
|
||||
after it."
|
||||
(if (not file)
|
||||
(setq file (mh-alias-insert-file alias)))
|
||||
(save-excursion
|
||||
(set-buffer (find-file-noselect file))
|
||||
(goto-char (point-min))
|
||||
(let ((alias-search (concat alias ":"))
|
||||
(letter)
|
||||
(here (point))
|
||||
(case-fold-search t))
|
||||
(cond
|
||||
;; Search for exact match (if we had the same alias before)
|
||||
((re-search-forward
|
||||
(concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
|
||||
(let ((answer (read-string
|
||||
(format "Exists for %s; [i]nsert, [a]ppend: "
|
||||
(match-string 1))))
|
||||
(case-fold-search t))
|
||||
(cond ((string-match "^i" answer))
|
||||
((string-match "^a" answer)
|
||||
(forward-line 1))
|
||||
(t
|
||||
error "Quitting."))))
|
||||
;; No, so sort-in at the right place
|
||||
;; search for "^alias", then "^alia", etc.
|
||||
((eq mh-alias-insertion-location 'sorted)
|
||||
(setq letter (substring alias-search -1)
|
||||
alias-search (substring alias-search 0 -1))
|
||||
(while (and (not (equal alias-search ""))
|
||||
(not (re-search-forward
|
||||
(concat "^" (regexp-quote alias-search)) nil t)))
|
||||
(setq letter (substring alias-search -1)
|
||||
alias-search (substring alias-search 0 -1)))
|
||||
;; Next, move forward to sort alphabetically for following letters
|
||||
(beginning-of-line)
|
||||
(while (re-search-forward
|
||||
(concat "^" (regexp-quote alias-search) "[a-" letter "]")
|
||||
nil t)
|
||||
(forward-line 1)))
|
||||
((eq mh-alias-insertion-location 'bottom)
|
||||
(goto-char (point-max)))
|
||||
((eq mh-alias-insertion-location 'top)
|
||||
(goto-char (point-min)))))
|
||||
(beginning-of-line)
|
||||
(insert (format "%s: %s\n" alias address))
|
||||
(save-buffer)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-add-alias (alias address)
|
||||
"*Add ALIAS for ADDRESS in personal alias file.
|
||||
Prompts for confirmation if the address already has an alias.
|
||||
If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
|
||||
(interactive "P\nP")
|
||||
(mh-alias-reload-maybe)
|
||||
(setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
|
||||
(setq address (read-string "Address: " address))
|
||||
(let ((address-alias (mh-alias-address-to-alias address))
|
||||
(alias-address (mh-alias-expand alias)))
|
||||
(if (string-equal alias-address alias)
|
||||
(setq alias-address nil))
|
||||
(cond
|
||||
((and (equal alias address-alias)
|
||||
(equal address alias-address))
|
||||
(message "Already defined as: %s" alias-address))
|
||||
(address-alias
|
||||
(if (y-or-n-p (format "Address has alias %s; set new one? "
|
||||
address-alias))
|
||||
(mh-alias-add-alias-to-file alias address)))
|
||||
(t
|
||||
(mh-alias-add-alias-to-file alias address)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-grab-from-field ()
|
||||
"*Add ALIAS for ADDRESS in personal alias file.
|
||||
Prompts for confirmation if the alias is already in use or if the address
|
||||
already has an alias."
|
||||
(interactive)
|
||||
(mh-alias-reload-maybe)
|
||||
(save-excursion
|
||||
(cond
|
||||
((mh-folder-line-matches-show-buffer-p)
|
||||
(set-buffer mh-show-buffer))
|
||||
((and (eq major-mode 'mh-folder-mode)
|
||||
(mh-get-msg-num nil))
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
|
||||
((eq major-mode 'mh-folder-mode)
|
||||
(error "Cursor not pointing to a message")))
|
||||
(let* ((address (mh-extract-from-header-value))
|
||||
(alias (mh-alias-suggest-alias address)))
|
||||
(mh-alias-add-alias alias address))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-add-address-under-point ()
|
||||
"Insert an alias for email address under point."
|
||||
(interactive)
|
||||
(let ((address (mh-goto-address-find-address-at-point)))
|
||||
(if address
|
||||
(mh-alias-add-alias nil address)
|
||||
(message "No email address found under point."))))
|
||||
|
||||
(provide 'mh-alias)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
;;; mh-alias.el ends here
|
||||
1267
lisp/mail/mh-comp.el
1267
lisp/mail/mh-comp.el
File diff suppressed because it is too large
Load diff
1751
lisp/mail/mh-customize.el
Normal file
1751
lisp/mail/mh-customize.el
Normal file
File diff suppressed because it is too large
Load diff
1884
lisp/mail/mh-e.el
1884
lisp/mail/mh-e.el
File diff suppressed because it is too large
Load diff
|
|
@ -32,17 +32,13 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-funcs.el,v 1.28 2002/11/11 23:01:27 mbaushke Exp $
|
||||
;; $Id: mh-funcs.el,v 1.36 2002/12/23 05:52:07 satyaki Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
|
||||
;;; autoload
|
||||
(autoload 'mh-notate-seq "mh-seq")
|
||||
(autoload 'mh-speed-invalidate-map "mh-speed")
|
||||
|
||||
;;; customization
|
||||
;;; Customization
|
||||
|
||||
(defvar mh-sortm-args nil
|
||||
"Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
|
||||
|
|
@ -59,6 +55,7 @@ For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
|
|||
|
||||
;;; Functions
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-burst-digest ()
|
||||
"Burst apart the current message, which should be a digest.
|
||||
The message is replaced by its table of contents and the messages from the
|
||||
|
|
@ -66,7 +63,7 @@ digest are inserted into the folder after that message."
|
|||
(interactive)
|
||||
(let ((digest (mh-get-msg-num t)))
|
||||
(mh-process-or-undo-commands mh-current-folder)
|
||||
(mh-set-folder-modified-p t) ; lock folder while bursting
|
||||
(mh-set-folder-modified-p t) ; lock folder while bursting
|
||||
(message "Bursting digest...")
|
||||
(mh-exec-cmd "burst" mh-current-folder digest "-inplace")
|
||||
(with-mh-folder-updating (t)
|
||||
|
|
@ -76,19 +73,29 @@ digest are inserted into the folder after that message."
|
|||
(mh-goto-cur-msg)
|
||||
(message "Bursting digest...done")))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-copy-msg (msg-or-seq folder)
|
||||
"Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
|
||||
Default is the displayed message. If optional prefix argument is provided,
|
||||
then prompt for the message sequence."
|
||||
(interactive (list (if current-prefix-arg
|
||||
(mh-read-seq-default "Copy" t)
|
||||
(mh-get-msg-num t))
|
||||
(mh-prompt-for-folder "Copy to" "" t)))
|
||||
(mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder)
|
||||
(interactive (list (cond
|
||||
((mh-mark-active-p t)
|
||||
(mh-region-to-msg-list (region-beginning) (region-end)))
|
||||
(current-prefix-arg
|
||||
(mh-read-seq-default "Copy" t))
|
||||
(t
|
||||
(mh-get-msg-num t)))
|
||||
(mh-prompt-for-folder "Copy to" "" t)))
|
||||
(mh-exec-cmd "refile"
|
||||
(cond ((numberp msg-or-seq) msg-or-seq)
|
||||
((listp msg-or-seq) msg-or-seq)
|
||||
(t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq))))
|
||||
"-link" "-src" mh-current-folder folder)
|
||||
(if (numberp msg-or-seq)
|
||||
(mh-notate msg-or-seq mh-note-copied mh-cmd-note)
|
||||
(mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
|
||||
(mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-kill-folder ()
|
||||
"Remove the current folder and all included messages.
|
||||
Removes all of the messages (files) within the specified current folder,
|
||||
|
|
@ -99,54 +106,60 @@ with no arguments, after the folders has been removed."
|
|||
(if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
|
||||
mh-current-folder))
|
||||
(let ((folder mh-current-folder))
|
||||
(if (null mh-folder-list)
|
||||
(mh-set-folder-list))
|
||||
(mh-set-folder-modified-p t) ; lock folder to kill it
|
||||
(mh-exec-cmd-daemon "rmf" folder)
|
||||
(setq mh-folder-list
|
||||
(delq (assoc folder mh-folder-list) mh-folder-list))
|
||||
(if (null mh-folder-list)
|
||||
(mh-set-folder-list))
|
||||
(mh-set-folder-modified-p t) ; lock folder to kill it
|
||||
(mh-exec-cmd-daemon "rmf" folder)
|
||||
(setq mh-folder-list
|
||||
(delq (assoc folder mh-folder-list) mh-folder-list))
|
||||
(when (boundp 'mh-speed-folder-map)
|
||||
(mh-speed-invalidate-map folder))
|
||||
(run-hooks 'mh-folder-list-change-hook)
|
||||
(message "Folder %s removed" folder)
|
||||
(mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
|
||||
(if (get-buffer mh-show-buffer)
|
||||
(kill-buffer mh-show-buffer))
|
||||
(if (get-buffer folder)
|
||||
(kill-buffer folder)))
|
||||
(message "Folder not removed")))
|
||||
(run-hooks 'mh-folder-list-change-hook)
|
||||
(message "Folder %s removed" folder)
|
||||
(mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
|
||||
(if (get-buffer mh-show-buffer)
|
||||
(kill-buffer mh-show-buffer))
|
||||
(if (get-buffer folder)
|
||||
(kill-buffer folder)))
|
||||
(message "Folder not removed")))
|
||||
|
||||
;; Avoid compiler warning...
|
||||
(defvar view-exit-action)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-list-folders ()
|
||||
"List mail folders."
|
||||
(interactive)
|
||||
(let ((temp-buffer mh-temp-folders-buffer))
|
||||
(with-output-to-temp-buffer temp-buffer
|
||||
(save-excursion
|
||||
(set-buffer temp-buffer)
|
||||
(erase-buffer)
|
||||
(message "Listing folders...")
|
||||
(mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
|
||||
"-recurse"
|
||||
"-norecurse"))
|
||||
(goto-char (point-min))
|
||||
(view-mode 1)
|
||||
(setq view-exit-action 'kill-buffer)
|
||||
(message "Listing folders...done")))))
|
||||
(set-buffer temp-buffer)
|
||||
(erase-buffer)
|
||||
(message "Listing folders...")
|
||||
(mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
|
||||
"-recurse"
|
||||
"-norecurse"))
|
||||
(goto-char (point-min))
|
||||
(view-mode 1)
|
||||
(setq view-exit-action 'kill-buffer)
|
||||
(message "Listing folders...done")))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-pack-folder (range)
|
||||
"Renumber the messages of a folder to be 1..n.
|
||||
First, offer to execute any outstanding commands for the current folder. If
|
||||
optional prefix argument provided, prompt for the RANGE of messages to display
|
||||
after packing. Otherwise, show the entire folder."
|
||||
(interactive (list (if current-prefix-arg
|
||||
(mh-read-msg-range
|
||||
"Range to scan after packing [all]? ")
|
||||
"all")))
|
||||
(mh-pack-folder-1 range)
|
||||
(mh-goto-cur-msg)
|
||||
(mh-read-msg-range mh-current-folder t)
|
||||
'("all"))))
|
||||
(let ((threaded-flag (memq 'unthread mh-view-ops)))
|
||||
(mh-pack-folder-1 range)
|
||||
(mh-goto-cur-msg)
|
||||
(when mh-index-data
|
||||
(mh-index-update-maps mh-current-folder))
|
||||
(cond (threaded-flag (mh-toggle-threads))
|
||||
(mh-index-data (mh-index-insert-folder-headers))))
|
||||
(message "Packing folder...done"))
|
||||
|
||||
(defun mh-pack-folder-1 (range)
|
||||
|
|
@ -155,13 +168,14 @@ Display the given RANGE of messages after packing. If RANGE is nil, show the
|
|||
entire folder."
|
||||
(mh-process-or-undo-commands mh-current-folder)
|
||||
(message "Packing folder...")
|
||||
(mh-set-folder-modified-p t) ; lock folder while packing
|
||||
(mh-set-folder-modified-p t) ; lock folder while packing
|
||||
(save-excursion
|
||||
(mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
|
||||
"-norecurse" "-fast"))
|
||||
"-norecurse" "-fast"))
|
||||
(mh-reset-threads-and-narrowing)
|
||||
(mh-regenerate-headers range))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-pipe-msg (command include-headers)
|
||||
"Pipe the current message through the given shell COMMAND.
|
||||
If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
|
||||
|
|
@ -169,7 +183,7 @@ Otherwise just send the message's body without the headers."
|
|||
(interactive
|
||||
(list (read-string "Shell command on message: ") current-prefix-arg))
|
||||
(let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
|
||||
(message-directory default-directory))
|
||||
(message-directory default-directory))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
|
|
@ -177,8 +191,9 @@ Otherwise just send the message's body without the headers."
|
|||
(goto-char (point-min))
|
||||
(if (not include-headers) (search-forward "\n\n"))
|
||||
(let ((default-directory message-directory))
|
||||
(shell-command-on-region (point) (point-max) command nil)))))
|
||||
(shell-command-on-region (point) (point-max) command nil)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-page-digest ()
|
||||
"Advance displayed message to next digested message."
|
||||
(interactive)
|
||||
|
|
@ -188,13 +203,14 @@ Otherwise just send the message's body without the headers."
|
|||
(let ((case-fold-search nil))
|
||||
;; Search for blank line and then for From:
|
||||
(or (and (search-forward "\n\n" nil t)
|
||||
(re-search-forward "^From:" nil t))
|
||||
(error "No more messages in digest")))
|
||||
(re-search-forward "^From:" nil t))
|
||||
(error "No more messages in digest")))
|
||||
;; Go back to previous blank line, then forward to the first non-blank.
|
||||
(search-backward "\n\n" nil t)
|
||||
(forward-line 2)
|
||||
(mh-recenter 0)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-page-digest-backwards ()
|
||||
"Back up displayed message to previous digested message."
|
||||
(interactive)
|
||||
|
|
@ -204,66 +220,68 @@ Otherwise just send the message's body without the headers."
|
|||
(let ((case-fold-search nil))
|
||||
(beginning-of-line)
|
||||
(or (and (search-backward "\n\n" nil t)
|
||||
(re-search-backward "^From:" nil t))
|
||||
(error "No previous message in digest")))
|
||||
(re-search-backward "^From:" nil t))
|
||||
(error "No previous message in digest")))
|
||||
;; Go back to previous blank line, then forward to the first non-blank.
|
||||
(if (search-backward "\n\n" nil t)
|
||||
(forward-line 2))
|
||||
(forward-line 2))
|
||||
(mh-recenter 0)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-print-msg (msg-or-seq)
|
||||
"Print MSG-OR-SEQ (default: displayed message) on printer.
|
||||
If optional prefix argument provided, then prompt for the message sequence.
|
||||
The variable `mh-lpr-command-format' is used to generate the print command.
|
||||
The messages are formatted by mhl. See the variable `mhl-formfile'."
|
||||
(interactive (list (if current-prefix-arg
|
||||
(reverse (mh-seq-to-msgs
|
||||
(mh-read-seq-default "Print" t)))
|
||||
(mh-get-msg-num t))))
|
||||
(reverse (mh-seq-to-msgs
|
||||
(mh-read-seq-default "Print" t)))
|
||||
(mh-get-msg-num t))))
|
||||
(if (numberp msg-or-seq)
|
||||
(message "Printing message...")
|
||||
(message "Printing sequence..."))
|
||||
(message "Printing sequence..."))
|
||||
(let ((print-command
|
||||
(if (numberp msg-or-seq)
|
||||
(format "%s -nobell -clear %s %s | %s"
|
||||
(expand-file-name "mhl" mh-lib-progs)
|
||||
(mh-msg-filename msg-or-seq)
|
||||
(if (stringp mhl-formfile)
|
||||
(format "-form %s" mhl-formfile)
|
||||
"")
|
||||
(format mh-lpr-command-format
|
||||
(if (numberp msg-or-seq)
|
||||
(format "%s/%d" mh-current-folder
|
||||
msg-or-seq)
|
||||
(format "Sequence from %s" mh-current-folder))))
|
||||
(format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
|
||||
(mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
|
||||
(expand-file-name "mhl" mh-lib-progs)
|
||||
(if (stringp mhl-formfile)
|
||||
(format "-form %s" mhl-formfile)
|
||||
"")
|
||||
(mh-msg-filenames msg-or-seq)
|
||||
(format mh-lpr-command-format
|
||||
(if (numberp msg-or-seq)
|
||||
(format "%s/%d" mh-current-folder
|
||||
msg-or-seq)
|
||||
(format "Sequence from %s"
|
||||
mh-current-folder)))))))
|
||||
(if (numberp msg-or-seq)
|
||||
(format "%s -nobell -clear %s %s | %s"
|
||||
(expand-file-name "mhl" mh-lib-progs)
|
||||
(mh-msg-filename msg-or-seq)
|
||||
(if (stringp mhl-formfile)
|
||||
(format "-form %s" mhl-formfile)
|
||||
"")
|
||||
(format mh-lpr-command-format
|
||||
(if (numberp msg-or-seq)
|
||||
(format "%s/%d" mh-current-folder
|
||||
msg-or-seq)
|
||||
(format "Sequence from %s" mh-current-folder))))
|
||||
(format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
|
||||
(mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
|
||||
(expand-file-name "mhl" mh-lib-progs)
|
||||
(if (stringp mhl-formfile)
|
||||
(format "-form %s" mhl-formfile)
|
||||
"")
|
||||
(mh-msg-filenames msg-or-seq)
|
||||
(format mh-lpr-command-format
|
||||
(if (numberp msg-or-seq)
|
||||
(format "%s/%d" mh-current-folder
|
||||
msg-or-seq)
|
||||
(format "Sequence from %s"
|
||||
mh-current-folder)))))))
|
||||
(if mh-print-background-flag
|
||||
(mh-exec-cmd-daemon shell-file-name "-c" print-command)
|
||||
(mh-exec-cmd-daemon shell-file-name "-c" print-command)
|
||||
(call-process shell-file-name nil nil nil "-c" print-command))
|
||||
(if (numberp msg-or-seq)
|
||||
(mh-notate msg-or-seq mh-note-printed mh-cmd-note)
|
||||
(mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
|
||||
(mh-notate msg-or-seq mh-note-printed mh-cmd-note)
|
||||
(mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
|
||||
(mh-add-msgs-to-seq msg-or-seq 'printed t)
|
||||
(if (numberp msg-or-seq)
|
||||
(message "Printing message...done")
|
||||
(message "Printing sequence...done"))))
|
||||
(message "Printing message...done")
|
||||
(message "Printing sequence...done"))))
|
||||
|
||||
(defun mh-msg-filenames (msgs &optional folder)
|
||||
"Return a list of file names for MSGS in FOLDER (default current folder)."
|
||||
(mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-sort-folder (&optional extra-args)
|
||||
"Sort the messages in the current folder by date.
|
||||
Calls the MH program sortm to do the work.
|
||||
|
|
@ -272,36 +290,45 @@ argument EXTRA-ARGS is given."
|
|||
(interactive "P")
|
||||
(mh-process-or-undo-commands mh-current-folder)
|
||||
(setq mh-next-direction 'forward)
|
||||
(mh-set-folder-modified-p t) ; lock folder while sorting
|
||||
(mh-set-folder-modified-p t) ; lock folder while sorting
|
||||
(message "Sorting folder...")
|
||||
(mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
|
||||
(message "Sorting folder...done")
|
||||
(mh-scan-folder mh-current-folder "all"))
|
||||
(let ((threaded-flag (memq 'unthread mh-view-ops)))
|
||||
(mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
|
||||
(when mh-index-data
|
||||
(mh-index-update-maps mh-current-folder))
|
||||
(message "Sorting folder...done")
|
||||
(mh-reset-threads-and-narrowing)
|
||||
(mh-scan-folder mh-current-folder "all")
|
||||
(cond (threaded-flag (mh-toggle-threads))
|
||||
(mh-index-data (mh-index-insert-folder-headers)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-undo-folder (&rest ignore)
|
||||
"Undo all pending deletes and refiles in current folder.
|
||||
Argument IGNORE is deprecated."
|
||||
(interactive)
|
||||
(cond ((or mh-do-not-confirm-flag
|
||||
(yes-or-no-p "Undo all commands in folder? "))
|
||||
(setq mh-delete-list nil
|
||||
mh-refile-list nil
|
||||
mh-seq-list nil
|
||||
mh-next-direction 'forward)
|
||||
(with-mh-folder-updating (nil)
|
||||
(mh-unmark-all-headers t)))
|
||||
(t
|
||||
(message "Commands not undone.")
|
||||
(sit-for 2))))
|
||||
(yes-or-no-p "Undo all commands in folder? "))
|
||||
(setq mh-delete-list nil
|
||||
mh-refile-list nil
|
||||
mh-seq-list nil
|
||||
mh-next-direction 'forward)
|
||||
(with-mh-folder-updating (nil)
|
||||
(mh-unmark-all-headers t)))
|
||||
(t
|
||||
(message "Commands not undone.")
|
||||
(sit-for 2))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-store-msg (directory)
|
||||
"Store the file(s) contained in the current message into DIRECTORY.
|
||||
The message can contain a shar file or uuencoded file.
|
||||
Default directory is the last directory used, or initially the value of
|
||||
`mh-store-default-directory' or the current directory."
|
||||
(interactive (list (let ((udir (or mh-store-default-directory default-directory)))
|
||||
(read-file-name "Store message in directory: "
|
||||
udir udir nil))))
|
||||
(interactive (list (let ((udir (or mh-store-default-directory
|
||||
default-directory)))
|
||||
(read-file-name "Store message in directory: "
|
||||
udir udir nil))))
|
||||
(let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
|
|
@ -309,58 +336,59 @@ Default directory is the last directory used, or initially the value of
|
|||
(insert-file-contents msg-file-to-store)
|
||||
(mh-store-buffer directory))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-store-buffer (directory)
|
||||
"Store the file(s) contained in the current buffer into DIRECTORY.
|
||||
The buffer can contain a shar file or uuencoded file.
|
||||
Default directory is the last directory used, or initially the value of
|
||||
`mh-store-default-directory' or the current directory."
|
||||
(interactive (list (let ((udir (or mh-store-default-directory
|
||||
default-directory)))
|
||||
(read-file-name "Store buffer in directory: "
|
||||
udir udir nil))))
|
||||
default-directory)))
|
||||
(read-file-name "Store buffer in directory: "
|
||||
udir udir nil))))
|
||||
(let ((store-directory (expand-file-name directory))
|
||||
(sh-start (save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
"^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
|
||||
(progn
|
||||
;; The "cut here" pattern was removed from above
|
||||
;; because it seemed to hurt more than help.
|
||||
;; But keep this to make it easier to put it back.
|
||||
(if (looking-at "^[^a-z0-9\"]*cut here\\b")
|
||||
(forward-line 1))
|
||||
(beginning-of-line)
|
||||
(if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
|
||||
nil ;most likely end of a uuencode
|
||||
(point))))))
|
||||
(log-buffer (get-buffer-create "*Store Output*"))
|
||||
(command "sh")
|
||||
(uudecode-filename "(unknown filename)"))
|
||||
(sh-start (save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
"^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
|
||||
(progn
|
||||
;; The "cut here" pattern was removed from above
|
||||
;; because it seemed to hurt more than help.
|
||||
;; But keep this to make it easier to put it back.
|
||||
(if (looking-at "^[^a-z0-9\"]*cut here\\b")
|
||||
(forward-line 1))
|
||||
(beginning-of-line)
|
||||
(if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
|
||||
nil ;most likely end of a uuencode
|
||||
(point))))))
|
||||
(log-buffer (get-buffer-create "*Store Output*"))
|
||||
(command "sh")
|
||||
(uudecode-filename "(unknown filename)"))
|
||||
(if (not sh-start)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "^begin [0-7]+ " nil t)
|
||||
(setq uudecode-filename
|
||||
(buffer-substring (point)
|
||||
(progn (end-of-line) (point)))))))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "^begin [0-7]+ " nil t)
|
||||
(setq uudecode-filename
|
||||
(buffer-substring (point)
|
||||
(progn (end-of-line) (point)))))))
|
||||
(save-excursion
|
||||
(set-buffer log-buffer)
|
||||
(erase-buffer)
|
||||
(if (not (file-directory-p store-directory))
|
||||
(progn
|
||||
(insert "mkdir " directory "\n")
|
||||
(call-process "mkdir" nil log-buffer t store-directory)))
|
||||
(progn
|
||||
(insert "mkdir " directory "\n")
|
||||
(call-process "mkdir" nil log-buffer t store-directory)))
|
||||
(insert "cd " directory "\n")
|
||||
(setq mh-store-default-directory directory)
|
||||
(if (not sh-start)
|
||||
(progn
|
||||
(setq command "uudecode")
|
||||
(insert uudecode-filename " being uudecoded...\n"))))
|
||||
(progn
|
||||
(setq command "uudecode")
|
||||
(insert uudecode-filename " being uudecoded...\n"))))
|
||||
(set-window-start (display-buffer log-buffer) 0) ;watch progress
|
||||
(let (value)
|
||||
(let ((default-directory (file-name-as-directory store-directory)))
|
||||
(setq value (call-process-region sh-start (point-max) command
|
||||
nil log-buffer t)))
|
||||
(setq value (call-process-region sh-start (point-max) command
|
||||
nil log-buffer t)))
|
||||
(set-buffer log-buffer)
|
||||
(mh-handle-process-error command value))
|
||||
(insert "\n(mh-store finished)\n")))
|
||||
|
|
@ -375,13 +403,15 @@ Default directory is the last directory used, or initially the value of
|
|||
(sit-for 5)
|
||||
(message ""))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-help ()
|
||||
"Display cheat sheet for the MH-Folder commands in minibuffer."
|
||||
(interactive)
|
||||
(mh-ephem-message
|
||||
(substitute-command-keys
|
||||
(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
|
||||
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-prefix-help ()
|
||||
"Display cheat sheet for the commands of the current prefix in minibuffer."
|
||||
(interactive)
|
||||
|
|
@ -391,7 +421,7 @@ Default directory is the last directory used, or initially the value of
|
|||
;; length-2. We use that information to obtain a suitable prefix character
|
||||
;; from the recent keys.
|
||||
(let* ((keys (recent-keys))
|
||||
(prefix-char (elt keys (- (length keys) 2))))
|
||||
(prefix-char (elt keys (- (length keys) 2))))
|
||||
(mh-ephem-message
|
||||
(substitute-command-keys
|
||||
(mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
|
||||
|
|
@ -399,6 +429,7 @@ Default directory is the last directory used, or initially the value of
|
|||
(provide 'mh-funcs)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
|
|
|
|||
219
lisp/mail/mh-identity.el
Normal file
219
lisp/mail/mh-identity.el
Normal file
|
|
@ -0,0 +1,219 @@
|
|||
;;; mh-identity.el --- Multiple Identify support for MH-E.
|
||||
|
||||
;; Copyright (C) 2002 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Peter S. Galbraith <psg@debian.org>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Multiple identity support for MH-E.
|
||||
;;
|
||||
;; Used to easily set different fields such as From and Organization, as
|
||||
;; well as different signature files.
|
||||
;;
|
||||
;; Customize the variable `mh-identity-list' and an Identity menu will
|
||||
;; appear in mh-letter-mode. The command 'mh-insert-identity can be used
|
||||
;; from the command line.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-identity.el,v 1.17 2002/12/03 15:54:27 psg Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
(require 'cl)
|
||||
|
||||
(eval-when (compile load eval)
|
||||
(defvar mh-comp-loaded nil)
|
||||
(unless mh-comp-loaded
|
||||
(setq mh-comp-loaded t)
|
||||
(require 'mh-comp))) ;Since we do this on sending
|
||||
|
||||
(autoload 'mml-insert-tag "mml")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-identity-make-menu ()
|
||||
"Build (or rebuild) the Identity menu (e.g. after the list is modified)."
|
||||
(when (and mh-identity-list (boundp 'mh-letter-mode-map))
|
||||
(easy-menu-define mh-identity-menu mh-letter-mode-map
|
||||
"mh-e identity menu"
|
||||
(append
|
||||
'("Identity")
|
||||
;; Dynamically render :type corresponding to `mh-identity-list'
|
||||
;; e.g.:
|
||||
;; ["home" (mh-insert-identity "home")
|
||||
;; :style radio :active (not (equal mh-identity-local "home"))
|
||||
;; :selected (equal mh-identity-local "home")]
|
||||
(mapcar (function
|
||||
(lambda (arg)
|
||||
`[,arg (mh-insert-identity ,arg) :style radio
|
||||
:active (not (equal mh-identity-local ,arg))
|
||||
:selected (equal mh-identity-local ,arg)]))
|
||||
(mapcar 'car mh-identity-list))
|
||||
'("--"
|
||||
["none" (mh-insert-identity "none") mh-identity-local]
|
||||
["Set Default for Session"
|
||||
(setq mh-identity-default mh-identity-local) t]
|
||||
["Save as Default"
|
||||
(customize-save-variable
|
||||
'mh-identity-default mh-identity-local) t]
|
||||
)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-identity-list-set (symbol value)
|
||||
"Update the `mh-identity-list' variable, and rebuild the menu.
|
||||
Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
|
||||
customization). This is called after 'customize is used to alter
|
||||
`mh-identity-list'."
|
||||
(set-default symbol value)
|
||||
(mh-identity-make-menu))
|
||||
|
||||
(defvar mh-identity-local nil
|
||||
"Buffer-local variable holding the identity currently in use.")
|
||||
(make-variable-buffer-local 'mh-identity-local)
|
||||
|
||||
(defun mh-header-field-delete (field value-only)
|
||||
"Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
|
||||
Return t if anything is deleted."
|
||||
(when (mh-goto-header-field field)
|
||||
(if (not value-only)
|
||||
(beginning-of-line)
|
||||
(forward-char))
|
||||
(delete-region (point)
|
||||
(progn (mh-header-field-end)
|
||||
(if (not value-only) (forward-char 1))
|
||||
(point)))
|
||||
t))
|
||||
|
||||
(defvar mh-identity-signature-start nil
|
||||
"Marker for the beginning of a signature inserted by `mh-insert-identity'.")
|
||||
(defvar mh-identity-signature-end nil
|
||||
"Marker for the end of a signature inserted by `mh-insert-identity'.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-insert-identity (identity)
|
||||
"Insert proper fields for given IDENTITY.
|
||||
Edit the `mh-identity-list' variable to define identity."
|
||||
(interactive
|
||||
(list (completing-read
|
||||
"Identity: "
|
||||
(if mh-identity-local
|
||||
(cons '("none")
|
||||
(mapcar 'list (mapcar 'car mh-identity-list)))
|
||||
(mapcar 'list (mapcar 'car mh-identity-list)))
|
||||
nil t)))
|
||||
(save-excursion
|
||||
;;First remove old settings, if any.
|
||||
(when mh-identity-local
|
||||
(let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
|
||||
(while pers-list
|
||||
(let ((field (concat (caar pers-list) ":")))
|
||||
(cond
|
||||
((string-equal "signature:" field)
|
||||
(when (and (boundp 'mh-identity-signature-start)
|
||||
(markerp mh-identity-signature-start))
|
||||
(goto-char mh-identity-signature-start)
|
||||
(forward-char -1)
|
||||
(delete-region (point) mh-identity-signature-end)))
|
||||
((mh-header-field-delete field nil))))
|
||||
(setq pers-list (cdr pers-list)))))
|
||||
;; Then insert the replacement
|
||||
(when (not (equal "none" identity))
|
||||
(let ((pers-list (cadr (assoc identity mh-identity-list))))
|
||||
(while pers-list
|
||||
(let ((field (concat (caar pers-list) ":"))
|
||||
(value (cdar pers-list)))
|
||||
(cond
|
||||
;; No value, remove field
|
||||
((or (not value)
|
||||
(string= value ""))
|
||||
(mh-header-field-delete field nil))
|
||||
;; Existing field, replace
|
||||
((mh-header-field-delete field t)
|
||||
(insert value))
|
||||
;; Handle "signature" special case. Insert file or call function.
|
||||
((and (string-equal "signature:" field)
|
||||
(or (and (stringp value)
|
||||
(file-readable-p value))
|
||||
(fboundp value)))
|
||||
(goto-char (point-max))
|
||||
(if (not (looking-at "^$"))
|
||||
(insert "\n"))
|
||||
(insert "\n")
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(set (make-local-variable 'mh-identity-signature-start)
|
||||
(make-marker))
|
||||
(set-marker mh-identity-signature-start (point))
|
||||
(cond
|
||||
;; If MIME composition done, insert signature at the end as
|
||||
;; an inline MIME part.
|
||||
((and (boundp 'mh-mhn-compose-insert-flag)
|
||||
mh-mhn-compose-insert-flag)
|
||||
(insert "#\n" "Content-Description: Signature\n"))
|
||||
((and (boundp 'mh-mml-compose-insert-flag)
|
||||
mh-mml-compose-insert-flag)
|
||||
(mml-insert-tag 'part 'type "text/plain"
|
||||
'disposition "inline"
|
||||
'description "Signature")))
|
||||
(if (stringp value)
|
||||
(insert-file-contents value)
|
||||
(funcall value))
|
||||
(goto-char (point-min))
|
||||
(when (not (re-search-forward "^--" nil t))
|
||||
(if (and (boundp 'mh-mhn-compose-insert-flag)
|
||||
mh-mhn-compose-insert-flag)
|
||||
(forward-line 2))
|
||||
(if (and (boundp 'mh-mml-compose-insert-flag)
|
||||
mh-mml-compose-insert-flag)
|
||||
(forward-line 1))
|
||||
(insert "-- \n"))
|
||||
(set (make-local-variable 'mh-identity-signature-end)
|
||||
(make-marker))
|
||||
(set-marker mh-identity-signature-end (point-max))))
|
||||
;; Handle "From" field differently, adding it at the beginning.
|
||||
((string-equal "From:" field)
|
||||
(goto-char (point-min))
|
||||
(insert "From: " value "\n"))
|
||||
;; Skip empty signature (Can't remove what we don't know)
|
||||
((string-equal "signature:" field))
|
||||
;; Other field, add at end
|
||||
(t ;Otherwise, add the end.
|
||||
(goto-char (point-min))
|
||||
(mh-goto-header-end 0)
|
||||
(mh-insert-fields field value))))
|
||||
(setq pers-list (cdr pers-list))))))
|
||||
;; Remember what is in use in this buffer
|
||||
(if (equal "none" identity)
|
||||
(setq mh-identity-local nil)
|
||||
(setq mh-identity-local identity)))
|
||||
|
||||
(provide 'mh-identity)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
;;; mh-identity.el ends here
|
||||
File diff suppressed because it is too large
Load diff
880
lisp/mail/mh-loaddefs.el
Normal file
880
lisp/mail/mh-loaddefs.el
Normal file
|
|
@ -0,0 +1,880 @@
|
|||
;;; mh-loaddefs.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
|
||||
;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom
|
||||
;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
|
||||
;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
|
||||
;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
|
||||
;;;;;; (15899 19356))
|
||||
;;; Generated autoloads from mh-comp.el
|
||||
|
||||
(autoload (quote mh-edit-again) "mh-comp" "\
|
||||
Clean up a draft or a message MSG previously sent and make it resendable.
|
||||
Default is the current message.
|
||||
The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
|
||||
See also documentation for `\\[mh-send]' function." t nil)
|
||||
|
||||
(autoload (quote mh-extract-rejected-mail) "mh-comp" "\
|
||||
Extract message MSG returned by the mail system and make it resendable.
|
||||
Default is the current message. The variable `mh-new-draft-cleaned-headers'
|
||||
gives the headers to clean out of the original message.
|
||||
See also documentation for `\\[mh-send]' function." t nil)
|
||||
|
||||
(autoload (quote mh-forward) "mh-comp" "\
|
||||
Forward one or more messages to the recipients TO and CC.
|
||||
|
||||
Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
|
||||
|
||||
Default is the displayed message. If optional prefix argument is given then
|
||||
prompt for the message sequence. If variable `transient-mark-mode' is non-nil
|
||||
and the mark is active, then the selected region is forwarded.
|
||||
See also documentation for `\\[mh-send]' function." t nil)
|
||||
|
||||
(autoload (quote mh-redistribute) "mh-comp" "\
|
||||
Redistribute displayed message to recipients TO and CC.
|
||||
Use optional argument MSG to redistribute another message.
|
||||
Depending on how your copy of MH was compiled, you may need to change the
|
||||
setting of the variable `mh-redist-full-contents'. See its documentation." t nil)
|
||||
|
||||
(autoload (quote mh-reply) "mh-comp" "\
|
||||
Reply to MESSAGE (default: current message).
|
||||
If the optional argument REPLY-TO is not given, prompts for type of addresses
|
||||
to reply to:
|
||||
from sender only,
|
||||
to sender and primary recipients,
|
||||
cc/all sender and all recipients.
|
||||
If optional prefix argument INCLUDEP provided, then include the message
|
||||
in the reply using filter `mhl.reply' in your MH directory.
|
||||
If the file named by `mh-repl-formfile' exists, it is used as a skeleton
|
||||
for the reply. See also documentation for `\\[mh-send]' function." t nil)
|
||||
|
||||
(autoload (quote mh-send) "mh-comp" "\
|
||||
Compose and send a letter.
|
||||
|
||||
Do not call this function from outside MH-E; use \\[mh-smail] instead.
|
||||
|
||||
The file named by `mh-comp-formfile' will be used as the form.
|
||||
The letter is composed in `mh-letter-mode'; see its documentation for more
|
||||
details.
|
||||
If `mh-compose-letter-function' is defined, it is called on the draft and
|
||||
passed three arguments: TO, CC, and SUBJECT." t nil)
|
||||
|
||||
(autoload (quote mh-send-other-window) "mh-comp" "\
|
||||
Compose and send a letter in another window.
|
||||
|
||||
Do not call this function from outside MH-E; use \\[mh-smail-other-window]
|
||||
instead.
|
||||
|
||||
The file named by `mh-comp-formfile' will be used as the form.
|
||||
The letter is composed in `mh-letter-mode'; see its documentation for more
|
||||
details.
|
||||
If `mh-compose-letter-function' is defined, it is called on the draft and
|
||||
passed three arguments: TO, CC, and SUBJECT." t nil)
|
||||
|
||||
(autoload (quote mh-fill-paragraph-function) "mh-comp" "\
|
||||
Fill paragraph at or after point.
|
||||
Prefix ARG means justify as well. This function enables `fill-paragraph' to
|
||||
work better in MH-Letter mode." t nil)
|
||||
|
||||
(autoload (quote mh-to-field) "mh-comp" "\
|
||||
Move point to the end of a specified header field.
|
||||
The field is indicated by the previous keystroke (the last keystroke
|
||||
of the command) according to the list in the variable `mh-to-field-choices'.
|
||||
Create the field if it does not exist. Set the mark to point before moving." t nil)
|
||||
|
||||
(autoload (quote mh-to-fcc) "mh-comp" "\
|
||||
Insert an Fcc: FOLDER field in the current message.
|
||||
Prompt for the field name with a completion list of the current folders." t nil)
|
||||
|
||||
(autoload (quote mh-insert-signature) "mh-comp" "\
|
||||
Insert the file named by `mh-signature-file-name' at point.
|
||||
The value of `mh-letter-insert-signature-hook' is a list of functions to be
|
||||
called, with no arguments, before the signature is actually inserted." t nil)
|
||||
|
||||
(autoload (quote mh-check-whom) "mh-comp" "\
|
||||
Verify recipients of the current letter, showing expansion of any aliases." t nil)
|
||||
|
||||
(autoload (quote mh-send-letter) "mh-comp" "\
|
||||
Send the draft letter in the current buffer.
|
||||
If optional prefix argument ARG is provided, monitor delivery.
|
||||
The value of `mh-before-send-letter-hook' is a list of functions to be called,
|
||||
with no arguments, before doing anything.
|
||||
Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
|
||||
Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
|
||||
Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
|
||||
Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil)
|
||||
|
||||
(autoload (quote mh-insert-letter) "mh-comp" "\
|
||||
Insert a message into the current letter.
|
||||
Removes the header fields according to the variable `mh-invisible-headers'.
|
||||
Prefixes each non-blank line with `mh-ins-buf-prefix', unless
|
||||
`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
|
||||
used to format the message.
|
||||
Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
|
||||
not indent and do not delete headers. Leaves the mark before the letter
|
||||
and point after it." t nil)
|
||||
|
||||
(autoload (quote mh-yank-cur-msg) "mh-comp" "\
|
||||
Insert the current message into the draft buffer.
|
||||
Prefix each non-blank line in the message with the string in
|
||||
`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
|
||||
only the region will be inserted. Otherwise, the entire message will
|
||||
be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
|
||||
is nil, the portion of the message following the point will be yanked.
|
||||
If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
|
||||
yanked message will be deleted." t nil)
|
||||
|
||||
(autoload (quote mh-fully-kill-draft) "mh-comp" "\
|
||||
Kill the draft message file and the draft message buffer.
|
||||
Use \\[kill-buffer] if you don't want to delete the draft message file." t nil)
|
||||
|
||||
(autoload (quote mh-open-line) "mh-comp" "\
|
||||
Insert a newline and leave point after it.
|
||||
In addition, insert newline and quoting characters before text after point.
|
||||
This is useful in breaking up paragraphs in replies." t nil)
|
||||
|
||||
(autoload (quote mh-letter-complete) "mh-comp" "\
|
||||
Perform completion on header field or word preceding point.
|
||||
Alias completion is done within the mail header on selected fields and
|
||||
by the function designated by `mh-letter-complete-function' elsewhere,
|
||||
passing the prefix ARG if any." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set
|
||||
;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15899 29873))
|
||||
;;; Generated autoloads from mh-customize.el
|
||||
|
||||
(autoload (quote mh-customize) "mh-customize" "\
|
||||
Customize MH-E variables." t nil)
|
||||
|
||||
(autoload (quote mh-tool-bar-letter-set) "mh-customize" "\
|
||||
Construct toolbar for `mh-letter-mode'." nil nil)
|
||||
|
||||
(autoload (quote mh-tool-bar-folder-set) "mh-customize" "\
|
||||
Construct toolbar for `mh-folder-mode'." nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
|
||||
;;;;;; "mh-e" "mh-e.el" (15899 29921))
|
||||
;;; Generated autoloads from mh-e.el
|
||||
|
||||
(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
|
||||
Return t if the message under point in folder-mode is in the show buffer.
|
||||
Return nil in any other circumstance (no message under point, no show buffer,
|
||||
the message in the show buffer doesn't match." nil nil)
|
||||
|
||||
(autoload (quote mh-update-sequences) "mh-e" "\
|
||||
Update MH's Unseen-Sequence and current folder and message.
|
||||
Flush MH-E's state out to MH. The message at the cursor becomes current." t nil)
|
||||
|
||||
(autoload (quote mh-goto-cur-msg) "mh-e" "\
|
||||
Position the cursor at the current message.
|
||||
When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
|
||||
recenter the folder buffer." nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-prefix-help mh-help mh-store-buffer mh-store-msg
|
||||
;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
|
||||
;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
|
||||
;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
|
||||
;;;;;; (15886 19303))
|
||||
;;; Generated autoloads from mh-funcs.el
|
||||
|
||||
(autoload (quote mh-burst-digest) "mh-funcs" "\
|
||||
Burst apart the current message, which should be a digest.
|
||||
The message is replaced by its table of contents and the messages from the
|
||||
digest are inserted into the folder after that message." t nil)
|
||||
|
||||
(autoload (quote mh-copy-msg) "mh-funcs" "\
|
||||
Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
|
||||
Default is the displayed message. If optional prefix argument is provided,
|
||||
then prompt for the message sequence." t nil)
|
||||
|
||||
(autoload (quote mh-kill-folder) "mh-funcs" "\
|
||||
Remove the current folder and all included messages.
|
||||
Removes all of the messages (files) within the specified current folder,
|
||||
and then removes the folder (directory) itself.
|
||||
The value of `mh-folder-list-change-hook' is a list of functions to be called,
|
||||
with no arguments, after the folders has been removed." t nil)
|
||||
|
||||
(autoload (quote mh-list-folders) "mh-funcs" "\
|
||||
List mail folders." t nil)
|
||||
|
||||
(autoload (quote mh-pack-folder) "mh-funcs" "\
|
||||
Renumber the messages of a folder to be 1..n.
|
||||
First, offer to execute any outstanding commands for the current folder. If
|
||||
optional prefix argument provided, prompt for the RANGE of messages to display
|
||||
after packing. Otherwise, show the entire folder." t nil)
|
||||
|
||||
(autoload (quote mh-pipe-msg) "mh-funcs" "\
|
||||
Pipe the current message through the given shell COMMAND.
|
||||
If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
|
||||
Otherwise just send the message's body without the headers." t nil)
|
||||
|
||||
(autoload (quote mh-page-digest) "mh-funcs" "\
|
||||
Advance displayed message to next digested message." t nil)
|
||||
|
||||
(autoload (quote mh-page-digest-backwards) "mh-funcs" "\
|
||||
Back up displayed message to previous digested message." t nil)
|
||||
|
||||
(autoload (quote mh-print-msg) "mh-funcs" "\
|
||||
Print MSG-OR-SEQ (default: displayed message) on printer.
|
||||
If optional prefix argument provided, then prompt for the message sequence.
|
||||
The variable `mh-lpr-command-format' is used to generate the print command.
|
||||
The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
|
||||
|
||||
(autoload (quote mh-sort-folder) "mh-funcs" "\
|
||||
Sort the messages in the current folder by date.
|
||||
Calls the MH program sortm to do the work.
|
||||
The arguments in the list `mh-sortm-args' are passed to sortm if the optional
|
||||
argument EXTRA-ARGS is given." t nil)
|
||||
|
||||
(autoload (quote mh-undo-folder) "mh-funcs" "\
|
||||
Undo all pending deletes and refiles in current folder.
|
||||
Argument IGNORE is deprecated." t nil)
|
||||
|
||||
(autoload (quote mh-store-msg) "mh-funcs" "\
|
||||
Store the file(s) contained in the current message into DIRECTORY.
|
||||
The message can contain a shar file or uuencoded file.
|
||||
Default directory is the last directory used, or initially the value of
|
||||
`mh-store-default-directory' or the current directory." t nil)
|
||||
|
||||
(autoload (quote mh-store-buffer) "mh-funcs" "\
|
||||
Store the file(s) contained in the current buffer into DIRECTORY.
|
||||
The buffer can contain a shar file or uuencoded file.
|
||||
Default directory is the last directory used, or initially the value of
|
||||
`mh-store-default-directory' or the current directory." t nil)
|
||||
|
||||
(autoload (quote mh-help) "mh-funcs" "\
|
||||
Display cheat sheet for the MH-Folder commands in minibuffer." t nil)
|
||||
|
||||
(autoload (quote mh-prefix-help) "mh-funcs" "\
|
||||
Display cheat sheet for the commands of the current prefix in minibuffer." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
|
||||
;;;;;; "mh-identity" "mh-identity.el" (15852 60439))
|
||||
;;; Generated autoloads from mh-identity.el
|
||||
|
||||
(autoload (quote mh-identity-make-menu) "mh-identity" "\
|
||||
Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil)
|
||||
|
||||
(autoload (quote mh-identity-list-set) "mh-identity" "\
|
||||
Update the `mh-identity-list' variable, and rebuild the menu.
|
||||
Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
|
||||
customization). This is called after 'customize is used to alter
|
||||
`mh-identity-list'." nil nil)
|
||||
|
||||
(autoload (quote mh-insert-identity) "mh-identity" "\
|
||||
Insert proper fields for given IDENTITY.
|
||||
Edit the `mh-identity-list' variable to define identity." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search
|
||||
;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands
|
||||
;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers
|
||||
;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-search
|
||||
;;;;;; mh-index-update-maps) "mh-index" "mh-index.el" (15899 19358))
|
||||
;;; Generated autoloads from mh-index.el
|
||||
|
||||
(autoload (quote mh-index-update-maps) "mh-index" "\
|
||||
Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
|
||||
As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
|
||||
is a hashtable which maps each message in the index folder to the original
|
||||
folder and message from whence it was copied. If present the
|
||||
checksum -> (origin-folder, origin-index) map is updated too." nil nil)
|
||||
|
||||
(autoload (quote mh-index-search) "mh-index" "\
|
||||
Perform an indexed search in an MH mail folder.
|
||||
|
||||
If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
|
||||
index search, then the search is repeated. Otherwise, FOLDER is searched with
|
||||
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
|
||||
\"+\" then mail in all folders are searched.
|
||||
|
||||
Four indexing programs are supported; if none of these are present, then grep
|
||||
is used. This function picks the first program that is available on your
|
||||
system. If you would prefer to use a different program, set the customization
|
||||
variable `mh-index-program' accordingly.
|
||||
|
||||
The documentation for the following functions describes how to generate the
|
||||
index for each program:
|
||||
|
||||
- `mh-swish++-execute-search'
|
||||
- `mh-swish-execute-search'
|
||||
- `mh-namazu-execute-search'
|
||||
- `mh-glimpse-execute-search'
|
||||
|
||||
This and related functions use an X-MHE-Checksum header to cache the MD5
|
||||
checksum of a message. This means that already present X-MHE-Checksum headers
|
||||
in the incoming email could result in messages not being found. The following
|
||||
procmail recipe should avoid this:
|
||||
|
||||
:0 wf
|
||||
| formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
|
||||
|
||||
This has the effect of renaming already present X-MHE-Checksum headers." t nil)
|
||||
|
||||
(autoload (quote mh-index-next-folder) "mh-index" "\
|
||||
Jump to the next folder marker.
|
||||
The function is only applicable to folders displaying index search results.
|
||||
With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
|
||||
results." t nil)
|
||||
|
||||
(autoload (quote mh-index-previous-folder) "mh-index" "\
|
||||
Jump to the previous folder marker." t nil)
|
||||
|
||||
(autoload (quote mh-index-insert-folder-headers) "mh-index" "\
|
||||
Annotate the search results with original folder names." nil nil)
|
||||
|
||||
(autoload (quote mh-index-delete-folder-headers) "mh-index" "\
|
||||
Delete the folder headers." nil nil)
|
||||
|
||||
(autoload (quote mh-index-visit-folder) "mh-index" "\
|
||||
Visit original folder from where the message at point was found." t nil)
|
||||
|
||||
(autoload (quote mh-index-execute-commands) "mh-index" "\
|
||||
Delete/refile the actual messages.
|
||||
The copies in the searched folder are then deleted/refiled to get the desired
|
||||
result. Before deleting the messages we make sure that the message being
|
||||
deleted is identical to the one that the user has marked in the index buffer." nil nil)
|
||||
|
||||
(autoload (quote mh-glimpse-execute-search) "mh-index" "\
|
||||
Execute glimpse and read the results.
|
||||
|
||||
In the examples below, replace /home/user/Mail with the path to your MH
|
||||
directory.
|
||||
|
||||
First create the directory /home/user/Mail/.glimpse. Then create the file
|
||||
/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
|
||||
|
||||
*/.*
|
||||
*/#*
|
||||
*/,*
|
||||
*/*~
|
||||
^/home/user/Mail/.glimpse
|
||||
^/home/user/Mail/mhe-index
|
||||
|
||||
If there are any directories you would like to ignore, append lines like the
|
||||
following to .glimpse_exclude:
|
||||
|
||||
^/home/user/Mail/scripts
|
||||
|
||||
You do not want to index the folders that hold the results of your searches
|
||||
since they tend to be ephemeral and the original messages are indexed anyway.
|
||||
The configuration file above assumes that the results are found in sub-folders
|
||||
of `mh-index-folder' which is +mhe-index by default.
|
||||
|
||||
Use the following command line to generate the glimpse index. Run this
|
||||
daily from cron:
|
||||
|
||||
glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
|
||||
|
||||
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
|
||||
|
||||
(autoload (quote mh-swish-execute-search) "mh-index" "\
|
||||
Execute swish-e and read the results.
|
||||
|
||||
In the examples below, replace /home/user/Mail with the path to your MH
|
||||
directory.
|
||||
|
||||
First create the directory /home/user/Mail/.swish. Then create the file
|
||||
/home/user/Mail/.swish/config with the following contents:
|
||||
|
||||
IndexDir /home/user/Mail
|
||||
IndexFile /home/user/Mail/.swish/index
|
||||
IndexName \"Mail Index\"
|
||||
IndexDescription \"Mail Index\"
|
||||
IndexPointer \"http://nowhere\"
|
||||
IndexAdmin \"nobody\"
|
||||
#MetaNames automatic
|
||||
IndexReport 3
|
||||
FollowSymLinks no
|
||||
UseStemming no
|
||||
IgnoreTotalWordCountWhenRanking yes
|
||||
WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
|
||||
BeginCharacters abcdefghijklmnopqrstuvwxyz
|
||||
EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
|
||||
IgnoreLimit 50 1000
|
||||
IndexComments 0
|
||||
FileRules pathname contains /home/user/Mail/.swish
|
||||
FileRules pathname contains /home/user/Mail/mhe-index
|
||||
FileRules filename is index
|
||||
FileRules filename is ..*
|
||||
FileRules filename is #.*
|
||||
FileRules filename is ,.*
|
||||
FileRules filename is .*~
|
||||
|
||||
If there are any directories you would like to ignore, append lines like the
|
||||
following to config:
|
||||
|
||||
FileRules pathname contains /home/user/Mail/scripts
|
||||
|
||||
You do not want to index the folders that hold the results of your searches
|
||||
since they tend to be ephemeral and the original messages are indexed anyway.
|
||||
The configuration file above assumes that the results are found in sub-folders
|
||||
of `mh-index-folder' which is +mhe-index by default.
|
||||
|
||||
Use the following command line to generate the swish index. Run this
|
||||
daily from cron:
|
||||
|
||||
swish-e -c /home/user/Mail/.swish/config
|
||||
|
||||
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
|
||||
|
||||
(autoload (quote mh-swish++-execute-search) "mh-index" "\
|
||||
Execute swish++ and read the results.
|
||||
|
||||
In the examples below, replace /home/user/Mail with the path to your MH
|
||||
directory.
|
||||
|
||||
First create the directory /home/user/Mail/.swish++. Then create the file
|
||||
/home/user/Mail/.swish++/swish++.conf with the following contents:
|
||||
|
||||
IncludeMeta Bcc Cc Comments Content-Description From Keywords
|
||||
IncludeMeta Newsgroups Resent-To Subject To
|
||||
IncludeMeta Message-Id References In-Reply-To
|
||||
IncludeFile Mail *
|
||||
IndexFile /home/user/Mail/.swish++/swish++.index
|
||||
|
||||
Use the following command line to generate the swish index. Run this
|
||||
daily from cron:
|
||||
|
||||
find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
|
||||
-o -path /home/user/Mail/.swish++ -prune \\
|
||||
-o -name \"[0-9]*\" -print \\
|
||||
| index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
|
||||
|
||||
You do not want to index the folders that hold the results of your searches
|
||||
since they tend to be ephemeral and the original messages are indexed anyway.
|
||||
The command above assumes that the results are found in sub-folders of
|
||||
`mh-index-folder' which is +mhe-index by default.
|
||||
|
||||
On some systems (Debian GNU/Linux, for example), use index++ instead of index.
|
||||
|
||||
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
|
||||
|
||||
(autoload (quote mh-namazu-execute-search) "mh-index" "\
|
||||
Execute namazu and read the results.
|
||||
|
||||
In the examples below, replace /home/user/Mail with the path to your MH
|
||||
directory.
|
||||
|
||||
First create the directory /home/user/Mail/.namazu. Then create the file
|
||||
/home/user/Mail/.namazu/mknmzrc with the following contents:
|
||||
|
||||
package conf; # Don't remove this line!
|
||||
$ADDRESS = 'user@localhost';
|
||||
$ALLOW_FILE = \"[0-9]*\";
|
||||
$EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
|
||||
|
||||
In the above example configuration, none of the mail files contained in the
|
||||
directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
|
||||
|
||||
You do not want to index the folders that hold the results of your searches
|
||||
since they tend to be ephemeral and the original messages are indexed anyway.
|
||||
The configuration file above assumes that the results are found in sub-folders
|
||||
of `mh-index-folder' which is +mhe-index by default.
|
||||
|
||||
Use the following command line to generate the namazu index. Run this
|
||||
daily from cron:
|
||||
|
||||
mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
|
||||
/home/user/Mail
|
||||
|
||||
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
|
||||
;;;;;; mh-press-button mh-mime-display mh-mime-save-parts mh-display-emphasis
|
||||
;;;;;; mh-display-smileys mh-add-missing-mime-version-header mh-destroy-postponed-handles
|
||||
;;;;;; mh-mime-cleanup mh-mml-secure-message-encrypt-pgpmime mh-mml-secure-message-sign-pgpmime
|
||||
;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime
|
||||
;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
|
||||
;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
|
||||
;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15858 6046))
|
||||
;;; Generated autoloads from mh-mime.el
|
||||
|
||||
(autoload (quote mh-compose-insertion) "mh-mime" "\
|
||||
Add a directive to insert a MIME part from a file, using mhn or gnus.
|
||||
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
|
||||
If it is set to 'gnus, then that will be used instead.
|
||||
Optional argument INLINE means make it an inline attachment." t nil)
|
||||
|
||||
(autoload (quote mh-compose-forward) "mh-mime" "\
|
||||
Add a MIME directive to forward a message, using mhn or gnus.
|
||||
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
|
||||
If it is set to 'gnus, then that will be used instead.
|
||||
Optional argument DESCRIPTION is a description of the attachment.
|
||||
Optional argument FOLDER is the folder from which the forwarded message should
|
||||
come.
|
||||
Optional argument MESSAGE is the message to forward.
|
||||
If any of the optional arguments are absent, they are prompted for." t nil)
|
||||
|
||||
(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\
|
||||
Add a directive to insert a MIME message part from a file.
|
||||
This is the typical way to insert non-text parts in a message.
|
||||
|
||||
Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
|
||||
content type, DESCRIPTION, a line of text for the Content-Description field.
|
||||
ATTRIBUTES is a comma separated list of name=value pairs that is appended to
|
||||
the Content-Type field of the attachment.
|
||||
|
||||
See also \\[mh-edit-mhn]." t nil)
|
||||
|
||||
(autoload (quote mh-mhn-compose-anon-ftp) "mh-mime" "\
|
||||
Add a directive for a MIME anonymous ftp external body part.
|
||||
This directive tells MH to include a reference to a message/external-body part
|
||||
retrievable by anonymous FTP.
|
||||
|
||||
Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
|
||||
MIME content type, and DESCRIPTION, a line of text for the Content-description
|
||||
header.
|
||||
|
||||
See also \\[mh-edit-mhn]." t nil)
|
||||
|
||||
(autoload (quote mh-mhn-compose-external-compressed-tar) "mh-mime" "\
|
||||
Add a directive to include a MIME reference to a compressed tar file.
|
||||
The file should be available via anonymous ftp. This directive tells MH to
|
||||
include a reference to a message/external-body part.
|
||||
|
||||
Arguments are HOST and FILENAME, which tell where to find the file, and
|
||||
DESCRIPTION, a line of text for the Content-description header.
|
||||
|
||||
See also \\[mh-edit-mhn]." t nil)
|
||||
|
||||
(autoload (quote mh-mhn-compose-forw) "mh-mime" "\
|
||||
Add a forw directive to this message, to forward a message with MIME.
|
||||
This directive tells MH to include the named messages in this one.
|
||||
|
||||
Arguments are DESCRIPTION, a line of text for the Content-description header,
|
||||
and FOLDER and MESSAGES, which name the message(s) to be forwarded.
|
||||
|
||||
See also \\[mh-edit-mhn]." t nil)
|
||||
|
||||
(autoload (quote mh-edit-mhn) "mh-mime" "\
|
||||
Format the current draft for MIME, expanding any mhn directives.
|
||||
|
||||
Process the current draft with the mhn program, which, using directives
|
||||
already inserted in the draft, fills in all the MIME components and header
|
||||
fields.
|
||||
|
||||
This step should be done last just before sending the message.
|
||||
|
||||
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
|
||||
list `mh-mhn-args' are passed to mhn if this function is passed an optional
|
||||
prefix argument EXTRA-ARGS.
|
||||
|
||||
For assistance with creating mhn directives to insert various types of
|
||||
components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
|
||||
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
|
||||
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] (reference to
|
||||
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
|
||||
message). If these helper functions are used, `mh-edit-mhn' is run
|
||||
automatically when the draft is sent.
|
||||
|
||||
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
|
||||
arguments, after performing the conversion.
|
||||
|
||||
The mhn program is part of MH version 6.8 or later." t nil)
|
||||
|
||||
(autoload (quote mh-revert-mhn-edit) "mh-mime" "\
|
||||
Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
|
||||
Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil)
|
||||
|
||||
(autoload (quote mh-mml-to-mime) "mh-mime" "\
|
||||
Compose MIME message from mml directives." t nil)
|
||||
|
||||
(autoload (quote mh-mml-forward-message) "mh-mime" "\
|
||||
Forward a message as attachment.
|
||||
The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
|
||||
number." nil nil)
|
||||
|
||||
(autoload (quote mh-mml-attach-file) "mh-mime" "\
|
||||
Attach a file to the outgoing MIME message.
|
||||
The file is not inserted or encoded until you send the message with
|
||||
`\\[mh-send-letter]'.
|
||||
Message disposition is \"inline\" or \"attachment\" and is prompted for if
|
||||
DISPOSITION is nil.
|
||||
|
||||
This is basically `mml-attach-file' from gnus, modified such that a prefix
|
||||
argument yields an `inline' disposition and Content-Type is determined
|
||||
automatically." nil nil)
|
||||
|
||||
(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\
|
||||
Add directive to encrypt/sign the entire message." t nil)
|
||||
|
||||
(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\
|
||||
Add directive to encrypt and sign the entire message.
|
||||
If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil)
|
||||
|
||||
(autoload (quote mh-mime-cleanup) "mh-mime" "\
|
||||
Free the decoded MIME parts." nil nil)
|
||||
|
||||
(autoload (quote mh-destroy-postponed-handles) "mh-mime" "\
|
||||
Free MIME data for externally displayed mime parts." nil nil)
|
||||
|
||||
(autoload (quote mh-add-missing-mime-version-header) "mh-mime" "\
|
||||
Some mail programs don't put a MIME-Version header.
|
||||
I have seen this only in spam, so maybe we shouldn't fix this ;-)" nil nil)
|
||||
|
||||
(autoload (quote mh-display-smileys) "mh-mime" "\
|
||||
Function to display smileys." nil nil)
|
||||
|
||||
(autoload (quote mh-display-emphasis) "mh-mime" "\
|
||||
Function to display graphical emphasis." nil nil)
|
||||
|
||||
(autoload (quote mh-mime-save-parts) "mh-mime" "\
|
||||
Store the MIME parts of the current message.
|
||||
If ARG, prompt for directory, else use that specified by the variable
|
||||
`mh-mime-save-parts-default-directory'. These directories may be superseded by
|
||||
mh_profile directives, since this function calls on mhstore or mhn to do the
|
||||
actual storing." t nil)
|
||||
|
||||
(autoload (quote mh-mime-display) "mh-mime" "\
|
||||
Display (and possibly decode) MIME handles.
|
||||
Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
|
||||
present they are displayed otherwise the buffer is parsed and then
|
||||
displayed." nil nil)
|
||||
|
||||
(autoload (quote mh-press-button) "mh-mime" "\
|
||||
Press MIME button.
|
||||
If the MIME part is visible then it is removed. Otherwise the part is
|
||||
displayed." t nil)
|
||||
|
||||
(autoload (quote mh-push-button) "mh-mime" "\
|
||||
Click MIME button for EVENT.
|
||||
If the MIME part is visible then it is removed. Otherwise the part is
|
||||
displayed. This function is called when the mouse is used to click the MIME
|
||||
button." t nil)
|
||||
|
||||
(autoload (quote mh-mime-save-part) "mh-mime" "\
|
||||
Save MIME part at point." t nil)
|
||||
|
||||
(autoload (quote mh-mime-inline-part) "mh-mime" "\
|
||||
Toggle display of the raw MIME part." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-do-pick-search mh-search-folder) "mh-pick"
|
||||
;;;;;; "mh-pick.el" (15854 20166))
|
||||
;;; Generated autoloads from mh-pick.el
|
||||
|
||||
(autoload (quote mh-search-folder) "mh-pick" "\
|
||||
Search FOLDER for messages matching a pattern.
|
||||
This function uses the MH command `pick' to do the work.
|
||||
Add the messages found to the sequence named `search'." t nil)
|
||||
|
||||
(autoload (quote mh-do-pick-search) "mh-pick" "\
|
||||
Find messages that match the qualifications in the current pattern buffer.
|
||||
Messages are searched for in the folder named in `mh-searching-folder'.
|
||||
Add the messages found to the sequence named `search'." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor
|
||||
;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message
|
||||
;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
|
||||
;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list
|
||||
;;;;;; mh-add-to-sequence mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
|
||||
;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
|
||||
;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (15899
|
||||
;;;;;; 19358))
|
||||
;;; Generated autoloads from mh-seq.el
|
||||
|
||||
(autoload (quote mh-delete-seq) "mh-seq" "\
|
||||
Delete the SEQUENCE." t nil)
|
||||
|
||||
(autoload (quote mh-list-sequences) "mh-seq" "\
|
||||
List the sequences defined in the folder being visited." t nil)
|
||||
|
||||
(autoload (quote mh-msg-is-in-seq) "mh-seq" "\
|
||||
Display the sequences that contain MESSAGE (default: current message)." t nil)
|
||||
|
||||
(autoload (quote mh-narrow-to-seq) "mh-seq" "\
|
||||
Restrict display of this folder to just messages in SEQUENCE.
|
||||
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
|
||||
|
||||
(autoload (quote mh-put-msg-in-seq) "mh-seq" "\
|
||||
Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
|
||||
If optional prefix argument provided, then prompt for the message sequence.
|
||||
If variable `transient-mark-mode' is non-nil and the mark is active, then
|
||||
the selected region is added to the sequence." t nil)
|
||||
|
||||
(autoload (quote mh-widen) "mh-seq" "\
|
||||
Remove restrictions from current folder, thereby showing all messages." t nil)
|
||||
|
||||
(autoload (quote mh-rename-seq) "mh-seq" "\
|
||||
Rename SEQUENCE to have NEW-NAME." t nil)
|
||||
|
||||
(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\
|
||||
Invoke the FUNC at each message in the SEQ.
|
||||
SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
|
||||
passed as arguments to FUNC." nil nil)
|
||||
|
||||
(autoload (quote mh-notate-seq) "mh-seq" "\
|
||||
Mark the scan listing.
|
||||
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
|
||||
the line." nil nil)
|
||||
|
||||
(autoload (quote mh-add-to-sequence) "mh-seq" "\
|
||||
The sequence SEQ is augmented with the messages in MSGS." nil nil)
|
||||
|
||||
(autoload (quote mh-region-to-msg-list) "mh-seq" "\
|
||||
Return a list of messages within the region between BEGIN and END." nil nil)
|
||||
|
||||
(autoload (quote mh-narrow-to-subject) "mh-seq" "\
|
||||
Narrow to a sequence containing all following messages with same subject." t nil)
|
||||
|
||||
(autoload (quote mh-delete-subject) "mh-seq" "\
|
||||
Mark all following messages with same subject to be deleted.
|
||||
This puts the messages in a sequence named subject. You can undo the last
|
||||
deletion marks using `mh-undo' with a prefix argument and then specifying the
|
||||
subject sequence." t nil)
|
||||
|
||||
(autoload (quote mh-delete-subject-or-thread) "mh-seq" "\
|
||||
Mark messages for deletion intelligently.
|
||||
If the folder is threaded then `mh-thread-delete' is used to mark the current
|
||||
message and all its descendants for deletion. Otherwise `mh-delete-subject' is
|
||||
used to mark the current message and all messages following it with the same
|
||||
subject for deletion." t nil)
|
||||
|
||||
(autoload (quote mh-thread-inc) "mh-seq" "\
|
||||
Update thread tree for FOLDER.
|
||||
All messages after START-POINT are added to the thread tree." nil nil)
|
||||
|
||||
(autoload (quote mh-thread-add-spaces) "mh-seq" "\
|
||||
Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
|
||||
|
||||
(autoload (quote mh-toggle-threads) "mh-seq" "\
|
||||
Toggle threaded view of folder.
|
||||
The conversion of normal view to threaded view is exact, that is the same
|
||||
messages are displayed in the folder buffer before and after threading. However
|
||||
the conversion from threaded view to normal view is inexact. So more messages
|
||||
than were originally present may be shown as a result." t nil)
|
||||
|
||||
(autoload (quote mh-thread-forget-message) "mh-seq" "\
|
||||
Forget the message INDEX from the threading tables." nil nil)
|
||||
|
||||
(autoload (quote mh-thread-next-sibling) "mh-seq" "\
|
||||
Jump to next sibling.
|
||||
With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." t nil)
|
||||
|
||||
(autoload (quote mh-thread-previous-sibling) "mh-seq" "\
|
||||
Jump to previous sibling." t nil)
|
||||
|
||||
(autoload (quote mh-thread-ancestor) "mh-seq" "\
|
||||
Jump to the ancestor of current message.
|
||||
If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
|
||||
thread tree the message belongs to." t nil)
|
||||
|
||||
(autoload (quote mh-thread-delete) "mh-seq" "\
|
||||
Mark current message and all its children for subsequent deletion." t nil)
|
||||
|
||||
(autoload (quote mh-thread-refile) "mh-seq" "\
|
||||
Mark current message and all its children for refiling to FOLDER." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
|
||||
;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
|
||||
;;;;;; "mh-speed" "mh-speed.el" (15899 19358))
|
||||
;;; Generated autoloads from mh-speed.el
|
||||
|
||||
(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
|
||||
Interface function to create MH-E speedbar buffer.
|
||||
BUFFER is the MH-E buffer for which the speedbar buffer is to be created." nil nil)
|
||||
|
||||
(defalias (quote mh-show-speedbar-buttons) (quote mh-folder-speedbar-buttons))
|
||||
|
||||
(defalias (quote mh-letter-speedbar-buttons) (quote mh-folder-speedbar-buttons))
|
||||
|
||||
(autoload (quote mh-speed-toggle) "mh-speed" "\
|
||||
Toggle the display of child folders.
|
||||
The otional ARGS are ignored and there for compatibilty with speedbar." t nil)
|
||||
|
||||
(autoload (quote mh-speed-view) "mh-speed" "\
|
||||
View folder on current line.
|
||||
Optional ARGS are ignored." t nil)
|
||||
|
||||
(autoload (quote mh-speed-flists) "mh-speed" "\
|
||||
Execute flists -recurse and update message counts.
|
||||
If FORCE is non-nil the timer is reset." t nil)
|
||||
|
||||
(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
|
||||
Remove FOLDER from various optimization caches." t nil)
|
||||
|
||||
(autoload (quote mh-speed-add-folder) "mh-speed" "\
|
||||
Add FOLDER since it is being created.
|
||||
The function invalidates the latest ancestor that is present." nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
|
||||
;;;;;; "mh-utils" "mh-utils.el" (15899 28827))
|
||||
;;; Generated autoloads from mh-utils.el
|
||||
|
||||
(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
|
||||
Find e-mail address around or before point.
|
||||
Then search backwards to beginning of line for the start of an e-mail
|
||||
address. If no e-mail address found, return nil." nil nil)
|
||||
|
||||
(autoload (quote mh-get-msg-num) "mh-utils" "\
|
||||
Return the message number of the displayed message.
|
||||
If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
|
||||
not pointing to a message." nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field
|
||||
;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-letter-expand-alias
|
||||
;;;;;; mh-alias-minibuffer-confirm-address mh-read-address mh-alias-reload)
|
||||
;;;;;; "mh-alias" "mh-alias.el" (15899 29102))
|
||||
;;; Generated autoloads from mh-alias.el
|
||||
|
||||
(autoload (quote mh-alias-reload) "mh-alias" "\
|
||||
Load MH aliases into `mh-alias-alist'." t nil)
|
||||
|
||||
(autoload (quote mh-read-address) "mh-alias" "\
|
||||
Read an address from the minibuffer with PROMPT." nil nil)
|
||||
|
||||
(autoload (quote mh-alias-minibuffer-confirm-address) "mh-alias" "\
|
||||
Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." t nil)
|
||||
|
||||
(autoload (quote mh-alias-letter-expand-alias) "mh-alias" "\
|
||||
Expand mail alias before point." nil nil)
|
||||
|
||||
(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
|
||||
Return t is From has no current alias set." nil nil)
|
||||
|
||||
(autoload (quote mh-alias-add-alias) "mh-alias" "\
|
||||
*Add ALIAS for ADDRESS in personal alias file.
|
||||
Prompts for confirmation if the address already has an alias.
|
||||
If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil)
|
||||
|
||||
(autoload (quote mh-alias-grab-from-field) "mh-alias" "\
|
||||
*Add ALIAS for ADDRESS in personal alias file.
|
||||
Prompts for confirmation if the alias is already in use or if the address
|
||||
already has an alias." t nil)
|
||||
|
||||
(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
|
||||
Insert an alias for email address under point." t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
(provide 'mh-loaddefs)
|
||||
;;; Local Variables:
|
||||
;;; version-control: never
|
||||
;;; no-byte-compile: t
|
||||
;;; no-update-autoloads: t
|
||||
;;; End:
|
||||
;;; mh-loaddefs.el ends here
|
||||
|
|
@ -32,17 +32,17 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-mime.el,v 1.90 2002/11/22 20:00:48 satyaki Exp $
|
||||
;; $Id: mh-mime.el,v 1.98 2002/12/06 03:33:47 satyaki Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
(require 'mh-comp)
|
||||
(require 'mh-utils)
|
||||
(load "mm-decode" t t) ; Non-fatal dependency
|
||||
(load "mm-uu" t t) ; Non-fatal dependency
|
||||
(load "mailcap" t t) ; Non-fatal dependency
|
||||
(load "smiley" t t) ; Non-fatal dependency
|
||||
(load "mm-decode" t t) ; Non-fatal dependency
|
||||
(load "mm-uu" t t) ; Non-fatal dependency
|
||||
(load "mailcap" t t) ; Non-fatal dependency
|
||||
(load "smiley" t t) ; Non-fatal dependency
|
||||
(require 'gnus-util)
|
||||
|
||||
(autoload 'gnus-article-goto-header "gnus-art")
|
||||
|
|
@ -59,29 +59,7 @@
|
|||
(autoload 'mml-to-mime "mml")
|
||||
(autoload 'mml-attach-file "mml")
|
||||
|
||||
;;; Hooks
|
||||
(defcustom mh-edit-mhn-hook nil
|
||||
"Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]."
|
||||
:type 'hook
|
||||
:group 'mh-hook)
|
||||
|
||||
;; Keeps assorted MIME data
|
||||
(defstruct (mh-buffer-data (:conc-name mh-mime-)
|
||||
(:constructor mh-make-buffer-data))
|
||||
;; Structure to keep track of MIME handles on a per buffer basis.
|
||||
(handles ()) ; List of MIME handles
|
||||
(handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of
|
||||
; nested messages
|
||||
(parts-count 0) ; The button number is generated from
|
||||
; this number
|
||||
(part-index-hash (make-hash-table))) ; Avoid incrementing the part number
|
||||
; for nested messages
|
||||
|
||||
;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...)
|
||||
(defmacro mh-buffer-data ()
|
||||
"Convenience macro to get the MIME data structures of the current buffer."
|
||||
`(gethash (current-buffer) mh-globals-hash))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-compose-insertion (&optional inline)
|
||||
"Add a directive to insert a MIME part from a file, using mhn or gnus.
|
||||
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
|
||||
|
|
@ -94,6 +72,7 @@ Optional argument INLINE means make it an inline attachment."
|
|||
(mh-mml-attach-file))
|
||||
(call-interactively 'mh-mhn-compose-insertion)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-compose-forward (&optional description folder message)
|
||||
"Add a MIME directive to forward a message, using mhn or gnus.
|
||||
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
|
||||
|
|
@ -104,12 +83,12 @@ come.
|
|||
Optional argument MESSAGE is the message to forward.
|
||||
If any of the optional arguments are absent, they are prompted for."
|
||||
(interactive (list
|
||||
(read-string "Forw Content-description: ")
|
||||
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
|
||||
(read-string (format "Messages%s: "
|
||||
(if mh-sent-from-msg
|
||||
(read-string "Forw Content-description: ")
|
||||
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
|
||||
(read-string (format "Messages%s: "
|
||||
(if mh-sent-from-msg
|
||||
(format " [%d]" mh-sent-from-msg)
|
||||
"")))))
|
||||
"")))))
|
||||
(if (equal mh-compose-insertion 'gnus)
|
||||
(mh-mml-forward-message description folder message)
|
||||
(mh-mhn-compose-forw description folder message)))
|
||||
|
|
@ -117,7 +96,7 @@ If any of the optional arguments are absent, they are prompted for."
|
|||
;; To do:
|
||||
;; paragraph code should not fill # lines if MIME enabled.
|
||||
;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
|
||||
;; invokes mh-edit-mhn automatically before sending.)
|
||||
;; invokes mh-edit-mhn automatically before sending.)
|
||||
;; actually, instead of mh-auto-edit-mhn,
|
||||
;; should read automhnproc from profile
|
||||
;; MIME option to mh-forward
|
||||
|
|
@ -143,7 +122,7 @@ MH profile.")
|
|||
"Return t if 'file' command is on the system.
|
||||
'file -i' is used to get MIME type of composition insertion."
|
||||
(when (not (boundp 'mh-have-file-command))
|
||||
(load "executable" t t) ; executable-find not autoloaded in emacs20
|
||||
(load "executable" t t) ; executable-find not autoloaded in emacs20
|
||||
(setq mh-have-file-command
|
||||
(and (fboundp 'executable-find)
|
||||
(executable-find "file") ; file command exists
|
||||
|
|
@ -223,6 +202,7 @@ Returns nil if file command not on system."
|
|||
"Legal MIME content types.
|
||||
See documentation for \\[mh-edit-mhn].")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mhn-compose-insertion (filename type description attributes)
|
||||
"Add a directive to insert a MIME message part from a file.
|
||||
This is the typical way to insert non-text parts in a message.
|
||||
|
|
@ -234,22 +214,22 @@ the Content-Type field of the attachment.
|
|||
|
||||
See also \\[mh-edit-mhn]."
|
||||
(interactive (let ((filename (read-file-name "Insert contents of: ")))
|
||||
(list
|
||||
filename
|
||||
(list
|
||||
filename
|
||||
(or (mh-file-mime-type filename)
|
||||
(completing-read "Content-Type: "
|
||||
(if (fboundp 'mailcap-mime-types)
|
||||
(mapcar 'list (mailcap-mime-types))
|
||||
mh-mime-content-types)))
|
||||
(read-string "Content-Description: ")
|
||||
(read-string "Content-Attributes: "
|
||||
(concat "name=\""
|
||||
(file-name-nondirectory filename)
|
||||
"\"")))))
|
||||
(completing-read "Content-Type: "
|
||||
(if (fboundp 'mailcap-mime-types)
|
||||
(mapcar 'list (mailcap-mime-types))
|
||||
mh-mime-content-types)))
|
||||
(read-string "Content-Description: ")
|
||||
(read-string "Content-Attributes: "
|
||||
(concat "name=\""
|
||||
(file-name-nondirectory filename)
|
||||
"\"")))))
|
||||
(mh-mhn-compose-type filename type description attributes ))
|
||||
|
||||
(defun mh-mhn-compose-type (filename type
|
||||
&optional description attributes comment)
|
||||
&optional description attributes comment)
|
||||
"Insert a mhn directive to insert a file.
|
||||
|
||||
The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
|
||||
|
|
@ -269,6 +249,7 @@ optional COMMENT can also be included."
|
|||
(insert "\n"))
|
||||
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mhn-compose-anon-ftp (host filename type description)
|
||||
"Add a directive for a MIME anonymous ftp external body part.
|
||||
This directive tells MH to include a reference to a message/external-body part
|
||||
|
|
@ -280,16 +261,17 @@ header.
|
|||
|
||||
See also \\[mh-edit-mhn]."
|
||||
(interactive (list
|
||||
(read-string "Remote host: ")
|
||||
(read-string "Remote filename: ")
|
||||
(completing-read "External Content-Type: "
|
||||
(if (fboundp 'mailcap-mime-types)
|
||||
(mapcar 'list (mailcap-mime-types))
|
||||
mh-mime-content-types))
|
||||
(read-string "External Content-Description: ")))
|
||||
(read-string "Remote host: ")
|
||||
(read-string "Remote filename: ")
|
||||
(completing-read "External Content-Type: "
|
||||
(if (fboundp 'mailcap-mime-types)
|
||||
(mapcar 'list (mailcap-mime-types))
|
||||
mh-mime-content-types))
|
||||
(read-string "External Content-Description: ")))
|
||||
(mh-mhn-compose-external-type "anon-ftp" host filename
|
||||
type description))
|
||||
type description))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mhn-compose-external-compressed-tar (host filename description)
|
||||
"Add a directive to include a MIME reference to a compressed tar file.
|
||||
The file should be available via anonymous ftp. This directive tells MH to
|
||||
|
|
@ -300,19 +282,20 @@ DESCRIPTION, a line of text for the Content-description header.
|
|||
|
||||
See also \\[mh-edit-mhn]."
|
||||
(interactive (list
|
||||
(read-string "Remote host: ")
|
||||
(read-string "Remote filename: ")
|
||||
(read-string "Tar file Content-description: ")))
|
||||
(read-string "Remote host: ")
|
||||
(read-string "Remote filename: ")
|
||||
(read-string "Tar file Content-description: ")))
|
||||
(mh-mhn-compose-external-type "anon-ftp" host filename
|
||||
"application/octet-stream"
|
||||
description
|
||||
"type=tar; conversions=x-compress"
|
||||
"mode=image"))
|
||||
"application/octet-stream"
|
||||
description
|
||||
"type=tar; conversions=x-compress"
|
||||
"mode=image"))
|
||||
|
||||
|
||||
(defun mh-mhn-compose-external-type (access-type host filename type
|
||||
&optional description
|
||||
attributes extra-params comment)
|
||||
&optional description
|
||||
attributes extra-params
|
||||
comment)
|
||||
"Add a directive to include a MIME reference to a remote file.
|
||||
The file should be available via anonymous ftp. This directive tells MH to
|
||||
include a reference to a message/external-body part.
|
||||
|
|
@ -342,6 +325,7 @@ See also \\[mh-edit-mhn]."
|
|||
(insert "; " extra-params))
|
||||
(insert "\n"))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mhn-compose-forw (&optional description folder messages)
|
||||
"Add a forw directive to this message, to forward a message with MIME.
|
||||
This directive tells MH to include the named messages in this one.
|
||||
|
|
@ -351,12 +335,12 @@ and FOLDER and MESSAGES, which name the message(s) to be forwarded.
|
|||
|
||||
See also \\[mh-edit-mhn]."
|
||||
(interactive (list
|
||||
(read-string "Forw Content-description: ")
|
||||
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
|
||||
(read-string (format "Messages%s: "
|
||||
(if mh-sent-from-msg
|
||||
(format " [%d]" mh-sent-from-msg)
|
||||
"")))))
|
||||
(read-string "Forw Content-description: ")
|
||||
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
|
||||
(read-string (format "Messages%s: "
|
||||
(if mh-sent-from-msg
|
||||
(format " [%d]" mh-sent-from-msg)
|
||||
"")))))
|
||||
(setq mh-mhn-compose-insert-flag t)
|
||||
(beginning-of-line)
|
||||
(insert "#forw [")
|
||||
|
|
@ -368,14 +352,15 @@ See also \\[mh-edit-mhn]."
|
|||
(not (string= folder ""))
|
||||
(insert " " folder))
|
||||
(if (and messages
|
||||
(not (string= messages "")))
|
||||
(not (string= messages "")))
|
||||
(let ((start (point)))
|
||||
(insert " " messages)
|
||||
(subst-char-in-region start (point) ?, ? ))
|
||||
(insert " " messages)
|
||||
(subst-char-in-region start (point) ?, ? ))
|
||||
(if mh-sent-from-msg
|
||||
(insert " " (int-to-string mh-sent-from-msg))))
|
||||
(insert " " (int-to-string mh-sent-from-msg))))
|
||||
(insert "\n"))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-edit-mhn (&optional extra-args)
|
||||
"Format the current draft for MIME, expanding any mhn directives.
|
||||
|
||||
|
|
@ -416,6 +401,7 @@ The mhn program is part of MH version 6.8 or later."
|
|||
(message "mhn editing...done")
|
||||
(run-hooks 'mh-edit-mhn-hook))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-revert-mhn-edit (noconfirm)
|
||||
"Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
|
||||
Optional non-nil argument NOCONFIRM means don't ask for confirmation."
|
||||
|
|
@ -423,21 +409,21 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
|
|||
(if (null buffer-file-name)
|
||||
(error "Buffer does not seem to be associated with any file"))
|
||||
(let ((backup-strings '("," "#"))
|
||||
backup-file)
|
||||
backup-file)
|
||||
(while (and backup-strings
|
||||
(not (file-exists-p
|
||||
(setq backup-file
|
||||
(concat (file-name-directory buffer-file-name)
|
||||
(car backup-strings)
|
||||
(file-name-nondirectory buffer-file-name)
|
||||
".orig")))))
|
||||
(not (file-exists-p
|
||||
(setq backup-file
|
||||
(concat (file-name-directory buffer-file-name)
|
||||
(car backup-strings)
|
||||
(file-name-nondirectory buffer-file-name)
|
||||
".orig")))))
|
||||
(setq backup-strings (cdr backup-strings)))
|
||||
(or backup-strings
|
||||
(error "Backup file for %s no longer exists!" buffer-file-name))
|
||||
(error "Backup file for %s no longer exists!" buffer-file-name))
|
||||
(or noconfirm
|
||||
(yes-or-no-p (format "Revert buffer from file %s? "
|
||||
backup-file))
|
||||
(error "Revert not confirmed"))
|
||||
(yes-or-no-p (format "Revert buffer from file %s? "
|
||||
backup-file))
|
||||
(error "Revert not confirmed"))
|
||||
(let ((buffer-read-only nil))
|
||||
(erase-buffer)
|
||||
(insert-file-contents backup-file))
|
||||
|
|
@ -447,6 +433,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
|
|||
|
||||
;;; MIME composition functions
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mml-to-mime ()
|
||||
"Compose MIME message from mml directives."
|
||||
(interactive)
|
||||
|
|
@ -455,6 +442,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
|
|||
(mml-to-mime)
|
||||
(setq mh-mml-compose-insert-flag nil))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mml-forward-message (description folder message)
|
||||
"Forward a message as attachment.
|
||||
The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
|
||||
|
|
@ -476,6 +464,7 @@ number."
|
|||
(setq mh-mml-compose-insert-flag t))
|
||||
(t (error "The message number, %s is not a integer!" msg)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mml-attach-file (&optional disposition)
|
||||
"Attach a file to the outgoing MIME message.
|
||||
The file is not inserted or encoded until you send the message with
|
||||
|
|
@ -502,6 +491,7 @@ automatically."
|
|||
'disposition dispos 'description description)
|
||||
(setq mh-mml-compose-insert-flag t)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mml-secure-message-sign-pgpmime ()
|
||||
"Add directive to encrypt/sign the entire message."
|
||||
(interactive)
|
||||
|
|
@ -510,6 +500,7 @@ automatically."
|
|||
(mml-secure-message-sign-pgpmime)
|
||||
(setq mh-mml-compose-insert-flag t)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
|
||||
"Add directive to encrypt and sign the entire message.
|
||||
If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
|
||||
|
|
@ -523,54 +514,6 @@ If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
|
|||
|
||||
;;; MIME decoding
|
||||
|
||||
(defcustom mh-graphical-smileys-flag t
|
||||
"*Non-nil means graphical smileys are displayed.
|
||||
Non-nil means that small graphics will be used in the show buffer instead of
|
||||
patterns like :-), ;-) etc. The setting only has effect if
|
||||
`mh-decode-mime-flag' is non-nil."
|
||||
:type 'boolean
|
||||
:group 'mh-buffer)
|
||||
|
||||
(defcustom mh-graphical-emphasis-flag t
|
||||
"*Non-nil means graphical emphasis is displayed.
|
||||
Non-nil means that _underline_ will be underlined, *bold* will appear in bold,
|
||||
/italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole
|
||||
list. The setting only has effect if `mh-decode-mime-flag' is non-nil."
|
||||
:type 'boolean
|
||||
:group 'mh-buffer)
|
||||
|
||||
;; Small image definition
|
||||
(defcustom mh-max-inline-image-width nil
|
||||
"*Maximum inline image width if Content-Disposition is not present.
|
||||
If nil, image will be displayed if its width is smaller than the width of the
|
||||
window."
|
||||
:type '(choice (const nil) integer)
|
||||
:group 'mh-buffer)
|
||||
|
||||
(defcustom mh-max-inline-image-height nil
|
||||
"*Maximum inline image height if Content-Disposition is not present.
|
||||
If nil, image will be displayed if its height is smaller than the height of
|
||||
the window."
|
||||
:type '(choice (const nil) integer)
|
||||
:group 'mh-buffer)
|
||||
|
||||
(defcustom mh-display-buttons-for-inline-parts-flag nil
|
||||
"*Non-nil means display buttons for all inline MIME parts.
|
||||
If non-nil, buttons are displayed for all MIME parts. Inline parts start off
|
||||
in displayed state but they can be hidden by clicking the button. If nil no
|
||||
buttons are shown for inline parts."
|
||||
:type 'boolean
|
||||
:group 'mh-buffer)
|
||||
|
||||
(defcustom mh-mime-save-parts-default-directory t
|
||||
"Default directory to use for `mh-mime-save-parts'.
|
||||
If nil, prompt and set for next time the command is used during same session.
|
||||
If t, prompt always"
|
||||
:type '(choice (const :tag "Prompt the first time" nil)
|
||||
(const :tag "Prompt always" t)
|
||||
directory)
|
||||
:group 'mh)
|
||||
|
||||
(defmacro mh-defun-compat (function arg-list &rest body)
|
||||
"This is a macro to define functions which are not defined.
|
||||
It is used for Gnus utility functions which were added recently. If FUNCTION
|
||||
|
|
@ -579,6 +522,7 @@ BODY."
|
|||
(let ((defined-p (fboundp function)))
|
||||
(unless defined-p
|
||||
`(defun ,function ,arg-list ,@body))))
|
||||
(put 'mh-defun-compat 'lisp-indent-function 'defun)
|
||||
|
||||
;; Copy of original function from gnus-util.el
|
||||
(mh-defun-compat gnus-local-map-property (map)
|
||||
|
|
@ -597,7 +541,7 @@ BODY."
|
|||
;; HANDLE could be a CTL.
|
||||
(if handle
|
||||
(put-text-property 0 (length (car handle)) parameter value
|
||||
(car handle))))
|
||||
(car handle))))
|
||||
|
||||
;; Copy of original macro is in mm-decode.el
|
||||
(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
|
||||
|
|
@ -607,11 +551,11 @@ BODY."
|
|||
(mh-defun-compat mm-readable-p (handle)
|
||||
"Say whether the content of HANDLE is readable."
|
||||
(and (< (with-current-buffer (mm-handle-buffer handle)
|
||||
(buffer-size)) 10000)
|
||||
(buffer-size)) 10000)
|
||||
(mm-with-unibyte-buffer
|
||||
(mm-insert-part handle)
|
||||
(and (eq (mm-body-7-or-8) '7bit)
|
||||
(not (mm-long-lines-p 76))))))
|
||||
(mm-insert-part handle)
|
||||
(and (eq (mm-body-7-or-8) '7bit)
|
||||
(not (mm-long-lines-p 76))))))
|
||||
|
||||
;; Copy of original function in mm-bodies.el
|
||||
(mh-defun-compat mm-long-lines-p (length)
|
||||
|
|
@ -620,11 +564,11 @@ BODY."
|
|||
(goto-char (point-min))
|
||||
(end-of-line)
|
||||
(while (and (not (eobp))
|
||||
(not (> (current-column) length)))
|
||||
(not (> (current-column) length)))
|
||||
(forward-line 1)
|
||||
(end-of-line))
|
||||
(and (> (current-column) length)
|
||||
(current-column))))
|
||||
(current-column))))
|
||||
|
||||
(mh-defun-compat mm-keep-viewer-alive-p (handle)
|
||||
;; Released Gnus doesn't keep handles associated with externally displayed
|
||||
|
|
@ -642,25 +586,26 @@ BODY."
|
|||
(defun mh-mm-save-part (handle)
|
||||
"Write HANDLE to a file."
|
||||
(let ((name (mail-content-type-get (mm-handle-type handle) 'name))
|
||||
(filename (mail-content-type-get
|
||||
(mm-handle-disposition handle) 'filename))
|
||||
file)
|
||||
(filename (mail-content-type-get
|
||||
(mm-handle-disposition handle) 'filename))
|
||||
file)
|
||||
(when filename
|
||||
(setq filename (file-name-nondirectory filename)))
|
||||
(setq file (read-file-name "Save MIME part to: "
|
||||
(or mm-default-directory
|
||||
default-directory)
|
||||
nil nil (or filename name "")))
|
||||
(or mm-default-directory
|
||||
default-directory)
|
||||
nil nil (or filename name "")))
|
||||
(setq mm-default-directory (file-name-directory file))
|
||||
(and (or (not (file-exists-p file))
|
||||
(yes-or-no-p (format "File %s already exists; overwrite? "
|
||||
file)))
|
||||
(mm-save-part-to-file handle file))))
|
||||
(yes-or-no-p (format "File %s already exists; overwrite? "
|
||||
file)))
|
||||
(mm-save-part-to-file handle file))))
|
||||
|
||||
|
||||
|
||||
;;; MIME cleanup
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mime-cleanup ()
|
||||
"Free the decoded MIME parts."
|
||||
(let ((mime-data (gethash (current-buffer) mh-globals-hash)))
|
||||
|
|
@ -671,6 +616,7 @@ BODY."
|
|||
(mm-destroy-parts (mh-mime-handles mime-data))
|
||||
(remhash (current-buffer) mh-globals-hash))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-destroy-postponed-handles ()
|
||||
"Free MIME data for externally displayed mime parts."
|
||||
(let ((mime-data (mh-buffer-data)))
|
||||
|
|
@ -686,8 +632,8 @@ Gnus (as in the original). The MIME part, HANDLE is associated with the
|
|||
undisplayer FUNCTION."
|
||||
(if (mm-keep-viewer-alive-p handle)
|
||||
(let ((new-handle (copy-sequence handle)))
|
||||
(mm-handle-set-undisplayer new-handle function)
|
||||
(mm-handle-set-undisplayer handle nil)
|
||||
(mm-handle-set-undisplayer new-handle function)
|
||||
(mm-handle-set-undisplayer handle nil)
|
||||
(save-excursion
|
||||
(set-buffer folder)
|
||||
(push new-handle (mh-mime-handles (mh-buffer-data)))))
|
||||
|
|
@ -696,7 +642,9 @@ undisplayer FUNCTION."
|
|||
|
||||
|
||||
;;; MIME transformations
|
||||
(eval-when-compile (require 'font-lock))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-add-missing-mime-version-header ()
|
||||
"Some mail programs don't put a MIME-Version header.
|
||||
I have seen this only in spam, so maybe we shouldn't fix this ;-)"
|
||||
|
|
@ -708,15 +656,22 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
|
|||
(forward-line -1)
|
||||
(insert "MIME-Version: 1.0\n")))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-display-smileys ()
|
||||
"Function to display smileys."
|
||||
(when (and mh-graphical-smileys-flag (fboundp 'smiley-region))
|
||||
(when (and mh-graphical-smileys-flag
|
||||
(fboundp 'smiley-region)
|
||||
(boundp 'font-lock-maximum-size)
|
||||
(>= (/ font-lock-maximum-size 8) (buffer-size)))
|
||||
(smiley-region (point-min) (point-max))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-display-emphasis ()
|
||||
"Function to display graphical emphasis."
|
||||
(when mh-graphical-emphasis-flag
|
||||
(flet ((article-goto-body ())) ; shadow this function to do nothing
|
||||
(when (and mh-graphical-emphasis-flag
|
||||
(boundp 'font-lock-maximum-size)
|
||||
(>= (/ font-lock-maximum-size 8) (buffer-size)))
|
||||
(flet ((article-goto-body ())) ; shadow this function to do nothing
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(article-emphasize)))))
|
||||
|
|
@ -760,6 +715,7 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
|
|||
"Default to use for `mh-mime-save-parts-default-directory'.
|
||||
Set from last use.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mime-save-parts (arg)
|
||||
"Store the MIME parts of the current message.
|
||||
If ARG, prompt for directory, else use that specified by the variable
|
||||
|
|
@ -815,6 +771,7 @@ actual storing."
|
|||
(defvar gnus-newsgroup-charset nil)
|
||||
(defvar gnus-newsgroup-name nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mime-display (&optional pre-dissected-handles)
|
||||
"Display (and possibly decode) MIME handles.
|
||||
Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
|
||||
|
|
@ -822,11 +779,12 @@ present they are displayed otherwise the buffer is parsed and then
|
|||
displayed."
|
||||
(let ((handles ())
|
||||
(folder mh-show-folder-buffer))
|
||||
(flet ((mm-handle-set-external-undisplayer (handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
(flet ((mm-handle-set-external-undisplayer
|
||||
(handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
;; If needed dissect the current buffer
|
||||
(if pre-dissected-handles
|
||||
(setq handles pre-dissected-handles)
|
||||
(setq handles pre-dissected-handles)
|
||||
(setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
|
||||
(setf (mh-mime-handles (mh-buffer-data))
|
||||
(mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))))
|
||||
|
|
@ -864,7 +822,7 @@ If no part is preferred then all the parts are displayed."
|
|||
(preferred
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (if (eobp) (point) (1+ (point))))
|
||||
(or (mm-display-part preferred) (mm-display-part preferred))
|
||||
(mh-mime-display-single preferred)
|
||||
(goto-char (point-max))))
|
||||
(t (mh-mime-display-mixed handles)))))
|
||||
|
||||
|
|
@ -883,9 +841,9 @@ opened)."
|
|||
|
||||
;;; Avoid compiler warnings for XEmacs functions...
|
||||
(eval-when (compile)
|
||||
(loop for function in '(glyph-width window-pixel-width
|
||||
glyph-height window-pixel-height)
|
||||
do (or (fboundp function) (defalias function 'ignore))))
|
||||
(loop for function in '(glyph-width window-pixel-width
|
||||
glyph-height window-pixel-height)
|
||||
do (or (fboundp function) (defalias function 'ignore))))
|
||||
|
||||
(defun mh-small-image-p (handle)
|
||||
"Decide whether HANDLE is a \"small\" image that can be displayed inline.
|
||||
|
|
@ -895,9 +853,9 @@ This is only useful if a Content-Disposition header is not present."
|
|||
(mm-inline-large-images t))
|
||||
(and media-test
|
||||
(equal (mm-handle-media-supertype handle) "image")
|
||||
(funcall media-test handle) ; Since mm-inline-large-images is T,
|
||||
; this only tells us if the image is
|
||||
; something that emacs can display
|
||||
(funcall media-test handle) ; Since mm-inline-large-images is T,
|
||||
; this only tells us if the image is
|
||||
; something that emacs can display
|
||||
(let* ((image (mm-get-image handle)))
|
||||
(cond ((fboundp 'glyph-width)
|
||||
;; XEmacs -- totally untested, copied from gnus
|
||||
|
|
@ -919,6 +877,17 @@ This is only useful if a Content-Disposition header is not present."
|
|||
;; Can't show image inline
|
||||
nil))))))
|
||||
|
||||
(defun mh-inline-vcard-p (handle)
|
||||
"Decide if HANDLE is a vcard that must be displayed inline."
|
||||
(let ((type (mm-handle-type handle)))
|
||||
(and (consp type)
|
||||
(equal (car type) "text/x-vcard")
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(not (re-search-forward "^-- $" nil t)))))))
|
||||
|
||||
(defun mh-mime-display-single (handle)
|
||||
"Display a leaf node, HANDLE in the MIME tree."
|
||||
(let* ((type (mm-handle-media-type handle))
|
||||
|
|
@ -928,10 +897,11 @@ This is only useful if a Content-Disposition header is not present."
|
|||
(inlinep (and (equal (car (mm-handle-disposition handle)) "inline")
|
||||
(mm-inlinable-p handle)
|
||||
(mm-inlined-p handle)))
|
||||
(displayp (or inlinep ; display if inline
|
||||
(and (not attachmentp) ; if it is not an attachment
|
||||
(or small-image-flag ; display if small image
|
||||
; or if user wants inline.
|
||||
(displayp (or inlinep ; show if inline OR
|
||||
(mh-inline-vcard-p handle); inline vcard OR
|
||||
(and (not attachmentp) ; if not an attachment
|
||||
(or small-image-flag ; and small image
|
||||
; and user wants inline
|
||||
(and (not (equal
|
||||
(mm-handle-media-supertype handle)
|
||||
"image"))
|
||||
|
|
@ -941,7 +911,7 @@ This is only useful if a Content-Disposition header is not present."
|
|||
(narrow-to-region (point) (if (eobp) (point) (1+ (point))))
|
||||
(cond ((and mh-gnus-pgp-support-flag
|
||||
(equal type "application/pgp-signature"))
|
||||
nil) ; skip signatures as they are already handled...
|
||||
nil) ; skip signatures as they are already handled...
|
||||
((not displayp)
|
||||
(insert "\n")
|
||||
(mh-insert-mime-button handle (mh-mime-part-index handle) nil))
|
||||
|
|
@ -982,9 +952,9 @@ like \"K v\" which operate on individual MIME parts."
|
|||
(gnus-eval-format
|
||||
mh-mime-button-line-format mh-mime-button-line-format-alist
|
||||
`(,@(gnus-local-map-property mh-mime-button-map)
|
||||
mh-callback mh-mm-display-part
|
||||
mh-part ,index
|
||||
mh-data ,handle))
|
||||
mh-callback mh-mm-display-part
|
||||
mh-part ,index
|
||||
mh-data ,handle))
|
||||
(setq end (point))
|
||||
(widget-convert-button
|
||||
'link begin end
|
||||
|
|
@ -1062,6 +1032,7 @@ like \"K v\" which operate on individual MIME parts."
|
|||
(add-text-properties (line-beginning-position) (line-end-position)
|
||||
`(mh-region ,region)))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-press-button ()
|
||||
"Press MIME button.
|
||||
If the MIME part is visible then it is removed. Otherwise the part is
|
||||
|
|
@ -1072,13 +1043,15 @@ displayed."
|
|||
(function (get-text-property (point) 'mh-callback))
|
||||
(buffer-read-only nil)
|
||||
(folder mh-show-folder-buffer))
|
||||
(flet ((mm-handle-set-external-undisplayer (handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
(flet ((mm-handle-set-external-undisplayer
|
||||
(handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
(when (and function (eolp))
|
||||
(backward-char))
|
||||
(unwind-protect (and function (funcall function data))
|
||||
(set-buffer-modified-p nil)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-push-button (event)
|
||||
"Click MIME button for EVENT.
|
||||
If the MIME part is visible then it is removed. Otherwise the part is
|
||||
|
|
@ -1093,21 +1066,24 @@ button."
|
|||
(data (get-text-property pos 'mh-data))
|
||||
(function (get-text-property pos 'mh-callback))
|
||||
(buffer-read-only nil))
|
||||
(flet ((mm-handle-set-external-undisplayer (handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
(flet ((mm-handle-set-external-undisplayer
|
||||
(handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
(goto-char pos)
|
||||
(unwind-protect (and function (funcall function data))
|
||||
(set-buffer-modified-p nil)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mime-save-part ()
|
||||
"Save MIME part at point."
|
||||
(interactive)
|
||||
(let ((data (get-text-property (point) 'mh-data)))
|
||||
(when data
|
||||
(let ((mm-default-directory mh-mime-save-parts-directory))
|
||||
(mh-mm-save-part data)
|
||||
(setq mh-mime-save-parts-directory mm-default-directory)))))
|
||||
(mh-mm-save-part data)
|
||||
(setq mh-mime-save-parts-directory mm-default-directory)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mime-inline-part ()
|
||||
"Toggle display of the raw MIME part."
|
||||
(interactive)
|
||||
|
|
@ -1149,7 +1125,7 @@ Parameter EL is unused."
|
|||
(mh-mime-display-mixed (cdr handle))
|
||||
(insert "\n")
|
||||
(let ((mh-mime-security-button-line-format
|
||||
mh-mime-security-button-end-line-format))
|
||||
mh-mime-security-button-end-line-format))
|
||||
(mh-insert-mime-security-button handle))
|
||||
(mm-set-handle-multipart-parameter
|
||||
handle 'mh-region
|
||||
|
|
@ -1164,9 +1140,9 @@ Parameter EL is unused."
|
|||
(let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
|
||||
(when details
|
||||
(let ((mh-mime-security-button-pressed
|
||||
(not (get-text-property (point) 'mh-button-pressed)))
|
||||
(not (get-text-property (point) 'mh-button-pressed)))
|
||||
(mh-mime-security-button-line-format
|
||||
(get-text-property (point) 'mh-line-format)))
|
||||
(get-text-property (point) 'mh-line-format)))
|
||||
(forward-char -1)
|
||||
(while (eq (get-text-property (point) 'mh-line-format)
|
||||
mh-mime-security-button-line-format)
|
||||
|
|
@ -1217,10 +1193,10 @@ Parameter EL is unused."
|
|||
mh-mime-security-button-line-format
|
||||
mh-mime-security-button-line-format-alist
|
||||
`(,@(gnus-local-map-property mh-mime-security-button-map)
|
||||
mh-button-pressed ,mh-mime-security-button-pressed
|
||||
mh-callback mh-mime-security-press-button
|
||||
mh-line-format ,mh-mime-security-button-line-format
|
||||
mh-data ,handle))
|
||||
mh-button-pressed ,mh-mime-security-button-pressed
|
||||
mh-callback mh-mime-security-press-button
|
||||
mh-line-format ,mh-mime-security-button-line-format
|
||||
mh-data ,handle))
|
||||
(setq end (point))
|
||||
(widget-convert-button 'link begin end
|
||||
:mime-handle handle
|
||||
|
|
@ -1293,6 +1269,7 @@ message multiple times."
|
|||
(provide 'mh-mime)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-pick.el,v 1.21 2002/11/05 21:43:16 wohler Exp $
|
||||
;; $Id: mh-pick.el,v 1.25 2002/12/04 18:51:50 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -38,46 +38,40 @@
|
|||
(require 'easymenu)
|
||||
(require 'gnus-util)
|
||||
|
||||
;;; Hooks
|
||||
|
||||
(defcustom mh-pick-mode-hook nil
|
||||
"Invoked upon entry to `mh-pick-mode'."
|
||||
:type 'hook
|
||||
:group 'mh-hook)
|
||||
|
||||
;;; Internal variables:
|
||||
|
||||
(defvar mh-pick-mode-map (make-sparse-keymap)
|
||||
"Keymap for searching folder.")
|
||||
|
||||
(defvar mh-searching-folder nil) ;Folder this pick is searching.
|
||||
(defvar mh-searching-folder nil) ;Folder this pick is searching.
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-search-folder (folder)
|
||||
"Search FOLDER for messages matching a pattern.
|
||||
This function uses the MH command `pick' to do the work.
|
||||
Add the messages found to the sequence named `search'."
|
||||
(interactive (list (mh-prompt-for-folder "Search"
|
||||
mh-current-folder
|
||||
t)))
|
||||
mh-current-folder
|
||||
t)))
|
||||
(switch-to-buffer-other-window "pick-pattern")
|
||||
(if (or (zerop (buffer-size))
|
||||
(not (y-or-n-p "Reuse pattern? ")))
|
||||
(not (y-or-n-p "Reuse pattern? ")))
|
||||
(mh-make-pick-template)
|
||||
(message ""))
|
||||
(setq mh-searching-folder folder)
|
||||
(message "%s" (substitute-command-keys
|
||||
(concat "Type \\[mh-do-pick-search] to search messages, "
|
||||
"\\[mh-help] for help."))))
|
||||
(concat "Type \\[mh-do-pick-search] to search messages, "
|
||||
"\\[mh-help] for help."))))
|
||||
|
||||
(defun mh-make-pick-template ()
|
||||
"Initialize the current buffer with a template for a pick pattern."
|
||||
(erase-buffer)
|
||||
(insert "From: \n"
|
||||
"To: \n"
|
||||
"Cc: \n"
|
||||
"Date: \n"
|
||||
"Subject: \n"
|
||||
"---------\n")
|
||||
"To: \n"
|
||||
"Cc: \n"
|
||||
"Date: \n"
|
||||
"Subject: \n"
|
||||
"---------\n")
|
||||
(mh-pick-mode)
|
||||
(goto-char (point-min))
|
||||
(end-of-line))
|
||||
|
|
@ -130,41 +124,42 @@ with no arguments, upon entry to this mode.
|
|||
(setq mh-help-messages mh-pick-mode-help-messages)
|
||||
(run-hooks 'mh-pick-mode-hook))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-do-pick-search ()
|
||||
"Find messages that match the qualifications in the current pattern buffer.
|
||||
Messages are searched for in the folder named in `mh-searching-folder'.
|
||||
Add the messages found to the sequence named `search'."
|
||||
(interactive)
|
||||
(let ((pattern-buffer (buffer-name))
|
||||
(searching-buffer mh-searching-folder)
|
||||
range
|
||||
msgs
|
||||
(pattern nil)
|
||||
(new-buffer nil))
|
||||
(searching-buffer mh-searching-folder)
|
||||
range
|
||||
msgs
|
||||
(pattern nil)
|
||||
(new-buffer nil))
|
||||
(save-excursion
|
||||
(cond ((get-buffer searching-buffer)
|
||||
(set-buffer searching-buffer)
|
||||
(setq range (list (format "%d-%d"
|
||||
mh-first-msg-num mh-last-msg-num))))
|
||||
(t
|
||||
(mh-make-folder searching-buffer)
|
||||
(setq range '("all"))
|
||||
(setq new-buffer t))))
|
||||
(set-buffer searching-buffer)
|
||||
(setq range (list (format "%d-%d"
|
||||
mh-first-msg-num mh-last-msg-num))))
|
||||
(t
|
||||
(mh-make-folder searching-buffer)
|
||||
(setq range '("all"))
|
||||
(setq new-buffer t))))
|
||||
(message "Searching...")
|
||||
(goto-char (point-min))
|
||||
(while (and range
|
||||
(setq pattern (mh-next-pick-field pattern-buffer)))
|
||||
(setq pattern (mh-next-pick-field pattern-buffer)))
|
||||
(setq msgs (mh-seq-from-command searching-buffer
|
||||
'search
|
||||
(mh-list-to-string
|
||||
(list "pick" pattern searching-buffer
|
||||
"-list"
|
||||
(mh-coalesce-msg-list range)))))
|
||||
(setq range msgs)) ;restrict the pick range for next pass
|
||||
'search
|
||||
(mh-list-to-string
|
||||
(list "pick" pattern searching-buffer
|
||||
"-list"
|
||||
(mh-coalesce-msg-list range)))))
|
||||
(setq range msgs)) ;restrict the pick range for next pass
|
||||
(message "Searching...done")
|
||||
(if new-buffer
|
||||
(mh-scan-folder searching-buffer msgs)
|
||||
(switch-to-buffer searching-buffer))
|
||||
(mh-scan-folder searching-buffer msgs)
|
||||
(switch-to-buffer searching-buffer))
|
||||
(mh-add-msgs-to-seq msgs 'search)
|
||||
(delete-other-windows)))
|
||||
|
||||
|
|
@ -173,17 +168,17 @@ Add the messages found to the sequence named `search'."
|
|||
COMMAND is a list. The first element is a program name
|
||||
and the subsequent elements are its arguments, all strings."
|
||||
(let ((msg)
|
||||
(msgs ())
|
||||
(case-fold-search t))
|
||||
(msgs ())
|
||||
(case-fold-search t))
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
|
||||
;; "pick" outputs one number per line
|
||||
(while (setq msg (car (mh-read-msg-list)))
|
||||
(setq msgs (cons msg msgs))
|
||||
(forward-line 1))))
|
||||
(if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
|
||||
;; "pick" outputs one number per line
|
||||
(while (setq msg (car (mh-read-msg-list)))
|
||||
(setq msgs (cons msg msgs))
|
||||
(forward-line 1))))
|
||||
(set-buffer folder)
|
||||
(setq msgs (nreverse msgs)) ;put in ascending order
|
||||
(setq msgs (nreverse msgs)) ;put in ascending order
|
||||
msgs)))
|
||||
|
||||
(defun mh-next-pick-field (buffer)
|
||||
|
|
@ -193,50 +188,51 @@ 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))))
|
||||
nil)
|
||||
((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
|
||||
nil t)
|
||||
(let* ((component
|
||||
(format "--%s"
|
||||
(downcase (buffer-substring (match-beginning 1)
|
||||
(match-end 1)))))
|
||||
(pat (buffer-substring (match-beginning 2) (match-end 2))))
|
||||
(forward-line 1)
|
||||
(list component pat)))
|
||||
((re-search-forward "^-*$" nil t)
|
||||
(forward-char 1)
|
||||
(let ((body (buffer-substring (point) (point-max))))
|
||||
(if (and (> (length body) 0) (not (equal body "\n")))
|
||||
(list "-search" body)
|
||||
nil)))
|
||||
(t
|
||||
nil))))
|
||||
|
||||
|
||||
|
||||
;;; Build the pick-mode keymap:
|
||||
;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
|
||||
(gnus-define-keys mh-pick-mode-map
|
||||
"\C-c?" mh-help
|
||||
"\C-c\C-c" mh-do-pick-search
|
||||
"\C-c\C-f\C-b" mh-to-field
|
||||
"\C-c\C-f\C-c" mh-to-field
|
||||
"\C-c\C-f\C-d" mh-to-field
|
||||
"\C-c\C-f\C-f" mh-to-field
|
||||
"\C-c\C-f\C-r" mh-to-field
|
||||
"\C-c\C-f\C-s" mh-to-field
|
||||
"\C-c\C-f\C-t" mh-to-field
|
||||
"\C-c\C-fb" mh-to-field
|
||||
"\C-c\C-fc" mh-to-field
|
||||
"\C-c\C-fd" mh-to-field
|
||||
"\C-c\C-ff" mh-to-field
|
||||
"\C-c\C-fr" mh-to-field
|
||||
"\C-c\C-fs" mh-to-field
|
||||
"\C-c\C-ft" mh-to-field)
|
||||
"\C-c?" mh-help
|
||||
"\C-c\C-c" mh-do-pick-search
|
||||
"\C-c\C-f\C-b" mh-to-field
|
||||
"\C-c\C-f\C-c" mh-to-field
|
||||
"\C-c\C-f\C-d" mh-to-field
|
||||
"\C-c\C-f\C-f" mh-to-field
|
||||
"\C-c\C-f\C-r" mh-to-field
|
||||
"\C-c\C-f\C-s" mh-to-field
|
||||
"\C-c\C-f\C-t" mh-to-field
|
||||
"\C-c\C-fb" mh-to-field
|
||||
"\C-c\C-fc" mh-to-field
|
||||
"\C-c\C-fd" mh-to-field
|
||||
"\C-c\C-ff" mh-to-field
|
||||
"\C-c\C-fr" mh-to-field
|
||||
"\C-c\C-fs" mh-to-field
|
||||
"\C-c\C-ft" mh-to-field)
|
||||
|
||||
(provide 'mh-pick)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
|
|
|
|||
|
|
@ -67,7 +67,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-seq.el,v 1.71 2002/11/14 20:41:12 wohler Exp $
|
||||
;; $Id: mh-seq.el,v 1.84 2003/01/07 21:15:33 satyaki Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -137,56 +137,65 @@ redone to get the new thread tree. This makes incremental threading easier.")
|
|||
(make-variable-buffer-local 'mh-thread-duplicates)
|
||||
(make-variable-buffer-local 'mh-thread-history)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-delete-seq (sequence)
|
||||
"Delete the SEQUENCE."
|
||||
(interactive (list (mh-read-seq-default "Delete" t)))
|
||||
(mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
|
||||
sequence)
|
||||
sequence)
|
||||
(mh-undefine-sequence sequence '("all"))
|
||||
(mh-delete-seq-locally sequence))
|
||||
|
||||
;; Avoid compiler warnings
|
||||
(defvar view-exit-action)
|
||||
|
||||
(defun mh-list-sequences (folder)
|
||||
"List the sequences defined in FOLDER."
|
||||
(interactive (list (mh-prompt-for-folder "List sequences in"
|
||||
mh-current-folder t)))
|
||||
(let ((temp-buffer mh-temp-sequences-buffer)
|
||||
(seq-list mh-seq-list))
|
||||
;;;###mh-autoload
|
||||
(defun mh-list-sequences ()
|
||||
"List the sequences defined in the folder being visited."
|
||||
(interactive)
|
||||
(let ((folder mh-current-folder)
|
||||
(temp-buffer mh-temp-sequences-buffer)
|
||||
(seq-list mh-seq-list)
|
||||
(max-len 0))
|
||||
(with-output-to-temp-buffer temp-buffer
|
||||
(save-excursion
|
||||
(set-buffer temp-buffer)
|
||||
(erase-buffer)
|
||||
(message "Listing sequences ...")
|
||||
(insert "Sequences in folder " folder ":\n")
|
||||
(while seq-list
|
||||
(let ((name (mh-seq-name (car seq-list)))
|
||||
(sorted-seq-msgs
|
||||
(sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))
|
||||
(last-col (- (window-width) 4))
|
||||
name-spec)
|
||||
(insert (setq name-spec (format "%20s:" name)))
|
||||
(while sorted-seq-msgs
|
||||
(if (> (current-column) last-col)
|
||||
(progn
|
||||
(insert "\n")
|
||||
(move-to-column (length name-spec))))
|
||||
(insert (format " %s" (car sorted-seq-msgs)))
|
||||
(setq sorted-seq-msgs (cdr sorted-seq-msgs)))
|
||||
(insert "\n"))
|
||||
(setq seq-list (cdr seq-list)))
|
||||
(goto-char (point-min))
|
||||
(view-mode 1)
|
||||
(setq view-exit-action 'kill-buffer)
|
||||
(message "Listing sequences...done")))))
|
||||
(set-buffer temp-buffer)
|
||||
(erase-buffer)
|
||||
(message "Listing sequences ...")
|
||||
(insert "Sequences in folder " folder ":\n")
|
||||
(let ((seq-list seq-list))
|
||||
(while seq-list
|
||||
(setq max-len
|
||||
(max (length (symbol-name (mh-seq-name (pop seq-list))))
|
||||
max-len)))
|
||||
(setq max-len (+ 2 max-len)))
|
||||
(while seq-list
|
||||
(let ((name (mh-seq-name (car seq-list)))
|
||||
(sorted-seq-msgs
|
||||
(mh-coalesce-msg-list
|
||||
(sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
|
||||
name-spec)
|
||||
(insert (setq name-spec (format (format "%%%ss:" max-len) name)))
|
||||
(while sorted-seq-msgs
|
||||
(let ((next-element (format " %s" (pop sorted-seq-msgs))))
|
||||
(when (>= (+ (current-column) (length next-element))
|
||||
(window-width))
|
||||
(insert "\n")
|
||||
(insert (format (format "%%%ss" (length name-spec)) "")))
|
||||
(insert next-element)))
|
||||
(insert "\n"))
|
||||
(setq seq-list (cdr seq-list)))
|
||||
(goto-char (point-min))
|
||||
(view-mode 1)
|
||||
(setq view-exit-action 'kill-buffer)
|
||||
(message "Listing sequences...done")))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-msg-is-in-seq (message)
|
||||
"Display the sequences that contain MESSAGE (default: current message)."
|
||||
(interactive (list (mh-get-msg-num t)))
|
||||
(let* ((dest-folder (loop for seq in mh-refile-list
|
||||
when (member message (cdr seq))
|
||||
return (car seq)))
|
||||
when (member message (cdr seq)) return (car seq)))
|
||||
(deleted-flag (unless dest-folder (member message mh-delete-list))))
|
||||
(message "Message %d%s is in sequences: %s"
|
||||
message
|
||||
|
|
@ -197,37 +206,39 @@ redone to get the new thread tree. This makes incremental threading easier.")
|
|||
(mh-list-to-string (mh-seq-containing-msg message t))
|
||||
" "))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-narrow-to-seq (sequence)
|
||||
"Restrict display of this folder to just messages in SEQUENCE.
|
||||
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
|
||||
(interactive (list (mh-read-seq "Narrow to" t)))
|
||||
(with-mh-folder-updating (t)
|
||||
(cond ((mh-seq-to-msgs sequence)
|
||||
(mh-widen)
|
||||
(mh-widen)
|
||||
(mh-remove-all-notation)
|
||||
(let ((eob (point-max))
|
||||
(let ((eob (point-max))
|
||||
(msg-at-cursor (mh-get-msg-num nil)))
|
||||
(setq mh-thread-old-scan-line-map mh-thread-scan-line-map)
|
||||
(setq mh-thread-scan-line-map (make-hash-table :test #'eql))
|
||||
(mh-copy-seq-to-eob sequence)
|
||||
(mh-copy-seq-to-eob sequence)
|
||||
(narrow-to-region eob (point-max))
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note)
|
||||
(when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
|
||||
(make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
|
||||
(setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
|
||||
(setq mh-mode-line-annotation (symbol-name sequence))
|
||||
(mh-make-folder-mode-line)
|
||||
(mh-recenter nil)
|
||||
(make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
|
||||
(setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
|
||||
(setq mh-mode-line-annotation (symbol-name sequence))
|
||||
(mh-make-folder-mode-line)
|
||||
(mh-recenter nil)
|
||||
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
|
||||
(set (make-local-variable 'tool-bar-map)
|
||||
mh-folder-seq-tool-bar-map))
|
||||
(setq mh-narrowed-to-seq sequence)
|
||||
(setq mh-narrowed-to-seq sequence)
|
||||
(push 'widen mh-view-ops)))
|
||||
(t
|
||||
(error "No messages in sequence `%s'" (symbol-name sequence))))))
|
||||
(t
|
||||
(error "No messages in sequence `%s'" (symbol-name sequence))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-put-msg-in-seq (msg-or-seq sequence)
|
||||
"Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
|
||||
If optional prefix argument provided, then prompt for the message sequence.
|
||||
|
|
@ -235,19 +246,18 @@ 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-sequence (region-beginning) (region-end))
|
||||
'region)
|
||||
(mh-region-to-msg-list (region-beginning) (region-end)))
|
||||
(current-prefix-arg
|
||||
(mh-read-seq-default "Add messages from" t))
|
||||
(t
|
||||
(mh-get-msg-num t)))
|
||||
(mh-read-seq-default "Add to" nil)))
|
||||
(mh-get-msg-num t)))
|
||||
(mh-read-seq-default "Add to" nil)))
|
||||
(if (not (mh-internal-seq sequence))
|
||||
(setq mh-last-seq-used sequence))
|
||||
(mh-add-msgs-to-seq (if (numberp msg-or-seq)
|
||||
msg-or-seq
|
||||
(mh-seq-to-msgs msg-or-seq))
|
||||
sequence))
|
||||
(mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq))
|
||||
((listp msg-or-seq) msg-or-seq)
|
||||
(t (mh-seq-to-msgs msg-or-seq)))
|
||||
sequence))
|
||||
|
||||
(defun mh-valid-view-change-operation-p (op)
|
||||
"Check if the view change operation can be performed.
|
||||
|
|
@ -256,6 +266,7 @@ OP is one of 'widen and 'unthread."
|
|||
(pop mh-view-ops))
|
||||
(t nil)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-widen ()
|
||||
"Remove restrictions from current folder, thereby showing all messages."
|
||||
(interactive)
|
||||
|
|
@ -304,16 +315,16 @@ refiled are present in `mh-refile-list'."
|
|||
|
||||
;;; Commands to manipulate sequences. Sequences are stored in an alist
|
||||
;;; of the form:
|
||||
;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
|
||||
;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
|
||||
|
||||
(defun mh-read-seq-default (prompt not-empty)
|
||||
"Read and return sequence name with default narrowed or previous sequence.
|
||||
PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
|
||||
non-empty sequence is read."
|
||||
(mh-read-seq prompt not-empty
|
||||
(or mh-narrowed-to-seq
|
||||
mh-last-seq-used
|
||||
(car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
|
||||
(or mh-narrowed-to-seq
|
||||
mh-last-seq-used
|
||||
(car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
|
||||
|
||||
(defun mh-read-seq (prompt not-empty &optional default)
|
||||
"Read and return a sequence name.
|
||||
|
|
@ -321,60 +332,65 @@ Prompt with PROMPT, raise an error if the sequence is empty and the NOT-EMPTY
|
|||
flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%'
|
||||
defaults to the first sequence containing the current message."
|
||||
(let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
|
||||
(if default
|
||||
(format "[%s] " default)
|
||||
""))
|
||||
(mh-seq-names mh-seq-list)))
|
||||
(seq (cond ((equal input "%")
|
||||
(car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
|
||||
((equal input "") default)
|
||||
(t (intern input))))
|
||||
(msgs (mh-seq-to-msgs seq)))
|
||||
(if default
|
||||
(format "[%s] " default)
|
||||
""))
|
||||
(mh-seq-names mh-seq-list)))
|
||||
(seq (cond ((equal input "%")
|
||||
(car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
|
||||
((equal input "") default)
|
||||
(t (intern input))))
|
||||
(msgs (mh-seq-to-msgs seq)))
|
||||
(if (and (null msgs) not-empty)
|
||||
(error "No messages in sequence `%s'" seq))
|
||||
(error "No messages in sequence `%s'" seq))
|
||||
seq))
|
||||
|
||||
(defun mh-seq-names (seq-list)
|
||||
"Return an alist containing the names of the SEQ-LIST."
|
||||
(mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
|
||||
seq-list))
|
||||
seq-list))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-rename-seq (sequence new-name)
|
||||
"Rename SEQUENCE to have NEW-NAME."
|
||||
(interactive (list (mh-read-seq "Old" t)
|
||||
(intern (read-string "New sequence name: "))))
|
||||
(intern (read-string "New sequence name: "))))
|
||||
(let ((old-seq (mh-find-seq sequence)))
|
||||
(or old-seq
|
||||
(error "Sequence %s does not exist" sequence))
|
||||
(error "Sequence %s does not exist" sequence))
|
||||
;; create new sequence first, since it might raise an error.
|
||||
(mh-define-sequence new-name (mh-seq-msgs old-seq))
|
||||
(mh-undefine-sequence sequence (mh-seq-msgs old-seq))
|
||||
(rplaca old-seq new-name)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-map-to-seq-msgs (func seq &rest args)
|
||||
"Invoke the FUNC at each message in the SEQ.
|
||||
The remaining ARGS are passed as arguments to FUNC."
|
||||
"Invoke the FUNC at each message in the SEQ.
|
||||
SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
|
||||
passed as arguments to FUNC."
|
||||
(save-excursion
|
||||
(let ((msgs (mh-seq-to-msgs seq)))
|
||||
(let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
|
||||
(while msgs
|
||||
(if (mh-goto-msg (car msgs) t t)
|
||||
(apply func (car msgs) args))
|
||||
(setq msgs (cdr msgs))))))
|
||||
(if (mh-goto-msg (car msgs) t t)
|
||||
(apply func (car msgs) args))
|
||||
(setq msgs (cdr msgs))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-notate-seq (seq notation offset)
|
||||
"Mark the scan listing.
|
||||
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
|
||||
the line."
|
||||
(mh-map-to-seq-msgs 'mh-notate seq notation offset))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-add-to-sequence (seq msgs)
|
||||
"The sequence SEQ is augmented with the messages in MSGS."
|
||||
;; Add to a SEQUENCE each message the list of MSGS.
|
||||
(if (not (mh-folder-name-p seq))
|
||||
(if msgs
|
||||
(apply 'mh-exec-cmd "mark" mh-current-folder "-add"
|
||||
"-sequence" (symbol-name seq)
|
||||
(mh-coalesce-msg-list msgs)))))
|
||||
(apply 'mh-exec-cmd "mark" mh-current-folder "-add"
|
||||
"-sequence" (symbol-name seq)
|
||||
(mh-coalesce-msg-list msgs)))))
|
||||
|
||||
;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
|
||||
;; that the folder buffer is sorted. However in this case that assumption
|
||||
|
|
@ -397,20 +413,25 @@ the line."
|
|||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(mh-regenerate-headers coalesced-msgs t)
|
||||
(when (memq 'unthread mh-view-ops)
|
||||
;; Populate restricted scan-line map
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line))
|
||||
(forward-line))
|
||||
;; Remove scan lines and read results from pre-computed thread tree
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((thread-tree (mh-thread-generate mh-current-folder ()))
|
||||
(mh-thread-body-width
|
||||
(- (window-width) mh-cmd-note
|
||||
(1- mh-scan-field-subject-start-offset))))
|
||||
(mh-thread-generate-scan-lines thread-tree -2)))))))
|
||||
(cond ((memq 'unthread mh-view-ops)
|
||||
;; Populate restricted scan-line map
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(let ((msg (mh-get-msg-num nil)))
|
||||
(when (numberp msg)
|
||||
(setf (gethash msg mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line))))
|
||||
(forward-line))
|
||||
;; Remove scan lines and read results from pre-computed tree
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((thread-tree (mh-thread-generate mh-current-folder ()))
|
||||
(mh-thread-body-width
|
||||
(- (window-width) mh-cmd-note
|
||||
(1- mh-scan-field-subject-start-offset)))
|
||||
(mh-thread-last-ancestor nil))
|
||||
(mh-thread-generate-scan-lines thread-tree -2)))
|
||||
(mh-index-data
|
||||
(mh-index-insert-folder-headers)))))))
|
||||
|
||||
(defun mh-copy-line-to-point (msg location)
|
||||
"Copy current message line to a specific location.
|
||||
|
|
@ -421,24 +442,25 @@ LOCATION."
|
|||
(beginning-of-line)
|
||||
(save-excursion
|
||||
(let ((beginning-of-line (point))
|
||||
end)
|
||||
end)
|
||||
(forward-line 1)
|
||||
(setq end (point))
|
||||
(goto-char location)
|
||||
(insert-buffer-substring (current-buffer) beginning-of-line end))))
|
||||
|
||||
(defun mh-region-to-sequence (begin end)
|
||||
"Define sequence 'region as the messages between point and mark.
|
||||
When called programmatically, use arguments BEGIN and END to define region."
|
||||
(interactive "r")
|
||||
(mh-delete-seq-locally 'region)
|
||||
;;;###mh-autoload
|
||||
(defun mh-region-to-msg-list (begin end)
|
||||
"Return a list of messages within the region between BEGIN and END."
|
||||
(save-excursion
|
||||
;; If end is end of buffer back up one position
|
||||
(setq end (if (equal end (point-max)) (1- end) end))
|
||||
(goto-char begin)
|
||||
(while (<= (point) end)
|
||||
(mh-add-msgs-to-seq (mh-get-msg-num t) 'region t)
|
||||
(forward-line 1))))
|
||||
(let ((result ()))
|
||||
(while (<= (point) end)
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(when (numberp index) (push index result)))
|
||||
(forward-line 1))
|
||||
result)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -493,6 +515,7 @@ Return number of messages put in the sequence:
|
|||
(t
|
||||
0))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-narrow-to-subject ()
|
||||
"Narrow to a sequence containing all following messages with same subject."
|
||||
(interactive)
|
||||
|
|
@ -510,6 +533,7 @@ Return number of messages put in the sequence:
|
|||
(if (numberp num)
|
||||
(mh-goto-msg num t t))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-delete-subject ()
|
||||
"Mark all following messages with same subject to be deleted.
|
||||
This puts the messages in a sequence named subject. You can undo the last
|
||||
|
|
@ -527,30 +551,42 @@ subject sequence."
|
|||
(message "Marked %d messages for deletion" count)
|
||||
(mh-delete-msg 'subject)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-delete-subject-or-thread ()
|
||||
"Mark messages for deletion intelligently.
|
||||
If the folder is threaded then `mh-thread-delete' is used to mark the current
|
||||
message and all its descendants for deletion. Otherwise `mh-delete-subject' is
|
||||
used to mark the current message and all messages following it with the same
|
||||
subject for deletion."
|
||||
(interactive)
|
||||
(if (memq 'unthread mh-view-ops)
|
||||
(mh-thread-delete)
|
||||
(mh-delete-subject)))
|
||||
|
||||
;;; Message threading:
|
||||
|
||||
(defun mh-thread-initialize ()
|
||||
"Make hash tables, otherwise clear them."
|
||||
(cond
|
||||
(mh-thread-id-hash
|
||||
(clrhash mh-thread-id-hash)
|
||||
(clrhash mh-thread-subject-hash)
|
||||
(clrhash mh-thread-id-table)
|
||||
(clrhash mh-thread-id-index-map)
|
||||
(clrhash mh-thread-index-id-map)
|
||||
(clrhash mh-thread-scan-line-map)
|
||||
(clrhash mh-thread-subject-container-hash)
|
||||
(clrhash mh-thread-duplicates)
|
||||
(setq mh-thread-history ()))
|
||||
(t (setq mh-thread-id-hash (make-hash-table :test #'equal))
|
||||
(setq mh-thread-subject-hash (make-hash-table :test #'equal))
|
||||
(setq mh-thread-id-table (make-hash-table :test #'eq))
|
||||
(setq mh-thread-id-index-map (make-hash-table :test #'eq))
|
||||
(setq mh-thread-index-id-map (make-hash-table :test #'eql))
|
||||
(setq mh-thread-scan-line-map (make-hash-table :test #'eql))
|
||||
(setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
|
||||
(setq mh-thread-duplicates (make-hash-table :test #'eq))
|
||||
(setq mh-thread-history ()))))
|
||||
(mh-thread-id-hash
|
||||
(clrhash mh-thread-id-hash)
|
||||
(clrhash mh-thread-subject-hash)
|
||||
(clrhash mh-thread-id-table)
|
||||
(clrhash mh-thread-id-index-map)
|
||||
(clrhash mh-thread-index-id-map)
|
||||
(clrhash mh-thread-scan-line-map)
|
||||
(clrhash mh-thread-subject-container-hash)
|
||||
(clrhash mh-thread-duplicates)
|
||||
(setq mh-thread-history ()))
|
||||
(t (setq mh-thread-id-hash (make-hash-table :test #'equal))
|
||||
(setq mh-thread-subject-hash (make-hash-table :test #'equal))
|
||||
(setq mh-thread-id-table (make-hash-table :test #'eq))
|
||||
(setq mh-thread-id-index-map (make-hash-table :test #'eq))
|
||||
(setq mh-thread-index-id-map (make-hash-table :test #'eql))
|
||||
(setq mh-thread-scan-line-map (make-hash-table :test #'eql))
|
||||
(setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
|
||||
(setq mh-thread-duplicates (make-hash-table :test #'eq))
|
||||
(setq mh-thread-history ()))))
|
||||
|
||||
(defsubst mh-thread-id-container (id)
|
||||
"Given ID, return the corresponding container in `mh-thread-id-table'.
|
||||
|
|
@ -570,8 +606,8 @@ is updated."
|
|||
(parent-container (mh-container-parent child-container)))
|
||||
(when parent-container
|
||||
(setf (mh-container-children parent-container)
|
||||
(remove* child-container (mh-container-children parent-container)
|
||||
:test #'eq))
|
||||
(loop for elem in (mh-container-children parent-container)
|
||||
unless (eq child-container elem) collect elem))
|
||||
(setf (mh-container-parent child-container) nil))))
|
||||
|
||||
(defsubst mh-thread-add-link (parent child &optional at-end-p)
|
||||
|
|
@ -711,7 +747,7 @@ If CONTAINER is empty return the subject info of one of its children."
|
|||
(setf (mh-container-real-child-p node) t)))))))
|
||||
|
||||
(defun mh-thread-prune-containers (roots)
|
||||
"Prune empty containers in the containers ROOTS."
|
||||
"Prune empty containers in the containers ROOTS."
|
||||
(let ((dfs-ordered-nodes ())
|
||||
(work-list roots))
|
||||
(while work-list
|
||||
|
|
@ -804,16 +840,18 @@ preference to something that has it."
|
|||
Ideally this should have some regexp which will try to guess if a string
|
||||
between < and > is a message id and not an email address. For now it will
|
||||
take the last string inside angles."
|
||||
(let ((end (search ">" reply-to-header :from-end t)))
|
||||
(let ((end (mh-search-from-end ?> reply-to-header)))
|
||||
(when (numberp end)
|
||||
(let ((begin (search "<" reply-to-header :from-end t :end2 end)))
|
||||
(let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end))))
|
||||
(when (numberp begin)
|
||||
(list (substring reply-to-header begin (1+ end))))))))
|
||||
|
||||
(defun mh-thread-set-tables (folder)
|
||||
"Use the tables of FOLDER in current buffer."
|
||||
(flet ((mh-get-table (symbol)
|
||||
(save-excursion (set-buffer folder) (symbol-value symbol))))
|
||||
(save-excursion
|
||||
(set-buffer folder)
|
||||
(symbol-value symbol))))
|
||||
(setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
|
||||
(setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
|
||||
(setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
|
||||
|
|
@ -851,7 +889,7 @@ Only information about messages in MSG-LIST are added to the tree."
|
|||
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
|
||||
"-width" "10000" "-format"
|
||||
"%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
|
||||
(mapcar #'(lambda (x) (format "%s" x)) msg-list)))
|
||||
folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
|
||||
(goto-char (point-min))
|
||||
(let ((roots ())
|
||||
(case-fold-search t))
|
||||
|
|
@ -859,8 +897,8 @@ Only information about messages in MSG-LIST are added to the tree."
|
|||
(while (not (eobp))
|
||||
(block process-message
|
||||
(let* ((index-line
|
||||
(prog1 (buffer-substring (point) (line-end-position))
|
||||
(forward-line)))
|
||||
(prog1 (buffer-substring (point) (line-end-position))
|
||||
(forward-line)))
|
||||
(index (car (read-from-string index-line)))
|
||||
(id (prog1 (buffer-substring (point) (line-end-position))
|
||||
(forward-line)))
|
||||
|
|
@ -901,6 +939,7 @@ Only information about messages in MSG-LIST are added to the tree."
|
|||
(set-buffer folder)
|
||||
(setq mh-thread-history history))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-inc (folder start-point)
|
||||
"Update thread tree for FOLDER.
|
||||
All messages after START-POINT are added to the thread tree."
|
||||
|
|
@ -909,22 +948,26 @@ All messages after START-POINT are added to the thread tree."
|
|||
(let ((msg-list ()))
|
||||
(while (not (eobp))
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(push index msg-list)
|
||||
(setf (gethash index mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line))
|
||||
(when (numberp index)
|
||||
(push index msg-list)
|
||||
(setf (gethash index mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line)))
|
||||
(forward-line)))
|
||||
(let ((thread-tree (mh-thread-generate folder msg-list))
|
||||
(buffer-read-only nil)
|
||||
(old-buffer-modified-flag (buffer-modified-p)))
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
|
||||
(1- mh-scan-field-subject-start-offset))))
|
||||
(1- mh-scan-field-subject-start-offset)))
|
||||
(mh-thread-last-ancestor nil))
|
||||
(mh-thread-generate-scan-lines thread-tree -2))
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note)
|
||||
(set-buffer-modified-p old-buffer-modified-flag))))
|
||||
|
||||
(defvar mh-thread-last-ancestor)
|
||||
|
||||
(defun mh-thread-generate-scan-lines (tree level)
|
||||
"Generate scan lines.
|
||||
TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices
|
||||
|
|
@ -938,18 +981,31 @@ the message."
|
|||
(duplicates (gethash id mh-thread-duplicates))
|
||||
(new-level (+ level 2))
|
||||
(dupl-flag t)
|
||||
(force-angle-flag nil)
|
||||
(increment-level-flag nil))
|
||||
(dolist (scan-line (mapcar (lambda (x)
|
||||
(gethash x mh-thread-scan-line-map))
|
||||
(reverse (cons index duplicates))))
|
||||
(when scan-line
|
||||
(when (and dupl-flag (equal level 0)
|
||||
(mh-thread-ancestor-p mh-thread-last-ancestor tree))
|
||||
(setq level (+ level 2)
|
||||
new-level (+ new-level 2)
|
||||
force-angle-flag t))
|
||||
(when (equal level 0)
|
||||
(setq mh-thread-last-ancestor tree)
|
||||
(while (mh-container-parent mh-thread-last-ancestor)
|
||||
(setq mh-thread-last-ancestor
|
||||
(mh-container-parent mh-thread-last-ancestor))))
|
||||
(insert (car scan-line)
|
||||
(format (format "%%%ss"
|
||||
(if dupl-flag level new-level)) "")
|
||||
(if (and (mh-container-real-child-p tree) dupl-flag)
|
||||
(if (and (mh-container-real-child-p tree) dupl-flag
|
||||
(not force-angle-flag))
|
||||
"[" "<")
|
||||
(cadr scan-line)
|
||||
(if (and (mh-container-real-child-p tree) dupl-flag)
|
||||
(if (and (mh-container-real-child-p tree) dupl-flag
|
||||
(not force-angle-flag))
|
||||
"]" ">")
|
||||
(truncate-string-to-width
|
||||
(caddr scan-line) (- mh-thread-body-width
|
||||
|
|
@ -984,14 +1040,16 @@ Otherwise uses the line at point as the scan line to parse."
|
|||
(substring string (+ mh-cmd-note mh-scan-field-from-end-offset))
|
||||
string)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-add-spaces (count)
|
||||
"Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
|
||||
(let ((spaces (format (format "%%%ss" count) "")))
|
||||
(while (not (eobp))
|
||||
(let* ((msg-num (mh-get-msg-num nil))
|
||||
(old-line (nth 3 (gethash msg-num mh-thread-scan-line-map))))
|
||||
(setf (gethash msg-num mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line (format "%s%s" spaces old-line))))
|
||||
(when (numberp msg-num)
|
||||
(setf (gethash msg-num mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
|
||||
(forward-line 1))))
|
||||
|
||||
(defun mh-thread-folder ()
|
||||
|
|
@ -1000,23 +1058,24 @@ Otherwise uses the line at point as the scan line to parse."
|
|||
(mh-thread-initialize)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line))
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(when (numberp index)
|
||||
(setf (gethash index mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line))))
|
||||
(forward-line))
|
||||
(let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num))
|
||||
(thread-tree (mh-thread-generate (buffer-name) (list range)))
|
||||
(buffer-read-only nil)
|
||||
(old-buffer-modified-p (buffer-modified-p)))
|
||||
(thread-tree (mh-thread-generate (buffer-name) (list range))))
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
|
||||
(1- mh-scan-field-subject-start-offset))))
|
||||
(1- mh-scan-field-subject-start-offset)))
|
||||
(mh-thread-last-ancestor nil))
|
||||
(mh-thread-generate-scan-lines thread-tree -2))
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-seq 'cur mh-note-cur mh-cmd-note)
|
||||
(set-buffer-modified-p old-buffer-modified-p)
|
||||
(message "Threading %s...done" (buffer-name))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-toggle-threads ()
|
||||
"Toggle threaded view of folder.
|
||||
The conversion of normal view to threaded view is exact, that is the same
|
||||
|
|
@ -1024,24 +1083,32 @@ 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."
|
||||
(interactive)
|
||||
(let ((msg-at-point (mh-get-msg-num nil)))
|
||||
(let ((msg-at-point (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil))
|
||||
(cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq)
|
||||
(unless (mh-valid-view-change-operation-p 'unthread)
|
||||
(error "Can't unthread folder"))
|
||||
(mh-scan-folder mh-current-folder
|
||||
(format "%s" mh-narrowed-to-seq)
|
||||
t))
|
||||
t)
|
||||
(when mh-index-data
|
||||
(mh-index-insert-folder-headers)))
|
||||
((memq 'unthread mh-view-ops)
|
||||
(unless (mh-valid-view-change-operation-p 'unthread)
|
||||
(error "Can't unthread folder"))
|
||||
(mh-scan-folder mh-current-folder
|
||||
(format "%s-%s" mh-first-msg-num mh-last-msg-num)
|
||||
t))
|
||||
t)
|
||||
(when mh-index-data
|
||||
(mh-index-insert-folder-headers)))
|
||||
(t (mh-thread-folder)
|
||||
(push 'unthread mh-view-ops)))
|
||||
(when msg-at-point (mh-goto-msg msg-at-point t t))
|
||||
(set-buffer-modified-p old-buffer-modified-flag)
|
||||
(mh-recenter nil)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-forget-message (index)
|
||||
"Forget the message INDEX from the threading tables."
|
||||
(let* ((id (gethash index mh-thread-index-id-map))
|
||||
|
|
@ -1058,9 +1125,152 @@ than were originally present may be shown as a result."
|
|||
(setf (gethash id mh-thread-duplicates)
|
||||
(remove index duplicates))))))
|
||||
|
||||
|
||||
|
||||
;;; Operations on threads
|
||||
|
||||
(defun mh-thread-current-indentation-level ()
|
||||
"Find the number of spaces by which current message is indented."
|
||||
(save-excursion
|
||||
(let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
|
||||
mh-scan-date-width 1))
|
||||
(level 0))
|
||||
(beginning-of-line)
|
||||
(forward-char address-start-offset)
|
||||
(while (char-equal (char-after) ? )
|
||||
(incf level)
|
||||
(forward-char))
|
||||
level)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-next-sibling (&optional previous-flag)
|
||||
"Jump to next sibling.
|
||||
With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling."
|
||||
(interactive)
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point")))
|
||||
(beginning-of-line)
|
||||
(let ((point (point))
|
||||
(done nil)
|
||||
(my-level (mh-thread-current-indentation-level)))
|
||||
(while (and (not done)
|
||||
(equal (forward-line (if previous-flag -1 1)) 0)
|
||||
(not (eobp)))
|
||||
(let ((level (mh-thread-current-indentation-level)))
|
||||
(cond ((equal level my-level)
|
||||
(setq done 'success))
|
||||
((< level my-level)
|
||||
(message "No %s sibling" (if previous-flag "previous" "next"))
|
||||
(setq done 'failure)))))
|
||||
(cond ((eq done 'success) (mh-maybe-show))
|
||||
((eq done 'failure) (goto-char point))
|
||||
(t (message "No %s sibling" (if previous-flag "previous" "next"))
|
||||
(goto-char point)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-previous-sibling ()
|
||||
"Jump to previous sibling."
|
||||
(interactive)
|
||||
(mh-thread-next-sibling t))
|
||||
|
||||
(defun mh-thread-immediate-ancestor ()
|
||||
"Jump to immediate ancestor in thread tree."
|
||||
(beginning-of-line)
|
||||
(let ((point (point))
|
||||
(ancestor-level (- (mh-thread-current-indentation-level) 2))
|
||||
(done nil))
|
||||
(if (< ancestor-level 0)
|
||||
nil
|
||||
(while (and (not done) (equal (forward-line -1) 0))
|
||||
(when (equal ancestor-level (mh-thread-current-indentation-level))
|
||||
(setq done t)))
|
||||
(unless done
|
||||
(goto-char point))
|
||||
done)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-ancestor (&optional thread-root-flag)
|
||||
"Jump to the ancestor of current message.
|
||||
If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
|
||||
thread tree the message belongs to."
|
||||
(interactive "P")
|
||||
(beginning-of-line)
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point")))
|
||||
(let ((current-level (mh-thread-current-indentation-level)))
|
||||
(cond (thread-root-flag
|
||||
(while (mh-thread-immediate-ancestor))
|
||||
(mh-maybe-show))
|
||||
((equal current-level 1)
|
||||
(message "Message has no ancestor"))
|
||||
(t (mh-thread-immediate-ancestor)
|
||||
(mh-maybe-show)))))
|
||||
|
||||
(defun mh-thread-find-children ()
|
||||
"Return a region containing the current message and its children.
|
||||
The result is returned as a list of two elements. The first is the point at the
|
||||
start of the region and the second is the point at the end."
|
||||
(beginning-of-line)
|
||||
(if (eobp)
|
||||
nil
|
||||
(let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
|
||||
mh-scan-date-width 1))
|
||||
(level (mh-thread-current-indentation-level))
|
||||
spaces begin)
|
||||
(setq begin (point))
|
||||
(setq spaces (format (format "%%%ss" (1+ level)) ""))
|
||||
(forward-line)
|
||||
(block nil
|
||||
(while (not (eobp))
|
||||
(forward-char address-start-offset)
|
||||
(unless (equal (string-match spaces (buffer-substring-no-properties
|
||||
(point) (line-end-position)))
|
||||
0)
|
||||
(beginning-of-line)
|
||||
(backward-char)
|
||||
(return))
|
||||
(forward-line)))
|
||||
(list begin (point)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-delete ()
|
||||
"Mark current message and all its children for subsequent deletion."
|
||||
(interactive)
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point"))
|
||||
(t (mh-delete-msg
|
||||
(apply #'mh-region-to-msg-list (mh-thread-find-children))))))
|
||||
|
||||
;; This doesn't handle mh-default-folder-for-message-function. We should
|
||||
;; refactor that code so that we don't copy it.
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-refile (folder)
|
||||
"Mark current message and all its children for refiling to FOLDER."
|
||||
(interactive (list
|
||||
(intern (mh-prompt-for-folder
|
||||
"Destination"
|
||||
(cond ((eq 'refile (car mh-last-destination-folder))
|
||||
(symbol-name (cdr mh-last-destination-folder)))
|
||||
(t ""))
|
||||
t))))
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point"))
|
||||
(t (mh-refile-msg
|
||||
(apply #'mh-region-to-msg-list (mh-thread-find-children))
|
||||
folder))))
|
||||
|
||||
(provide 'mh-seq)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
;; Copyright (C) 2002 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bill Wohler <wohler@newt.com>
|
||||
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
|
@ -31,71 +31,15 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-speed.el,v 1.26 2002/11/13 19:36:00 wohler Exp $
|
||||
;; $Id: mh-speed.el,v 1.34 2003/01/07 21:15:20 satyaki Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; Requires
|
||||
(require 'cl)
|
||||
(require 'mh-utils)
|
||||
(require 'mh-e)
|
||||
(require 'speedbar)
|
||||
|
||||
;; Autoloads
|
||||
(autoload 'mh-index-goto-nearest-msg "mh-index")
|
||||
(autoload 'mh-index-parse-folder "mh-index")
|
||||
(autoload 'mh-visit-folder "mh-e")
|
||||
|
||||
;; User customizable
|
||||
(defcustom mh-large-folder 200
|
||||
"The number of messages that indicates a large folder.
|
||||
If the number of messages in a folder exceeds this value, confirmation is
|
||||
required when the folder is visited from the speedbar."
|
||||
:type 'integer
|
||||
:group 'mh)
|
||||
|
||||
(defcustom mh-speed-flists-interval 60
|
||||
"Time between calls to flists in seconds.
|
||||
If 0, flists is not called repeatedly."
|
||||
:type 'integer
|
||||
:group 'mh)
|
||||
|
||||
(defcustom mh-speed-run-flists-flag t
|
||||
"Non-nil means flists is used.
|
||||
If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
|
||||
update the display of the number of unseen and total messages in each folder.
|
||||
If resources are limited, this can be set to nil and the speedbar display can
|
||||
be updated manually with the \\[mh-speed-flists] command."
|
||||
:type 'boolean
|
||||
:group 'mh)
|
||||
|
||||
(defface mh-speedbar-folder-face
|
||||
'((((class color) (background light))
|
||||
(:foreground "blue4"))
|
||||
(((class color) (background dark))
|
||||
(:foreground "light blue")))
|
||||
"Face used for folders in the speedbar buffer."
|
||||
:group 'mh)
|
||||
|
||||
(defface mh-speedbar-selected-folder-face
|
||||
'((((class color) (background light))
|
||||
(:foreground "red" :underline t))
|
||||
(((class color) (background dark))
|
||||
(:foreground "red" :underline t))
|
||||
(t (:underline t)))
|
||||
"Face used for the current folder."
|
||||
:group 'mh)
|
||||
|
||||
(defface mh-speedbar-folder-with-unseen-messages-face
|
||||
'((t (:inherit mh-speedbar-folder-face :bold t)))
|
||||
"Face used for folders in the speedbar buffer which have unread messages."
|
||||
:group 'mh)
|
||||
|
||||
(defface mh-speedbar-selected-folder-with-unseen-messages-face
|
||||
'((t (:inherit mh-speedbar-selected-folder-face :bold t)))
|
||||
"Face used for the current folder when it has unread messages."
|
||||
:group 'mh)
|
||||
|
||||
;; Global variables
|
||||
(defvar mh-speed-refresh-flag nil)
|
||||
(defvar mh-speed-last-selected-folder nil)
|
||||
|
|
@ -116,6 +60,7 @@ be updated manually with the \\[mh-speed-flists] command."
|
|||
(cdr (assoc "files" speedbar-stealthy-function-list))))
|
||||
|
||||
;; Functions called by speedbar to initialize display...
|
||||
;;;###mh-autoload
|
||||
(defun mh-folder-speedbar-buttons (buffer)
|
||||
"Interface function to create MH-E speedbar buffer.
|
||||
BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
|
||||
|
|
@ -134,24 +79,22 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
|
|||
(when mh-speed-run-flists-flag
|
||||
(mh-speed-flists nil))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
|
||||
(defalias 'mh-index-folder-speedbar-buttons 'mh-folder-speedbar-buttons)
|
||||
(defalias 'mh-index-show-speedbar-buttons 'mh-folder-speedbar-buttons)
|
||||
;;;###mh-autoload
|
||||
(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
|
||||
|
||||
;; Keymaps for speedbar...
|
||||
(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
|
||||
"Specialized speedbar keymap for MH-E buffers.")
|
||||
(gnus-define-keys mh-folder-speedbar-key-map
|
||||
"+" mh-speed-expand-folder
|
||||
"-" mh-speed-contract-folder
|
||||
"\r" mh-speed-view
|
||||
"f" mh-speed-flists
|
||||
"i" mh-speed-invalidate-map)
|
||||
"+" mh-speed-expand-folder
|
||||
"-" mh-speed-contract-folder
|
||||
"\r" mh-speed-view
|
||||
"f" mh-speed-flists
|
||||
"i" mh-speed-invalidate-map)
|
||||
|
||||
(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
(defvar mh-index-folder-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
(defvar mh-index-show-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
|
||||
;; Menus for speedbar...
|
||||
|
|
@ -171,8 +114,6 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
|
|||
"Extra menu items for speedbar.")
|
||||
|
||||
(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
(defvar mh-index-folder-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
(defvar mh-index-show-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
|
||||
(defmacro mh-speed-select-attached-frame ()
|
||||
|
|
@ -193,12 +134,12 @@ own when you are trying to navigate around in the speedbar buffer.
|
|||
|
||||
The update is always carried out if FORCE is non-nil."
|
||||
(let* ((lastf (selected-frame))
|
||||
(newcf (save-excursion
|
||||
(newcf (save-excursion
|
||||
(mh-speed-select-attached-frame)
|
||||
(prog1 (mh-speed-extract-folder-name (buffer-name))
|
||||
(select-frame lastf))))
|
||||
(lastb (current-buffer))
|
||||
(case-fold-search t))
|
||||
(lastb (current-buffer))
|
||||
(case-fold-search t))
|
||||
(when (or force
|
||||
(and mh-speed-refresh-flag (not (eq lastf speedbar-frame)))
|
||||
(and (stringp newcf)
|
||||
|
|
@ -271,7 +212,7 @@ The function will expand out parent folders of FOLDER if needed."
|
|||
(suffix-list ())
|
||||
(last-slash t))
|
||||
(while (and (not (gethash prefix mh-speed-folder-map)) last-slash)
|
||||
(setq last-slash (search "/" prefix :from-end t))
|
||||
(setq last-slash (mh-search-from-end ?/ prefix))
|
||||
(when (integerp last-slash)
|
||||
(push (substring prefix (1+ last-slash)) suffix-list)
|
||||
(setq prefix (substring prefix 0 last-slash))))
|
||||
|
|
@ -306,15 +247,10 @@ Do the right thing for the different kinds of buffers that MH-E uses."
|
|||
((eq major-mode 'mh-show-mode)
|
||||
(set-buffer mh-show-folder-buffer)
|
||||
mh-current-folder)
|
||||
((eq major-mode 'mh-index-folder-mode)
|
||||
(save-excursion
|
||||
(mh-index-goto-nearest-msg)
|
||||
(mh-index-parse-folder)))
|
||||
((or (eq major-mode 'mh-index-show-mode)
|
||||
(eq major-mode 'mh-letter-mode))
|
||||
((eq major-mode 'mh-letter-mode)
|
||||
(when (string-match mh-user-path buffer-file-name)
|
||||
(let* ((rel-path (substring buffer-file-name (match-end 0)))
|
||||
(directory-end (search "/" rel-path :from-end t)))
|
||||
(directory-end (mh-search-from-end ?/ rel-path)))
|
||||
(when directory-end
|
||||
(format "+%s" (substring rel-path 0 directory-end)))))))))
|
||||
|
||||
|
|
@ -347,12 +283,14 @@ Do the right thing for the different kinds of buffers that MH-E uses."
|
|||
(add-text-properties
|
||||
(line-beginning-position) (1+ (line-beginning-position))
|
||||
`(mh-folder ,folder-name
|
||||
mh-expanded nil
|
||||
mh-children-p ,(not (not (cdr f)))
|
||||
,@(if counts `(mh-count (,(car counts) . ,(cdr counts))) ())
|
||||
mh-level ,level))))))
|
||||
mh-expanded nil
|
||||
mh-children-p ,(not (not (cdr f)))
|
||||
,@(if counts `(mh-count
|
||||
(,(car counts) . ,(cdr counts))) ())
|
||||
mh-level ,level))))))
|
||||
folder-list)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-toggle (&rest args)
|
||||
"Toggle the display of child folders.
|
||||
The otional ARGS are ignored and there for compatibilty with speedbar."
|
||||
|
|
@ -393,45 +331,14 @@ The otional ARGS are ignored and there for compatibilty with speedbar."
|
|||
(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
|
||||
(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
|
||||
|
||||
(defun mh-speed-folder-size ()
|
||||
"Find folder size if folder on current line."
|
||||
(let ((folder (get-text-property (line-beginning-position) 'mh-folder)))
|
||||
(or (cdr (get-text-property (line-beginning-position) 'mh-count))
|
||||
(and (null folder) 0)
|
||||
(with-temp-buffer
|
||||
(call-process (expand-file-name "flist" mh-progs) nil t nil
|
||||
"-norecurse" folder)
|
||||
(goto-char (point-min))
|
||||
(unless (re-search-forward "out of " (line-end-position) t)
|
||||
(error "Call to flist failed on folder %s" folder))
|
||||
(car (read-from-string
|
||||
(buffer-substring-no-properties (point)
|
||||
(line-end-position))))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-view (&rest args)
|
||||
"View folder on current line.
|
||||
Optional ARGS are ignored."
|
||||
(interactive)
|
||||
(declare (ignore args))
|
||||
(let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
|
||||
(range
|
||||
(cond ((save-excursion
|
||||
(beginning-of-line)
|
||||
(re-search-forward "([1-9][0-9]*/[0-9]+)"
|
||||
(line-end-position) t))
|
||||
mh-unseen-seq)
|
||||
((> (mh-speed-folder-size) mh-large-folder)
|
||||
(let* ((size (mh-speed-folder-size))
|
||||
(prompt
|
||||
(format "How many messages from %s (default: %s): "
|
||||
folder size))
|
||||
(in (read-string prompt nil nil
|
||||
(number-to-string size)))
|
||||
(result (car (ignore-errors (read-from-string in)))))
|
||||
(cond ((null result) (format "last:%s" size))
|
||||
((numberp result) (format "last:%s" result))
|
||||
(t (format "%s" result)))))
|
||||
(t nil))))
|
||||
(range (and (stringp folder) (mh-read-msg-range folder))))
|
||||
(when (stringp folder)
|
||||
(speedbar-with-attached-buffer
|
||||
(mh-visit-folder folder range)
|
||||
|
|
@ -463,19 +370,22 @@ aren't usually mail folders are hidden."
|
|||
(apply #'call-process arg-list)
|
||||
(goto-char (point-min))
|
||||
(while (not (and (eolp) (bolp)))
|
||||
(let ((folder-end (or (search-forward "+ " (line-end-position) t)
|
||||
(search-forward " " (line-end-position) t))))
|
||||
(when (integerp folder-end)
|
||||
(let ((name (buffer-substring (line-beginning-position)
|
||||
(match-beginning 0))))
|
||||
(goto-char (line-end-position))
|
||||
(let ((has-pos (search-backward " has " (line-beginning-position) t)))
|
||||
(when (integerp has-pos)
|
||||
(while (or (equal (char-after has-pos) ? )
|
||||
(equal (char-after has-pos) ?+))
|
||||
(decf has-pos))
|
||||
(incf has-pos)
|
||||
(let ((name (buffer-substring (line-beginning-position) has-pos)))
|
||||
(let ((first-char (substring name 0 1)))
|
||||
(unless (or (string-equal first-char ".")
|
||||
(string-equal first-char "#")
|
||||
(string-equal first-char ","))
|
||||
(push
|
||||
(cons name
|
||||
(search-forward "(others)" (line-end-position) t))
|
||||
results)))))
|
||||
(cons name
|
||||
(search-forward "(others)" (line-end-position) t))
|
||||
results)))))
|
||||
(forward-line 1))))
|
||||
(setq results (nreverse results))
|
||||
(when (stringp folder)
|
||||
|
|
@ -487,6 +397,7 @@ aren't usually mail folders are hidden."
|
|||
results))))
|
||||
results))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-flists (force)
|
||||
"Execute flists -recurse and update message counts.
|
||||
If FORCE is non-nil the timer is reset."
|
||||
|
|
@ -509,7 +420,8 @@ If FORCE is non-nil the timer is reset."
|
|||
'exit)))
|
||||
(setq mh-speed-flists-process
|
||||
(start-process (expand-file-name "flists" mh-progs) nil
|
||||
"flists" "-recurse"))
|
||||
"flists" "-recurse"
|
||||
"-sequence" (symbol-name mh-unseen-seq)))
|
||||
(set-process-filter mh-speed-flists-process
|
||||
'mh-speed-parse-flists-output)))))))
|
||||
|
||||
|
|
@ -527,61 +439,53 @@ next."
|
|||
mh-speed-partial-line
|
||||
(substring output position line-end))
|
||||
mh-speed-partial-line "")
|
||||
(when (string-match "+? " line)
|
||||
(setq folder (format "+%s" (subseq line 0 (match-beginning 0))))
|
||||
(when (string-match " has " line)
|
||||
(setq unseen (car (read-from-string line (match-end 0))))
|
||||
(when (string-match "; out of " line)
|
||||
(setq total (car (read-from-string line (match-end 0))))
|
||||
(setf (gethash folder mh-speed-flists-cache)
|
||||
(cons unseen total))
|
||||
(save-excursion
|
||||
(when (buffer-live-p (get-buffer speedbar-buffer))
|
||||
(set-buffer speedbar-buffer)
|
||||
(speedbar-with-writable
|
||||
(when (get-text-property (point-min) 'mh-level)
|
||||
(let ((pos (gethash folder mh-speed-folder-map))
|
||||
face)
|
||||
(when pos
|
||||
(goto-char pos)
|
||||
(goto-char (line-beginning-position))
|
||||
(cond
|
||||
((null (get-text-property (point) 'mh-count))
|
||||
(goto-char (line-end-position))
|
||||
(setq face (get-text-property (1- (point))
|
||||
'face))
|
||||
(insert (format " (%s/%s)" unseen total))
|
||||
(mh-speed-highlight 'unknown face)
|
||||
(goto-char (line-beginning-position))
|
||||
(add-text-properties
|
||||
(point) (1+ (point))
|
||||
`(mh-count (,unseen . ,total))))
|
||||
((not
|
||||
(equal (get-text-property (point) 'mh-count)
|
||||
(cons unseen total)))
|
||||
(goto-char (line-end-position))
|
||||
(setq face (get-text-property (1- (point))
|
||||
'face))
|
||||
(re-search-backward
|
||||
" " (line-beginning-position) t)
|
||||
(delete-region (point) (line-end-position))
|
||||
(insert (format " (%s/%s)" unseen total))
|
||||
(mh-speed-highlight 'unknown face)
|
||||
(goto-char (line-beginning-position))
|
||||
(add-text-properties
|
||||
(point) (1+ (point))
|
||||
`(mh-count (,unseen . ,total))))))))))))))
|
||||
(multiple-value-setq (folder unseen total)
|
||||
(mh-parse-flist-output-line line))
|
||||
(when (and folder unseen total)
|
||||
(setf (gethash folder mh-speed-flists-cache) (cons unseen total))
|
||||
(save-excursion
|
||||
(when (buffer-live-p (get-buffer speedbar-buffer))
|
||||
(set-buffer speedbar-buffer)
|
||||
(speedbar-with-writable
|
||||
(when (get-text-property (point-min) 'mh-level)
|
||||
(let ((pos (gethash folder mh-speed-folder-map))
|
||||
face)
|
||||
(when pos
|
||||
(goto-char pos)
|
||||
(goto-char (line-beginning-position))
|
||||
(cond
|
||||
((null (get-text-property (point) 'mh-count))
|
||||
(goto-char (line-end-position))
|
||||
(setq face (get-text-property (1- (point)) 'face))
|
||||
(insert (format " (%s/%s)" unseen total))
|
||||
(mh-speed-highlight 'unknown face)
|
||||
(goto-char (line-beginning-position))
|
||||
(add-text-properties (point) (1+ (point))
|
||||
`(mh-count (,unseen . ,total))))
|
||||
((not (equal (get-text-property (point) 'mh-count)
|
||||
(cons unseen total)))
|
||||
(goto-char (line-end-position))
|
||||
(setq face (get-text-property (1- (point)) 'face))
|
||||
(re-search-backward " " (line-beginning-position) t)
|
||||
(delete-region (point) (line-end-position))
|
||||
(insert (format " (%s/%s)" unseen total))
|
||||
(mh-speed-highlight 'unknown face)
|
||||
(goto-char (line-beginning-position))
|
||||
(add-text-properties
|
||||
(point) (1+ (point))
|
||||
`(mh-count (,unseen . ,total))))))))))))
|
||||
(setq position (1+ line-end)))
|
||||
(set-match-data prevailing-match-data))
|
||||
(setq mh-speed-partial-line (subseq output position))))
|
||||
(setq mh-speed-partial-line (substring output position))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-invalidate-map (folder)
|
||||
"Remove FOLDER from various optimization caches."
|
||||
(interactive (list ""))
|
||||
(save-excursion
|
||||
(set-buffer speedbar-buffer)
|
||||
(let* ((speedbar-update-flag nil)
|
||||
(last-slash (search "/" folder :from-end t))
|
||||
(last-slash (mh-search-from-end ?/ folder))
|
||||
(parent (if last-slash (substring folder 0 last-slash) nil))
|
||||
(parent-position (gethash parent mh-speed-folder-map))
|
||||
(parent-change nil))
|
||||
|
|
@ -615,13 +519,14 @@ next."
|
|||
(when (equal folder "")
|
||||
(clrhash mh-speed-folders-cache)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-add-folder (folder)
|
||||
"Add FOLDER since it is being created.
|
||||
The function invalidates the latest ancestor that is present."
|
||||
(save-excursion
|
||||
(set-buffer speedbar-buffer)
|
||||
(let ((speedbar-update-flag nil)
|
||||
(last-slash (search "/" folder :from-end t))
|
||||
(last-slash (mh-search-from-end ?/ folder))
|
||||
(ancestor folder)
|
||||
(ancestor-pos nil))
|
||||
(block while-loop
|
||||
|
|
@ -630,7 +535,7 @@ The function invalidates the latest ancestor that is present."
|
|||
(setq ancestor-pos (gethash ancestor mh-speed-folder-map))
|
||||
(when ancestor-pos
|
||||
(return-from while-loop))
|
||||
(setq last-slash (search "/" ancestor :from-end t))))
|
||||
(setq last-slash (mh-search-from-end ?/ ancestor))))
|
||||
(unless ancestor-pos (setq ancestor nil))
|
||||
(goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
|
||||
(speedbar-with-writable
|
||||
|
|
@ -650,17 +555,18 @@ The function invalidates the latest ancestor that is present."
|
|||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (re-search-forward "\\[.\\]" (line-end-position) t)
|
||||
(speedbar-with-writable
|
||||
(speedbar-with-writable
|
||||
(backward-char 2)
|
||||
(delete-char 1)
|
||||
(insert-char char 1 t)
|
||||
(put-text-property (point) (1- (point)) 'invisible nil)
|
||||
;; make sure we fix the image on the text here.
|
||||
(speedbar-insert-image-button-maybe (- (point) 2) 3)))))
|
||||
(delete-char 1)
|
||||
(insert-char char 1 t)
|
||||
(put-text-property (point) (1- (point)) 'invisible nil)
|
||||
;; make sure we fix the image on the text here.
|
||||
(speedbar-insert-image-button-maybe (- (point) 2) 3)))))
|
||||
|
||||
(provide 'mh-speed)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -28,7 +28,7 @@
|
|||
|
||||
;;; Change Log:
|
||||
|
||||
;; $Id: mh-xemacs-compat.el,v 1.12 2002/11/02 19:56:50 wohler Exp $
|
||||
;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -52,10 +52,10 @@
|
|||
(unless (fboundp 'cancel-timer)
|
||||
(defalias 'cancel-timer 'delete-itimer))
|
||||
|
||||
|
||||
(provide 'mh-xemacs-compat)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; indent-tabs-mode: nil
|
||||
;;; sentence-end-double-space: nil
|
||||
;;; End:
|
||||
|
||||
|
|
|
|||
BIN
lisp/toolbar/alias.pbm
Normal file
BIN
lisp/toolbar/alias.pbm
Normal file
Binary file not shown.
33
lisp/toolbar/alias.xpm
Normal file
33
lisp/toolbar/alias.xpm
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
/* XPM */
|
||||
static char * alias_xpm[] = {
|
||||
/* columns rows colors chars-per-pixel */
|
||||
"24 24 4 1",
|
||||
" c None",
|
||||
". c #61b761b7600a",
|
||||
"X c #a5d8a5d89550",
|
||||
"o c black",
|
||||
/* pixels */
|
||||
" ",
|
||||
" ",
|
||||
" ",
|
||||
" ...... ",
|
||||
" ...XXXX..XX ",
|
||||
" o..ooooooo... ",
|
||||
" ooo oooo..X ",
|
||||
" o.X ooo... ",
|
||||
" o.X ooo.XX ",
|
||||
" o.X oo.. ",
|
||||
" o.X oo. ",
|
||||
" o... oo.. ",
|
||||
" o.X o.. ",
|
||||
" o.XX oX. ",
|
||||
" o.... oo. ",
|
||||
" o..XX oooo ",
|
||||
" o...XXX XXoooo ",
|
||||
" ooo........ooooo ",
|
||||
" oooooXXooooo.oo ",
|
||||
" ooo o..oo",
|
||||
" o...",
|
||||
" ooo",
|
||||
" oo",
|
||||
" "};
|
||||
Loading…
Add table
Reference in a new issue