mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-32

Browse source 
Merge from emacs--cvs-trunk--0

Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-486
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-487
   Tweak permissions

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-488
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-489
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-490
   Update from CVS: man/fixit.texi (Spelling): Fix typo.

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-491
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-494
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-495
   Update from CVS: Add missing lisp/mh-e files

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-496
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-499
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-500
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-513
   Update from CVS
This commit is contained in:
Miles Bader 2004-08-27 07:00:34 +00:00
commit b71f2b97d3
128 changed files with 12489 additions and 7377 deletions
Download patch file Download diff file Expand all files Collapse all files

38
etc/ChangeLog
View file

@ -1,3 +1,41 @@
2004-08-24 Bill Wohler <wohler@newt.com>
* NEWS, MH-E-NEWS: Upgraded to MH-E version 7.82.
2004-08-22 David Kastrup <dak@gnu.org>
* PROBLEMS, MAILINGLISTS: Update AUCTeX information.
2004-08-21 Bill Wohler <wohler@newt.com>
* NEWS, MH-E-NEWS: Upgraded to MH-E version 7.81.
2004-08-21 Eric S. Raymond <esr@thyrsus.com>
* PROBLEMS: Massively rearranged by category, to make environment
features and symptoms easier to find. Bugs relating to
20th-century systems moved to the end. Most problem headers
changed to "object: variation" format.
2004-08-15 Bill Wohler <wohler@newt.com>
* NEWS, MH-E-NEWS: Upgraded to MH-E version 7.4.80.
2004-08-14 Romain Francoise <romain@orebokech.com>
* NEWS: Mention the thumbs.el package.
2004-08-14 Eric Hanchrow <offby1@blarg.net>
* TUTORIAL.es: Replace actual whitespace with the magic string
that causes help-with-tutorial to automatically insert the correct
amount.
2004-08-10 Steven Tamm <steventamm@mac.com>
* PROBLEMS: Remove description of Mac OS version upgrade
problems as it is no longer applicable.
2004-07-27 Werner Lemberg <wl@gnu.org>
* NEWS: Document all new tutorials.

9
etc/MAILINGLISTS
View file

@ -1224,13 +1224,14 @@ rmail mode.
The supercite mailing list covers issues related to the advanced
mail/news citation package called Supercite for GNU Emacs.
* auc-tex-request@iesd.auc.dk to subscribe
* auc-tex-request@sunsite.dk to subscribe
** USENET newsgroup: NONE YET
** Send contributions to: auc-tex@iesd.auc.dk
** Send contributions to: auc-tex@sunsite.dk
The list is intended to exchange information about AUC TeX, such as
The list is intended to exchange information about AUCTeX, such as
bug reports, request for help, and information on current
developments. AUC TeX is a much enhanced LaTeX mode for GNU Emacs.
developments. AUCTeX is a much enhanced TeX/LaTeX/ConTeXt/Texinfo mode
for GNU Emacs.
The list is unmoderated.

385
etc/MH-E-NEWS
View file

@ -6,6 +6,389 @@ Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
notice and this notice are preserved.
* Changes in MH-E 7.82
Version 7.82 continues to address the saga surrounding the use of CL
macros in CVS Emacs and fixes the auto-detection of vanilla MH (SF
#1014781).
* Changes in MH-E 7.81
Version 7.81 fixes a `wrong-type-argument' argument error that
sometimes occurred when processing the Message-ID, adds the ";
(mh-toggle-mh-decode-mime-flag)" command, and uses ":default" instead
of "default" in `mh-identity-handlers' to avoid problems with
"Default:" as a user defined field. If you have modified
`mh-identity-handlers' in your .emacs, you'll need to rename "default"
to ":default". This release also corrects the release numbering; the
previous version number was intended to be 7.80.
* Changes in MH-E 7.4.80
Version 7.4.80 now supports GNU mailutils, S/MIME, picons,
which-func-mode, has an improved interface for hiding header fields,
improves upon the MH variant detection, and contains many bug fixes.
Those of you familiar with the GNU version numbering schemes will
recognize this as an alpha release. This does not reflect on the
quality of this release which is as high as it has always been.
Although we are not ready to release 8.0, we want you to have access
to the work that has been hiding in CVS. At the same time we want to
make it clear that there are incompatible changes with previous
versions.
We are planning to release the long-awaited manual update synchronized
with version 8.0. We are using documentation from the manual in the
docstrings which is hoped to make "C-h f (describe-function)" really
useful and create a seamless experience when switching back and forth
between the manual and the docstrings. This has been done in about
half of the variables and functions in this version.
The writing of the manual has revealed a few inconsistencies in the
software whose fixes have resulted in incompatible changes, and there
may well be more. So, unlike version 7 which was chock full of new
features, version 8's strengths will include complete documentation
and higher quality.
** New Features in MH-E 7.4.80
*** GNU mailutils Support
MH-E now supports GNU mailutils 0.4 and higher versions.
*** S/MIME Support
MH-E now supports S/MIME using Gnus 5.10.6 or higher.
*** Picon Support
In addition to the other methods of displaying an icon for the sender
of a message, MH-E can now display images from a picon directory. The
directory search path is found in the `mh-picon-directory-list'
variable. More documentation is found in the "facedb" sections in the
xfaces man page. [NOTE: need to make mh-picon-directory-list an option
and add xfaces facedb documentation to it.]
*** X-Image-URL Updates
Now support the use of `curl' and `fetch' as alternatives to `wget' to
obtain the image. The display of images are controlled with the
`mh-show-use-xface-flag' option while the `mh-fetch-x-image-url'
option controls how the images are fetched.
WARNING: There are security concerns with this feature. Please read
the documentation for these options carefully before changing the
default.
*** Updates to mh-identity-list
Note that the field names found in `mh-identity-list' that refer to
the fields in `mh-identity-handlers' have changed in an incompatible
way from 7.4.4. In general, the symbolic names now have a ":" prefix
to avoid collisions with header fields. Before starting Emacs, edit
your .emacs and insert ":" before "signature" if you have defined it.
You can change your attribution in replies with the new "Attribution
Verb" field, and you can set your default GPG user ID with the "GPG
key ID" field.
Signatures can now be read from the `mh-signature-file-name' variable,
or come from a function, in addition to a named file. If you write
your own function, variables that you can use include
`mh-signature-separator-regexp', `mh-signature-separator',
and `mh-signature-separator-p'.
The handling of these fields has been moved into a new
`mh-identity-handlers' option, an alist of fields (strings) and
handlers (functions). Strings are lowercase. Use ":signature" for
Signature and ":pgg-default-user-id" for GPG Key ID. The function
associated with the string "default" is used if no other functions are
appropriate. For this reason, don't name a header field "Default".
If you point your signature at a vCard file with a vcf suffix, then it
will be incorporated as a vCard body part (closes SF #802723).
*** Catchup Command
There is a new "F c (mh-catchup)" command that marks all unread
messages in the current folder as read.
*** Change Content-Type Renderer on the Fly in MH-Show Buffer
This has been implemented by adding the key binding "K e
(mh-display-with-external-viewer)". For inline text/html parts,
buttons aren't displayed by default. In that case use "K t
(mh-toggle-mime-buttons)" to display the button before viewing it with
an external browser (closes SF #839318).
*** Use which-func-mode to Display Folder in Index Mode
Turning on `which-func-mode' displays the folder name of the message
under the cursor in index folders (closes SF #855520).
*** Render Signature and vCard in Italics
This has been implemented. Use `mh-show-signature-face' to customize
the face used (closes SF #802722).
*** New Print Map
There is now a keymap for the printing functions whose prefix is "P".
The command "l (mh-print-msg)" has been replaced with "P l". Other new
functions in this keymap include:
P A mh-ps-print-toggle-mime
P C mh-ps-print-toggle-color
P F mh-ps-print-toggle-faces
P M mh-ps-print-toggle-mime
P f mh-ps-print-msg-file
P l mh-print-msg
P p mh-ps-print-msg
P s mh-ps-print-msg-show
*** Draft Buffer Keymap Changes
The keymap in the draft buffer has been modified slightly. The old
anonymous ftp and tar composition commands have been reinstated and
letter signing and encrypting keymaps have been added.
The type of signing or encryption has been generalized so the method
is now an option rather than a part of the function's name. The option
is `mh-mml-method-default' and choices include PGP (MIME), PGP,
S/MIME, or none.
Key 7.4.4 7.4.80
C-c RET C-e mh-mml-secure-message-encrypt-pgpmime
mh-mml-secure-message-encrypt
C-c RET C-s mh-mml-secure-message-sign-pgpmime
-
C-c RET C-g - mh-mhn-compose-anon-ftp
C-c RET C-n - mh-mml-unsecure-message
C-c RET C-s - mh-mml-secure-message-sign
C-c RET C-t - mh-mhn-compose-external-compressed-tar
C-c RET C-s mh-mml-secure-message-sign-pgpmime
mh-mml-secure-message-sign
C-c RET C-x - mh-mhn-compose-external-type
C-c RET e mh-mml-secure-message-encrypt-pgpmime
Prefix Command
C-c RET e e - mh-mml-secure-message-encrypt
C-c RET e s - mh-mml-secure-message-signencrypt
C-c RET g - mh-mhn-compose-anon-ftp
C-c RET n - mh-mml-unsecure-message
C-c RET s mh-mml-secure-message-sign-pgpmime
Prefix Command
C-c RET s e - mh-mml-secure-message-signencrypt
C-c RET s s - mh-mml-secure-message-sign
C-c RET t - mh-mhn-compose-external-compressed-tar
C-c RET x - mh-mhn-compose-external-type
*** Speedbar: Highlight Folders With Unseen
The speedbar now renders the folders with unseen messages in boldface
which makes them easier to identify (closes SF #623369).
*** Quick Key Help
The "? (mh-help)" function now displays the help in its own buffer
called *MH-E Help* (closes SF #493740 and SF #656631).
*** New Startup File mh-e-autoloads.el
If you are installing MH-E yourself, then you can replace any
autoloads you may have with "(require 'mh-e-autoloads.el)". See the
README for details.
*** Glimpse Support Removed
Since glimpse isn't free, we cannot mention it. Glimpse has been
removed from the option `mh-indexer-choices' (closes SF #831276).
*** mh-msg-is-in-seq Update
Can now specify an alternate message number to "S s
(mh-msg-is-in-seq)" with a prefix argument.
** New Variables in MH-E 7.4.80
Variables that have been added to MH-E that have not been discussed
elsewhere are listed here.
*** mail-citation-hook
Hook for modifying a citation just inserted in the mail buffer.
*** mh-alias-reloaded-hook
Invoked by `mh-alias-reload' after reloading aliases.
*** mh-auto-fields-prompt-flag
Non-nil means to prompt before sending if fields in
`mh-auto-fields-list' are inserted.
*** mh-default-folder-for-message-function
Function to select a default folder for refiling or `Fcc'.
*** mh-forward-hook
Invoked on the forwarded letter by "f (mh-forward)".
*** mh-invisible-header-fields-default
List of hidden header fields. The header fields listed in this option
are hidden, although you can check off any field that you would like
to see. Header fields that you would like to hide that aren't listed
can be added to the `mh-invisible-header-fields' option (closes SF
#752045).
The option `mh-visible-header-fields' has been deleted.
*** mh-junk-background
If on, spam programs are run in background. This used to be the
default behavior but this could overwhelm a system if many messages
were black- or whitelisted at once. The spam programs are now run in
the foreground, but this option can be used to put them back in the
background.
*** mh-signature-separator-flag
Non-nil means a signature separator should be inserted. It is not
recommended that you change this option since various mail user
agents, including MH-E, use the separator to present the signature
differently, and to suppress the signature when replying or yanking a
letter into a draft.
*** mh-variant
Specifies the variant used by MH-E. The default setting of this option
is `Auto-detect' which means that MH-E will automatically choose the
first of nmh, MH, or GNU mailutils that it finds in the directories
listed in `mh-path', `mh-sys-path', and `exec-path'. If, for example,
you have both nmh and mailutils installed and `mh-variant-in-use' was
initialized to nmh but you want to use mailutils, then you can set
this option to `mailutils'.
When this variable is changed, MH-E resets `mh-progs', `mh-lib',
`mh-lib-progs', `mh-flists-present-flag', and `mh-variant-in-use'
accordingly.
If you've set these variables in your .emacs, it is strongly suggested
that you comment them out. The MH detection code has been completely
rewritten and it is very likely that you no longer to set them and
their setting may confuse other MH-E settings.
** Variables Deleted in MH-E
Variables that have been removed from MH-E that have not been
discussed elsewhere are listed here.
*** mh-alias-system-aliases
System definitions should not be a user option.
*** mh-junk-mail-folder
Since this variable can accept values other than folder names, it was
renamed to `mh-junk-disposition' to more accurately reflect the content.
** Bug Fixes in MH-E 7.4.80
Many bugs were fixed in this version that aren't listed below.
*** mh-extract-rejected-mail Can't Do MIME (and Other Formats)
Now handles qmail and exim bounces (addresses SF #404965).
*** mh-rmail Hangs in XEmacs
We've determined that MH-E is incompatible with some versions of
XEmacs (21.5.9-21.5.16). More recent versions work fine. If you think
our list is too broad, please let us know which version of XEmacs you
are using (closes SF #644321).
*** Inconsistent Prompts
Prompt formats are now consistent throughout the application (closes
SF #730470).
*** Empty Shell Comments Confuse mh-mhn-directive-present-p
If you had a string that matched the regexp "^# $" in your draft, it
would cause an error. This has been fixed (closes SF #762458).
*** Quote Hashes When mhbuild Directives Used
A related bug, if you had empty shell comments but inserted your own
directives, you'd get another error from mhbuild. This has been fixed
by quoting the hash ("^# $") like this "##" before submitting to
mhbuild (closes SF #762464).
*** Inconsistent Usage in Scan Formatting Variables
The variables:
mh-note-cur
mh-note-deleted
mh-note-dist
mh-note-forw
mh-note-refiled
mh-note-repl
mh-note-seq
used to contain strings. Although only the first character was read,
the entire string would be inserted which may have caused problems.
These variables have been converted to character constants so that
only a single character can be inserted into the scan line (closes SF
#770772).
*** Bad Handling of Aliases That Conflict With Local User Names
If a user name existed both locally and in the aliases file, the local
user would be flashed, but the alias would be used when sending. This
has been fixed so that the user name that is flashed is the same as
the name that is sent (closes SF #772595).
*** Args out of range
In rare and non-reproducible circumstances, compilation sometimes
threw an "Args out of range" error. Nonetheless, this has been fixed
(closes SF #806577).
*** mh-forward hard-codes '-mime' Switch on nmh
Added new option `mh-compose-forward-as-mime-flag' that controls whether
messages are forwarded as MIME attachments (closes SF #827203).
*** Not Re-prompted to Sign After Pass Phrase Typo
If there were errors when sending a signed message (like getting the
pass phrase wrong), the MML markup remained in the draft buffer. The
draft buffer is now restored if there is an error (closes SF #839303).
*** Font-lock Gets Confused in MH-Letter Buffer
If a user manually moved the cursor to the end of the header field
separator line (by mouse click or keyboard navigation) and hit Enter
to start typing their message, any line in the body with a colon would
be fontified with a gray background. This has been fixed (closes SF
#855479).
*** mh-refile-msg Fails to Suggest Folder for Empty Message
If you received a message with an empty body from someone who is
listed in your aliases file, "o (mh-refile-msg)" failed to suggest the
correct folder. This has been fixed (closes SF #917096).
*** Error Visiting Folder With no Unseen Messages
If you visited a folder without unseen messages and the option "flist:
-noshowzero" is present in your ~/.mh_profile, you'd get an error. This
has been fixed (closes SF #933954).
* Changes in MH-E 7.4.4
Version 7.4.4 addresses programmatic issues from the FSF and prepares
@ -18,7 +401,7 @@ code moved here from desktop.el.
* Changes in MH-E 7.4.3
Version 7.4.3 fixes the problem where mh-identity-list was not getting
Version 7.4.3 fixes the problem where `mh-identity-list' was not getting
set from .emacs.
* Changes in MH-E 7.4.2

22
etc/NEWS
View file

@ -173,6 +173,8 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* Changes in Emacs 21.4
** global-whitespace-mode is a new alias for whitespace-global-mode.
+++
** There are now two new regular expression operators, \_< and \_>,
for matching the beginning and end of a symbol. A symbol is a
@ -267,6 +269,11 @@ just put point at the end of the buffer and it stays there. This
rule applies to file buffers. For non-file buffers, the behavior may
be mode dependent.
If you are sure that the file will only change by growing at the end,
then you can tail the file more efficiently by using the new minor
mode Auto Revert Tail mode. The function `auto-revert-tail-mode'
toggles this mode.
** Auto Revert mode is now more careful to avoid excessive reverts and
other potential problems when deciding which non-file buffers to
revert. This matters especially if Global Auto Revert mode is enabled
@ -733,7 +740,7 @@ You can now put the init files .emacs and .emacs_SHELL under
** MH-E changes.
Upgraded to MH-E version 7.4.4. There have been major changes since
Upgraded to MH-E version 7.82. There have been major changes since
version 5.0.2; see MH-E-NEWS for details.
+++
@ -2041,9 +2048,12 @@ source files. See the Flymake's Info manual for more details.
of hierarchical data as an outline. For example, the tree-widget is
well suited to display a hierarchy of directories and files.
** The wdired.el package allows you to use normal editing commands on dired
** The wdired.el package allows you to use normal editing commands on Dired
buffers to change filenames, permissions, etc...
** The thumbs.el package allows you to preview image files as thumbnails
and can be invoked from a Dired buffer.
** The new python.el package is used to edit Python and Jython programs.
** The URL package (which had been part of W3) is now part of Emacs.
@ -3343,7 +3353,13 @@ and modify elements on this property list.
The new low-level functions process-plist and set-process-plist are
used to access and replace the entire property list of a process.
???
*** Function accept-process-output now has an optional fourth arg
`just-this-one'. If non-nil, only output from the specified process
is handled, suspending output from other processes. If value is an
integer, also inhibit running timers. This feature is generally not
recommended, but may be necessary for specific applications, such as
speech synthesis.
*** Adaptive read buffering of subprocess output.
On some systems, when emacs reads the output from a subprocess, the

5821
etc/PROBLEMS
View file

File diff suppressed because it is too large Load diff

5
etc/TODO
View file

@ -62,6 +62,11 @@ to the FSF.
* Other features we would like:
** ange-ftp
*** understand sftp
*** ignore some irrelevant errors (like IPv6 and kerberos thingies).
*** Use MLS for ange-ftp-insert-directory if a list of files is specified.
** Ability to map a key, including all modified-combinations.
E.g map mouse-4 to wheel-up as well as M-mouse-4 -> M-wheel-up
M-C-mouse-4 -> M-C-wheel-up, H-S-C-M-s-double-mouse-4 ->

28
etc/TUTORIAL.es
View file

@ -18,32 +18,8 @@ ocasi
Nota importante: para terminar la sesión de Emacs teclee C-x C-c (dos
caracteres). Los caracteres ">>" en el margen izquierdo indican
instrucciones para que usted trate de usar un comando. Por ejemplo:
[Mitad de página en blanco para propósitos didácticos. El texto
continúa abajo]
<<Blank lines inserted around following line by help-with-tutorial>>
[Mitad de página en blanco para propósitos didácticos. El texto continúa abajo]
>> Ahora teclee C-v (ver la próxima pantalla) para desplazarse a la
siguiente pantalla (hágalo manteniendo la tecla control
oprimida mientras teclea v). Desde ahora debería hacer esto

14
leim/ChangeLog
View file

@ -1,3 +1,13 @@
2004-08-21 David Kastrup <dak@gnu.org>
* quail/greek.el ("greek-babel"): Add accent/breathing/uppercase
combinations.
2004-08-16 Kenichi Handa <handa@m17n.org>
* quail/georgian.el ("georgian"): Call quail-define-package with
the show-layout arg t.
2004-08-06 Andreas Schwab <schwab@suse.de>
* Makefile.in (install): Remove .arch-inventory files.
@ -99,7 +109,7 @@
(clean, mostlyclean): Don't delete *.elc distributed with tarball.
(maintainer-clean): Delete files that are not in CVS repository.
2004-02-16 J,bi(Br,bt(Bme Marant <jmarant@nerim.net> (tiny change)
2004-02-16 J,Ai(Br,At(Bme Marant <jmarant@nerim.net> (tiny change)
* Makefile.in (distclean maintainer-clean): Depend on clean.
@ -237,7 +247,7 @@
("cyrillic-ukrainian"): Fix `q', `Q', `W', `w' bindings.
("ukrainian-computer", "belarusian", "bulgarian-bds")
("russian-computer"): New.
("bulgarian-phonetic"): Rename from bulgarian-pho. Add ,A'(B, $,1uV(B, ,LN(B.
("bulgarian-phonetic"): Rename from bulgarian-pho. Add ,A'(B, $,1uV(B, $,1(N(B.
("russian-typewriter"): Rename from cyrillic-jcuken.
2002-06-20 Dave Love <fx@gnu.org>

2
leim/quail/georgian.el
View file

@ -34,7 +34,7 @@
(quail-define-package
"georgian" "Georgian" "გ" t
"A common Georgian transliteration (using Unicode)"
nil t nil nil nil nil nil nil nil nil t)
nil t nil nil t nil nil nil nil nil t)
(quail-define-rules
("a" ?ა)

104
leim/quail/greek.el
View file

@ -489,12 +489,14 @@ nil t t nil nil nil nil nil nil nil t)
("))" ?,A;(B) ; #x00bb
("A" ?$,1&q(B)
("A|" ?$,1q|(B)
("B" ?$,1&r(B)
("D" ?$,1&t(B)
("E" ?$,1&u(B)
("F" ?$,1'&(B)
("G" ?$,1&s(B)
("H" ?$,1&w(B)
("H|" ?$,1r,(B)
("I" ?$,1&y(B)
("J" ?$,1&x(B)
("K" ?$,1&z(B)
@ -509,6 +511,7 @@ nil t t nil nil nil nil nil nil nil t)
("T" ?$,1'$(B)
("U" ?$,1'%(B)
("W" ?$,1')(B)
("W|" ?$,1r\(B)
("X" ?$,1&~(B)
("Y" ?$,1'((B)
("Z" ?$,1&v(B)
@ -560,6 +563,18 @@ nil t t nil nil nil nil nil nil nil t)
("\"'i" ?$,1r3(B)
("\"`i" ?$,1r2(B)
("<I" ?$,1pY(B)
(">I" ?$,1pX(B)
("'I" ?$,1r;(B)
("<'I" ?$,1p](B)
(">'I" ?$,1p\(B)
("`I" ?$,1r:(B)
("<`I" ?$,1p[(B)
(">`I" ?$,1pZ(B)
("<~I" ?$,1p_(B)
(">~I" ?$,1p^(B)
("\"I" ?$,1'*(B)
("<~" ?$,1r?(B)
(">~" ?$,1r/(B)
("<'" ?$,1r>(B)
@ -578,6 +593,15 @@ nil t t nil nil nil nil nil nil nil t)
("<`e" ?$,1p3(B)
(">`e" ?$,1p2(B)
("<E" ?$,1p9(B)
(">E" ?$,1p8(B)
("'E" ?$,1r)(B)
("<'E" ?$,1p=(B)
(">'E" ?$,1p<(B)
("`E" ?$,1r((B)
("<`E" ?$,1p;(B)
(">`E" ?$,1p:(B)
("<a" ?$,1p!(B)
(">a" ?$,1p (B)
("'a" ?$,1q1(B)
@ -590,6 +614,17 @@ nil t t nil nil nil nil nil nil nil t)
("<~a" ?$,1p'(B)
(">~a" ?$,1p&(B)
("<A" ?$,1p)(B)
(">A" ?$,1p((B)
("'A" ?$,1q{(B)
("<'A" ?$,1p-(B)
(">'A" ?$,1p,(B)
("`A" ?$,1qz(B)
("<`A" ?$,1p+(B)
(">`A" ?$,1p*(B)
("<~A" ?$,1p/(B)
(">~A" ?$,1p.(B)
("<a|" ?$,1qA(B)
(">a|" ?$,1q@(B)
("'a|" ?$,1qt(B)
@ -602,9 +637,20 @@ nil t t nil nil nil nil nil nil nil t)
("<~a|" ?$,1qG(B)
(">~a|" ?$,1qF(B)
("<A|" ?$,1qI(B)
(">A|" ?$,1qH(B)
("<'A|" ?$,1qM(B)
(">'A|" ?$,1qL(B)
("<`A|" ?$,1qK(B)
(">`A|" ?$,1qJ(B)
("<~A|" ?$,1qO(B)
(">~A|" ?$,1qN(B)
("<r" ?$,1rE(B)
(">r" ?$,1rD(B)
("<R" ?$,1rL(B)
("<h" ?$,1pA(B)
(">h" ?$,1p@(B)
("'h" ?$,1q5(B)
@ -617,6 +663,17 @@ nil t t nil nil nil nil nil nil nil t)
("<~h" ?$,1pG(B)
(">~h" ?$,1pF(B)
("<H" ?$,1pI(B)
(">H" ?$,1pH(B)
("'H" ?$,1r+(B)
("<'H" ?$,1pM(B)
(">'H" ?$,1pL(B)
("`H" ?$,1r*(B)
("<`H" ?$,1pK(B)
(">`H" ?$,1pJ(B)
("<~H" ?$,1pO(B)
(">~H" ?$,1pN(B)
("|" ?$,1&Z(B) ; ypogegrammeni
("<h|" ?$,1qQ(B)
@ -631,6 +688,15 @@ nil t t nil nil nil nil nil nil nil t)
("<~h|" ?$,1qW(B)
(">~h|" ?$,1qV(B)
("<H|" ?$,1qY(B)
(">H|" ?$,1qX(B)
("<'H|" ?$,1q](B)
(">'H|" ?$,1q\(B)
("<`H|" ?$,1q[(B)
(">`H|" ?$,1qZ(B)
("<~H|" ?$,1q_(B)
(">~H|" ?$,1q^(B)
("<o" ?$,1pa(B)
(">o" ?$,1p`(B)
("'o" ?$,1q9(B)
@ -640,6 +706,15 @@ nil t t nil nil nil nil nil nil nil t)
("<`o" ?$,1pc(B)
(">`o" ?$,1pb(B)
("<O" ?$,1pi(B)
(">O" ?$,1ph(B)
("'O" ?$,1rY(B)
("<'O" ?$,1pm(B)
(">'O" ?$,1pl(B)
("`O" ?$,1rX(B)
("<`O" ?$,1pk(B)
(">`O" ?$,1pj(B)
("<u" ?$,1pq(B)
(">u" ?$,1pp(B)
("'u" ?$,1q;(B)
@ -655,6 +730,14 @@ nil t t nil nil nil nil nil nil nil t)
("\"'u" ?$,1rC(B)
("`\"u" ?$,1rB(B)
("<U" ?$,1py(B)
("'U" ?$,1rK(B)
("<'U" ?$,1p}(B)
("`U" ?$,1rJ(B)
("<`U" ?$,1p{(B)
("<~U" ?$,1p(B)
("\"U" ?$,1'+(B)
("<w" ?$,1q!(B)
(">w" ?$,1q (B)
("'w" ?$,1q=(B)
@ -667,6 +750,17 @@ nil t t nil nil nil nil nil nil nil t)
("<~w" ?$,1q'(B)
(">~w" ?$,1q&(B)
("<W" ?$,1q)(B)
(">W" ?$,1q((B)
("'W" ?$,1r[(B)
("<'W" ?$,1q-(B)
(">'W" ?$,1q,(B)
("`W" ?$,1rZ(B)
("<`W" ?$,1q+(B)
(">`W" ?$,1q*(B)
("<~W" ?$,1q/(B)
(">~W" ?$,1q.(B)
("<w|" ?$,1qa(B)
(">w|" ?$,1q`(B)
("'w|" ?$,1rT(B)
@ -678,6 +772,16 @@ nil t t nil nil nil nil nil nil nil t)
("~w|" ?$,1rW(B)
("<~w|" ?$,1qg(B)
(">~w|" ?$,1qf(B)
("<W|" ?$,1qi(B)
(">W|" ?$,1qh(B)
("'W|" ?$,1rT(B)
("<'W|" ?$,1qm(B)
(">'W|" ?$,1ql(B)
("<`W|" ?$,1qk(B)
(">`W|" ?$,1qj(B)
("<~W|" ?$,1qo(B)
(">~W|" ?$,1qn(B)
)
;;

381
lisp/ChangeLog
View file

@ -1,3 +1,368 @@
2004-08-27 Kenichi Handa <handa@m17n.org>
* international/utf-8.el (utf-8-post-read-conversion): If the
buffer is unibyte, temporarily make it multibyte.
2004-08-27 Masatake YAMATO <jet@gyve.org>
* calendar/time-date.el (time-to-seconds): Add autoload cookies.
2004-08-25 John Paul Wallington <jpw@gnu.org>
* textmodes/tex-mode.el (tex-validate-buffer): Distinguish between
0, 1, and many mismatches in message.
(tex-start-shell): Use `set-process-query-on-exit-flag'.
* ielm.el (ielm-tab, ielm-complete-symbol): Doc fix.
(inferior-emacs-lisp-mode): Use `set-process-query-on-exit-flag'.
2004-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-svn.el (vc-svn-diff): Treat options from vc-svn-diff-switches and
vc-diff-switches differently.
2004-08-22 Luc Teirlinck <teirllm@auburn.edu>
* speedbar.el (speedbar-file-regexp): Give it a phony defvar
before and a real defvar after
`speedbar-supported-extension-expressions'. This is to silence
the compiler without breaking bootstrapping.
2004-08-22 Richard M. Stallman <rms@gnu.org>
* textmodes/flyspell.el (flyspell-word):
Use set-process-query-on-exit-flag.
(flyspell-highlight-duplicate-region): Take POSS as arg.
(flyspell-word): Pass POSS as arg.
* progmodes/ada-xref.el: Many doc and style fixes.
(ada-find-any-references): Use compilation-start.
(ada-get-ali-file-name): Improve error msg.
(ada-get-ada-file-name): Likewise.
* net/ange-ftp.el (ange-ftp-gwp-start, ange-ftp-nslookup-host)
(ange-ftp-start-process): Use set-process-query-on-exit-flag.
* mail/mail-extr.el (mail-extr-all-top-level-domains):
Add forward defvar.
* whitespace.el (global-whitespace-mode): New alias
for whitespace-global-mode.
* speedbar.el (speedbar-file-regexp): Definition moved up.
(speedbar-mode, speedbar-set-mode-line-format):
Use with-no-warnings.
(speedbar-emacs-popup-kludge): Delete Emacs 19 alternative.
* simple.el (shell-command-on-region): New arg DISPLAY-ERROR-BUFFER
controls whether to display the error buffer.
* ps-mule.el: Delete compatibility code for old Emacses.
(ps-mule-find-wrappoint): Don't use chars-in-region.
* frame.el (display-mouse-p, display-selections-p):
Use with-no-warnings.
* font-lock.el (font-lock-set-defaults): Use with-no-warnings.
2004-08-22 David Kastrup <dak@gnu.org>
* textmodes/reftex-auc.el, progmodes/meta-mode.el: Update AUCTeX
information.
* speedbar.el, iswitchb.el, ido.el: Update AUCTeX information.
2004-08-22 Andreas Schwab <schwab@suse.de>
* cvs-status.el: Require pcvs during byte-compiling for defun-cvs-mode.
2004-08-22 Masatake YAMATO <jet@gyve.org>
* cvs-status.el (cvs-status-checkout): New function.
(cvs-status-mode-map): Add a key definition for `cvs-status-checkout'.
2004-08-21 David Kastrup <dak@gnu.org>
* net/ange-ftp.el (ange-ftp-hash-entry-exists-p)
(ange-ftp-file-entry-p, ange-ftp-file-symlink-p): Since the code
has been converted to use hashtables, the relation `nil=none' is
no longer valid, as `nil' is not a hashtable. This patch tries to
reduce the number of resulting errors.
2004-08-21 John Paul Wallington <jpw@gnu.org>
* subr.el (process-kill-without-query): Made obsolete in
version 21.4, not 21.5.
* log-edit.el (vc-comment-ring, vc-comment-ring-index)
(vc-previous-comment, vc-next-comment)
(vc-comment-search-reverse, vc-comment-search-forward)
(vc-comment-to-change-log): Likewise.
* international/latin1-disp.el (latin1-char-displayable-p): Likewise.
2004-08-21 Peter Seibel <peter@javamonkey.com> (tiny patch)
* emacs-lisp/cl-indent.el (lisp-indent-defmethod):
Correct indentation of DEFMETHODS with non-standard method
combinations (e.g., PROGN, MIN, MAX).
2004-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
* startup.el (normal-top-level-add-subdirs-to-load-path):
Avoid unnecessarily checking system-type.
(normal-top-level): Set TERM to "dumb". Simplify.
* avoid.el (mouse-avoidance-ignore-p): New fun.
Also ignore switch-frame, select-window, double, and triple clicks.
(mouse-avoidance-banish-hook, mouse-avoidance-exile-hook)
(mouse-avoidance-fancy-hook): Use it.
2004-08-20 Zoran Milojevic <zoran@sipquest.com> (tiny change)
* avoid.el (mouse-avoidance-nudge-mouse)
(mouse-avoidance-banish-destination): Stay within the current window
to avoid problems with mouse-autoselect-window.
2004-08-19 Stefan Monnier <monnier@iro.umontreal.ca>
* pcvs-parse.el (cvs-parse-table, cvs-parse-commit): Try to adapt to
the newer format of some messages in cvs-1.12.1.
2004-08-19 Masatake YAMATO <jet@gyve.org>
* emacs-lisp/elp.el (elp-results-symname-map): New keymap.
(elp-results-jump-to-definition-by-mouse)
(elp-results-jump-to-definition, elp-output-insert-symname): New funs.
(elp-output-result): Use elp-output-insert-symname.
2004-08-18 Kenichi Handa <handa@m17n.org>
* language/cyrillic.el: Register koi8-r in
ctext-non-standard-encodings-alist.
("Cyrillic-KOI8"): Add ctext-non-standard-encoding.
2004-08-17 Luc Teirlinck <teirllm@auburn.edu>
* emacs-lisp/copyright.el (copyright-update-year): Delete code
that replaces 20xy with xy.
2004-08-17 John Paul Wallington <jpw@gnu.org>
* emacs-lisp/re-builder.el (reb-mode-map): Define within defvar.
(reb-force-update): Doc fix.
2004-08-16 Richard M. Stallman <rms@gnu.org>
* progmodes/which-func.el (which-func-update-1): Doc fix.
* progmodes/sh-script.el (sh-set-shell): Use sh-mode-abbrev-table.
(sh-mode-abbrev-table): New variable.
* progmodes/compile.el (compilation-mode): Doc fix.
* emacs-lisp/lisp-mode.el (eval-last-sexp):
Don't cons a new symbol each time.
(eval-last-sexp-fake-value): New variable.
* emacs-lisp/copyright.el (copyright-years-regexp): New variable.
(copyright-update-year): Detect continuation of list of years.
* term.el (term-default-fg-color, term-default-bg-color)
(ansi-term-color-vector): Use `unspecified', not nil, as default.
* imenu.el: Several doc fixes: don't say variables are buffer-local.
2004-08-16 Davis Herring <herring@lanl.gov>
* isearch.el (isearch-string, isearch-message-string, isearch-point)
(isearch-success, isearch-forward-flag, isearch-other-end)
(isearch-word, isearch-invalid-regexp, isearch-wrapped)
(isearch-barrier, isearch-within-brackets)
(isearch-case-fold-search): Fix broken `nth'-like calls to `aref'.
2004-08-16 Kenichi Handa <handa@m17n.org>
* ps-mule.el (ps-mule-font-info-database): Fix docstring.
2004-08-15 Kenichi Handa <handa@m17n.org>
* term/x-win.el (x-selection-value): If utf8 was successful but
ctext was not, use utf8 string.
2004-08-14 Davis Herring <herring@lanl.gov>
* isearch.el: Remove accidental changes of March 4. Fix backing
up when a regexp isearch is made more general. Use symbolic
accessor functions for isearch stack frames to make usage clearer.
(search-whitespace-regexp): Made groups in documentation shy (as
is the group in the default value).
(isearch-fallback): New function, addresses problems with regexps
liberalized by `\|', adds support for liberalization by `\}' (the
general repetition construct), and incorporates behavior for
`*'/`?'.
(isearch-}-char): New command, calls `isearch-fallback' with
arguments appropriate to a typed `}'.
(isearch-*-char, isearch-|-char): Now just call `isearch-fallback'
appropriately.
(isearch-mode-map): Bind `}' to `isearch-}-char'.
(isearch-string, isearch-message,string, isearch-point)
(isearch-success, isearch-forward-flag, isearch-other-end)
(isearch-word, isearch-invalid-regexp, isearch-wrapped)
(isearch-barrier, isearch-within-brackets, isearch-case-fold-search):
New inline functions to read fields of a stack frame.
2004-08-14 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> (tiny change)
* battery.el (battery-linux-proc-acpi): Look into battery
directories matching the literal string "CMB", too (required for
Linux kernel version 2.6.7).
2004-08-14 John Paul Wallington <jpw@gnu.org>
* cus-start.el (read-file-name-completion-ignore-case): Add.
(blink-cursor-alist): Change version to "21.4".
* emacs-lisp/bytecomp.el (forward-word): Allow 0 args.
2004-08-11 Daniel Pfeiffer <occitan@esperanto.org>
* speedbar.el (speedbar-scan-subdirs): New option.
(speedbar-file-lists): Don't ignore file-name case on Unix and use
dolist.
(speedbar-insert-files-at-point): Take an extra argument and use
it to optionally find out if a subdir is empty. Also unreadable
files don't get expand buttons.
(speedbar-directory): New image (unused pixmap already existed).
(speedbar-expand-image-button-alist): Use it.
2004-08-11 Martin Stjernholm <bug-cc-mode@gnu.org>
CC Mode update to 5.30.9:
* progmodes/cc-defs.el, progmodes/cc-vars.el (c-emacs-features):
Move from cc-vars to cc-defs for dependency reasons. Fix the
POSIX char class test to check that it works in
`skip-chars-(forward|backward)' too.
* progmodes/cc-align.el (c-lineup-arglist): Fix bug when the
first argument starts with a special brace list.
* progmodes/cc-engine.el (c-forward-type): Fix promotion bug
when `c-opt-type-concat-key' is used (i.e. in Pike).
* progmodes/cc-engine.el (c-looking-at-special-brace-list):
Fix bug when the inner char pair doesn't have paren syntax, i.e. "(<
>)".
* progmodes/cc-align.el (c-lineup-multi-inher): Made it syntactic
whitespace safe.
* progmodes/cc-engine.el (c-guess-basic-syntax): Fix anchor
position for `arglist-intro', `arglist-cont-nonempty' and
`arglist-close' when there are two arglist open parens on the same
line and there's nothing in front of the first.
* progmodes/cc-fonts.el (c-basic-matchers-before): Fix font
locking of qualified names in Java, which previously could fontify
common indexing expressions in many cases. The standard Java
naming conventions are used to tell them apart.
* progmodes/cc-align.el (c-lineup-whitesmith-in-block):
Fix inconsistency wrt opening parens on the first line inside a paren
block.
* progmodes/cc-defs.el (c-langs-are-parametric): Must be known at
compile time for the sake of `c-major-mode-is'.
(c-mode-is-new-awk-p): Made it a macro to delay expansion of
`c-major-mode-is' in the event that this is used inside a
`c-lang-defconst'.
* progmodes/cc-defs.el (c-major-mode-is): Fix expansion inside
`c-lang-defconst' so that it works better with fallback languages.
* progmodes/cc-defs.el (c-add-language): Fix a typo that caused
it to fail to record the base mode.
* progmodes/cc-engine.el (c-syntactic-re-search-forward):
Fix bug so that it doesn't go past the closing paren when PAREN-LEVEL
is used. Reordered the syntax checks to get more efficient
skipping in some situations.
* progmodes/cc-cmds.el (c-electric-brace): Don't trip up on a line
continuation which might precede the newly inserted '{'.
* progmodes/cc-engine.el (c-syntactic-re-search-forward):
Fix cases where it could loop indefinitely.
* progmodes/cc-fonts.el (c-font-lock-declarators): Handle array
size specs correctly. Only fontify identifiers in front of '('
with as functions - don't accept any paren char. Tightened up
initializer skipping to stop before function and class blocks.
* progmodes/cc-engine.el (c-beginning-of-decl-1): Fix bug where
the point could be left directly after an open paren when finding
the beginning of the first decl in the block.
* progmodes/cc-engine.el (c-parse-state): Don't use the syntax
table when filtering out legitimate open parens to be recorded.
This could cause cache inconsistencies when e.g.
`c++-template-syntax-table' was temporarily in use.
* progmodes/cc-engine.el (c-on-identifier)
(c-simple-skip-symbol-backward): Small fix for handling "-"
correctly in `skip-chars-backward'. Affected the operator lfun
syntax in Pike.
* progmodes/cc-engine.el (c-invalidate-sws-region-after):
Fix bug that could cause an error from `after-change-functions' when
the changed region is at bob.
2004-08-11 Alan Mackenzie <bug-cc-mode@gnu.org>
CC Mode update to 5.30.9:
* progmodes/cc-cmds.el, progmodes/cc-vars.el: Amend doc(-strings)
to say that <TAB> doesn't insert WS into a CPP line.
(c-indent-command, c-tab-always-indent): Amend doc strings.
* progmodes/cc-styles.el, progmodes/cc-engine.el: Add in two
checks for user errors, thus eliminating cryptic and unhelpful
Emacs error messages. (1) Check the arg to `c-set-style' is a
string. (2) Check that settings to `c-offsets-alist' are not
spuriously quoted.
* progmodes/cc-cmds.el: (c-electric-brace): Don't delete a comment
which precedes the newly inserted `{'.
2004-08-10 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.0.44.
* net/tramp.el (tramp-post-connection): Quote $1 and $2 of shell
function "tramp_file_attributes". Otherwise, file names
containing spaces are misinterpreted. Reported by Magnus Henoch
<mange@freemail.hu>.
(tramp-handle-file-truename): FILENAME must be expanded first.
Otherwise, parameters like "/ssh:deego@gnufans.net:~" will return
obscure results. Reported by D. Goel <deego@gnufans.org>.
(tramp-handle-verify-visited-file-modtime): If file does not
exist, say it is not modified if and only if that agrees with the
buffer's record. Check whether a file is visiting the buffer, or
the buffer has no recorded last modification time. Return t in
case the visiting file doesn't exist. Suggested by Luc Teirlinck
<teirllm@auburn.edu>.
(tramp-handle-write-region): Pass modtime explicitely to
`set-visited-file-modtime', because filename can be different
from (buffer-file-name) if `file-precious-flag' is set.
`set-visited-file-modtime' must be called always when `visit' is t
or a string. Suggested by Luc Teirlinck <teirllm@auburn.edu>.
(tramp-handle-set-visited-file-modtime): If `time-list' is not
nil, don't apply the whole body. If the file doesn't exists, set
modtime to '(-1 65535). Suggested by Luc Teirlinck
<teirllm@auburn.edu>.
2004-08-09 Luc Teirlinck <teirllm@auburn.edu>
* help.el (describe-bindings): Doc fix.
@ -12,8 +377,7 @@
2004-08-08 Lars Hansen <larsh@math.ku.dk>
* wid-edit.el (widget-sexp-validate): Allow whitespace after
expression.
* wid-edit.el (widget-sexp-validate): Allow whitespace after expression.
2004-08-08 Luc Teirlinck <teirllm@auburn.edu>
@ -38,10 +402,15 @@
(reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax.
(reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'.
2004-08-05 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change)
* mail/mail-extr.el (mail-extr-disable-voodoo): New variable.
(mail-extr-voodoo): Check mail-extr-disable-voodoo.
2004-08-04 Kenichi Handa <handa@m17n.org>
* international/encoded-kb.el (encoded-kbd-setup-keymap): Fix
previous change.
* international/encoded-kb.el (encoded-kbd-setup-keymap):
Fix previous change.
2004-08-03 Kenichi Handa <handa@m17n.org>
@ -75,8 +444,8 @@
2004-08-01 David Kastrup <dak@gnu.org>
* replace.el (query-replace-read-from): Use
`query-replace-compile-replacement'.
* replace.el (query-replace-read-from):
Use `query-replace-compile-replacement'.
(query-replace-compile-replacement): New function.
(query-replace-read-to): Use `query-replace-compile-replacement'
for repeating the last command.

82
lisp/avoid.el
View file

@ -1,6 +1,6 @@
;;; avoid.el --- make mouse pointer stay out of the way of editing
;;; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1994, 2000, 2004 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: mouse
@ -52,7 +52,7 @@
;;
;; Bugs / Warnings / To-Do:
;;
;; - Using this code does slow emacs down. "banish" mode shouldn't
;; - Using this code does slow Emacs down. "banish" mode shouldn't
;; be too bad, and on my workstation even "animate" is reasonable.
;;
;; - It ought to find out where any overlapping frames are and avoid them,
@ -96,7 +96,7 @@ use either \\[customize] or the function `mouse-avoidance-mode'."
(defcustom mouse-avoidance-nudge-dist 15
"*Average distance that mouse will be moved when approached by cursor.
Only applies in mouse-avoidance-mode `jump' and its derivatives.
Only applies in Mouse-Avoidance mode `jump' and its derivatives.
For best results make this larger than `mouse-avoidance-threshold'."
:type 'integer
:group 'avoid)
@ -137,7 +137,7 @@ Only applies in mouse-avoidance-modes `animate' and `jump'."
(defun mouse-avoidance-point-position ()
"Return the position of point as (FRAME X . Y).
Analogous to mouse-position."
Analogous to `mouse-position'."
(let* ((w (selected-window))
(edges (window-inside-edges w))
(list
@ -194,10 +194,11 @@ Acceptable distance is defined by `mouse-avoidance-threshold'."
mouse-avoidance-threshold))))))
(defun mouse-avoidance-banish-destination ()
"The position to which mouse-avoidance-mode `banish' moves the mouse.
"The position to which Mouse-Avoidance mode `banish' moves the mouse.
You can redefine this if you want the mouse banished to a different corner."
(cons (1- (frame-width))
0))
(let* ((pos (window-edges)))
(cons (- (nth 2 pos) 2)
(nth 1 pos))))
(defun mouse-avoidance-banish-mouse ()
;; Put the mouse pointer in the upper-right corner of the current frame.
@ -225,22 +226,27 @@ You can redefine this if you want the mouse banished to a different corner."
(t 0))))
(defun mouse-avoidance-nudge-mouse ()
;; Push the mouse a little way away, possibly animating the move
;; Push the mouse a little way away, possibly animating the move.
;; For these modes, state keeps track of the total offset that we've
;; accumulated, and tries to keep it close to zero.
(let* ((cur (mouse-position))
(cur-frame (car cur))
(cur-pos (cdr cur))
(pos (window-edges))
(wleft (pop pos))
(wtop (pop pos))
(wright (pop pos))
(wbot (pop pos))
(deltax (mouse-avoidance-delta
(car cur-pos) (- (random mouse-avoidance-nudge-var)
(car mouse-avoidance-state))
mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
0 (frame-width)))
wleft (1- wright)))
(deltay (mouse-avoidance-delta
(cdr cur-pos) (- (random mouse-avoidance-nudge-var)
(cdr mouse-avoidance-state))
mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
0 (frame-height))))
wtop (1- wbot))))
(setq mouse-avoidance-state
(cons (+ (car mouse-avoidance-state) deltax)
(+ (cdr mouse-avoidance-state) deltay)))
@ -277,33 +283,34 @@ redefine this function to suit your own tastes."
(nth (random mouse-avoidance-n-pointer-shapes)
mouse-avoidance-pointer-shapes))
(defun mouse-avoidance-ignore-p ()
(let ((mp (mouse-position)))
(or executing-kbd-macro ; don't check inside macro
(null (cadr mp)) ; don't move unless in an Emacs frame
(not (eq (car mp) (selected-frame)))
;; Don't do anything if last event was a mouse event.
;; FIXME: this code fails in the case where the mouse was moved
;; since the last key-press but without generating any event.
(and (consp last-input-event)
(symbolp (car last-input-event))
(let ((modifiers (event-modifiers (car last-input-event))))
(or (memq (car last-input-event)
'(mouse-movement scroll-bar-movement
select-window switch-frame))
(memq 'click modifiers)
(memq 'double modifiers)
(memq 'triple modifiers)
(memq 'drag modifiers)
(memq 'down modifiers)))))))
(defun mouse-avoidance-banish-hook ()
(if (and (not executing-kbd-macro) ; don't check inside macro
(cadr (mouse-position)) ; don't move unless in an Emacs frame
;; Don't do anything if last event was a mouse event.
(not (and (consp last-input-event)
(symbolp (car last-input-event))
(let ((modifiers (event-modifiers (car last-input-event))))
(or (memq (car last-input-event)
'(mouse-movement scroll-bar-movement))
(memq 'click modifiers)
(memq 'drag modifiers)
(memq 'down modifiers))))))
(if (not (mouse-avoidance-ignore-p))
(mouse-avoidance-banish-mouse)))
(defun mouse-avoidance-exile-hook ()
;; For exile mode, the state is nil when the mouse is in its normal
;; position, and set to the old mouse-position when the mouse is in exile.
(if (and (not executing-kbd-macro)
;; Don't do anything if last event was a mouse event.
(not (and (consp last-input-event)
(symbolp (car last-input-event))
(let ((modifiers (event-modifiers (car last-input-event))))
(or (memq (car last-input-event)
'(mouse-movement scroll-bar-movement))
(memq 'click modifiers)
(memq 'drag modifiers)
(memq 'down modifiers))))))
(if (not (mouse-avoidance-ignore-p))
(let ((mp (mouse-position)))
(cond ((and (not mouse-avoidance-state)
(mouse-avoidance-too-close-p mp))
@ -321,16 +328,7 @@ redefine this function to suit your own tastes."
(defun mouse-avoidance-fancy-hook ()
;; Used for the "fancy" modes, ie jump et al.
(if (and (not executing-kbd-macro) ; don't check inside macro
;; Don't do anything if last event was a mouse event.
(not (and (consp last-input-event)
(symbolp (car last-input-event))
(let ((modifiers (event-modifiers (car last-input-event))))
(or (memq (car last-input-event)
'(mouse-movement scroll-bar-movement))
(memq 'click modifiers)
(memq 'drag modifiers)
(memq 'down modifiers)))))
(if (and (not (mouse-avoidance-ignore-p))
(mouse-avoidance-too-close-p (mouse-position)))
(let ((old-pos (mouse-position)))
(mouse-avoidance-nudge-mouse)
@ -416,5 +414,5 @@ definition of \"random distance\".)"
(if mouse-avoidance-mode
(mouse-avoidance-mode mouse-avoidance-mode))
;;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800
;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800
;;; avoid.el ends here

2
lisp/battery.el
View file

@ -290,7 +290,7 @@ The following %-sequences are provided:
nil t)
(setq low (+ (or low 0)
(string-to-int (match-string 1))))))))
(directory-files "/proc/acpi/battery/" t "BAT")))
(directory-files "/proc/acpi/battery/" t "\\(BAT\\|CMB\\)")))
(and capacity rate
(setq minutes (if (zerop rate) 0
(floor (* (/ (float (if (string= charging-state

1
lisp/calendar/time-date.el
View file

@ -45,6 +45,7 @@
(timezone-make-date-arpa-standard date)))
(error (error "Invalid date: %s" date))))
;;;###autoload
(defun time-to-seconds (time)
"Convert time value TIME to a floating point number.
You can use `float-time' instead."

3
lisp/cus-start.el
View file

@ -124,6 +124,7 @@
(const :tag "always" t)))
;; fileio.c
(insert-default-directory minibuffer boolean)
(read-file-name-completion-ignore-case minibuffer boolean "21.4")
;; fns.c
(use-dialog-box menu boolean "21.1")
(use-file-dialog menu boolean "21.4")
@ -267,7 +268,7 @@
:format "%v")
(other :tag "Unlimited" t)))
(unibyte-display-via-language-environment mule boolean)
(blink-cursor-alist cursor alist "21.5")
(blink-cursor-alist cursor alist "21.4")
;; xfaces.c
(scalable-fonts-allowed display boolean)
;; xfns.c

23
lisp/cvs-status.el
View file

@ -31,6 +31,7 @@
;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile (require 'pcvs))
(require 'pcvs-util)
;;;
@ -48,7 +49,8 @@
("\M-n" . cvs-status-next)
("\M-p" . cvs-status-prev)
("t" . cvs-status-cvstrees)
("T" . cvs-status-trees))
("T" . cvs-status-trees)
(">" . cvs-status-checkout))
"CVS-Status' keymap."
:group 'cvs-status
:inherit 'cvs-mode-map)
@ -464,6 +466,25 @@ Optional prefix ARG chooses between two representations."
;;(sit-for 0)
))))))
(defun-cvs-mode (cvs-status-checkout . NOARGS) (dir)
"Run cvs-checkout against the tag under the point.
The files are stored to DIR."
(interactive
(let* ((module (cvs-get-module))
(branch (cvs-prefix-get 'cvs-branch-prefix))
(prompt (format "CVS Checkout Directory for `%s%s': "
module
(if branch (format "(branch: %s)" branch)
""))))
(list
(read-directory-name prompt
nil default-directory nil))))
(let ((modules (cvs-string->strings (cvs-get-module)))
(flags (cvs-add-branch-prefix
(cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))
(cvs-cvsroot (cvs-get-cvsroot)))
(cvs-checkout modules dir flags)))
(defun cvs-tree-tags-insert (tags prev)
(when tags
(let* ((tag (car tags))

2
lisp/emacs-lisp/bytecomp.el
View file

@ -2900,7 +2900,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-defop-compiler char-after 0-1)
(byte-defop-compiler set-buffer 1)
;;(byte-defop-compiler set-mark 1) ;; obsolete
(byte-defop-compiler19 forward-word 1)
(byte-defop-compiler19 forward-word 0-1)
(byte-defop-compiler19 char-syntax 1)
(byte-defop-compiler19 nreverse 1)
(byte-defop-compiler19 car-safe 1)

2
lisp/emacs-lisp/cl-indent.el
View file

@ -458,7 +458,7 @@ If nil, indent backquoted lists as data, i.e., like quoted lists."
(forward-char 1)
(forward-sexp 3)
(backward-sexp)
(looking-at ":")))
(looking-at ":\\|\\sw+")))
'(4 4 (&whole 4 &rest 4) &body)
(get 'defun 'common-lisp-indent-function))
path state indent-point sexp-column normal-indent))

44
lisp/emacs-lisp/copyright.el
View file

@ -52,6 +52,13 @@ The second \\( \\) construct must match the years."
:group 'copyright
:type 'regexp)
(defcustom copyright-years-regexp
"\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"*Match additional copyright notice years.
The second \\( \\) construct must match the years."
:group 'copyright
:type 'regexp)
(defcustom copyright-query 'function
"*If non-nil, ask user before changing copyright.
@ -75,6 +82,23 @@ When this is `function', only ask when called non-interactively."
(defun copyright-update-year (replace noquery)
(when (re-search-forward copyright-regexp (+ (point) copyright-limit) t)
;; If the years are continued onto multiple lined
;; that are marked as comments, skip to the end of the years anyway.
(while (save-excursion
(and (eq (following-char) ?,)
(progn (forward-char 1) t)
(progn (skip-chars-forward " \t") (eolp))
comment-start-skip
(save-match-data
(forward-line 1)
(and (looking-at comment-start-skip)
(goto-char (match-end 0))))
(save-match-data
(looking-at copyright-years-regexp))))
(forward-line 1)
(re-search-forward comment-start-skip)
(re-search-forward copyright-years-regexp))
;; Note that `current-time-string' isn't locale-sensitive.
(setq copyright-current-year (substring (current-time-string) -4))
(unless (string= (buffer-substring (- (match-end 2) 2) (match-end 2))
@ -98,26 +122,6 @@ When this is `function', only ask when called non-interactively."
(eq (char-after (+ (point) size -2)) ?-)))
;; This is a range so just replace the end part.
(delete-char size)
;; Detect if this is using the following shorthand:
;; (C) 1993, 94, 95, 1998, 2000, 01, 02, 2003
(if (and
;; Check that the last year was 4-chars and same century.
(eq size -4)
(equal (buffer-substring (- (point) 4) (- (point) 2))
(substring copyright-current-year 0 2))
;; Check that there are 2-char years as well.
(save-excursion
(re-search-backward "[^0-9][0-9][0-9][^0-9]"
(line-beginning-position) t))
;; Make sure we don't remove the first century marker.
(save-excursion
(forward-char size)
(re-search-backward
(concat (buffer-substring (point) (+ (point) 2))
"[0-9][0-9]")
(line-beginning-position) t)))
;; Remove the century marker of the last entry.
(delete-region (- (point) 4) (- (point) 2)))
;; Insert a comma with the preferred number of spaces.
(insert
(save-excursion

28
lisp/emacs-lisp/elp.el
View file

@ -513,7 +513,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
(numberp elp-report-limit)
(< cc elp-report-limit))
nil
(insert symname)
(elp-output-insert-symname symname)
(insert-char 32 (+ elp-field-len (- (length symname)) 2))
;; print stuff out, formatting it nicely
(insert callcnt)
@ -525,6 +525,32 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
(insert atstr))
(insert "\n"))))
(defvar elp-results-symname-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse)
(define-key map "\C-m" 'elp-results-jump-to-definition)
map)
"Keymap used on the function name column." )
(defun elp-results-jump-to-definition-by-mouse (event)
"Jump to the definition of the function under the place specified by EVENT."
(interactive "e")
(posn-set-point (event-end event))
(elp-results-jump-to-definition))
(defun elp-results-jump-to-definition ()
"Jump to the definition of the function under the point."
(interactive)
(find-function (get-text-property (point) 'elp-symname)))
(defun elp-output-insert-symname (symname)
;; Insert SYMNAME with text properties.
(insert (propertize symname
'elp-symname (intern symname)
'keymap elp-results-symname-map
'mouse-face 'highlight
'help-echo (substitute-command-keys "\\{elp-results-symname-map}"))))
;;;###autoload
(defun elp-results ()
"Display current profiling results.

4
lisp/emacs-lisp/lisp-mode.el
View file

@ -555,13 +555,15 @@ With argument, print output into current buffer."
))))
(defvar eval-last-sexp-fake-value (make-symbol "t"))
(defun eval-last-sexp (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in minibuffer.
Interactively, with prefix argument, print output into current buffer."
(interactive "P")
(if (null eval-expression-debug-on-error)
(eval-last-sexp-1 eval-last-sexp-arg-internal)
(let ((old-value (make-symbol "t")) new-value value)
(let ((old-value eval-last-sexp-fake-value) new-value value)
(let ((debug-on-error old-value))
(setq value (eval-last-sexp-1 eval-last-sexp-arg-internal))
(setq new-value debug-on-error))

30
lisp/emacs-lisp/re-builder.el
View file

@ -45,7 +45,7 @@
;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
;; The target buffer can be changed with `reb-change-target-buffer'
;; ("\C-c\C-b"). Changing the target buffer automatically removes
;; ("\C-c\C-b"). Changing the target buffer automatically removes
;; the overlays from the old buffer and displays the new one in the
;; target window.
@ -229,22 +229,20 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
"Buffer to use for the RE Builder.")
;; Define the local "\C-c" keymap
(defvar reb-mode-map nil
(defvar reb-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'reb-toggle-case)
(define-key map "\C-c\C-q" 'reb-quit)
(define-key map "\C-c\C-w" 'reb-copy)
(define-key map "\C-c\C-s" 'reb-next-match)
(define-key map "\C-c\C-r" 'reb-prev-match)
(define-key map "\C-c\C-i" 'reb-change-syntax)
(define-key map "\C-c\C-e" 'reb-enter-subexp-mode)
(define-key map "\C-c\C-b" 'reb-change-target-buffer)
(define-key map "\C-c\C-u" 'reb-force-update)
map)
"Keymap used by the RE Builder.")
(if (not reb-mode-map)
(progn
(setq reb-mode-map (make-sparse-keymap))
(define-key reb-mode-map "\C-c\C-c" 'reb-toggle-case)
(define-key reb-mode-map "\C-c\C-q" 'reb-quit)
(define-key reb-mode-map "\C-c\C-w" 'reb-copy)
(define-key reb-mode-map "\C-c\C-s" 'reb-next-match)
(define-key reb-mode-map "\C-c\C-r" 'reb-prev-match)
(define-key reb-mode-map "\C-c\C-i" 'reb-change-syntax)
(define-key reb-mode-map "\C-c\C-e" 'reb-enter-subexp-mode)
(define-key reb-mode-map "\C-c\C-b" 'reb-change-target-buffer)
(define-key reb-mode-map "\C-c\C-u" 'reb-force-update)))
(defun reb-mode ()
"Major mode for interactively building Regular Expressions.
\\{reb-mode-map}"
@ -367,7 +365,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(reb-update-modestring))))
(defun reb-force-update ()
"Forces an update in the RE Builder target window without a match limit."
"Force an update in the RE Builder target window without a match limit."
(interactive)
(let ((reb-auto-match-limit nil))

4
lisp/font-lock.el
View file

@ -1516,7 +1516,9 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
(make-local-variable 'font-lock-fontified)
(make-local-variable 'font-lock-multiline)
(let* ((defaults (or font-lock-defaults
(cdr (assq major-mode font-lock-defaults-alist))))
(cdr (assq major-mode
(with-no-warnings
font-lock-defaults-alist)))))
(keywords
(font-lock-choose-keywords (nth 0 defaults)
(font-lock-value-in-major-mode font-lock-maximum-decoration)))

6
lisp/frame.el
View file

@ -987,7 +987,8 @@ frame's display)."
((eq frame-type 'pc)
(msdos-mouse-p))
((eq system-type 'windows-nt)
(> w32-num-mouse-buttons 0))
(with-no-warnings
(> w32-num-mouse-buttons 0)))
((memq frame-type '(x mac))
t) ;; We assume X and Mac *always* have a pointing device
(t
@ -1040,7 +1041,8 @@ frame's display)."
((eq frame-type 'pc)
;; MS-DOG frames support selections when Emacs runs inside
;; the Windows' DOS Box.
(not (null dos-windows-version)))
(with-no-warnings
(not (null dos-windows-version))))
((memq frame-type '(x w32 mac))
t) ;; FIXME?
(t

2
lisp/ido.el
View file

@ -291,7 +291,7 @@
;; then all files matching "Summary" are moved to the end of the
;; list. (I find this handy for keeping the INBOX Summary and so on
;; out of the way.) It also moves files matching "output\*$" to the
;; end of the list (these are created by AUC TeX when compiling.)
;; end of the list (these are created by AUCTeX when compiling.)
;; Other functions could be made available which alter the list of
;; matching files (either deleting or rearranging elements.)

6
lisp/ielm.el
View file

@ -198,7 +198,7 @@ This variable is buffer-local.")
;;; Completion stuff
(defun ielm-tab nil
"Possibly indent the current line as lisp code."
"Possibly indent the current line as Lisp code."
(interactive)
(if (or (eq (preceding-char) ?\n)
(eq (char-syntax (preceding-char)) ? ))
@ -207,7 +207,7 @@ This variable is buffer-local.")
t)))
(defun ielm-complete-symbol nil
"Complete the lisp symbol before point."
"Complete the Lisp symbol before point."
;; A wrapper for lisp-complete symbol that returns non-nil if
;; completion has occurred
(let* ((btick (buffer-modified-tick))
@ -528,7 +528,7 @@ Customized bindings may be defined in `ielm-map', which currently contains:
(condition-case nil
(start-process "ielm" (current-buffer) "hexl")
(file-error (start-process "ielm" (current-buffer) "cat")))
(process-kill-without-query (ielm-process))
(set-process-query-on-exit-flag (ielm-process) nil)
(goto-char (point-max))
;; Lisp output can include raw characters that confuse comint's

9
lisp/imenu.el
View file

@ -211,8 +211,6 @@ menu. See the info section on Regexps for more information.
INDEX points to the substring in REGEXP that contains the name (of the
function, variable or type) that is to appear in the menu.
The variable is buffer-local.
The variable `imenu-case-fold-search' determines whether or not the
regexp matches are case sensitive, and `imenu-syntax-alist' can be
used to alter the syntax table for the search.
@ -240,9 +238,7 @@ A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
The function `imenu--subalist-p' tests an element and returns t
if it is a sub-alist.
This function is called within a `save-excursion'.
The variable is buffer-local.")
This function is called within a `save-excursion'.")
;;;###autoload
(make-variable-buffer-local 'imenu-create-index-function)
@ -977,8 +973,7 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
(defvar imenu-buffer-menubar nil)
(defvar imenu-menubar-modified-tick 0
"The value of (buffer-modified-tick) as of last call to `imenu-update-menubar'.
This value becomes local in every buffer when it is set.")
"The value of (buffer-modified-tick) as of last call to `imenu-update-menubar'.")
(make-variable-buffer-local 'imenu-menubar-modified-tick)
(defun imenu-update-menubar ()

2
lisp/international/latin1-disp.el
View file

@ -225,7 +225,7 @@ character set: `latin-2', `hebrew' etc."
;; Backwards compatibility.
(defalias 'latin1-char-displayable-p 'char-displayable-p)
(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "21.5")
(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "21.4")
(defun latin1-display-setup (set &optional force)
"Set up Latin-1 display for characters in the given SET.

234
lisp/isearch.el
View file

@ -153,9 +153,9 @@ string, and RET terminates editing and does a nonincremental search."
(defcustom search-whitespace-regexp "\\(?:\\s-+\\)"
"*If non-nil, regular expression to match a sequence of whitespace chars.
This applies to regular expression incremental search.
You might want to use something like \"[ \\t\\r\\n]+\" instead.
In the Customization buffer, that is `[' followed by a space,
a tab, a carriage return (control-M), a newline, and `]+'."
You might want to use something like \"\\\\(?:[ \\t\\r\\n]+\\\\)\" instead.
In the Customization buffer, that is `\\(?:[' followed by a space,
a tab, a carriage return (control-M), a newline, and `]+\\)'."
:type 'regexp
:group 'isearch)
@ -294,11 +294,11 @@ Default value, nil, means edit the string instead."
(define-key map "\M-\C-y" 'isearch-yank-char)
(define-key map "\C-y" 'isearch-yank-line)
;; Define keys for regexp chars * ? |.
;; Define keys for regexp chars * ? } |.
;; Nothing special for + because it matches at least once.
(define-key map "*" 'isearch-*-char)
(define-key map "?" 'isearch-*-char)
(define-key map "{" 'isearch-{-char)
(define-key map "}" 'isearch-}-char)
(define-key map "|" 'isearch-|-char)
;; Turned off because I find I expect to get the global definition--rms.
@ -368,9 +368,9 @@ Default value, nil, means edit the string instead."
(defvar isearch-cmds nil
"Stack of search status sets.
Each set is a list of the form:
(STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD
INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH)")
Each set is a vector of the form:
[STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD
INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH]")
(defvar isearch-string "") ; The current search string.
(defvar isearch-message "") ; text-char-description version of isearch-string
@ -769,6 +769,74 @@ REGEXP says which ring to use."
;; (isearch-clean-overlays)
;; (handle-switch-frame (car (cdr last-command-char))))
;; The search status structure and stack.
(defsubst isearch-string (frame)
"Return the search string in FRAME."
(aref frame 0))
(defsubst isearch-message-string (frame)
"Return the search string to display to the user in FRAME."
(aref frame 1))
(defsubst isearch-point (frame)
"Return the point in FRAME."
(aref frame 2))
(defsubst isearch-success (frame)
"Return the success flag in FRAME."
(aref frame 3))
(defsubst isearch-forward-flag (frame)
"Return the searching-forward flag in FRAME."
(aref frame 4))
(defsubst isearch-other-end (frame)
"Return the other end of the match in FRAME."
(aref frame 5))
(defsubst isearch-word (frame)
"Return the search-by-word flag in FRAME."
(aref frame 6))
(defsubst isearch-invalid-regexp (frame)
"Return the regexp error message in FRAME, or nil if its regexp is valid."
(aref frame 7))
(defsubst isearch-wrapped (frame)
"Return the search-wrapped flag in FRAME."
(aref frame 8))
(defsubst isearch-barrier (frame)
"Return the barrier value in FRAME."
(aref frame 9))
(defsubst isearch-within-brackets (frame)
"Return the in-character-class flag in FRAME."
(aref frame 10))
(defsubst isearch-case-fold-search (frame)
"Return the case-folding flag in FRAME."
(aref frame 11))
(defun isearch-top-state ()
(let ((cmd (car isearch-cmds)))
(setq isearch-string (isearch-string cmd)
isearch-message (isearch-message-string cmd)
isearch-success (isearch-success cmd)
isearch-forward (isearch-forward-flag cmd)
isearch-other-end (isearch-other-end cmd)
isearch-word (isearch-word cmd)
isearch-invalid-regexp (isearch-invalid-regexp cmd)
isearch-wrapped (isearch-wrapped cmd)
isearch-barrier (isearch-barrier cmd)
isearch-within-brackets (isearch-within-brackets cmd)
isearch-case-fold-search (isearch-case-fold-search cmd))
(goto-char (isearch-point cmd))))
(defun isearch-pop-state ()
(setq isearch-cmds (cdr isearch-cmds))
(isearch-top-state))
(defun isearch-push-state ()
(setq isearch-cmds
(cons (vector isearch-string isearch-message (point)
isearch-success isearch-forward isearch-other-end
isearch-word
isearch-invalid-regexp isearch-wrapped isearch-barrier
isearch-within-brackets isearch-case-fold-search)
isearch-cmds)))
;; Commands active while inside of the isearch minor mode.
@ -1245,53 +1313,93 @@ might return the position of the end of the line."
(isearch-update))
(defun isearch-{-char ()
"Handle \{ specially in regexps."
(interactive)
(isearch-*-char t))
;; *, ?, and | chars can make a regexp more liberal.
;; *, ?, }, and | chars can make a regexp more liberal.
;; They can make a regexp match sooner or make it succeed instead of failing.
;; So go back to place last successful search started
;; or to the last ^S/^R (barrier), whichever is nearer.
;; + needs no special handling because the string must match at least once.
(defun isearch-*-char (&optional want-backslash)
"Handle * and ? specially in regexps.
When WANT-BACKSLASH is non-nil, do special handling for \{."
(interactive)
(if isearch-regexp
(let ((idx (length isearch-string)))
(while (and (> idx 0)
(eq (aref isearch-string (1- idx)) ?\\))
(setq idx (1- idx)))
;; * and ? are special when not preceded by \.
;; { is special when it is preceded by \.
(when (= (mod (- (length isearch-string) idx) 2)
(if want-backslash 1 0))
(setq isearch-adjusted t)
;; Get the isearch-other-end from before the last search.
;; We want to start from there,
;; so that we don't retreat farther than that.
;; (car isearch-cmds) is after last search;
;; (car (cdr isearch-cmds)) is from before it.
(let ((cs (nth 5 (car (cdr isearch-cmds)))))
(setq cs (or cs isearch-barrier))
(goto-char
(if isearch-forward
(max cs isearch-barrier)
(min cs isearch-barrier)))))))
(defun isearch-backslash (str)
"Return t if STR ends in an odd number of backslashes."
(= (mod (- (length str) (string-match "\\\\*\\'" str)) 2) 1))
(defun isearch-fallback (want-backslash &optional allow-invalid to-barrier)
"Return point to previous successful match to allow regexp liberalization.
\\<isearch-mode-map>
Respects \\[isearch-repeat-forward] and \\[isearch-repeat-backward] by
stopping at `isearch-barrier' as needed.
Do nothing if a backslash is escaping the liberalizing character. If
WANT-BACKSLASH is non-nil, invert this behavior (for \\} and \\|).
Do nothing if regexp has recently been invalid unless optional ALLOW-INVALID
non-nil.
If optional TO-BARRIER non-nil, ignore previous matches and go exactly to the
barrier."
;; (eq (not a) (not b)) makes all non-nil values equivalent
(when (and isearch-regexp (eq (not (isearch-backslash isearch-string))
(not want-backslash))
;; We have to check 2 stack frames because the last might be
;; invalid just because of a backslash.
(or (not isearch-invalid-regexp)
(not (isearch-invalid-regexp (cadr isearch-cmds)))
allow-invalid))
(if to-barrier
(progn (goto-char isearch-barrier)
(setq isearch-adjusted t))
(let* ((stack isearch-cmds)
(previous (cdr stack)) ; lookbelow in the stack
(frame (car stack)))
;; Walk down the stack looking for a valid regexp (as of course only
;; they can be the previous successful match); this conveniently
;; removes all bracket-sets and groups that might be in the way, as
;; well as partial \{\} constructs that the code below leaves behind.
;; Also skip over postfix operators -- though horrid,
;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal.
(while (and previous
(or (isearch-invalid-regexp frame)
(let* ((string (isearch-string frame))
(lchar (aref string (1- (length string)))))
;; The operators aren't always operators; check
;; backslashes. This doesn't handle the case of
;; operators at the beginning of the regexp not
;; being special, but then we should fall back to
;; the barrier anyway because it's all optional.
(if (isearch-backslash
(isearch-string (car previous)))
(eq lchar ?\})
(memq lchar '(?* ?? ?+))))))
(setq stack previous previous (cdr previous) frame (car stack)))
(when stack
;; `stack' now refers the most recent valid regexp that is not at
;; all optional in its last term. Now dig one level deeper and find
;; what matched before that.
(let ((last-other-end (or (isearch-other-end (car previous))
isearch-barrier)))
(goto-char (if isearch-forward
(max last-other-end isearch-barrier)
(min last-other-end isearch-barrier)))
(setq isearch-adjusted t))))))
(isearch-process-search-char last-command-char))
;; * and ? are special when not preceded by \.
(defun isearch-*-char ()
"Maybe back up to handle * and ? specially in regexps."
(interactive)
(isearch-fallback nil))
;; } is special when it is preceded by \.
(defun isearch-}-char ()
"Handle \\} specially in regexps."
(interactive)
(isearch-fallback t t))
;; | is special when it is preceded by \.
(defun isearch-|-char ()
"If in regexp search, jump to the barrier."
"If in regexp search, jump to the barrier unless in a group."
(interactive)
(if isearch-regexp
(progn
(setq isearch-adjusted t)
(goto-char isearch-barrier)))
(isearch-process-search-char last-command-char))
(isearch-fallback t nil t))
(defun isearch-unread-key-sequence (keylist)
"Unread the given key-sequence KEYLIST.
@ -1770,38 +1878,6 @@ If there is no completion possible, say so and continue searching."
(delete-field)
(insert isearch-string))))
;; The search status stack (and isearch window-local variables, not used).
;; Need a structure for this.
(defun isearch-top-state ()
(let ((cmd (car isearch-cmds)))
(setq isearch-string (car cmd)
isearch-message (car (cdr cmd))
isearch-success (nth 3 cmd)
isearch-forward (nth 4 cmd)
isearch-other-end (nth 5 cmd)
isearch-word (nth 6 cmd)
isearch-invalid-regexp (nth 7 cmd)
isearch-wrapped (nth 8 cmd)
isearch-barrier (nth 9 cmd)
isearch-within-brackets (nth 10 cmd)
isearch-case-fold-search (nth 11 cmd))
(goto-char (car (cdr (cdr cmd))))))
(defun isearch-pop-state ()
(setq isearch-cmds (cdr isearch-cmds))
(isearch-top-state))
(defun isearch-push-state ()
(setq isearch-cmds
(cons (list isearch-string isearch-message (point)
isearch-success isearch-forward isearch-other-end
isearch-word
isearch-invalid-regexp isearch-wrapped isearch-barrier
isearch-within-brackets isearch-case-fold-search)
isearch-cmds)))
;; Message string
@ -1932,9 +2008,9 @@ Can be changed via `isearch-search-fun-function' for special needs."
(if isearch-success
nil
;; Ding if failed this time after succeeding last time.
(and (nth 3 (car isearch-cmds))
(and (isearch-success (car isearch-cmds))
(ding))
(goto-char (nth 2 (car isearch-cmds)))))
(goto-char (isearch-point (car isearch-cmds)))))
;; Called when opening an overlay, and we are still in isearch.

2
lisp/iswitchb.el
View file

@ -159,7 +159,7 @@
;; then all buffers matching "Summary" are moved to the end of the
;; list. (I find this handy for keeping the INBOX Summary and so on
;; out of the way.) It also moves buffers matching "output\*$" to the
;; end of the list (these are created by AUC TeX when compiling.)
;; end of the list (these are created by AUCTeX when compiling.)
;; Other functions could be made available which alter the list of
;; matching buffers (either deleting or rearranging elements.)

1
lisp/language/cyrillic.el
View file

@ -98,6 +98,7 @@
"Cyrillic-KOI8" `((charset koi8)
(coding-system cyrillic-koi8)
(coding-priority cyrillic-koi8 cyrillic-iso-8bit)
(ctext-non-standard-encodings "koi8-r")
(nonascii-translation . koi8)
(input-method . "russian-typewriter")
(features cyril-util)

14
lisp/log-edit.el
View file

@ -281,19 +281,19 @@ automatically."
;; Compatibility with old names.
(defvaralias 'vc-comment-ring 'log-edit-comment-ring)
(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "21.5")
(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "21.4")
(defvaralias 'vc-comment-ring-index 'log-edit-comment-ring-index)
(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "21.5")
(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "21.4")
(defalias 'vc-previous-comment 'log-edit-previous-comment)
(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.5")
(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.4")
(defalias 'vc-next-comment 'log-edit-next-comment)
(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.5")
(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.4")
(defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward)
(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.5")
(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.4")
(defalias 'vc-comment-search-forward 'log-edit-comment-search-forward)
(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.5")
(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.4")
(defalias 'vc-comment-to-change-log 'log-edit-comment-to-change-log)
(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "21.5")
(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "21.4")
;;;
;;; Actual code

1
lisp/mail/mail-extr.el
View file

@ -687,6 +687,7 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
(defvar disable-initial-guessing-flag) ; dynamic assignment
(defvar cbeg) ; dynamic assignment
(defvar cend) ; dynamic assignment
(defvar mail-extr-all-top-level-domains) ; Defined below.
;;;###autoload
(defun mail-extract-address-components (address &optional all)

2080
lisp/mh-e/ChangeLog
View file

File diff suppressed because it is too large Load diff

144
lisp/mh-e/mh-acros.el Normal file
View file

@ -0,0 +1,144 @@
;;; mh-acros.el --- Macros used in MH-E
;; Copyright (C) 2004 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This file contains macros that would normally be in mh-utils.el except that
;; their presence there would cause a dependency loop with mh-customize.el.
;; This file must always be included like this:
;;
;; (eval-when-compile (require 'mh-acros))
;;
;; It is so named with a silent `m' so that it is compiled first. Otherwise,
;; "make recompile" in Emacs 21.4 fails.
;;; Change Log:
;;; Code:
(require 'cl)
;; The Emacs coding conventions require that the cl package not be required at
;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl
;; routines in their macro expansions. Use mh-require-cl to provide the cl
;; routines in the best way possible.
(defmacro mh-require-cl ()
"Macro to load `cl' if needed.
Some versions of `cl' produce code for the expansion of
\(setf (gethash ...) ...) that uses functions in `cl' at run time. This macro
recognizes that and loads `cl' where appropriate."
(if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
`(require 'cl)
`(eval-when-compile (require 'cl))))
;;; Macros to generate correct code for different emacs variants
(defmacro mh-do-in-gnu-emacs (&rest body)
"Execute BODY if in GNU Emacs."
(unless (featurep 'xemacs) `(progn ,@body)))
(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
(defmacro mh-do-in-xemacs (&rest body)
"Execute BODY if in GNU Emacs."
(when (featurep 'xemacs) `(progn ,@body)))
(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
(defmacro mh-funcall-if-exists (function &rest args)
"Call FUNCTION with ARGS as parameters if it exists."
(if (fboundp function)
`(funcall ',function ,@args)))
(defmacro mh-make-local-hook (hook)
"Make HOOK local if needed.
XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be
called."
(when (and (fboundp 'make-local-hook)
(not (get 'make-local-hook 'byte-obsolete-info)))
`(make-local-hook ,hook)))
(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
"A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
variable `transient-mark-mode' is active."
(cond ((featurep 'xemacs) ;XEmacs
`(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
((not check-transient-mark-mode-flag) ;GNU Emacs
`(and (boundp 'mark-active) mark-active))
(t ;GNU Emacs
`(and (boundp 'transient-mark-mode) transient-mark-mode
(boundp 'mark-active) mark-active))))
(defmacro mh-defstruct (name-spec &rest fields)
"Replacement for `defstruct' from the `cl' package.
The `defstruct' in the `cl' library produces compiler warnings, and generates
code that uses functions present in `cl' at run-time. This is a partial
replacement, that avoids these issues.
NAME-SPEC declares the name of the structure, while FIELDS describes the
various structure fields. Lookup `defstruct' for more details."
(let* ((struct-name (if (atom name-spec) name-spec (car name-spec)))
(conc-name (or (and (consp name-spec)
(cadr (assoc :conc-name (cdr name-spec))))
(format "%s-" struct-name)))
(predicate (intern (format "%s-p" struct-name)))
(constructor (or (and (consp name-spec)
(cadr (assoc :constructor (cdr name-spec))))
(intern (format "make-%s" struct-name))))
(field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields))
(field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x)))
fields))
(struct (gensym "S"))
(x (gensym "X"))
(y (gensym "Y")))
`(progn
(defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y))
field-names field-init-forms))
(list (quote ,struct-name) ,@field-names))
(defun ,predicate (arg)
(and (consp arg) (eq (car arg) (quote ,struct-name))))
,@(loop for x from 1
for y in field-names
collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z)
(list 'nth ,x z)))
(quote ,struct-name))))
(defadvice require (around mh-prefer-el activate)
"Modify `require' to load uncompiled MH-E files."
(or (featurep (ad-get-arg 0))
(and (string-match "^mh-" (symbol-name (ad-get-arg 0)))
(load (format "%s.el" (ad-get-arg 0)) t t))
ad-do-it))
(provide 'mh-acros)
;;; Local Variables:
;;; no-byte-compile: t
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;; arch-tag: b383b49a-494f-4ed0-a30a-cb6d5d2da4ff
;;; mh-acros.el ends here

207
lisp/mh-e/mh-alias.el
View file

@ -27,75 +27,12 @@
;;; 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.
;;; Change Log:
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(load "cmr" t t) ; Non-fatal dependency for
; completing-read-multiple.
@ -116,15 +53,23 @@
(defvar mh-alias-tstamp nil
"Time aliases were last loaded.")
(defvar mh-alias-read-address-map nil)
(if mh-alias-read-address-map
()
(unless 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
"," 'mh-alias-minibuffer-confirm-address)
(define-key mh-alias-read-address-map " " 'self-insert-command))
(defvar mh-alias-system-aliases
'("/etc/nmh/MailAliases" "/etc/mh/MailAliases"
"/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases"
"/etc/passwd")
"*A list of system files which are a source of 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.
You can update the alias list manually using \\[mh-alias-reload].")
;;; Alias Loading
@ -138,7 +83,7 @@ This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid
(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
Return t if any file listed in the Aliasfile MH profile component has been
modified since the timestamp.
If ARG is non-nil, set timestamp with the current time."
(if arg
@ -157,7 +102,7 @@ If ARG is non-nil, set timestamp with the current time."
(defun mh-alias-filenames (arg)
"Return list of filenames that contain aliases.
The filenames come from the MH profile component Aliasfile and are expanded.
The filenames come from the Aliasfile profile component 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
@ -201,7 +146,8 @@ non-nil."
res))
(defun mh-alias-local-users ()
"Return an alist of local users from /etc/passwd."
"Return an alist of local users from /etc/passwd.
Exclude all aliases already in `mh-alias-alist' from `ali'"
(let (passwd-alist)
(save-excursion
(set-buffer (get-buffer-create mh-temp-buffer))
@ -222,23 +168,33 @@ non-nil."
(gecos-name (match-string 3))
(realname (mh-alias-gecos-name
gecos-name username
mh-alias-passwd-gecos-comma-separator-flag)))
(setq passwd-alist
(cons
(list (if mh-alias-local-users-prefix
(concat mh-alias-local-users-prefix
(mh-alias-suggest-alias realname t))
username)
(if (string-equal username realname)
(concat "<" username ">")
(concat realname " <" username ">")))
passwd-alist))))))
mh-alias-passwd-gecos-comma-separator-flag))
(alias-name (if mh-alias-local-users-prefix
(concat mh-alias-local-users-prefix
(mh-alias-suggest-alias realname t))
username))
(alias-translation
(if (string-equal username realname)
(concat "<" username ">")
(concat realname " <" username ">"))))
(when (not (mh-assoc-ignore-case alias-name mh-alias-alist))
(setq passwd-alist (cons (list alias-name alias-translation)
passwd-alist)))))))
(forward-line 1)))
passwd-alist))
;;;###mh-autoload
(defun mh-alias-reload ()
"Load MH aliases into `mh-alias-alist'."
"Reload MH aliases.
Since aliases are updated frequently, MH-E will reload aliases automatically
whenever an alias lookup occurs if an alias source (a file listed in your
`Aliasfile:' profile component and your password file if variable
`mh-alias-local-users' is non-nil) has changed. However, you can reload your
aliases manually by calling this command directly.
The value of `mh-alias-reloaded-hook' is a list of functions to be called,
with no arguments, after the aliases have been loaded."
(interactive)
(save-excursion
(message "Loading MH aliases...")
@ -269,13 +225,14 @@ non-nil."
(if (not (mh-assoc-ignore-case (car user) mh-alias-alist))
(setq mh-alias-alist (append mh-alias-alist (list user))))
(setq local-users (cdr local-users)))))
(run-hooks 'mh-alias-reloaded-hook)
(message "Loading MH aliases...done"))
;;;###mh-autoload
(defun mh-alias-reload-maybe ()
"Load new MH aliases."
(if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.
(mh-alias-tstamp nil)) ; Out of date, so recreate it.
(if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
(mh-alias-tstamp nil)) ; Out of date?
(mh-alias-reload)))
@ -461,21 +418,21 @@ is converted to lower case."
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."
"Return filename which should be used to add ALIAS.
The value of the option `mh-alias-insert-file' is used if non-nil\; otherwise
the value of the `Aliasfile:' profile component is used.
If the alias already exists, try to return the name of 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]: "
(completing-read "Alias file: "
(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]: "
(completing-read "Alias file: "
(mapcar 'list mh-alias-insert-file) nil t)))))
((and mh-alias-insert-file (stringp mh-alias-insert-file))
mh-alias-insert-file)
@ -490,16 +447,15 @@ contains it."
(cond
((not autolist)
(error "No writable alias file.
Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
Set `mh-alias-insert-file' or the Aliasfile profile component"))
((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))
(completing-read "Alias file: " (mapcar 'list autolist) nil t))
(t
(or (mh-alias-which-file-has-alias alias autolist)
(completing-read "Alias file [press Tab]: "
(completing-read "Alias file: "
(mapcar 'list autolist) nil t))))))))
;;;###mh-autoload
@ -520,10 +476,8 @@ Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
(split-string aliases ", +")))))))
;;;###mh-autoload
(defun mh-alias-from-has-no-alias-p ()
"Return t is From has no current alias set.
In the exceptional situation where there isn't a From header in the message the
function returns nil."
(defun mh-alias-for-from-p ()
"Return t if sender's address has a corresponding alias."
(mh-alias-reload-maybe)
(save-excursion
(if (not (mh-folder-line-matches-show-buffer-p))
@ -532,13 +486,16 @@ function returns nil."
(set-buffer mh-show-buffer))
(let ((from-header (mh-extract-from-header-value)))
(and from-header
(not (mh-alias-address-to-alias from-header)))))))
(mh-alias-address-to-alias from-header))))))
(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 the alias exists already, you will have the choice of inserting the new
alias before or after the old alias. In the former case, this alias will be
used when sending mail to this alias. In the latter case, the alias serves as
an additional folder name hint when filing messages."
(if (not file)
(setq file (mh-alias-insert-file alias)))
(save-excursion
@ -552,14 +509,15 @@ after it."
((re-search-forward
(concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
(let ((answer (read-string
(format "Exists for %s; [i]nsert, [a]ppend: "
(format (concat "Alias %s exists; insert new address "
"[b]efore or [a]fter: ")
(match-string 1))))
(case-fold-search t))
(cond ((string-match "^i" answer))
(cond ((string-match "^b" answer))
((string-match "^a" answer)
(forward-line 1))
(t
(error "Quitting")))))
(error "Unrecognized response")))))
;; No, so sort-in at the right place
;; search for "^alias", then "^alia", etc.
((eq mh-alias-insertion-location 'sorted)
@ -587,8 +545,11 @@ after it."
;;;###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."
This function prompts you for an alias and address. If the alias exists
already, you will have the choice of inserting the new alias before or after
the old alias. In the former case, this alias will be used when sending mail
to this alias. In the latter case, the alias serves as an additional folder
name hint when filing messages."
(interactive "P\nP")
(mh-alias-reload-maybe)
(setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
@ -614,9 +575,7 @@ If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
;;;###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."
"*Add alias for the sender of the current message."
(interactive)
(mh-alias-reload-maybe)
(save-excursion
@ -636,24 +595,26 @@ already has an alias."
;;;###mh-autoload
(defun mh-alias-add-address-under-point ()
"Insert an alias for email address under point."
"Insert an alias for 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."))))
(message "No email address found under point"))))
;;;###mh-autoload
(defun mh-alias-apropos (regexp)
"Show all aliases that match REGEXP either in name or content."
"Show all aliases or addresses that match REGEXP."
(interactive "sAlias regexp: ")
(if mh-alias-local-users
(mh-alias-reload-maybe))
(let ((matches "")(group-matches "")(passwd-matches))
(let ((matches "")
(group-matches "")
(passwd-matches))
(save-excursion
(message "Reading MH aliases...")
(mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
(message "Reading MH aliases...done. Parsing...")
(message "Parsing MH aliases...")
(while (re-search-forward regexp nil t)
(beginning-of-line)
(cond
@ -673,10 +634,9 @@ already has an alias."
(concat matches
(buffer-substring (point)(progn (end-of-line)(point)))
"\n")))))
(message "Reading MH aliases...done. Parsing...done.")
(message "Parsing MH aliases...done")
(when mh-alias-local-users
(message
"Reading MH aliases...done. Parsing...done. Passwd aliases...")
(message "Making passwd aliases...")
(setq passwd-matches
(mapconcat
'(lambda (elem)
@ -684,13 +644,12 @@ already has an alias."
(string-match regexp (cadr elem)))
(format "%s: %s\n" (car elem) (cadr elem))))
mh-alias-passwd-alist ""))
(message
"Reading MH aliases...done. Parsing...done. Passwd aliases...done.")))
(message "Making passwd aliases...done")))
(if (and (string-equal "" matches)
(string-equal "" group-matches)
(string-equal "" passwd-matches))
(message "No matches")
(with-output-to-temp-buffer "*Help*"
(with-output-to-temp-buffer mh-aliases-buffer
(if (not (string-equal "" matches))
(princ matches))
(when (not (string-equal group-matches ""))

450
lisp/mh-e/mh-comp.el
View file

@ -33,11 +33,12 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'gnus-util)
(require 'easymenu)
(require 'mh-utils)
(mh-require-cl)
(require 'mh-gnus)
(eval-when (compile load eval)
(ignore-errors (require 'mailabbrev)))
@ -48,6 +49,7 @@
(defvar sendmail-coding-system)
(defvar mh-identity-list)
(defvar mh-identity-default)
(defvar mh-mml-mode-default)
(defvar mh-identity-menu)
;;; Autoloads
@ -58,7 +60,7 @@
(autoload 'sc-cite-original "sc"
"Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
function according to the agreed upon standard. See `\\[sc-describe]'
function according to the agreed upon standard. See `sc-describe'
for more details. `sc-cite-original' does not do any yanking of the
original message but it does require a few things:
@ -95,14 +97,16 @@ If MH will not allow you to redist a previously redist'd msg, set to nil.")
This allows transaction log to be visible if -watch, -verbose or -snoop are
used.")
(defvar mh-note-repl "-"
"String whose first character is used to notate replied to messages.")
;;; Scan Line Formats
(defvar mh-note-forw "F"
"String whose first character is used to notate forwarded messages.")
(defvar mh-note-repl ?-
"Messages that have been replied to are marked by this character.")
(defvar mh-note-dist "R"
"String whose first character is used to notate redistributed messages.")
(defvar mh-note-forw ?F
"Messages that have been forwarded are marked by this character.")
(defvar mh-note-dist ?R
"Messages that have been redistributed are marked by this character.")
(defvar mh-yank-hooks nil
"Obsolete hook for modifying a citation just inserted in the mail buffer.
@ -113,23 +117,6 @@ text as modified.
This is a normal hook, misnamed for historical reasons.
It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
(defvar mail-citation-hook nil
"*Hook for modifying a citation just inserted in the mail buffer.
Each hook function can find the citation between point and mark.
And each hook function should leave point and mark around the citation
text as modified.
If this hook is entirely empty (nil), the text of the message is inserted
with `mh-ins-buf-prefix' prefixed to each line.
See also the variable `mh-yank-from-start-of-msg', which controls how
much of the message passed to the hook.
This hook was historically provided to set up supercite. You may now leave
this nil and set up supercite by setting the variable
`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
to 'autosupercite.")
(defvar mh-comp-formfile "components"
"Name of file to be used as a skeleton for composing messages.
Default is \"components\". If not an absolute file name, the file
@ -145,7 +132,8 @@ system MH lib directory.")
(defvar mh-repl-group-formfile "replgroupcomps"
"Name of file to be used as a skeleton for replying to messages.
This file is used to form replies to the sender and all recipients of a
message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
message. Only used if `(mh-variant-p 'nmh)' is non-nil.
Default is \"replgroupcomps\".
If not an absolute file name, the file is searched for first in the user's MH
directory, then in the system MH lib directory.")
@ -153,6 +141,8 @@ directory, then in the system MH lib directory.")
(format "^%s$"
(regexp-opt
'("Content-Type: message/rfc822" ;MIME MDN
"------ This is a copy of the message, including all the headers. ------";from exim
"--- Below this line is a copy of the message."; from qmail
" ----- Unsent message follows -----" ;from sendmail V5
" --------Unsent Message below:" ; from sendmail at BU
" ----- Original message follows -----" ;from sendmail V8
@ -201,16 +191,16 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte
"Field name for message annotation.")
(defvar mh-insert-auto-fields-done-local nil
"Buffer-local variable set when `mh-insert-auto-fields' successfully called.")
"Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
;;;###autoload
(defun mh-smail ()
"Compose and send mail with the MH mail system.
This function is an entry point to MH-E, the Emacs front end
to the MH mail system.
This function is an entry point to MH-E, the Emacs interface to the MH mail
system.
See documentation of `\\[mh-send]' for more details on composing mail."
See `mh-send' for more details on composing mail."
(interactive)
(mh-find-path)
(call-interactively 'mh-send))
@ -220,11 +210,11 @@ See documentation of `\\[mh-send]' for more details on composing mail."
;;;###autoload
(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
"Set up a mail composition draft with the MH mail system.
This function is an entry point to MH-E, the Emacs front end
to the MH mail system. This function does not prompt the user
for any header fields, and thus is suitable for use by programs
that want to create a mail buffer.
Users should use `\\[mh-smail]' to compose mail.
This function is an entry point to MH-E, the Emacs interface to the MH mail
system. This function does not prompt the user for any header fields, and thus
is suitable for use by programs that want to create a mail buffer. Users
should use `mh-smail' to compose mail.
Optional arguments for setting certain fields include TO, SUBJECT, and
OTHER-HEADERS. Additional arguments are IGNORED."
(mh-find-path)
@ -260,7 +250,8 @@ CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
"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."
See also `mh-send'."
(interactive (list (mh-get-msg-num t)))
(let* ((from-folder mh-current-folder)
(config (current-window-configuration))
@ -292,7 +283,8 @@ See also documentation for `\\[mh-send]' function."
"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."
See also `mh-send'."
(interactive (list (mh-get-msg-num t)))
(let ((from-folder mh-current-folder)
(config (current-window-configuration))
@ -303,7 +295,7 @@ See also documentation for `\\[mh-send]' function."
(delete-region (point-min) (point))
(mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
(t
(message "Does not appear to be a rejected letter.")))
(message "Does not appear to be a rejected letter")))
(mh-insert-header-separator)
(goto-char (point-min))
(save-buffer)
@ -323,7 +315,7 @@ Default is the displayed message.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
See also documentation for `\\[mh-send]' function."
See also `mh-send'."
(interactive (list (mh-interactive-read-address "To: ")
(mh-interactive-read-address "Cc: ")
(mh-interactive-range "Forward")))
@ -335,7 +327,10 @@ See also documentation for `\\[mh-send]' function."
(draft-name (expand-file-name "draft" mh-user-path))
(draft (cond ((or (not (file-exists-p draft-name))
(y-or-n-p "The file 'draft' exists. Discard it? "))
(mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
(mh-exec-cmd "forw" "-build"
(if (and (mh-variant-p 'nmh)
mh-compose-forward-as-mime-flag)
"-mime")
mh-current-folder
(mh-coalesce-msg-list msgs))
(prog1
@ -388,7 +383,8 @@ See also documentation for `\\[mh-send]' function."
mh-note-forw "Forwarded:"
config)
(mh-letter-mode-message)
(mh-letter-adjust-point)))))
(mh-letter-adjust-point)
(run-hooks 'mh-forward-hook)))))
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
@ -406,10 +402,10 @@ Original message has headers FROM and SUBJECT."
;;;###autoload
(defun mh-smail-other-window ()
"Compose and send mail in other window with the MH mail system.
This function is an entry point to MH-E, the Emacs front end
to the MH mail system.
This function is an entry point to MH-E, the Emacs interface to the MH mail
system.
See documentation of `\\[mh-send]' for more details on composing mail."
See `mh-send' for more details on composing mail."
(interactive)
(mh-find-path)
(call-interactively 'mh-send-other-window))
@ -496,13 +492,15 @@ to reply to:
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."
for the reply.
See also `mh-send'."
(interactive (list
(mh-get-msg-num t)
(let ((minibuffer-help-form
"from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
(or mh-reply-default-reply-to
(completing-read "Reply to whom? (from, to, all) [from]: "
(completing-read "Reply to whom: [from] "
'(("from") ("to") ("cc") ("all"))
nil
t)))
@ -511,7 +509,7 @@ for the reply. See also documentation for `\\[mh-send]' function."
(show-buffer mh-show-buffer)
(config (current-window-configuration))
(group-reply (or (equal reply-to "cc") (equal reply-to "all")))
(form-file (cond ((and mh-nmh-flag group-reply
(form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
(stringp mh-repl-group-formfile))
mh-repl-group-formfile)
((stringp mh-repl-formfile) mh-repl-formfile)
@ -525,7 +523,7 @@ for the reply. See also documentation for `\\[mh-send]' function."
'("-nocc" "all"))
((equal reply-to "to")
'("-cc" "to"))
(group-reply (if mh-nmh-flag
(group-reply (if (mh-variant-p 'nmh 'mu-mh)
'("-group" "-nocc" "me")
'("-cc" "all" "-nocc" "me"))))
(cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
@ -562,7 +560,6 @@ for the reply. See also documentation for `\\[mh-send]' function."
;;;###mh-autoload
(defun mh-send (to cc subject)
"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.
@ -581,7 +578,6 @@ passed three arguments: TO, CC, and SUBJECT."
;;;###mh-autoload
(defun mh-send-other-window (to cc subject)
"Compose and send a letter in another window.
Do not call this function from outside MH-E; use \\[mh-smail-other-window]
instead.
@ -711,6 +707,8 @@ Do not insert any pairs whose value is the empty string."
(while name-values
(let ((field-name (car name-values))
(value (car (cdr name-values))))
(if (not (string-match "^.*:$" field-name))
(setq field-name (concat field-name ":")))
(cond ((equal value "")
nil)
((mh-position-on-field field-name)
@ -730,6 +728,7 @@ The optional second arg is for pre-version 4 compatibility and is IGNORED."
((mh-goto-header-end 0)
nil)))
;;;###mh-autoload
(defun mh-get-header-field (field)
"Find and return the body of FIELD in the mail header.
Returns the empty string if the field is not in the header of the
@ -777,35 +776,53 @@ Returns t if found, nil if not."
;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
(eval-when-compile (defvar mh-letter-menu nil))
(cond
((fboundp 'easy-menu-define)
(easy-menu-define
mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
'("Letter"
["Send This Draft" mh-send-letter t]
["Split Current Line" mh-open-line t]
["Check Recipient" mh-check-whom t]
["Yank Current Message" mh-yank-cur-msg t]
["Insert a Message..." mh-insert-letter t]
["Insert Signature" mh-insert-signature t]
["GPG Sign message"
mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
["GPG Encrypt message"
mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
["Compose Insertion (MIME)..." mh-compose-insertion t]
;; ["Compose Compressed tar (MIME)..."
;;mh-mhn-compose-external-compressed-tar t]
;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
["Compose Forward (MIME)..." mh-compose-forward t]
;; The next two will have to be merged. But I also need to make sure the
;; user can't mix directives of both types.
["Pull in All Compositions (mhn)"
mh-edit-mhn (mh-mhn-directive-present-p)]
["Pull in All Compositions (gnus)"
mh-mml-to-mime (mh-mml-directive-present-p)]
["Revert to Non-MIME Edit (mhn)"
mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
["Kill This Draft" mh-fully-kill-draft t]))))
(easy-menu-define
mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
'("Letter"
["Send This Draft" mh-send-letter t]
["Split Current Line" mh-open-line t]
["Check Recipient" mh-check-whom t]
["Yank Current Message" mh-yank-cur-msg t]
["Insert a Message..." mh-insert-letter t]
["Insert Signature" mh-insert-signature t]
("Encrypt/Sign Message"
["Sign Message"
mh-mml-secure-message-sign mh-gnus-pgp-support-flag]
["Encrypt Message"
mh-mml-secure-message-encrypt mh-gnus-pgp-support-flag]
["Sign+Encrypt Message"
mh-mml-secure-message-signencrypt mh-gnus-pgp-support-flag]
["Disable Security"
mh-mml-unsecure-message mh-gnus-pgp-support-flag]
"--"
"Security Method"
["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
:style radio
:selected (equal mh-mml-method-default "pgpmime")]
["PGP" (setq mh-mml-method-default "pgp")
:style radio
:selected (equal mh-mml-method-default "pgp")]
["S/MIME" (setq mh-mml-method-default "smime")
:style radio
:selected (equal mh-mml-method-default "smime")]
"--"
["Save Method as Default"
(customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
)
["Compose Insertion (MIME)..." mh-compose-insertion t]
["Compose Compressed tar (MIME)..."
mh-mhn-compose-external-compressed-tar t]
["Compose Get File (MIME)..." mh-mhn-compose-anon-ftp t]
["Compose Forward (MIME)..." mh-compose-forward t]
;; The next two will have to be merged. But I also need to make sure the
;; user can't mix directives of both types.
["Pull in All Compositions (mhn)"
mh-edit-mhn (mh-mhn-directive-present-p)]
["Pull in All Compositions (gnus)"
mh-mml-to-mime (mh-mml-directive-present-p)]
["Revert to Non-MIME Edit (mhn)"
mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
["Kill This Draft" mh-fully-kill-draft t]))
;;; Help Messages
;;; Group messages logically, more or less.
@ -817,12 +834,15 @@ Returns t if found, nil if not."
"\t\tInsert:\n"
"Check recipients: \\[mh-check-whom]"
"\t\t Current message: \\[mh-yank-cur-msg]\n"
"Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]"
"\t\t Attachment: \\[mh-compose-insertion]\n"
"Sign message: \\[mh-mml-secure-message-sign-pgpmime]"
"\t\t Message to forward: \\[mh-compose-forward]\n"
"\t\t Attachment: \\[mh-compose-insertion]\n"
"\t\t Message to forward: \\[mh-compose-forward]\n"
" "
"\t\t Signature: \\[mh-insert-signature]"))
"Security:"
"\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]"
"\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"
"\t\t Sign message: \\[mh-mml-secure-message-sign]\n"
" "
"\t\t Signature: \\[mh-insert-signature]"))
"Key binding cheat sheet.
This is an associative array which is used to show the most common commands.
@ -872,13 +892,19 @@ When a message is composed, the hooks `text-mode-hook' and
`mh-letter-mode-hook' are run.
\\{mh-letter-mode-map}"
(or mh-user-path (mh-find-path))
(mh-find-path)
(make-local-variable 'mh-send-args)
(make-local-variable 'mh-annotate-char)
(make-local-variable 'mh-annotate-field)
(make-local-variable 'mh-previous-window-config)
(make-local-variable 'mh-sent-from-folder)
(make-local-variable 'mh-sent-from-msg)
;; Set the local value of mh-mail-header-separator according to what is
;; present in the buffer...
(set (make-local-variable 'mh-mail-header-separator)
(save-excursion
(goto-char (mh-mail-header-end))
(buffer-substring-no-properties (point) (line-end-position))))
(make-local-variable 'mail-header-separator)
(setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
(make-local-variable 'mh-help-messages)
@ -886,12 +912,6 @@ When a message is composed, the hooks `text-mode-hook' and
(setq buffer-invisibility-spec '((vanish . t) t))
(set (make-local-variable 'line-move-ignore-invisible) t)
;; Set mh-mail-header-end-marker to remember end of message header.
(set (make-local-variable 'mh-letter-mail-header-end-marker)
(set-marker (make-marker) (save-excursion
(goto-char (mh-mail-header-end))
(line-beginning-position 2))))
;; From sendmail.el for proper paragraph fill
;; sendmail.el also sets a normal-auto-fill-function (not done here)
(make-local-variable 'paragraph-separate)
@ -965,11 +985,15 @@ When a message is composed, the hooks `text-mode-hook' and
t)))
(defun mh-letter-header-end ()
"Find the end of header from `mh-letter-mail-header-end-marker'."
"Find the end of the message header.
This function is to be used only for font locking. It works by searching for
`mh-mail-header-separator' in the buffer."
(save-excursion
(goto-char (marker-position mh-letter-mail-header-end-marker))
(forward-line -1)
(point)))
(goto-char (point-min))
(cond ((equal mh-mail-header-separator "") (point-min))
((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
(line-beginning-position 0))
(t (point-min)))))
(defun mh-auto-fill-for-letter ()
"Perform auto-fill for message.
@ -1041,16 +1065,69 @@ Prompt for the field name with a completion list of the current folders."
(substring folder 1)
folder)))))
(defun mh-file-is-vcard-p (file)
"Return t if FILE is a .vcf vcard."
(let ((case-fold-search t))
(and (stringp file)
(file-exists-p file)
(or (and (not (mh-have-file-command))
(not (null (string-match "\.vcf$" file))))
(and (mh-have-file-command)
(string-equal "text/x-vcard" (mh-file-mime-type file)))))))
;;;###mh-autoload
(defun mh-insert-signature ()
"Insert the file named by `mh-signature-file-name' at point.
(defun mh-insert-signature (&optional file)
"Insert the signature specified by `mh-signature-file-name' or FILE at point.
A signature separator (`-- ') will be added if the signature block does not
contain one and `mh-signature-separator-flag' is on.
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."
(interactive)
(let ((mh-signature-file-name mh-signature-file-name))
(run-hooks 'mh-letter-insert-signature-hook)
(if mh-signature-file-name
(insert-file-contents mh-signature-file-name)))
called, with no arguments, after the signature is inserted.
The signature can also be inserted with `mh-identity-list'."
(interactive)
(save-excursion
(insert "\n")
(let ((mh-signature-file-name (or file mh-signature-file-name))
(mh-mhn-p (mh-mhn-directive-present-p))
(mh-mml-p (mh-mml-directive-present-p)))
(save-restriction
(narrow-to-region (point) (point))
(cond
((mh-file-is-vcard-p mh-signature-file-name)
(if (equal mh-compose-insertion 'gnus)
(insert "<#part type=\"text/x-vcard\" filename=\""
mh-signature-file-name
"\" disposition=inline description=VCard>\n<#/part>")
(insert "#text/x-vcard; name=\""
(file-name-nondirectory mh-signature-file-name)
"\" [VCard] " (expand-file-name mh-signature-file-name))))
(t
(cond
(mh-mhn-p
(insert "#\n" "Content-Description: Signature\n"))
(mh-mml-p
(mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
'description "Signature")))
(cond ((null mh-signature-file-name))
((and (stringp mh-signature-file-name)
(file-readable-p mh-signature-file-name))
(insert-file-contents mh-signature-file-name))
((functionp mh-signature-file-name)
(funcall mh-signature-file-name)))))
(save-restriction
(widen)
(run-hooks 'mh-letter-insert-signature-hook))
(goto-char (point-min))
(when (and (not (mh-file-is-vcard-p mh-signature-file-name))
mh-signature-separator-flag
(> (point-max) (point-min))
(not (mh-signature-separator-p)))
(cond (mh-mhn-p
(forward-line 2))
(mh-mml-p
(forward-line 1)))
(insert mh-signature-separator))
(if (not (> (point-max) (point-min)))
(message "No signature found")))))
(force-mode-line-update))
;;;###mh-autoload
@ -1100,33 +1177,18 @@ MH the first time a message is composed.")
(defun mh-insert-x-mailer ()
"Append an X-Mailer field to the header.
The versions of MH-E, Emacs, and MH are shown."
;; Lazily initialize mh-x-mailer-string.
(when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
(save-window-excursion
;; User would be confused if version info buffer disappeared magically,
;; so don't delete buffer if it already existed.
(let ((info-buffer-exists-p (get-buffer mh-info-buffer)))
(mh-version)
(set-buffer mh-info-buffer)
(if mh-nmh-flag
(search-forward-regexp "^nmh-\\(\\S +\\)")
(search-forward-regexp "^MH \\(\\S +\\)" nil t))
(let ((x-mailer-mh (buffer-substring (match-beginning 1)
(match-end 1))))
(setq mh-x-mailer-string
(format "MH-E %s; %s %s; %sEmacs %s"
mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
(if mh-xemacs-flag "X" "GNU ")
(cond ((not mh-xemacs-flag) emacs-version)
((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
emacs-version)
(match-string 0 emacs-version))
(t (format "%s.%s"
emacs-major-version
emacs-minor-version))))))
(if (not info-buffer-exists-p)
(kill-buffer mh-info-buffer)))))
(setq mh-x-mailer-string
(format "MH-E %s; %s; %sEmacs %s"
mh-version mh-variant-in-use
(if mh-xemacs-flag "X" "GNU ")
(cond ((not mh-xemacs-flag) emacs-version)
((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
emacs-version)
(match-string 0 emacs-version))
(t (format "%s.%s" emacs-major-version
emacs-minor-version))))))
;; Insert X-Mailer, but only if it doesn't already exist.
(save-excursion
(when (and mh-insert-x-mailer-flag
@ -1155,25 +1217,31 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
something. If NON-INTERACTIVE is non-nil, do not be verbose and only
attempt matches if `mh-insert-auto-fields-done-local' is nil.
An `identity' entry is skipped if one was already entered manually."
An `identity' entry is skipped if one was already entered manually.
Return t if fields added; otherwise return nil."
(interactive)
(when (or (not non-interactive) (not mh-insert-auto-fields-done-local))
(when (or (not non-interactive)
(not mh-insert-auto-fields-done-local))
(save-excursion
(when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")))
(let ((list mh-auto-fields-list))
(when (and (or (mh-goto-header-field "To:")
(mh-goto-header-field "cc:")))
(let ((list mh-auto-fields-list)
(fields-inserted nil))
(while list
(let ((regexp (nth 0 (car list)))
(entries (nth 1 (car list))))
(when (mh-regexp-in-field-p regexp "To:" "cc:")
(setq mh-insert-auto-fields-done-local t)
(setq fields-inserted t)
(if (not non-interactive)
(message "Matched for regexp %s" regexp))
(message "Fields for %s added" regexp))
(let ((entry-list entries))
(while entry-list
(let ((field (caar entry-list))
(value (cdar entry-list)))
(cond
((equal "identity" field)
((equal ":identity" field)
(when (and (not mh-identity-local)
(assoc value mh-identity-list))
(mh-insert-identity value)))
@ -1181,7 +1249,8 @@ An `identity' entry is skipped if one was already entered manually."
(mh-modify-header-field field value
(equal field "From")))))
(setq entry-list (cdr entry-list))))))
(setq list (cdr list))))))))
(setq list (cdr list)))
fields-inserted)))))
(defun mh-modify-header-field (field value &optional overwrite-flag)
"To header FIELD add VALUE.
@ -1201,8 +1270,6 @@ If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded."
(mh-goto-header-end 0)
(insert field ": " value "\n"))))
(defvar mh-letter-mail-header-end-marker nil)
(defun mh-compose-and-send-mail (draft send-args
sent-from-folder sent-from-msg
to subject cc
@ -1221,22 +1288,19 @@ for `mh-annotate-msg'.
CONFIG is the window configuration to restore after sending the letter."
(pop-to-buffer draft)
(mh-letter-mode)
(mh-insert-auto-fields t)
;; mh-identity support
;; Insert identity.
(if (and (boundp 'mh-identity-default)
mh-identity-default
(not mh-identity-local))
(mh-insert-identity mh-identity-default))
(when (and (boundp 'mh-identity-list)
mh-identity-list)
(mh-identity-make-menu)
(easy-menu-add mh-identity-menu))
(mh-identity-make-menu)
(easy-menu-add mh-identity-menu)
;; Extra fields
;; Insert extra fields.
(mh-insert-x-mailer)
(mh-insert-x-face)
;; Hide skipped fields
(mh-letter-hide-all-skipped-fields)
(setq mh-sent-from-folder sent-from-folder)
@ -1264,7 +1328,16 @@ CONFIG is the window configuration to restore after sending the letter."
This should be the last function called when composing the draft."
(message "%s" (substitute-command-keys
(concat "Type \\[mh-send-letter] to send message, "
"\\[mh-help] for help."))))
"\\[mh-help] for help"))))
(defun mh-ascii-buffer-p ()
"Check if current buffer is entirely composed of ASCII.
The function doesn't work for XEmacs since `find-charset-region' doesn't exist
there."
(loop for charset in (mh-funcall-if-exists
find-charset-region (point-min) (point-max))
unless (eq charset 'ascii) return nil
finally return t))
;;;###mh-autoload
(defun mh-send-letter (&optional arg)
@ -1273,15 +1346,17 @@ 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 mhn directives are present; otherwise
run `\\[mh-mml-to-mime]' if mml directives are present.
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."
run `\\[mh-mml-to-mime]' if mml directives are present."
(interactive "P")
(run-hooks 'mh-before-send-letter-hook)
(mh-insert-auto-fields t)
(if (and (mh-insert-auto-fields t)
mh-auto-fields-prompt-flag
(goto-char (point-min)))
(if (not (y-or-n-p "Auto fields inserted, send? "))
(error "Send aborted")))
(cond ((mh-mhn-directive-present-p)
(mh-edit-mhn))
((mh-mml-directive-present-p)
((or (mh-mml-directive-present-p) (not (mh-ascii-buffer-p)))
(mh-mml-to-mime)))
(save-buffer)
(message "Sending...")
@ -1302,7 +1377,7 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
'iso-latin-1))))
;; The default BCC encapsulation will make a MIME message unreadable.
;; With nmh use the -mime arg to prevent this.
(if (and mh-nmh-flag
(if (and (mh-variant-p 'nmh)
(mh-goto-header-field "Bcc:")
(mh-goto-header-field "Content-Type:"))
(setq mh-send-args (format "-mime %s" mh-send-args)))
@ -1338,7 +1413,8 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
;;;###mh-autoload
(defun mh-insert-letter (folder message verbatim)
"Insert a message into the current letter.
Removes the header fields according to the variable `mh-invisible-headers'.
Removes the header fields according to the variable
`mh-invisible-header-fields-compiled'.
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.
@ -1355,11 +1431,12 @@ and point after it."
(save-restriction
(narrow-to-region (point) (point))
(let ((start (point-min)))
(if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
(if (and (equal message "") (numberp mh-sent-from-msg))
(setq message (int-to-string mh-sent-from-msg)))
(insert-file-contents
(expand-file-name message (mh-expand-file-name folder)))
(when (not verbatim)
(mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
(mh-clean-msg-header start mh-invisible-header-fields-compiled nil)
(goto-char (point-max)) ;Needed for sc-cite-original
(push-mark) ;Needed for sc-cite-original
(goto-char (point-min)) ;Needed for sc-cite-original
@ -1373,15 +1450,13 @@ and point after it."
(skip-chars-forward " ")
(cond
((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
(format "%s %s %s" (match-string 1)(match-string 2)
mh-extract-from-attribution-verb))
(format "%s %s " (match-string 1)(match-string 2)))
((looking-at "\\([^<\n]+<.+>\\)$")
(format "%s %s" (match-string 1) mh-extract-from-attribution-verb))
(format "%s " (match-string 1)))
((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
(format "%s <%s> %s" (match-string 2)(match-string 1)
mh-extract-from-attribution-verb))
(format "%s <%s> " (match-string 2)(match-string 1)))
((looking-at " *\\(.+\\)$")
(format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
(format "%s " (match-string 1)))))))
;;;###mh-autoload
(defun mh-yank-cur-msg ()
@ -1444,9 +1519,11 @@ yanked message will be deleted."
(push-mark) ;Needed for sc-cite-original
(goto-char (point-min)) ;Needed for sc-cite-original
(mh-insert-prefix-string mh-ins-buf-prefix)
(if (or (eq 'attribution mh-yank-from-start-of-msg)
(eq 'autoattrib mh-yank-from-start-of-msg))
(insert from-attr "\n\n"))
(when (or (eq 'attribution mh-yank-from-start-of-msg)
(eq 'autoattrib mh-yank-from-start-of-msg))
(insert from-attr)
(mh-identity-insert-attribution-verb nil)
(insert "\n\n"))
;; If the user has selected a region, he has already "edited" the
;; text, so leave the cursor at the end of the yanked text. In
;; either case, leave a mark at the opposite end of the included
@ -1572,7 +1649,7 @@ Any match found replaces the text from BEGIN to END."
(let ((syntax-table (syntax-table)))
(unwind-protect
(save-excursion
(mh-funcall-if-exists mail-abbrev-make-syntax-table)
(mh-mail-abbrev-make-syntax-table)
(set-syntax-table mail-abbrev-syntax-table)
(backward-word n)
(point))
@ -1593,7 +1670,6 @@ Any match found replaces the text from BEGIN to END."
(mh-folder-completion-function folder nil t))))
(mh-complete-word folder choices beg end)))
;; XXX: This should probably be customizable
(defvar mh-letter-complete-function-alist
'((cc . mh-alias-letter-expand-alias)
(bcc . mh-alias-letter-expand-alias)
@ -1607,10 +1683,10 @@ Any match found replaces the text from BEGIN to END."
(defun mh-letter-complete (arg)
"Perform completion on header field or word preceding point.
Alias completion is done within the mail header on selected fields based on
the matches in `mh-letter-complete-function-alist'. Elsewhere the function
designated by `mh-letter-complete-function' is used and given the prefix ARG,
if present."
If the field contains addresses (for example, `To:' or `Cc:') or folders (for
example, `Fcc:') then this function will provide alias completion. Elsewhere,
this function runs `mh-letter-complete-function' instead and passes the prefix
ARG, if present."
(interactive "P")
(let ((func nil))
(cond ((not (mh-in-header-p))
@ -1832,10 +1908,13 @@ Otherwise return the empty string."
;;; Build the letter-mode keymap:
;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
(gnus-define-keys mh-letter-mode-map
" " mh-letter-complete-or-space
"," mh-letter-confirm-address
"\C-c?" mh-help
"\C-c\C-\\" mh-fully-kill-draft ;if no C-q
"\C-c\C-^" mh-insert-signature ;if no C-s
"\C-c\C-c" mh-send-letter
"\C-c\C-d" mh-insert-identity
"\C-c\M-d" mh-insert-auto-fields
"\C-c\C-e" mh-edit-mhn
"\C-c\C-f\C-b" mh-to-field
"\C-c\C-f\C-c" mh-to-field
@ -1852,31 +1931,38 @@ Otherwise return the empty string."
"\C-c\C-fs" mh-to-field
"\C-c\C-ft" mh-to-field
"\C-c\C-i" mh-insert-letter
"\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime
"\C-c\C-m\C-e" mh-mml-secure-message-encrypt
"\C-c\C-m\C-f" mh-compose-forward
"\C-c\C-m\C-g" mh-mhn-compose-anon-ftp
"\C-c\C-m\C-i" mh-compose-insertion
"\C-c\C-m\C-m" mh-mml-to-mime
"\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime
"\C-c\C-m\C-n" mh-mml-unsecure-message
"\C-c\C-m\C-s" mh-mml-secure-message-sign
"\C-c\C-m\C-t" mh-mhn-compose-external-compressed-tar
"\C-c\C-m\C-u" mh-revert-mhn-edit
"\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime
"\C-c\C-m\C-x" mh-mhn-compose-external-type
"\C-c\C-mee" mh-mml-secure-message-encrypt
"\C-c\C-mes" mh-mml-secure-message-signencrypt
"\C-c\C-mf" mh-compose-forward
"\C-c\C-mg" mh-mhn-compose-anon-ftp
"\C-c\C-mi" mh-compose-insertion
"\C-c\C-mm" mh-mml-to-mime
"\C-c\C-ms" mh-mml-secure-message-sign-pgpmime
"\C-c\C-mn" mh-mml-unsecure-message
"\C-c\C-mse" mh-mml-secure-message-signencrypt
"\C-c\C-mss" mh-mml-secure-message-sign
"\C-c\C-mt" mh-mhn-compose-external-compressed-tar
"\C-c\C-mu" mh-revert-mhn-edit
"\C-c\C-mx" mh-mhn-compose-external-type
"\C-c\C-o" mh-open-line
"\C-c\C-q" mh-fully-kill-draft
"\C-c\C-\\" mh-fully-kill-draft ;if no C-q
"\C-c\C-s" mh-insert-signature
"\C-c\C-^" mh-insert-signature ;if no C-s
"\C-c\C-t" mh-letter-toggle-header-field-display
"\C-c\C-w" mh-check-whom
"\C-c\C-y" mh-yank-cur-msg
"\C-c\C-t" mh-letter-toggle-header-field-display
" " mh-letter-complete-or-space
"\C-c\M-d" mh-insert-auto-fields
"\M-\t" mh-letter-complete
"\t" mh-letter-next-header-field-or-indent
[backtab] mh-letter-previous-header-field
"," mh-letter-confirm-address)
[backtab] mh-letter-previous-header-field)
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.

2776
lisp/mh-e/mh-customize.el
View file

File diff suppressed because it is too large Load diff

529
lisp/mh-e/mh-e.el
View file

@ -5,7 +5,7 @@
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Version: 7.4.4
;; Version: 7.82
;; Keywords: mail
;; This file is part of GNU Emacs.
@ -75,25 +75,21 @@
;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu
;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
;; Rewritten for GNU Emacs, James Larus, 1985.
;; Modified by Stephen Gildea, 1988.
;; Maintenance picked up by Bill Wohler and the
;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001.
;;; Code:
(provide 'mh-e)
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(defvar recursive-load-depth-limit)
(eval-when (compile load eval)
(if (and (boundp 'recursive-load-depth-limit)
(integerp recursive-load-depth-limit)
(> 50 recursive-load-depth-limit))
(setq recursive-load-depth-limit 50)))
(require 'mh-utils)
(require 'mh-init)
(require 'mh-inc)
(require 'mh-seq)
(require 'gnus-util)
(require 'easymenu)
@ -101,35 +97,27 @@
(defvar font-lock-auto-fontify)
(defvar font-lock-defaults)
(defconst mh-version "7.4.4" "Version number of MH-E.")
(defconst mh-version "7.82" "Version number of MH-E.")
;;; Autoloads
(autoload 'Info-goto-node "info")
(defvar mh-note-deleted "D"
"String whose first character is used to notate deleted messages.")
(defvar mh-note-refiled "^"
"String whose first character is used to notate refiled messages.")
(defvar mh-note-cur "+"
"String whose first character is used to notate the current message.")
(defvar mh-partial-folder-mode-line-annotation "select"
"Annotation when displaying part of a folder.
The string is displayed after the folder's name. nil for no annotation.")
;;; Scan Line Formats
;;; Parameterize MH-E to work with different scan formats. The defaults work
;;; with the standard MH scan listings, in which the first 4 characters on
;;; the line are the message number, followed by two places for notations.
;; The following scan formats are passed to the scan program if the
;; setting of `mh-scan-format-file' above is nil. They are identical
;; except the later one makes use of the nmh `decode' function to
;; decode RFC 2047 encodings. If you just want to change the width of
;; the msg number, use the `mh-set-cmd-note' function.
;; The following scan formats are passed to the scan program if the setting of
;; `mh-scan-format-file' is t. They are identical except the later one makes
;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just
;; want to change the width of the msg number, use the `mh-set-cmd-note'
;; function.
(defvar mh-scan-format-mh
(concat
@ -150,11 +138,10 @@ This format is identical to the default except that additional hints for
fontification have been added to the fifth column (remember that in Emacs, the
first column is 0).
The values of the fifth column, in priority order, are: `-' if the
message has been replied to, t if an address on the To: line matches
one of the mailboxes of the current user, `c' if the Cc: line matches,
`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
is present.")
The values of the fifth column, in priority order, are: `-' if the message has
been replied to, t if an address on the To: line matches one of the
mailboxes of the current user, `c' if the Cc: line matches, `b' if the Bcc:
line matches, and `n' if a non-empty Newsgroups: header is present.")
(defvar mh-scan-format-nmh
(concat
@ -176,78 +163,94 @@ This format is identical to the default except that additional hints for
fontification have been added to the fifth column (remember that in Emacs, the
first column is 0).
The values of the fifth column, in priority order, are: `-' if the
message has been replied to, t if an address on the To: line matches
one of the mailboxes of the current user, `c' if the Cc: line matches,
`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
is present.")
The values of the fifth column, in priority order, are: `-' if the message has
been replied to, t if an address on the To: field matches one of the
mailboxes of the current user, `c' if the Cc: field matches, `b' if the Bcc:
field matches, and `n' if a non-empty Newsgroups: field is present.")
(defvar mh-note-deleted ?D
"Deleted messages are marked by this character.
See also `mh-scan-deleted-msg-regexp'.")
(defvar mh-note-refiled ?^
"Refiled messages are marked by this character.
See also `mh-scan-refiled-msg-regexp'.")
(defvar mh-note-cur ?+
"The current message (in MH) is marked by this character.
See also `mh-scan-cur-msg-number-regexp'.")
(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
"Regexp specifying the scan lines that are 'good' messages.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.")
"This regexp specifies the scan lines that are 'good' messages.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which matches the
message number as in the default of \"^\\\\( *[0-9]+\\\\)[^D^0-9]\".")
(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
"Regexp matching scan lines of deleted messages.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.")
"This regexp matches deleted messages.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which matches the
message number as in the default of \"^\\\\( *[0-9]+\\\\)D\".
See also `mh-note-deleted'.")
(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
"Regexp matching scan lines of refiled messages.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.")
"This regexp matches refiled messages.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which matches the
message number as in the default of \"^\\\\( *[0-9]+\\\\)\\\\^\".
See also `mh-note-refiled'.")
(defvar mh-scan-valid-regexp "^ *[0-9]"
"Regexp matching scan lines for messages (not error messages).")
"This regexp matches scan lines for messages (not error messages).")
(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
"Regexp matching scan line for the current message.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.
Don't disable this regexp as it's needed by non fontifying functions.")
(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
"Regexp matching scan line for the current message.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the whole line.
To enable this feature, remove the string DISABLED from the regexp.")
"This regexp matches the current message.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which matches the
message number as in the default of \"^\\\\( *[0-9]+\\\\+\\\\).*\". Don't
disable this regexp as it's needed by non-fontifying functions.
See also `mh-note-cur'.")
(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
"Regexp matching a valid date in scan lines.
The default `mh-folder-font-lock-keywords' expects this expression to contain
only one parenthesized expression which matches the date field
\(see `mh-scan-format-regexp').")
"This regexp matches a valid date.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain only one parenthesized expression which matches the date
field as in the default of \"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}.
See also `mh-scan-format-regexp'.")
(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
"Regexp specifying the recipient in scan lines for messages we sent.
The default `mh-folder-font-lock-keywords' expects this expression to contain
two parenthesized expressions. The first is expected to match the To:
that the default scan format file generates. The second is expected to match
the recipient's name.")
"This regexp specifies the recipient in messages you sent.
Note that the default setting of `mh-folder-font-lock-keywords'
expects this expression to contain two parenthesized expressions. The
first is expected to match the `To:' that the default scan format
file generates. The second is expected to match the recipient's name
as in the default of \"\\\\(To:\\\\)\\\\(..............\\\\)\".")
(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
"Regexp matching the message body beginning displayed in scan lines.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the body text.")
"This regexp matches the message body fragment displayed in scan lines.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which matches the
body text as in the default of \"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\".")
(defvar mh-scan-subject-regexp
;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
"^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
"*Regexp matching the subject string in MH folder mode.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least tree parenthesized expressions. The first is expected to match the Re:
string, if any. The second matches an optional bracketed number after Re,
such as in Re[2]: and the third is expected to match the subject line itself.")
"This regexp matches the subject.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least three parenthesized expressions. The first is
expected to match the `Re:' string, if any. The second matches an optional
bracketed number after `Re:', such as in `Re[2]:' (and is thus a
sub-expression of the first expression) and the third is expected to match
the subject line itself as in the default of \"^ *[0-9]+........[ ]*...................\\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)*\\\\([^<\\n]*\\\\)\".")
(defvar mh-scan-format-regexp
(concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
"Regexp matching the output of scan.
The default value is based upon the default values of either
`mh-scan-format-mh' or `mh-scan-format-nmh'.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least three parenthesized expressions. The first should match the
fontification hint, the second is found in `mh-scan-date-regexp', and the
third should match the user name.")
"This regexp matches the output of scan.
Note that the default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least three parenthesized expressions. The first
should match the fontification hint, the second is found in
`mh-scan-date-regexp', and the third should match the user name as in the
default of \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp
\"*\\\\(..................\\\\)\")\".")
@ -279,10 +282,7 @@ third should match the user name.")
;; scan font-lock name
(list mh-scan-format-regexp
'(1 mh-folder-date-face)
'(3 mh-folder-scan-format-face))
;; Current message line
(list mh-scan-cur-msg-regexp
'(1 mh-folder-cur-msg-face prepend t)))
'(3 mh-folder-scan-format-face)))
"Regexp keywords used to fontify the MH-Folder buffer.")
(defvar mh-scan-cmd-note-width 1
@ -356,46 +356,6 @@ This column will only ever have spaces in it.")
;; Fontifify unseen mesages in bold.
(defvar mh-folder-unseen-seq-name nil
"Name of unseen sequence.
The default for this is provided by the function `mh-folder-unseen-seq-name'
On nmh systems.")
(defun mh-folder-unseen-seq-name ()
"Provide name of unseen sequence from mhparam."
(or mh-progs (mh-find-path))
(save-excursion
(let ((unseen-seq-name "unseen"))
(with-temp-buffer
(unwind-protect
(progn
(call-process (expand-file-name "mhparam" mh-progs)
nil '(t t) nil "-component" "Unseen-Sequence")
(goto-char (point-min))
(if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
(setq unseen-seq-name (match-string 1))))))
unseen-seq-name)))
(defun mh-folder-unseen-seq-list ()
"Return a list of unseen message numbers for current folder."
(if (not mh-folder-unseen-seq-name)
(setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
(cond
((not mh-folder-unseen-seq-name)
nil)
(t
(let ((folder mh-current-folder))
(save-excursion
(with-temp-buffer
(unwind-protect
(progn
(call-process (expand-file-name "mark" mh-progs)
nil '(t t) nil
folder "-seq" mh-folder-unseen-seq-name
"-list")
(goto-char (point-min))
(sort (mh-read-msg-list) '<)))))))))
(defmacro mh-generate-sequence-font-lock (seq prefix face)
"Generate the appropriate code to fontify messages in SEQ.
PREFIX is used to generate unique names for the variables and functions
@ -492,6 +452,8 @@ is done highlighting.")
;Rememeber original notation that
;is overwritten by `mh-note-seq'.
(defvar mh-colors-available-flag nil) ;Are colors available?
;;; Macros and generic functions:
(defun mh-mapc (function list)
@ -503,7 +465,7 @@ is done highlighting.")
(defun mh-scan-format ()
"Return the output format argument for the scan program."
(if (equal mh-scan-format-file t)
(list "-format" (if mh-nmh-flag
(list "-format" (if (mh-variant-p 'nmh 'mu-mh)
(list (mh-update-scan-format
mh-scan-format-nmh mh-cmd-note))
(list (mh-update-scan-format
@ -519,7 +481,7 @@ is done highlighting.")
(defun mh-rmail (&optional arg)
"Inc(orporate) new mail with MH.
Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
the Emacs front end to the MH mail system."
the Emacs interface to the MH mail system."
(interactive "P")
(mh-find-path)
(if arg
@ -532,7 +494,7 @@ the Emacs front end to the MH mail system."
(defun mh-nmail (&optional arg)
"Check for new mail in inbox folder.
Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
the Emacs front end to the MH mail system."
the Emacs interface to the MH mail system."
(interactive "P")
(mh-find-path) ; init mh-inbox
(if arg
@ -616,6 +578,7 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
(setq folder mh-inbox))
(let ((threading-needed-flag nil))
(let ((config (current-window-configuration)))
(delete-other-windows)
(cond ((not (get-buffer folder))
(mh-make-folder folder)
(setq threading-needed-flag mh-show-threads-flag)
@ -659,25 +622,26 @@ last undeleted message then pause for a second after printing message."
(if wait-after-complaining-flag (sit-for 1)))))
(defun mh-folder-from-address ()
"Determine folder name from address in From field.
Takes the address in the From: header field, and returns one of:
"Derive folder name from sender.
a) The folder name associated with the address in the alist
`mh-default-folder-list'. If the `Check Recipient' boolean
is set, then the `mh-default-folder-list' addresses are
checked against the recipient instead of the originator
(making possible to use this feature for mailing lists).
The first match found in `mh-default-folder-list' is used.
The name of the folder is derived as follows:
b) The address' corresponding alias from the user's personal
aliases file prefixed by `mh-default-folder-prefix'.
a) The folder name associated with the first address found in the list
`mh-default-folder-list' is used. Each element in this list contains a
`Check Recipient' item. If this item is turned on, then the address is
checked against the recipient instead of the sender. This is useful for
mailing lists.
Returns nil if the address was not found in either place or if the variable
`mh-default-folder-must-exist-flag' is nil and the folder does not exist."
b) An alias prefixed by `mh-default-folder-prefix' corresponding to the
address is used. The prefix is used to prevent clutter in your mail
directory.
Return nil if a folder name was not derived, or if the variable
`mh-default-folder-must-exist-flag' is t and the folder does not exist."
;; Loop for all entries in mh-default-folder-list
(save-restriction
(goto-char (point-min))
(re-search-forward "\n\n" nil t)
(re-search-forward "\n\n" nil 'limit)
(narrow-to-region (point-min) (point))
(let ((to/cc (concat (or (message-fetch-field "to") "") ", "
(or (message-fetch-field "cc") "")))
@ -715,25 +679,24 @@ Returns nil if the address was not found in either place or if the variable
"Prompt the user for a folder in which the message should be filed.
The folder is returned as a string.
If `mh-default-folder-for-message-function' is a function then the message
being refiled is yanked into a temporary buffer and the function is called to
intelligently guess where the message is to be refiled.
Otherwise, a default folder name is generated by `mh-folder-from-address'."
The default folder name is generated by the option
`mh-default-folder-for-message-function' if it is non-nil or
`mh-folder-from-address'."
(mh-prompt-for-folder
"Destination"
(let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
(save-excursion
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(insert-file-contents refile-file)
(or (and mh-default-folder-for-message-function
(let ((buffer-file-name refile-file))
(funcall mh-default-folder-for-message-function)))
(mh-folder-from-address)
(and (eq 'refile (car mh-last-destination-folder))
(symbol-name (cdr mh-last-destination-folder)))
"")))
(let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t)))))
(if (null refile-file) ""
(save-excursion
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(insert-file-contents refile-file)
(or (and mh-default-folder-for-message-function
(let ((buffer-file-name refile-file))
(funcall mh-default-folder-for-message-function)))
(mh-folder-from-address)
(and (eq 'refile (car mh-last-destination-folder))
(symbol-name (cdr mh-last-destination-folder)))
""))))
t))
(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
@ -872,7 +835,9 @@ are skipped."
(setq count (1- count)))
(not (car unread-sequence)))
(message "No more unread messages"))
(t (mh-goto-msg (car unread-sequence))))))
(t (loop for msg in unread-sequence
when (mh-goto-msg msg t) return nil
finally (message "No more unread messages"))))))
(defun mh-goto-next-button (backward-flag &optional criterion)
"Search for next button satisfying criterion.
@ -1090,7 +1055,7 @@ interactive use."
(if (not (mh-outstanding-commands-p))
(mh-set-folder-modified-p nil)))
;;;###mh-autoload
(defun mh-folder-line-matches-show-buffer-p ()
"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,
@ -1123,7 +1088,6 @@ compiled then macro expansion happens at compile time."
(defun mh-version ()
"Display version information about MH-E and the MH mail handling system."
(interactive)
(mh-find-progs)
(set-buffer (get-buffer-create mh-info-buffer))
(erase-buffer)
;; MH-E version.
@ -1140,19 +1104,12 @@ compiled then macro expansion happens at compile time."
;; Emacs version.
(insert (emacs-version) "\n\n")
;; MH version.
(let ((help-start (point)))
(condition-case err-data
(mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
(file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
(goto-char help-start)
(if mh-nmh-flag
(search-forward "inc -- " nil t)
(search-forward "version: " nil t))
(delete-region help-start (point)))
(goto-char (point-max))
(insert " mh-progs:\t" mh-progs "\n"
" mh-lib:\t" mh-lib "\n"
" mh-lib-progs:\t" mh-lib-progs "\n\n")
(if mh-variant-in-use
(insert mh-variant-in-use "\n"
" mh-progs:\t" mh-progs "\n"
" mh-lib:\t" mh-lib "\n"
" mh-lib-progs:\t" mh-lib-progs "\n\n")
(insert "No MH variant detected\n"))
;; Linux version.
(condition-case ()
(call-process "uname" nil t nil "-a")
@ -1202,7 +1159,7 @@ used to avoid problems in corner cases involving folders whose names end with a
(defun mh-folder-size-flist (folder)
"Find size of FOLDER using `flist'."
(with-temp-buffer
(call-process (expand-file-name "flist" mh-progs) nil t nil
(call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
"-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
(goto-char (point-min))
(multiple-value-bind (folder unseen total)
@ -1236,6 +1193,7 @@ regardless of the size of the `mh-large-folder' variable."
(let ((config (current-window-configuration))
(current-buffer (current-buffer))
(threaded-view-flag mh-show-threads-flag))
(delete-other-windows)
(save-excursion
(when (get-buffer folder)
(set-buffer folder)
@ -1258,12 +1216,11 @@ regardless of the size of the `mh-large-folder' variable."
(mh-toggle-threads))
(mh-index-data
(mh-index-insert-folder-headers)))
(unless mh-showing-mode (delete-other-windows))
(unless (eq current-buffer (current-buffer))
(setq mh-previous-window-config config)))
nil)
;;;###mh-autoload
(defun mh-update-sequences ()
"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."
@ -1334,7 +1291,7 @@ arguments, after the message has been refiled."
(mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
"-src" mh-current-folder
(symbol-name folder))
(message "Message not copied.")))
(message "Message not copied")))
(t
(mh-set-folder-modified-p t)
(cond ((null (assoc folder mh-refile-list))
@ -1381,7 +1338,9 @@ With optional argument COUNT, COUNT-1 unread messages are skipped."
(setq count (1- count)))
(not (car unread-sequence)))
(message "No more unread messages"))
(t (mh-goto-msg (car unread-sequence))))))
(t (loop for msg in unread-sequence
when (mh-goto-msg msg t) return nil
finally (message "No more unread messages"))))))
(defun mh-set-scan-mode ()
"Display the scan listing buffer, but do not show a message."
@ -1472,12 +1431,12 @@ Make it the current folder."
["Go to First Message" mh-first-msg t]
["Go to Last Message" mh-last-msg t]
["Go to Message by Number..." mh-goto-msg t]
["Modify Message" mh-modify]
["Modify Message" mh-modify t]
["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
["Undo Delete/Refile" mh-undo t]
["Process Delete/Refile" mh-execute-commands
(or mh-refile-list mh-delete-list)]
["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)]
["Execute Delete/Refile" mh-execute-commands
(mh-outstanding-commands-p)]
"--"
["Compose a New Message" mh-send t]
["Reply to Message..." mh-reply (mh-get-msg-num nil)]
@ -1501,7 +1460,7 @@ Make it the current folder."
["Incorporate New Mail" mh-inc-folder t]
["Toggle Show/Folder" mh-toggle-showing t]
["Execute Delete/Refile" mh-execute-commands
(or mh-refile-list mh-delete-list)]
(mh-outstanding-commands-p)]
["Rescan Folder" mh-rescan-folder t]
["Thread Folder" mh-toggle-threads
(not (memq 'unthread mh-view-ops))]
@ -1541,6 +1500,12 @@ is used in previous versions and XEmacs."
(defvar tool-bar-map)
(defvar desktop-save-buffer)) ;Emacs 21.4
;; Register mh-folder-mode as supporting which-function-mode...
(load "which-func" t t)
(when (and (boundp 'which-func-modes)
(not (member 'mh-folder-mode which-func-modes)))
(push 'mh-folder-mode which-func-modes))
(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
"Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
@ -1548,16 +1513,49 @@ You can show the message the cursor is pointing to, and step through the
messages. Messages can be marked for deletion or refiling into another
folder; these commands are executed all at once with a separate command.
A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
applies the action to a message sequence. If `transient-mark-mode',
is non-nil, the action is applied to the region.
Options that control this mode can be changed with \\[customize-group];
specify the \"mh\" group. In particular, please see the `mh-scan-format-file'
option if you wish to modify scan's format.
When a folder is visited, the hook `mh-folder-mode-hook' is run.
Ranges
======
Many commands that operate on individual messages, such as `mh-forward' or
`mh-refile-msg' take a RANGE argument. This argument can be used in several
ways.
If you provide the prefix argument (\\[universal-argument]) to these commands,
then you will be prompted for the message range. This can be any legal MH
range which can include messages, sequences, and the abbreviations (described
in the mh(1) man page):
<num1>-<num2>
Indicates all messages in the range <num1> to <num2>, inclusive. The range
must be nonempty.
`<num>:N'
`<num>:+N'
`<num>:-N'
Up to N messages beginning with (or ending with) message num. Num may be
any of the pre-defined symbols: first, prev, cur, next or last.
`first:N'
`prev:N'
`next:N'
`last:N'
The first, previous, next or last messages, if they exist.
`all'
All of the messages.
For example, a range that shows all of these things is `1 2 3 5-10 last:5
unseen'.
If the option `transient-mark-mode' is set to t and you set a region in the
MH-Folder buffer, then the MH-E command will perform the operation on all
messages in that region.
\\{mh-folder-mode-map}"
(make-local-variable 'font-lock-defaults)
@ -1565,10 +1563,15 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(make-local-variable 'desktop-save-buffer)
(setq desktop-save-buffer t)
(mh-make-local-vars
'mh-colors-available-flag (mh-colors-available-p)
; Do we have colors available
'mh-current-folder (buffer-name) ; Name of folder, a string
'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
(file-name-as-directory (mh-expand-file-name (buffer-name)))
'mh-display-buttons-for-inline-parts-flag
mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
; be toggled.
'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
'overlay-arrow-position nil ; Allow for simultaneous display in
'overlay-arrow-string ">" ; different MH-E buffers.
@ -1597,6 +1600,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
'mh-sequence-notation-history (make-hash-table)
; Remember what is overwritten by
; mh-note-seq.
'imenu-create-index-function 'mh-index-create-imenu-index
; Setup imenu support
'mh-previous-window-config nil) ; Previous window configuration
(mh-remove-xemacs-horizontal-scrollbar)
(setq truncate-lines t)
@ -1620,6 +1625,26 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
font-lock-auto-fontify)
(turn-on-font-lock))) ; Force font-lock in XEmacs.
(defun mh-toggle-mime-buttons ()
"Toggle display of buttons for inline MIME parts."
(interactive)
(setq mh-display-buttons-for-inline-parts-flag
(not mh-display-buttons-for-inline-parts-flag))
(mh-show nil t))
(defun mh-colors-available-p ()
"Check if colors are available in the Emacs being used."
(or mh-xemacs-flag
(let ((color-cells
(or (ignore-errors (mh-funcall-if-exists display-color-cells))
(ignore-errors (mh-funcall-if-exists
x-display-color-cells)))))
(and (numberp color-cells) (>= color-cells 8)))))
(defun mh-colors-in-use-p ()
"Check if colors are being used in the folder buffer."
(and mh-colors-available-flag font-lock-mode))
(defun mh-make-local-vars (&rest pairs)
"Initialize local variables according to the variable-value PAIRS."
@ -1631,7 +1656,11 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(defun mh-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore an MH folder buffer specified in a desktop file."
"Restore an MH folder buffer specified in a desktop file.
When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the file name to
visit, DESKTOP-BUFFER-NAME holds the desired buffer name, and
DESKTOP-BUFFER-MISC holds a list of miscellaneous info used by the
`desktop-buffer-handlers' functions."
(mh-find-path)
(mh-visit-folder desktop-buffer-name)
(current-buffer))
@ -1641,6 +1670,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
refiles aren't carried out.
Return in the folder's buffer."
(when (stringp range)
(setq range (delete "" (split-string range "[ \t\n]"))))
(cond ((null (get-buffer folder))
(mh-make-folder folder))
(t
@ -1693,7 +1724,9 @@ If UPDATE, append the scan lines, otherwise replace."
(goto-char scan-start)
(cond ((looking-at "scan: no messages in")
(keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
((looking-at "scan: bad message list ")
((looking-at (if (mh-variant-p 'mu-mh)
"scan: message set .* does not exist"
"scan: bad message list "))
(keep-lines mh-scan-valid-regexp))
((looking-at "scan: ")) ; Keep error messages
(t
@ -1869,46 +1902,21 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
(""))))))
(mh-logo-display))))
;;; XXX: Remove this function, if no one uses it any more...
(defun mh-unmark-all-headers (remove-all-flags)
"Remove all '+' flags from the folder listing.
With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
Optimized for speed (i.e., no regular expressions).
This function is deprecated. Use `mh-remove-all-notation' instead."
(save-excursion
(let ((case-fold-search nil)
(last-line (1- (point-max)))
char)
(mh-first-msg)
(while (<= (point) last-line)
(forward-char mh-cmd-note)
(setq char (following-char))
(if (or (and remove-all-flags
(or (= char (aref mh-note-deleted 0))
(= char (aref mh-note-refiled 0))))
(= char (aref mh-note-cur 0)))
(progn
(delete-char 1)
(insert " ")))
(if remove-all-flags
(progn
(forward-char 1)
(if (= (following-char) (aref mh-note-seq 0))
(progn
(delete-char 1)
(insert " ")))))
(forward-line)))))
(defun mh-add-sequence-notation (msg internal-seq-flag)
"Add sequence notation to the MSG on the current line.
If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the
current line, so that font-lock would automatically refontify it."
If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if font-lock is
turned on."
(with-mh-folder-updating (t)
(save-excursion
(beginning-of-line)
(if internal-seq-flag
(mh-notate nil nil mh-cmd-note)
(progn
;; Change the buffer so that if transient-mark-mode is active
;; and there is an active region it will get deactivated as in
;; the case of user sequences.
(mh-notate nil nil mh-cmd-note)
(when font-lock-mode
(font-lock-fontify-region (point) (line-end-position))))
(forward-char (1+ mh-cmd-note))
(let ((stack (gethash msg mh-sequence-notation-history)))
(setf (gethash msg mh-sequence-notation-history)
@ -1930,7 +1938,11 @@ If ALL is non-nil, then all sequence marks on the scan line are removed."
(while (and all (cdr stack))
(setq stack (cdr stack)))
(when stack
(mh-notate nil (car stack) (1+ mh-cmd-note)))
(save-excursion
(beginning-of-line)
(forward-char (1+ mh-cmd-note))
(delete-char 1)
(insert (car stack))))
(setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
(defun mh-remove-cur-notation ()
@ -1953,7 +1965,7 @@ If ALL is non-nil, then all sequence marks on the scan line are removed."
(mh-remove-sequence-notation msg nil t))
(clrhash mh-sequence-notation-history)))
;;;###mh-autoload
(defun mh-goto-cur-msg (&optional minimal-changes-flag)
"Position the cursor at the current message.
When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
@ -2102,7 +2114,10 @@ with no arguments, after the unseen sequence is updated."
(defun mh-outstanding-commands-p ()
"Return non-nil if there are outstanding deletes or refiles."
(or mh-delete-list mh-refile-list))
(save-excursion
(when (eq major-mode 'mh-show-mode)
(set-buffer mh-show-folder-buffer))
(or mh-delete-list mh-refile-list)))
(defun mh-coalesce-msg-list (messages)
"Given a list of MESSAGES, return a list of message number ranges.
@ -2223,7 +2238,7 @@ numbers, a sequence, a region in a cons cell. If nil all messages are notated."
"Return non-nil if NAME is the name of an internal MH-E sequence."
(or (memq name mh-internal-seqs)
(eq name mh-unseen-seq)
(and mh-tick-seq (eq name mh-tick-seq))
(and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq))
(eq name mh-previous-seq)
(mh-folder-name-p name)))
@ -2264,6 +2279,15 @@ change."
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
(apply #'mh-speed-flists t folders-changed)))))
(defun mh-catchup (range)
"Delete RANGE from the `mh-unseen-seq' sequence.
Check the document of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Catchup"
(cons (point-min) (point-max)))))
(mh-delete-msg-from-seq range mh-unseen-seq))
(defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
"Delete MSG from SEQUENCE.
If INTERNAL-FLAG is non-nil, then do not inform MH of the change."
@ -2291,23 +2315,6 @@ Signals an error if SEQ is an illegal name."
"-sequence" (symbol-name seq)
(mh-coalesce-msg-list msgs)))))
(defun mh-map-over-seqs (function seq-list)
"Apply FUNCTION to each sequence in SEQ-LIST.
The sequence name and the list of messages are passed as arguments."
(while seq-list
(funcall function
(mh-seq-name (car seq-list))
(mh-seq-msgs (car seq-list)))
(setq seq-list (cdr seq-list))))
(defun mh-notate-if-in-one-seq (msg character offset seq)
"Notate MSG.
The CHARACTER is placed at the given OFFSET from the beginning of the listing.
The notation is performed if the MSG is only in SEQ."
(let ((in-seqs (mh-seq-containing-msg msg nil)))
(if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
(mh-notate msg character offset))))
(defun mh-seq-containing-msg (msg &optional include-internal-flag)
"Return a list of the sequences containing MSG.
If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
@ -2341,6 +2348,7 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
"'" mh-toggle-tick
"," mh-header-display
"." mh-alt-show
";" mh-toggle-mh-decode-mime-flag
">" mh-write-msg-to-file
"?" mh-help
"E" mh-extract-rejected-mail
@ -2362,7 +2370,6 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
"g" mh-goto-msg
"i" mh-inc-folder
"k" mh-delete-subject-or-thread
"l" mh-print-msg
"m" mh-alt-send
"n" mh-next-undeleted-msg
"\M-n" mh-next-unread-msg
@ -2382,6 +2389,7 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
"?" mh-prefix-help
"'" mh-index-ticked-messages
"S" mh-sort-folder
"c" mh-catchup
"f" mh-alt-visit-folder
"i" mh-index-search
"k" mh-kill-folder
@ -2402,6 +2410,17 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
"b" mh-junk-blacklist
"w" mh-junk-whitelist)
(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
"?" mh-prefix-help
"A" mh-ps-print-toggle-mime
"C" mh-ps-print-toggle-color
"F" mh-ps-print-toggle-faces
"M" mh-ps-print-toggle-mime
"f" mh-ps-print-msg-file
"l" mh-print-msg
"p" mh-ps-print-msg
"s" mh-ps-print-msg-show)
(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
"'" mh-narrow-to-tick
"?" mh-prefix-help
@ -2446,8 +2465,10 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
"?" mh-prefix-help
"a" mh-mime-save-parts
"e" mh-display-with-external-viewer
"i" mh-folder-inline-mime-part
"o" mh-folder-save-mime-part
"t" mh-toggle-mime-buttons
"v" mh-folder-toggle-mime-part
"\t" mh-next-button
[backtab] mh-prev-button
@ -2477,13 +2498,17 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
(defvar mh-help-messages
'((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
"[d]elete, [o]refile, e[x]ecute,\n"
"[s]end, [r]eply.\n"
"[s]end, [r]eply,\n"
"[;]toggle MIME decoding.\n"
"Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
"\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
(?F "[l]ist; [v]isit folder;\n"
"[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
"[p]ack; [S]ort; [r]escan; [k]ill")
(?P "PS [p]rint message; [l]non-PS print;\n"
"PS Print [s]how window, message to [f]ile;\n"
"Toggle printing of [M]IME parts, [C]olor, [F]aces")
(?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
"[s]equences, [l]ist,\n"
"[d]elete message from sequence, [k]ill sequence")

97
lisp/mh-e/mh-funcs.el
View file

@ -1,6 +1,6 @@
;;; mh-funcs.el --- MH-E functions not everyone will use right away
;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,6 +34,8 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
;;; Customization
@ -45,11 +47,13 @@ prefix argument. Normally default arguments to sortm are specified in the
MH profile.
For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
;;; Scan Line Formats
(defvar mh-note-copied "C"
"String whose first character is used to notate copied messages.")
"Copied messages are marked by this character.")
(defvar mh-note-printed "P"
"String whose first character is used to notate printed messages.")
"Messages that have been printed are marked by this character.")
;;; Functions
@ -232,60 +236,6 @@ Otherwise just send the message's body without the headers."
(forward-line 2))
(mh-recenter 0)))
;;;###mh-autoload
(defun mh-print-msg (range)
"Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'."
(interactive (list (mh-interactive-range "Print")))
(message "Printing...")
(let (msgs)
;; Gather message numbers and add them to "printed" sequence.
(mh-iterate-on-range msg range
(mh-add-msgs-to-seq msg 'printed t)
(mh-notate nil mh-note-printed mh-cmd-note)
(push msg msgs))
(setq msgs (nreverse msgs))
;; Print scan listing if we have more than one message.
(if (> (length msgs) 1)
(let* ((msgs-string
(mapconcat 'identity (mh-list-to-string
(mh-coalesce-msg-list msgs)) " "))
(lpr-command
(format mh-lpr-command-format
(cond ((listp range)
(format "Folder: %s, Messages: %s"
mh-current-folder msgs-string))
((symbolp range)
(format "Folder: %s, Sequence: %s"
mh-current-folder range)))))
(scan-command
(format "scan %s | %s" msgs-string lpr-command)))
(if mh-print-background-flag
(mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
(call-process shell-file-name nil nil nil "-c" scan-command))))
;; Print the messages
(dolist (msg msgs)
(let* ((mhl-command (format "%s %s %s"
(expand-file-name "mhl" mh-lib-progs)
(if mhl-formfile
(format " -form %s" mhl-formfile)
"")
(mh-msg-filename msg)))
(lpr-command
(format mh-lpr-command-format
(format "%s/%s" mh-current-folder msg)))
(print-command
(format "%s | %s" mhl-command lpr-command)))
(if mh-print-background-flag
(mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
(call-process shell-file-name nil nil nil "-c" print-command)))))
(message "Printing...done"))
;;;###mh-autoload
(defun mh-sort-folder (&optional extra-args)
"Sort the messages in the current folder by date.
@ -307,9 +257,8 @@ argument EXTRA-ARGS is given."
(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."
(defun mh-undo-folder ()
"Undo all pending deletes and refiles in current folder."
(interactive)
(cond ((or mh-do-not-confirm-flag
(yes-or-no-p "Undo all commands in folder? "))
@ -320,10 +269,7 @@ Argument IGNORE is deprecated."
(with-mh-folder-updating (nil)
(mh-remove-all-notation)))
(t
(message "Commands not undone.")
;; Remove by 2003-06-30 if nothing seems amiss. XXX
;; (sit-for 2)
)))
(message "Commands not undone"))))
;;;###mh-autoload
(defun mh-store-msg (directory)
@ -413,11 +359,15 @@ Default directory is the last directory used, or initially the value of
;;;###mh-autoload
(defun mh-help ()
"Display cheat sheet for the MH-Folder commands in minibuffer."
"Display cheat sheet for the MH-E commands."
(interactive)
(mh-ephem-message
(substitute-command-keys
(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
(with-electric-help
(function
(lambda ()
(insert
(substitute-command-keys
(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
mh-help-buffer)))
;;;###mh-autoload
(defun mh-prefix-help ()
@ -430,9 +380,14 @@ Default directory is the last directory used, or initially the value of
;; from the recent keys.
(let* ((keys (recent-keys))
(prefix-char (elt keys (- (length keys) 2))))
(mh-ephem-message
(substitute-command-keys
(mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
(with-electric-help
(function
(lambda ()
(insert
(substitute-command-keys
(mapconcat 'identity
(cdr (assoc prefix-char mh-help-messages)) "")))))
mh-help-buffer)))
(provide 'mh-funcs)

36
lisp/mh-e/mh-gnus.el
View file

@ -1,6 +1,6 @@
;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus.
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,6 +34,7 @@
(load "mm-uu" t t) ; Non-fatal dependency
(load "mailcap" t t) ; Non-fatal dependency
(load "smiley" t t) ; Non-fatal dependency
(load "mailabbrev" t t)
(defmacro mh-defun-compat (function arg-list &rest body)
"This is a macro to define functions which are not defined.
@ -74,12 +75,28 @@ BODY."
(put-text-property 0 (length (car handle)) parameter value
(car handle))))
;; Copy of function from mm-view.el
(mh-defun-compat mm-inline-text-vcard (handle)
(let (buffer-read-only)
(mm-insert-inline
handle
(concat "\n-- \n"
(ignore-errors
(if (fboundp 'vcard-pretty-print)
(vcard-pretty-print (mm-get-part handle))
(vcard-format-string
(vcard-parse-string (mm-get-part handle)
'vcard-standard-filter))))))))
;; Function from mm-decode.el used in PGP messages. Just define it with older
;; gnus to avoid compiler warning.
(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl)
nil)
;; Copy of original macro is in mm-decode.el
(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
`(get-text-property 0 ,parameter (car ,handle)))
(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
;; Copy of original function in mm-decode.el
(mh-defun-compat mm-readable-p (handle)
"Say whether the content of HANDLE is readable."
@ -134,10 +151,23 @@ BODY."
file)))
(mm-save-part-to-file handle file))))
(defun mh-mm-text-html-renderer ()
"Find the renderer gnus is using to display text/html MIME parts."
(or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer)
(and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))
(defun mh-mail-abbrev-make-syntax-table ()
"Call `mail-abbrev-make-syntax-table' if available."
(when (fboundp 'mail-abbrev-make-syntax-table)
(mail-abbrev-make-syntax-table)))
(provide 'mh-gnus)
;;; Local Variables:
;;; no-byte-compile: t
;;; no-update-autoloads: t
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa

296
lisp/mh-e/mh-identity.el
View file

@ -39,47 +39,50 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-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
(require 'mh-comp)
(autoload 'mml-insert-tag "mml")
(defvar mh-identity-pgg-default-user-id nil
"Holds the GPG key ID to be used by pgg.el.
This is normally set as part of an Identity in `mh-identity-list'.")
(make-variable-buffer-local 'mh-identity-pgg-default-user-id)
;;;###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")]
'(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list]
"--")
(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]
)))))
"Build the Identity menu.
This should be called any time `mh-identity-list' or `mh-auto-fields-list'
change."
(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")]
'(["Insert Auto Fields"
(mh-insert-auto-fields) mh-auto-fields-list]
"--")
(mapcar (function
(lambda (arg)
`[,arg (mh-insert-identity ,arg) :style radio
:selected (equal mh-identity-local ,arg)]))
(mapcar 'car mh-identity-list))
'(["None"
(mh-insert-identity "None") :style radio
:selected (not 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]
["Customize Identities" (customize-variable 'mh-identity-list) t]
))))
;;;###mh-autoload
(defun mh-identity-list-set (symbol value)
@ -97,21 +100,36 @@ customization). This is called after 'customize is used to alter
(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))
(let ((field-colon (if (string-match "^.*:$" field)
field
(concat field ":"))))
(when (mh-goto-header-field field-colon)
(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'.")
(defun mh-identity-field-handler (field)
"Return the handler for a FIELD or nil if none set.
The field name is downcased. If the FIELD begins with the character
`:', then it must have a special handler defined in
`mh-identity-handlers', else return an error since it is not a legal
message header."
(or (cdr (assoc (downcase field) mh-identity-handlers))
(and (eq (aref field 0) ?:)
(error (format "Field %s - unknown mh-identity-handler" field)))
(cdr (assoc ":default" mh-identity-handlers))
'mh-identity-handler-default))
;;;###mh-autoload
(defun mh-insert-identity (identity)
"Insert proper fields for given IDENTITY.
@ -120,7 +138,7 @@ Edit the `mh-identity-list' variable to define identity."
(list (completing-read
"Identity: "
(if mh-identity-local
(cons '("none")
(cons '("None")
(mapcar 'list (mapcar 'car mh-identity-list)))
(mapcar 'list (mapcar 'car mh-identity-list)))
nil t)))
@ -129,83 +147,135 @@ Edit the `mh-identity-list' variable to define identity."
(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))))
(let* ((field (caar pers-list))
(handler (mh-identity-field-handler field)))
(funcall handler field 'remove))
(setq pers-list (cdr pers-list)))))
;; Then insert the replacement
(when (not (equal "none" identity))
(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.
((mh-mhn-directive-present-p)
(insert "#\n" "Content-Description: Signature\n"))
((mh-mml-directive-present-p)
(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))
(cond ((mh-mhn-directive-present-p)
(forward-line 2))
((mh-mml-directive-present-p)
(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))))
(let* ((field (caar pers-list))
(value (cdar pers-list))
(handler (mh-identity-field-handler field)))
(funcall handler field 'add value))
(setq pers-list (cdr pers-list))))))
;; Remember what is in use in this buffer
(if (equal "none" identity)
(if (equal "None" identity)
(setq mh-identity-local nil)
(setq mh-identity-local identity)))
;;;###mh-autoload
(defun mh-identity-handler-gpg-identity (field action &optional value)
"For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add.
The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE
when action 'add is selected."
(cond
((or (equal action 'remove)
(not value)
(string= value ""))
(setq mh-identity-pgg-default-user-id nil))
((equal action 'add)
(setq mh-identity-pgg-default-user-id value))))
;;;###mh-autoload
(defun mh-identity-handler-signature (field action &optional value)
"For FIELD \"signature\", process headers for ACTION 'remove or 'add.
The VALUE is added."
(cond
((equal action 'remove)
(when (and (markerp mh-identity-signature-start)
(markerp mh-identity-signature-end))
(delete-region mh-identity-signature-start
mh-identity-signature-end)))
(t
;; Insert "signature". Nil value means to use `mh-signature-file-name'.
(when (not (mh-signature-separator-p)) ;...unless already present
(goto-char (point-max))
(save-restriction
(narrow-to-region (point) (point))
(if (null value)
(mh-insert-signature)
(mh-insert-signature value))
(set (make-local-variable 'mh-identity-signature-start)
(point-min-marker))
(set-marker-insertion-type mh-identity-signature-start t)
(set (make-local-variable 'mh-identity-signature-end)
(point-max-marker)))))))
(defvar mh-identity-attribution-verb-start nil
"Marker for the beginning of the attribution verb.")
(defvar mh-identity-attribution-verb-end nil
"Marker for the end of the attribution verb.")
;;;###mh-autoload
(defun mh-identity-handler-attribution-verb (field action &optional value)
"For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add.
The VALUE is added."
(when (and (markerp mh-identity-attribution-verb-start)
(markerp mh-identity-attribution-verb-end))
(delete-region mh-identity-attribution-verb-start
mh-identity-attribution-verb-end)
(goto-char mh-identity-attribution-verb-start)
(cond
((equal action 'remove) ; Replace with default
(mh-identity-insert-attribution-verb nil))
(t ; Insert attribution verb.
(mh-identity-insert-attribution-verb value)))))
;;;###mh-autoload
(defun mh-identity-insert-attribution-verb (value)
"Insert VALUE as attribution verb, setting up delimiting markers.
If VALUE is nil, use `mh-extract-from-attribution-verb'."
(save-restriction
(narrow-to-region (point) (point))
(if (null value)
(insert mh-extract-from-attribution-verb)
(insert value))
(set (make-local-variable 'mh-identity-attribution-verb-start)
(point-min-marker))
(set-marker-insertion-type mh-identity-attribution-verb-start t)
(set (make-local-variable 'mh-identity-attribution-verb-end)
(point-max-marker))))
(defun mh-identity-handler-default (field action top &optional value)
"For FIELD, process mh-identity headers for ACTION 'remove or 'add.
if TOP is non-nil, add the field and it's VALUE at the top of the header, else
add it at the bottom of the header."
(let ((field-colon (if (string-match "^.*:$" field)
field
(concat field ":"))))
(cond
((equal action 'remove)
(mh-header-field-delete field-colon nil))
(t
(cond
;; No value, remove field
((or (not value)
(string= value ""))
(mh-header-field-delete field-colon nil))
;; Existing field, replace
((mh-header-field-delete field-colon t)
(insert value))
;; Other field, add at end or top
(t
(goto-char (point-min))
(if (not top)
(mh-goto-header-end 0))
(insert field-colon " " value "\n")))))))
;;;###mh-autoload
(defun mh-identity-handler-top (field action &optional value)
"For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the top of the header."
(mh-identity-handler-default field action t value))
;;;###mh-autoload
(defun mh-identity-handler-bottom (field action &optional value)
"For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the bottom of the header."
(mh-identity-handler-default field action nil value))
(provide 'mh-identity)
;;; Local Variables:

8
lisp/mh-e/mh-inc.el
View file

@ -1,6 +1,6 @@
;;; mh-inc.el --- MH-E `inc' and separate mail spool handling
;;
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,7 +34,8 @@
;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(defvar mh-inc-spool-map (make-sparse-keymap)
"Keymap for MH-E's mh-inc-spool commands.")
@ -46,7 +47,8 @@
'(lambda ()
(interactive)
(if mh-inc-spool-map-help
(mh-ephem-message (substring mh-inc-spool-map-help 0 -1))
(let ((mh-help-messages (list (list nil mh-inc-spool-map-help))))
(mh-help))
(mh-ephem-message
"There are no keys defined yet. Customize `mh-inc-spool-list'"))))

225
lisp/mh-e/mh-index.el
View file

@ -31,7 +31,6 @@
;;; swish-e
;;; mairix
;;; namazu
;;; glimpse
;;; grep
;;;
;;; (2) To use this package, you first have to build an index. Please read
@ -43,7 +42,7 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'mh-mime)
@ -66,8 +65,6 @@
mh-mairix-regexp-builder)
(namazu
mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
(glimpse
mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil)
(pick
mh-pick-binary mh-pick-execute-search mh-pick-next-result
mh-pick-regexp-builder)
@ -200,7 +197,8 @@ This function should only be called in the appropriate index folder buffer."
(call-process "rm" nil nil nil
(format "%s%s/%s" mh-user-path
(substring mh-current-folder 1) msg))
(remhash omsg (gethash ofolder mh-index-data))))
(when (gethash ofolder mh-index-data)
(remhash omsg (gethash ofolder mh-index-data)))))
(t
(setf (gethash msg mh-index-msg-checksum-map) checksum)
(when origin-map
@ -301,7 +299,8 @@ list of messages in that sequence."
(pair (gethash checksum mh-index-checksum-origin-map))
(ofolder (car pair))
(omsg (cdr pair)))
(loop for seq in (gethash omsg (gethash ofolder seq-hash))
(loop for seq in (ignore-errors
(gethash omsg (gethash ofolder seq-hash)))
do (if (assoc seq seq-list)
(push msg (cdr (assoc seq seq-list)))
(push (list seq msg) seq-list)))))
@ -374,7 +373,6 @@ index for each program:
- `mh-swish-execute-search'
- `mh-mairix-execute-search'
- `mh-namazu-execute-search'
- `mh-glimpse-execute-search'
If none of these programs are present then we use pick. If desired grep can be
used instead. Details about these methods can be found in:
@ -436,7 +434,7 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
(setq index-folder buffer-name))
(setq index-folder (mh-index-new-folder index-folder)))
(setq index-folder (mh-index-new-folder index-folder search-regexp)))
(let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
(folder-results-map (make-hash-table :test #'equal))
@ -587,13 +585,6 @@ PROC is used to convert the value to actual data."
mh-previous-window-config)
(error "No search terms"))))
(defun mh-replace-string (old new)
"Replace all occurrences of OLD with NEW in the current buffer."
(goto-char (point-min))
(let ((case-fold-search t))
(while (search-forward old nil t)
(replace-match new t t))))
;;;###mh-autoload
(defun mh-index-parse-search-regexp (input-string)
"Construct parse tree for INPUT-STRING.
@ -739,28 +730,48 @@ results."
"Check if MSG exists in FOLDER."
(file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
(defun mh-index-new-folder (name)
"Create and return an MH folder name based on NAME.
If the folder NAME already exists then check if NAME<2> exists. If it doesn't
then it is created and returned. Otherwise try NAME<3>. This is repeated till
we find a new folder name."
(defun mh-index-new-folder (name search-regexp)
"Return a folder name based on NAME for search results of SEARCH-REGEXP.
If folder NAME already exists and was generated for the same SEARCH-REGEXP
then it is reused.
Otherwise if the folder NAME was generated from a different search then check
if NAME<2> can be used. Otherwise try NAME<3>. This is repeated till we find a
new folder name.
If the folder returned doesn't exist then it is created."
(unless (mh-folder-name-p name)
(error "The argument should be a valid MH folder name"))
(let ((chosen-name name))
(block unique-name
(unless (mh-folder-exists-p name)
(return-from unique-name))
(loop for index from 2
do (let ((new-name (format "%s<%s>" name index)))
(unless (mh-folder-exists-p new-name)
(setq chosen-name new-name)
(return-from unique-name)))))
(let ((chosen-name
(loop for i from 1
for candidate = (if (equal i 1) name (format "%s<%s>" name i))
when (or (not (mh-folder-exists-p candidate))
(equal (mh-index-folder-search-regexp candidate)
search-regexp))
return candidate)))
;; Do pending refiles/deletes...
(when (get-buffer chosen-name)
(mh-process-or-undo-commands chosen-name))
;; Recreate folder...
(save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name))
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
(mh-remove-from-sub-folders-cache chosen-name)
(when (boundp 'mh-speed-folder-map)
(mh-speed-add-folder chosen-name))
chosen-name))
(defun mh-index-folder-search-regexp (folder)
"If FOLDER was created by a index search, return the search regexp.
Return nil if FOLDER doesn't exist or the .mhe_index file is garbled."
(ignore-errors
(with-temp-buffer
(insert-file-contents
(format "%s%s/%s" mh-user-path (substring folder 1) mh-index-data-file))
(goto-char (point-min))
(forward-list 3)
(cadr (read (current-buffer))))))
;;;###mh-autoload
(defun mh-index-insert-folder-headers ()
"Annotate the search results with original folder names."
@ -777,8 +788,27 @@ we find a new folder name."
(insert (if last-folder "\n" "") current-folder "\n")
(setq last-folder current-folder))
(forward-line))
(when cur-msg (mh-goto-msg cur-msg t))
(set-buffer-modified-p old-buffer-modified-flag)))
(when cur-msg
(mh-notate-cur)
(mh-goto-msg cur-msg t))
(set-buffer-modified-p old-buffer-modified-flag))
(mh-index-create-imenu-index))
;;;###mh-autoload
(defun mh-index-create-imenu-index ()
"Create alist of folder names and positions in index folder buffers."
(save-excursion
(setq which-func-mode t)
(let ((alist ()))
(goto-char (point-min))
(while (re-search-forward "^+" nil t)
(save-excursion
(beginning-of-line)
(push (cons (buffer-substring-no-properties
(point) (line-end-position))
(set-marker (make-marker) (point)))
alist)))
(setq imenu--index-alist (nreverse alist)))))
;;;###mh-autoload
(defun mh-index-group-by-folder ()
@ -837,23 +867,6 @@ list of messages originally from that folder."
folder (loop for x being the hash-keys of (gethash folder mh-index-data)
when (mh-msg-exists-p x folder) collect x)))))
;;;###mh-autoload
(defun mh-index-update-unseen (msg)
"Remove counterpart of MSG in source folder from `mh-unseen-seq'.
Also `mh-update-unseen' is called in the original folder, if we have it open."
(let* ((checksum (gethash msg mh-index-msg-checksum-map))
(folder-msg-pair (gethash checksum mh-index-checksum-origin-map))
(orig-folder (car folder-msg-pair))
(orig-msg (cdr folder-msg-pair)))
(when (mh-index-match-checksum orig-msg orig-folder checksum)
(when (get-buffer orig-folder)
(save-excursion
(set-buffer orig-folder)
(unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))
(mh-update-unseen)))
(mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)
"-sequence" (symbol-name mh-unseen-seq) "-del"))))
(defun mh-index-match-checksum (msg folder checksum)
"Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
(with-temp-buffer
@ -973,90 +986,6 @@ update the source folder buffer if present."
;; Glimpse interface
(defvar mh-glimpse-binary (executable-find "glimpse"))
(defvar mh-glimpse-directory ".glimpse")
;;;###mh-autoload
(defun mh-glimpse-execute-search (folder-path search-regexp)
"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."
(set-buffer (get-buffer-create mh-index-temp-buffer))
(erase-buffer)
(call-process mh-glimpse-binary nil '(t nil) nil
;(format "-%s" fuzz)
"-i" "-y"
"-H" (format "%s%s" mh-user-path mh-glimpse-directory)
"-F" (format "^%s" folder-path)
search-regexp)
(goto-char (point-min)))
(defun mh-glimpse-next-result ()
"Read the next result.
Parse it and return the message folder, message index and the match. If no
other matches left then return nil. If the current record is invalid return
'error."
(prog1
(block nil
(when (eobp)
(return nil))
(let ((eol-pos (line-end-position))
(bol-pos (line-beginning-position))
folder-start msg-end)
(goto-char bol-pos)
(unless (search-forward mh-user-path eol-pos t)
(return 'error))
(setq folder-start (point))
(unless (search-forward ": " eol-pos t)
(return 'error))
(let ((match (buffer-substring-no-properties (point) eol-pos)))
(forward-char -2)
(setq msg-end (point))
(unless (search-backward "/" folder-start t)
(return 'error))
(list (format "+%s" (buffer-substring-no-properties
folder-start (point)))
(let ((val (ignore-errors (read-from-string
(buffer-substring-no-properties
(1+ (point)) msg-end)))))
(if (and (consp val) (integerp (car val)))
(car val)
(return 'error)))
match))))
(forward-line)))
;; Pick interface
(defvar mh-index-pick-folder)
@ -1319,16 +1248,12 @@ then the folders are searched recursively. All parameters ARGS are ignored."
;;;###mh-autoload
(defun mh-index-sequenced-messages (folders sequence)
"Display messages from FOLDERS in SEQUENCE.
By default the folders specified by `mh-index-new-messages-folders' are
searched. With a prefix argument, enter a space-separated list of folders, or
nothing to search all folders.
Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
function searches for in each of the FOLDERS. With a prefix argument, enter a
sequence to use."
All messages in the sequence you provide from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of folders, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
(split-string (read-string "Search folder(s): [all] "))
mh-index-new-messages-folders)
(mh-read-seq-default "Search" nil)))
(unless sequence (setq sequence mh-unseen-seq))
@ -1367,26 +1292,26 @@ sequence to use."
;;;###mh-autoload
(defun mh-index-new-messages (folders)
"Display unseen messages.
All messages in the `unseen' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-new-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders."
If you use a program such as `procmail' to use `rcvstore' to file your
incoming mail automatically, you can display new, unseen, messages using this
command. All messages in the `unseen' sequence from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
(split-string (read-string "Search folder(s): [all] "))
mh-index-new-messages-folders)))
(mh-index-sequenced-messages folders mh-unseen-seq))
;;;###mh-autoload
(defun mh-index-ticked-messages (folders)
"Display ticked messages.
All messages in the `tick' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-ticked-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders."
All messages in `mh-tick-seq' from the folders in
`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
(split-string (read-string "Search folder(s): [all] "))
mh-index-ticked-messages-folders)))
(mh-index-sequenced-messages folders mh-tick-seq))

308
lisp/mh-e/mh-init.el Normal file
View file

@ -0,0 +1,308 @@
;;; mh-init.el --- MH-E initialization.
;; Copyright (C) 2003, 2004 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:
;; Sets up the MH variant (currently nmh or MH).
;;
;; Users may customize `mh-variant' to switch between available variants.
;; Available MH variants are described in the variable `mh-variants'.
;; Developers may check which variant is currently in use with the
;; variable `mh-variant-in-use' or the function `mh-variant-p'.
;;; Change Log:
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-utils)
;;; Set for local environment:
;;; mh-progs and mh-lib used to be set in paths.el, which tried to
;;; figure out at build time which of several possible directories MH
;;; was installed into. But if you installed MH after building Emacs,
;;; this would almost certainly be wrong, so now we do it at run time.
(defvar mh-progs nil
"Directory containing MH commands, such as inc, repl, and rmm.")
(defvar mh-lib nil
"Directory containing the MH library.
This directory contains, among other things, the components file.")
(defvar mh-lib-progs nil
"Directory containing MH helper programs.
This directory contains, among other things, the mhl program.")
(defvar mh-flists-present-flag nil
"Non-nil means that we have `flists'.")
;;;###autoload
(put 'mh-progs 'risky-local-variable t)
;;;###autoload
(put 'mh-lib 'risky-local-variable t)
;;;###autoload
(put 'mh-lib-progs 'risky-local-variable t)
(defvar mh-variant-in-use nil
"The MH variant currently in use; a string with variant and version number.
This differs from `mh-variant' when the latter is set to `autodetect'.")
;;;###mh-autoload
(defun mh-variant-set (variant)
"Set the MH variant to VARIANT.
Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'.
If the VARIANT is `autodetect', then first try nmh, then MH and finally
GNU mailutils."
(interactive
(list (completing-read
"MH Variant: "
(mapcar (lambda (x) (list (car x))) (mh-variants))
nil t)))
(let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants))))
(cond
((eq variant 'none))
((eq variant 'autodetect)
(cond
((mh-variant-set-variant 'nmh)
(message "%s installed as MH variant" mh-variant-in-use))
((mh-variant-set-variant 'mh)
(message "%s installed as MH variant" mh-variant-in-use))
((mh-variant-set-variant 'mu-mh)
(message "%s installed as MH variant" mh-variant-in-use))
(t
(message "No MH variant found on the system!"))))
((member variant valid-list)
(when (not (mh-variant-set-variant variant))
(message "Warning: %s variant not found. Autodetecting..." variant)
(mh-variant-set 'autodetect)))
(t
(message "Unknown variant. Use %s"
(mapconcat '(lambda (x) (format "%s" (car x)))
mh-variants " or "))))))
(defun mh-variant-set-variant (variant)
"Setup the system variables for the MH variant named VARIANT.
If VARIANT is a string, use that key in the variable `mh-variants'.
If VARIANT is a symbol, select the first entry that matches that variant."
(cond
((stringp variant) ;e.g. "nmh 1.1-RC1"
(when (assoc variant mh-variants)
(let* ((alist (cdr (assoc variant mh-variants)))
(lib-progs (cadr (assoc 'mh-lib-progs alist)))
(lib (cadr (assoc 'mh-lib alist)))
(progs (cadr (assoc 'mh-progs alist)))
(flists (cadr (assoc 'flists alist))))
;;(set-default mh-variant variant)
(setq mh-x-mailer-string nil
mh-flists-present-flag flists
mh-lib-progs lib-progs
mh-lib lib
mh-progs progs
mh-variant-in-use variant))))
((symbolp variant) ;e.g. 'nmh (pick the first match)
(loop for variant-list in mh-variants
when (eq variant (cadr (assoc 'variant (cdr variant-list))))
return (let* ((version (car variant-list))
(alist (cdr variant-list))
(lib-progs (cadr (assoc 'mh-lib-progs alist)))
(lib (cadr (assoc 'mh-lib alist)))
(progs (cadr (assoc 'mh-progs alist)))
(flists (cadr (assoc 'flists alist))))
;;(set-default mh-variant flavor)
(setq mh-x-mailer-string nil
mh-flists-present-flag flists
mh-lib-progs lib-progs
mh-lib lib
mh-progs progs
mh-variant-in-use version)
t)))))
;;;###mh-autoload
(defun mh-variant-p (&rest variants)
"Return t if variant is any of VARIANTS.
Currently known variants are 'MH, 'nmh, and 'mu-mh."
(let ((variant-in-use
(cadr (assoc 'variant (assoc mh-variant-in-use mh-variants)))))
(not (null (member variant-in-use variants)))))
(defvar mh-sys-path
'("/usr/local/nmh/bin" ; nmh default
"/usr/local/bin/mh/"
"/usr/local/mh/"
"/usr/bin/mh/" ; Ultrix 4.2, Linux
"/usr/new/mh/" ; Ultrix < 4.2
"/usr/contrib/mh/bin/" ; BSDI
"/usr/pkg/bin/" ; NetBSD
"/usr/local/bin/"
"/usr/local/bin/mu-mh/" ; GNU mailutils - default
"/usr/bin/mu-mh/") ; GNU mailutils - packaged
"List of directories to search for variants of the MH variant.
The list `exec-path' is searched in addition to this list.
There's no need for users to modify this list. Instead add extra
directories to the customizable variable `mh-path'.")
(defcustom mh-path nil
"*List of directories to search for variants of the MH variant.
The directories will be searched for `mhparam' in addition to directories
listed in `mh-sys-path' and `exec-path'."
:group 'mh
:type '(repeat (directory)))
(defvar mh-variants nil
"List describing known MH variants.
Created by the function `mh-variants'")
(defun mh-variant-mh-info (dir)
"Return info for MH variant in DIR assuming a temporary buffer is setup."
;; MH does not have the -version option.
;; Its version number is included in the output of `-help' as:
;;
;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999
;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE]
;; [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK]
;; [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME]
;; [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS]
;; [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO]
;; [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF]
(let ((mhparam (expand-file-name "mhparam" dir)))
(when (and (file-exists-p mhparam) (file-executable-p mhparam))
(erase-buffer)
(call-process mhparam nil '(t nil) nil "-help")
(goto-char (point-min))
(when (search-forward-regexp "version: MH \\(\\S +\\)" nil t)
(let ((version (format "MH %s" (match-string 1))))
(erase-buffer)
(call-process mhparam nil '(t nil) nil "libdir")
(goto-char (point-min))
(when (search-forward-regexp "^.*$" nil t)
(let ((libdir (match-string 0)))
`(,version
(variant mh)
(mh-lib-progs ,libdir)
(mh-lib ,libdir)
(mh-progs ,dir)
(flists nil)))))))))
(defun mh-variant-mu-mh-info (dir)
"Return info for GNU mailutils variant in DIR.
This assumes that a temporary buffer is setup."
;; 'mhparam -version' output:
;; mhparam (GNU mailutils 0.3.2)
(let ((mhparam (expand-file-name "mhparam" dir)))
(when (and (file-exists-p mhparam) (file-executable-p mhparam))
(erase-buffer)
(call-process mhparam nil '(t nil) nil "-version")
(goto-char (point-min))
(when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))"
nil t)
(let ((version (match-string 1)))
(erase-buffer)
(call-process mhparam nil '(t nil) nil "libdir" "etcdir")
(goto-char (point-min))
(when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
(let ((libdir (match-string 1)))
(goto-char (point-min))
(when (search-forward-regexp
"^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
(let ((etcdir (match-string 1))
(flists (file-exists-p (expand-file-name "flists" dir))))
`(,version
(variant mu-mh)
(mh-lib-progs ,libdir)
(mh-lib ,etcdir)
(mh-progs ,dir)
(flists ,flists)))))))))))
(defun mh-variant-nmh-info (dir)
"Return info for nmh variant in DIR assuming a temporary buffer is setup."
;; `mhparam -version' outputs:
;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003]
(let ((mhparam (expand-file-name "mhparam" dir)))
(when (and (file-exists-p mhparam) (file-executable-p mhparam))
(erase-buffer)
(call-process mhparam nil '(t nil) nil "-version")
(goto-char (point-min))
(when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t)
(let ((version (format "nmh %s" (match-string 1))))
(erase-buffer)
(call-process mhparam nil '(t nil) nil "libdir" "etcdir")
(goto-char (point-min))
(when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
(let ((libdir (match-string 1)))
(goto-char (point-min))
(when (search-forward-regexp
"^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
(let ((etcdir (match-string 1))
(flists (file-exists-p (expand-file-name "flists" dir))))
`(,version
(variant nmh)
(mh-lib-progs ,libdir)
(mh-lib ,etcdir)
(mh-progs ,dir)
(flists ,flists)))))))))))
(defun mh-variant-info (dir)
"Return MH variant found in DIR, or nil if none present."
(save-excursion
(let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
(set-buffer tmp-buffer)
(cond
((mh-variant-mh-info dir))
((mh-variant-nmh-info dir))
((mh-variant-mu-mh-info dir))))))
;;;###mh-autoload
(defun mh-variants ()
"Return a list of installed variants of MH on the system.
This function looks for MH in `mh-sys-path', `mh-path' and
`exec-path'. The format of the list of variants that is returned is described
by the variable `mh-variants'."
(if mh-variants
mh-variants
(let ((list-unique))
;; Make a unique list of directories, keeping the given order.
;; We don't want the same MH variant to be listed multiple times.
(loop for dir in (append mh-path mh-sys-path exec-path) do
(setq dir (file-chase-links (directory-file-name dir)))
(add-to-list 'list-unique dir))
(loop for dir in (nreverse list-unique) do
(when (and dir (file-directory-p dir) (file-readable-p dir))
(let ((variant (mh-variant-info dir)))
(if variant
(add-to-list 'mh-variants variant)))))
mh-variants)))
(provide 'mh-init)
;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c
;;; mh-init.el ends here

450
lisp/mh-e/mh-junk.el
View file

@ -1,6 +1,6 @@
;;; mh-junk.el --- Interface to anti-spam measures
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>,
;; Bill Wohler <wohler@newt.com>
@ -32,6 +32,8 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
;; Interactive functions callable from the folder buffer
@ -39,36 +41,33 @@
(defun mh-junk-blacklist (range)
"Blacklist RANGE as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command trains the spam program in use (see the `mh-junk-program' option)
with the content of the range (see `mh-interactive-range') and then handles
the message(s) as specified by the `mh-junk-disposition' option.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
refiled to that folder. If nil, the message is deleted.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended.
The documentation for the following functions describes what setup is needed
for the different spam fighting programs:
For more information about using your particular spam fighting program, see:
- `mh-spamassassin-blacklist'
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'"
- `mh-spamprobe-blacklist'"
(interactive (list (mh-interactive-range "Blacklist")))
(let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
(unless blacklist-func
(error "Customize `mh-junk-program' appropriately"))
(let ((dest (cond ((null mh-junk-mail-folder) nil)
((equal mh-junk-mail-folder "") "+")
((eq (aref mh-junk-mail-folder 0) ?+)
mh-junk-mail-folder)
((eq (aref mh-junk-mail-folder 0) ?@)
(let ((dest (cond ((null mh-junk-disposition) nil)
((equal mh-junk-disposition "") "+")
((eq (aref mh-junk-disposition 0) ?+)
mh-junk-disposition)
((eq (aref mh-junk-disposition 0) ?@)
(concat mh-current-folder "/"
(substring mh-junk-mail-folder 1)))
(t (concat "+" mh-junk-mail-folder)))))
(substring mh-junk-disposition 1)))
(t (concat "+" mh-junk-disposition)))))
(mh-iterate-on-range msg range
(message (format "Blacklisting message %d..." msg))
(funcall (symbol-function blacklist-func) msg)
(message (format "Blacklisting message %d...done" msg))
(if (not (memq msg mh-seen-list))
(setq mh-seen-list (cons msg mh-seen-list)))
(if dest
(mh-refile-a-msg nil (intern dest))
(mh-delete-a-msg nil)))
@ -76,231 +75,124 @@ for the different spam fighting programs:
;;;###mh-autoload
(defun mh-junk-whitelist (range)
"Whitelist RANGE incorrectly classified as spam.
"Whitelist RANGE as ham.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command reclassifies a range of messages (see `mh-interactive-range') as
ham if it were incorrectly classified as spam. It then refiles the message
into the `+inbox' folder.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then the message is refiled to `mh-inbox'.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended."
The `mh-junk-program' option specifies the spam program in use."
(interactive (list (mh-interactive-range "Whitelist")))
(let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
(unless whitelist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
(message (format "Whitelisting message %d..." msg))
(funcall (symbol-function whitelist-func) msg)
(message (format "Whitelisting message %d...done" msg))
(mh-refile-a-msg nil (intern mh-inbox)))
(mh-next-msg)))
;; Bogofilter Interface
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
(defun mh-bogofilter-blacklist (msg)
"Classify MSG as spam.
Tell bogofilter that the message is spam.
Bogofilter is a Bayesian spam filtering program. Get it from your local
distribution or from:
http://bogofilter.sourceforge.net/
You first need to teach bogofilter. This is done by running
bogofilter -n < good-message
on every good message, and
bogofilter -s < spam-message
on every spam message. Most Bayesian filters need 1000 to 5000 of each to
start doing a good job.
To use bogofilter, add the following .procmailrc recipes which you can also
find in the bogofilter man page:
# Bogofilter
:0fw
| bogofilter -u -e -p
:0
* ^X-Bogosity: Yes, tests=bogofilter
$SPAM
Bogofilter continues to feed the messages it classifies back into its
database. Occasionally it misses, and those messages need to be reclassified.
MH-E can do this for you. Use \\[mh-junk-blacklist] to reclassify messges in
your +inbox as spam, and \\[mh-junk-whitelist] to reclassify messages in your
spambox as good messages."
(unless mh-bogofilter-executable
(error "Couldn't find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file 0 nil "-Ns")))
(defun mh-bogofilter-whitelist (msg)
"Reinstate incorrectly filtered MSG.
Train bogofilter to think of the message as non-spam."
(unless mh-bogofilter-executable
(error "Couldn't find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file 0 nil "-Sn")))
;; Spamprobe Interface
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
(defun mh-spamprobe-blacklist (msg)
"Classify MSG as spam.
Tell spamprobe that the message is spam.
Spamprobe is a Bayesian spam filtering program. More info about the program can
be found at:
http://spamprobe.sourceforge.net
Here is a procmail recipe to stores incoming spam mail into the folder +spam
and good mail in /home/user/Mail/mdrop/mbox. This recipe is provided as an
example in the spamprobe man page.
PATH=/bin:/usr/bin:/usr/local/bin
DEFAULT=/home/user/Mail/mdrop/mbox
SPAM=/home/user/Mail/spam/.
# Spamprobe filtering
:0
SCORE=| spamprobe receive
:0 wf
| formail -I \"X-SpamProbe: $SCORE\"
:0 a:
*^X-SpamProbe: SPAM
$SPAM
Occasionally some good mail gets misclassified as spam. You can use
\\[mh-junk-whitelist] to reclassify that as good mail."
(unless mh-spamprobe-executable
(error "Couldn't find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file 0 nil "spam")))
(defun mh-spamprobe-whitelist (msg)
"Reinstate incorrectly filtered MSG.
Train spamprobe to think of the message as non-spam."
(unless mh-spamprobe-executable
(error "Couldn't find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file 0 nil "good")))
;; Spamassassin Interface
(defvar mh-spamassassin-executable (executable-find "spamassassin"))
(defvar mh-sa-learn-executable (executable-find "sa-learn"))
(defun mh-spamassassin-blacklist (msg)
"Blacklist MSG.
This is done by sending the message to Razor and by appending the sender to
~/.spamassassin/user_prefs in a blacklist_from rule. If sa-learn is available,
the message is also recategorized as spam.
"Blacklist MSG with SpamAssassin.
Spamassassin is an excellent spam filter. For more information, see:
http://spamassassin.org/.
SpamAssassin is one of the more popular spam filtering programs. Get it from
your local distribution or from http://spamassassin.org/.
I ran \"spamassassin -t\" on every mail message in my archive and ran an
analysis in Gnumeric to find that the standard deviation of good mail
scored under 5 (coincidentally, the spamassassin default for \"spam\").
To use SpamAssassin, add the following recipes to `.procmailrc':
Furthermore, I observed that there weren't any messages with a score of 8
or more that were interesting, so I added a couple of points to be
conservative and send any message with a score of 10 or more down the
drain. You might want to use a score of 12 or 13 to be really conservative.
I have found that this really decreases the amount of junk to review.
MAILDIR=$HOME/`mhparam Path`
Messages with a score of 5-9 are set aside for later review. The major
weakness of rules-based filters is a plethora of false positives\; I catch one
or two legitimate messages in here a week, so it is worthwhile to check.
# Fight spam with SpamAssassin.
:0fw
| spamc
You might choose to do this analysis yourself to pick a good score for
deleting spam sight unseen, or you might pick a score out of a hat, or you
might choose to be very conservative and not delete any messages at all.
# Anything with a spam level of 10 or more is junked immediately.
:0:
* ^X-Spam-Level: ..........
/dev/null
Based upon this discussion, here is what the associated ~/.procmailrc
entries look like. These rules appear before my list filters so that spam
sent to mailing lists gets pruned too.
:0:
* ^X-Spam-Status: Yes
spam/.
#
# Spam
#
:0fw
| spamc
If you don't use `spamc', use `spamassassin -P -a'.
# Anything with a spam level of 10 or more is junked immediately.
:0:
* ^X-Spam-Level: ..........
/dev/null
Note that one of the recipes above throws away messages with a score greater
than or equal to 10. Here's how you can determine a value that works best for
you.
:0
* ^X-Spam-Status: Yes
$SPAM
First, run `spamassassin -t' on every mail message in your archive and use
Gnumeric to verify that the average plus the standard deviation of good mail
is under 5, the SpamAssassin default for \"spam\".
If you don't use \"spamc\", use \"spamassassin -P -a\".
Using Gnumeric, sort the messages by score and view the messages with the
highest score. Determine the score which encompasses all of your interesting
messages and add a couple of points to be conservative. Add that many dots to
the `X-Spam-Level:' header field above to send messages with that score down
the drain.
A handful of spam does find its way into +inbox. In this case, use
\\[mh-junk-blacklist] to add a \"blacklist_from\" line to
~/spamassassin/user_prefs, delete the message, and send the message to the
Razor, so that others might not see this spam.
In the example above, messages with a score of 5-9 are set aside in the
`+spam' folder for later review. The major weakness of rules-based filters is
a plethora of false positives so it is worthwhile to check.
Over time, you see some patterns in the blacklisted addresses and can
replace several lines with wildcards. For example, it is clear that High
Speed Media is the biggest bunch of jerks on the Net. Here are some of the
entries I have for them, and the list continues to grow.
If SpamAssassin classifies a message incorrectly, or is unsure, you can use
the MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist].
blacklist_from *@*-hsm-*.com
blacklist_from *@*182*643*.com
blacklist_from *@*antarhsm*.com
blacklist_from *@*h*speed*
blacklist_from *@*hsm*182*.com
blacklist_from *@*hsm*643*.com
blacklist_from *@*hsmridi2983cslt227.com
blacklist_from *@*list*hsm*.com
blacklist_from *@h*s*media*
blacklist_from *@hsmdrct.com
blacklist_from *@hsmridi2983csltsite.com
The \\[mh-junk-blacklist] command adds a `blacklist_from' entry to
`~/spamassassin/user_prefs', deletes the message, and sends the message to the
Razor, so that others might not see this spam. If the `sa-learn' command is
available, the message is also recategorized as spam.
The function `mh-spamassassin-identify-spammers' is provided that shows the
frequency counts of the host and domain names in your blacklist_from
entries. This can be helpful when editing the blacklist_from entries.
The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the
`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the
message is also recategorized as ham.
In versions of spamassassin (2.50 and on) that support a Bayesian classifier,
\\[mh-junk-blacklist] uses the sa-learn program to recategorize the message as
spam. Neither MH-E, nor spamassassin, rebuilds the database after adding
words, so you will need to run \"sa-learn --rebuild\" periodically. This can
be done by adding the following to your crontab:
Over time, you'll observe that the same host or domain occurs repeatedly in
the `blacklist_from' entries, so you might think that you could avoid future
spam by blacklisting all mail from a particular domain. The utility function
`mh-spamassassin-identify-spammers' helps you do precisely that. This function
displays a frequency count of the hosts and domains in the `blacklist_from'
entries from the last blank line in `~/.spamassassin/user_prefs' to the end of
the file. This information can be used so that you can replace multiple
`blacklist_from' entries with a single wildcard entry such as:
0 * * * * sa-learn --rebuild > /dev/null 2>&1"
blacklist_from *@*amazingoffersdirect2u.com
In versions of SpamAssassin (2.50 and on) that support a Bayesian classifier,
\\[mh-junk-blacklist] uses the `sa-learn' program to recategorize the message
as spam. Neither MH-E, nor SpamAssassin, rebuilds the database after adding
words, so you will need to run `sa-learn --rebuild' periodically. This can be
done by adding the following to your crontab:
0 * * * * sa-learn --rebuild > /dev/null 2>&1"
(unless mh-spamassassin-executable
(error "Couldn't find the spamassassin executable"))
(error "Unable to find the spamassassin executable"))
(let ((current-folder mh-current-folder)
(msg-file (mh-msg-filename msg mh-current-folder))
(sender))
(save-excursion
(message "Giving this message the Razor...")
(message (format "Reporting message %d..." msg))
(mh-truncate-log-buffer)
(call-process mh-spamassassin-executable msg-file mh-log-buffer nil
"--report" "--remove-from-whitelist")
;;"--report" "--remove-from-whitelist"
"-r" "-R") ; spamassassin V2.20
(when mh-sa-learn-executable
(message "Recategorizing this message as spam...")
(call-process mh-sa-learn-executable msg-file mh-log-buffer nil
"--single" "--spam" "--local" "--no-rebuild"))
(message "Blacklisting address...")
(message (format "Blacklisting message %d..." msg))
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(call-process (expand-file-name mh-scan-prog mh-progs) nil t nil
(call-process (expand-file-name mh-scan-prog mh-progs) mh-junk-background
t nil
(format "%s" msg) current-folder
"-format" "%<(mymbox{from})%|%(addr{from})%>")
(goto-char (point-min))
@ -308,15 +200,19 @@ be done by adding the following to your crontab:
(progn
(setq sender (match-string 0))
(mh-spamassassin-add-rule "blacklist_from" sender)
(message "Blacklisting address...done"))
(message "Blacklisting address...not done (from my address)")))))
(message (format "Blacklisting message %d...done" msg)))
(message (format "Blacklisting message %d...not done (from my address)" msg))))))
(defun mh-spamassassin-whitelist (msg)
"Whitelist MSG.
Add a whitelist_from rule to the ~/.spamassassin/user_prefs file. If sa-learn
is available, then the message is recategorized as ham."
"Whitelist MSG with SpamAssassin.
The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the
`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the
message is also recategorized as ham.
See `mh-spamassassin-blacklist' for more information."
(unless mh-spamassassin-executable
(error "Couldn't find the spamassassin executable"))
(error "Unable to find the spamassassin executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder))
(show-buffer (get-buffer mh-show-buffer))
from)
@ -325,7 +221,8 @@ is available, then the message is recategorized as ham."
(erase-buffer)
(message "Removing spamassassin markup from message...")
(call-process mh-spamassassin-executable msg-file mh-temp-buffer nil
"--remove-markup")
;; "--remove-markup"
"-d") ; spamassassin V2.20
(if show-buffer
(kill-buffer show-buffer))
(write-file msg-file)
@ -333,15 +230,17 @@ is available, then the message is recategorized as ham."
(message "Recategorizing this message as ham...")
(call-process mh-sa-learn-executable msg-file mh-temp-buffer nil
"--single" "--ham" "--local --no-rebuild"))
(message "Whitelisting address...")
(setq from (car (ietf-drums-parse-address (mh-get-header-field "From:"))))
(message (format "Whitelisting message %d..." msg))
(setq from
(car (mh-funcall-if-exists
ietf-drums-parse-address (mh-get-header-field "From:"))))
(kill-buffer nil)
(unless (equal from "")
(unless (or (null from) (equal from ""))
(mh-spamassassin-add-rule "whitelist_from" from))
(message "Whitelisting address...done"))))
(message (format "Whitelisting message %d...done" msg)))))
(defun mh-spamassassin-add-rule (rule body)
"Add a new rule to ~/.spamassassin/user_prefs.
"Add a new rule to `~/.spamassassin/user_prefs'.
The name of the rule is RULE and its body is BODY."
(save-window-excursion
(let* ((line (format "%s\t%s\n" rule body))
@ -358,15 +257,15 @@ The name of the rule is RULE and its body is BODY."
(kill-buffer nil)))))
(defun mh-spamassassin-identify-spammers ()
"Identifies spammers who are repeat offenders.
"Identify spammers who are repeat offenders.
For each blacklist_from entry from the last blank line of
~/.spamassassin/user_prefs to the end of the file, a list of host and domain
names along with their frequency counts is displayed. This information can be
used to replace multiple blacklist_from entries with a single wildcard entry
such as:
This function displays a frequency count of the hosts and domains in the
`blacklist_from' entries from the last blank line in
`~/.spamassassin/user_prefs' to the end of the file. This information can be
used so that you can replace multiple `blacklist_from' entries with a single
wildcard entry such as:
blacklist_from *@*amazingoffersdirect2u.com"
blacklist_from *@*amazingoffersdirect2u.com"
(interactive)
(let* ((file (expand-file-name "~/.spamassassin/user_prefs"))
(domains (make-hash-table :test 'equal)))
@ -385,7 +284,7 @@ such as:
;; Add counts for each host and domain part.
(while host
(setq value (gethash (car host) domains))
(puthash (car host) (1+ (if (not value) 0 value)) domains)
(setf (gethash (car host) domains) (1+ (if (not value) 0 value)))
(setq host (cdr host))))))
;; Output
@ -400,6 +299,121 @@ such as:
(reverse-region (point-min) (point-max))
(goto-char (point-min))))
;; Bogofilter Interface
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
(defun mh-bogofilter-blacklist (msg)
"Blacklist MSG with Bogofilter.
Bogofilter is a Bayesian spam filtering program. Get it from your local
distribution or from http://bogofilter.sourceforge.net/.
Bogofilter is taught by running:
bogofilter -n < good-message
on every good message, and
bogofilter -s < spam-message
on every spam message. This is called a full training; three other
training methods are described in the FAQ that is distributed with bogofilter.
Note that most Bayesian filters need 1000 to 5000 of each type of message to
start doing a good job.
To use Bogofilter, add the following recipes to `.procmailrc':
MAILDIR=$HOME/`mhparam Path`
# Fight spam with Bogofilter.
:0fw
| bogofilter -3 -e -p
:0:
* ^X-Bogosity: Yes, tests=bogofilter
spam/.
:0:
* ^X-Bogosity: Unsure, tests=bogofilter
spam/unsure/.
If Bogofilter classifies a message incorrectly, or is unsure, you can use the
MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update
Bogofilter's training.
The \"Bogofilter FAQ\" suggests that you run the following
occasionally to shrink the database:
bogoutil -d wordlist.db | bogoutil -l wordlist.db.new
mv wordlist.db wordlist.db.prv
mv wordlist.db.new wordlist.db
The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file mh-junk-background
nil "-s")))
(defun mh-bogofilter-whitelist (msg)
"Whitelist MSG with Bogofilter.
See `mh-bogofilter-blacklist' for more information."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file mh-junk-background
nil "-n")))
;; Spamprobe Interface
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
(defun mh-spamprobe-blacklist (msg)
"Blacklist MSG with SpamProbe.
SpamProbe is a Bayesian spam filtering program. Get it from your local
distribution or from http://spamprobe.sourceforge.net.
To use SpamProbe, add the following recipes to `.procmailrc':
MAILDIR=$HOME/`mhparam Path`
# Fight spam with SpamProbe.
:0
SCORE=| spamprobe receive
:0 wf
| formail -I \"X-SpamProbe: $SCORE\"
:0:
*^X-SpamProbe: SPAM
spam/.
If SpamProbe classifies a message incorrectly, you can use the MH-E commands
\\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update SpamProbe's
training."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file mh-junk-background
nil "spam")))
(defun mh-spamprobe-whitelist (msg)
"Whitelist MSG with SpamProbe.
See `mh-spamprobe-blacklist' for more information."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file mh-junk-background
nil "good")))
(provide 'mh-junk)
;;; Local Variables:

515
lisp/mh-e/mh-loaddefs.el
View file

@ -11,22 +11,24 @@
;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft
;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-insert-auto-fields
;;;;;; mh-check-whom mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
;;;;;; (16625 53169))
;;;;;; mh-get-header-field mh-send-other-window mh-send mh-reply
;;;;;; mh-redistribute mh-forward mh-extract-rejected-mail mh-edit-again)
;;;;;; "mh-comp" "mh-comp.el" (16665 53716))
;;; 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)
See also `mh-send'." 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)
See also `mh-send'." t nil)
(autoload (quote mh-forward) "mh-comp" "\
Forward messages to the recipients TO and CC.
@ -36,7 +38,7 @@ Default is the displayed message.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
See also documentation for `\\[mh-send]' function." t nil)
See also `mh-send'." t nil)
(autoload (quote mh-redistribute) "mh-comp" "\
Redistribute displayed message to recipients TO and CC.
@ -55,11 +57,12 @@ to reply to:
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)
for the reply.
See also `mh-send'." 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.
@ -70,7 +73,6 @@ 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.
@ -80,6 +82,11 @@ 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-get-header-field) "mh-comp" "\
Find and return the body of FIELD in the mail header.
Returns the empty string if the field is not in the header of the
current buffer." nil 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
@ -96,9 +103,12 @@ 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.
Insert the signature specified by `mh-signature-file-name' or FILE at point.
A signature separator (`-- ') will be added if the signature block does not
contain one and `mh-signature-separator-flag' is on.
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)
called, with no arguments, after the signature is inserted.
The signature can also be inserted with `mh-identity-list'." t nil)
(autoload (quote mh-check-whom) "mh-comp" "\
Verify recipients of the current letter, showing expansion of any aliases." t nil)
@ -109,7 +119,9 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
something. If NON-INTERACTIVE is non-nil, do not be verbose and only
attempt matches if `mh-insert-auto-fields-done-local' is nil.
An `identity' entry is skipped if one was already entered manually." t nil)
An `identity' entry is skipped if one was already entered manually.
Return t if fields added; otherwise return nil." t nil)
(autoload (quote mh-send-letter) "mh-comp" "\
Send the draft letter in the current buffer.
@ -117,13 +129,12 @@ 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 mhn directives are present; otherwise
run `\\[mh-mml-to-mime]' if mml directives are present.
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)
run `\\[mh-mml-to-mime]' if mml directives are present." 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'.
Removes the header fields according to the variable
`mh-invisible-header-fields-compiled'.
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.
@ -166,44 +177,13 @@ In the message header, go to the next field. Elsewhere call
Cycle to the previous header field.
If we are at the first header field go to the start of the message body." t nil)
;;;***
;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el"
;;;;;; (16625 53481))
;;; Generated autoloads from mh-customize.el
(autoload (quote mh-customize) "mh-customize" "\
Customize MH-E variables.
With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame
are removed." t nil)
;;;***
;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
;;;;;; "mh-e" "mh-e.el" (16627 22341))
;;; 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-ephem-message mh-store-buffer
;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
;;;;;; mh-store-msg mh-undo-folder mh-sort-folder 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"
;;;;;; (16625 54011))
;;;;;; (16671 48788))
;;; Generated autoloads from mh-funcs.el
(autoload (quote mh-burst-digest) "mh-funcs" "\
@ -245,15 +225,6 @@ 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 RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
(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.
@ -261,8 +232,7 @@ 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)
Undo all pending deletes and refiles in current folder." t nil)
(autoload (quote mh-store-msg) "mh-funcs" "\
Store the file(s) contained in the current message into DIRECTORY.
@ -280,19 +250,24 @@ Default directory is the last directory used, or initially the value of
Display STRING in the minibuffer momentarily." nil nil)
(autoload (quote mh-help) "mh-funcs" "\
Display cheat sheet for the MH-Folder commands in minibuffer." t nil)
Display cheat sheet for the MH-E commands." 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" (16625 54171))
;;;### (autoloads (mh-identity-handler-bottom mh-identity-handler-top
;;;;;; mh-identity-insert-attribution-verb mh-identity-handler-attribution-verb
;;;;;; mh-identity-handler-signature mh-identity-handler-gpg-identity
;;;;;; mh-insert-identity mh-identity-list-set mh-identity-make-menu)
;;;;;; "mh-identity" "mh-identity.el" (16671 57010))
;;; 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)
Build the Identity menu.
This should be called any time `mh-identity-list' or `mh-auto-fields-list'
change." nil nil)
(autoload (quote mh-identity-list-set) "mh-identity" "\
Update the `mh-identity-list' variable, and rebuild the menu.
@ -304,10 +279,35 @@ customization). This is called after 'customize is used to alter
Insert proper fields for given IDENTITY.
Edit the `mh-identity-list' variable to define identity." t nil)
(autoload (quote mh-identity-handler-gpg-identity) "mh-identity" "\
For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add.
The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE
when action 'add is selected." nil nil)
(autoload (quote mh-identity-handler-signature) "mh-identity" "\
For FIELD \"signature\", process headers for ACTION 'remove or 'add.
The VALUE is added." nil nil)
(autoload (quote mh-identity-handler-attribution-verb) "mh-identity" "\
For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add.
The VALUE is added." nil nil)
(autoload (quote mh-identity-insert-attribution-verb) "mh-identity" "\
Insert VALUE as attribution verb, setting up delimiting markers.
If VALUE is nil, use `mh-extract-from-attribution-verb'." nil nil)
(autoload (quote mh-identity-handler-top) "mh-identity" "\
For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the top of the header." nil nil)
(autoload (quote mh-identity-handler-bottom) "mh-identity" "\
For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the bottom of the header." nil nil)
;;;***
;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16625
;;;;;; 54212))
;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16671
;;;;;; 48848))
;;; Generated autoloads from mh-inc.el
(autoload (quote mh-inc-spool-list-set) "mh-inc" "\
@ -319,14 +319,14 @@ This is called after 'customize is used to alter `mh-inc-spool-list'." nil nil)
;;;### (autoloads (mh-index-choose mh-namazu-execute-search mh-swish++-execute-search
;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages
;;;;;; mh-index-sequenced-messages mh-glimpse-execute-search mh-index-delete-from-sequence
;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-update-unseen
;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-group-by-folder
;;;;;; mh-index-sequenced-messages mh-index-delete-from-sequence
;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-visit-folder
;;;;;; mh-index-delete-folder-headers mh-index-group-by-folder mh-index-create-imenu-index
;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder
;;;;;; mh-index-parse-search-regexp mh-index-do-search mh-index-p
;;;;;; mh-index-read-data mh-index-search mh-index-create-sequences
;;;;;; mh-create-sequence-map mh-index-update-maps) "mh-index" "mh-index.el"
;;;;;; (16625 54348))
;;;;;; (16665 53754))
;;; Generated autoloads from mh-index.el
(autoload (quote mh-index-update-maps) "mh-index" "\
@ -367,7 +367,6 @@ index for each program:
- `mh-swish-execute-search'
- `mh-mairix-execute-search'
- `mh-namazu-execute-search'
- `mh-glimpse-execute-search'
If none of these programs are present then we use pick. If desired grep can be
used instead. Details about these methods can be found in:
@ -411,6 +410,9 @@ 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-create-imenu-index) "mh-index" "\
Create alist of folder names and positions in index folder buffers." nil nil)
(autoload (quote mh-index-group-by-folder) "mh-index" "\
Partition the messages based on source folder.
Returns an alist with the the folder names in the car and the cdr being the
@ -422,10 +424,6 @@ 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-update-unseen) "mh-index" "\
Remove counterpart of MSG in source folder from `mh-unseen-seq'.
Also `mh-update-unseen' is called in the original folder, if we have it open." nil 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
@ -442,62 +440,25 @@ Delete from SEQ the messages in MSGS.
This function updates the source folder sequences. Also makes an attempt to
update the source folder buffer if present." nil nil)
(autoload (quote mh-glimpse-execute-search) "mh-index" "\
Execute glimpse and read the results.
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-index-sequenced-messages) "mh-index" "\
Display messages from FOLDERS in SEQUENCE.
By default the folders specified by `mh-index-new-messages-folders' are
searched. With a prefix argument, enter a space-separated list of folders, or
nothing to search all folders.
Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
function searches for in each of the FOLDERS. With a prefix argument, enter a
sequence to use." t nil)
All messages in the sequence you provide from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of folders, or nothing to search all folders." t nil)
(autoload (quote mh-index-new-messages) "mh-index" "\
Display unseen messages.
All messages in the `unseen' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-new-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders." t nil)
If you use a program such as `procmail' to use `rcvstore' to file your
incoming mail automatically, you can display new, unseen, messages using this
command. All messages in the `unseen' sequence from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders." t nil)
(autoload (quote mh-index-ticked-messages) "mh-index" "\
Display ticked messages.
All messages in the `tick' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-ticked-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders." t nil)
All messages in `mh-tick-seq' from the folders in
`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders." t nil)
(autoload (quote mh-swish-execute-search) "mh-index" "\
Execute swish-e and read the results.
@ -618,56 +579,72 @@ The side-effects of this function are that the variables `mh-indexer',
set according to the first indexer in `mh-indexer-choices' present on the
system." nil nil)
;;;***
;;;### (autoloads (mh-variants mh-variant-p mh-variant-set) "mh-init"
;;;;;; "mh-init.el" (16684 6777))
;;; Generated autoloads from mh-init.el
(autoload (quote mh-variant-set) "mh-init" "\
Set the MH variant to VARIANT.
Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'.
If the VARIANT is `autodetect', then first try nmh, then MH and finally
GNU mailutils." t nil)
(autoload (quote mh-variant-p) "mh-init" "\
Return t if variant is any of VARIANTS.
Currently known variants are 'MH, 'nmh, and 'mu-mh." nil nil)
(autoload (quote mh-variants) "mh-init" "\
Return a list of installed variants of MH on the system.
This function looks for MH in `mh-sys-path', `mh-path' and
`exec-path'. The format of the list of variants that is returned is described
by the variable `mh-variants'." nil nil)
;;;***
;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk"
;;;;;; "mh-junk.el" (16625 54386))
;;;;;; "mh-junk.el" (16671 48929))
;;; Generated autoloads from mh-junk.el
(autoload (quote mh-junk-blacklist) "mh-junk" "\
Blacklist RANGE as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command trains the spam program in use (see the `mh-junk-program' option)
with the content of the range (see `mh-interactive-range') and then handles
the message(s) as specified by the `mh-junk-disposition' option.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
refiled to that folder. If nil, the message is deleted.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended.
The documentation for the following functions describes what setup is needed
for the different spam fighting programs:
For more information about using your particular spam fighting program, see:
- `mh-spamassassin-blacklist'
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'" t nil)
- `mh-spamprobe-blacklist'" t nil)
(autoload (quote mh-junk-whitelist) "mh-junk" "\
Whitelist RANGE incorrectly classified as spam.
Whitelist RANGE as ham.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command reclassifies a range of messages (see `mh-interactive-range') as
ham if it were incorrectly classified as spam. It then refiles the message
into the `+inbox' folder.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then the message is refiled to `mh-inbox'.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended." t nil)
The `mh-junk-program' option specifies the spam program in use." t nil)
;;;***
;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
;;;;;; mh-press-button mh-mime-display mh-decode-message-header
;;;;;; 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-directive-present-p mh-mml-secure-message-encrypt-pgpmime
;;;;;; mh-mml-secure-message-sign-pgpmime mh-mml-attach-file mh-mml-forward-message
;;;### (autoloads (mh-display-with-external-viewer mh-mime-inline-part
;;;;;; mh-mime-save-part mh-push-button mh-press-button mh-mime-display
;;;;;; mh-decode-message-header mh-toggle-mh-decode-mime-flag 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-directive-present-p
;;;;;; mh-mml-secure-message-signencrypt mh-mml-secure-message-encrypt
;;;;;; mh-mml-secure-message-sign mh-mml-unsecure-message mh-mml-attach-file
;;;;;; mh-mml-query-cryptographic-method mh-mml-forward-message
;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit
;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16625 54523))
;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-type
;;;;;; mh-mhn-compose-external-compressed-tar mh-mhn-compose-anon-ftp
;;;;;; mh-mhn-compose-insertion mh-file-mime-type mh-have-file-command
;;;;;; mh-compose-forward mh-compose-insertion) "mh-mime" "mh-mime.el"
;;;;;; (16684 7323))
;;; Generated autoloads from mh-mime.el
(autoload (quote mh-compose-insertion) "mh-mime" "\
@ -686,6 +663,14 @@ 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-have-file-command) "mh-mime" "\
Return t if 'file' command is on the system.
'file -i' is used to get MIME type of composition insertion." nil nil)
(autoload (quote mh-file-mime-type) "mh-mime" "\
Return MIME type of FILENAME from file command.
Returns nil if file command not on system." nil 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.
@ -718,6 +703,18 @@ DESCRIPTION, a line of text for the Content-description header.
See also \\[mh-edit-mhn]." t nil)
(autoload (quote mh-mhn-compose-external-type) "mh-mime" "\
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.
Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the
file and TYPE which is the MIME Content-Type. Optional arguments include
DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
EXTRA-PARAMS, and COMMENT.
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.
@ -758,7 +755,9 @@ 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-mhn-directive-present-p) "mh-mime" "\
Check if the current buffer has text which might be a MHN directive." nil nil)
Check if the text between BEGIN and END might be a MHN directive.
The optional argument BEGIN defaults to the beginning of the buffer, while END
defaults to the the end of the buffer." nil nil)
(autoload (quote mh-mml-to-mime) "mh-mime" "\
Compose MIME message from mml directives.
@ -770,6 +769,9 @@ 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-query-cryptographic-method) "mh-mime" "\
Read the cryptographic method to use." 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
@ -781,12 +783,18 @@ 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-unsecure-message) "mh-mime" "\
Remove any secure message directives.
The IGNORE argument is not used." 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-mml-secure-message-sign) "mh-mime" "\
Add security directive to sign the entire message using METHOD." t nil)
(autoload (quote mh-mml-secure-message-encrypt) "mh-mime" "\
Add security directive to encrypt the entire message using METHOD." t nil)
(autoload (quote mh-mml-secure-message-signencrypt) "mh-mime" "\
Add security directive to encrypt and sign the entire message using METHOD." t nil)
(autoload (quote mh-mml-directive-present-p) "mh-mime" "\
Check if the current buffer has text which may be an MML directive." nil nil)
@ -814,6 +822,9 @@ If ARG, prompt for directory, else use that specified by the variable
mh_profile directives, since this function calls on mhstore or mhn to do the
actual storing." t nil)
(autoload (quote mh-toggle-mh-decode-mime-flag) "mh-mime" "\
Toggle whether MH-E should decode MIME or not." t nil)
(autoload (quote mh-decode-message-header) "mh-mime" "\
Decode RFC2047 encoded message header fields." nil nil)
@ -840,10 +851,13 @@ Save MIME part at point." t nil)
(autoload (quote mh-mime-inline-part) "mh-mime" "\
Toggle display of the raw MIME part." t nil)
(autoload (quote mh-display-with-external-viewer) "mh-mime" "\
View MIME PART-INDEX externally." t nil)
;;;***
;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search
;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16625 54571))
;;;### (autoloads (mh-do-search mh-pick-do-search mh-search-folder)
;;;;;; "mh-pick" "mh-pick.el" (16671 49140))
;;; Generated autoloads from mh-pick.el
(autoload (quote mh-search-folder) "mh-pick" "\
@ -853,13 +867,6 @@ Add the messages found to the sequence named `search'.
Argument WINDOW-CONFIG is the current window configuration and is used when
the search folder is dismissed." t nil)
(autoload (quote mh-do-pick-search) "mh-pick" "\
Find messages that match the qualifications in the current pattern buffer.
Messages are searched for in the folder named in `mh-searching-folder'.
Add the messages found to the sequence named `search'.
This is a deprecated function and `mh-pick-do-search' should be used instead." t nil)
(autoload (quote mh-pick-do-search) "mh-pick" "\
Find messages that match the qualifications in the current pattern buffer.
Messages are searched for in the folder named in `mh-searching-folder'.
@ -871,6 +878,50 @@ If \\[mh-search-folder] was used to create the search pattern then pick is used
to search the folder. Otherwise if \\[mh-index-search] was used then the
indexing program specified in `mh-index-program' is used." t nil)
;;;***
;;;### (autoloads (mh-print-msg mh-ps-print-toggle-mime mh-ps-print-toggle-color
;;;;;; mh-ps-print-toggle-faces mh-ps-print-msg-show mh-ps-print-msg-file
;;;;;; mh-ps-print-msg) "mh-print" "mh-print.el" (16680 11171))
;;; Generated autoloads from mh-print.el
(autoload (quote mh-ps-print-msg) "mh-print" "\
Print the messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-ps-print-msg-file) "mh-print" "\
Print to FILE the messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-ps-print-msg-show) "mh-print" "\
Print current show buffer to FILE." t nil)
(autoload (quote mh-ps-print-toggle-faces) "mh-print" "\
Toggle whether printing is done with faces or not." t nil)
(autoload (quote mh-ps-print-toggle-color) "mh-print" "\
Toggle whether color is used in printing messages." t nil)
(autoload (quote mh-ps-print-toggle-mime) "mh-print" "\
Cycle through available choices on how MIME parts should be printed.
The available settings are:
1. Print only inline MIME parts.
2. Print all MIME parts.
3. Print no MIME parts." t nil)
(autoload (quote mh-print-msg) "mh-print" "\
Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
;;;***
;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-thread-refile
@ -879,13 +930,12 @@ indexing program specified in `mh-index-program' is used." t nil)
;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc
;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range
;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject
;;;;;; mh-region-to-msg-list mh-interactive-range mh-range-to-msg-list
;;;;;; mh-iterate-on-range mh-iterate-on-messages-in-region mh-add-to-sequence
;;;;;; mh-notate-cur mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
;;;;;; mh-translate-range mh-read-range mh-read-seq-default mh-notate-deleted-and-refiled
;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (16625
;;;;;; 54690))
;;;;;; mh-interactive-range mh-range-to-msg-list mh-iterate-on-range
;;;;;; mh-iterate-on-messages-in-region mh-add-to-sequence mh-notate-cur
;;;;;; mh-rename-seq mh-translate-range mh-read-range mh-read-seq-default
;;;;;; mh-notate-deleted-and-refiled mh-widen mh-put-msg-in-seq
;;;;;; mh-narrow-to-seq mh-msg-is-in-seq mh-list-sequences mh-delete-seq)
;;;;;; "mh-seq" "mh-seq.el" (16671 65286))
;;; Generated autoloads from mh-seq.el
(autoload (quote mh-delete-seq) "mh-seq" "\
@ -895,8 +945,9 @@ Delete the SEQUENCE." t nil)
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 is the displayed message." t nil)
Display the sequences in which the current message appears.
Use a prefix argument to display the sequences in which another MESSAGE
appears." t nil)
(autoload (quote mh-narrow-to-seq) "mh-seq" "\
Restrict display of this folder to just messages in SEQUENCE.
@ -909,10 +960,8 @@ Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-widen) "mh-seq" "\
Remove last restriction from current folder.
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
of the view stack thereby showing all messages that the buffer originally
contained." t nil)
Restore the previous limit.
If optional prefix argument ALL-FLAG is non-nil, remove all limits." t nil)
(autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\
Notate messages marked for deletion or refiling.
@ -965,16 +1014,6 @@ In FOLDER, translate the string EXPR to a list of messages numbers." nil nil)
(autoload (quote mh-rename-seq) "mh-seq" "\
Rename SEQUENCE to have NEW-NAME." t nil)
(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-notate-cur) "mh-seq" "\
Mark the MH sequence cur.
In addition to notating the current message with `mh-note-cur' the function
@ -1019,37 +1058,44 @@ RANGE-PROMPT. A list of messages in that range is returned.
If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.
If DEFAULT non-nil then it is returned.
Otherwise, the message number at point is returned.
This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions." nil nil)
(autoload (quote mh-region-to-msg-list) "mh-seq" "\
Return a list of messages within the region between BEGIN and END." nil nil)
(autoload (quote mh-narrow-to-subject) "mh-seq" "\
Narrow to a sequence containing all following messages with same subject." t nil)
Limit to messages with same subject.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-from) "mh-seq" "\
Limit to messages with the same From header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
Limit to messages with the same `From:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-cc) "mh-seq" "\
Limit to messages with the same Cc header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
Limit to messages with the same `Cc:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-to) "mh-seq" "\
Limit to messages with the same To header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
Limit to messages with the same `To:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-range) "mh-seq" "\
Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
interactive use.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-delete-subject) "mh-seq" "\
Mark all following messages with same subject to be deleted.
@ -1103,14 +1149,15 @@ Mark current message and all its children for refiling to FOLDER." t nil)
Toggle tick mark of all messages in RANGE." t nil)
(autoload (quote mh-narrow-to-tick) "mh-seq" "\
Restrict display of this folder to just messages in `mh-tick-seq'.
Limit to messages in `mh-tick-seq'.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." 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" (16625 54721))
;;;;;; "mh-speed" "mh-speed.el" (16665 53793))
;;; Generated autoloads from mh-speed.el
(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
@ -1143,33 +1190,26 @@ Remove FOLDER from various optimization caches." t nil)
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" (16625 54979))
;;; 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-apropos mh-alias-add-address-under-point
;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-from-has-no-alias-p
;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-for-from-p
;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address
;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias"
;;;;;; "mh-alias.el" (16625 53006))
;;;;;; "mh-alias.el" (16671 49382))
;;; Generated autoloads from mh-alias.el
(autoload (quote mh-alias-reload) "mh-alias" "\
Load MH aliases into `mh-alias-alist'." t nil)
Reload MH aliases.
Since aliases are updated frequently, MH-E will reload aliases automatically
whenever an alias lookup occurs if an alias source (a file listed in your
`Aliasfile:' profile component and your password file if variable
`mh-alias-local-users' is non-nil) has changed. However, you can reload your
aliases manually by calling this command directly.
The value of `mh-alias-reloaded-hook' is a list of functions to be called,
with no arguments, after the aliases have been loaded." t nil)
(autoload (quote mh-alias-reload-maybe) "mh-alias" "\
Load new MH aliases." nil nil)
@ -1186,26 +1226,25 @@ Expand mail alias before point." nil nil)
(autoload (quote mh-alias-address-to-alias) "mh-alias" "\
Return the ADDRESS alias if defined, or nil." nil nil)
(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
Return t is From has no current alias set.
In the exceptional situation where there isn't a From header in the message the
function returns nil." nil nil)
(autoload (quote mh-alias-for-from-p) "mh-alias" "\
Return t if sender's address has a corresponding alias." 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)
This function prompts you for an alias and address. If the alias exists
already, you will have the choice of inserting the new alias before or after
the old alias. In the former case, this alias will be used when sending mail
to this alias. In the latter case, the alias serves as an additional folder
name hint when filing messages." 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)
*Add alias for the sender of the current message." t nil)
(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
Insert an alias for email address under point." t nil)
Insert an alias for address under point." t nil)
(autoload (quote mh-alias-apropos) "mh-alias" "\
Show all aliases that match REGEXP either in name or content." t nil)
Show all aliases or addresses that match REGEXP." t nil)
;;;***

298
lisp/mh-e/mh-mime.el
View file

@ -34,7 +34,7 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-comp)
(require 'gnus-util)
@ -46,8 +46,7 @@
(autoload 'gnus-eval-format "gnus-spec")
(autoload 'widget-convert-button "wid-edit")
(autoload 'message-options-set-recipient "message")
(autoload 'mml-secure-message-sign-pgpmime "mml-sec")
(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")
(autoload 'mml-unsecure-message "mml-sec")
(autoload 'mml-minibuffer-read-file "mml")
(autoload 'mml-minibuffer-read-description "mml")
(autoload 'mml-insert-empty-tag "mml")
@ -82,7 +81,7 @@ If any of the optional arguments are absent, they are prompted for."
(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
(if (numberp mh-sent-from-msg)
(format " [%d]" mh-sent-from-msg)
"")))))
(if (equal mh-compose-insertion 'gnus)
@ -114,6 +113,7 @@ MH profile.")
;; the variable, so things should work exactly as before.
(defvar mh-have-file-command)
;;;###mh-autoload
(defun mh-have-file-command ()
"Return t if 'file' command is on the system.
'file -i' is used to get MIME type of composition insertion."
@ -129,7 +129,8 @@ MH profile.")
(defvar mh-file-mime-type-substitutions
'(("application/msword" "\.xls" "application/ms-excel")
("application/msword" "\.ppt" "application/ms-powerpoint"))
("application/msword" "\.ppt" "application/ms-powerpoint")
("text/plain" "\.vcf" "text/x-vcard"))
"Substitutions to make for Content-Type returned from file command.
The first element is the Content-Type returned by the file command.
The second element is a regexp matching the file name, usually the extension.
@ -151,6 +152,7 @@ Substitutions are made from the `mh-file-mime-type-substitutions' variable."
(setq subst (cdr subst))))
answer))
;;;###mh-autoload
(defun mh-file-mime-type (filename)
"Return MIME type of FILENAME from file command.
Returns nil if file command not on system."
@ -192,12 +194,38 @@ Returns nil if file command not on system."
("message/external-body") ("message/partial") ("message/rfc822")
("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
("text/richtext") ("text/xml")
("text/richtext") ("text/x-vcard") ("text/xml")
("video/mpeg") ("video/quicktime"))
"Legal MIME content types.
See documentation for \\[mh-edit-mhn].")
;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One:
;; Format of Internet Message Bodies.
;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two:
;; Media Types.
;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five:
;; Conformance Criteria and Examples.
;; RFC 2017 - Definition of the URL MIME External-Body Access-Type
;; RFC 1738 - Uniform Resource Locators (URL)
(defvar mh-access-types
'(("anon-ftp") ; RFC2046 Anonymous File Transfer Protocol
("file") ; RFC1738 Host-specific file names
("ftp") ; RFC2046 File Transfer Protocol
("gopher") ; RFC1738 The Gopher Protocol
("http") ; RFC1738 Hypertext Transfer Protocol
("local-file") ; RFC2046 Local file access
("mail-server") ; RFC2046 mail-server Electronic mail address
("mailto") ; RFC1738 Electronic mail address
("news") ; RFC1738 Usenet news
("nntp") ; RFC1738 Usenet news using NNTP access
("propspero") ; RFC1738 Prospero Directory Service
("telnet") ; RFC1738 Telnet
("tftp") ; RFC2046 Trivial File Transfer Protocol
("url") ; RFC2017 URL scheme MIME access-type Protocol
("wais")) ; RFC1738 Wide Area Information Servers
"Legal MIME access-type values.")
;;;###mh-autoload
(defun mh-mhn-compose-insertion (filename type description attributes)
"Add a directive to insert a MIME message part from a file.
@ -286,7 +314,7 @@ See also \\[mh-edit-mhn]."
"type=tar; conversions=x-compress"
"mode=image"))
;;;###mh-autoload
(defun mh-mhn-compose-external-type (access-type host filename type
&optional description
attributes extra-params
@ -301,6 +329,18 @@ DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
EXTRA-PARAMS, and COMMENT.
See also \\[mh-edit-mhn]."
(interactive (list
(completing-read "Access Type: " mh-access-types)
(read-string "Remote host: ")
(read-string "Remote url-path: ")
(completing-read "Content-Type: "
(if (fboundp 'mailcap-mime-types)
(mapcar 'list (mailcap-mime-types))
mh-mime-content-types))
(if current-prefix-arg (read-string "Content-description: "))
(if current-prefix-arg (read-string "Attributes: "))
(if current-prefix-arg (read-string "Extra Parameters: "))
(if current-prefix-arg (read-string "Comment: "))))
(beginning-of-line)
(insert "#@" type)
(and attributes
@ -314,7 +354,9 @@ See also \\[mh-edit-mhn]."
(insert "access-type=" access-type "; ")
(insert "site=" host)
(insert "; name=" (file-name-nondirectory filename))
(insert "; directory=\"" (file-name-directory filename) "\"")
(let ((directory (file-name-directory filename)))
(and directory
(insert "; directory=\"" directory "\"")))
(and extra-params
(insert "; " extra-params))
(insert "\n"))
@ -332,7 +374,7 @@ See also \\[mh-edit-mhn]."
(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
(if (numberp mh-sent-from-msg)
(format " [%d]" mh-sent-from-msg)
"")))))
(beginning-of-line)
@ -349,7 +391,7 @@ See also \\[mh-edit-mhn]."
(let ((start (point)))
(insert " " messages)
(subst-char-in-region start (point) ?, ? ))
(if mh-sent-from-msg
(if (numberp mh-sent-from-msg)
(insert " " (int-to-string mh-sent-from-msg))))
(insert "\n"))
@ -380,10 +422,11 @@ arguments, after performing the conversion.
The mhn program is part of MH version 6.8 or later."
(interactive "*P")
(mh-mhn-quote-unescaped-sharp)
(save-buffer)
(message "mhn editing...")
(cond
(mh-nmh-flag
((mh-variant-p 'nmh)
(mh-exec-cmd-error nil
"mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
(t
@ -393,6 +436,19 @@ The mhn program is part of MH version 6.8 or later."
(message "mhn editing...done")
(run-hooks 'mh-edit-mhn-hook))
(defun mh-mhn-quote-unescaped-sharp ()
"Quote `#' characters that haven't been quoted for `mhbuild'.
If the `#' character is present in the first column, but it isn't part of a
MHN directive then `mhbuild' gives an error. This function will quote all such
characters."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^#" nil t)
(beginning-of-line)
(unless (mh-mhn-directive-present-p (point) (line-end-position))
(insert "#"))
(goto-char (line-end-position)))))
;;;###mh-autoload
(defun mh-revert-mhn-edit (noconfirm)
"Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
@ -422,18 +478,24 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
(after-find-file nil)))
;;;###mh-autoload
(defun mh-mhn-directive-present-p ()
"Check if the current buffer has text which might be a MHN directive."
(defun mh-mhn-directive-present-p (&optional begin end)
"Check if the text between BEGIN and END might be a MHN directive.
The optional argument BEGIN defaults to the beginning of the buffer, while END
defaults to the the end of the buffer."
(unless begin (setq begin (point-min)))
(unless end (setq end (point-max)))
(save-excursion
(block 'search-for-mhn-directive
(goto-char (point-min))
(while (re-search-forward "^#" nil t)
(goto-char begin)
(while (re-search-forward "^#" end t)
(let ((s (buffer-substring-no-properties (point) (line-end-position))))
(cond ((equal s ""))
((string-match "^forw[ \t\n]+" s)
(return-from 'search-for-mhn-directive t))
(t (let ((first-token (car (split-string s "[ \t;@]"))))
(when (string-match mh-media-type-regexp first-token)
(when (and first-token
(string-match mh-media-type-regexp
first-token))
(return-from 'search-for-mhn-directive t)))))))
nil)))
@ -450,14 +512,23 @@ function may be called manually before sending the draft as well."
(require 'message)
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP
(message-options-set-recipient))
(mml-to-mime))
(let ((saved-text (buffer-string))
(buffer (current-buffer))
(modified-flag (buffer-modified-p)))
(condition-case err (mml-to-mime)
(error
(with-current-buffer buffer
(delete-region (point-min) (point-max))
(insert saved-text)
(set-buffer-modified-p modified-flag))
(error (error-message-string err))))))
;;;###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
number."
(let ((msg (if (equal message "")
(let ((msg (if (and (equal message "") (numberp mh-sent-from-msg))
mh-sent-from-msg
(car (read-from-string message)))))
(cond ((integerp msg)
@ -473,6 +544,19 @@ number."
description)))
(t (error "The message number, %s is not a integer!" msg)))))
(defvar mh-mml-cryptographic-method-history ())
;;;###mh-autoload
(defun mh-mml-query-cryptographic-method ()
"Read the cryptographic method to use."
(if current-prefix-arg
(let ((def (or (car mh-mml-cryptographic-method-history)
mh-mml-method-default)))
(completing-read (format "Method: [%s] " def)
'(("pgp") ("pgpmime") ("smime"))
nil t nil 'mh-mml-cryptographic-method-history def))
mh-mml-method-default))
;;;###mh-autoload
(defun mh-mml-attach-file (&optional disposition)
"Attach a file to the outgoing MIME message.
@ -499,22 +583,58 @@ automatically."
(mml-insert-empty-tag 'part 'type type 'filename file
'disposition dispos 'description description)))
;;;###mh-autoload
(defun mh-mml-secure-message-sign-pgpmime ()
"Add directive to encrypt/sign the entire message."
(interactive)
(defvar mh-identity-pgg-default-user-id)
(defun mh-secure-message (method mode &optional identity)
"Add directive to Encrypt/Sign an entire message.
METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\".
IDENTITY is optionally the default-user-id to use."
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
(mml-secure-message-sign-pgpmime)))
;; Check the arguments
(let ((valid-methods (list "pgpmime" "pgp" "smime"))
(valid-modes (list "sign" "encrypt" "signencrypt" "none")))
(if (not (member method valid-methods))
(error (format "Sorry. METHOD \"%s\" is invalid." method)))
(if (not (member mode valid-modes))
(error (format "Sorry. MODE \"%s\" is invalid" mode)))
(mml-unsecure-message)
(if (not (string= mode "none"))
(save-excursion
(goto-char (point-min))
(mh-goto-header-end 1)
(if mh-identity-pgg-default-user-id
(mml-insert-tag 'secure 'method method 'mode mode
'sender mh-identity-pgg-default-user-id)
(mml-insert-tag 'secure 'method method 'mode mode)))))))
;;;###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)."
(defun mh-mml-unsecure-message (&optional ignore)
"Remove any secure message directives.
The IGNORE argument is not used."
(interactive "P")
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
(mml-secure-message-encrypt-pgpmime dontsign)))
(mml-unsecure-message)))
;;;###mh-autoload
(defun mh-mml-secure-message-sign (method)
"Add security directive to sign the entire message using METHOD."
(interactive (list (mh-mml-query-cryptographic-method)))
(mh-secure-message method "sign" mh-identity-pgg-default-user-id))
;;;###mh-autoload
(defun mh-mml-secure-message-encrypt (method)
"Add security directive to encrypt the entire message using METHOD."
(interactive (list (mh-mml-query-cryptographic-method)))
(mh-secure-message method "encrypt" mh-identity-pgg-default-user-id))
;;;###mh-autoload
(defun mh-mml-secure-message-signencrypt (method)
"Add security directive to encrypt and sign the entire message using METHOD."
(interactive (list (mh-mml-query-cryptographic-method)))
(mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id))
;;;###mh-autoload
(defun mh-mml-directive-present-p ()
@ -667,19 +787,19 @@ actual storing."
(folder (if (eq major-mode 'mh-show-mode)
mh-show-folder-buffer
mh-current-folder))
(command (if mh-nmh-flag "mhstore" "mhn"))
(command (if (mh-variant-p 'nmh) "mhstore" "mhn"))
(directory
(cond
((and (or arg
(equal nil mh-mime-save-parts-default-directory)
(equal t mh-mime-save-parts-default-directory))
(not mh-mime-save-parts-directory))
(read-file-name "Store in what directory? " nil nil t nil))
(read-file-name "Store in directory: " nil nil t nil))
((and (or arg
(equal t mh-mime-save-parts-default-directory))
mh-mime-save-parts-directory)
(read-file-name (format
"Store in what directory? [%s] "
"Store in directory: [%s] "
mh-mime-save-parts-directory)
"" mh-mime-save-parts-directory t ""))
((stringp mh-mime-save-parts-default-directory)
@ -689,7 +809,7 @@ actual storing."
(if (and (equal directory "") mh-mime-save-parts-directory)
(setq directory mh-mime-save-parts-directory))
(if (not (file-directory-p directory))
(message "No directory specified.")
(message "No directory specified")
(if (equal nil mh-mime-save-parts-default-directory)
(setq mh-mime-save-parts-directory directory))
(save-excursion
@ -731,6 +851,14 @@ If message has been encoded for transfer take that into account."
(gnus-strip-whitespace cte))))
(car ct))))))
;;;###mh-autoload
(defun mh-toggle-mh-decode-mime-flag ()
"Toggle whether MH-E should decode MIME or not."
(interactive)
(setq mh-decode-mime-flag (not mh-decode-mime-flag))
(mh-show nil t)
(message (format "(setq mh-decode-mime-flag %s)" mh-decode-mime-flag)))
;;;###mh-autoload
(defun mh-decode-message-header ()
"Decode RFC2047 encoded message header fields."
@ -766,17 +894,18 @@ displayed."
(mh-mime-handles (mh-buffer-data))))
(unless handles (mh-decode-message-body)))
(when (and handles
(or (not (stringp (car handles))) (cdr handles)))
;; Goto start of message body
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (goto-char (point-max)))
(cond ((and handles
(or (not (stringp (car handles))) (cdr handles)))
;; Goto start of message body
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (goto-char (point-max)))
;; Delete the body
(delete-region (point) (point-max))
;; Delete the body
(delete-region (point) (point-max))
;; Display the MIME handles
(mh-mime-display-part handles)))
;; Display the MIME handles
(mh-mime-display-part handles))
(t (mh-signature-highlight))))
(error
(message "Please report this error. The error message is:\n %s"
(error-message-string err))
@ -874,7 +1003,7 @@ This is only useful if a Content-Disposition header is not present."
(save-restriction
(widen)
(goto-char (point-min))
(not (re-search-forward "^-- $" nil t)))))))
(not (mh-signature-separator-p)))))))
(defun mh-mime-display-single (handle)
"Display a leaf node, HANDLE in the MIME tree."
@ -904,7 +1033,8 @@ This is only useful if a Content-Disposition header is not present."
(insert "\n")
(mh-insert-mime-button handle (mh-mime-part-index handle) nil))
((and displayp (not mh-display-buttons-for-inline-parts-flag))
(or (mm-display-part handle) (mm-display-part handle)))
(or (mm-display-part handle) (mm-display-part handle))
(mh-signature-highlight handle))
((and displayp mh-display-buttons-for-inline-parts-flag)
(insert "\n")
(mh-insert-mime-button handle (mh-mime-part-index handle) nil)
@ -912,6 +1042,28 @@ This is only useful if a Content-Disposition header is not present."
(mh-mm-display-part handle)))
(goto-char (point-max)))))
(defun mh-signature-highlight (&optional handle)
"Highlight message signature in HANDLE.
The optional argument, HANDLE is a MIME handle if the function is being used
to highlight the signature in a MIME part."
(let ((regexp
(cond ((not handle) "^-- $")
((not (and (equal (mm-handle-media-supertype handle) "text")
(equal (mm-handle-media-subtype handle) "html")))
"^-- $")
((eq (mh-mm-text-html-renderer) 'lynx) "^ --$")
(t "^--$"))))
(save-excursion
(goto-char (point-max))
(when (re-search-backward regexp nil t)
(mh-do-in-gnu-emacs
(let ((ov (make-overlay (point) (point-max))))
(overlay-put ov 'face 'mh-show-signature-face)
(overlay-put ov 'evaporate t)))
(mh-do-in-xemacs
(set-extent-property (make-extent (point) (point-max))
'face 'mh-show-signature-face))))))
(mh-do-in-xemacs
(defvar dots)
(defvar type))
@ -954,7 +1106,9 @@ like \"K v\" which operate on individual MIME parts."
:action 'mh-widget-press-button
:button-keymap mh-mime-button-map
:help-echo
"Mouse-2 click or press RET (in show buffer) to toggle display")))
"Mouse-2 click or press RET (in show buffer) to toggle display")
(dolist (ov (mh-funcall-if-exists overlays-in begin end))
(mh-funcall-if-exists overlay-put ov 'evaporate t))))
;; There is a bug in Gnus inline image display due to which an extra line
;; gets inserted every time it is viewed. To work around that problem we are
@ -1009,7 +1163,8 @@ like \"K v\" which operate on individual MIME parts."
(when (eq mh-highlight-citation-p 'gnus)
(mh-gnus-article-highlight-citation))
(mh-display-smileys)
(mh-display-emphasis))
(mh-display-emphasis)
(mh-signature-highlight handle))
(setq region (cons (progn (goto-char (point-min))
(point-marker))
(progn (goto-char (point-max))
@ -1098,6 +1253,31 @@ button."
(goto-char point)
(set-buffer-modified-p nil)))
;;;###mh-autoload
(defun mh-display-with-external-viewer (part-index)
"View MIME PART-INDEX externally."
(interactive "P")
(when (consp part-index) (setq part-index (car part-index)))
(mh-folder-mime-action
part-index
#'(lambda ()
(let* ((part (get-text-property (point) 'mh-data))
(type (mm-handle-media-type part))
(methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
(mailcap-mime-info type 'all)))
(def (caar methods))
(prompt (format "Viewer: %s" (if def (format "[%s] " def) "")))
(method (completing-read prompt methods nil nil nil nil def))
(folder mh-show-folder-buffer)
(buffer-read-only nil))
(when (string-match "^[^% \t]+$" method)
(setq method (concat method " %s")))
(flet ((mm-handle-set-external-undisplayer (handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(unwind-protect (mm-display-external part method)
(set-buffer-modified-p nil)))))
nil))
(defun mh-widget-press-button (widget el)
"Callback for widget, WIDGET.
Parameter EL is unused."
@ -1106,9 +1286,9 @@ Parameter EL is unused."
(defun mh-mime-display-security (handle)
"Display PGP encrypted/signed message, HANDLE."
(insert "\n")
(save-restriction
(narrow-to-region (point) (point))
(insert "\n")
(mh-insert-mime-security-button handle)
(mh-mime-display-mixed (cdr handle))
(insert "\n")
@ -1116,9 +1296,7 @@ Parameter EL is unused."
mh-mime-security-button-end-line-format))
(mh-insert-mime-security-button handle))
(mm-set-handle-multipart-parameter
handle 'mh-region
(cons (set-marker (make-marker) (point-min))
(set-marker (make-marker) (point-max))))))
handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
;;; I rewrote the security part because Gnus doesn't seem to ever minimize
;;; the button. That is once the mime-security button is pressed there seems
@ -1149,8 +1327,22 @@ Parameter EL is unused."
(defun mh-mime-security-press-button (handle)
"Callback from security button for part HANDLE."
(when (mm-handle-multipart-ctl-parameter handle 'gnus-info)
(mh-mime-security-show-details handle)))
(if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
(mh-mime-security-show-details handle)
(let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
point)
(setq point (point))
(goto-char (car region))
(delete-region (car region) (cdr region))
(with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
(let* ((mm-verify-option 'known)
(mm-decrypt-option 'known)
(new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
(unless (eq new (cdr handle))
(mm-destroy-parts (cdr handle))
(setcdr handle new))))
(mh-mime-display-security handle)
(goto-char point))))
;; These variables should already be initialized in mm-decode.el if we have a
;; recent enough Gnus. The defvars are here to avoid compiler warnings.
@ -1191,6 +1383,8 @@ Parameter EL is unused."
:action 'mh-widget-press-button
:button-keymap mh-mime-security-button-map
:help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
(dolist (ov (mh-funcall-if-exists overlays-in begin end))
(mh-funcall-if-exists overlay-put ov 'evaporate t))
(when (equal info "Failed")
(let* ((type (if (equal (car handle) "multipart/signed")
"verification" "decryption"))
@ -1204,8 +1398,8 @@ The function decodes the message and displays it. It avoids decoding the same
message multiple times."
(let ((b (point))
(clean-message-header mh-clean-message-header-flag)
(invisible-headers mh-invisible-headers)
(visible-headers mh-visible-headers))
(invisible-headers mh-invisible-header-fields-compiled)
(visible-headers nil))
(save-excursion
(save-restriction
(narrow-to-region b b)

39
lisp/mh-e/mh-pick.el
View file

@ -1,6 +1,6 @@
;;; mh-pick.el --- make a search pattern and search for a message in MH-E
;; Copyright (C) 1993, 1995, 2001, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 2003, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -32,6 +32,8 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'easymenu)
(require 'gnus-util)
@ -44,6 +46,9 @@
(defvar mh-searching-folder nil) ;Folder this pick is searching.
(defvar mh-searching-function nil)
(defconst mh-pick-single-dash '(cc date from subject to)
"Search components that are supported by single-dash option in pick.")
;;;###mh-autoload
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
@ -138,16 +143,6 @@ 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'.
This is a deprecated function and `mh-pick-do-search' should be used instead."
(interactive)
(mh-pick-do-search))
;;;###mh-autoload
(defun mh-pick-do-search ()
"Find messages that match the qualifications in the current pattern buffer.
@ -260,6 +255,13 @@ COMPONENT is the component to search."
"-rbrace"))
(t (error "Unknown operator '%s' seen" (car expr)))))
;; All implementations of pick have special options -cc, -date, -from and
;; -subject that allow to search for corresponding components. Any other
;; component is searched using option --COMPNAME, for example: `pick
;; --x-mailer mh-e'. Mailutils `pick' supports this option using a certain
;; kludge, but it prefers the following syntax for this purpose:
;; `--component=COMPNAME --pattern=PATTERN'.
;; -- Sergey Poznyakoff, Aug 2003
(defun mh-pick-regexp-builder (pattern-list)
"Generate pick search expression from PATTERN-LIST."
(let ((result ()))
@ -267,9 +269,18 @@ COMPONENT is the component to search."
(when (cdr pattern)
(setq result `(,@result "-and" "-lbrace"
,@(mh-pick-construct-regexp
(cdr pattern) (if (car pattern)
(format "-%s" (car pattern))
"-search"))
(if (and (mh-variant-p 'mu-mh) (car pattern))
(format "--pattern=%s" (cdr pattern))
(cdr pattern))
(if (car pattern)
(cond
((mh-variant-p 'mu-mh)
(format "--component=%s" (car pattern)))
((member (car pattern) mh-pick-single-dash)
(format "-%s" (car pattern)))
(t
(format "--%s" (car pattern))))
"-search"))
"-rbrace"))))
(cdr result)))

279
lisp/mh-e/mh-print.el Normal file
View file

@ -0,0 +1,279 @@
;;; mh-print.el --- MH-E printing support
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Jeffrey C Honig <jch@honig.net>
;; 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:
;; Pp Print to lpr | Default inline settings
;; Pf Print to file | Generate a postscript file
;; Ps Print show buffer | Fails if no show buffer
;;
;; PA Toggle inline/attachments
;; PC Toggle color
;; PF Toggle faces
;;; Change Log:
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'ps-print)
(require 'mh-utils)
(require 'mh-funcs)
(eval-when-compile (require 'mh-seq))
(defvar mh-ps-print-mime nil
"Control printing of MIME parts.
The three possible states are:
1. nil to not print inline parts
2. t to print inline parts
3. non-zero to print inline parts and attachments")
(defvar mh-ps-print-color-option ps-print-color-p
"MH-E's version of `\\[ps-print-color-p]'.")
(defvar mh-ps-print-func 'ps-spool-buffer-with-faces
"Function to use to spool a buffer.
Sensible choices are the functions `ps-spool-buffer' and
`ps-spool-buffer-with-faces'.")
;; XXX - If buffer is already being displayed, use that buffer
;; XXX - What about showing MIME content?
;; XXX - Default print buffer is bogus
(defun mh-ps-spool-buffer (buffer)
"Send BUFFER to printer queue."
(message (format "mh-ps-spool-buffer %s" buffer))
(save-excursion
(set-buffer buffer)
(let ((ps-print-color-p mh-ps-print-color-option)
(ps-left-header
(list
(concat "("
(mh-get-header-field "Subject:") ")")
(concat "("
(mh-get-header-field "From:") ")")))
(ps-right-header
(list
"/pagenumberstring load"
(concat "("
(mh-get-header-field "Date:") ")"))))
(funcall mh-ps-print-func))))
(defun mh-ps-spool-a-msg (msg buffer)
"Print MSG.
First the message is decoded in BUFFER before the results are sent to the
printer."
(message (format "mh-ps-spool-a-msg msg %s buffer %s"
msg buffer))
(let ((mh-show-buffer mh-show-buffer)
(folder mh-current-folder)
;; The following is commented out because
;; `clean-message-header-flag' isn't used anywhere. I
;; commented rather than deleted in case somebody had some
;; future plans for it. --SY.
;(clean-message-header-flag mh-clean-message-header-flag)
)
(unwind-protect
(progn
(setq mh-show-buffer buffer)
(save-excursion
;;
;; XXX - Use setting of mh-ps-print-mime
;;
(mh-display-msg msg folder)
(mh-ps-spool-buffer mh-show-buffer)
(kill-buffer mh-show-buffer))))))
;;;###mh-autoload
(defun mh-ps-print-msg (range)
"Print the messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Print")))
(message (format "mh-ps-print-msg range %s keys %s"
range (this-command-keys)))
(mh-iterate-on-range msg range
(let ((buffer (get-buffer-create mh-temp-buffer)))
(unwind-protect
(mh-ps-spool-a-msg msg buffer)
(kill-buffer buffer)))
(mh-notate nil mh-note-printed mh-cmd-note))
(ps-despool nil))
(defun mh-ps-print-preprint (prefix-arg)
"Replacement for `ps-print-preprint'.
The original function does not handle the fact that MH folders are directories
nicely, when generating the default file name. This function works around
that. The function is passed the interactive PREFIX-ARG."
(let ((buffer-file-name (format "/tmp/%s" (substring (buffer-name) 1))))
(ps-print-preprint prefix-arg)))
;;;###mh-autoload
(defun mh-ps-print-msg-file (file range)
"Print to FILE the messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list
(mh-ps-print-preprint 1)
(mh-interactive-range "Print")))
(mh-iterate-on-range msg range
(let ((buffer (get-buffer-create mh-temp-buffer)))
(unwind-protect
(mh-ps-spool-a-msg msg buffer)
(kill-buffer buffer)))
(mh-notate nil mh-note-printed mh-cmd-note))
(ps-despool file))
;;;###mh-autoload
(defun mh-ps-print-msg-show (file)
"Print current show buffer to FILE."
(interactive (list (mh-ps-print-preprint current-prefix-arg)))
(message (format "mh-ps-print-msg-show file %s keys %s mh-show-buffer %s"
file (this-command-keys) mh-show-buffer))
(let ((msg (mh-get-msg-num t))
(folder mh-current-folder)
(show-buffer mh-show-buffer)
(show-window (get-buffer-window mh-show-buffer)))
(if (and show-buffer show-window)
(mh-in-show-buffer (show-buffer)
(if (equal (mh-msg-filename msg folder) buffer-file-name)
(progn
(mh-ps-spool-buffer show-buffer)
(ps-despool file))
(message "Current message is not being shown(1).")))
(message "Current message is not being shown(2)."))))
;;;###mh-autoload
(defun mh-ps-print-toggle-faces ()
"Toggle whether printing is done with faces or not."
(interactive)
(if (eq mh-ps-print-func 'ps-spool-buffer-with-faces)
(progn
(setq mh-ps-print-func 'ps-spool-buffer)
(message "Printing without faces"))
(setq mh-ps-print-func 'ps-spool-buffer-with-faces)
(message "Printing with faces")))
;;;###mh-autoload
(defun mh-ps-print-toggle-color ()
"Toggle whether color is used in printing messages."
(interactive)
(if (eq mh-ps-print-color-option nil)
(progn
(setq mh-ps-print-color-option 'black-white)
(message "Colors will be printed as black & white."))
(if (eq mh-ps-print-color-option 'black-white)
(progn
(setq mh-ps-print-color-option t)
(message "Colors will be printed."))
(setq mh-ps-print-color-option nil)
(message "Colors will not be printed."))))
;;; XXX: Check option 3. Documentation doesn't sound right.
;;;###mh-autoload
(defun mh-ps-print-toggle-mime ()
"Cycle through available choices on how MIME parts should be printed.
The available settings are:
1. Print only inline MIME parts.
2. Print all MIME parts.
3. Print no MIME parts."
(interactive)
(if (eq mh-ps-print-mime nil)
(progn
(setq mh-ps-print-mime t)
(message "Inline parts will be printed, attachments will not be printed."))
(if (eq mh-ps-print-mime t)
(progn
(setq mh-ps-print-mime 1)
(message "Both Inline parts and attachments will be printed."))
(setq mh-ps-print-mime nil)
(message "Neither inline parts nor attachments will be printed."))))
;;; Old non-PS based printing
;;;###mh-autoload
(defun mh-print-msg (range)
"Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'."
(interactive (list (mh-interactive-range "Print")))
(message "Printing...")
(let (msgs)
;; Gather message numbers and add them to "printed" sequence.
(mh-iterate-on-range msg range
(mh-add-msgs-to-seq msg 'printed t)
(mh-notate nil mh-note-printed mh-cmd-note)
(push msg msgs))
(setq msgs (nreverse msgs))
;; Print scan listing if we have more than one message.
(if (> (length msgs) 1)
(let* ((msgs-string
(mapconcat 'identity (mh-list-to-string
(mh-coalesce-msg-list msgs)) " "))
(lpr-command
(format mh-lpr-command-format
(cond ((listp range)
(format "Folder: %s, Messages: %s"
mh-current-folder msgs-string))
((symbolp range)
(format "Folder: %s, Sequence: %s"
mh-current-folder range)))))
(scan-command
(format "scan %s | %s" msgs-string lpr-command)))
(if mh-print-background-flag
(mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
(call-process shell-file-name nil nil nil "-c" scan-command))))
;; Print the messages
(dolist (msg msgs)
(let* ((mhl-command (format "%s %s %s"
(expand-file-name "mhl" mh-lib-progs)
(if mhl-formfile
(format " -form %s" mhl-formfile)
"")
(mh-msg-filename msg)))
(lpr-command
(format mh-lpr-command-format
(format "%s/%s" mh-current-folder msg)))
(print-command
(format "%s | %s" mhl-command lpr-command)))
(if mh-print-background-flag
(mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
(call-process shell-file-name nil nil nil "-c" print-command)))))
(message "Printing...done"))
(provide 'mh-print)
;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;; arch-tag: 8d84d50b-2a49-4d0d-b51e-ba9c9b6fc679
;;; mh-print.el ends here

214
lisp/mh-e/mh-seq.el
View file

@ -70,7 +70,7 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
@ -78,15 +78,15 @@
(defvar tool-bar-mode)
;;; Data structures (used in message threading)...
(defstruct (mh-thread-message (:conc-name mh-message-)
(:constructor mh-thread-make-message))
(mh-defstruct (mh-thread-message (:conc-name mh-message-)
(:constructor mh-thread-make-message))
(id nil)
(references ())
(subject "")
(subject-re-p nil))
(defstruct (mh-thread-container (:conc-name mh-container-)
(:constructor mh-thread-make-container))
(mh-defstruct (mh-thread-container (:conc-name mh-container-)
(:constructor mh-thread-make-container))
message parent children
(real-child-p t))
@ -201,12 +201,15 @@ redone to get the new thread tree. This makes incremental threading easier.")
;;;###mh-autoload
(defun mh-msg-is-in-seq (message)
"Display the sequences that contain MESSAGE.
Default is the displayed message."
(interactive (list (mh-get-msg-num t)))
"Display the sequences in which the current message appears.
Use a prefix argument to display the sequences in which another MESSAGE
appears."
(interactive "P")
(if (not message)
(setq message (mh-get-msg-num t)))
(let* ((dest-folder (loop for seq in mh-refile-list
until (member message (cdr seq))
finally return (car seq)))
when (member message (cdr seq)) return (car seq)
finally return nil))
(deleted-flag (unless dest-folder (member message mh-delete-list))))
(message "Message %d%s is in sequences: %s"
message
@ -269,12 +272,11 @@ interactive use."
(let* ((internal-seq-flag (mh-internal-seq sequence))
(original-msgs (mh-seq-msgs (mh-find-seq sequence)))
(folders (list mh-current-folder))
(msg-list ()))
(msg-list (mh-range-to-msg-list range)))
(mh-add-msgs-to-seq msg-list sequence nil t)
(mh-iterate-on-range m range
(push m msg-list)
(unless (memq m original-msgs)
(mh-add-sequence-notation m internal-seq-flag)))
(mh-add-msgs-to-seq msg-list sequence nil t)
(if (not internal-seq-flag)
(setq mh-last-seq-used sequence))
(when mh-index-data
@ -292,10 +294,8 @@ OP is one of 'widen and 'unthread."
;;;###mh-autoload
(defun mh-widen (&optional all-flag)
"Remove last restriction from current folder.
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
of the view stack thereby showing all messages that the buffer originally
contained."
"Restore the previous limit.
If optional prefix argument ALL-FLAG is non-nil, remove all limits."
(interactive "P")
(let ((msg (mh-get-msg-num nil)))
(when mh-folder-view-stack
@ -532,28 +532,6 @@ should be replaced with:
(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.
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 (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))))))
;;;###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."
(let ((msg-list (mh-seq-to-msgs seq)))
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
(when (member msg msg-list)
(mh-notate nil notation offset)))))
;;;###mh-autoload
(defun mh-notate-cur ()
"Mark the MH sequence cur.
@ -577,14 +555,6 @@ uses `overlay-arrow-position' to put a marker in the fringe."
"-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
;; doesn't hold. So we will do this the dumb way.
;(defun mh-copy-seq-to-point (seq location)
; ;; Copy the scan listing of the messages in SEQUENCE to after the point
; ;; LOCATION in the current buffer.
; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
(defvar mh-thread-last-ancestor)
(defun mh-copy-seq-to-eob (seq)
@ -614,21 +584,6 @@ uses `overlay-arrow-position' to put a marker in the fringe."
(mh-index-data
(mh-index-insert-folder-headers)))))))
(defun mh-copy-line-to-point (msg location)
"Copy current message line to a specific location.
The argument MSG is not used. The message in the current line is copied to
LOCATION."
;; msg is not used?
;; Copy the current line to the LOCATION in the current buffer.
(beginning-of-line)
(save-excursion
(let ((beginning-of-line (point))
end)
(forward-line 1)
(setq end (point))
(goto-char location)
(insert-buffer-substring (current-buffer) beginning-of-line end))))
;;;###mh-autoload
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body)
"Iterate over region.
@ -702,7 +657,7 @@ a region in a cons cell."
(nreverse msg-list)))
;;;###mh-autoload
(defun mh-interactive-range (range-prompt)
(defun mh-interactive-range (range-prompt &optional default)
"Return interactive specification for message, sequence, range or region.
By convention, the name of this argument is RANGE.
@ -715,24 +670,17 @@ RANGE-PROMPT. A list of messages in that range is returned.
If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.
If DEFAULT non-nil then it is returned.
Otherwise, the message number at point is returned.
This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions."
(cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
(current-prefix-arg (mh-read-range range-prompt nil nil t t))
(default default)
(t (mh-get-msg-num t))))
;;;###mh-autoload
(defun mh-region-to-msg-list (begin end)
"Return a list of messages within the region between BEGIN and END."
;; If end is end of buffer back up one position
(setq end (if (equal end (point-max)) (1- end) end))
(let ((result))
(mh-iterate-on-messages-in-region index begin end
(when (numberp index) (push index result)))
result))
;;; Commands to handle new 'subject sequence.
@ -772,7 +720,7 @@ Return number of messages put in the sequence:
(if (or (not (looking-at mh-scan-subject-regexp))
(not (match-string 3))
(string-equal "" (match-string 3)))
(progn (message "No subject line.")
(progn (message "No subject line")
nil)
(let ((subject (match-string-no-properties 3))
(list))
@ -835,61 +783,57 @@ This function can only be used the folder is threaded."
(mh-container-message (gethash (gethash msg mh-thread-index-id-map)
mh-thread-id-table)))))
;;;###mh-autoload
(defun mh-narrow-to-subject ()
"Narrow to a sequence containing all following messages with same subject."
(interactive)
(let ((num (mh-get-msg-num nil))
(count (mh-subject-to-sequence t)))
(cond
((not count) ; No subject line, delete msg anyway
nil)
((= 0 count) ; No other msgs, delete msg anyway.
(message "No other messages with same Subject following this one.")
nil)
(t ; We have a subject sequence.
(message "Found %d messages for subject sequence." count)
(mh-narrow-to-seq 'subject)
(if (numberp num)
(mh-goto-msg num t t))))))
(defun mh-read-pick-regexp (default)
"With prefix arg read a pick regexp.
(defun mh-edit-pick-expr (default)
"With prefix arg edit a pick expression.
If no prefix arg is given, then return DEFAULT."
(let ((default-string (loop for x in default concat (format " %s" x))))
(if (or current-prefix-arg (equal default-string ""))
(delete "" (split-string (read-string "Pick regexp: " default-string)))
(delete "" (split-string (read-string "Pick expression: "
default-string)))
default)))
;;;###mh-autoload
(defun mh-narrow-to-from (&optional regexp)
"Limit to messages with the same From header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(defun mh-narrow-to-subject (&optional pick-expr)
"Limit to messages with same subject.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'from))))
(mh-narrow-to-header-field 'from regexp))
(list (mh-edit-pick-expr (mh-current-message-header-field 'subject))))
(mh-narrow-to-header-field 'subject pick-expr))
;;;###mh-autoload
(defun mh-narrow-to-cc (&optional regexp)
"Limit to messages with the same Cc header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(defun mh-narrow-to-from (&optional pick-expr)
"Limit to messages with the same `From:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'cc))))
(mh-narrow-to-header-field 'cc regexp))
(list (mh-edit-pick-expr (mh-current-message-header-field 'from))))
(mh-narrow-to-header-field 'from pick-expr))
;;;###mh-autoload
(defun mh-narrow-to-to (&optional regexp)
"Limit to messages with the same To header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'to))))
(mh-narrow-to-header-field 'to regexp))
(defun mh-narrow-to-cc (&optional pick-expr)
"Limit to messages with the same `Cc:' field.
With a prefix argument, edit PICK-EXPR.
(defun mh-narrow-to-header-field (header-field regexp)
"Limit to messages whose HEADER-FIELD match REGEXP.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-edit-pick-expr (mh-current-message-header-field 'cc))))
(mh-narrow-to-header-field 'cc pick-expr))
;;;###mh-autoload
(defun mh-narrow-to-to (&optional pick-expr)
"Limit to messages with the same `To:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-edit-pick-expr (mh-current-message-header-field 'to))))
(mh-narrow-to-header-field 'to pick-expr))
(defun mh-narrow-to-header-field (header-field pick-expr)
"Limit to messages whose HEADER-FIELD match PICK-EXPR.
The MH command pick is used to do the match."
(let ((folder mh-current-folder)
(original (mh-coalesce-msg-list
@ -897,7 +841,7 @@ The MH command pick is used to do the match."
(msg-list ()))
(with-temp-buffer
(apply #'mh-exec-cmd-output "pick" nil folder
(append original (list "-list") regexp))
(append original (list "-list") pick-expr))
(goto-char (point-min))
(while (not (eobp))
(let ((num (read-from-string
@ -939,7 +883,9 @@ The MH command pick is used to do the match."
"Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
interactive use.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive (list (mh-interactive-range "Narrow to")))
(when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
(mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
@ -958,7 +904,7 @@ subject sequence."
((not count) ; No subject line, delete msg anyway
(mh-delete-msg (mh-get-msg-num t)))
((= 0 count) ; No other msgs, delete msg anyway.
(message "No other messages with same Subject following this one.")
(message "No other messages with same Subject following this one")
(mh-delete-msg (mh-get-msg-num t)))
(t ; We have a subject sequence.
(message "Marked %d messages for deletion" count)
@ -1078,13 +1024,12 @@ SUBJECT and REFS fields."
message)
(container
(setf (mh-container-message container)
(mh-thread-make-message :subject subject
:subject-re-p subject-re-p
:id id :references refs)))
(t (let ((message (mh-thread-make-message
:subject subject
:subject-re-p subject-re-p
:id id :references refs)))
(mh-thread-make-message :id id :references refs
:subject subject
:subject-re-p subject-re-p)))
(t (let ((message (mh-thread-make-message :id id :references refs
:subject-re-p subject-re-p
:subject subject)))
(prog1 message
(mh-thread-get-message-container message)))))))
@ -1450,8 +1395,7 @@ MSG is the message being notated with NOTATION at OFFSET."
(cur-scan-line (and mh-thread-scan-line-map
(gethash msg mh-thread-scan-line-map)))
(old-scan-lines (loop for map in mh-thread-scan-line-map-stack
collect (and map (gethash msg map))))
(notation (if (stringp notation) (aref notation 0) notation)))
collect (and map (gethash msg map)))))
(when cur-scan-line
(setf (aref (car cur-scan-line) offset) notation))
(dolist (line old-scan-lines)
@ -1486,7 +1430,8 @@ MSG is the message being notated with NOTATION at OFFSET."
(setf (gethash msg mh-thread-scan-line-map) v))))
(when (> (hash-table-count mh-thread-scan-line-map) 0)
(insert (if (bobp) "" "\n") (car x) "\n")
(mh-thread-generate-scan-lines thread-tree -2)))))))
(mh-thread-generate-scan-lines thread-tree -2))))
(mh-index-create-imenu-index))))
(defun mh-thread-folder ()
"Generate thread view of folder."
@ -1711,11 +1656,12 @@ start of the region and the second is the point at the end."
(push msg unticked)
(setcdr tick-seq (delq msg (cdr tick-seq)))
(when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
(mh-remove-sequence-notation msg t))
(mh-remove-sequence-notation msg (mh-colors-in-use-p)))
(t
(push msg ticked)
(setq mh-last-seq-used mh-tick-seq)
(mh-add-sequence-notation msg t))))
(let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list)))
(mh-add-sequence-notation msg (mh-colors-in-use-p))))))
(mh-add-msgs-to-seq ticked mh-tick-seq nil t)
(mh-undefine-sequence mh-tick-seq unticked)
(when mh-index-data
@ -1724,16 +1670,16 @@ start of the region and the second is the point at the end."
;;;###mh-autoload
(defun mh-narrow-to-tick ()
"Restrict display of this folder to just messages in `mh-tick-seq'.
"Limit to messages in `mh-tick-seq'.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive)
(cond ((not mh-tick-seq)
(error "Enable ticking by customizing `mh-tick-seq'"))
((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
(message "No messages in tick sequence"))
(message "No messages in %s sequence" mh-tick-seq))
(t (mh-narrow-to-seq mh-tick-seq))))
(provide 'mh-seq)
;;; Local Variables:

33
lisp/mh-e/mh-speed.el
View file

@ -34,10 +34,11 @@
;;; Code:
;; Requires
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'speedbar)
(require 'timer)
;; Global variables
(defvar mh-speed-refresh-flag nil)
@ -90,26 +91,25 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
"+" mh-speed-expand-folder
"-" mh-speed-contract-folder
"\r" mh-speed-view
"f" mh-speed-flists
"i" mh-speed-invalidate-map)
"r" mh-speed-refresh)
(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
;; Menus for speedbar...
(defvar mh-folder-speedbar-menu-items
'(["Visit Folder" mh-speed-view
'("--"
["Visit Folder" mh-speed-view
(save-excursion
(set-buffer speedbar-buffer)
(get-text-property (line-beginning-position) 'mh-folder))]
["Expand nested folders" mh-speed-expand-folder
["Expand Nested Folders" mh-speed-expand-folder
(and (get-text-property (line-beginning-position) 'mh-children-p)
(not (get-text-property (line-beginning-position) 'mh-expanded)))]
["Contract nested folders" mh-speed-contract-folder
["Contract Nested Folders" mh-speed-contract-folder
(and (get-text-property (line-beginning-position) 'mh-children-p)
(get-text-property (line-beginning-position) 'mh-expanded))]
["Run Flists" mh-speed-flists t]
["Invalidate cached folders" mh-speed-invalidate-map t])
["Refresh Speedbar" mh-speed-refresh t])
"Extra menu items for speedbar.")
(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
@ -352,6 +352,14 @@ Optional ARGS are ignored."
(defvar mh-speed-current-folder nil)
(defvar mh-speed-flists-folder nil)
(defmacro mh-process-kill-without-query (process)
"PROCESS can be killed without query on Emacs exit.
Avoid using `process-kill-without-query' if possible since it is now
obsolete."
(if (fboundp 'set-process-query-on-exit-flag)
`(set-process-query-on-exit-flag ,process nil)
`(process-kill-without-query ,process)))
;;;###mh-autoload
(defun mh-speed-flists (force &rest folders)
"Execute flists -recurse and update message counts.
@ -396,6 +404,7 @@ only for that one folder."
(or mh-speed-flists-folder '("-recurse"))))
;; Run flists on all folders the next time around...
(setq mh-speed-flists-folder nil)
(mh-process-kill-without-query mh-speed-flists-process)
(set-process-filter mh-speed-flists-process
'mh-speed-parse-flists-output)))))))
@ -494,6 +503,14 @@ next."
(when (equal folder "")
(clrhash mh-sub-folders-cache)))))
(defun mh-speed-refresh ()
"Refresh the speedbar.
Use this function to refresh the speedbar if folders have been added or
deleted or message ranges have been updated outside of MH-E."
(interactive)
(mh-speed-flists t)
(mh-speed-invalidate-map ""))
;;;###mh-autoload
(defun mh-speed-add-folder (folder)
"Add FOLDER since it is being created.

741
lisp/mh-e/mh-utils.el
View file

File diff suppressed because it is too large Load diff

25
lisp/net/ange-ftp.el
View file

@ -1014,7 +1014,7 @@ or nil meaning don't change it."
(defun ange-ftp-hash-entry-exists-p (key tbl)
"Return whether there is an association for KEY in TABLE."
(not (eq (gethash key tbl 'unknown) 'unknown)))
(and tbl (not (eq (gethash key tbl 'unknown) 'unknown))))
(defun ange-ftp-hash-table-keys (tbl)
"Return a sorted list of all the active keys in TABLE, as strings."
@ -1771,7 +1771,7 @@ good, skip, fatal, or unknown."
ange-ftp-gateway-program
ange-ftp-gateway-host)))
(ftp (mapconcat 'identity args " ")))
(process-kill-without-query proc)
(set-process-query-on-exit-flag proc nil)
(set-process-sentinel proc 'ange-ftp-gwp-sentinel)
(set-process-filter proc 'ange-ftp-gwp-filter)
(save-excursion
@ -1880,7 +1880,7 @@ been queued with no result. CONT will still be called, however."
(start-process " *nslookup*" " *nslookup*"
ange-ftp-nslookup-program host)))
(res host))
(process-kill-without-query proc)
(set-process-query-on-exit-flag proc nil)
(save-excursion
(set-buffer (process-buffer proc))
(while (memq (process-status proc) '(run open))
@ -1938,7 +1938,7 @@ on the gateway machine to do the ftp instead."
(set-buffer (process-buffer proc))
(goto-char (point-max))
(set-marker (process-mark proc) (point)))
(process-kill-without-query proc)
(set-process-query-on-exit-flag proc nil)
(set-process-sentinel proc 'ange-ftp-process-sentinel)
(set-process-filter proc 'ange-ftp-process-filter)
;; On Windows, the standard ftp client buffers its output (because
@ -2919,11 +2919,8 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained."
;; error message.
(gethash "." ent))
;; Child lookup failed, so try the parent.
(let ((table (ange-ftp-get-files dir 'no-error)))
;; If the dir doesn't exist, don't use it as a hash table.
(and table
(ange-ftp-hash-entry-exists-p file
table)))))))
(ange-ftp-hash-entry-exists-p
file (ange-ftp-get-files dir 'no-error))))))
(defun ange-ftp-get-file-entry (name)
"Given NAME, return the given file entry.
@ -3374,11 +3371,11 @@ system TYPE.")
(setq file (ange-ftp-expand-file-name file))
(if (ange-ftp-ftp-name file)
(condition-case nil
(let ((file-ent
(gethash
(ange-ftp-get-file-part file)
(ange-ftp-get-files (file-name-directory file)))))
(and (stringp file-ent) file-ent))
(let ((ent (ange-ftp-get-files (file-name-directory file))))
(and ent
(stringp (setq ent
(gethash (ange-ftp-get-file-part file) ent)))
ent))
;; If we can't read the parent directory, just assume
;; this file is not a symlink.
;; This makes it possible to access a directory that

65
lisp/net/tramp.el
View file

@ -2055,7 +2055,7 @@ target of the symlink differ."
(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
"Like `file-truename' for tramp files."
(with-parsed-tramp-file-name filename nil
(with-parsed-tramp-file-name (expand-file-name filename) nil
(let* ((steps (tramp-split-string localname "/"))
(localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
(file-name-as-directory localname)))
@ -2299,32 +2299,33 @@ If it doesn't exist, generate a new one."
(unless (buffer-file-name)
(error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
(buffer-name)))
(when time-list
(tramp-run-real-handler 'set-visited-file-modtime (list time-list)))
(let ((f (buffer-file-name))
(coding-system-used nil))
(with-parsed-tramp-file-name f nil
(let* ((attr (file-attributes f))
(modtime (nth 5 attr)))
;; We use '(0 0) as a don't-know value. See also
;; `tramp-handle-file-attributes-with-ls'.
(when (boundp 'last-coding-system-used)
(setq coding-system-used last-coding-system-used))
(if (not (equal modtime '(0 0)))
(tramp-run-real-handler 'set-visited-file-modtime (list modtime))
(save-excursion
(tramp-send-command
multi-method method user host
(format "%s -ild %s"
(tramp-get-ls-command multi-method method user host)
(tramp-shell-quote-argument localname)))
(tramp-wait-for-output)
(setq attr (buffer-substring (point)
(progn (end-of-line) (point)))))
(setq tramp-buffer-file-attributes attr))
(when (boundp 'last-coding-system-used)
(setq last-coding-system-used coding-system-used))
nil))))
(if time-list
(tramp-run-real-handler 'set-visited-file-modtime (list time-list))
(let ((f (buffer-file-name))
(coding-system-used nil))
(with-parsed-tramp-file-name f nil
(let* ((attr (file-attributes f))
;; '(-1 65535) means file doesn't exists yet.
(modtime (or (nth 5 attr) '(-1 65535))))
;; We use '(0 0) as a don't-know value. See also
;; `tramp-handle-file-attributes-with-ls'.
(when (boundp 'last-coding-system-used)
(setq coding-system-used last-coding-system-used))
(if (not (equal modtime '(0 0)))
(tramp-run-real-handler 'set-visited-file-modtime (list modtime))
(save-excursion
(tramp-send-command
multi-method method user host
(format "%s -ild %s"
(tramp-get-ls-command multi-method method user host)
(tramp-shell-quote-argument localname)))
(tramp-wait-for-output)
(setq attr (buffer-substring (point)
(progn (end-of-line) (point)))))
(setq tramp-buffer-file-attributes attr))
(when (boundp 'last-coding-system-used)
(setq last-coding-system-used coding-system-used))
nil)))))
;; CCC continue here
@ -3811,8 +3812,11 @@ This will break if COMMAND prints a newline, followed by the value of
(unless (equal curbuf (current-buffer))
(error "Buffer has changed from `%s' to `%s'"
curbuf (current-buffer)))
(when (eq visit t)
(set-visited-file-modtime))
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
;; We must pass modtime explicitely, because filename can be different
;; from (buffer-file-name), f.e. if `file-precious-flag' is set.
(nth 5 (file-attributes filename))))
;; Make `last-coding-system-used' have the right value.
(when (boundp 'last-coding-system-used)
(setq last-coding-system-used coding-system-used))
@ -5847,7 +5851,8 @@ locale to C and sets up the remote shell search path."
multi-method method user host
(concat "tramp_file_attributes () {\n"
tramp-remote-perl
" -e '" tramp-perl-file-attributes "' $1 $2 2>/dev/null\n"
" -e '" tramp-perl-file-attributes "'"
" \"$1\" \"$2\" 2>/dev/null\n"
"}"))
(tramp-wait-for-output)
(unless (tramp-method-out-of-band-p multi-method method user host)

2
lisp/net/trampver.el
View file

@ -30,7 +30,7 @@
;; are auto-frobbed from configure.ac, so you should edit that file and run
;; "autoconf && ./configure" to change them.
(defconst tramp-version "2.0.39"
(defconst tramp-version "2.0.44"
"This version of Tramp.")
(defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"

21
lisp/pcvs-parse.el
View file

@ -1,7 +1,7 @@
;;; pcvs-parse.el --- the CVS output parser
;; Copyright (C) 1991,92,93,94,95,96,97,98,99,2000,02,2003
;; Free Software Foundation, Inc.
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;; 2000, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: pcl-cvs
@ -370,7 +370,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; File you removed still exists. Ignore (will be noted as removed).
(cvs-match ".* should be removed and is still there$")
;; just a note
(cvs-match "use '.+ commit' to \\sw+ th\\sw+ files? permanently$")
(cvs-match "use ['`].+ commit' to \\sw+ th\\sw+ files? permanently$")
;; [add,status] followed by a more complete status description anyway
(and (cvs-match "nothing known about \\(.*\\)$" (path 1))
(cvs-parsed-fileinfo 'DEAD path 'trust))
@ -492,12 +492,14 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
:head-rev head-rev))))
(defun cvs-parse-commit ()
(let (path base-rev subtype)
(let (path file base-rev subtype)
(cvs-or
(and
(cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2))
(cvs-match ".*,v <-- .*$")
(cvs-or
(cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2))
t)
(cvs-match ".*,v <-- \\(.*\\)$" (file 1))
(cvs-or
;; deletion
(cvs-match "new revision: delete; previous revision: \\([0-9.]*\\)$"
@ -508,7 +510,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; update
(cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$"
(subtype 'COMMITTED) (base-rev 1)))
(cvs-match "done$")
(cvs-or (cvs-match "done$") t)
(progn
;; Try to remove the temp files used by VC.
(vc-delete-automatic-version-backups (expand-file-name path))
@ -516,7 +518,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; because `cvs commit' might begin by a series of Examining messages
;; so the processing of the actual checkin messages might begin with
;; a `current-dir' set to something different from ""
(cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) path 'trust
(cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype)
(or path file) (if path 'trust)
:base-rev base-rev)))
;; useless message added before the actual addition: ignored
@ -525,5 +528,5 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(provide 'pcvs-parse)
;;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6
;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6
;;; pcvs-parse.el ends here

166
lisp/progmodes/ada-xref.el
View file

@ -33,7 +33,7 @@
;;; for lookup and completion in Ada mode.
;;;
;;; If a file *.`adp' exists in the ada-file directory, then it is
;;; read for configuration informations. It is read only the first
;;; read for configuration informations. It is read only the first
;;; time a cross-reference is asked for, and is not read later.
;;; You need Emacs >= 20.2 to run this package
@ -55,26 +55,25 @@ Otherwise create either a new buffer or a new frame."
(defcustom ada-xref-create-ali nil
"*If non-nil, run gcc whenever the cross-references are not up-to-date.
If nil, the cross-reference mode will never run gcc."
If nil, the cross-reference mode never runs gcc."
:type 'boolean :group 'ada)
(defcustom ada-xref-confirm-compile nil
"*If non-nil, always ask for user confirmation before compiling or running
the application."
"*If non-nil, ask for confirmation before compiling or running the application."
:type 'boolean :group 'ada)
(defcustom ada-krunch-args "0"
"*Maximum number of characters for filenames created by gnatkr.
Set to 0, if you don't use crunched filenames. This should be a string."
"*Maximum number of characters for filenames created by `gnatkr'.
Set to 0, if you don't use crunched filenames. This should be a string."
:type 'string :group 'ada)
(defcustom ada-gnatls-args '("-v")
"*Arguments to pass to gnatfind when the location of the runtime is searched.
Typical use is to pass --RTS=soft-floats on some systems that support it.
"*Arguments to pass to `gnatfind' to find location of the runtime.
Typical use is to pass `--RTS=soft-floats' on some systems that support it.
You can also add -I- if you do not want the current directory to be included.
You can also add `-I-' if you do not want the current directory to be included.
Otherwise, going from specs to bodies and back will first look for files in the
current directory. This only has an impact if you are not using project files,
current directory. This only has an impact if you are not using project files,
but only ADA_INCLUDE_PATH."
:type '(repeat string) :group 'ada)
@ -91,14 +90,14 @@ but only ADA_INCLUDE_PATH."
:type 'string :group 'ada)
(defcustom ada-prj-default-gnatmake-opt "-g"
"Default options for gnatmake."
"Default options for `gnatmake'."
:type 'string :group 'ada)
(defcustom ada-prj-gnatfind-switches "-rf"
"Default switches to use for gnatfind.
You should modify this variable, for instance to add -a, if you are working
"Default switches to use for `gnatfind'.
You should modify this variable, for instance to add `-a', if you are working
in an environment where most ALI files are write-protected.
The command gnatfind is used every time you choose the menu
The command `gnatfind' is used every time you choose the menu
\"Show all references\"."
:type 'string :group 'ada)
@ -106,12 +105,12 @@ The command gnatfind is used every time you choose the menu
(concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
" ${comp_opt}")
"*Default command to be used to compile a single file.
Emacs will add the filename at the end of this command. This is the same
Emacs will add the filename at the end of this command. This is the same
syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
"*Default name of the debugger. We recommend either `gdb',
"*Default name of the debugger. We recommend either `gdb',
`gdb --emacs_gdbtk' or `ddd --tty -fullname'."
:type 'string :group 'ada)
@ -129,7 +128,7 @@ this string is not empty."
:type '(file :must-match t) :group 'ada)
(defcustom ada-gnatstub-opts "-q -I${src_dir}"
"*List of the options to pass to gnatsub to generate the body of a package.
"*List of the options to pass to `gnatsub' to generate the body of a package.
This has the same syntax as in the project file (with variable substitution)."
:type 'string :group 'ada)
@ -139,7 +138,7 @@ Otherwise, ask the user for the name of the project file to use."
:type 'boolean :group 'ada)
(defconst is-windows (memq system-type (quote (windows-nt)))
"True if we are running on windows NT or windows 95.")
"True if we are running on Windows NT or Windows 95.")
(defcustom ada-tight-gvd-integration nil
"*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
@ -149,7 +148,7 @@ If GVD is not the debugger used, nothing happens."
(defcustom ada-xref-search-with-egrep t
"*If non-nil, use egrep to find the possible declarations for an entity.
This alternate method is used when the exact location was not found in the
information provided by GNAT. However, it might be expensive if you have a lot
information provided by GNAT. However, it might be expensive if you have a lot
of sources, since it will search in all the files in your project."
:type 'boolean :group 'ada)
@ -161,8 +160,8 @@ This hook should be used to support new formats for the project files.
If the function can load the file with the given filename, it should create a
buffer that contains a conversion of the file to the standard format of the
project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\"
lines). It should return nil if it doesn't know how to convert that project
project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\"
lines.) It should return nil if it doesn't know how to convert that project
file.")
@ -192,14 +191,13 @@ Used to go back to these positions.")
(if (string-match "cmdproxy.exe" shell-file-name)
"cd /d"
"cd")
"Command to use to change to a specific directory. On windows systems
using cmdproxy.exe as the shell, we need to use /d or the drive is never
changed.")
"Command to use to change to a specific directory.
On Windows systems using `cmdproxy.exe' as the shell,
we need to use `/d' or the drive is never changed.")
(defvar ada-command-separator (if is-windows " && " "\n")
"Separator to use when sending multiple commands to `compile' or
`start-process'.
cmdproxy.exe doesn't recognize multiple-line commands, so we have to use
"Separator to use between multiple commands to `compile' or `start-process'.
`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use
\"&&\" for now.")
(defconst ada-xref-pos-ring-max 16
@ -247,12 +245,12 @@ As always, the values of the project file are defined through properties.")
;; -----------------------------------------------------------------------
(defun ada-quote-cmd (cmd)
"Duplicates all \\ characters in CMD so that it can be passed to `compile'"
"Duplicate all \\ characters in CMD so that it can be passed to `compile'."
(mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
(defun ada-initialize-runtime-library (cross-prefix)
"Initializes the variables for the runtime library location.
CROSS-PREFIX is the prefix to use for the gnatls command"
"Initialize the variables for the runtime library location.
CROSS-PREFIX is the prefix to use for the gnatls command."
(save-excursion
(setq ada-xref-runtime-library-specs-path '()
ada-xref-runtime-library-ali-path '())
@ -591,7 +589,7 @@ This is overriden on VMS to convert from VMS filenames to Unix filenames."
(defun ada-set-default-project-file (name &optional keep-existing)
"Set the file whose name is NAME as the default project file.
If KEEP-EXISTING is true and a project file has already been loaded, nothing
is done. This is meant to be used from ada-mode-hook, for instance to force
is done. This is meant to be used from `ada-mode-hook', for instance, to force
a project file unless the user has already loaded one."
(interactive "fProject file:")
(if (or (not keep-existing)
@ -608,7 +606,7 @@ a project file unless the user has already loaded one."
If NO-USER-QUESTION is non-nil, use a default file if not project file was
found, and do not ask the user.
If the buffer is not an Ada buffer, associate it with the default project
file. If none is set, return nil."
file. If none is set, return nil."
(let (selected)
@ -711,7 +709,7 @@ The current buffer should be the ada-file buffer."
(ada-xref-set-default-prj-values 'project (current-buffer))
;; Do not use find-file below, since we don't want to show this
;; buffer. If the file is open through speedbar, we can't use
;; buffer. If the file is open through speedbar, we can't use
;; find-file anyway, since the speedbar frame is special and does not
;; allow the selection of a file in it.
@ -786,7 +784,7 @@ The current buffer should be the ada-file buffer."
;; Else the file wasn't readable (probably the default project).
;; We initialize it with the current environment variables.
;; We need to add the startup directory in front so that
;; files locally redefined are properly found. We cannot
;; files locally redefined are properly found. We cannot
;; add ".", which varies too much depending on what the
;; current buffer is.
(set 'project
@ -836,7 +834,7 @@ The current buffer should be the ada-file buffer."
;; No prj file ? => Setup default values
;; Note that nil means that all compilation modes will first look in the
;; current directory, and only then in the current file's directory. This
;; current directory, and only then in the current file's directory. This
;; current file is assumed at this point to be in the common source
;; directory.
(setq compilation-search-path (list nil default-directory))
@ -846,10 +844,9 @@ The current buffer should be the ada-file buffer."
(defun ada-find-references (&optional pos arg local-only)
"Find all references to the entity under POS.
Calls gnatfind to find the references.
if ARG is t, the contents of the old *gnatfind* buffer is preserved.
if LOCAL-ONLY is t, only the declarations in the current file are returned."
(interactive "d
P")
If ARG is t, the contents of the old *gnatfind* buffer is preserved.
If LOCAL-ONLY is t, only the declarations in the current file are returned."
(interactive "d\nP")
(ada-require-project-file)
(let* ((identlist (ada-read-identifier pos))
@ -872,24 +869,23 @@ P")
(defun ada-find-local-references (&optional pos arg)
"Find all references to the entity under POS.
Calls gnatfind to find the references.
if ARG is t, the contents of the old *gnatfind* buffer is preserved."
(interactive "d
P")
Calls `gnatfind' to find the references.
If ARG is t, the contents of the old *gnatfind* buffer is preserved."
(interactive "d\nP")
(ada-find-references pos arg t))
(defun ada-find-any-references
(entity &optional file line column local-only append)
"Search for references to any entity whose name is ENTITY.
ENTITY was first found the location given by FILE, LINE and COLUMN.
If LOCAL-ONLY is t, then only the references in file will be listed, which
If LOCAL-ONLY is t, then list only the references in FILE, which
is much faster.
If APPEND is t, then the output of the command will be append to the existing
buffer *gnatfind* if it exists."
If APPEND is t, then append the output of the command to the existing
buffer `*gnatfind*', if there is one."
(interactive "sEntity name: ")
(ada-require-project-file)
;; Prepare the gnatfind command. Note that we must protect the quotes
;; Prepare the gnatfind command. Note that we must protect the quotes
;; around operators, so that they are correctly handled and can be
;; processed (gnatfind \"+\":...).
(let* ((quote-entity
@ -921,7 +917,8 @@ buffer *gnatfind* if it exists."
(set-buffer "*gnatfind*")
(setq old-contents (buffer-string))))
(compile-internal command "No more references" "gnatfind")
(let ((compilation-error "reference"))
(compilation-start command))
;; Hide the "Compilation" menu
(save-excursion
@ -941,8 +938,8 @@ buffer *gnatfind* if it exists."
;; ----- Identifier Completion --------------------------------------------
(defun ada-complete-identifier (pos)
"Tries to complete the identifier around POS.
The feature is only available if the files where compiled not using the -gnatx
option."
The feature is only available if the files where compiled without
the option `-gnatx'."
(interactive "d")
(ada-require-project-file)
@ -1026,12 +1023,12 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
;; entity, whose references are not given by GNAT
(if (and (file-exists-p ali-file)
(file-newer-than-file-p ali-file (ada-file-of identlist)))
(message "No cross-reference found. It might be a predefined entity.")
(message "No cross-reference found--may be a predefined entity.")
;; Else, look in every ALI file, except if the user doesn't want that
(if ada-xref-search-with-egrep
(ada-find-in-src-path identlist other-frame)
(message "Cross-referencing information is not up-to-date. Please recompile.")
(message "Cross-referencing information is not up-to-date; please recompile.")
)))))))
(defun ada-goto-declaration-other-frame (pos)
@ -1052,12 +1049,13 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
(defun ada-get-absolute-dir-list (dir-list root-dir)
"Returns the list of absolute directories found in dir-list.
If a directory is a relative directory, the value of ROOT-DIR is added in
front."
If a directory is a relative directory, add the value of ROOT-DIR in front."
(mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
(defun ada-set-environment ()
"Return the new value for process-environment.
"Prepare an environment for Ada compilation.
This returns a new value to use for `process-environment',
but does not actually put it into use.
It modifies the source path and object path with the values found in the
project file."
(let ((include (getenv "ADA_INCLUDE_PATH"))
@ -1082,7 +1080,7 @@ project file."
process-environment))))
(defun ada-compile-application (&optional arg)
"Compiles the application, using the command found in the project file.
"Compile the application, using the command found in the project file.
If ARG is not nil, ask for user confirmation."
(interactive "P")
(ada-require-project-file)
@ -1104,7 +1102,7 @@ If ARG is not nil, ask for user confirmation."
(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
;; Insert newlines so as to separate the name of the commands to run
;; and the output of the commands. this doesn't work with cmdproxy.exe,
;; and the output of the commands. This doesn't work with cmdproxy.exe,
;; which gets confused by newline characters.
(if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
@ -1137,7 +1135,7 @@ command, and should be either comp_cmd (default) or check_cmd."
(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
;; Insert newlines so as to separate the name of the commands to run
;; and the output of the commands. this doesn't work with cmdproxy.exe,
;; and the output of the commands. This doesn't work with cmdproxy.exe,
;; which gets confused by newline characters.
(if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
@ -1152,7 +1150,7 @@ If ARG is not nil, ask for user confirmation of the command."
(defun ada-run-application (&optional arg)
"Run the application.
if ARG is not-nil, asks for user confirmation."
if ARG is not-nil, ask for user confirmation."
(interactive)
(ada-require-project-file)
@ -1227,7 +1225,7 @@ If ARG is non-nil, ask the user to confirm the command."
;; We make sure that gvd swallows the new frame, not the one the
;; user has been using until now
;; The frame is made invisible initially, so that GtkPlug gets a
;; chance to fully manage it. Then it works fine with Enlightenment
;; chance to fully manage it. Then it works fine with Enlightenment
;; as well
(let ((frame (make-frame '((visibility . nil)))))
(set 'cmd (concat
@ -1297,7 +1295,7 @@ If ARG is non-nil, ask the user to confirm the command."
(end-of-buffer)
;; Display both the source window and the debugger window (the former
;; above the latter). No need to show the debugger window unless it
;; above the latter). No need to show the debugger window unless it
;; is going to have some relevant information.
(if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
(string-match "--tty" cmd))
@ -1328,8 +1326,8 @@ automatically modifies the setup for all the Ada buffer that use this file."
"Update the cross-references for FILE.
This in fact recompiles FILE to create ALI-FILE-NAME.
This function returns the name of the file that was recompiled to generate
the cross-reference information. Note that the ali file can then be deduced by
replacing the file extension with .ali"
the cross-reference information. Note that the ali file can then be deduced by
replacing the file extension with `.ali'."
;; kill old buffer
(if (and ali-file-name
(get-file-buffer ali-file-name))
@ -1338,7 +1336,7 @@ replacing the file extension with .ali"
(let* ((name (ada-convert-file-name file))
(body-name (or (ada-get-body-name name) name)))
;; Always recompile the body when we can. We thus temporarily switch to a
;; Always recompile the body when we can. We thus temporarily switch to a
;; buffer than contains the body of the unit
(save-excursion
(let ((body-visible (find-buffer-visiting body-name))
@ -1347,7 +1345,7 @@ replacing the file extension with .ali"
(set-buffer body-visible)
(find-file body-name))
;; Execute the compilation. Note that we must wait for the end of the
;; Execute the compilation. Note that we must wait for the end of the
;; process, or the ALI file would still not be available.
;; Unfortunately, the underlying `compile' command that we use is
;; asynchronous.
@ -1377,13 +1375,13 @@ replacing the file extension with .ali"
found))
(defun ada-find-ali-file-in-dir (file)
"Find an .ali file in obj_dir. The current buffer must be the Ada file.
"Find an .ali file in obj_dir. The current buffer must be the Ada file.
Adds build_dir in front of the search path to conform to gnatmake's behavior,
and the standard runtime location at the end."
(ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
(defun ada-find-src-file-in-dir (file)
"Find a source file in src_dir. The current buffer must be the Ada file.
"Find a source file in src_dir. The current buffer must be the Ada file.
Adds src_dir in front of the search path to conform to gnatmake's behavior,
and the standard runtime location at the end."
(ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
@ -1400,7 +1398,7 @@ the project file."
;; and look for this file
;; 2- If this file is found:
;; grep the "^U" lines, and make sure we are not reading the
;; .ali file for a spec file. If we are, go to step 3.
;; .ali file for a spec file. If we are, go to step 3.
;; 3- If the file is not found or step 2 failed:
;; find the name of the "other file", ie the body, and look
;; for its associated .ali file by subtituing the extension
@ -1408,9 +1406,9 @@ the project file."
;; We must also handle the case of separate packages and subprograms:
;; 4- If no ali file was found, we try to modify the file name by removing
;; everything after the last '-' or '.' character, so as to get the
;; ali file for the parent unit. If we found an ali file, we check that
;; ali file for the parent unit. If we found an ali file, we check that
;; it indeed contains the definition for the separate entity by checking
;; the 'D' lines. This is done repeatedly, in case the direct parent is
;; the 'D' lines. This is done repeatedly, in case the direct parent is
;; also a separate.
(save-excursion
@ -1423,7 +1421,7 @@ the project file."
;; If we have a non-standard file name, and this is a spec, we first
;; look for the .ali file of the body, since this is the one that
;; contains the most complete information. If not found, we will do what
;; contains the most complete information. If not found, we will do what
;; we can with the .ali file for the spec...
(if (not (string= (file-name-extension file) "ads"))
@ -1476,8 +1474,8 @@ the project file."
;; If still not found, try to recompile the file
(if (not ali-file-name)
;; recompile only if the user asked for this. and search the ali
;; filename again. We avoid a possible infinite recursion by
;; Recompile only if the user asked for this, and search the ali
;; filename again. We avoid a possible infinite recursion by
;; temporarily disabling the automatic compilation.
(if ada-xref-create-ali
@ -1485,7 +1483,7 @@ the project file."
(concat (file-name-sans-extension (ada-xref-current file))
".ali"))
(error "Ali file not found. Recompile your file"))
(error "`.ali' file not found; recompile your source file"))
;; same if the .ali file is too old and we must recompile it
@ -1499,7 +1497,7 @@ the project file."
(defun ada-get-ada-file-name (file original-file)
"Create the complete file name (+directory) for FILE.
The original file (where the user was) is ORIGINAL-FILE. Search in project
The original file (where the user was) is ORIGINAL-FILE. Search in project
file for possible paths."
(save-excursion
@ -1519,7 +1517,7 @@ file for possible paths."
(expand-file-name filename)
(error (concat
(file-name-nondirectory file)
" not found in src_dir. Please check your project file")))
" not found in src_dir; please check your project file")))
)))
@ -1671,13 +1669,13 @@ from the ali file (definition file and places where it is referenced)."
(set 'declaration-found nil))))
;; Still no success ! The ali file must be too old, and we need to
;; use a basic algorithm based on guesses. Note that this only happens
;; use a basic algorithm based on guesses. Note that this only happens
;; if the user does not want us to automatically recompile files
;; automatically
(unless declaration-found
(if (ada-xref-find-in-modified-ali identlist)
(set 'declaration-found t)
;; no more idea to find the declaration. Give up
;; No more idea to find the declaration. Give up
(progn
(kill-buffer ali-buffer)
(error (concat "No declaration of " (ada-name-of identlist)
@ -1911,7 +1909,7 @@ is using."
(save-excursion
;; Do the grep in all the directories. We do multiple shell
;; Do the grep in all the directories. We do multiple shell
;; commands instead of one in case there is no .ali file in one
;; of the directory and the shell stops because of that.
@ -2011,7 +2009,7 @@ is using."
(file line column identlist &optional other-frame)
"Select and display FILE, at LINE and COLUMN.
If we do not end on the same identifier as IDENTLIST, find the closest
match. Kills the .ali buffer at the end.
match. Kills the .ali buffer at the end.
If OTHER-FRAME is non-nil, creates a new frame to show the file."
(let (declaration-buffer)
@ -2178,7 +2176,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
(unless (buffer-file-name (car (buffer-list)))
(set-buffer (cadr (buffer-list))))
;; Make sure we have a project file (for parameters to gnatstub). Note that
;; Make sure we have a project file (for parameters to gnatstub). Note that
;; this might have already been done if we have been called from the hook,
;; but this is not an expensive call)
(ada-require-project-file)
@ -2240,9 +2238,9 @@ find-file...."
;; Use gvd or ddd as the default debugger if it was found
;; On windows, do not use the --tty switch for GVD, since this is
;; not supported. Actually, we do not use this on Unix either, since otherwise
;; there is no console window left in GVD, and people have to use the
;; Emacs one.
;; not supported. Actually, we do not use this on Unix either,
;; since otherwise there is no console window left in GVD,
;; and people have to use the Emacs one.
;; This must be done before initializing the Ada menu.
(if (ada-find-file-in-dir "gvd" exec-path)
(set 'ada-prj-default-debugger "gvd ")

35
lisp/progmodes/cc-align.el
View file

@ -121,7 +121,7 @@ Works with: arglist-cont-nonempty, arglist-close."
;; like "({".
(when c-special-brace-lists
(let ((special-list (c-looking-at-special-brace-list)))
(when special-list
(when (and special-list (< (car (car special-list)) (point)))
(goto-char (+ (car (car special-list)) 2)))))
(let ((savepos (point))
@ -380,9 +380,7 @@ Works with: inher-cont, member-init-cont."
(back-to-indentation)
(let* ((eol (c-point 'eol))
(here (point))
(char-after-ip (progn
(skip-chars-forward " \t")
(char-after))))
(char-after-ip (char-after)))
(if (cdr langelem) (goto-char (cdr langelem)))
;; This kludge is necessary to support both inher-cont and
@ -392,13 +390,12 @@ Works with: inher-cont, member-init-cont."
(backward-char)
(c-backward-syntactic-ws))
(skip-chars-forward "^:" eol)
(if (eq char-after-ip ?,)
(skip-chars-forward " \t" eol)
(skip-chars-forward " \t:" eol))
(if (or (eolp)
(looking-at c-comment-start-regexp))
(c-forward-syntactic-ws here))
(c-syntactic-re-search-forward ":" eol 'move)
(if (looking-at c-syntactic-eol)
(c-forward-syntactic-ws here)
(if (eq char-after-ip ?,)
(backward-char)
(skip-chars-forward " \t" eol)))
(if (< (point) here)
(vector (current-column)))
)))
@ -952,11 +949,17 @@ Works with: defun-close, defun-block-intro, block-close,
brace-list-close, brace-list-intro, statement-block-intro and all in*
symbols, e.g. inclass and inextern-lang."
(save-excursion
(goto-char (cdr langelem))
(back-to-indentation)
(if (eq (char-syntax (char-after)) ?\()
0
c-basic-offset)))
(+ (progn
(back-to-indentation)
(if (eq (char-syntax (char-after)) ?\()
c-basic-offset
0))
(progn
(goto-char (cdr langelem))
(back-to-indentation)
(if (eq (char-syntax (char-after)) ?\()
0
c-basic-offset)))))
(defun c-lineup-cpp-define (langelem)
"Line up macro continuation lines according to the indentation of

9
lisp/progmodes/cc-cmds.el
View file

@ -479,7 +479,11 @@ This function does various newline cleanups based on the value of
;; end up before it.
(setq delete-temp-newline
(cons (save-excursion
(c-backward-syntactic-ws)
(end-of-line 0)
(if (eq (char-before) ?\\)
;; Ignore a line continuation.
(backward-char))
(skip-chars-backward " \t")
(copy-marker (point) t))
(point-marker))))
(unwind-protect
@ -1971,8 +1975,7 @@ If `c-tab-always-indent' is t, always just indent the current line.
If nil, indent the current line only if point is at the left margin or
in the line's indentation; otherwise insert some whitespace[*]. If
other than nil or t, then some whitespace[*] is inserted only within
literals (comments and strings) and inside preprocessor directives,
but the line is always reindented.
literals (comments and strings), but the line is always reindented.
If `c-syntactic-indentation' is t, indentation is done according to
the syntactic context. A numeric argument, regardless of its value,

215
lisp/progmodes/cc-defs.el
View file

@ -48,7 +48,6 @@
;; Silence the compiler.
(cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
(cc-bytecomp-defvar c-emacs-features) ; In cc-vars.el
(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs
(cc-bytecomp-defun region-active-p) ; XEmacs
(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs
@ -105,7 +104,7 @@
;;; Variables also used at compile time.
(defconst c-version "5.30.8"
(defconst c-version "5.30.9"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
@ -620,20 +619,36 @@ This function does not do any hidden buffer changes."
(eq (char-before) ?\\)))
(backward-char))))
(eval-and-compile
(defvar c-langs-are-parametric nil))
(defmacro c-major-mode-is (mode)
"Return non-nil if the current CC Mode major mode is MODE.
MODE is either a mode symbol or a list of mode symbols.
This function does not do any hidden buffer changes."
(if (eq (car-safe mode) 'quote)
(let ((mode (eval mode)))
(if (listp mode)
`(memq c-buffer-is-cc-mode ',mode)
`(eq c-buffer-is-cc-mode ',mode)))
`(let ((mode ,mode))
(if (listp mode)
(memq c-buffer-is-cc-mode mode)
(eq c-buffer-is-cc-mode mode)))))
(if c-langs-are-parametric
;; Inside a `c-lang-defconst'.
`(c-lang-major-mode-is ,mode)
(if (eq (car-safe mode) 'quote)
(let ((mode (eval mode)))
(if (listp mode)
`(memq c-buffer-is-cc-mode ',mode)
`(eq c-buffer-is-cc-mode ',mode)))
`(let ((mode ,mode))
(if (listp mode)
(memq c-buffer-is-cc-mode mode)
(eq c-buffer-is-cc-mode mode))))))
(defmacro c-mode-is-new-awk-p ()
;; Is the current mode the "new" awk mode? It is important for
;; (e.g.) the cc-engine functions do distinguish between the old and
;; new awk-modes.
'(and (c-major-mode-is 'awk-mode)
(memq 'syntax-properties c-emacs-features)))
(defmacro c-parse-sexp-lookup-properties ()
;; Return the value of the variable that says whether the
@ -968,13 +983,6 @@ the value of the variable with that name.
This function does not do any hidden buffer changes."
(symbol-value (c-mode-symbol suffix)))
(defsubst c-mode-is-new-awk-p ()
;; Is the current mode the "new" awk mode? It is important for
;; (e.g.) the cc-engine functions do distinguish between the old and
;; new awk-modes.
(and (c-major-mode-is 'awk-mode)
(memq 'syntax-properties c-emacs-features)))
(defsubst c-got-face-at (pos faces)
"Return non-nil if position POS in the current buffer has any of the
faces in the list FACES.
@ -1056,12 +1064,156 @@ current language (taken from `c-buffer-is-cc-mode')."
(put 'c-make-keywords-re 'lisp-indent-function 1)
;; Figure out what features this Emacs has
(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
(defconst c-emacs-features
(let (list)
(if (boundp 'infodock-version)
;; I've no idea what this actually is, but it's legacy. /mast
(setq list (cons 'infodock list)))
;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags.
;; Emacs 19 uses a 1-bit flag. We will have to set up our
;; syntax tables differently to handle this.
(let ((table (copy-syntax-table))
entry)
(modify-syntax-entry ?a ". 12345678" table)
(cond
;; XEmacs 19, and beyond Emacs 19.34
((arrayp table)
(setq entry (aref table ?a))
;; In Emacs, table entries are cons cells
(if (consp entry) (setq entry (car entry))))
;; XEmacs 20
((fboundp 'get-char-table) (setq entry (get-char-table ?a table)))
;; before and including Emacs 19.34
((and (fboundp 'char-table-p)
(char-table-p table))
(setq entry (car (char-table-range table [?a]))))
;; incompatible
(t (error "CC Mode is incompatible with this version of Emacs")))
(setq list (cons (if (= (logand (lsh entry -16) 255) 255)
'8-bit
'1-bit)
list)))
(let ((buf (generate-new-buffer " test"))
parse-sexp-lookup-properties
parse-sexp-ignore-comments
lookup-syntax-properties)
(save-excursion
(set-buffer buf)
(set-syntax-table (make-syntax-table))
;; For some reason we have to set some of these after the
;; buffer has been made current. (Specifically,
;; `parse-sexp-ignore-comments' in Emacs 21.)
(setq parse-sexp-lookup-properties t
parse-sexp-ignore-comments t
lookup-syntax-properties t)
;; Find out if the `syntax-table' text property works.
(modify-syntax-entry ?< ".")
(modify-syntax-entry ?> ".")
(insert "<()>")
(c-mark-<-as-paren 1)
(c-mark->-as-paren 4)
(goto-char 1)
(c-forward-sexp)
(if (= (point) 5)
(setq list (cons 'syntax-properties list)))
;; Find out if generic comment delimiters work.
(c-safe
(modify-syntax-entry ?x "!")
(if (string-match "\\s!" "x")
(setq list (cons 'gen-comment-delim list))))
;; Find out if generic string delimiters work.
(c-safe
(modify-syntax-entry ?x "|")
(if (string-match "\\s|" "x")
(setq list (cons 'gen-string-delim list))))
;; See if POSIX char classes work.
(when (and (string-match "[[:alpha:]]" "a")
;; All versions of Emacs 21 so far haven't fixed
;; char classes in `skip-chars-forward' and
;; `skip-chars-backward'.
(progn
(delete-region (point-min) (point-max))
(insert "foo123")
(skip-chars-backward "[:alnum:]")
(bobp))
(= (skip-chars-forward "[:alpha:]") 3))
(setq list (cons 'posix-char-classes list)))
;; See if `open-paren-in-column-0-is-defun-start' exists and
;; isn't buggy.
(when (boundp 'open-paren-in-column-0-is-defun-start)
(let ((open-paren-in-column-0-is-defun-start nil)
(parse-sexp-ignore-comments t))
(delete-region (point-min) (point-max))
(set-syntax-table (make-syntax-table))
(modify-syntax-entry ?\' "\"")
(cond
;; XEmacs. Afaik this is currently an Emacs-only
;; feature, but it's good to be prepared.
((memq '8-bit list)
(modify-syntax-entry ?/ ". 1456")
(modify-syntax-entry ?* ". 23"))
;; Emacs
((memq '1-bit list)
(modify-syntax-entry ?/ ". 124b")
(modify-syntax-entry ?* ". 23")))
(modify-syntax-entry ?\n "> b")
(insert "/* '\n () */")
(backward-sexp)
(if (bobp)
(setq list (cons 'col-0-paren list)))))
(set-buffer-modified-p nil))
(kill-buffer buf))
;; See if `parse-partial-sexp' returns the eighth element.
(when (c-safe (>= (length (save-excursion (parse-partial-sexp 1 1))) 10))
(setq list (cons 'pps-extended-state list)))
;;(message "c-emacs-features: %S" list)
list)
"A list of certain features in the (X)Emacs you are using.
There are many flavors of Emacs out there, each with different
features supporting those needed by CC Mode. The following values
might be present:
'8-bit 8 bit syntax entry flags (XEmacs style).
'1-bit 1 bit syntax entry flags (Emacs style).
'syntax-properties It works to override the syntax for specific characters
in the buffer with the 'syntax-table property.
'gen-comment-delim Generic comment delimiters work
(i.e. the syntax class `!').
'gen-string-delim Generic string delimiters work
(i.e. the syntax class `|').
'pps-extended-state `parse-partial-sexp' returns a list with at least 10
elements, i.e. it contains the position of the
start of the last comment or string.
'posix-char-classes The regexp engine understands POSIX character classes.
'col-0-paren It's possible to turn off the ad-hoc rule that a paren
in column zero is the start of a defun.
'infodock This is Infodock (based on XEmacs).
'8-bit and '1-bit are mutually exclusive.")
;;; Some helper constants.
;; If the regexp engine supports POSIX char classes (e.g. Emacs 21)
;; then we can use them to handle extended charsets correctly.
(if (string-match "[[:alpha:]]" "a") ; Can't use c-emacs-features here.
;; If the regexp engine supports POSIX char classes then we can use
;; them to handle extended charsets correctly.
(if (memq 'posix-char-classes c-emacs-features)
(progn
(defconst c-alpha "[:alpha:]")
(defconst c-alnum "[:alnum:]")
@ -1127,8 +1279,8 @@ system."
(error "The mode name symbol `%s' must end with \"-mode\"" mode))
(put mode 'c-mode-prefix (match-string 1 (symbol-name mode)))
(unless (get base-mode 'c-mode-prefix)
(error "Unknown base mode `%s'" base-mode)
(put mode 'c-fallback-mode base-mode)))
(error "Unknown base mode `%s'" base-mode))
(put mode 'c-fallback-mode base-mode))
(defvar c-lang-constants (make-vector 151 0))
;; This obarray is a cache to keep track of the language constants
@ -1144,7 +1296,6 @@ system."
;; various other symbols, but those don't have any variable bindings.
(defvar c-lang-const-expansion nil)
(defvar c-langs-are-parametric nil)
(defsubst c-get-current-file ()
;; Return the base name of the current file.
@ -1585,6 +1736,22 @@ This macro does not do any hidden buffer changes."
c-lang-constants)))
(defun c-lang-major-mode-is (mode)
;; `c-major-mode-is' expands to a call to this function inside
;; `c-lang-defconst'. Here we also match the mode(s) against any
;; fallback modes for the one in `c-buffer-is-cc-mode', so that
;; e.g. (c-major-mode-is 'c++-mode) is true in a derived language
;; that has c++-mode as base mode.
(unless (listp mode)
(setq mode (list mode)))
(let (match (buf-mode c-buffer-is-cc-mode))
(while (if (memq buf-mode mode)
(progn
(setq match t)
nil)
(setq buf-mode (get buf-mode 'c-fallback-mode))))
match))
(cc-provide 'cc-defs)

292
lisp/progmodes/cc-engine.el
View file

@ -1270,7 +1270,7 @@ This function does not do any hidden buffer changes."
(when (and (= beg end)
(get-text-property beg 'c-in-sws)
(not (bobp))
(> beg (point-min))
(get-text-property (1- beg) 'c-in-sws))
;; Ensure that an `c-in-sws' range gets broken. Note that it isn't
;; safe to keep a range that was continuous before the change. E.g:
@ -1906,7 +1906,7 @@ This function does not do any hidden buffer changes."
(if last-pos
;; Prepare to loop, but record the open paren only if it's
;; outside a macro or within the same macro as point, and
;; if it is a "real" open paren and not some character
;; if it is a legitimate open paren and not some character
;; that got an open paren syntax-table property.
(progn
(setq pos last-pos)
@ -1914,7 +1914,11 @@ This function does not do any hidden buffer changes."
(save-excursion
(goto-char last-pos)
(not (c-beginning-of-macro))))
(= (char-syntax (char-before last-pos)) ?\())
;; Check for known types of parens that we want
;; to record. The syntax table is not to be
;; trusted here since the caller might be using
;; e.g. `c++-template-syntax-table'.
(memq (char-before last-pos) '(?{ ?\( ?\[)))
(setq c-state-cache (cons (1- last-pos) c-state-cache))))
(if (setq last-pos (c-up-list-forward pos))
@ -2124,7 +2128,7 @@ This function does not do any hidden buffer changes."
(when (c-major-mode-is 'pike-mode)
;; Handle the `<operator> syntax in Pike.
(let ((pos (point)))
(skip-chars-backward "!%&*+\\-/<=>^|~[]()")
(skip-chars-backward "-!%&*+/<=>^|~[]()")
(and (if (< (skip-chars-backward "`") 0)
t
(goto-char pos)
@ -2144,7 +2148,7 @@ This function does not do any hidden buffer changes."
(and (c-major-mode-is 'pike-mode)
;; Handle the `<operator> syntax in Pike.
(let ((pos (point)))
(if (and (< (skip-chars-backward "!%&*+\\-/<=>^|~[]()") 0)
(if (and (< (skip-chars-backward "-!%&*+/<=>^|~[]()") 0)
(< (skip-chars-backward "`") 0)
(looking-at c-symbol-key)
(>= (match-end 0) pos))
@ -2384,8 +2388,11 @@ outside any comment, macro or string literal, or else the content of
that region is taken as syntactically significant text.
If PAREN-LEVEL is non-nil, an additional restriction is added to
ignore matches in nested paren sexps, and the search will also not go
outside the current paren sexp.
ignore matches in nested paren sexps. The search will also not go
outside the current list sexp, which has the effect that if the point
should be moved to BOUND when no match is found \(i.e. NOERROR is
neither nil nor t), then it will be at the closing paren if the end of
the current list sexp is encountered first.
If NOT-INSIDE-TOKEN is non-nil, matches in the middle of tokens are
ignored. Things like multicharacter operators and special symbols
@ -2401,11 +2408,15 @@ subexpression is never tested before the starting position, so it
might be a good idea to include \\=\\= as a match alternative in it.
Optimization note: Matches might be missed if the \"look behind\"
subexpression should match the end of nonwhite syntactic whitespace,
subexpression can match the end of nonwhite syntactic whitespace,
i.e. the end of comments or cpp directives. This since the function
skips over such things before resuming the search. It's also not safe
to assume that the \"look behind\" subexpression never can match
syntactic whitespace."
skips over such things before resuming the search. It's on the other
hand not safe to assume that the \"look behind\" subexpression never
matches syntactic whitespace.
Bug: Unbalanced parens inside cpp directives are currently not handled
correctly \(i.e. they don't get ignored as they should) when
PAREN-LEVEL is set."
(or bound (setq bound (point-max)))
(if paren-level (setq paren-level -1))
@ -2413,53 +2424,55 @@ syntactic whitespace."
;;(message "c-syntactic-re-search-forward %s %s %S" (point) bound regexp)
(let ((start (point))
(pos (point))
tmp
;; Start position for the last search.
search-pos
;; The `parse-partial-sexp' state between the start position
;; and the point.
state
;; The current position after the last state update. The next
;; `parse-partial-sexp' continues from here.
(state-pos (point))
;; The position at which to check the state and the state
;; there. This is separate from `state-pos' since we might
;; need to back up before doing the next search round.
check-pos check-state
;; Last position known to end a token.
(last-token-end-pos (point-min))
match-pos found state check-pos check-state tmp)
;; Set when a valid match is found.
found)
(condition-case err
(while
(and
(re-search-forward regexp bound noerror)
(progn
(setq search-pos (point))
(re-search-forward regexp bound noerror))
(progn
(setq match-pos (point)
state (parse-partial-sexp
pos (match-beginning 0) paren-level nil state)
pos (point))
(setq state (parse-partial-sexp
state-pos (match-beginning 0) paren-level nil state)
state-pos (point))
(if (setq check-pos (and lookbehind-submatch
(or (not paren-level)
(>= (car state) 0))
(match-end lookbehind-submatch)))
(setq check-state (parse-partial-sexp
pos check-pos paren-level nil state))
(setq check-pos pos
state-pos check-pos paren-level nil state))
(setq check-pos state-pos
check-state state))
;; If we got a look behind subexpression and get an
;; insignificant match in something that isn't
;; NOTE: If we got a look behind subexpression and get
;; an insignificant match in something that isn't
;; syntactic whitespace (i.e. strings or in nested
;; parentheses), then we can never skip more than a
;; single character from the match position before
;; continuing the search. That since the look behind
;; subexpression might match the end of the
;; insignificant region.
;; single character from the match start position
;; (i.e. `state-pos' here) before continuing the
;; search. That since the look behind subexpression
;; might match the end of the insignificant region in
;; the next search.
(cond
((setq tmp (elt check-state 3))
;; Match inside a string.
(if (or lookbehind-submatch
(not (integerp tmp)))
(goto-char (min (1+ pos) bound))
;; Skip to the end of the string before continuing.
(let ((ender (make-string 1 tmp)) (continue t))
(while (if (search-forward ender bound noerror)
(progn
(setq state (parse-partial-sexp
pos (point) nil nil state)
pos (point))
(elt state 3))
(setq continue nil)))
continue)))
((elt check-state 7)
;; Match inside a line comment. Skip to eol. Use
;; `re-search-forward' instead of `skip-chars-forward' to get
@ -2472,6 +2485,7 @@ syntactic whitespace."
((and (not (elt check-state 5))
(eq (char-before check-pos) ?/)
(not (c-get-char-property (1- check-pos) 'syntax-table))
(memq (char-after check-pos) '(?/ ?*)))
;; Match in the middle of the opener of a block or line
;; comment.
@ -2479,6 +2493,67 @@ syntactic whitespace."
(re-search-forward "[\n\r]" bound noerror)
(search-forward "*/" bound noerror)))
;; The last `parse-partial-sexp' above might have
;; stopped short of the real check position if the end
;; of the current sexp was encountered in paren-level
;; mode. The checks above are always false in that
;; case, and since they can do better skipping in
;; lookbehind-submatch mode, we do them before
;; checking the paren level.
((and paren-level
(/= (setq tmp (car check-state)) 0))
;; Check the paren level first since we're short of the
;; syntactic checking position if the end of the
;; current sexp was encountered by `parse-partial-sexp'.
(if (> tmp 0)
;; Inside a nested paren sexp.
(if lookbehind-submatch
;; See the NOTE above.
(progn (goto-char state-pos) t)
;; Skip out of the paren quickly.
(setq state (parse-partial-sexp state-pos bound 0 nil state)
state-pos (point)))
;; Have exited the current paren sexp.
(if noerror
(progn
;; The last `parse-partial-sexp' call above
;; has left us just after the closing paren
;; in this case, so we can modify the bound
;; to leave the point at the right position
;; upon return.
(setq bound (1- (point)))
nil)
(signal 'search-failed (list regexp)))))
((setq tmp (elt check-state 3))
;; Match inside a string.
(if (or lookbehind-submatch
(not (integerp tmp)))
;; See the NOTE above.
(progn (goto-char state-pos) t)
;; Skip to the end of the string before continuing.
(let ((ender (make-string 1 tmp)) (continue t))
(while (if (search-forward ender bound noerror)
(progn
(setq state (parse-partial-sexp
state-pos (point) nil nil state)
state-pos (point))
(elt state 3))
(setq continue nil)))
continue)))
((save-excursion
(save-match-data
(c-beginning-of-macro start)))
;; Match inside a macro. Skip to the end of it.
(c-end-of-macro)
(cond ((<= (point) bound) t)
(noerror nil)
(t (signal 'search-failed (list regexp)))))
((and not-inside-token
(or (< check-pos last-token-end-pos)
(< check-pos
@ -2487,62 +2562,42 @@ syntactic whitespace."
(save-match-data
(c-end-of-current-token last-token-end-pos))
(setq last-token-end-pos (point))))))
;; Match inside a token.
(cond ((<= (point) bound)
(goto-char (min (1+ pos) bound))
t)
(noerror nil)
(t (signal 'search-failed "end of token"))))
((save-excursion
(save-match-data
(c-beginning-of-macro start)))
;; Match inside a macro. Skip to the end of it.
(c-end-of-macro)
(cond ((<= (point) bound) t)
(noerror nil)
(t (signal 'search-failed "end of macro"))))
((and paren-level
(/= (setq tmp (car check-state)) 0))
(if (> tmp 0)
;; Match inside a nested paren sexp.
(if lookbehind-submatch
(goto-char (min (1+ pos) bound))
;; Skip out of the paren quickly.
(setq state (parse-partial-sexp pos bound 0 nil state)
pos (point)))
;; Have exited the current paren sexp. The
;; `parse-partial-sexp' above has left us just after the
;; closing paren in this case. Just make
;; `re-search-forward' above fail in the appropriate way;
;; we'll adjust the leave off point below if necessary.
(setq bound (point))))
;; Inside a token.
(if lookbehind-submatch
;; See the NOTE above.
(goto-char state-pos)
(goto-char (min last-token-end-pos bound))))
(t
;; A real match.
(setq found t)
nil)))))
nil)))
;; Should loop to search again, but take care to avoid
;; looping on the same spot.
(or (/= search-pos (point))
(if (= (point) bound)
(if noerror
nil
(signal 'search-failed (list regexp)))
(forward-char)
t))))
(error
(goto-char start)
(signal (car err) (cdr err))))
;;(message "c-syntactic-re-search-forward done %s" (or match-pos (point)))
;;(message "c-syntactic-re-search-forward done %s" (or (match-end 0) (point)))
(if found
(progn
(goto-char match-pos)
match-pos)
(goto-char (match-end 0))
(match-end 0))
;; Search failed. Set point as appropriate.
(cond ((eq noerror t)
(goto-char start))
(paren-level
(if (eq (car (parse-partial-sexp pos bound -1 nil state)) -1)
(backward-char)))
(t
(goto-char bound)))
(if (eq noerror t)
(goto-char start)
(goto-char bound))
nil)))
(defun c-syntactic-skip-backward (skip-chars &optional limit)
@ -4030,12 +4085,13 @@ This function does not do any hidden buffer changes."
(defun c-forward-type ()
;; Move forward over a type spec if at the beginning of one,
;; stopping at the next following token. Return t if it's a known
;; type that can't be a name, 'known if it's an otherwise known type
;; (according to `*-font-lock-extra-types'), 'prefix if it's a known
;; prefix of a type, 'found if it's a type that matches one in
;; `c-found-types', 'maybe if it's an identfier that might be a
;; type, or nil if it can't be a type (the point isn't moved then).
;; The point is assumed to be at the beginning of a token.
;; type that can't be a name or other expression, 'known if it's an
;; otherwise known type (according to `*-font-lock-extra-types'),
;; 'prefix if it's a known prefix of a type, 'found if it's a type
;; that matches one in `c-found-types', 'maybe if it's an identfier
;; that might be a type, or nil if it can't be a type (the point
;; isn't moved then). The point is assumed to be at the beginning
;; of a token.
;;
;; Note that this function doesn't skip past the brace definition
;; that might be considered part of the type, e.g.
@ -4199,11 +4255,14 @@ This function does not do any hidden buffer changes."
;; don't let the existence of the operator itself promote two
;; uncertain types to a certain one.
(cond ((eq res t))
((or (eq res 'known) (memq res2 '(t known)))
((eq res2 t)
(c-add-type id-start id-end)
(when c-record-type-identifiers
(c-record-type-id id-range))
(setq res t))
((eq res 'known))
((eq res2 'known)
(setq res 'known))
((eq res 'found))
((eq res2 'found)
(setq res 'found))
@ -4526,7 +4585,8 @@ brace."
;; `c-beginning-of-statement-1' stops at a block start, but we
;; want to continue if the block doesn't begin a top level
;; construct, i.e. if it isn't preceded by ';', '}', ':', or bob.
;; construct, i.e. if it isn't preceded by ';', '}', ':', bob,
;; or an open paren.
(let ((beg (point)) tentative-move)
(while (and
;; Must check with c-opt-method-key in ObjC mode.
@ -4536,6 +4596,9 @@ brace."
(progn
(c-backward-syntactic-ws lim)
(not (memq (char-before) '(?\; ?} ?: nil))))
(save-excursion
(backward-char)
(not (looking-at "\\s(")))
;; Check that we don't move from the first thing in a
;; macro to its header.
(not (eq (setq tentative-move
@ -4972,33 +5035,44 @@ brace."
(condition-case ()
(save-excursion
(let ((beg (point))
end type)
inner-beg end type)
(c-forward-syntactic-ws)
(if (eq (char-after) ?\()
(progn
(forward-char 1)
(c-forward-syntactic-ws)
(setq inner-beg (point))
(setq type (assq (char-after) c-special-brace-lists)))
(if (setq type (assq (char-after) c-special-brace-lists))
(progn
(setq inner-beg (point))
(c-backward-syntactic-ws)
(forward-char -1)
(setq beg (if (eq (char-after) ?\()
(point)
nil)))))
(if (and beg type)
(if (and (c-safe (goto-char beg)
(if (and (c-safe
(goto-char beg)
(c-forward-sexp 1)
(setq end (point))
(= (char-before) ?\)))
(c-safe
(goto-char inner-beg)
(if (looking-at "\\s(")
;; Check balancing of the inner paren
;; below.
(progn
(c-forward-sexp 1)
(setq end (point))
(= (char-before) ?\)))
(c-safe (goto-char beg)
(forward-char 1)
(c-forward-sexp 1)
;; Kludges needed to handle inner
;; chars both with and without
;; paren syntax.
(or (/= (char-syntax (char-before)) ?\))
(= (char-before) (cdr type)))))
t)
;; If the inner char isn't a paren then
;; we can't check balancing, so just
;; check the char before the outer
;; closing paren.
(goto-char end)
(backward-char)
(c-backward-syntactic-ws)
(= (char-before) (cdr type)))))
(if (or (/= (char-syntax (char-before)) ?\))
(= (progn
(c-forward-syntactic-ws)
@ -6272,7 +6346,7 @@ This function does not do any hidden buffer changes."
(goto-char containing-sexp)
(setq placeholder (c-point 'boi))
(if (and (c-safe (backward-up-list 1) t)
(> (point) placeholder))
(>= (point) placeholder))
(progn
(forward-char)
(skip-chars-forward " \t"))
@ -6313,7 +6387,7 @@ This function does not do any hidden buffer changes."
(goto-char containing-sexp)
(setq placeholder (c-point 'boi))
(when (and (c-safe (backward-up-list 1) t)
(> (point) placeholder))
(>= (point) placeholder))
(forward-char)
(skip-chars-forward " \t")
(setq placeholder (point)))
@ -6354,7 +6428,7 @@ This function does not do any hidden buffer changes."
(goto-char containing-sexp)
(setq placeholder (c-point 'boi))
(if (and (c-safe (backward-up-list 1) t)
(> (point) placeholder))
(>= (point) placeholder))
(progn
(forward-char)
(skip-chars-forward " \t"))
@ -6830,6 +6904,10 @@ This function does not do any hidden buffer changes."
((vectorp offset) offset)
((null offset) nil)
((listp offset)
(if (eq (car offset) 'quote)
(error
"Setting in c-offsets-alist element \"(%s . '%s)\" was mistakenly quoted"
symbol (cadr offset)))
(let (done)
(while (and (not done) offset)
(setq done (c-evaluate-offset (car offset) langelem symbol)

114
lisp/progmodes/cc-fonts.el
View file

@ -574,33 +574,65 @@ casts and declarations are fontified. Used on level 2 and higher."
;; Fontify leading identifiers in fully qualified names like
;; "foo::bar" in languages that supports such things.
,@(when (c-lang-const c-opt-identifier-concat-key)
`((,(byte-compile
;; Must use a function here since we match longer
;; than we want to move before doing a new search.
;; This is not necessary for XEmacs >= 20 since it
;; restarts the search from the end of the first
;; highlighted submatch (something that causes
;; problems in other places).
`(lambda (limit)
(while (re-search-forward
,(concat "\\(\\<" ; 1
"\\(" (c-lang-const c-symbol-key) "\\)" ; 2
"[ \t\n\r\f\v]*"
(c-lang-const c-opt-identifier-concat-key)
"[ \t\n\r\f\v]*"
"\\)"
"\\("
(c-lang-const c-opt-after-id-concat-key)
"\\)")
limit t)
(unless (progn
(goto-char (match-beginning 0))
(c-skip-comments-and-strings limit))
(or (get-text-property (match-beginning 2) 'face)
(c-put-font-lock-face (match-beginning 2)
(match-end 2)
c-reference-face-name))
(goto-char (match-end 1)))))))))
(if (c-major-mode-is 'java-mode)
;; Java needs special treatment since "." is used both to
;; qualify names and in normal indexing. Here we look for
;; capital characters at the beginning of an identifier to
;; recognize the class. "*" is also recognized to cover
;; wildcard import declarations. All preceding dot separated
;; identifiers are taken as package names and therefore
;; fontified as references.
`(,(c-make-font-lock-search-function
;; Search for class identifiers preceded by ".". The
;; anchored matcher takes it from there.
(concat (c-lang-const c-opt-identifier-concat-key)
"[ \t\n\r\f\v]*"
(concat "\\("
"[" c-upper "][" (c-lang-const c-symbol-chars) "]*"
"\\|"
"\\*"
"\\)"))
`((let (id-end)
(goto-char (1+ (match-beginning 0)))
(while (and (eq (char-before) ?.)
(progn
(backward-char)
(c-backward-syntactic-ws)
(setq id-end (point))
(< (skip-chars-backward
,(c-lang-const c-symbol-chars)) 0))
(not (get-text-property (point) 'face)))
(c-put-font-lock-face (point) id-end c-reference-face-name)
(c-backward-syntactic-ws)))
nil
(goto-char (match-end 0)))))
`((,(byte-compile
;; Must use a function here since we match longer than we
;; want to move before doing a new search. This is not
;; necessary for XEmacs >= 20 since it restarts the search
;; from the end of the first highlighted submatch (something
;; that causes problems in other places).
`(lambda (limit)
(while (re-search-forward
,(concat "\\(\\<" ; 1
"\\(" (c-lang-const c-symbol-key) "\\)" ; 2
"[ \t\n\r\f\v]*"
(c-lang-const c-opt-identifier-concat-key)
"[ \t\n\r\f\v]*"
"\\)"
"\\("
(c-lang-const c-opt-after-id-concat-key)
"\\)")
limit t)
(unless (progn
(goto-char (match-beginning 0))
(c-skip-comments-and-strings limit))
(or (get-text-property (match-beginning 2) 'face)
(c-put-font-lock-face (match-beginning 2)
(match-end 2)
c-reference-face-name))
(goto-char (match-end 1))))))))))
;; Fontify the special declarations in Objective-C.
,@(when (c-major-mode-is 'objc-mode)
@ -787,17 +819,19 @@ casts and declarations are fontified. Used on level 2 and higher."
(<= (point) limit)
;; Search syntactically to the end of the declarator (";",
;; ",", ")", ">" (for <> arglists), eob etc) or to the
;; beginning of an initializer or function prototype ("="
;; or "\\s\(").
;; ",", a closen paren, eob etc) or to the beginning of an
;; initializer or function prototype ("=" or "\\s\(").
;; Note that the open paren will match array specs in
;; square brackets, and we treat them as initializers too.
(c-syntactic-re-search-forward
"[\];,\{\}\[\)>]\\|\\'\\|\\(=\\|\\(\\s\(\\)\\)" limit t t))
"[;,]\\|\\s)\\|\\'\\|\\(=\\|\\s(\\)" limit t t))
(setq next-pos (match-beginning 0)
id-face (if (match-beginning 2)
id-face (if (eq (char-after next-pos) ?\()
'font-lock-function-name-face
'font-lock-variable-name-face)
got-init (match-beginning 1))
got-init (and (match-beginning 1)
(char-after (match-beginning 1))))
(if types
;; Register and fontify the identifer as a type.
@ -828,9 +862,17 @@ casts and declarations are fontified. Used on level 2 and higher."
(goto-char limit)))
(got-init
;; Skip an initializer expression.
(if (c-syntactic-re-search-forward "[;,]" limit 'move t)
(backward-char)))
;; Skip an initializer expression. If we're at a '='
;; then accept a brace list directly after it to cope
;; with array initializers. Otherwise stop at braces
;; to avoid going past full function and class blocks.
(and (if (and (eq got-init ?=)
(= (c-forward-token-2) 0)
(looking-at "{"))
(c-safe (c-forward-sexp) t)
t)
(c-syntactic-re-search-forward "[;,{]" limit 'move t)
(backward-char)))
(t (c-forward-syntactic-ws limit)))

6
lisp/progmodes/cc-langs.el
View file

@ -374,6 +374,12 @@ identifiers, or nil in languages that don't have such things. Does
not contain a \\| operator at the top level."
t nil
c++ "::"
;; Java has "." to concatenate identifiers but it's also used for
;; normal indexing. There's special code in the Java font lock
;; rules to fontify qualified identifiers based on the standard
;; naming conventions. We still define "." here to make
;; `c-forward-name' move over as long names as possible which is
;; necessary to e.g. handle throws clauses correctly.
java "\\."
idl "::"
pike "\\(::\\|\\.\\)")

2
lisp/progmodes/cc-styles.el
View file

@ -355,6 +355,8 @@ when used elsewhere."
(completing-read prompt c-style-alist nil t
(cons c-indentation-style 0)
'c-set-style-history))))))
(or (stringp stylename)
(error "Argument to c-set-style was not a string"))
(c-initialize-builtin-style)
(let ((vars (c-get-style-variables stylename nil)))
(unless dont-override

146
lisp/progmodes/cc-vars.el
View file

@ -271,12 +271,12 @@ nil."
(defcustom c-tab-always-indent t
"*Controls the operation of the TAB key.
If t, hitting TAB always just indents the current line. If nil,
hitting TAB indents the current line if point is at the left margin or
in the line's indentation, otherwise it insert a `real' tab character
\(see note\). If the symbol `other', then tab is inserted only within
literals -- defined as comments and strings -- and inside preprocessor
directives, but the line is always reindented.
If t, hitting TAB always just indents the current line. If nil, hitting
TAB indents the current line if point is at the left margin or in the
line's indentation, otherwise it inserts a `real' tab character \(see
note\). If some other value (not nil or t), then tab is inserted only
within literals \(comments and strings), but the line is always
reindented.
Note: The value of `indent-tabs-mode' will determine whether a real
tab character will be inserted, or the equivalent number of spaces.
@ -1545,140 +1545,6 @@ Don't change this directly; call `c-set-style' instead.")
Set from `c-comment-prefix-regexp' at mode initialization.")
(make-variable-buffer-local 'c-current-comment-prefix)
;; Figure out what features this Emacs has
(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
(defconst c-emacs-features
(let (list)
(if (boundp 'infodock-version)
;; I've no idea what this actually is, but it's legacy. /mast
(setq list (cons 'infodock list)))
;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags.
;; Emacs 19 uses a 1-bit flag. We will have to set up our
;; syntax tables differently to handle this.
(let ((table (copy-syntax-table))
entry)
(modify-syntax-entry ?a ". 12345678" table)
(cond
;; XEmacs 19, and beyond Emacs 19.34
((arrayp table)
(setq entry (aref table ?a))
;; In Emacs, table entries are cons cells
(if (consp entry) (setq entry (car entry))))
;; XEmacs 20
((fboundp 'get-char-table) (setq entry (get-char-table ?a table)))
;; before and including Emacs 19.34
((and (fboundp 'char-table-p)
(char-table-p table))
(setq entry (car (char-table-range table [?a]))))
;; incompatible
(t (error "CC Mode is incompatible with this version of Emacs")))
(setq list (cons (if (= (logand (lsh entry -16) 255) 255)
'8-bit
'1-bit)
list)))
(let ((buf (generate-new-buffer " test"))
parse-sexp-lookup-properties
parse-sexp-ignore-comments
lookup-syntax-properties)
(save-excursion
(set-buffer buf)
(set-syntax-table (make-syntax-table))
;; For some reason we have to set some of these after the
;; buffer has been made current. (Specifically,
;; `parse-sexp-ignore-comments' in Emacs 21.)
(setq parse-sexp-lookup-properties t
parse-sexp-ignore-comments t
lookup-syntax-properties t)
;; Find out if the `syntax-table' text property works.
(modify-syntax-entry ?< ".")
(modify-syntax-entry ?> ".")
(insert "<()>")
(c-mark-<-as-paren 1)
(c-mark->-as-paren 4)
(goto-char 1)
(c-forward-sexp)
(if (= (point) 5)
(setq list (cons 'syntax-properties list)))
;; Find out if generic comment delimiters work.
(c-safe
(modify-syntax-entry ?x "!")
(if (string-match "\\s!" "x")
(setq list (cons 'gen-comment-delim list))))
;; Find out if generic string delimiters work.
(c-safe
(modify-syntax-entry ?x "|")
(if (string-match "\\s|" "x")
(setq list (cons 'gen-string-delim list))))
;; See if `open-paren-in-column-0-is-defun-start' exists and
;; isn't buggy.
(when (boundp 'open-paren-in-column-0-is-defun-start)
(let ((open-paren-in-column-0-is-defun-start nil)
(parse-sexp-ignore-comments t))
(set-syntax-table (make-syntax-table))
(modify-syntax-entry ?\' "\"")
(cond
;; XEmacs. Afaik this is currently an Emacs-only
;; feature, but it's good to be prepared.
((memq '8-bit list)
(modify-syntax-entry ?/ ". 1456")
(modify-syntax-entry ?* ". 23"))
;; Emacs
((memq '1-bit list)
(modify-syntax-entry ?/ ". 124b")
(modify-syntax-entry ?* ". 23")))
(modify-syntax-entry ?\n "> b")
(insert "/* '\n () */")
(backward-sexp)
(if (bobp)
(setq list (cons 'col-0-paren list))))
(kill-buffer buf))
(set-buffer-modified-p nil))
(kill-buffer buf))
;; See if `parse-partial-sexp' returns the eighth element.
(when (c-safe (>= (length (save-excursion (parse-partial-sexp 1 1))) 10))
(setq list (cons 'pps-extended-state list)))
;; See if POSIX char classes work.
(when (string-match "[[:alpha:]]" "a")
(setq list (cons 'posix-char-classes list)))
list)
"A list of certain features in the (X)Emacs you are using.
There are many flavors of Emacs out there, each with different
features supporting those needed by CC Mode. The following values
might be present:
'8-bit 8 bit syntax entry flags (XEmacs style).
'1-bit 1 bit syntax entry flags (Emacs style).
'syntax-properties It works to override the syntax for specific characters
in the buffer with the 'syntax-table property.
'gen-comment-delim Generic comment delimiters work
(i.e. the syntax class `!').
'gen-string-delim Generic string delimiters work
(i.e. the syntax class `|').
'pps-extended-state `parse-partial-sexp' returns a list with at least 10
elements, i.e. it contains the position of the
start of the last comment or string.
'posix-char-classes The regexp engine understands POSIX character classes.
'col-0-paren It's possible to turn off the ad-hoc rule that a paren
in column zero is the start of a defun.
'infodock This is Infodock (based on XEmacs).
'8-bit and '1-bit are mutually exclusive.")
(cc-provide 'cc-vars)

4
lisp/progmodes/compile.el
View file

@ -1101,7 +1101,9 @@ from a different message."
move point to the error message line and type \\[compile-goto-error].
To kill the compilation, type \\[kill-compilation].
Runs `compilation-mode-hook' with `run-hooks' (which see)."
Runs `compilation-mode-hook' with `run-hooks' (which see).
\\{compilation-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map compilation-mode-map)

2
lisp/progmodes/meta-mode.el
View file

@ -32,7 +32,7 @@
;; a major mode including an approriate syntax table, keymap, and a
;; mode-specific pull-down menu. It also provides a sophisticated set
;; of font-lock patterns, a fancy indentation function adapted from
;; AUC-TeX's latex.el, and some basic mode-specific editing functions
;; AUCTeX's latex.el, and some basic mode-specific editing functions
;; such as functions to move to the beginning or end of the enclosing
;; environment, or to mark, re-indent, or comment-out environments.
;; On the other hand, it doesn't yet provide any functionality for

7
lisp/progmodes/sh-script.el
View file

@ -353,6 +353,11 @@ the car and cdr are the same symbol.")
(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file))
"The shell being programmed. This is set by \\[sh-set-shell].")
(defvar sh-mode-abbrev-table nil)
(define-abbrev-table 'sh-mode-abbrev-table ())
;; I turned off this feature because it doesn't permit typing commands
;; in the usual way without help.
;;(defvar sh-abbrevs
@ -1483,7 +1488,7 @@ Calls the value of `sh-set-shell-hook' if set."
(setq require-final-newline tem)))
(setq
comment-start-skip "#+[\t ]*"
;;; local-abbrev-table (sh-feature sh-abbrevs)
local-abbrev-table sh-mode-abbrev-table
mode-line-process (format "[%s]" sh-shell)
sh-shell-variables nil
sh-shell-variables-initialized nil

2
lisp/progmodes/which-func.el
View file

@ -186,7 +186,7 @@ It creates the Imenu index for the buffer, if necessary."
(which-func-update-1 (selected-window)))
(defun which-func-update-1 (window)
"Update the Which-Function mode display for window WINDOW."
"Update the Which Function mode display for window WINDOW."
(with-selected-window window
(when which-func-mode
(condition-case info

63
lisp/ps-mule.el
View file

@ -204,69 +204,6 @@ Any other value is treated as nil."
(const bdf-font-except-latin) (const :tag "nil" nil))
:group 'ps-print-font)
(eval-and-compile
;; For Emacs 20.2 and the earlier version.
(if (and (boundp 'mule-version)
(not (string< (symbol-value 'mule-version) "4.0")))
;; mule package is loaded
(progn
(defalias 'ps-mule-next-point '1+)
(defalias 'ps-mule-chars-in-string 'length)
(defalias 'ps-mule-string-char 'aref)
(defsubst ps-mule-next-index (str i) (1+ i)))
;; mule package isn't loaded or mule version lesser than 4.0
(defun ps-mule-next-point (arg)
(save-excursion (goto-char arg) (forward-char 1) (point)))
(defun ps-mule-chars-in-string (string)
(/ (length string)
(charset-bytes (char-charset (string-to-char string)))))
(defun ps-mule-string-char (string idx)
(string-to-char (substring string idx)))
(defun ps-mule-next-index (string i)
(+ i (charset-bytes (char-charset (string-to-char string)))))
)
(if (boundp 'mule-version)
;; For Emacs 20.4 and the earlier version.
(if (string< (symbol-value 'mule-version) "5.0")
;; mule package is loaded and mule version is lesser than 5.0
(progn
(defun encode-composition-rule (rule)
(if (= (car rule) 4) (setcar rule 10))
(if (= (cdr rule) 4) (setcdr rule 10))
(+ (* (car rule) 12) (cdr rule)))
(defun ps-mule-search-composition (from to)
(save-excursion
(goto-char from)
(search-forward "\200" to t)))
(defun ps-mule-get-composition (pos)
(let ((ch (char-after pos)))
(and ch (eq (char-charset ch) 'composition)
(let ((components
(decompose-composite-char ch 'vector t)))
(list pos (ps-mule-next-point pos) components
(integerp (aref components 1)) nil
(char-width ch)))))))
(defun ps-mule-search-composition (from to)
(let (cmp-info)
(while (and (< from to)
(setq cmp-info (find-composition from to))
(not (nth 2 cmp-info)))
(setq from (nth 1 cmp-info)))
(< from to)))
(defun ps-mule-get-composition (pos)
(find-composition pos nil nil t)))
;; mule package isn't loaded
(or (fboundp 'encode-composition-rule)
(defun encode-composition-rule (rule)
130))
(defun ps-mule-search-composition (&rest ignore)
nil)
(defun ps-mule-get-composition (&rest ignore)
nil)
))
(defvar ps-mule-font-info-database
nil
"Alist of charsets with the corresponding font information.

18
lisp/simple.el
View file

@ -1628,7 +1628,7 @@ and only used if a buffer is displayed."
(defun shell-command-on-region (start end command
&optional output-buffer replace
error-buffer)
error-buffer display-error-buffer)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it. Return the exit code of
@ -1641,10 +1641,10 @@ is encoded in the same coding system that will be used to save the file,
`buffer-file-coding-system'. If the output is going to replace the region,
then it is decoded from that same coding system.
The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
systems by binding `coding-system-for-read' and
`coding-system-for-write'.
The noninteractive arguments are START, END, COMMAND,
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
If the command generates output, the output may be displayed
in the echo area or in a buffer.
@ -1674,6 +1674,8 @@ around it.
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
were any errors. (This is always t, interactively.)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive (let (string)
@ -1691,7 +1693,8 @@ specifies the value of ERROR-BUFFER."
string
current-prefix-arg
current-prefix-arg
shell-command-default-error-buffer)))
shell-command-default-error-buffer
t)))
(let ((error-file
(if error-buffer
(make-temp-file
@ -1800,7 +1803,8 @@ specifies the value of ERROR-BUFFER."
(format-insert-file error-file nil)
;; Put point after the inserted errors.
(goto-char (- (point-max) pos-from-end)))
(display-buffer (current-buffer))))
(and display-error-buffer
(display-buffer (current-buffer)))))
(delete-file error-file))
exit-status))

102
lisp/speedbar.el
View file

@ -92,7 +92,7 @@
;; into sub-lists. A long flat list can be used instead if needed.
;; Other filters can be easily added.
;;
;; AUC-TEX users: The imenu tags for AUC-TEX mode doesn't work very
;; AUCTEX users: The imenu tags for AUCTEX mode doesn't work very
;; well. Use the imenu keywords from tex-mode.el for better results.
;;
;; This file requires the library package assoc (association lists)
@ -665,6 +665,9 @@ useful, such as version control."
"*Regexp matching files we don't want displayed in a speedbar buffer.
It is generated from the variable `completion-ignored-extensions'")
;; Compiler silencing trick. The real defvar comes later in this file.
(defvar speedbar-file-regexp)
;; this is dangerous to customize, because the defaults will probably
;; change in the future.
(defcustom speedbar-supported-extension-expressions
@ -689,8 +692,7 @@ file."
:type '(repeat (regexp :tag "Extension Regexp"))
:set (lambda (sym val)
(setq speedbar-supported-extension-expressions val
speedbar-file-regexp (speedbar-extension-list-to-regex val)))
)
speedbar-file-regexp (speedbar-extension-list-to-regex val))))
(defvar speedbar-file-regexp
(speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
@ -698,6 +700,15 @@ file."
Created from `speedbar-supported-extension-expression' with the
function `speedbar-extension-list-to-regex'")
(defcustom speedbar-scan-subdirs nil
"*Non-nil means speedbar will check if subdirs are empty.
That way you don't have to click on them to find out. But this
incurs extra I/O, hence it slows down directory display
proportionally to the number of subdirs."
:group 'speedbar
:type 'boolean
:version 21.4)
(defun speedbar-add-supported-extension (extension)
"Add EXTENSION as a new supported extension for speedbar tagging.
This should start with a `.' if it is not a complete file name, and
@ -1287,8 +1298,9 @@ in the selected file.
(toggle-read-only 1)
(speedbar-set-mode-line-format)
(if speedbar-xemacsp
(set (make-local-variable 'mouse-motion-handler)
'speedbar-track-mouse-xemacs)
(with-no-warnings
(set (make-local-variable 'mouse-motion-handler)
'speedbar-track-mouse-xemacs))
(if speedbar-track-mouse-flag
(set (make-local-variable 'track-mouse) t)) ;this could be messy.
(setq auto-show-mode nil)) ;no auto-show for Emacs
@ -1337,7 +1349,8 @@ This gives visual indications of what is up. It EXPECTS the speedbar
frame and window to be the currently active frame and window."
(if (and (frame-live-p speedbar-frame)
(or (not speedbar-xemacsp)
(specifier-instance has-modeline-p)))
(with-no-warnings
(specifier-instance has-modeline-p))))
(save-excursion
(set-buffer speedbar-buffer)
(let* ((w (or (speedbar-frame-width) 20))
@ -1538,9 +1551,7 @@ Must be bound to event E."
;; This gets the cursor where the user can see it.
(if (not (bolp)) (forward-char -1))
(sit-for 0)
(if (< emacs-major-version 20)
(mouse-major-mode-menu e)
(mouse-major-mode-menu e nil))))
(mouse-major-mode-menu e nil)))
(defun speedbar-hack-buffer-menu (e)
"Control mouse 1 is buffer menu.
@ -2185,21 +2196,17 @@ the file-system."
;; find the directory, either in the cache, or build it.
(or (cdr-safe (assoc directory speedbar-directory-contents-alist))
(let ((default-directory directory)
(dir (directory-files directory nil))
(dirs nil)
(files nil))
(while dir
(if (not
(or (string-match speedbar-file-unshown-regexp (car dir))
(string-match speedbar-directory-unshown-regexp (car dir))))
(if (file-directory-p (car dir))
(setq dirs (cons (car dir) dirs))
(setq files (cons (car dir) files))))
(setq dir (cdr dir)))
(let ((nl (cons (nreverse dirs) (list (nreverse files)))))
(case-fold-search read-file-name-completion-ignore-case)
dirs files)
(dolist (file (directory-files directory nil))
(or (string-match speedbar-file-unshown-regexp file)
(string-match speedbar-directory-unshown-regexp file)
(if (file-directory-p file)
(setq dirs (cons file dirs))
(setq files (cons file files)))))
(let ((nl `(,(nreverse dirs) ,(nreverse files))))
(aput 'speedbar-directory-contents-alist directory nl)
nl))
))
nl))))
(defun speedbar-directory-buttons (directory index)
"Insert a single button group at point for DIRECTORY.
@ -2343,34 +2350,40 @@ position to insert a new item, and that the new item will end with a CR."
;;; Build button lists
;;
(defun speedbar-insert-files-at-point (files level)
(defun speedbar-insert-files-at-point (files level directory)
"Insert list of FILES starting at point, and indenting all files to LEVEL.
Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
don't know how to manage them. The input parameter FILES is a cons
cell of the form ( 'DIRLIST . 'FILELIST )."
;; Start inserting all the directories
(let ((dirs (car files)))
(while dirs
(speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
(car dirs) 'speedbar-dir-follow nil
'speedbar-directory-face level)
(setq dirs (cdr dirs))))
(let ((lst (car (cdr files)))
(case-fold-search t))
(while lst
(let* ((known (string-match speedbar-file-regexp (car lst)))
(dolist (dir (car files))
(if (if speedbar-scan-subdirs
(condition-case nil
(let ((l (speedbar-file-lists (concat directory dir))))
(or (car l) (cadr l)))
(file-error))
(file-readable-p (concat directory dir)))
(speedbar-make-tag-line 'angle ?+ 'speedbar-dired dir
dir 'speedbar-dir-follow nil
'speedbar-directory-face level)
(speedbar-make-tag-line 'angle ? nil dir
dir 'speedbar-dir-follow nil
'speedbar-directory-face level)))
(let ((case-fold-search read-file-name-completion-ignore-case))
(dolist (file (cadr files))
(let* ((known (and (file-readable-p (concat directory file))
(string-match speedbar-file-regexp file)))
(expchar (if known ?+ ??))
(fn (if known 'speedbar-tag-file nil)))
(if (or speedbar-show-unknown-files (/= expchar ??))
(speedbar-make-tag-line 'bracket expchar fn (car lst)
(car lst) 'speedbar-find-file nil
'speedbar-file-face level)))
(setq lst (cdr lst)))))
(speedbar-make-tag-line 'bracket expchar fn file
file 'speedbar-find-file nil
'speedbar-file-face level))))))
(defun speedbar-default-directory-list (directory index)
"Insert files for DIRECTORY with level INDEX at point."
(speedbar-insert-files-at-point
(speedbar-file-lists directory) index)
(speedbar-file-lists directory) index directory)
(speedbar-reset-scanners)
(if (= index 0)
;; If the shown files variable has extra directories, then
@ -2918,7 +2931,7 @@ updated."
(newcf (if newcfd newcfd))
(lastb (current-buffer))
(sucf-recursive (boundp 'sucf-recursive))
(case-fold-search t))
(case-fold-search read-file-name-completion-ignore-case))
(if (and newcf
;; check here, that way we won't refresh to newcf until
;; its been written, thus saving ourselves some time
@ -4235,9 +4248,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
(speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
'buffer)
(error nil))
,docstring))
)))
,docstring)))))
(defimage-speedbar speedbar-directory-plus
((:type xpm :file "sb-dir-plus.xpm" :ascent center))
@ -4247,6 +4258,10 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
((:type xpm :file "sb-dir-minus.xpm" :ascent center))
"Image used for open directories with stuff in them.")
(defimage-speedbar speedbar-directory
((:type xpm :file "sb-dir.xpm" :ascent center))
"Image used for empty or unreadable directories.")
(defimage-speedbar speedbar-page-plus
((:type xpm :file "sb-pg-plus.xpm" :ascent center))
"Image used for closed files with stuff in them.")
@ -4290,6 +4305,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
(defvar speedbar-expand-image-button-alist
'(("<+>" . speedbar-directory-plus)
("<->" . speedbar-directory-minus)
("< >" . speedbar-directory)
("[+]" . speedbar-page-plus)
("[-]" . speedbar-page-minus)
("[?]" . speedbar-page)

57
lisp/startup.el
View file

@ -220,7 +220,7 @@ Setting `init-file-user' does not prevent Emacs from loading
"File containing site-wide run-time initializations.
This file is loaded at run-time before `~/.emacs'. It contains inits
that need to be in place for the entire site, but which, due to their
higher incidence of change, don't make sense to load into emacs'
higher incidence of change, don't make sense to load into Emacs's
dumped image. Thus, the run-time load order is: 1. file described in
this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
@ -293,8 +293,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(let* ((this-dir (car dirs))
(contents (directory-files this-dir))
(default-directory this-dir)
(canonicalized (and (eq system-type 'windows-nt)
(untranslated-canonical-name this-dir))))
(canonicalized (if (fboundp 'untranslated-canonical-name)
(untranslated-canonical-name this-dir))))
;; The Windows version doesn't report meaningful inode
;; numbers, so use the canonicalized absolute file name of the
;; directory instead.
@ -343,12 +343,14 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; Give *Messages* the same default-directory as *scratch*,
;; just to keep things predictable.
(let ((dir default-directory))
(save-excursion
(set-buffer (get-buffer "*Messages*"))
(with-current-buffer "*Messages*"
(setq default-directory dir)))
;; `user-full-name' is now known; reset its standard-value here.
(put 'user-full-name 'standard-value
(list (default-value 'user-full-name)))
;; Subprocesses of Emacs do not have direct access to the terminal,
;; so unless told otherwise they should only assume a dumb terminal.
(setenv "TERM" "dumb")
;; For root, preserve owner and group when editing files.
(if (equal (user-uid) 0)
(setq backup-by-copying-when-mismatch t))
@ -357,32 +359,25 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; of that dir into load-path,
;; Look for a leim-list.el file too. Loading it will register
;; available input methods.
(let ((tail load-path)
new)
(while tail
(push (car tail) new)
(condition-case nil
(let ((default-directory (car tail)))
(load (expand-file-name "subdirs.el" (car tail)) t t t)))
(condition-case nil
(let ((default-directory (car tail)))
(load (expand-file-name "leim-list.el" (car tail)) t t t)))
(setq tail (cdr tail))))
(if (not (eq system-type 'vax-vms))
(progn
;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD")))
(and (stringp pwd)
;; Use FOO/., so that if FOO is a symlink, file-attributes
;; describes the directory linked to, not FOO itself.
(or (equal (file-attributes
(concat (file-name-as-directory pwd) "."))
(file-attributes
(concat (file-name-as-directory default-directory)
".")))
(setq process-environment
(delete (concat "PWD=" pwd)
process-environment)))))))
(dolist (dir load-path)
(let ((default-directory dir))
(load (expand-file-name "subdirs.el") t t t))
(let ((default-directory dir))
(load (expand-file-name "leim-list.el") t t t)))
(unless (eq system-type 'vax-vms)
;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD")))
(and (stringp pwd)
;; Use FOO/., so that if FOO is a symlink, file-attributes
;; describes the directory linked to, not FOO itself.
(or (equal (file-attributes
(concat (file-name-as-directory pwd) "."))
(file-attributes
(concat (file-name-as-directory default-directory)
".")))
(setq process-environment
(delete (concat "PWD=" pwd)
process-environment))))))
(setq default-directory (abbreviate-file-name default-directory))
(let ((menubar-bindings-done nil))
(unwind-protect

2
lisp/subr.el
View file

@ -1196,7 +1196,7 @@ Optional args SENTINEL and FILTER specify the sentinel and filter
(make-obsolete 'process-kill-without-query
"use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
"21.5")
"21.4")
(defun process-kill-without-query (process &optional flag)
"Say no query needed if PROCESS is running when Emacs is exited.
Optional second argument if non-nil says to require a query.

9
lisp/term.el
View file

@ -705,18 +705,18 @@ Buffer local variable.")
;;; faces -mm
(defcustom term-default-fg-color nil
(defcustom term-default-fg-color 'unspecified
"Default color for foreground in `term'."
:group 'term
:type 'string)
(defcustom term-default-bg-color nil
(defcustom term-default-bg-color 'unspecified
"Default color for background in `term'."
:group 'term
:type 'string)
(defvar ansi-term-color-vector
[nil "black" "red" "green" "yellow" "blue"
[unspecified "black" "red" "green" "yellow" "blue"
"magenta" "cyan" "white"])
;;; Inspiration came from comint.el -mm
@ -3078,8 +3078,7 @@ See `term-prompt-regexp'."
(setq term-current-face
(append '(:underline t) term-current-face))))))
; (message "Debug %S" term-current-face)
;;; (message "Debug %S" term-current-face)
(setq term-ansi-face-already-done 0))

3
lisp/term/x-win.el
View file

@ -2213,7 +2213,8 @@ order until succeed.")
(if utf8
(setq text (x-select-utf8-or-ctext utf8 ctext))
;; Othewise, choose CTEXT.
(setq text ctext))))
(setq text ctext))
(setq text utf8)))
;; If not yet decided, try STRING.
(or text
(setq text (condition-case nil

11
lisp/textmodes/flyspell.el
View file

@ -1011,8 +1011,7 @@ Mostly we check word delimiters."
(concat "^" word "\n"))
;; we mark the ispell process so it can be killed
;; when emacs is exited without query
(if (fboundp 'process-kill-without-query)
(process-kill-without-query ispell-process))
(set-process-query-on-exit-flag ispell-process nil)
;; wait until ispell has processed word
(while (progn
(accept-process-output ispell-process)
@ -1065,7 +1064,7 @@ Mostly we check word delimiters."
flyspell-duplicate-distance)
t)))))
(if flyspell-highlight-flag
(flyspell-highlight-duplicate-region start end)
(flyspell-highlight-duplicate-region start end poss)
(message (format "duplicate `%s'" word))))
(t
;; incorrect highlight the location
@ -1540,8 +1539,9 @@ for the overlay."
;*---------------------------------------------------------------------*/
;* flyspell-highlight-duplicate-region ... */
;*---------------------------------------------------------------------*/
(defun flyspell-highlight-duplicate-region (beg end)
"Set up an overlay on a duplicated word, in the buffer from BEG to END."
(defun flyspell-highlight-duplicate-region (beg end poss)
"Set up an overlay on a duplicated word, in the buffer from BEG to END.
??? What does POSS mean?"
(let ((inhibit-read-only t))
(unless (run-hook-with-args-until-success
'flyspell-incorrect-hook beg end poss)
@ -1947,7 +1947,6 @@ The word checked is the word at the mouse position."
mouse-pos
(set-mouse-position (car mouse-pos)
(/ (frame-width) 2) 2)
(unfocus-frame)
(mouse-position))))
(setq event (list (list (car (cdr mouse-pos))
(1+ (cdr (cdr mouse-pos))))

2
lisp/textmodes/reftex-auc.el
View file

@ -1,4 +1,4 @@
;;; reftex-auc.el --- RefTeX's interface to AUC TeX
;;; reftex-auc.el --- RefTeX's interface to AUCTeX
;; Copyright (c) 1997, 1998, 1999, 2000, 2003 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>

15
lisp/textmodes/tex-mode.el
View file

@ -1141,10 +1141,13 @@ on the line for the invalidity you want to see."
'occur-target tem)))))
(goto-char prev-end))))
(with-current-buffer standard-output
(if (eq num-matches 0)
(insert "None!\n"))
(if (interactive-p)
(message "%d mismatches found" num-matches))))))
(let ((no-matches (zerop num-matches)))
(if no-matches
(insert "None!\n"))
(if (interactive-p)
(message "%s mismatch%s found"
(if no-matches "No" num-matches)
(if (> num-matches 1) "es" ""))))))))
(defun tex-validate-region (start end)
"Check for mismatched braces or $'s in region.
@ -1459,7 +1462,7 @@ Mark is left at original location."
nil)
(let ((proc (get-process "tex-shell")))
(set-process-sentinel proc 'tex-shell-sentinel)
(process-kill-without-query proc)
(set-process-query-on-exit-flag proc nil)
(tex-shell)
(while (zerop (buffer-size))
(sleep-for 1)))))
@ -1928,7 +1931,7 @@ for the error messages."
(re-search-forward
"^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move))
(let* ((this-error (copy-marker begin-of-error))
(linenum (string-to-int (match-string 1)))
(linenum (string-to-number (match-string 1)))
(error-text (regexp-quote (match-string 3)))
(filename
(save-excursion

13
lisp/vc-svn.el
View file

@ -1,6 +1,7 @@
;;; vc-svn.el --- non-resident support for Subversion version-control
;; Copyright (C) 1995,98,99,2000,2001,02,2003 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@ -363,7 +364,10 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(append (vc-switches nil 'diff) '("/dev/null")))
;; Even if it's empty, it's locally modified.
1)
(let* ((switches (vc-switches 'SVN 'diff))
(let* ((switches
(if vc-svn-diff-switches
(vc-switches 'SVN 'diff)
(list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
(async (and (vc-stay-local-p file)
(or oldvers newvers) ; Svn diffs those locally.
(fboundp 'start-process))))
@ -371,8 +375,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(if async 'async 0)
file "diff"
(append
(when switches
(list "-x" (mapconcat 'identity switches " ")))
switches
(when oldvers
(list "-r" (if newvers (concat oldvers ":" newvers)
oldvers)))))
@ -504,5 +507,5 @@ essential information."
(provide 'vc-svn)
;;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
;;; vc-svn.el ends here

3
lisp/whitespace.el
View file

@ -819,6 +819,9 @@ If timer is not set, then set it to scan the files in
(disable-timeout whitespace-rescan-timer)
(setq whitespace-rescan-timer nil))))
;;;###autoload
(defalias 'global-whitespace-mode 'whitespace-global-mode)
;;;###autoload
(define-minor-mode whitespace-global-mode
"Toggle using Whitespace mode in new buffers.

30
lispref/ChangeLog
View file

@ -1,3 +1,33 @@
2004-08-22 Richard M. Stallman <rms@gnu.org>
* modes.texi (Major Mode Conventions): Discuss rebinding of
standard key bindings.
2004-08-18 Kim F. Storm <storm@cua.dk>
* processes.texi (Accepting Output): Add `just-this-one' arg to
`accept-process-output'.
(Output from Processes): New var `process-adaptive-read-buffering'.
2004-08-10 Luc Teirlinck <teirllm@auburn.edu>
* keymaps.texi: Various changes in addition to:
(Keymap Terminology): `kbd' uses same syntax as Edit Macro mode.
Give more varied examples for `kbd'.
(Creating Keymaps): Char tables have slots for all characters
without modifiers.
(Active Keymaps): `overriding-local-map' and
`overriding-terminal-local-map' also override text property and
overlay keymaps.
(Functions for Key Lookup): Mention OLP arg to `current-active-maps'.
(Scanning Keymaps): `accessible-keymaps' uses `[]' instead of `""'
to denote a prefix of no events.
`map-keymap' includes parent's bindings _recursively_.
Clarify and correct description of `where-is-internal'.
Mention BUFFER-OR-NAME arg to `describe-bindings'.
(Menu Example): For menus intended for use with the keyboard, the
menu items should be bound to characters or real function keys.
2004-08-08 Luc Teirlinck <teirllm@auburn.edu>
* objects.texi (Character Type): Reposition `@anchor' to prevent

96
lispref/keymaps.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1998, 1999, 2000
@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1998, 1999, 2000, 2004
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/keymaps
@ -103,16 +103,19 @@ representation; it is also convenient to use @code{kbd}:
This macro converts the text @var{keyseq-text} (a string constant)
into a key sequence (a string or vector constant). The contents
of @var{keyseq-text} should describe the key sequence using the syntax
used in this manual:
used in this manual. More precisely, it uses the same syntax that
Edit Macro mode uses for editing keyboard macros (@pxref{Edit Keyboard
Macro,,, emacs, The GNU Emacs Manual}).
@example
(kbd "C-x") @result{} "\C-x"
(kbd "C-x C-f") @result{} "\C-x\C-f"
(kbd "C-c C-c") @result{} "\C-c\C-c"
(kbd "C-x 4 C-f") @result{} "\C-x4\C-f"
(kbd "X") @result{} "X"
(kbd "RET") @result{} "\^M"
(kbd "C-c 3") @result{} "\C-c3"
(kbd "C-c SPC") @result{} "\C-c@ "
(kbd "<f1> SPC") @result{} [f1 32]
(kbd "C-M-<down>") @result{} [C-M-down]
@end example
@end defmac
@ -144,7 +147,8 @@ This specifies a @dfn{default key binding}; any event not bound by other
elements of the keymap is given @var{binding} as its binding. Default
bindings allow a keymap to bind all possible event types without having
to enumerate all of them. A keymap that has a default binding
completely masks any lower-precedence keymap.
completely masks any lower-precedence keymap, except for events
explicitly bound to @code{nil} (see below).
@item @var{char-table}
If an element of a keymap is a char-table, it counts as holding
@ -251,17 +255,15 @@ satisfies @code{keymapp}.
@c ??? This should come after make-sparse-keymap
@defun make-keymap &optional prompt
This function creates and returns a new full keymap. That keymap
contains a char-table (@pxref{Char-Tables}) with 384 slots: the first
128 slots are for defining all the @acronym{ASCII} characters, the next 128
slots are for 8-bit European characters, and each one of the final 128
slots is for one character set of non-@acronym{ASCII} characters supported by
Emacs. The new keymap initially binds all these characters to
@code{nil}, and does not bind any other kind of event.
contains a char-table (@pxref{Char-Tables}) with slots for all
characters without modifiers. The new keymap initially binds all
these characters to @code{nil}, and does not bind any other kind of
event.
@example
@group
(make-keymap)
@result{} (keymap [nil nil nil @dots{} nil nil])
@result{} (keymap #^[t nil nil nil @dots{} nil nil keymap])
@end group
@end example
@ -509,6 +511,7 @@ active keymap.
@defun define-prefix-command symbol &optional mapvar prompt
@cindex prefix command
@anchor{Definition of define-prefix-command}
This function prepares @var{symbol} for use as a prefix key's binding:
it creates a sparse keymap and stores it as @var{symbol}'s function
definition. Subsequently binding a key sequence to @var{symbol} will
@ -698,15 +701,16 @@ all buffers.
@defvar overriding-local-map
If non-@code{nil}, this variable holds a keymap to use instead of the
buffer's local keymap and instead of all the minor mode keymaps. This
keymap, if any, overrides all other maps that would have been active,
except for the current global map.
buffer's local keymap, text property or overlay keymaps, and instead
of all the minor mode keymaps. This keymap, if any, overrides all
other maps that would have been active, except for the current global
map.
@end defvar
@defvar overriding-terminal-local-map
If non-@code{nil}, this variable holds a keymap to use instead of
@code{overriding-local-map}, the buffer's local keymap and all the minor
mode keymaps.
@code{overriding-local-map}, the buffer's local keymap, text property
or overlay keymaps, and all the minor mode keymaps.
This variable is always local to the current terminal and cannot be
buffer-local. @xref{Multiple Displays}. It is used to implement
@ -977,9 +981,12 @@ An error is signaled if @var{key} is not a string or a vector.
@end example
@end defun
@defun current-active-maps
@defun current-active-maps &optional olp
This returns the list of keymaps that would be used by the command
loop in the current circumstances to look up a key sequence.
loop in the current circumstances to look up a key sequence. Normally
it ignores @code{overriding-local-map} and
@code{overriding-terminal-local-map}, but if @var{olp} is
non-@code{nil} then it pays attention to them.
@end defun
@defun local-key-binding key &optional accept-defaults
@ -1191,7 +1198,7 @@ changing the bindings of both @kbd{C-p C-f} and @kbd{C-x C-f} in the
default global map.
The function @code{substitute-key-definition} scans a keymap for
keys that have a certain binding and rebind them with a different
keys that have a certain binding and rebinds them with a different
binding. Another feature you can use for similar effects, but which
is often cleaner, is to add a binding that remaps a command
(@pxref{Remapping Commands}).
@ -1324,7 +1331,7 @@ this by making these two command-remapping bindings in its keymap:
Whenever @code{my-mode-map} is an active keymap, if the user types
@kbd{C-k}, Emacs will find the standard global binding of
@code{kill-line} (assuming nobody has changed it). But
@code{my-mode-map} remaps @code{kill-line} to @code{my-mode-map},
@code{my-mode-map} remaps @code{kill-line} to @code{my-kill-line},
so instead of running @code{kill-line}, Emacs runs
@code{my-kill-line}.
@ -1337,15 +1344,16 @@ Remapping only works through a single level. In other words,
@noindent
does not have the effect of remapping @code{kill-line} into
@code{my-other-kill-line}. If an ordinary key binding specifies
@code{my-other-kill-line}. If an ordinary key binding specifies
@code{kill-line}, this keymap will remap it to @code{my-kill-line};
if an ordinary binding specifies @code{my-kill-line}, this keymap will
remap it to @code{my-other-kill-line}.
@defun command-remapping command
This function returns the remapping for @var{command}, given the
current active keymaps. If @var{command} is not remapped (which is
the usual situation), the function returns @code{nil}.
This function returns the remapping for @var{command} (a symbol),
given the current active keymaps. If @var{command} is not remapped
(which is the usual situation), or not a symbol, the function returns
@code{nil}.
@end defun
@node Key Binding Commands
@ -1409,7 +1417,7 @@ actually bind the multibyte character with code 2294, not the unibyte
Latin-1 character with code 246 (@kbd{M-v}). In order to use this
binding, you need to enter the multibyte Latin-1 character as keyboard
input. One way to do this is by using an appropriate input method
(@pxref{Input Methods, , Input Methods, emacs,The GNU Emacs Manual}).
(@pxref{Input Methods, , Input Methods, emacs, The GNU Emacs Manual}).
If you want to use a unibyte character in the key binding, you can
construct the key sequence string using @code{multibyte-char-to-unibyte}
@ -1499,7 +1507,7 @@ association list with elements of the form @code{(@var{key} .@:
@var{keymap} is @var{map}.
The elements of the alist are ordered so that the @var{key} increases
in length. The first element is always @code{("" .@: @var{keymap})},
in length. The first element is always @code{([] .@: @var{keymap})},
because the specified keymap is accessible from itself with a prefix of
no events.
@ -1517,7 +1525,7 @@ definition is the sparse keymap @code{(keymap (83 .@: center-paragraph)
@smallexample
@group
(accessible-keymaps (current-local-map))
@result{}(("" keymap
@result{}(([] keymap
(27 keymap ; @r{Note this keymap for @key{ESC} is repeated below.}
(83 . center-paragraph)
(115 . center-line))
@ -1541,7 +1549,7 @@ of a window.
@smallexample
@group
(accessible-keymaps (current-global-map))
@result{} (("" keymap [set-mark-command beginning-of-line @dots{}
@result{} (([] keymap [set-mark-command beginning-of-line @dots{}
delete-backward-char])
@end group
@group
@ -1572,6 +1580,8 @@ The function @code{map-keymap} calls @var{function} once
for each binding in @var{keymap}. It passes two arguments,
the event type and the value of the binding. If @var{keymap}
has a parent, the parent's bindings are included as well.
This works recursively: if the parent has itself a parent, then the
grandparent's bindings are also included and so on.
This function is the cleanest way to examine all the bindings
in a keymap.
@ -1580,7 +1590,7 @@ in a keymap.
@defun where-is-internal command &optional keymap firstonly noindirect no-remap
This function is a subroutine used by the @code{where-is} command
(@pxref{Help, , Help, emacs,The GNU Emacs Manual}). It returns a list
of key sequences (of any length) that are bound to @var{command} in a
of all key sequences (of any length) that are bound to @var{command} in a
set of keymaps.
The argument @var{command} can be any object; it is compared with all
@ -1588,7 +1598,7 @@ keymap entries using @code{eq}.
If @var{keymap} is @code{nil}, then the maps used are the current active
keymaps, disregarding @code{overriding-local-map} (that is, pretending
its value is @code{nil}). If @var{keymap} is non-@code{nil}, then the
its value is @code{nil}). If @var{keymap} is a keymap, then the
maps searched are @var{keymap} and the global keymap. If @var{keymap}
is a list of keymaps, only those keymaps are searched.
@ -1598,11 +1608,12 @@ keymaps that are active. To search only the global map, pass
@code{(keymap)} (an empty keymap) as @var{keymap}.
If @var{firstonly} is @code{non-ascii}, then the value is a single
string representing the first key sequence found, rather than a list of
vector representing the first key sequence found, rather than a list of
all possible key sequences. If @var{firstonly} is @code{t}, then the
value is the first key sequence, except that key sequences consisting
entirely of @acronym{ASCII} characters (or meta variants of @acronym{ASCII}
characters) are preferred to all other key sequences.
characters) are preferred to all other key sequences and that the
return value can never be a menu binding.
If @var{noindirect} is non-@code{nil}, @code{where-is-internal} doesn't
follow indirect keymap bindings. This makes it possible to search for
@ -1623,7 +1634,7 @@ other command. However, if @var{no-remap} is non-@code{nil}.
@end smallexample
@end defun
@deffn Command describe-bindings &optional prefix
@deffn Command describe-bindings &optional prefix buffer-or-name
This function creates a listing of all current key bindings, and
displays it in a buffer named @samp{*Help*}. The text is grouped by
modes---minor modes first, then the major mode, then global bindings.
@ -1643,6 +1654,10 @@ For example, in the default global map, the characters @samp{@key{SPC}
@kbd{~} is @acronym{ASCII} 126, and the characters between them include all
the normal printing characters, (e.g., letters, digits, punctuation,
etc.@:); all these characters are bound to @code{self-insert-command}.
If @var{buffer-or-name} is non-@code{nil}, it should be a buffer or a
buffer name. Then @code{describe-bindings} lists that buffer's bindings,
instead of the current buffer's.
@end deffn
@node Menu Keymaps
@ -1681,8 +1696,9 @@ prompt string.
The easiest way to construct a keymap with a prompt string is to specify
the string as an argument when you call @code{make-keymap},
@code{make-sparse-keymap} or @code{define-prefix-command}
(@pxref{Creating Keymaps}).
@code{make-sparse-keymap} (@pxref{Creating Keymaps}), or
@code{define-prefix-command} (@pxref{Definition of define-prefix-command}).
@defun keymap-prompt keymap
This function returns the overall prompt string of @var{keymap},
@ -2107,6 +2123,12 @@ functioning of the menu itself, but they are ``echoed'' in the echo area
when the user selects from the menu, and they appear in the output of
@code{where-is} and @code{apropos}.
The menu in this example is intended for use with the mouse. If a
menu is intended for use with the keyboard, that is, if it is bound to
a key sequence ending with a keyboard event, then the menu items
should be bound to characters or ``real'' function keys, that can be
typed with the keyboard.
The binding whose definition is @code{("--")} is a separator line.
Like a real menu item, the separator has a key symbol, in this case
@code{separator-ps-print}. If one menu has two separators, they must
@ -2389,7 +2411,7 @@ property list elements to add to the menu item specification.
This function is used for making non-global tool bar items. Use it
like @code{tool-bar-add-item-from-menu} except that @var{in-map}
specifies the local map to make the definition in. The argument
@var{from-map} si like the @var{map} argument of
@var{from-map} is like the @var{map} argument of
@code{tool-bar-add-item-from-menu}.
@end defun

26
lispref/modes.texi
View file

@ -188,16 +188,24 @@ The key sequences bound in a major mode keymap should usually start with
characters are reserved for minor modes, and ordinary letters are
reserved for users.
It is reasonable for a major mode to rebind a key sequence with a
standard meaning, if it implements a command that does ``the same job''
in a way that fits the major mode better. For example, a major mode for
editing a programming language might redefine @kbd{C-M-a} to ``move to
the beginning of a function'' in a way that works better for that
language.
A major mode can also rebind the keys @kbd{M-n}, @kbd{M-p} and
@kbd{M-s}. The bindings for @kbd{M-n} and @kbd{M-p} should normally
be some kind of ``moving forward and backward,'' but this does not
necessarily mean cursor motion.
Major modes such as Dired or Rmail that do not allow self-insertion of
text can reasonably redefine letters and other printing characters as
editing commands. Dired and Rmail both do this.
It is legitimate for a major mode to rebind a standard key sequence if
it provides a command that does ``the same job'' in a way better
suited to the text this mode is used for. For example, a major mode
for editing a programming language might redefine @kbd{C-M-a} to
``move to the beginning of a function'' in a way that works better for
that language.
It is also legitimate for a major mode to rebind a standard key
sequence whose standard meaning is rarely useful in that mode. For
instance, minibuffer modes rebind @kbd{M-r}, whose standard meaning is
rarely of any use in the minibuffer. Major modes such as Dired or
Rmail that do not allow self-insertion of text can reasonably redefine
letters and other printing characters as special commands.
@item
Major modes must not define @key{RET} to do anything other than insert

27
lispref/processes.texi
View file

@ -929,6 +929,16 @@ process and only then specify its buffer or filter function; no output
can arrive before you finish, if the code in between does not call any
primitive that waits.
@defvar process-adaptive-read-buffering
On some systems, when Emacs reads the output from a subprocess, the
output data is read in very small blocks, potentially resulting in
very poor performance. This behaviour can be remedied to some extent
by setting the variable @var{process-adaptive-read-buffering} to a
non-nil value (the default), as it will automatically delay reading
from such processes, thus allowing them to produce more output before
Emacs tries to read it.
@end defvar
It is impossible to separate the standard output and standard error
streams of the subprocess, because Emacs normally spawns the subprocess
inside a pseudo-TTY, and a pseudo-TTY has only one output channel. If
@ -1240,7 +1250,7 @@ or terminal input. Occasionally it is useful in a Lisp program to
explicitly permit output to arrive at a specific point, or even to wait
until output arrives from a process.
@defun accept-process-output &optional process seconds millisec
@defun accept-process-output &optional process seconds millisec just-this-one
This function allows Emacs to read pending output from processes. The
output is inserted in the associated buffers or given to their filter
functions. If @var{process} is non-@code{nil} then this function does
@ -1263,6 +1273,15 @@ Not all operating systems support waiting periods other than multiples
of a second; on those that do not, you get an error if you specify
nonzero @var{millisec}.
@c Emacs 21.4 feature
If @var{process} is a process, and the argument @var{just-this-one} is
non-nil, only output from that process is handled, suspending output
from other processes until some output has been received from that
process or the timeout expires. If @var{just-this-one} is an integer,
also inhibit running timers. This feature is generally not
recommended, but may be necessary for specific applications, such as
speech synthesis.
The function @code{accept-process-output} returns non-@code{nil} if it
did get some output, or @code{nil} if the timeout expired before output
arrived.
@ -1664,7 +1683,7 @@ meaning ask the system to allocate an unused port to listen on.
@end defun
@node Datagrams
@section Datagrams
@section Datagrams
@cindex datagrams
A datagram connection communicates with individual packets rather
@ -1951,7 +1970,7 @@ the port number.
@example
(featurep 'make-network-process '(@var{keyword} @var{value}))
@end example
@end example
@noindent
The result of the first form is @code{t} if it works to specify
@ -1977,7 +1996,7 @@ Non-@code{nil} if the system can select the port for a server.
@example
(featurep 'make-network-process '@var{keyword})
@end example
@end example
Here are some of the option @var{keyword}s you can test in
this way.

99
man/ChangeLog
View file

@ -1,3 +1,102 @@
2004-08-26 Richard M. Stallman <rms@gnu.org>
* faq.texi (Difference between Emacs and XEmacs): Rewrite.
2004-08-25 Kenichi Handa <handa@m17n.org>
* custom.texi (Non-ASCII Rebinding): Fix and simplify the
description for unibyte mode.
2004-08-23 Luc Teirlinck <teirllm@auburn.edu>
* display.texi (Font Lock): Correct invalid (for hardcopy) @xref.
* search.texi (Regexps): Correct cryptic (in hardcopy) @ref.
(Configuring Scrolling): Correct invalid (for hardcopy) @xref.
(Regexp Replace): Standardize reference to hardcopy Elisp Manual
in @pxref.
2004-08-22 Luc Teirlinck <teirllm@auburn.edu>
* kmacro.texi (Keyboard Macro Counter, Keyboard Macro Step-Edit):
Change section names.
2004-08-22 David Kastrup <dak@gnu.org>
* reftex.texi (AUCTeX): Update links, section name.
* faq.texi (Calc): Update availability (included in 21.4).
(AUCTeX): Update availability, information, versions, description.
2004-08-21 Luc Teirlinck <teirllm@auburn.edu>
* kmacro.texi (Keyboard Macro Ring): Rename section.
Emacs treats the head of the macro ring as the `last keyboard macro'.
(Keyboard Macro Counter): Minor change.
(Save Keyboard Macro): Some clarifications.
(Edit Keyboard Macro): Rename section.
* buffers.texi (Buffers): Maximum buffer size is now 256M on
32-bit machines.
(Several Buffers): Clarify which buffer is selected if `2' is
pressed in the Buffer Menu.
Auto Revert mode can be used to update the Buffer Menu
automatically.
2004-08-21 Eli Zaretskii <eliz@gnu.org>
* help.texi (Misc Help): Add an index entry for finding an Info
manual by its file name.
2004-08-20 Luc Teirlinck <teirllm@auburn.edu>
* files.texi (Backup Deletion): Correct description of
`delete-old-versions'.
(Time Stamps): `time-stamp' needs to be added to `before-save-hook'.
(Auto Save Files): Recommend `auto-save-mode' to reenable
auto-saving, rather than the abbreviation `auto-save'.
2004-08-17 Luc Teirlinck <teirllm@auburn.edu>
* emacs.texi (Top): Mention "cutting" and "pasting" as synonyms
for "killing" and "yanking" in main menu.
2004-08-16 Richard M. Stallman <rms@gnu.org>
* killing.texi (Yanking, Killing): Minor cleanups.
* mark.texi (Momentary Mark): Minor cleanups.
2004-08-15 Kenichi Handa <handa@etl.go.jp>
* custom.texi (Non-ASCII Rebinding):
C-q always inserts the right code to pass to global-set-key.
2004-08-14 Eli Zaretskii <eliz@gnu.org>
* Makefile.in (../info/tramp, tramp.dvi): Depend on trampver.texi.
2004-08-13 Luc Teirlinck <teirllm@auburn.edu>
* regs.texi (RegNumbers): Mention `C-x r i' binding for
`insert-register', instead of `C-x r g' binding, for consistency.
2004-08-12 Luc Teirlinck <teirllm@auburn.edu>
* fixit.texi (Spelling): Fix typo.
2004-08-11 Luc Teirlinck <teirllm@auburn.edu>
* help.texi (Help): Fix Texinfo usage.
2004-08-11 Martin Stjernholm <bug-cc-mode@gnu.org>
* cc-mode.texi: Various updates for CC Mode 5.30.9.
2004-08-10 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.0.44.
2004-08-05 Lars Hansen <larsh@math.ku.dk>
* widget.texi (User Interface): Update how to separate the

4
man/Makefile.in
View file

@ -279,9 +279,9 @@ speedbar.dvi: speedbar.texi
emacs-mime.dvi: emacs-mime.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi
../info/tramp: tramp.texi
../info/tramp: tramp.texi trampver.texi
cd $(srcdir); $(MAKEINFO) -D emacs tramp.texi
tramp.dvi: tramp.texi
tramp.dvi: tramp.texi trampver.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/tramp.texi
../info/ses: ses.texi

19
man/buffers.texi
View file

@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
@c Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 2000, 2001
@c Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 2000, 2001, 2004
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Buffers, Windows, Files, Top
@ -44,7 +44,7 @@ the value in other buffers. @xref{Locals}.
A buffer's size cannot be larger than some maximum, which is defined
by the largest buffer position representable by the @dfn{Emacs integer}
data type. This is because Emacs tracks buffer positions using that
data type. For 32-bit machines, the largest buffer size is 128
data type. For 32-bit machines, the largest buffer size is 256
megabytes.
@menu
@ -395,9 +395,9 @@ select the window.
@item 1
Immediately select this line's buffer in a full-screen window.
@item 2
Immediately set up two windows, with this line's buffer in one, and the
previously current buffer (aside from the buffer @samp{*Buffer List*})
in the other.
Immediately set up two windows, with this line's buffer selected in
one, and the previously current buffer (aside from the buffer
@samp{*Buffer List*}) displayed in the other.
@item b
Bury the buffer listed on this line.
@item m
@ -427,12 +427,19 @@ window. If you run @code{list-buffers} (that is, type @kbd{C-x C-b})
and select the buffer list manually, you can use all of the commands
described here.
The buffer @samp{*Buffer List*} is not updated automatically when
Normally, the buffer @samp{*Buffer List*} is not updated automatically when
buffers are created and killed; its contents are just text. If you have
created, deleted or renamed buffers, the way to update @samp{*Buffer
List*} to show what you have done is to type @kbd{g}
(@code{revert-buffer}) or repeat the @code{buffer-menu} command.
The @samp{*Buffer List*} buffer does automatically update every
@code{auto-revert-interval} seconds if you enable Auto Revert mode in
it. (As long as it is not marked modified.) Global Auto Revert mode
does not update the @samp{*Buffer List*} buffer by default, but it
does if @code{global-auto-revert-non-file-buffers} is non-@code{nil}.
@inforef{Autorevert,, emacs-xtra}, for details.
The command @code{buffer-menu-other-window} works the same as
@code{buffer-menu}, except that it displays the buffers list in
another window.

129
man/cc-mode.texi
View file

@ -1340,9 +1340,9 @@ block comments.
@findex setup-paragraph-variables (c-)
Also note that since @ccmode{} uses the value of
@code{c-comment-prefix-regexp} to set up several other variables at mode
initialization, there won't have any effect if you change it inside a
initialization, there won't be any effect if you just change it inside a
@ccmode{} buffer. You need to call the command
@code{c-setup-paragraph-variables} to update those other variables with
@code{c-setup-paragraph-variables} too, to update those other variables with
the new value. That's also the case if you modify this variable in a
mode hook, since @ccmode{} sets up all variables before calling them.
@end defopt
@ -1415,8 +1415,12 @@ namely when a block comment is broken for the first time. This style
variable@footnote{In versions before 5.26, this variable was called
@code{c-comment-continuation-stars}. As a compatibility measure,
@ccmode{} still uses the value on that variable if it's set.} is used
then as the comment prefix. It defaults to @samp{* }, which makes a
comment
then as the comment prefix. It defaults to @samp{*
}@footnote{Actually, this default setting of
@code{c-block-comment-prefix} typically gets overriden by the default
style @code{gnu}, which sets it to blank. You can see the line
splitting effect described here by setting a different style,
e.g. @code{k&r} @xref{Choosing a Style}}, which makes a comment
@example
/* Got O(n^2) here, which is a Bad Thing. */
@ -2057,13 +2061,13 @@ These variables are also useful when indenting code:
@vindex tab-always-indent (c-)
@kindex TAB
@cindex literal
This variable controls how @kbd{TAB} (@code{c-indent-command}) operates.
When it is @code{t}, @kbd{TAB} always indents the current line. When it
is @code{nil}, the line is indented only if point is at the left margin,
or on or before the first non-whitespace character on the line,
otherwise some whitespace is inserted. If this variable is the symbol
@code{other}, then some whitespace is inserted only within strings and
comments (literals), and inside preprocessor directives, but the line is
This variable controls how @kbd{TAB} (@code{c-indent-command})
operates. When it is @code{t}, @kbd{TAB} always indents the current
line. When it is @code{nil}, the line is indented only if point is at
the left margin, or on or before the first non-whitespace character on
the line, otherwise some whitespace is inserted. If this variable is
some other value (not @code{nil} or @code{t}), then some whitespace is
inserted only within strings and comments (literals), but the line is
always reindented.
@end defopt
@ -2878,26 +2882,71 @@ string.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@node Adding Styles, File Styles, Choosing a Style, Styles
@comment node-name, next, previous, up
@subsection Adding Styles
@subsection Adding and Amending Styles
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
If none of the built-in styles is appropriate, you'll probably want to
add a new @dfn{style definition}. Styles are kept in the
@code{c-style-alist} variable, but you should never modify this
variable directly. Instead, @ccmode{} provides the function
@code{c-add-style} that you can use to easily add new styles or change
existing styles:
create a new @dfn{style definition}, possibly based on an existing
style. To do this, put the new style's settings into a list with the
following format - the list can then be passed as an argument to the
function @code{c-add-style}:
@cindex style definition
@defvr {List} style definition
([@var{base-style}] [(@var{variable} . @var{value}) @dots{}])
Optional @var{base-style}, if present, must be a string which is the
name of the @dfn{base style} from which this style inherits. At most
one @var{base-style} is allowed in a style definition. If
@var{base-style} is not specified, the style inherits from a table of
default values@footnote{This table is stored internally in the
variable c-fallback-style. It is computed during the initialisation
of @ccmode{} from the factory defaults of the style variables and any
global values they may have been given since starting Emacs.} instead.
All styles eventually inherit from this internal table. Style loops
generate errors. The list of pre-existing styles can be seen in
@ref{Built-in Styles}.
The dotted pairs (@var{variable} . @var{value}) each consist of a
variable and the value it is to be set to when the style is later
activated.@footnote{In certain circumstances, this value can get
overridden by another value.} The variable can be either a @ccmode{}
style variable or an arbitrary Emacs variable. In the latter case, it
is @emph{not} made buffer local by the @ccmode{} style system.
@end defvr
Two variables are treated specially in the dotted pair list:
@table @code
@item c-offsets-alist
The value is in turn a dotted list on the form
(@var{syntactic-symbol} . @var{offset})
as described in @ref{Customizing Indentation}. These are passed to
@code{c-set-offset} so there is no need to set every syntactic symbol in
your style, only those that are different from the inherited style.
@item c-special-indent-hook
The value is added to @code{c-special-indent-hook} using
@code{add-hook}, so any functions already on it are kept. If the value
is a list, each element of the list is added with @code{add-hook}.
@end table
Styles are kept in the @code{c-style-alist} variable, but you
should never modify this variable directly. Instead, @ccmode{}
provides the function @code{c-add-style} for this purpose.
@defun c-add-style stylename description &optional set-p
@findex add-style (c-)
Add or update a style. If @var{stylename} is not already in
@code{c-style-alist} then a new style according to @var{description}
is added, otherwise the existing style is changed. If the optional
@var{set-p} is non-@code{nil} then the new style is applied to the
current buffer as well.
@comment TBD: The next paragraph is bogus. I really need to better
@comment document adding styles, including setting up inherited styles.
Add or update a style called @var{stylename}, a string.
@var{description} is the new style definition in the form described
above. If @var{stylename} already exists in @code{c-style-alist} then
it is replaced by @var{description}. (Note, this replacement is
total. The old style is @emph{not} merged into the new one.)
Otherwise, a new style is added. If the optional @var{set-p} is
non-@code{nil} then the new style is applied to the current buffer as
well.
The sample @file{.emacs} file provides a concrete example of how a new
style can be added and automatically set. @xref{Sample .emacs File}.
@ -3416,9 +3465,9 @@ Analogous to @code{inclass} syntactic symbol, but used inside lambda
Lines continuing the header of a lambda function, i.e., between the
@code{lambda} keyword and the function body. Only used in Pike mode.
@item inexpr-statement
A statement block inside an expression. The gcc C extension of this is
recognized. It's also used for the special functions that takes a
statement block as an argument in Pike.
A statement block inside an expression. The gcc C and C++ extension for
this is recognized. It's also used for the special functions that take
a statement block as an argument in Pike.
@item inexpr-class
A class definition inside an expression. This is used for anonymous
classes in Java. It's also used for anonymous array initializers in
@ -4022,7 +4071,8 @@ indented just like a normal class, with the added indentation given to
@code{inexpr-class}.
There are a few occasions where a statement block may be used inside an
expression. One is in C code using the gcc extension for this, e.g:
expression. One is in C or C++ code using the gcc extension for this,
e.g:
@example
1: int res = (@{
@ -5225,7 +5275,7 @@ Controls whether a final newline is ensured when the file is saved. The
value is an association list that for each language mode specifies the
value to give to @code{require-final-newline} at mode initialization;
see that variable for details about the value. If a language isn't
present on the association list, CC Mode won't set
present on the association list, CC Mode won't touch
@code{require-final-newline} in buffers for that language.
The default is to set @code{require-final-newline} to @code{t} in the
@ -5484,6 +5534,25 @@ interpreter tries to call the macro as a function, it shows this
(somewhat cryptic) error message.}. If you are using the standalone
@ccmode{} distribution, try recompiling it according to the instructions
in the @file{README} file.
@item
@cindex open paren in column zero
@emph{I have an open paren character at column zero inside a comment or
multiline string literal, and it causes the fontification and/or
indentation to go haywire. What gives?}
It's due to the ad-hoc rule in (X)Emacs that such open parens always
start defuns (which translates to functions, classes, namespaces or any
other top-level block constructs in the @ccmode{} languages).
@xref{Left Margin Paren,,, emacs, The Emacs Editor}, for details
(@xref{Defuns,,, emacs, The Emacs Editor}, in the Emacs 20 manual).
This heuristic is built into the core syntax analysis routines in
(X)Emacs, so it's not really a @ccmode{} issue. However, in Emacs 21.4
it has become possible to turn it off@footnote{Using the variable
@code{open-paren-in-column-0-is-defun-start}.} and @ccmode{} does so
there since it got its own system to keep track of blocks.
@end itemize

45
man/custom.texi
View file

@ -1619,14 +1619,13 @@ because the terminal sends the same character in both cases.
@cindex rebinding non-@acronym{ASCII} keys
@cindex non-@acronym{ASCII} keys, binding
If your keyboard has keys that send non-@acronym{ASCII} characters, such as
accented letters, rebinding these keys is a bit tricky. There are two
solutions you can use. One is to specify a keyboard coding system,
using @code{set-keyboard-coding-system} (@pxref{Specify Coding}).
Then you can bind these keys in the usual way@footnote{Note that you
should avoid the string syntax for binding 8-bit characters, since
they will be interpreted as meta keys. @xref{Strings of
Events,,,elisp, The Emacs Lisp Reference Manual}.}, like this:
If your keyboard has keys that send non-@acronym{ASCII}
characters, such as accented letters, rebinding these keys
must be done by using a vector like this@footnote{Note that
you should avoid the string syntax for binding
non-@acronym{ASCII} characters, since they will be
interpreted as meta keys. @xref{Strings of Events,,,elisp,
The Emacs Lisp Reference Manual}.}:
@example
(global-set-key [?@var{char}] 'some-function)
@ -1635,30 +1634,16 @@ Events,,,elisp, The Emacs Lisp Reference Manual}.}, like this:
@noindent
Type @kbd{C-q} followed by the key you want to bind, to insert @var{char}.
Since this puts a non-@acronym{ASCII} character in the @file{.emacs}, you should
specify the proper coding system for that file. @xref{Init Syntax}.
Specify the same coding system for the file that you use for your
keyboard.
Since this puts a non-@acronym{ASCII} character in the @file{.emacs},
you should specify for that file a coding system that supports
that character. @xref{Init Syntax}.
If you don't specify a keyboard coding system, that approach won't
work. Instead, you need to find out the actual code that the terminal
sends. The easiest way to do this in Emacs is to create an empty
buffer with @kbd{C-x b temp @key{RET}}, make it unibyte with @kbd{M-x
toggle-enable-multibyte-characters @key{RET}}, then type the key to
insert the character into this buffer.
@strong{Warning:} if you change the keyboard encoding, such that the code that
@kbd{C-q} inserts becomes different, you'll need to edit the
Lisp expression accordingly.
Move point before the character, then type @kbd{C-x =}. This
displays a message in the minibuffer, showing the character code in
three ways, octal, decimal and hexadecimal, all within a set of
parentheses. Use the second of the three numbers, the decimal one,
inside the vector to bind:
@example
(global-set-key [@var{decimal-code}] 'some-function)
@end example
If you bind 8-bit characters like this in your init file, you may find it
convenient to specify that it is unibyte. @xref{Enabling Multibyte}.
@strong{Warning:} @kbd{C-q} will insert the wrong code if you visit
the file @file{.emacs} in a unibyte buffer, so don't do that.
@node Mouse Buttons
@subsection Rebinding Mouse Buttons

3
man/display.texi
View file

@ -316,7 +316,8 @@ comments, use this:
@findex font-lock-remove-keywords
To remove keywords from the font-lock highlighting patterns, use the
function @code{font-lock-remove-keywords}. @xref{Search-based
Fontification,,,elisp}, for documentation of the format of this list.
Fontification,,, elisp, The Emacs Lisp Reference Manual}, for
documentation of the format of this list.
@cindex just-in-time (JIT) font-lock
@cindex background syntax highlighting

4
man/emacs.texi
View file

@ -158,8 +158,8 @@ Fundamental Editing Commands
Important Text-Changing Commands
* Mark:: The mark: how to delimit a ``region'' of text.
* Killing:: Killing text.
* Yanking:: Recovering killed text. Moving text.
* Killing:: Killing (cutting) text.
* Yanking:: Recovering killed text. Moving text. (Pasting.)
* Accumulating Text:: Other ways of copying text.
* Rectangles:: Operating on the text inside a rectangle on the screen.
* Registers:: Saving a text string or a location in the buffer.

74
man/faq.texi
View file

@ -3586,45 +3586,25 @@ A list of sites mirroring @samp{ftp.gnu.org} can be found at
@cindex Lucid Emacs
@cindex Epoch
First of all, they're both GNU Emacs. XEmacs is just as much a later
version of GNU Emacs as the FSF-distributed version. This FAQ refers to
the latest version to be distributed by the FSF as ``Emacs,'' partly
because the XEmacs maintainers now refer to their product using the
``XEmacs'' name, and partly because there isn't any accurate way to
differentiate between the two without getting mired in paragraphs of
legalese and history.
XEmacs is a branch version of Emacs. It was earlier called as Lucid
Emacs, and it was based on a prerelease version of Emacs 19. In this
FAQ, we use the name ``Emacs'' only for the official version.
XEmacs, which began life as Lucid Emacs, is based on an early version of
Emacs 19 and Epoch, an X-aware version of Emacs 18.
Emacs (i.e., the version distributed by the FSF) has a larger installed
base and now always contains the MULE multilingual facilities.
XEmacs can do some clever tricks with X and MS-Windows, such as
putting arbitrary graphics in a buffer. Similar facilities have been
implemented for Emacs as part of a new redisplay implementation for
Emacs 21, and are available in the latest Emacs releases.
Emacs and XEmacs each come with
Lisp packages that are lacking in the other; RMS says that the FSF would
include more packages that come with XEmacs, but that the XEmacs
maintainers don't always keep track of the authors of contributed code,
which makes it impossible for the FSF to have certain legal papers
signed. (Without these legal papers, the FSF will not distribute Lisp
packages with Emacs.) The two versions have some
significant differences at the Lisp programming level.
Emacs and XEmacs each come with Lisp packages that are lacking in the
other. The two versions have some significant differences at the Lisp
programming level.
Many XEmacs features have found their way into recent versions of Emacs,
and more features can be expected in the future, but there are still many
differences between the two.
The latest stable branch of XEmacs as of this writing is 21.4; you can
get it at
@uref{ftp://ftp.xemacs.org/pub/xemacs/xemacs-21.4/xemacs-21.4.12.tar.gz}
More information about XEmacs, including a list of frequently asked
questions (FAQ), is available at
@uref{http://www.xemacs.org/}
The FSF has used some of the code in XEmacs, and would like to use
other parts, but the earlier XEmacs maintainers did not always keep
track of the authors of contributed code, which makes it impossible
for the FSF to get copyright papers signed for that code. (The FSF
requires these papers for all the code included in Emacs, aside from
generic C support packages that are not integrated into the code of
Emacs proper.)
@node Emacs for MS-DOS, Emacs for Windows, Difference between Emacs and XEmacs, Finding Emacs and related packages
@section Where can I get Emacs for my PC running MS-DOS?
@ -3953,10 +3933,11 @@ Superyank is an old version of Supercite.
@email{daveg@@csvax.cs.caltech.edu, Dave Gillespie}
@item Latest version
2.02f
2.02g (part of Emacs since version 21.4)
@item Distribution
@uref{ftp://ftp.gnu.org/pub/gnu/calc/calc-2.02f.tar.gz}
No separate distribution outside of Emacs. Older versions
are available at @uref{ftp://ftp.gnu.org/pub/gnu/calc/}.
@end table
@ -3996,34 +3977,41 @@ better than the one distributed with Emacs:
@end table
@node AUCTeX, BBDB, VIPER, Major packages and programs
@section AUCTeX --- enhanced LaTeX mode with debugging facilities
@section AUC@TeX{} --- enhanced @TeX{} modes with debugging facilities
@cindex Mode for @TeX{}
@cindex @TeX{} mode
@cindex AUCTeX mode for editing @TeX{}
@cindex AUC@TeX{} mode for editing @TeX{}
@cindex Writing and debugging @TeX{}
AUC@TeX{} is a set of sophisticated major modes for @TeX{}, LaTeX,
ConTeXt, and Texinfo offering context-sensitive syntax highlighting,
indentation, formatting and folding, macro completion, @TeX{} shell
functionality, and debugging. Some important supplemental packages are
described in @ref{Introduction, RefTeX, Introduction, reftex, Ref@TeX{}
User Manual}, and
@uref{http://preview-latex.sourceforge.net,preview-latex}.
@table @b
@item Authors
@email{krab@@iesd.auc.dk, Kresten Krab Thorup} and@*
@email{abraham@@dina.kvl.dk, Per Abrahamsen}
@email{krab@@iesd.auc.dk, Kresten Krab Thorup}, @*
@email{abraham@@dina.kvl.dk, Per Abrahamsen}, @* and others.
@item Maintainer
@email{dak@@gnu.org, David Kastrup}
@item Latest version
11.13
11.52
@item Distribution
@uref{http://savannah.gnu.org/download/auctex/stable.pkg/11.13/auctex-11.13.tar.gz}
@uref{ftp://ftp.gnu.org/pub/gnu/auctex/}
@item Web site
@uref{http://www.gnu.org/software/auctex/}
@item Mailing list:
Subscription requests to @email{auc-tex-subscribe@@sunsite.dk}@*
Submissions to @email{auc-tex@@sunsite.dk}@*
Development team is at @email{auc-tex_mgr@@sunsite.dk}
Submissions to @email{auc-tex@@sunsite.dk}
@end table

19
man/files.texi
View file

@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
@c Copyright (C) 1985,86,87,93,94,95,97,99, 2000, 2001
@c Copyright (C) 1985,86,87,93,94,95,97,99, 2000, 2001, 2004
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Files, Buffers, Keyboard Macros, Top
@ -625,9 +625,10 @@ made backup is included in the count in @code{kept-new-versions}. By
default, both variables are 2.
@vindex delete-old-versions
If @code{delete-old-versions} is non-@code{nil}, Emacs deletes the
excess backup files silently. If it is @code{nil}, the default, Emacs
asks you whether it should delete the excess backup versions.
If @code{delete-old-versions} is @code{t}, Emacs deletes the excess
backup files silently. If it is @code{nil}, the default, Emacs asks
you whether it should delete the excess backup versions. If it has
any other value, then Emacs never automatically deletes backups.
Dired's @kbd{.} (Period) command can also be used to delete old versions.
@xref{Dired Deletion}.
@ -836,7 +837,7 @@ Time-stamp: " "
@end example
Then add the hook function @code{time-stamp} to the hook
@code{write-file-functions}; that hook function will automatically update
@code{before-save-hook}; that hook function will automatically update
the time stamp, inserting the current date and time when you save the
file. You can also use the command @kbd{M-x time-stamp} to update the
time stamp manually. For other customizations, see the Custom group
@ -942,7 +943,7 @@ when they are auto-saved, the auto-save file name is made by appending
@samp{#} to the front and rear of buffer name, then
adding digits and letters at the end for uniqueness. For
example, the @samp{*mail*} buffer in which you compose messages to be
sent might auto-saved in a file named @file{#*mail*#704juu}. Auto-save file
sent might be auto-saved in a file named @file{#*mail*#704juu}. Auto-save file
names are made this way unless you reprogram parts of Emacs to do
something different (the functions @code{make-auto-save-file-name} and
@code{auto-save-file-name-p}). The file name to be used for auto-saving
@ -962,7 +963,7 @@ save turns off temporarily in that buffer. This is because if you
deleted the text unintentionally, you might find the auto-save file more
useful if it contains the deleted text. To reenable auto-saving after
this happens, save the buffer with @kbd{C-x C-s}, or use @kbd{C-u 1 M-x
auto-save}.
auto-save-mode}.
@vindex auto-save-visited-file-name
If you want auto-saving to be done in the visited file rather than
@ -1567,7 +1568,7 @@ the revision denoted on the current line was committed.
@item
Pressing @kbd{L} shows the log of the revision at line. This is
useful to see the author's description of the changes that occured
useful to see the author's description of the changes that occurred
when the revision denoted on the current line was committed.
@item
@ -1585,7 +1586,7 @@ use once a day.
@menu
* Registering:: Putting a file under version control.
* VC Status:: Viewing the VC status of files.
* VC Undo:: Cancelling changes before or after check-in.
* VC Undo:: Canceling changes before or after check-in.
* VC Dired Mode:: Listing files managed by version control.
* VC Dired Commands:: Commands to use in a VC Dired buffer.
@end menu

2
man/fixit.texi
View file

@ -339,7 +339,7 @@ a different standard dictionary.
Ispell uses a separate dictionary for word completion. The variable
@code{ispell-complete-word-dict} specifies the file name of this
dictionary. The completion dictionary must be different because it
cannot use employ root and affix information. For some languages
cannot use root and affix information. For some languages
there is a spell checking dictionary but no word completion
dictionary.

3
man/help.texi
View file

@ -63,7 +63,7 @@ match for @var{topic}, a regular expression. @xref{Apropos}.
@item C-h i d m emacs @key{RET} i @var{topic} @key{RET}
This looks up @var{topic} in the indices of the Emacs on-line manual.
If there are several matches, Emacs displays the first one. You can then
press @key{,} to move to other matches, until you find what you are
press @kbd{,} to move to other matches, until you find what you are
looking for.
@item C-h i d m emacs @key{RET} s @var{topic} @key{RET}
@ -455,6 +455,7 @@ is available within Info. Eventually all the documentation of the GNU
system will be available. Type @kbd{h} after entering Info to run
a tutorial on using Info.
@cindex find Info manual by its file name
If you specify a numeric argument, @kbd{C-h i} prompts for the name of
a documentation file. This way, you can browse a file which doesn't
have an entry in the top-level Info menu. It is also handy when you

7
man/killing.texi
View file

@ -31,8 +31,8 @@ one buffer and yank it in another buffer.
@cindex killing text
@cindex cutting text
@cindex deletion
Most commands which erase text from the buffer save it in the kill
ring so that you can move or copy it to other parts of the buffer.
Most commands which erase text from the buffer save it in the @dfn{kill
ring} so that you can move or copy it to other parts of the buffer.
These commands are known as @dfn{kill} commands. The rest of the
commands that erase text do not save it in the kill ring; they are known
as @dfn{delete} commands. (This distinction is made only for erasure of
@ -274,7 +274,8 @@ single kill ring entry as usual.
@dfn{Yanking} means reinserting text previously killed. This is what
some systems call ``pasting.'' The usual way to move or copy text is to
kill it and then yank it elsewhere one or more times.
kill it and then yank it elsewhere one or more times. This is very safe
because Emacs remembers many recent kills, not just the last one.
@table @kbd
@item C-y

52
man/kmacro.texi
View file

@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
@c Copyright (C) 1985,86,87,93,94,95,97,2000,2001,2002,2003
@c Copyright (C) 1985,86,87,93,94,95,97,2000,2001,2002,2003,2004
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Keyboard Macros, Files, Fixit, Top
@ -165,7 +165,7 @@ to plain @kbd{C-x (} followed by retyping the whole definition so far. As
a consequence it re-executes the macro as previously defined.
You can also add to the end of the definition of the last keyboard
macro without re-execuing it by typing @kbd{C-u C-u C-x (}.
macro without re-executing it by typing @kbd{C-u C-u C-x (}.
The variable @code{kmacro-execute-before-append} specifies whether
a single @kbd{C-u} prefix causes the existing macro to be re-executed
@ -179,7 +179,7 @@ the current region. It does this line by line, by moving point to the
beginning of the line and then executing the macro.
@node Keyboard Macro Ring
@section Where previous keyboard macros are saved
@section The Keyboard Macro Ring
All defined keyboard macros are recorded in the ``keyboard macro ring'',
a list of sequences of keys. There is only one keyboard macro ring,
@ -218,7 +218,11 @@ of the macro ring. The definition of the new head macro is displayed
in the echo area. You can continue to rotate the macro ring
immediately by repeating just @kbd{C-n} and @kbd{C-p} until the
desired macro is at the head of the ring. To execute the new macro
ring head immediately, just type @kbd{C-k}.
ring head immediately, just type @kbd{C-k}.
Note that Emacs treats the head of the macro ring as the ``last
defined keyboard macro''. For instance, it is the keyboard macro that
@kbd{C-x e} will execute.
@findex kmacro-view-macro-repeat
@kindex C-x C-k C-v
@ -257,15 +261,14 @@ the macro ring.
executes the previous (rather than the head) element on the macro ring.
@node Keyboard Macro Counter
@section Inserting incrementing numbers in macros
@section The Keyboard Macro Counter
Each keyboard macro has an associated counter which is automatically
incremented on every repetition of the keyboard macro. Normally, the
macro counter is initialized to 0 when you start defining the macro,
and incremented by 1 after each insertion of the counter value;
that is, if you insert the macro counter twice while defining the
macro, it will be incremented by 2 time for each repetition of the
macro.
macro, the counter will increase by 2 on each repetition of the macro.
@findex kmacro-insert-counter
@kindex C-x C-k C-i
@ -361,23 +364,26 @@ register as a counter, incrementing it on each repetition of the macro.
@findex name-last-kbd-macro
@kindex C-x C-k n
If you wish to save a keyboard macro for later use, you can give it
a name using @kbd{C-x C-k n} (@code{name-last-kbd-macro}).
This reads a name as an argument using the minibuffer and defines that name
to execute the macro. The macro name is a Lisp symbol, and defining it in
this way makes it a valid command name for calling with @kbd{M-x} or for
binding a key to with @code{global-set-key} (@pxref{Keymaps}). If you
specify a name that has a prior definition other than another keyboard
macro, an error message is shown and nothing is changed.
a name using @kbd{C-x C-k n} (@code{name-last-kbd-macro}).
This reads a name as an argument using the minibuffer and defines that
name to execute the last keyboard macro, in its current form. (If you
later add to the definition of this macro, that does not alter the
name's definition as a macro.) The macro name is a Lisp symbol, and
defining it in this way makes it a valid command name for calling with
@kbd{M-x} or for binding a key to with @code{global-set-key}
(@pxref{Keymaps}). If you specify a name that has a prior definition
other than a keyboard macro, an error message is shown and nothing is
changed.
@cindex binding keyboard macros
@findex kmacro-bind-to-key
@kindex C-x C-k b
Rather than giving a keyboard macro a name, you can bind it to a
key using @kbd{C-x C-k b} (@code{kmacro-bind-to-key}) followed by the
You can also bind the last keyboard macro to a key, using
@kbd{C-x C-k b} (@code{kmacro-bind-to-key}) followed by the
key sequence you want the keyboard macro to be bound to. You can
bind to any key sequence in the global keymap, but since most key
sequences already have other bindings, you should select the key
sequence carefylly. If you try to bind to a key sequence with an
sequence carefully. If you try to bind to a key sequence with an
existing binding (in any keymap), you will be asked if you really
want to replace the existing binding of that key.
@ -414,12 +420,12 @@ save in is your init file @file{~/.emacs} (@pxref{Init File}) then the
macro will be defined each time you run Emacs.
If you give @code{insert-kbd-macro} a numeric argument, it makes
additional Lisp code to record the keys (if any) that you have bound to the
keyboard macro, so that the macro will be reassigned the same keys when you
load the file.
additional Lisp code to record the keys (if any) that you have bound
to @var{macroname}, so that the macro will be reassigned the same keys
when you load the file.
@node Edit Keyboard Macro
@section Interactively executing and editing a keyboard macro
@section Editing a Keyboard Macro
@findex kmacro-edit-macro
@kindex C-x C-k C-e
@ -443,12 +449,12 @@ keyboard input that you would use to invoke the macro---@kbd{C-x e} or
@kbd{C-x C-k l} (@code{kmacro-edit-lossage}).
@node Keyboard Macro Step-Edit
@section Interactively executing and editing a keyboard macro
@section Stepwise Editing a Keyboard Macro
@findex kmacro-step-edit-macro
@kindex C-x C-k SPC
You can interactively and stepwise replay and edit the last keyboard
macro one command at a time by typing @kbd{C-x C-k SPC}
macro one command at a time by typing @kbd{C-x C-k SPC}
(@code{kmacro-step-edit-macro}). Unless you quit the macro using
@kbd{q} or @kbd{C-g}, the edited macro replaces the last macro on the
macro ring.

16
man/mark.texi
View file

@ -247,20 +247,20 @@ command twice.)
@item C-u C-x C-x
@kindex C-u C-x C-x
Activate the mark without changing it, enable Transient Mark mode just
once until the mark is deactivated. (This is the @kbd{C-x C-x} command,
@code{exchange-point-and-mark}, with a prefix argument.)
Activate the mark without changing it; enable Transient Mark mode just
once, until the mark is deactivated. (This is the @kbd{C-x C-x}
command, @code{exchange-point-and-mark}, with a prefix argument.)
@end table
One of the secondary features of Transient Mark mode is that certain
commands operate on the region when there is an active region. If you
don't use Transient Mark mode, the region once set never becomes
inactive, so there is no way these commands to make such a
commands operate only on the region, when there is an active region.
If you don't use Transient Mark mode, the region once set never
becomes inactive, so there is no way for these commands to make such a
distinction. Enabling Transient Mark mode momentarily gives you a way
to use these commands on the region.
The other way momentarily use of Transient Mark mode is useful
is that it highlights the region for the time being.
Momentary use of Transient Mark mode is also a way to highlight the
region for the time being.
@node Using Region
@section Operating on the Region

Some files were not shown because too many files have changed in this diff Show more