mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
Revision: miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 Patches applied: * lorentey@elte.hu--2004/emacs--multi-tty--0--patch-224 Added sorted-doc to backup regex in lib-src. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-465 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-482 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-483 Build-in-place tweak * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-484 - 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-522 Update from CVS
This commit is contained in:
Miles Bader
commit
84ef9e9fb1
212 changed files with 16238 additions and 9331 deletions
|
|
@ -1,3 +1,11 @@
|
|||
2004-08-06 Andreas Schwab <schwab@suse.de>
|
||||
|
||||
* Makefile.in (install-arch-indep, uninstall): Add flymake.
|
||||
|
||||
2004-07-31 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* config.bat: Update URLs in the comments.
|
||||
|
||||
2004-08-02 Reiner Steib <Reiner.Steib@gmx.de>
|
||||
|
||||
* Makefile.in (install-arch-indep): Added pgg and sieve.
|
||||
|
|
|
|||
|
|
@ -475,7 +475,7 @@ install-arch-indep: mkdir info
|
|||
chmod a+r ${infodir}/dir); \
|
||||
fi; \
|
||||
cd ${srcdir}/info ; \
|
||||
for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-mime* emacs-xtra* eshell* eudc* forms* gnus* idlwave* info* message* mh-e* pcl-cvs* pgg* reftex* sc* ses* sieve* speedbar* tramp* vip* widget* woman* smtpmail*; do \
|
||||
for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-mime* emacs-xtra* eshell* eudc* flymake* forms* gnus* idlwave* info* message* mh-e* pcl-cvs* pgg* reftex* sc* ses* sieve* speedbar* tramp* vip* widget* woman* smtpmail*; do \
|
||||
(cd $${thisdir}; \
|
||||
${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f; \
|
||||
chmod a+r ${infodir}/$$f); \
|
||||
|
|
@ -485,7 +485,7 @@ install-arch-indep: mkdir info
|
|||
thisdir=`/bin/pwd`; \
|
||||
if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \
|
||||
then \
|
||||
for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc forms gnus idlwave info message mh-e pcl-cvs pgg reftex sc ses sieve speedbar tramp vip viper widget woman smtpmail; do \
|
||||
for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc flymake forms gnus idlwave info message mh-e pcl-cvs pgg reftex sc ses sieve speedbar tramp vip viper widget woman smtpmail; do \
|
||||
(cd $${thisdir}; \
|
||||
${INSTALL_INFO} --info-dir=${infodir} ${infodir}/$$f); \
|
||||
done; \
|
||||
|
|
@ -551,7 +551,7 @@ uninstall:
|
|||
done
|
||||
(cd ${archlibdir} && rm -f fns-*)
|
||||
-rm -rf ${libexecdir}/emacs/${version}
|
||||
(cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* forms* gnus* info* mh-e* sc* ses* vip* smtpmail*)
|
||||
(cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* flymake* forms* gnus* info* mh-e* sc* ses* vip* smtpmail*)
|
||||
(cd ${man1dir} && rm -f emacs${manext} emacsclient${manext} etags${manext} ctags${manext})
|
||||
(cd ${bindir} && rm -f $(EMACSFULL) $(EMACS))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,15 @@
|
|||
2004-08-29 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* FOR-RELEASE (Documentation): Add man/ack.texi and AUTHORS.
|
||||
|
||||
2004-08-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
|
||||
|
||||
* FOR-RELEASE (Indications): Remove entry about GTK and geometry,
|
||||
(now behaves as well as other ports).
|
||||
|
||||
2004-06-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
|
||||
|
||||
* FOR-RELEASE: Removed entry about GTK and monochrome displays (done).
|
||||
* FOR-RELEASE: Remove entry about GTK and monochrome displays (done).
|
||||
|
||||
2002-06-26 Eli Zaretskii <eliz@is.elta.co.il>
|
||||
|
||||
|
|
|
|||
|
|
@ -14,6 +14,10 @@ Tasks needed before the next release.
|
|||
|
||||
** Update man/info.texi.
|
||||
|
||||
** Update man/ack.texi.
|
||||
|
||||
** Update AUTHORS.
|
||||
|
||||
|
||||
* NEW FEATURES
|
||||
|
||||
|
|
@ -38,8 +42,6 @@ isearch faces.
|
|||
|
||||
* GTK RELATED BUGS
|
||||
|
||||
** Make geometry specifications work correctly for GTK.
|
||||
|
||||
** Make GTK scrollbars behave like others w.r.t. overscrolling.
|
||||
|
||||
|
||||
|
|
|
|||
10
config.bat
10
config.bat
|
|
@ -24,17 +24,15 @@ rem ----------------------------------------------------------------------
|
|||
rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS:
|
||||
rem
|
||||
rem + msdos version 3 or better.
|
||||
rem + djgpp version 1.12maint1 or later (version 2.0 or later recommended).
|
||||
rem + DJGPP version 1.12maint1 or later (version 2.03 or later recommended).
|
||||
rem + make utility that allows breaking of the 128 chars limit on
|
||||
rem command lines. ndmake (as of version 4.5) won't work due to a
|
||||
rem line length limit. The make that comes with djgpp does work.
|
||||
rem line length limit. The make that comes with DJGPP does work.
|
||||
rem + rm and mv (from GNU file utilities).
|
||||
rem + sed (you can use the port that comes with DJGPP).
|
||||
rem
|
||||
rem You should be able to get all the above utilities from any SimTel
|
||||
rem repository, e.g. ftp.simtel.net, in the directory
|
||||
rem "pub/simtelnet/gnu/djgpp/v2gnu". As usual, please use your local
|
||||
rem mirroring site to reduce trans-Atlantic traffic.
|
||||
rem You should be able to get all the above utilities from the DJGPP FTP
|
||||
rem site, ftp.delorie.com, in the directory "pub/djgpp/current/v2gnu".
|
||||
rem ----------------------------------------------------------------------
|
||||
set X11=
|
||||
set nodebug=
|
||||
|
|
|
|||
|
|
@ -1,3 +1,45 @@
|
|||
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.
|
||||
|
||||
2004-08-05 Reiner Steib <Reiner.Steib@gmx.de>
|
||||
|
||||
* GNUS-NEWS: Import from the v5_10 branch of the Gnus repository.
|
||||
|
|
|
|||
|
|
@ -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
385
etc/MH-E-NEWS
|
|
@ -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
|
||||
|
|
|
|||
71
etc/NEWS
71
etc/NEWS
|
|
@ -22,7 +22,11 @@ the supported image types and their associated dynamic libraries by
|
|||
setting the variable `image-library-alist'.
|
||||
|
||||
---
|
||||
** A Bulgarian translation of the Emacs Tutorial is available.
|
||||
** New translations of the Emacs Tutorial are available in the following
|
||||
languages: Brasilian, Bulgarian, Chinese (both with simplified and
|
||||
traditional characters), French, and Italian. Type `C-u C-h t' to
|
||||
choose one of them in case your language setup doesn't automatically
|
||||
select the right one.
|
||||
|
||||
** You can build Emacs with Gtk+ widgets by specifying `--with-x-toolkit=gtk'
|
||||
when you run configure. This requires Gtk+ 2.0 or newer. This port
|
||||
|
|
@ -88,13 +92,18 @@ See the files mac/README and mac/INSTALL for build instructions.
|
|||
** A French translation of the `Emacs Survival Guide' is available.
|
||||
|
||||
---
|
||||
** A French translation of the Emacs Tutorial is available.
|
||||
** Building with -DENABLE_CHECKING does not automatically build with union
|
||||
types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
|
||||
|
||||
|
||||
* Changes in Emacs 21.4
|
||||
|
||||
+++
|
||||
** `apply-macro-to-region-lines' now operates on all lines that begin
|
||||
in the region, rather than on all complete lines in the region.
|
||||
|
||||
** 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
|
||||
|
|
@ -189,6 +198,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
|
||||
|
|
@ -514,6 +528,13 @@ mode toggling function instead.
|
|||
*** A numeric prefix argument of `info' selects an Info buffer
|
||||
with the number appended to the *info* buffer name.
|
||||
|
||||
*** Regexp isearch (C-M-s and C-M-r) can search through multiple nodes.
|
||||
Failed isearch wraps to the top/final node.
|
||||
|
||||
*** New search commands: `Info-search-case-sensitively' (bound to S),
|
||||
`Info-search-backward', and `Info-search-next' which repeats the last
|
||||
search without prompting for a new search string.
|
||||
|
||||
*** New command `Info-history' (bound to L) displays a menu of visited nodes.
|
||||
|
||||
*** New command `Info-toc' (bound to T) creates a node with table of contents
|
||||
|
|
@ -527,11 +548,6 @@ possible matches.
|
|||
the current Info node name into the kill ring. With a zero prefix
|
||||
arg, puts the node name inside the `info' function call.
|
||||
|
||||
*** New command `Info-search-case-sensitively' (bound to S).
|
||||
|
||||
*** New command `Info-search-next' (unbound) repeats the last search
|
||||
without prompting for a new search string.
|
||||
|
||||
*** New face `info-xref-visited' distinguishes visited nodes from unvisited
|
||||
and a new option `Info-fontify-visited-nodes' to control this.
|
||||
|
||||
|
|
@ -664,7 +680,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.
|
||||
|
||||
+++
|
||||
|
|
@ -1108,9 +1124,9 @@ Another method to grab a character is to enter the minibuffer by `M-e'
|
|||
and to type `C-f' at the end of the search string in the minibuffer.
|
||||
|
||||
+++
|
||||
** M-% and C-M-% typed in isearch mode invoke `query-replace' and
|
||||
`query-replace-regexp' with the current search string inserted
|
||||
in the minibuffer as initial input for the string to replace.
|
||||
** M-% typed in isearch mode invokes `query-replace' or
|
||||
`query-replace-regexp' (depending on search mode) with the current
|
||||
search string used as the string to replace.
|
||||
|
||||
+++
|
||||
** Yanking text now discards certain text properties that can
|
||||
|
|
@ -1857,7 +1873,9 @@ This option allows you to specify environment variables for inferior
|
|||
compilation processes without affecting the environment that all
|
||||
subprocesses inherit.
|
||||
|
||||
*** `next-error' now temporarily highlights the corresponding source line.
|
||||
*** New options `next-error-highlight' and `next-error-highlight-no-select'
|
||||
specify the method of highlighting of the corresponding source line
|
||||
in new face `next-error'.
|
||||
|
||||
** Grep has been decoupled from compilation mode setup.
|
||||
|
||||
|
|
@ -1869,7 +1887,12 @@ subprocesses inherit.
|
|||
`grep-scroll-output' can be used to override the corresponding
|
||||
compilation mode settings for grep commands.
|
||||
|
||||
*** Source line is temporarily highlighted when going to next match.
|
||||
*** New option `grep-highlight-matches' highlightes matches in *grep*
|
||||
buffer. It uses a special feature of some grep programs which accept
|
||||
--color option to output markers around matches. When going to the next
|
||||
match with `next-error' the exact match is highlighted in the source
|
||||
buffer. Otherwise, if `grep-highlight-matches' is nil, the whole
|
||||
source line is highlighted.
|
||||
|
||||
*** New key bindings in grep output window:
|
||||
SPC and DEL scrolls window up and down. C-n and C-p moves to next and
|
||||
|
|
@ -1972,9 +1995,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.
|
||||
|
|
@ -2193,6 +2219,15 @@ configuration files.
|
|||
|
||||
* Lisp Changes in Emacs 21.4
|
||||
|
||||
+++
|
||||
** Both the variable and the function `disabled-command-hook' have
|
||||
been renamed to `disabled-command-function'. The variable
|
||||
`disabled-command-hook' has been kept as an obsolete alias.
|
||||
|
||||
** Function `compute-motion' now calculates the usable window
|
||||
width if the WIDTH argument is nil. If the TOPOS argument is nil,
|
||||
the usable window height and width is used.
|
||||
|
||||
+++
|
||||
** `visited-file-modtime' and `calendar-time-from-absolute' now return
|
||||
a list of two integers, instead of a cons.
|
||||
|
|
@ -3265,7 +3300,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
5821
etc/PROBLEMS
File diff suppressed because it is too large
Load diff
5
etc/TODO
5
etc/TODO
|
|
@ -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 ->
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,3 +1,17 @@
|
|||
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.
|
||||
|
||||
2004-07-01 David Kastrup <dak@gnu.org>
|
||||
|
||||
* quail/greek.el ("((") ("))"): add quotation mark shorthands.
|
||||
|
|
@ -95,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.
|
||||
|
||||
|
|
@ -233,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>
|
||||
|
|
|
|||
|
|
@ -232,6 +232,7 @@ install: all
|
|||
fi; \
|
||||
rm -rf ${INSTALLDIR}/CVS ${INSTALLDIR}/*/CVS; \
|
||||
rm -f ${INSTALLDIR}/.cvsignore ${INSTALLDIR}/*/.cvsignore; \
|
||||
rm -f ${INSTALLDIR}/.arch-inventory ${INSTALLDIR}/*/.arch-inventory; \
|
||||
rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \
|
||||
rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \
|
||||
rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \
|
||||
|
|
|
|||
|
|
@ -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" ?ა)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
)
|
||||
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
# Ignore binaries
|
||||
backup ^(test-distrib|make-docfile|profile|digest-doc|movemail|cvtmail|fakemail|yow|emacsserver|hexl|update-game-score|etags|ctags|emacsclient|b2m|ebrowse)$
|
||||
backup ^(test-distrib|make-docfile|profile|digest-doc|movemail|cvtmail|fakemail|yow|emacsserver|hexl|update-game-score|etags|ctags|emacsclient|b2m|ebrowse|sorted-doc)$
|
||||
|
||||
# Building actually makes a copy/link of the source file
|
||||
precious ^(ctags\.c)$
|
||||
|
|
|
|||
768
lisp/ChangeLog
768
lisp/ChangeLog
|
|
@ -1,3 +1,759 @@
|
|||
2004-09-03 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* autorevert.el (auto-revert-handler): Bind `buffer-read-only'
|
||||
locally around the call to `revert-buffer'.
|
||||
|
||||
2004-09-03 Juri Linkov <juri@jurta.org>
|
||||
|
||||
* isearch.el (isearch-toggle-regexp): Set `isearch-success' and
|
||||
`isearch-adjusted' to `t'.
|
||||
(isearch-toggle-case-fold): Set `isearch-success' to `t'.
|
||||
(isearch-message-prefix): Add "pending" for isearch-adjusted.
|
||||
(isearch-other-meta-char): Restore isearch-point unconditionally.
|
||||
(isearch-query-replace): Add new arg `regexp-flag' and use it.
|
||||
Set point to start of match if region is not active in transient
|
||||
mark mode (to include the current match to region boundaries).
|
||||
Push the search string to `query-replace-from-history-variable'.
|
||||
Add prompt "Query replace regexp" for isearch-regexp.
|
||||
Add region beginning/end as last arguments of `perform-replace.'
|
||||
(isearch-query-replace-regexp): Replace code by the call to
|
||||
`isearch-query-replace' with arg `t'.
|
||||
|
||||
2004-09-03 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* startup.el (normal-top-level): Undo previous TERM change.
|
||||
|
||||
2004-09-03 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* emulation/cua-rect.el (cua--overlay-keymap): New keymap for
|
||||
highlight overlays; allow using RET when cursor is over a button.
|
||||
(cua--highlight-rectangle): Use it.
|
||||
(cua--rectangle-set-corners): Don't move backwards at eol.
|
||||
(cua--forward-line): Don't move into void after eob.
|
||||
|
||||
* emulation/cua-rect.el (cua--rectangle-set-corners): Ensure that
|
||||
point is set (and displayed) inside rectangle.
|
||||
(cua--rectangle-operation): Fix for highlight of empty lines.
|
||||
(cua--highlight-rectangle): Fix highlight for tabs.
|
||||
Position cursor at left/right edge of rectangle using new `cursor'
|
||||
property on overlay strings.
|
||||
(cua--indent-rectangle): Don't tabify.
|
||||
(cua-rotate-rectangle): Ignore that point has moved.
|
||||
|
||||
2004-09-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
|
||||
|
||||
* term/mac-win.el: Add ASCII equivalents for some function keys.
|
||||
(mode-line-frame-identification): Sync with x-win.el.
|
||||
|
||||
2004-09-02 Juri Linkov <juri@jurta.org>
|
||||
|
||||
* progmodes/compile.el (compilation-buffer-name): Compare major
|
||||
mode with second element of compilation-arguments instead of third
|
||||
to reflect latest changes in compilation-arguments structure.
|
||||
(recompile): Use global variable `compilation-directory' to get
|
||||
recent compilation directory only when `recompile' is invoked NOT
|
||||
in the compilation buffer. Otherwise, use `default-directory' of
|
||||
the compilation buffer.
|
||||
(compilation-error-properties): Allow to funcall col and end-col.
|
||||
(compilation-mode-font-lock-keywords): Check col and end-col by
|
||||
`integerp'.
|
||||
(compilation-goto-locus): If end-mk is non-nil in transient mark
|
||||
mode don't activate the mark (and don't display message in
|
||||
push-mark), but highlight overlay between mk and end-mk.
|
||||
|
||||
* progmodes/grep.el (grep-highlight-matches): New defcustom.
|
||||
(grep-regexp-alist): Add rule to highlight grep matches.
|
||||
(grep-process-setup): Set env-vars GREP_OPTIONS and GREP_COLOR.
|
||||
|
||||
* info.el (Info-fontify-node): Don't compute other-tag
|
||||
if Info-hide-note-references=hide.
|
||||
|
||||
* help.el (function-called-at-point):
|
||||
* help-fns.el (variable-at-point):
|
||||
Try `find-tag-default' when other methods failed.
|
||||
|
||||
* emacs-lisp/lisp.el (beginning-of-defun, end-of-defun):
|
||||
Do not push mark if inhibit-mark-movement is non-nil.
|
||||
|
||||
* textmodes/ispell.el (ispell-html-skip-alists):
|
||||
Fix backslashes in docstring.
|
||||
|
||||
2004-09-01 Juri Linkov <juri@jurta.org>
|
||||
|
||||
* isearch.el (isearch-wrap-function)
|
||||
(isearch-push-state-function): New defvars.
|
||||
(isearch-pop-fun-state): New defsubst.
|
||||
(isearch-top-state): Call function saved in `isearch-pop-fun-state'.
|
||||
(isearch-push-state): Set the result of calling
|
||||
`isearch-push-state-function' to the `isearch-pop-fun-state' field.
|
||||
(isearch-cancel): Call function saved in `isearch-pop-fun-state' to
|
||||
restore the mode-specific starting point of terminated search.
|
||||
(isearch-abort): Call `isearch-cancel' instead of its duplicated code.
|
||||
(isearch-repeat): Call `isearch-wrap-function' if defined.
|
||||
(isearch-message-prefix): Don't add prefix "over" to the message
|
||||
for wrapped search if `isearch-wrap-function' is defined.
|
||||
(isearch-search): Call function saved in `isearch-pop-fun-state' to
|
||||
restore the mode-specific starting point of failed search.
|
||||
|
||||
* info.el (Info-search-whitespace-regexp): Fix backslashes.
|
||||
(Info-search): Add new optional arguments for the sake of isearch.
|
||||
Replace whitespace in Info-search-whitespace-regexp literally.
|
||||
Add backward search. Don't call `Info-select-node' if regexp is
|
||||
found in the same Info node. Don't add node to Info-history for
|
||||
wrapped isearch.
|
||||
(Info-search-backward, Info-isearch-search, Info-isearch-wrap)
|
||||
(Info-isearch-push-state, Info-isearch-pop-state): New funs.
|
||||
(Info-mode): Set local variables `isearch-search-fun-function',
|
||||
`isearch-wrap-function', `isearch-push-state-function',
|
||||
`search-whitespace-regexp'.
|
||||
|
||||
* isearch.el: Remove ancient Change Log section.
|
||||
(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): Add suffix `-state' to state-related
|
||||
defsubsts to avoid name clashes with other function names.
|
||||
|
||||
* simple.el (next-error): New defgroup and defface.
|
||||
(next-error-highlight, next-error-highlight-no-select):
|
||||
New defcustoms.
|
||||
(next-error-no-select): Let-bind next-error-highlight to the value
|
||||
of next-error-highlight-no-select before calling `next-error'.
|
||||
|
||||
* progmodes/compile.el (compilation-goto-locus):
|
||||
Use `next-error' face instead of `region'. Set 4-th argument of
|
||||
`move-overlay' to `current-buffer' to move overlay to different
|
||||
source buffers. Use new variable `next-error-highlight'.
|
||||
|
||||
* simple.el (next-error-find-buffer): Move the rule
|
||||
"if current buffer is a next-error capable buffer" after the
|
||||
rule "if next-error-last-buffer is set to a live buffer".
|
||||
Simplify to test all rules in one `or'.
|
||||
(next-error): Doc fix.
|
||||
(next-error, previous-error, first-error)
|
||||
(next-error-no-select, previous-error-no-select):
|
||||
Make arguments optional.
|
||||
|
||||
2004-08-31 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* macros.el (apply-macro-to-region-lines): Make it operate on all
|
||||
lines that begin in the region, rather than on all complete lines
|
||||
in the region.
|
||||
|
||||
2004-08-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
|
||||
|
||||
* x-dnd.el (x-dnd-protocol-alist): Document update.
|
||||
(x-dnd-known-types): Defcustom it.
|
||||
(x-dnd-handle-motif): Print message-atom in error message.
|
||||
|
||||
2004-08-30 John Paul Wallington <jpw@gnu.org>
|
||||
|
||||
* textmodes/tex-mode.el (tex-validate-buffer): Use distinct
|
||||
strings rather than programatically constructing message.
|
||||
|
||||
2004-08-30 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* emacs-lisp/lisp-mode.el (prin1-char): Don't turn S-a into A.
|
||||
Don't return a string that would read as the wrong character code.
|
||||
|
||||
2004-08-29 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* emulation/cua-base.el (cua-auto-expand-rectangles): Remove
|
||||
automatic rectangle padding feature; replace by non-destructive
|
||||
virtual rectangle edges feature.
|
||||
(cua-virtual-rectangle-edges): New defcustom.
|
||||
(cua-auto-tabify-rectangles): New defcustom.
|
||||
(cua-paste): If paste into a marked rectangle, insert rectangle at
|
||||
current column, even if virtual; also paste exactly as many lines
|
||||
as has been marked (ignore additional lines or add empty lines),
|
||||
but paste whole source if only one line is marked.
|
||||
(cua--update-indications): No longer use overwrite-cursor to
|
||||
indicate rectangle padding
|
||||
|
||||
* emulation/cua-rect.el (cua--rectangle-padding): Remove.
|
||||
(cua--rectangle-virtual-edges): New defun.
|
||||
(cua--rectangle-get-corners): Remove optional PAD arg.
|
||||
(cua--rectangle-set-corners): Never do padding.
|
||||
(cua--forward-line): Remove optional PAD arg. Simplify.
|
||||
(cua-resize-rectangle-right, cua-resize-rectangle-left)
|
||||
(cua-resize-rectangle-down, cua-resize-rectangle-up):
|
||||
(cua-resize-rectangle-bot, cua-resize-rectangle-top)
|
||||
(cua-resize-rectangle-page-up, cua-resize-rectangle-page-down)
|
||||
(cua--rectangle-move): Never do padding. Simplify.
|
||||
(cua--tabify-start): New defun.
|
||||
(cua--rectangle-operation): Add tabify arg. All callers changed.
|
||||
(cua--pad-rectangle): Remove.
|
||||
(cua--delete-rectangle): Handle delete with virtual edges.
|
||||
(cua--extract-rectangle): Add spaces if rectangle has virtual edges.
|
||||
(cua--insert-rectangle): Handle insert at virtual column.
|
||||
Perform auto-tabify if necessary.
|
||||
(cua--activate-rectangle): Remove optional FORCE arg.
|
||||
Never do padding. Simplify.
|
||||
(cua--highlight-rectangle): Enhance for virtual edges.
|
||||
(cua-toggle-rectangle-padding): Remove command.
|
||||
(cua-toggle-rectangle-virtual-edges): New command.
|
||||
(cua-sequence-rectangle): Add optional TABIFY arg. Callers changed.
|
||||
(cua--rectangle-post-command): Don't force rectangle padding.
|
||||
(cua--init-rectangles): Bind M-p to cua-toggle-rectangle-virtual-edges.
|
||||
|
||||
2004-08-28 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* indent.el (edit-tab-stops-buffer): Doc fix.
|
||||
|
||||
2004-08-28 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* progmodes/grep.el (grep-default-command): Use find-tag-default.
|
||||
(grep-tag-default): Function deleted.
|
||||
|
||||
* subr.el (find-tag-default): Moved from etags.el.
|
||||
|
||||
* progmodes/etags.el (find-tag-default): Moved to subr.el.
|
||||
|
||||
* emacs-lisp/lisp-mode.el (prin1-char): Put `shift' modifier
|
||||
into the basic character if it has an uppercase form.
|
||||
|
||||
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.
|
||||
|
||||
* subr.el (kbd): Doc fix.
|
||||
|
||||
2004-08-08 John Paul Wallington <jpw@gnu.org>
|
||||
|
||||
* ibuffer.el (define-ibuffer-column size): Use `string-to-number'
|
||||
instead of `string-to-int'.
|
||||
(define-ibuffer-column mode): Fix indentation.
|
||||
|
||||
2004-08-08 Lars Hansen <larsh@math.ku.dk>
|
||||
|
||||
* wid-edit.el (widget-sexp-validate): Allow whitespace after expression.
|
||||
|
||||
2004-08-08 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* subr.el (global-unset-key, local-unset-key): Doc fixes.
|
||||
|
||||
* novice.el (disabled-command-function): New variable renamed from
|
||||
`disabled-command-hook'.
|
||||
(disabled-command-hook): Keep the _variable_ as alias for
|
||||
`disabled-command-function' and make obsolete.
|
||||
(disabled-command-function): Function renamed from
|
||||
`disabled-command-hook'. Adapt code to name change of the variable.
|
||||
|
||||
2004-08-07 Satyaki Das <satyaki@theforce.stanford.edu> (tiny change)
|
||||
|
||||
* simple.el (completion-root-regexp): New defvar.
|
||||
(completion-setup-function): Use it instead of a literal string.
|
||||
|
||||
2004-08-07 John Paul Wallington <jpw@gnu.org>
|
||||
|
||||
* emacs-lisp/re-builder.el (reb-re-syntax): Add `rx' syntax.
|
||||
(reb-lisp-mode): Require `rx' feature when `re-reb-syntax' is `rx'.
|
||||
(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.
|
||||
|
||||
2004-08-03 Kenichi Handa <handa@m17n.org>
|
||||
|
||||
* international/encoded-kb.el: The following changes are to
|
||||
utilize key-translation-map instead of minor mode map.
|
||||
(encoded-kbd-iso2022-non-ascii-map): Delete it.
|
||||
(encoded-kbd-coding, encoded-kbd-handle-8bit): Delete them.
|
||||
(encoded-kbd-last-key): New function.
|
||||
(encoded-kbd-iso2022-single-shift): New function.
|
||||
(encoded-kbd-iso2022-designation)
|
||||
(encoded-kbd-self-insert-iso2022-7bit)
|
||||
(encoded-kbd-self-insert-iso2022-8bit)
|
||||
(encoded-kbd-self-insert-sjis, encoded-kbd-self-insert-big5)
|
||||
(encoded-kbd-self-insert-ccl): Make them suitable for bindings in
|
||||
key-translation-map.
|
||||
(encoded-kbd-setup-keymap): Setup key-translation-map.
|
||||
(saved-key-translation-map): New variable.
|
||||
(encoded-kbd-mode): Save/restore key-translation-map. Adjusted
|
||||
for the change of encoded-kbd-setup-keymap.
|
||||
|
||||
2004-08-02 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* avoid.el (mouse-avoidance-point-position): Use window-inside-edges
|
||||
and call compute-motion with nil for topos and width to get proper
|
||||
usable width and height for both window and non-window systems.
|
||||
|
||||
* windmove.el (windmove-coordinates-of-position): Let compute-motion
|
||||
calculate usable window width and height.
|
||||
|
||||
* window.el (window-buffer-height): Call compute-motion with nil width.
|
||||
|
||||
2004-08-01 David Kastrup <dak@gnu.org>
|
||||
|
||||
* 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.
|
||||
|
||||
2004-08-01 John Paul Wallington <jpw@gnu.org>
|
||||
|
||||
* printing.el (toplevel, pr-ps-fast-fire, pr-ps-set-utility)
|
||||
(pr-ps-set-printer, pr-txt-set-printer, pr-eval-setting-alist)
|
||||
(pr-switches): Remove period from end of error messages.
|
||||
|
||||
* help-mode.el (help-go-back): Likewise.
|
||||
|
||||
* abbrev.el (only-global-abbrevs): Doc fix.
|
||||
(edit-abbrevs-map): Define within defvar.
|
||||
(quietly-read-abbrev-file): Doc fix.
|
||||
|
||||
2004-07-31 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* novice.el (enable-command, disable-command): Doc fixes.
|
||||
|
||||
* subr.el (event-modifiers, event-basic-type): Doc fixes.
|
||||
|
||||
2004-07-30 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* subr.el (with-local-quit): Doc fix.
|
||||
|
||||
2004-07-30 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* international/utf-8.el (utf-translate-cjk-mode): Doc fix.
|
||||
|
||||
2004-07-28 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* custom.el (defcustom): Doc fix.
|
||||
|
||||
2004-07-28 Masatake YAMATO <jet@gyve.org>
|
||||
|
||||
* progmodes/etags.el (etags-tags-apropos): Show building progress.
|
||||
|
||||
2004-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* imenu.el (imenu-prev-index-position-function)
|
||||
(imenu-extract-index-name-function, imenu-name-lookup-function)
|
||||
(imenu--index-alist): Docstring redundancy fix.
|
||||
|
||||
2004-07-25 Lars Hansen <larsh@math.ku.dk>
|
||||
|
||||
* wdired.el (wdired-finish-edit): Require dired-aux before locally
|
||||
binding dired-backup-overwrite.
|
||||
|
||||
2004-07-25 John Paul Wallington <jpw@gnu.org>
|
||||
|
||||
* subr.el (butlast, event-modifiers, event-basic-type): Doc fixes.
|
||||
|
||||
2004-07-24 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* term/tty-colors.el (tty-color-approximate): Doc fix.
|
||||
|
||||
* select.el (x-get-selection, x-set-selection): Doc fixes.
|
||||
|
||||
* frame.el (make-frame): Doc fix.
|
||||
|
||||
2004-07-24 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* mail/rmail.el (rmail-mime-charset-pattern):
|
||||
Don't include semicolon in the charset value.
|
||||
|
||||
* replace.el (occur-next-error): Call set-window-point.
|
||||
(occur-engine): Handle negative NLINES.
|
||||
|
||||
2004-07-23 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* frame.el (modify-all-frames-parameters): Minor doc fix.
|
||||
(set-frame-configuration): Doc fix.
|
||||
|
||||
2004-07-23 Matt Hodges <matt@stchem.bham.ac.uk> (tiny change)
|
||||
|
||||
* simple.el (completion-setup-function): Compute the common parts
|
||||
and the first difference place correctly when
|
||||
partial-completion-mode is on.
|
||||
|
||||
2004-07-22 Vinicius Jose Latorre <viniciusjl@ig.com.br>
|
||||
|
||||
* ps-print.el: Doc fix.
|
||||
(ps-print-version): New version 6.6.5.
|
||||
(ps-printing-region): Doc fix.
|
||||
(ps-generate-string-list): Comment fix.
|
||||
(ps-message-log-max): Code fix.
|
||||
|
||||
2004-07-22 Michael Piotrowski <mxp@dynalabs.de> (tiny change)
|
||||
|
||||
* ps-print.el (ps-begin-file): Improve the DSC compliance of the
|
||||
generated PostScript.
|
||||
|
||||
2004-08-17 Reiner Steib <Reiner.Steib@gmx.de>
|
||||
|
||||
* net/tls.el (tls-process-connection-type): Fix docstring. (Sync
|
||||
|
|
@ -22,11 +778,9 @@
|
|||
|
||||
2004-07-20 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* textmodes/fill.el (fill-comment-paragraph): Handle indent-tabs-mode.
|
||||
(fill-delete-newlines): Call sentence-end as function.
|
||||
(fill-nobreak-p, canonically-space-region): Likewise.
|
||||
(fill-nobreak-p): If this break point is at the end of the line,
|
||||
don't consider the newline which follows as a reason to return t.
|
||||
* textmodes/fill.el (fill-nobreak-p): If this break point is
|
||||
at the end of the line, don't consider the newline which follows
|
||||
as a reason to return t.
|
||||
|
||||
2004-07-19 John Paul Wallington <jpw@gnu.org>
|
||||
|
||||
|
|
@ -39,8 +793,8 @@
|
|||
|
||||
2004-07-17 Kai Grossjohann <kai.grossjohann@gmx.net>
|
||||
|
||||
* net/tramp.el (tramp-handle-verify-visited-file-modtime): New
|
||||
docstring. From Luc Teirlinck.
|
||||
* net/tramp.el (tramp-handle-verify-visited-file-modtime):
|
||||
New docstring. From Luc Teirlinck.
|
||||
|
||||
2004-07-17 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@
|
|||
;;; Code:
|
||||
|
||||
(defcustom only-global-abbrevs nil
|
||||
"*t means user plans to use global abbrevs only.
|
||||
"Non-nil means user plans to use global abbrevs only.
|
||||
This makes the commands that normally define mode-specific abbrevs
|
||||
define global abbrevs instead."
|
||||
:type 'boolean
|
||||
|
|
@ -59,13 +59,12 @@ to enable or disable Abbrev mode in the current buffer."
|
|||
:group 'abbrev-mode)
|
||||
|
||||
|
||||
(defvar edit-abbrevs-map nil
|
||||
(defvar edit-abbrevs-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\C-x\C-s" 'edit-abbrevs-redefine)
|
||||
(define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
|
||||
map)
|
||||
"Keymap used in `edit-abbrevs'.")
|
||||
(if edit-abbrevs-map
|
||||
nil
|
||||
(setq edit-abbrevs-map (make-sparse-keymap))
|
||||
(define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine)
|
||||
(define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine))
|
||||
|
||||
(defun kill-all-abbrevs ()
|
||||
"Undefine all defined abbrevs."
|
||||
|
|
@ -195,7 +194,7 @@ Optional second argument QUIETLY non-nil means don't display a message."
|
|||
(setq abbrevs-changed nil))
|
||||
|
||||
(defun quietly-read-abbrev-file (&optional file)
|
||||
"Read abbrev definitions from file written with write-abbrev-file.
|
||||
"Read abbrev definitions from file written with `write-abbrev-file'.
|
||||
Optional argument FILE is the name of the file to read;
|
||||
it defaults to the value of `abbrev-file-name'.
|
||||
Does not display any message."
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; autorevert.el --- revert buffers when files on disk change
|
||||
|
||||
;; Copyright (C) 1997, 1998, 1999, 2001 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 1997, 1998, 1999, 2001, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Anders Lindgren <andersl@andersl.com>
|
||||
;; Keywords: convenience
|
||||
|
|
@ -421,7 +421,8 @@ This is an internal function used by Auto-Revert Mode."
|
|||
'no-mini t))
|
||||
(if auto-revert-tail-mode
|
||||
(auto-revert-tail-handler)
|
||||
(revert-buffer 'ignore-auto 'dont-ask 'preserve-modes))
|
||||
(let ((buffer-read-only buffer-read-only))
|
||||
(revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)))
|
||||
(when buffer-file-name
|
||||
(when eob (goto-char (point-max)))
|
||||
(dolist (window eoblist)
|
||||
|
|
|
|||
|
|
@ -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,17 +137,17 @@ 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-edges w))
|
||||
(edges (window-inside-edges w))
|
||||
(list
|
||||
(compute-motion (max (window-start w) (point-min)) ; start pos
|
||||
;; window-start can be < point-min if the
|
||||
;; latter has changed since the last redisplay
|
||||
'(0 . 0) ; start XY
|
||||
(point) ; stop pos
|
||||
(cons (window-width) (window-height)); stop XY: none
|
||||
(1- (window-width)) ; width
|
||||
nil ; stop XY: none
|
||||
nil ; width
|
||||
(cons (window-hscroll w) 0) ; 0 may not be right?
|
||||
(selected-window))))
|
||||
;; compute-motion returns (pos HPOS VPOS prevhpos contin)
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -121,6 +121,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")
|
||||
|
|
@ -264,7 +265,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
|
||||
|
|
|
|||
|
|
@ -246,6 +246,13 @@ The following keywords are meaningful:
|
|||
Specifies that SYMBOL should be set after the list of variables
|
||||
VARIABLES when both have been customized.
|
||||
|
||||
If SYMBOL has a local binding, then this form affects the local
|
||||
binding. This is normally not what you want. Thus, if you need
|
||||
to load a file defining variables with this form, or with
|
||||
`defvar' or `defconst', you should always load that file
|
||||
_outside_ any bindings for these variables. \(`defvar' and
|
||||
`defconst' behave similarly in this respect.)
|
||||
|
||||
Read the section about customization in the Emacs Lisp manual for more
|
||||
information."
|
||||
;; It is better not to use backquote in this 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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -54,6 +54,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.
|
||||
|
|
@ -77,6 +84,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))
|
||||
|
|
@ -100,26 +124,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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -363,7 +363,7 @@ if that value is non-nil."
|
|||
(when (stringp default)
|
||||
(if (string-match ":+" default)
|
||||
(substring default (match-end 0))
|
||||
default))))
|
||||
default))))
|
||||
|
||||
;; Used in old LispM code.
|
||||
(defalias 'common-lisp-mode 'lisp-mode)
|
||||
|
|
@ -459,21 +459,37 @@ alternative printed representations that can be displayed."
|
|||
If CHAR is not a character, return nil."
|
||||
(and (integerp char)
|
||||
(eventp char)
|
||||
(let ((c (event-basic-type char)))
|
||||
(concat
|
||||
"?"
|
||||
(mapconcat
|
||||
(lambda (modif)
|
||||
(cond ((eq modif 'super) "\\s-")
|
||||
(t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
|
||||
(event-modifiers char) "")
|
||||
(cond
|
||||
((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
|
||||
((eq c 127) "\\C-?")
|
||||
(t
|
||||
(condition-case nil
|
||||
(string c)
|
||||
(error nil))))))))
|
||||
(let ((c (event-basic-type char))
|
||||
(mods (event-modifiers char))
|
||||
string)
|
||||
;; Prevent ?A from turning into ?\S-a.
|
||||
(if (and (memq 'shift mods)
|
||||
(zerop (logand char ?\S-\^@))
|
||||
(not (let ((case-fold-search nil))
|
||||
(char-equal c (upcase c)))))
|
||||
(setq c (upcase c) mods nil))
|
||||
;; What string are we considering using?
|
||||
(condition-case nil
|
||||
(setq string
|
||||
(concat
|
||||
"?"
|
||||
(mapconcat
|
||||
(lambda (modif)
|
||||
(cond ((eq modif 'super) "\\s-")
|
||||
(t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
|
||||
mods "")
|
||||
(cond
|
||||
((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
|
||||
((eq c 127) "\\C-?")
|
||||
(t
|
||||
(string c)))))
|
||||
(error nil))
|
||||
;; Verify the string reads a CHAR, not to some other character.
|
||||
;; If it doesn't, return nil instead.
|
||||
(and string
|
||||
(= (car (read-from-string string)) char)
|
||||
string))))
|
||||
|
||||
|
||||
(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
|
||||
"Evaluate sexp before point; print value in minibuffer.
|
||||
|
|
@ -555,13 +571,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))
|
||||
|
|
|
|||
|
|
@ -176,7 +176,8 @@ If variable `beginning-of-defun-function' is non-nil, its value
|
|||
is called as a function to find the defun's beginning."
|
||||
(interactive "p")
|
||||
(and (eq this-command 'beginning-of-defun)
|
||||
(or (eq last-command 'beginning-of-defun) (push-mark)))
|
||||
(or inhibit-mark-movement (eq last-command 'beginning-of-defun)
|
||||
(push-mark)))
|
||||
(and (beginning-of-defun-raw arg)
|
||||
(progn (beginning-of-line) t)))
|
||||
|
||||
|
|
@ -226,7 +227,8 @@ If variable `end-of-defun-function' is non-nil, its value
|
|||
is called as a function to find the defun's end."
|
||||
(interactive "p")
|
||||
(and (eq this-command 'end-of-defun)
|
||||
(or (eq last-command 'end-of-defun) (push-mark)))
|
||||
(or inhibit-mark-movement (eq last-command 'end-of-defun)
|
||||
(push-mark)))
|
||||
(if (or (null arg) (= arg 0)) (setq arg 1))
|
||||
(if end-of-defun-function
|
||||
(if (> arg 0)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
@ -135,6 +135,7 @@ Can either be `read', `string', `sregex' or `lisp-re'."
|
|||
(const :tag "String syntax" string)
|
||||
(const :tag "`sregex' syntax" sregex)
|
||||
(const :tag "`lisp-re' syntax" lisp-re)
|
||||
(const :tag "`rx' syntax" rx)
|
||||
(value: string)))
|
||||
|
||||
(defcustom reb-auto-match-limit 200
|
||||
|
|
@ -228,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}"
|
||||
|
|
@ -261,7 +260,9 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
|
|||
(cond ((eq reb-re-syntax 'lisp-re) ; Pull in packages
|
||||
(require 'lisp-re)) ; as needed
|
||||
((eq reb-re-syntax 'sregex) ; sregex is not autoloaded
|
||||
(require 'sregex))) ; right now..
|
||||
(require 'sregex)) ; right now..
|
||||
((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded
|
||||
(require 'rx))) ; require rx anyway
|
||||
(reb-mode-common))
|
||||
|
||||
;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from
|
||||
|
|
@ -320,7 +321,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
|
|||
|
||||
(defsubst reb-lisp-syntax-p ()
|
||||
"Return non-nil if RE Builder uses a Lisp syntax."
|
||||
(memq reb-re-syntax '(lisp-re sregex)))
|
||||
(memq reb-re-syntax '(lisp-re sregex rx)))
|
||||
|
||||
(defmacro reb-target-binding (symbol)
|
||||
"Return binding for SYMBOL in the RE Builder target buffer."
|
||||
|
|
@ -364,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))
|
||||
|
|
@ -466,10 +467,10 @@ Optional argument SYNTAX must be specified if called non-interactively."
|
|||
(list (intern
|
||||
(completing-read "Select syntax: "
|
||||
(mapcar (lambda (el) (cons (symbol-name el) 1))
|
||||
'(read string lisp-re sregex))
|
||||
'(read string lisp-re sregex rx))
|
||||
nil t (symbol-name reb-re-syntax)))))
|
||||
|
||||
(if (memq syntax '(read string lisp-re sregex))
|
||||
(if (memq syntax '(read string lisp-re sregex rx))
|
||||
(let ((buffer (get-buffer reb-buffer)))
|
||||
(setq reb-re-syntax syntax)
|
||||
(if buffer
|
||||
|
|
@ -604,6 +605,8 @@ optional fourth argument FORCE is non-nil."
|
|||
(lre-compile-string (eval (car (read-from-string re)))))
|
||||
((eq reb-re-syntax 'sregex)
|
||||
(apply 'sregex (eval (car (read-from-string re)))))
|
||||
((eq reb-re-syntax 'rx)
|
||||
(rx-to-string (eval (car (read-from-string re)))))
|
||||
(t re)))
|
||||
|
||||
(defun reb-update-regexp ()
|
||||
|
|
@ -670,7 +673,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
|
|||
(overlay-put overlay 'priority i)))
|
||||
(setq i (1+ i))))))
|
||||
(let ((count (if subexp submatches matches)))
|
||||
(message"%s %smatch%s%s"
|
||||
(message "%s %smatch%s%s"
|
||||
(if (= 0 count) "No" (int-to-string count))
|
||||
(if subexp "subexpression " "")
|
||||
(if (= 1 count) "" "es")
|
||||
|
|
|
|||
|
|
@ -141,30 +141,39 @@
|
|||
;; completely separate set of "rectangle commands" [C-x r ...] on the
|
||||
;; region to copy, kill, fill a.s.o. the virtual rectangle.
|
||||
;;
|
||||
;; cua-mode's superior rectangle support is based on using a true visual
|
||||
;; representation of the selected rectangle. To start a rectangle, use
|
||||
;; [S-return] and extend it using the normal movement keys (up, down,
|
||||
;; left, right, home, end, C-home, C-end). Once the rectangle has the
|
||||
;; desired size, you can cut or copy it using C-x and C-c (or C-w and M-w),
|
||||
;; and you can subsequently insert it - as a rectangle - using C-v (or
|
||||
;; C-y). So the only new command you need to know to work with
|
||||
;; cua-mode rectangles is S-return!
|
||||
;; cua-mode's superior rectangle support uses a true visual
|
||||
;; representation of the selected rectangle, i.e. it highlights the
|
||||
;; actual part of the buffer that is currently selected as part of the
|
||||
;; rectangle. Unlike emacs' traditional rectangle commands, the
|
||||
;; selected rectangle always as straight left and right edges, even
|
||||
;; when those are in the middle of a TAB character or beyond the end
|
||||
;; of the current line. And it does this without actually modifying
|
||||
;; the buffer contents (it uses display overlays to visualize the
|
||||
;; virtual dimensions of the rectangle).
|
||||
;;
|
||||
;; This means that cua-mode's rectangles are not limited to the actual
|
||||
;; contents of the buffer, so if the cursor is currently at the end of a
|
||||
;; short line, you can still extend the rectangle to include more columns
|
||||
;; of longer lines in the same rectangle. And you can also have the
|
||||
;; left edge of a rectangle start in the middle of a TAB character.
|
||||
;; Sounds strange? Try it!
|
||||
;;
|
||||
;; To start a rectangle, use [S-return] and extend it using the normal
|
||||
;; movement keys (up, down, left, right, home, end, C-home,
|
||||
;; C-end). Once the rectangle has the desired size, you can cut or
|
||||
;; copy it using C-x and C-c (or C-w and M-w), and you can
|
||||
;; subsequently insert it - as a rectangle - using C-v (or C-y). So
|
||||
;; the only new command you need to know to work with cua-mode
|
||||
;; rectangles is S-return!
|
||||
;;
|
||||
;; Normally, when you paste a rectangle using C-v (C-y), each line of
|
||||
;; the rectangle is inserted into the existing lines in the buffer.
|
||||
;; If overwrite-mode is active when you paste a rectangle, it is
|
||||
;; inserted as normal (multi-line) text.
|
||||
;;
|
||||
;; Furthermore, cua-mode's rectangles are not limited to the actual
|
||||
;; contents of the buffer, so if the cursor is currently at the end of a
|
||||
;; short line, you can still extend the rectangle to include more columns
|
||||
;; of longer lines in the same rectangle. Sounds strange? Try it!
|
||||
;;
|
||||
;; You can enable padding for just this rectangle by pressing [M-p];
|
||||
;; this works like entering `picture-mode' where the tabs and spaces
|
||||
;; are automatically converted/inserted to make the rectangle truly
|
||||
;; rectangular. Or you can do it for all rectangles by setting the
|
||||
;; `cua-auto-expand-rectangles' variable.
|
||||
;; If you prefer the traditional rectangle marking (i.e. don't want
|
||||
;; straight edges), [M-p] toggles this for the current rectangle,
|
||||
;; or you can customize cua-virtual-rectangle-edges.
|
||||
|
||||
;; And there's more: If you want to extend or reduce the size of the
|
||||
;; rectangle in one of the other corners of the rectangle, just use
|
||||
|
|
@ -204,8 +213,8 @@
|
|||
;; a supplied format string (prompt)
|
||||
;; [M-o] opens the rectangle by moving the highlighted text to the
|
||||
;; right of the rectangle and filling the rectangle with blanks.
|
||||
;; [M-p] toggles rectangle padding, i.e. insert tabs and spaces to
|
||||
;; make rectangles truly rectangular
|
||||
;; [M-p] toggles virtual straight rectangle edges
|
||||
;; [M-P] inserts tabs and spaces (padding) to make real straight edges
|
||||
;; [M-q] performs text filling on the rectangle
|
||||
;; [M-r] replaces REGEXP (prompt) by STRING (prompt) in rectangle
|
||||
;; [M-R] reverse the lines in the rectangle
|
||||
|
|
@ -347,14 +356,27 @@ managers, so try setting this to nil, if prefix override doesn't work."
|
|||
|
||||
;;; Rectangle Customization
|
||||
|
||||
(defcustom cua-auto-expand-rectangles nil
|
||||
"*If non-nil, rectangles are padded with spaces to make straight edges.
|
||||
This implies modifying buffer contents by expanding tabs and inserting spaces.
|
||||
Consequently, this is inhibited in read-only buffers.
|
||||
Can be toggled by [M-p] while the rectangle is active,"
|
||||
(defcustom cua-virtual-rectangle-edges t
|
||||
"*If non-nil, rectangles have virtual straight edges.
|
||||
Note that although rectangles are always DISPLAYED with straight edges, the
|
||||
buffer is NOT modified, until you execute a command that actually modifies it.
|
||||
\[M-p] toggles this feature when a rectangle is active."
|
||||
:type 'boolean
|
||||
:group 'cua)
|
||||
|
||||
(defcustom cua-auto-tabify-rectangles 1000
|
||||
"*If non-nil, automatically tabify after rectangle commands.
|
||||
This basically means that `tabify' is applied to all lines that
|
||||
are modified by inserting or deleting a rectangle. If value is
|
||||
an integer, cua will look for existing tabs in a region around
|
||||
the rectangle, and only do the conversion if any tabs are already
|
||||
present. The number specifies then number of characters before
|
||||
and after the region marked by the rectangle to search."
|
||||
:type '(choice (number :tag "Auto detect (limit)")
|
||||
(const :tag "Disabled" nil)
|
||||
(other :tag "Enabled" t))
|
||||
:group 'cua)
|
||||
|
||||
(defcustom cua-enable-rectangle-auto-help t
|
||||
"*If non-nil, automatically show help for region, rectangle and global mark."
|
||||
:type 'boolean
|
||||
|
|
@ -412,7 +434,6 @@ Can be toggled by [M-p] while the rectangle is active,"
|
|||
(frame-parameter nil 'cursor-color)
|
||||
"red")
|
||||
"Normal (non-overwrite) cursor color.
|
||||
Also used to indicate that rectangle padding is not in effect.
|
||||
Default is to load cursor color from initial or default frame parameters.
|
||||
|
||||
If the value is a COLOR name, then only the `cursor-color' attribute will be
|
||||
|
|
@ -462,7 +483,6 @@ a cons (TYPE . COLOR), then both properties are affected."
|
|||
|
||||
(defcustom cua-overwrite-cursor-color "yellow"
|
||||
"*Cursor color used when overwrite mode is set, if non-nil.
|
||||
Also used to indicate that rectangle padding is in effect.
|
||||
Only used when `cua-enable-cursor-indications' is non-nil.
|
||||
|
||||
If the value is a COLOR name, then only the `cursor-color' attribute will be
|
||||
|
|
@ -806,7 +826,8 @@ If global mark is active, copy from register or one character."
|
|||
(interactive "P")
|
||||
(setq arg (cua--prefix-arg arg))
|
||||
(let ((regtxt (and cua--register (get-register cua--register)))
|
||||
(count (prefix-numeric-value arg)))
|
||||
(count (prefix-numeric-value arg))
|
||||
paste-column paste-lines)
|
||||
(cond
|
||||
((and cua--register (not regtxt))
|
||||
(message "Nothing in register %c" cua--register))
|
||||
|
|
@ -825,7 +846,12 @@ If global mark is active, copy from register or one character."
|
|||
;; the same region that we are going to delete.
|
||||
;; That would make yank a no-op.
|
||||
(if cua--rectangle
|
||||
(cua--delete-rectangle)
|
||||
(progn
|
||||
(goto-char (min (mark) (point)))
|
||||
(setq paste-column (cua--rectangle-left))
|
||||
(setq paste-lines (cua--delete-rectangle))
|
||||
(if (= paste-lines 1)
|
||||
(setq paste-lines nil))) ;; paste all
|
||||
(if (string= (buffer-substring (point) (mark))
|
||||
(car kill-ring))
|
||||
(current-kill 1))
|
||||
|
|
@ -843,7 +869,8 @@ If global mark is active, copy from register or one character."
|
|||
(setq this-command 'cua--paste-rectangle)
|
||||
(undo-boundary)
|
||||
(setq buffer-undo-list (cons pt buffer-undo-list)))
|
||||
(cua--insert-rectangle (cdr cua--last-killed-rectangle))
|
||||
(cua--insert-rectangle (cdr cua--last-killed-rectangle)
|
||||
nil paste-column paste-lines)
|
||||
(if arg (goto-char pt))))
|
||||
(t (yank arg)))))))
|
||||
|
||||
|
|
@ -1033,9 +1060,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
|
|||
((and buffer-read-only
|
||||
cua-read-only-cursor-color)
|
||||
cua-read-only-cursor-color)
|
||||
((and cua-overwrite-cursor-color
|
||||
(or overwrite-mode
|
||||
(and cua--rectangle (cua--rectangle-padding))))
|
||||
((and cua-overwrite-cursor-color overwrite-mode)
|
||||
cua-overwrite-cursor-color)
|
||||
(t cua-normal-cursor-color)))
|
||||
(color (if (consp cursor) (cdr cursor) cursor))
|
||||
|
|
|
|||
|
|
@ -44,10 +44,10 @@
|
|||
(require 'rect)
|
||||
|
||||
;; If non-nil, restrict current region to this rectangle.
|
||||
;; Value is a vector [top bot left right corner ins pad select].
|
||||
;; Value is a vector [top bot left right corner ins virt select].
|
||||
;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
|
||||
;; INS specifies whether to insert on left(nil) or right(t) side.
|
||||
;; If PAD is non-nil, tabs are converted to spaces when necessary.
|
||||
;; If VIRT is non-nil, virtual straight edges are enabled.
|
||||
;; If SELECT is a regexp, only lines starting with that regexp are affected.")
|
||||
(defvar cua--rectangle nil)
|
||||
(make-variable-buffer-local 'cua--rectangle)
|
||||
|
|
@ -65,6 +65,12 @@
|
|||
(defvar cua--rectangle-overlays nil)
|
||||
(make-variable-buffer-local 'cua--rectangle-overlays)
|
||||
|
||||
(defvar cua--overlay-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\r" 'cua-rotate-rectangle)))
|
||||
|
||||
(defvar cua--virtual-edges-debug nil)
|
||||
|
||||
;; Per-buffer CUA mode undo list.
|
||||
(defvar cua--undo-list nil)
|
||||
(make-variable-buffer-local 'cua--undo-list)
|
||||
|
|
@ -97,7 +103,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(defvar cua--tidy-undo-counter 0
|
||||
"Number of times `cua--tidy-undo-lists' have run successfully.")
|
||||
|
||||
;; Clean out danling entries from cua's undo list.
|
||||
;; Clean out dangling entries from cua's undo list.
|
||||
;; Since this list contains pointers into the standard undo list,
|
||||
;; such references are only meningful as undo information if the
|
||||
;; corresponding entry is still on the standard undo list.
|
||||
|
|
@ -203,11 +209,11 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(aref cua--rectangle 5))
|
||||
(cua--rectangle-left))))
|
||||
|
||||
(defun cua--rectangle-padding (&optional set val)
|
||||
;; Current setting of rectangle padding
|
||||
(defun cua--rectangle-virtual-edges (&optional set val)
|
||||
;; Current setting of rectangle virtual-edges
|
||||
(if set
|
||||
(aset cua--rectangle 6 val))
|
||||
(and (not buffer-read-only)
|
||||
(and ;(not buffer-read-only)
|
||||
(aref cua--rectangle 6)))
|
||||
|
||||
(defun cua--rectangle-restriction (&optional val bounded negated)
|
||||
|
|
@ -226,7 +232,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(if (< (cua--rectangle-bot) (cua--rectangle-top))
|
||||
(message "rectangle bot < top")))
|
||||
|
||||
(defun cua--rectangle-get-corners (&optional pad)
|
||||
(defun cua--rectangle-get-corners ()
|
||||
;; Calculate the rectangular region represented by point and mark,
|
||||
;; putting start in the upper left corner and end in the
|
||||
;; bottom right corner.
|
||||
|
|
@ -245,12 +251,12 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(setq r (1- r)))
|
||||
(setq l (prog1 r (setq r l)))
|
||||
(goto-char top)
|
||||
(move-to-column l pad)
|
||||
(move-to-column l)
|
||||
(setq top (point))
|
||||
(goto-char bot)
|
||||
(move-to-column r pad)
|
||||
(move-to-column r)
|
||||
(setq bot (point))))
|
||||
(vector top bot l r corner 0 pad nil)))
|
||||
(vector top bot l r corner 0 cua-virtual-rectangle-edges nil)))
|
||||
|
||||
(defun cua--rectangle-set-corners ()
|
||||
;; Set mark and point in opposite corners of current rectangle.
|
||||
|
|
@ -269,24 +275,31 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(setq pp (cua--rectangle-bot) pc (cua--rectangle-right)
|
||||
mp (cua--rectangle-top) mc (cua--rectangle-left))))
|
||||
(goto-char mp)
|
||||
(move-to-column mc (cua--rectangle-padding))
|
||||
(move-to-column mc)
|
||||
(set-mark (point))
|
||||
(goto-char pp)
|
||||
(move-to-column pc (cua--rectangle-padding))))
|
||||
;; Move cursor inside rectangle, except if char at rigth edge is a tab.
|
||||
(if (and (if (cua--rectangle-right-side)
|
||||
(and (= (move-to-column pc) (- pc tab-width))
|
||||
(not (eolp)))
|
||||
(> (move-to-column pc) pc))
|
||||
(not (bolp)))
|
||||
(backward-char 1))
|
||||
))
|
||||
|
||||
;;; Rectangle resizing
|
||||
|
||||
(defun cua--forward-line (n pad)
|
||||
(defun cua--forward-line (n)
|
||||
;; Move forward/backward one line. Returns t if movement.
|
||||
(if (or (not pad) (< n 0))
|
||||
(= (forward-line n) 0)
|
||||
(next-line 1)
|
||||
t))
|
||||
(let ((pt (point)))
|
||||
(and (= (forward-line n) 0)
|
||||
;; Deal with end of buffer
|
||||
(or (not (eobp))
|
||||
(goto-char pt)))))
|
||||
|
||||
(defun cua--rectangle-resized ()
|
||||
;; Refresh state after resizing rectangle
|
||||
(setq cua--buffer-and-point-before-command nil)
|
||||
(cua--pad-rectangle)
|
||||
(cua--rectangle-insert-col 0)
|
||||
(cua--rectangle-set-corners)
|
||||
(cua--keep-active))
|
||||
|
|
@ -294,47 +307,35 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(defun cua-resize-rectangle-right (n)
|
||||
"Resize rectangle to the right."
|
||||
(interactive "p")
|
||||
(let ((pad (cua--rectangle-padding)) (resized (> n 0)))
|
||||
(let ((resized (> n 0)))
|
||||
(while (> n 0)
|
||||
(setq n (1- n))
|
||||
(cond
|
||||
((and (cua--rectangle-right-side) (or pad (eolp)))
|
||||
(cua--rectangle-right (1+ (cua--rectangle-right)))
|
||||
(move-to-column (cua--rectangle-right) pad))
|
||||
((cua--rectangle-right-side)
|
||||
(forward-char 1)
|
||||
(cua--rectangle-right (current-column)))
|
||||
((or pad (eolp))
|
||||
(cua--rectangle-left (1+ (cua--rectangle-left)))
|
||||
(move-to-column (cua--rectangle-right) pad))
|
||||
(cua--rectangle-right (1+ (cua--rectangle-right)))
|
||||
(move-to-column (cua--rectangle-right)))
|
||||
(t
|
||||
(forward-char 1)
|
||||
(cua--rectangle-left (current-column)))))
|
||||
(cua--rectangle-left (1+ (cua--rectangle-left)))
|
||||
(move-to-column (cua--rectangle-right)))))
|
||||
(if resized
|
||||
(cua--rectangle-resized))))
|
||||
|
||||
(defun cua-resize-rectangle-left (n)
|
||||
"Resize rectangle to the left."
|
||||
(interactive "p")
|
||||
(let ((pad (cua--rectangle-padding)) resized)
|
||||
(let (resized)
|
||||
(while (> n 0)
|
||||
(setq n (1- n))
|
||||
(if (or (= (cua--rectangle-right) 0)
|
||||
(and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0)))
|
||||
(setq n 0)
|
||||
(cond
|
||||
((and (cua--rectangle-right-side) (or pad (eolp) (bolp)))
|
||||
(cua--rectangle-right (1- (cua--rectangle-right)))
|
||||
(move-to-column (cua--rectangle-right) pad))
|
||||
((cua--rectangle-right-side)
|
||||
(backward-char 1)
|
||||
(cua--rectangle-right (current-column)))
|
||||
((or pad (eolp) (bolp))
|
||||
(cua--rectangle-left (1- (cua--rectangle-left)))
|
||||
(move-to-column (cua--rectangle-right) pad))
|
||||
(cua--rectangle-right (1- (cua--rectangle-right)))
|
||||
(move-to-column (cua--rectangle-right)))
|
||||
(t
|
||||
(backward-char 1)
|
||||
(cua--rectangle-left (current-column))))
|
||||
(cua--rectangle-left (1- (cua--rectangle-left)))
|
||||
(move-to-column (cua--rectangle-right))))
|
||||
(setq resized t)))
|
||||
(if resized
|
||||
(cua--rectangle-resized))))
|
||||
|
|
@ -342,20 +343,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(defun cua-resize-rectangle-down (n)
|
||||
"Resize rectangle downwards."
|
||||
(interactive "p")
|
||||
(let ((pad (cua--rectangle-padding)) resized)
|
||||
(let (resized)
|
||||
(while (> n 0)
|
||||
(setq n (1- n))
|
||||
(cond
|
||||
((>= (cua--rectangle-corner) 2)
|
||||
(goto-char (cua--rectangle-bot))
|
||||
(when (cua--forward-line 1 pad)
|
||||
(move-to-column (cua--rectangle-column) pad)
|
||||
(when (cua--forward-line 1)
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(cua--rectangle-bot t)
|
||||
(setq resized t)))
|
||||
(t
|
||||
(goto-char (cua--rectangle-top))
|
||||
(when (cua--forward-line 1 pad)
|
||||
(move-to-column (cua--rectangle-column) pad)
|
||||
(when (cua--forward-line 1)
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(cua--rectangle-top t)
|
||||
(setq resized t)))))
|
||||
(if resized
|
||||
|
|
@ -364,20 +365,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(defun cua-resize-rectangle-up (n)
|
||||
"Resize rectangle upwards."
|
||||
(interactive "p")
|
||||
(let ((pad (cua--rectangle-padding)) resized)
|
||||
(let (resized)
|
||||
(while (> n 0)
|
||||
(setq n (1- n))
|
||||
(cond
|
||||
((>= (cua--rectangle-corner) 2)
|
||||
(goto-char (cua--rectangle-bot))
|
||||
(when (cua--forward-line -1 pad)
|
||||
(move-to-column (cua--rectangle-column) pad)
|
||||
(when (cua--forward-line -1)
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(cua--rectangle-bot t)
|
||||
(setq resized t)))
|
||||
(t
|
||||
(goto-char (cua--rectangle-top))
|
||||
(when (cua--forward-line -1 pad)
|
||||
(move-to-column (cua--rectangle-column) pad)
|
||||
(when (cua--forward-line -1)
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(cua--rectangle-top t)
|
||||
(setq resized t)))))
|
||||
(if resized
|
||||
|
|
@ -408,7 +409,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
"Resize rectangle to bottom of buffer."
|
||||
(interactive)
|
||||
(goto-char (point-max))
|
||||
(move-to-column (cua--rectangle-column) (cua--rectangle-padding))
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(cua--rectangle-bot t)
|
||||
(cua--rectangle-resized))
|
||||
|
||||
|
|
@ -416,31 +417,29 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
"Resize rectangle to top of buffer."
|
||||
(interactive)
|
||||
(goto-char (point-min))
|
||||
(move-to-column (cua--rectangle-column) (cua--rectangle-padding))
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(cua--rectangle-top t)
|
||||
(cua--rectangle-resized))
|
||||
|
||||
(defun cua-resize-rectangle-page-up ()
|
||||
"Resize rectangle upwards by one scroll page."
|
||||
(interactive)
|
||||
(let ((pad (cua--rectangle-padding)))
|
||||
(scroll-down)
|
||||
(move-to-column (cua--rectangle-column) pad)
|
||||
(if (>= (cua--rectangle-corner) 2)
|
||||
(cua--rectangle-bot t)
|
||||
(cua--rectangle-top t))
|
||||
(cua--rectangle-resized)))
|
||||
(scroll-down)
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(if (>= (cua--rectangle-corner) 2)
|
||||
(cua--rectangle-bot t)
|
||||
(cua--rectangle-top t))
|
||||
(cua--rectangle-resized))
|
||||
|
||||
(defun cua-resize-rectangle-page-down ()
|
||||
"Resize rectangle downwards by one scroll page."
|
||||
(interactive)
|
||||
(let ((pad (cua--rectangle-padding)))
|
||||
(scroll-up)
|
||||
(move-to-column (cua--rectangle-column) pad)
|
||||
(if (>= (cua--rectangle-corner) 2)
|
||||
(cua--rectangle-bot t)
|
||||
(cua--rectangle-top t))
|
||||
(cua--rectangle-resized)))
|
||||
(scroll-up)
|
||||
(move-to-column (cua--rectangle-column))
|
||||
(if (>= (cua--rectangle-corner) 2)
|
||||
(cua--rectangle-bot t)
|
||||
(cua--rectangle-top t))
|
||||
(cua--rectangle-resized))
|
||||
|
||||
;;; Mouse support
|
||||
|
||||
|
|
@ -450,7 +449,8 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
"Set rectangle corner at mouse click position."
|
||||
(interactive "e")
|
||||
(mouse-set-point event)
|
||||
(if (cua--rectangle-padding)
|
||||
;; FIX ME -- need to calculate virtual column.
|
||||
(if (cua--rectangle-virtual-edges)
|
||||
(move-to-column (car (posn-col-row (event-end event))) t))
|
||||
(if (cua--rectangle-right-side)
|
||||
(cua--rectangle-right (current-column))
|
||||
|
|
@ -470,6 +470,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
|
|||
(cua--deactivate t))
|
||||
(setq cua--last-rectangle nil)
|
||||
(mouse-set-point event)
|
||||
;; FIX ME -- need to calculate virtual column.
|
||||
(cua-set-rectangle-mark)
|
||||
(setq cua--buffer-and-point-before-command nil)
|
||||
(setq cua--mouse-last-pos nil))
|
||||
|
|
@ -489,13 +490,13 @@ If command is repeated at same position, delete the rectangle."
|
|||
(let ((cua-keep-region-after-copy t))
|
||||
(cua-copy-rectangle arg)
|
||||
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
|
||||
|
||||
(defun cua--mouse-ignore (event)
|
||||
(interactive "e")
|
||||
(setq this-command last-command))
|
||||
|
||||
(defun cua--rectangle-move (dir)
|
||||
(let ((pad (cua--rectangle-padding))
|
||||
(moved t)
|
||||
(let ((moved t)
|
||||
(top (cua--rectangle-top))
|
||||
(bot (cua--rectangle-bot))
|
||||
(l (cua--rectangle-left))
|
||||
|
|
@ -503,17 +504,17 @@ If command is repeated at same position, delete the rectangle."
|
|||
(cond
|
||||
((eq dir 'up)
|
||||
(goto-char top)
|
||||
(when (cua--forward-line -1 pad)
|
||||
(when (cua--forward-line -1)
|
||||
(cua--rectangle-top t)
|
||||
(goto-char bot)
|
||||
(forward-line -1)
|
||||
(cua--rectangle-bot t)))
|
||||
((eq dir 'down)
|
||||
(goto-char bot)
|
||||
(when (cua--forward-line 1 pad)
|
||||
(when (cua--forward-line 1)
|
||||
(cua--rectangle-bot t)
|
||||
(goto-char top)
|
||||
(cua--forward-line 1 pad)
|
||||
(cua--forward-line 1)
|
||||
(cua--rectangle-top t)))
|
||||
((eq dir 'left)
|
||||
(when (> l 0)
|
||||
|
|
@ -526,19 +527,37 @@ If command is repeated at same position, delete the rectangle."
|
|||
(setq moved nil)))
|
||||
(when moved
|
||||
(setq cua--buffer-and-point-before-command nil)
|
||||
(cua--pad-rectangle)
|
||||
(cua--rectangle-set-corners)
|
||||
(cua--keep-active))))
|
||||
|
||||
|
||||
;;; Operations on current rectangle
|
||||
|
||||
(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct)
|
||||
(defun cua--tabify-start (start end)
|
||||
;; Return position where auto-tabify should start (or nil if not required).
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(and (not buffer-read-only)
|
||||
cua-auto-tabify-rectangles
|
||||
(if (or (not (integerp cua-auto-tabify-rectangles))
|
||||
(= (point-min) (point-max))
|
||||
(progn
|
||||
(goto-char (max (point-min)
|
||||
(- start cua-auto-tabify-rectangles)))
|
||||
(search-forward "\t" (min (point-max)
|
||||
(+ end cua-auto-tabify-rectangles)) t)))
|
||||
start)))))
|
||||
|
||||
(defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct)
|
||||
;; Call FCT for each line of region with 4 parameters:
|
||||
;; Region start, end, left-col, right-col
|
||||
;; Point is at start when FCT is called
|
||||
;; Call fct with (s,e) = whole lines if VISIBLE non-nil.
|
||||
;; Only call fct for visible lines if VISIBLE==t.
|
||||
;; Set undo boundary if UNDO is non-nil.
|
||||
;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding)
|
||||
;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
|
||||
;; Perform auto-tabify after operation if TABIFY is non-nil.
|
||||
;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
|
||||
(let* ((start (cua--rectangle-top))
|
||||
(end (cua--rectangle-bot))
|
||||
|
|
@ -546,11 +565,12 @@ If command is repeated at same position, delete the rectangle."
|
|||
(r (1+ (cua--rectangle-right)))
|
||||
(m (make-marker))
|
||||
(tabpad (and (integerp pad) (= pad 2)))
|
||||
(sel (cua--rectangle-restriction)))
|
||||
(sel (cua--rectangle-restriction))
|
||||
(tabify-start (and tabify (cua--tabify-start start end))))
|
||||
(if undo
|
||||
(cua--rectangle-undo-boundary))
|
||||
(if (integerp pad)
|
||||
(setq pad (cua--rectangle-padding)))
|
||||
(setq pad (cua--rectangle-virtual-edges)))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
|
|
@ -558,11 +578,13 @@ If command is repeated at same position, delete the rectangle."
|
|||
(goto-char end)
|
||||
(and (bolp) (not (eolp)) (not (eobp))
|
||||
(setq end (1+ end))))
|
||||
(when visible
|
||||
(when (eq visible t)
|
||||
(setq start (max (window-start) start))
|
||||
(setq end (min (window-end) end)))
|
||||
(goto-char end)
|
||||
(setq end (line-end-position))
|
||||
(if (and visible (bolp) (not (eobp)))
|
||||
(setq end (1+ end)))
|
||||
(goto-char start)
|
||||
(setq start (line-beginning-position))
|
||||
(narrow-to-region start end)
|
||||
|
|
@ -575,7 +597,7 @@ If command is repeated at same position, delete the rectangle."
|
|||
(forward-char 1))
|
||||
(set-marker m (point))
|
||||
(move-to-column l pad)
|
||||
(if (and fct (>= (current-column) l) (<= (current-column) r))
|
||||
(if (and fct (or visible (and (>= (current-column) l) (<= (current-column) r))))
|
||||
(let ((v t) (p (point)))
|
||||
(when sel
|
||||
(if (car (cdr sel))
|
||||
|
|
@ -585,8 +607,7 @@ If command is repeated at same position, delete the rectangle."
|
|||
(if (car (cdr (cdr sel)))
|
||||
(setq v (null v))))
|
||||
(if visible
|
||||
(unless (eolp)
|
||||
(funcall fct p m l r v))
|
||||
(funcall fct p m l r v)
|
||||
(if v
|
||||
(funcall fct p m l r)))))
|
||||
(set-marker m nil)
|
||||
|
|
@ -594,7 +615,9 @@ If command is repeated at same position, delete the rectangle."
|
|||
(if (not visible)
|
||||
(cua--rectangle-bot t))
|
||||
(if post-fct
|
||||
(funcall post-fct l r))))
|
||||
(funcall post-fct l r))
|
||||
(when tabify-start
|
||||
(tabify tabify-start (point)))))
|
||||
(cond
|
||||
((eq keep-clear 'keep)
|
||||
(cua--keep-active))
|
||||
|
|
@ -607,48 +630,96 @@ If command is repeated at same position, delete the rectangle."
|
|||
|
||||
(put 'cua--rectangle-operation 'lisp-indent-function 4)
|
||||
|
||||
(defun cua--pad-rectangle (&optional pad)
|
||||
(if (or pad (cua--rectangle-padding))
|
||||
(cua--rectangle-operation nil nil t t)))
|
||||
|
||||
(defun cua--delete-rectangle ()
|
||||
(cua--rectangle-operation nil nil t 2
|
||||
'(lambda (s e l r)
|
||||
(if (and (> e s) (<= e (point-max)))
|
||||
(delete-region s e)))))
|
||||
(let ((lines 0))
|
||||
(if (not (cua--rectangle-virtual-edges))
|
||||
(cua--rectangle-operation nil nil t 2 t
|
||||
'(lambda (s e l r v)
|
||||
(setq lines (1+ lines))
|
||||
(if (and (> e s) (<= e (point-max)))
|
||||
(delete-region s e))))
|
||||
(cua--rectangle-operation nil 1 t nil t
|
||||
'(lambda (s e l r v)
|
||||
(setq lines (1+ lines))
|
||||
(when (and (> e s) (<= e (point-max)))
|
||||
(delete-region s e)))))
|
||||
lines))
|
||||
|
||||
(defun cua--extract-rectangle ()
|
||||
(let (rect)
|
||||
(cua--rectangle-operation nil nil nil 1
|
||||
'(lambda (s e l r)
|
||||
(setq rect (cons (buffer-substring-no-properties s e) rect))))
|
||||
(nreverse rect)))
|
||||
(if (not (cua--rectangle-virtual-edges))
|
||||
(cua--rectangle-operation nil nil nil nil nil ; do not tabify
|
||||
'(lambda (s e l r)
|
||||
(setq rect (cons (buffer-substring-no-properties s e) rect))))
|
||||
(cua--rectangle-operation nil 1 nil nil nil ; do not tabify
|
||||
'(lambda (s e l r v)
|
||||
(let ((copy t) (bs 0) (as 0) row)
|
||||
(if (= s e) (setq e (1+ e)))
|
||||
(goto-char s)
|
||||
(move-to-column l)
|
||||
(if (= (point) (line-end-position))
|
||||
(setq bs (- r l)
|
||||
copy nil)
|
||||
(skip-chars-forward "\s\t" e)
|
||||
(setq bs (- (min r (current-column)) l)
|
||||
s (point))
|
||||
(move-to-column r)
|
||||
(skip-chars-backward "\s\t" s)
|
||||
(setq as (- r (max (current-column) l))
|
||||
e (point)))
|
||||
(setq row (if (and copy (> e s))
|
||||
(buffer-substring-no-properties s e)
|
||||
""))
|
||||
(when (> bs 0)
|
||||
(setq row (concat (make-string bs ?\s) row)))
|
||||
(when (> as 0)
|
||||
(setq row (concat row (make-string as ?\s))))
|
||||
(setq rect (cons row rect))))))
|
||||
(nreverse rect)))
|
||||
|
||||
(defun cua--insert-rectangle (rect &optional below)
|
||||
(defun cua--insert-rectangle (rect &optional below paste-column line-count)
|
||||
;; Insert rectangle as insert-rectangle, but don't set mark and exit with
|
||||
;; point at either next to top right or below bottom left corner
|
||||
;; Notice: In overwrite mode, the rectangle is inserted as separate text lines.
|
||||
(if (and below (eq below 'auto))
|
||||
(if (eq below 'auto)
|
||||
(setq below (and (bolp)
|
||||
(or (eolp) (eobp) (= (1+ (point)) (point-max))))))
|
||||
(unless paste-column
|
||||
(setq paste-column (current-column)))
|
||||
(let ((lines rect)
|
||||
(insertcolumn (current-column))
|
||||
(first t)
|
||||
(tabify-start (cua--tabify-start (point) (point)))
|
||||
last-column
|
||||
p)
|
||||
(while (or lines below)
|
||||
(or first
|
||||
(if overwrite-mode
|
||||
(insert ?\n)
|
||||
(forward-line 1)
|
||||
(or (bolp) (insert ?\n))
|
||||
(move-to-column insertcolumn t)))
|
||||
(or (bolp) (insert ?\n))))
|
||||
(unless overwrite-mode
|
||||
(move-to-column paste-column t))
|
||||
(if (not lines)
|
||||
(setq below nil)
|
||||
(insert-for-yank (car lines))
|
||||
(unless last-column
|
||||
(setq last-column (current-column)))
|
||||
(setq lines (cdr lines))
|
||||
(and first (not below)
|
||||
(setq p (point))))
|
||||
(setq first nil))
|
||||
(setq first nil)
|
||||
(if (and line-count (= (setq line-count (1- line-count)) 0))
|
||||
(setq lines nil)))
|
||||
(when (and line-count last-column (not overwrite-mode))
|
||||
(while (> line-count 0)
|
||||
(forward-line 1)
|
||||
(or (bolp) (insert ?\n))
|
||||
(move-to-column paste-column t)
|
||||
(insert-char ?\s (- last-column paste-column -1))
|
||||
(setq line-count (1- line-count))))
|
||||
(when (and tabify-start
|
||||
(not overwrite-mode))
|
||||
(tabify tabify-start (point)))
|
||||
(and p (not overwrite-mode)
|
||||
(goto-char p))))
|
||||
|
||||
|
|
@ -662,7 +733,7 @@ If command is repeated at same position, delete the rectangle."
|
|||
(function (lambda (row) (concat row "\n")))
|
||||
killed-rectangle "")))))
|
||||
|
||||
(defun cua--activate-rectangle (&optional force)
|
||||
(defun cua--activate-rectangle ()
|
||||
;; Turn on rectangular marking mode by disabling transient mark mode
|
||||
;; and manually handling highlighting from a post command hook.
|
||||
;; Be careful if we are already marking a rectangle.
|
||||
|
|
@ -671,12 +742,8 @@ If command is repeated at same position, delete the rectangle."
|
|||
(eq (car cua--last-rectangle) (current-buffer))
|
||||
(eq (car (cdr cua--last-rectangle)) (point)))
|
||||
(cdr (cdr cua--last-rectangle))
|
||||
(cua--rectangle-get-corners
|
||||
(and (not buffer-read-only)
|
||||
(or cua-auto-expand-rectangles
|
||||
force
|
||||
(eq major-mode 'picture-mode)))))
|
||||
cua--status-string (if (cua--rectangle-padding) " Pad" "")
|
||||
(cua--rectangle-get-corners))
|
||||
cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "")
|
||||
cua--last-rectangle nil))
|
||||
|
||||
;; (defvar cua-save-point nil)
|
||||
|
|
@ -698,7 +765,7 @@ If command is repeated at same position, delete the rectangle."
|
|||
;; Each overlay extends across all the columns of the rectangle.
|
||||
;; We try to reuse overlays where possible because this is more efficient
|
||||
;; and results in less flicker.
|
||||
;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines,
|
||||
;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or short lines,
|
||||
;; the higlighted region may not be perfectly rectangular.
|
||||
(let ((deactivate-mark deactivate-mark)
|
||||
(old cua--rectangle-overlays)
|
||||
|
|
@ -707,12 +774,67 @@ If command is repeated at same position, delete the rectangle."
|
|||
(right (1+ (cua--rectangle-right))))
|
||||
(when (/= left right)
|
||||
(sit-for 0) ; make window top/bottom reliable
|
||||
(cua--rectangle-operation nil t nil nil
|
||||
(cua--rectangle-operation nil t nil nil nil ; do not tabify
|
||||
'(lambda (s e l r v)
|
||||
(let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face))
|
||||
overlay)
|
||||
;; Trim old leading overlays.
|
||||
overlay bs ms as)
|
||||
(if (= s e) (setq e (1+ e)))
|
||||
(when (cua--rectangle-virtual-edges)
|
||||
(let ((lb (line-beginning-position))
|
||||
(le (line-end-position))
|
||||
cl cl0 pl cr cr0 pr)
|
||||
(goto-char s)
|
||||
(setq cl (move-to-column l)
|
||||
pl (point))
|
||||
(setq cr (move-to-column r)
|
||||
pr (point))
|
||||
(if (= lb pl)
|
||||
(setq cl0 0)
|
||||
(goto-char (1- pl))
|
||||
(setq cl0 (current-column)))
|
||||
(if (= lb le)
|
||||
(setq cr0 0)
|
||||
(goto-char (1- pr))
|
||||
(setq cr0 (current-column)))
|
||||
(unless (and (= cl l) (= cr r))
|
||||
(when (/= cl l)
|
||||
(setq bs (propertize
|
||||
(make-string
|
||||
(- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
|
||||
(if cua--virtual-edges-debug ?. ?\s))
|
||||
'face 'default))
|
||||
(if (/= pl le)
|
||||
(setq s (1- s))))
|
||||
(cond
|
||||
((= cr r)
|
||||
(if (and (/= pr le)
|
||||
(/= cr0 (1- cr))
|
||||
(or bs (/= cr0 (- cr tab-width)))
|
||||
(/= (mod cr tab-width) 0))
|
||||
(setq e (1- e))))
|
||||
((= cr cl)
|
||||
(setq ms (propertize
|
||||
(make-string
|
||||
(- r l)
|
||||
(if cua--virtual-edges-debug ?, ?\s))
|
||||
'face rface))
|
||||
(if (cua--rectangle-right-side)
|
||||
(put-text-property (1- (length ms)) (length ms) 'cursor t ms)
|
||||
(put-text-property 0 1 'cursor t ms))
|
||||
(setq bs (concat bs ms))
|
||||
(setq rface nil))
|
||||
(t
|
||||
(setq as (propertize
|
||||
(make-string
|
||||
(- r cr0 (if (= le pr) 1 0))
|
||||
(if cua--virtual-edges-debug ?~ ?\s))
|
||||
'face rface))
|
||||
(if (cua--rectangle-right-side)
|
||||
(put-text-property (1- (length as)) (length as) 'cursor t as)
|
||||
(put-text-property 0 1 'cursor t as))
|
||||
(if (/= pr le)
|
||||
(setq e (1- e))))))))
|
||||
;; Trim old leading overlays.
|
||||
(while (and old
|
||||
(setq overlay (car old))
|
||||
(< (overlay-start overlay) s)
|
||||
|
|
@ -728,8 +850,11 @@ If command is repeated at same position, delete the rectangle."
|
|||
(move-overlay overlay s e)
|
||||
(setq old (cdr old)))
|
||||
(setq overlay (make-overlay s e)))
|
||||
(overlay-put overlay 'face rface)
|
||||
(setq new (cons overlay new))))))
|
||||
(overlay-put overlay 'before-string bs)
|
||||
(overlay-put overlay 'after-string as)
|
||||
(overlay-put overlay 'face rface)
|
||||
(overlay-put overlay 'keymap cua--overlay-keymap)
|
||||
(setq new (cons overlay new))))))
|
||||
;; Trim old trailing overlays.
|
||||
(mapcar (function delete-overlay) old)
|
||||
(setq cua--rectangle-overlays (nreverse new))))
|
||||
|
|
@ -737,9 +862,9 @@ If command is repeated at same position, delete the rectangle."
|
|||
(defun cua--indent-rectangle (&optional ch to-col clear)
|
||||
;; Indent current rectangle.
|
||||
(let ((col (cua--rectangle-insert-col))
|
||||
(pad (cua--rectangle-padding))
|
||||
(pad (cua--rectangle-virtual-edges))
|
||||
indent)
|
||||
(cua--rectangle-operation (if clear 'clear 'corners) nil t pad
|
||||
(cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil
|
||||
'(lambda (s e l r)
|
||||
(move-to-column col pad)
|
||||
(if (and (eolp)
|
||||
|
|
@ -875,23 +1000,22 @@ With prefix argument, the toggle restriction."
|
|||
(defun cua-rotate-rectangle ()
|
||||
(interactive)
|
||||
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
|
||||
(cua--rectangle-set-corners))
|
||||
(cua--rectangle-set-corners)
|
||||
(if (cua--rectangle-virtual-edges)
|
||||
(setq cua--buffer-and-point-before-command nil)))
|
||||
|
||||
(defun cua-toggle-rectangle-padding ()
|
||||
(defun cua-toggle-rectangle-virtual-edges ()
|
||||
(interactive)
|
||||
(if buffer-read-only
|
||||
(message "Cannot do padding in read-only buffer.")
|
||||
(cua--rectangle-padding t (not (cua--rectangle-padding)))
|
||||
(cua--pad-rectangle)
|
||||
(cua--rectangle-set-corners))
|
||||
(setq cua--status-string (and (cua--rectangle-padding) " Pad"))
|
||||
(cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges)))
|
||||
(cua--rectangle-set-corners)
|
||||
(setq cua--status-string (and (cua--rectangle-virtual-edges) " [R]"))
|
||||
(cua--keep-active))
|
||||
|
||||
(defun cua-do-rectangle-padding ()
|
||||
(interactive)
|
||||
(if buffer-read-only
|
||||
(message "Cannot do padding in read-only buffer.")
|
||||
(cua--pad-rectangle t)
|
||||
(cua--rectangle-operation nil nil t t t)
|
||||
(cua--rectangle-set-corners))
|
||||
(cua--keep-active))
|
||||
|
||||
|
|
@ -900,7 +1024,7 @@ With prefix argument, the toggle restriction."
|
|||
The text previously in the region is not overwritten by the blanks,
|
||||
but instead winds up to the right of the rectangle."
|
||||
(interactive)
|
||||
(cua--rectangle-operation 'corners nil t 1
|
||||
(cua--rectangle-operation 'corners nil t 1 nil
|
||||
'(lambda (s e l r)
|
||||
(skip-chars-forward " \t")
|
||||
(let ((ws (- (current-column) l))
|
||||
|
|
@ -915,7 +1039,7 @@ On each line in the rectangle, all continuous whitespace starting
|
|||
at that column is deleted.
|
||||
With prefix arg, also delete whitespace to the left of that column."
|
||||
(interactive "P")
|
||||
(cua--rectangle-operation 'clear nil t 1
|
||||
(cua--rectangle-operation 'clear nil t 1 nil
|
||||
'(lambda (s e l r)
|
||||
(when arg
|
||||
(skip-syntax-backward " " (line-beginning-position))
|
||||
|
|
@ -927,7 +1051,7 @@ With prefix arg, also delete whitespace to the left of that column."
|
|||
"Blank out CUA rectangle.
|
||||
The text previously in the rectangle is overwritten by the blanks."
|
||||
(interactive)
|
||||
(cua--rectangle-operation 'keep nil nil 1
|
||||
(cua--rectangle-operation 'keep nil nil 1 nil
|
||||
'(lambda (s e l r)
|
||||
(goto-char e)
|
||||
(skip-syntax-forward " " (line-end-position))
|
||||
|
|
@ -942,7 +1066,7 @@ The text previously in the rectangle is overwritten by the blanks."
|
|||
"Align rectangle lines to left column."
|
||||
(interactive)
|
||||
(let (x)
|
||||
(cua--rectangle-operation 'clear nil t t
|
||||
(cua--rectangle-operation 'clear nil t t nil
|
||||
'(lambda (s e l r)
|
||||
(let ((b (line-beginning-position)))
|
||||
(skip-syntax-backward "^ " b)
|
||||
|
|
@ -984,7 +1108,7 @@ The text previously in the rectangle is overwritten by the blanks."
|
|||
"Replace CUA rectangle contents with STRING on each line.
|
||||
The length of STRING need not be the same as the rectangle width."
|
||||
(interactive "sString rectangle: ")
|
||||
(cua--rectangle-operation 'keep nil t t
|
||||
(cua--rectangle-operation 'keep nil t t nil
|
||||
'(lambda (s e l r)
|
||||
(delete-region s e)
|
||||
(skip-chars-forward " \t")
|
||||
|
|
@ -999,7 +1123,7 @@ The length of STRING need not be the same as the rectangle width."
|
|||
(defun cua-fill-char-rectangle (ch)
|
||||
"Replace CUA rectangle contents with CHARACTER."
|
||||
(interactive "cFill rectangle with character: ")
|
||||
(cua--rectangle-operation 'clear nil t 1
|
||||
(cua--rectangle-operation 'clear nil t 1 nil
|
||||
'(lambda (s e l r)
|
||||
(delete-region s e)
|
||||
(move-to-column l t)
|
||||
|
|
@ -1010,7 +1134,7 @@ The length of STRING need not be the same as the rectangle width."
|
|||
(interactive "sReplace regexp: \nsNew text: ")
|
||||
(if buffer-read-only
|
||||
(message "Cannot replace in read-only buffer")
|
||||
(cua--rectangle-operation 'keep nil t 1
|
||||
(cua--rectangle-operation 'keep nil t 1 nil
|
||||
'(lambda (s e l r)
|
||||
(if (re-search-forward regexp e t)
|
||||
(replace-match newtext nil nil))))))
|
||||
|
|
@ -1018,7 +1142,7 @@ The length of STRING need not be the same as the rectangle width."
|
|||
(defun cua-incr-rectangle (increment)
|
||||
"Increment each line of CUA rectangle by prefix amount."
|
||||
(interactive "p")
|
||||
(cua--rectangle-operation 'keep nil t 1
|
||||
(cua--rectangle-operation 'keep nil t 1 nil
|
||||
'(lambda (s e l r)
|
||||
(cond
|
||||
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
|
||||
|
|
@ -1051,36 +1175,36 @@ The numbers are formatted according to the FORMAT string."
|
|||
(if (= (length fmt) 0)
|
||||
(setq fmt cua--rectangle-seq-format)
|
||||
(setq cua--rectangle-seq-format fmt))
|
||||
(cua--rectangle-operation 'clear nil t 1
|
||||
(cua--rectangle-operation 'clear nil t 1 nil
|
||||
'(lambda (s e l r)
|
||||
(delete-region s e)
|
||||
(insert (format fmt first))
|
||||
(setq first (+ first incr)))))
|
||||
|
||||
(defmacro cua--convert-rectangle-as (command)
|
||||
`(cua--rectangle-operation 'clear nil nil nil
|
||||
(defmacro cua--convert-rectangle-as (command tabify)
|
||||
`(cua--rectangle-operation 'clear nil nil nil ,tabify
|
||||
'(lambda (s e l r)
|
||||
(,command s e))))
|
||||
|
||||
(defun cua-upcase-rectangle ()
|
||||
"Convert the rectangle to upper case."
|
||||
(interactive)
|
||||
(cua--convert-rectangle-as upcase-region))
|
||||
(cua--convert-rectangle-as upcase-region nil))
|
||||
|
||||
(defun cua-downcase-rectangle ()
|
||||
"Convert the rectangle to lower case."
|
||||
(interactive)
|
||||
(cua--convert-rectangle-as downcase-region))
|
||||
(cua--convert-rectangle-as downcase-region nil))
|
||||
|
||||
(defun cua-upcase-initials-rectangle ()
|
||||
"Convert the rectangle initials to upper case."
|
||||
(interactive)
|
||||
(cua--convert-rectangle-as upcase-initials-region))
|
||||
(cua--convert-rectangle-as upcase-initials-region nil))
|
||||
|
||||
(defun cua-capitalize-rectangle ()
|
||||
"Convert the rectangle to proper case."
|
||||
(interactive)
|
||||
(cua--convert-rectangle-as capitalize-region))
|
||||
(cua--convert-rectangle-as capitalize-region nil))
|
||||
|
||||
|
||||
;;; Replace/rearrange text in current rectangle
|
||||
|
|
@ -1116,7 +1240,7 @@ The numbers are formatted according to the FORMAT string."
|
|||
(setq z (reverse z))
|
||||
(if cua--debug
|
||||
(print z auxbuf))
|
||||
(cua--rectangle-operation nil nil t pad
|
||||
(cua--rectangle-operation nil nil t pad nil
|
||||
'(lambda (s e l r)
|
||||
(let (cc)
|
||||
(goto-char e)
|
||||
|
|
@ -1232,9 +1356,9 @@ With prefix arg, indent to that column."
|
|||
"Delete char to left or right of rectangle."
|
||||
(interactive)
|
||||
(let ((col (cua--rectangle-insert-col))
|
||||
(pad (cua--rectangle-padding))
|
||||
(pad (cua--rectangle-virtual-edges))
|
||||
indent)
|
||||
(cua--rectangle-operation 'corners nil t pad
|
||||
(cua--rectangle-operation 'corners nil t pad nil
|
||||
'(lambda (s e l r)
|
||||
(move-to-column
|
||||
(if (cua--rectangle-right-side t)
|
||||
|
|
@ -1282,10 +1406,7 @@ With prefix arg, indent to that column."
|
|||
(cua--rectangle-left (current-column)))
|
||||
(if (>= (cua--rectangle-corner) 2)
|
||||
(cua--rectangle-bot t)
|
||||
(cua--rectangle-top t))
|
||||
(if (cua--rectangle-padding)
|
||||
(setq unread-command-events
|
||||
(cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events)))))
|
||||
(cua--rectangle-top t))))
|
||||
(if cua--rectangle
|
||||
(if (and mark-active
|
||||
(not deactivate-mark))
|
||||
|
|
@ -1379,7 +1500,7 @@ With prefix arg, indent to that column."
|
|||
(cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text)
|
||||
(cua--rect-M/H-key ?n 'cua-sequence-rectangle)
|
||||
(cua--rect-M/H-key ?o 'cua-open-rectangle)
|
||||
(cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding)
|
||||
(cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges)
|
||||
(cua--rect-M/H-key ?P 'cua-do-rectangle-padding)
|
||||
(cua--rect-M/H-key ?q 'cua-refill-rectangle)
|
||||
(cua--rect-M/H-key ?r 'cua-replace-in-rectangle)
|
||||
|
|
|
|||
|
|
@ -358,8 +358,9 @@ Each element in a user-level keywords list should have one of these forms:
|
|||
(eval . FORM)
|
||||
|
||||
where MATCHER can be either the regexp to search for, or the function name to
|
||||
call to make the search (called with one argument, the limit of the search) and
|
||||
return non-nil if it succeeds (and set `match-data' appropriately).
|
||||
call to make the search (called with one argument, the limit of the search;
|
||||
it should return non-nil, move point, and set `match-data' appropriately iff
|
||||
it succeeds; like `re-search-forward' would).
|
||||
MATCHER regexps can be generated via the function `regexp-opt'.
|
||||
|
||||
FORM is an expression, whose value should be a keyword element, evaluated when
|
||||
|
|
@ -1515,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)))
|
||||
|
|
|
|||
|
|
@ -520,7 +520,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
|
|||
;;;; Creation of additional frames, and other frame miscellanea
|
||||
|
||||
(defun modify-all-frames-parameters (alist)
|
||||
"Modify all current and future frames parameters according to ALIST.
|
||||
"Modify all current and future frames' parameters according to ALIST.
|
||||
This changes `default-frame-alist' and possibly `initial-frame-alist'.
|
||||
See help of `modify-frame-parameters' for more information."
|
||||
(let (element) ;; temp
|
||||
|
|
@ -612,7 +612,13 @@ You cannot specify either `width' or `height', you must use neither or both.
|
|||
|
||||
Before the frame is created (via `frame-creation-function'), functions on the
|
||||
hook `before-make-frame-hook' are run. After the frame is created, functions
|
||||
on `after-make-frame-functions' are run with one arg, the newly created frame."
|
||||
on `after-make-frame-functions' are run with one arg, the newly created frame.
|
||||
|
||||
This function itself does not make the new frame the selected frame.
|
||||
The previously selected frame remains selected. However, the
|
||||
window system may select the new frame for its own reasons, for
|
||||
instance if the frame appears under the mouse pointer and your
|
||||
setup is for focus to follow the pointer."
|
||||
(interactive)
|
||||
(run-hooks 'before-make-frame-hook)
|
||||
(let ((frame (funcall frame-creation-function parameters)))
|
||||
|
|
@ -789,6 +795,8 @@ where
|
|||
"Restore the frames to the state described by CONFIGURATION.
|
||||
Each frame listed in CONFIGURATION has its position, size, window
|
||||
configuration, and other parameters set as specified in CONFIGURATION.
|
||||
However, this function does not restore deleted frames.
|
||||
|
||||
Ordinarily, this function deletes all existing frames not
|
||||
listed in CONFIGURATION. But if optional second argument NODELETE
|
||||
is given and non-nil, the unwanted frames are iconified instead."
|
||||
|
|
@ -979,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
|
||||
|
|
@ -1032,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
|
||||
|
|
|
|||
|
|
@ -461,18 +461,21 @@ face (according to `face-differs-from-default-p')."
|
|||
(defun variable-at-point ()
|
||||
"Return the bound variable symbol found around point.
|
||||
Return 0 if there is no such symbol."
|
||||
(condition-case ()
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(save-excursion
|
||||
(or (not (zerop (skip-syntax-backward "_w")))
|
||||
(eq (char-syntax (following-char)) ?w)
|
||||
(eq (char-syntax (following-char)) ?_)
|
||||
(forward-sexp -1))
|
||||
(skip-chars-forward "'")
|
||||
(let ((obj (read (current-buffer))))
|
||||
(or (and (symbolp obj) (boundp obj) obj)
|
||||
0))))
|
||||
(error 0)))
|
||||
(or (condition-case ()
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(save-excursion
|
||||
(or (not (zerop (skip-syntax-backward "_w")))
|
||||
(eq (char-syntax (following-char)) ?w)
|
||||
(eq (char-syntax (following-char)) ?_)
|
||||
(forward-sexp -1))
|
||||
(skip-chars-forward "'")
|
||||
(let ((obj (read (current-buffer))))
|
||||
(and (symbolp obj) (boundp obj) obj))))
|
||||
(error nil))
|
||||
(let* ((str (find-tag-default))
|
||||
(obj (if str (read str))))
|
||||
(and (symbolp obj) (boundp obj) obj))
|
||||
0))
|
||||
|
||||
;;;###autoload
|
||||
(defun describe-variable (variable &optional buffer)
|
||||
|
|
|
|||
|
|
@ -581,7 +581,7 @@ help buffer."
|
|||
(interactive)
|
||||
(if help-xref-stack
|
||||
(help-xref-go-back (current-buffer))
|
||||
(error "No previous help buffer.")))
|
||||
(error "No previous help buffer")))
|
||||
|
||||
(defun help-do-xref (pos function args)
|
||||
"Call the help cross-reference function FUNCTION with args ARGS.
|
||||
|
|
|
|||
58
lisp/help.el
58
lisp/help.el
|
|
@ -237,32 +237,35 @@ C-w Display information on absence of warranty for GNU Emacs."
|
|||
(defun function-called-at-point ()
|
||||
"Return a function around point or else called by the list containing point.
|
||||
If that doesn't give a function, return nil."
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(or (condition-case ()
|
||||
(save-excursion
|
||||
(or (not (zerop (skip-syntax-backward "_w")))
|
||||
(eq (char-syntax (following-char)) ?w)
|
||||
(eq (char-syntax (following-char)) ?_)
|
||||
(forward-sexp -1))
|
||||
(skip-chars-forward "'")
|
||||
(let ((obj (read (current-buffer))))
|
||||
(and (symbolp obj) (fboundp obj) obj)))
|
||||
(error nil))
|
||||
(condition-case ()
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region (max (point-min)
|
||||
(- (point) 1000)) (point-max))
|
||||
;; Move up to surrounding paren, then after the open.
|
||||
(backward-up-list 1)
|
||||
(forward-char 1)
|
||||
;; If there is space here, this is probably something
|
||||
;; other than a real Lisp function call, so ignore it.
|
||||
(if (looking-at "[ \t]")
|
||||
(error "Probably not a Lisp function call"))
|
||||
(let ((obj (read (current-buffer))))
|
||||
(and (symbolp obj) (fboundp obj) obj))))
|
||||
(error nil)))))
|
||||
(or (with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(or (condition-case ()
|
||||
(save-excursion
|
||||
(or (not (zerop (skip-syntax-backward "_w")))
|
||||
(eq (char-syntax (following-char)) ?w)
|
||||
(eq (char-syntax (following-char)) ?_)
|
||||
(forward-sexp -1))
|
||||
(skip-chars-forward "'")
|
||||
(let ((obj (read (current-buffer))))
|
||||
(and (symbolp obj) (fboundp obj) obj)))
|
||||
(error nil))
|
||||
(condition-case ()
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region (max (point-min)
|
||||
(- (point) 1000)) (point-max))
|
||||
;; Move up to surrounding paren, then after the open.
|
||||
(backward-up-list 1)
|
||||
(forward-char 1)
|
||||
;; If there is space here, this is probably something
|
||||
;; other than a real Lisp function call, so ignore it.
|
||||
(if (looking-at "[ \t]")
|
||||
(error "Probably not a Lisp function call"))
|
||||
(let ((obj (read (current-buffer))))
|
||||
(and (symbolp obj) (fboundp obj) obj))))
|
||||
(error nil))))
|
||||
(let* ((str (find-tag-default))
|
||||
(obj (if str (read str))))
|
||||
(and (symbolp obj) (fboundp obj) obj))))
|
||||
|
||||
|
||||
;;; `User' help functions
|
||||
|
|
@ -428,7 +431,8 @@ We put that list in a buffer, and display the buffer.
|
|||
The optional argument PREFIX, if non-nil, should be a key sequence;
|
||||
then we display only bindings that start with that prefix.
|
||||
The optional argument BUFFER specifies which buffer's bindings
|
||||
to display (default, the current buffer)."
|
||||
to display (default, the current buffer). BUFFER can be a buffer
|
||||
or a buffer name."
|
||||
(interactive)
|
||||
(or buffer (setq buffer (current-buffer)))
|
||||
(help-setup-xref (list #'describe-bindings prefix buffer) (interactive-p))
|
||||
|
|
|
|||
|
|
@ -1644,16 +1644,17 @@ If point is on a group name, this function operates on that group."
|
|||
(dolist (string column-strings)
|
||||
(setq total
|
||||
;; like, ewww ...
|
||||
(+ (float (string-to-int string))
|
||||
(+ (float (string-to-number string))
|
||||
total)))
|
||||
(format "%.0f" total))))
|
||||
(format "%s" (buffer-size)))
|
||||
|
||||
(define-ibuffer-column mode (:inline t
|
||||
:props
|
||||
('mouse-face 'highlight
|
||||
'keymap ibuffer-mode-name-map
|
||||
'help-echo "mouse-2: filter by this mode"))
|
||||
(define-ibuffer-column mode
|
||||
(:inline t
|
||||
:props
|
||||
('mouse-face 'highlight
|
||||
'keymap ibuffer-mode-name-map
|
||||
'help-echo "mouse-2: filter by this mode"))
|
||||
(format "%s" mode-name))
|
||||
|
||||
(define-ibuffer-column process
|
||||
|
|
@ -2198,7 +2199,7 @@ Try to restore the previous window configuration iff
|
|||
`ibuffer-restore-window-config-on-quit' is non-nil."
|
||||
(interactive)
|
||||
(if ibuffer-restore-window-config-on-quit
|
||||
(progn
|
||||
(progn
|
||||
(bury-buffer)
|
||||
(unless (= (count-windows) 1)
|
||||
(set-window-configuration ibuffer-prev-window-config)))
|
||||
|
|
|
|||
|
|
@ -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.)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
;;; imenu.el --- framework for mode-specific buffer indexes
|
||||
|
||||
;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2003 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2003, 2004
|
||||
;; Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se>
|
||||
;; Lars Lindberg <lli@sypro.cap.se>
|
||||
|
|
@ -210,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.
|
||||
|
|
@ -239,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)
|
||||
|
||||
|
|
@ -255,9 +252,7 @@ to a function that will find the next index, looking backwards in the
|
|||
file.
|
||||
|
||||
The function should leave point at the place to be connected to the
|
||||
index and it should return nil when it doesn't find another index.
|
||||
|
||||
This variable is local in all buffers.")
|
||||
index and it should return nil when it doesn't find another index.")
|
||||
;;;###autoload
|
||||
(make-variable-buffer-local 'imenu-prev-index-position-function)
|
||||
|
||||
|
|
@ -267,9 +262,7 @@ This variable is local in all buffers.")
|
|||
|
||||
This function is called after `imenu-prev-index-position-function'
|
||||
finds a position for an index item, with point at that position.
|
||||
It should return the name for that index item.
|
||||
|
||||
This variable is local in all buffers.")
|
||||
It should return the name for that index item.")
|
||||
;;;###autoload
|
||||
(make-variable-buffer-local 'imenu-extract-index-name-function)
|
||||
|
||||
|
|
@ -283,9 +276,7 @@ non-nil if they match.
|
|||
If nil, comparison is done with `string='.
|
||||
Set this to some other function for more advanced comparisons,
|
||||
such as \"begins with\" or \"name matches and number of
|
||||
arguments match\".
|
||||
|
||||
This variable is local in all buffers.")
|
||||
arguments match\".")
|
||||
;;;###autoload
|
||||
(make-variable-buffer-local 'imenu-name-lookup-function)
|
||||
|
||||
|
|
@ -453,9 +444,7 @@ The function in this variable is called when selecting a normal index-item.")
|
|||
"The buffer index computed for this buffer in Imenu.
|
||||
Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
|
||||
Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...).
|
||||
A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
|
||||
|
||||
This variable is local in all buffers, once set.")
|
||||
A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).")
|
||||
|
||||
(make-variable-buffer-local 'imenu--index-alist)
|
||||
|
||||
|
|
@ -984,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 ()
|
||||
|
|
|
|||
|
|
@ -442,8 +442,8 @@ This should be a list of integers, ordered from smallest to largest."
|
|||
"Keymap used in `edit-tab-stops'.")
|
||||
|
||||
(defvar edit-tab-stops-buffer nil
|
||||
"Buffer whose tab stops are being edited--in case
|
||||
the variable `tab-stop-list' is local in that buffer.")
|
||||
"Buffer whose tab stops are being edited.
|
||||
This matters if the variable `tab-stop-list' is local in that buffer.")
|
||||
|
||||
(defun edit-tab-stops ()
|
||||
"Edit the tab stops used by `tab-to-tab-stop'.
|
||||
|
|
|
|||
157
lisp/info.el
157
lisp/info.el
|
|
@ -188,7 +188,7 @@ file, so be prepared for a few surprises if you enable this feature."
|
|||
:type 'boolean
|
||||
:group 'info)
|
||||
|
||||
(defcustom Info-search-whitespace-regexp "\\\\(?:\\\\s-+\\\\)"
|
||||
(defcustom Info-search-whitespace-regexp "\\(?:\\s-+\\)"
|
||||
"*If non-nil, regular expression to match a sequence of whitespace chars.
|
||||
This applies to Info search for regular expressions.
|
||||
You might want to use something like \"[ \\t\\r\\n]+\" instead.
|
||||
|
|
@ -1442,8 +1442,9 @@ If FORK is a string, it is the name to use for the new buffer."
|
|||
(defvar Info-search-case-fold nil
|
||||
"The value of `case-fold-search' from previous `Info-search' command.")
|
||||
|
||||
(defun Info-search (regexp)
|
||||
"Search for REGEXP, starting from point, and select node it's found in."
|
||||
(defun Info-search (regexp &optional bound noerror count direction)
|
||||
"Search for REGEXP, starting from point, and select node it's found in.
|
||||
If DIRECTION is `backward', search in the reverse direction."
|
||||
(interactive (list (read-string
|
||||
(if Info-search-history
|
||||
(format "Regexp search%s (default `%s'): "
|
||||
|
|
@ -1458,31 +1459,42 @@ If FORK is a string, it is the name to use for the new buffer."
|
|||
(setq regexp (car Info-search-history)))
|
||||
(when regexp
|
||||
(let (found beg-found give-up
|
||||
(backward (eq direction 'backward))
|
||||
(onode Info-current-node)
|
||||
(ofile Info-current-file)
|
||||
(opoint (point))
|
||||
(opoint-min (point-min))
|
||||
(opoint-max (point-max))
|
||||
(ostart (window-start))
|
||||
(osubfile Info-current-subfile))
|
||||
(when Info-search-whitespace-regexp
|
||||
(setq regexp (replace-regexp-in-string
|
||||
"[ \t\n]+" Info-search-whitespace-regexp regexp)))
|
||||
(setq regexp
|
||||
(mapconcat 'identity (split-string regexp "[ \t\n]+")
|
||||
Info-search-whitespace-regexp)))
|
||||
(setq Info-search-case-fold case-fold-search)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(while (and (not give-up)
|
||||
(or (null found)
|
||||
(isearch-range-invisible beg-found found)))
|
||||
(if (re-search-forward regexp nil t)
|
||||
(setq found (point) beg-found (match-beginning 0))
|
||||
(if backward
|
||||
(isearch-range-invisible found beg-found)
|
||||
(isearch-range-invisible beg-found found))))
|
||||
(if (if backward
|
||||
(re-search-backward regexp bound t)
|
||||
(re-search-forward regexp bound t))
|
||||
(setq found (point) beg-found (if backward (match-end 0)
|
||||
(match-beginning 0)))
|
||||
(setq give-up t)))))
|
||||
;; If no subfiles, give error now.
|
||||
(if give-up
|
||||
(if (null Info-current-subfile)
|
||||
(re-search-forward regexp)
|
||||
(if backward
|
||||
(re-search-backward regexp)
|
||||
(re-search-forward regexp))
|
||||
(setq found nil)))
|
||||
|
||||
(unless found
|
||||
(unless (or found bound)
|
||||
(unwind-protect
|
||||
;; Try other subfiles.
|
||||
(let ((list ()))
|
||||
|
|
@ -1498,29 +1510,39 @@ If FORK is a string, it is the name to use for the new buffer."
|
|||
;; Find the subfile we just searched.
|
||||
(search-forward (concat "\n" osubfile ": "))
|
||||
;; Skip that one.
|
||||
(forward-line 1)
|
||||
(forward-line (if backward 0 1))
|
||||
;; Make a list of all following subfiles.
|
||||
;; Each elt has the form (VIRT-POSITION . SUBFILENAME).
|
||||
(while (not (eobp))
|
||||
(re-search-forward "\\(^.*\\): [0-9]+$")
|
||||
(while (not (if backward (bobp) (eobp)))
|
||||
(if backward
|
||||
(re-search-backward "\\(^.*\\): [0-9]+$")
|
||||
(re-search-forward "\\(^.*\\): [0-9]+$"))
|
||||
(goto-char (+ (match-end 1) 2))
|
||||
(setq list (cons (cons (+ (point-min)
|
||||
(read (current-buffer)))
|
||||
(match-string-no-properties 1))
|
||||
list))
|
||||
(goto-char (1+ (match-end 0))))
|
||||
(goto-char (if backward
|
||||
(1- (match-beginning 0))
|
||||
(1+ (match-end 0)))))
|
||||
;; Put in forward order
|
||||
(setq list (nreverse list))))
|
||||
(while list
|
||||
(message "Searching subfile %s..." (cdr (car list)))
|
||||
(Info-read-subfile (car (car list)))
|
||||
(if backward (goto-char (point-max)))
|
||||
(setq list (cdr list))
|
||||
(setq give-up nil found nil)
|
||||
(while (and (not give-up)
|
||||
(or (null found)
|
||||
(isearch-range-invisible beg-found found)))
|
||||
(if (re-search-forward regexp nil t)
|
||||
(setq found (point) beg-found (match-beginning 0))
|
||||
(if backward
|
||||
(isearch-range-invisible found beg-found)
|
||||
(isearch-range-invisible beg-found found))))
|
||||
(if (if backward
|
||||
(re-search-backward regexp nil t)
|
||||
(re-search-forward regexp nil t))
|
||||
(setq found (point) beg-found (if backward (match-end 0)
|
||||
(match-beginning 0)))
|
||||
(setq give-up t)))
|
||||
(if give-up
|
||||
(setq found nil))
|
||||
|
|
@ -1534,12 +1556,20 @@ If FORK is a string, it is the name to use for the new buffer."
|
|||
(goto-char opoint)
|
||||
(Info-select-node)
|
||||
(set-window-start (selected-window) ostart)))))
|
||||
(widen)
|
||||
(goto-char found)
|
||||
(Info-select-node)
|
||||
|
||||
(if (and (string= osubfile Info-current-subfile)
|
||||
(> found opoint-min)
|
||||
(< found opoint-max))
|
||||
;; Search landed in the same node
|
||||
(goto-char found)
|
||||
(widen)
|
||||
(goto-char found)
|
||||
(save-match-data (Info-select-node)))
|
||||
|
||||
;; Use string-equal, not equal, to ignore text props.
|
||||
(or (and (string-equal onode Info-current-node)
|
||||
(equal ofile Info-current-file))
|
||||
(and isearch-mode isearch-wrapped (eq opoint opoint-min))
|
||||
(setq Info-history (cons (list ofile onode opoint)
|
||||
Info-history))))))
|
||||
|
||||
|
|
@ -1556,6 +1586,48 @@ If FORK is a string, it is the name to use for the new buffer."
|
|||
(if Info-search-history
|
||||
(Info-search (car Info-search-history))
|
||||
(call-interactively 'Info-search))))
|
||||
|
||||
(defun Info-search-backward (regexp &optional bound noerror count)
|
||||
"Search for REGEXP in the reverse direction."
|
||||
(interactive (list (read-string
|
||||
(if Info-search-history
|
||||
(format "Regexp search%s backward (default `%s'): "
|
||||
(if case-fold-search "" " case-sensitively")
|
||||
(car Info-search-history))
|
||||
(format "Regexp search%s backward: "
|
||||
(if case-fold-search "" " case-sensitively")))
|
||||
nil 'Info-search-history)))
|
||||
(Info-search regexp bound noerror count 'backward))
|
||||
|
||||
(defun Info-isearch-search ()
|
||||
(cond
|
||||
(isearch-word
|
||||
(if isearch-forward 'word-search-forward 'word-search-backward))
|
||||
(isearch-regexp
|
||||
(lambda (regexp bound noerror)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(Info-search regexp bound noerror nil
|
||||
(unless isearch-forward 'backward))
|
||||
(point))
|
||||
(error nil))))
|
||||
(t
|
||||
(if isearch-forward 'search-forward 'search-backward))))
|
||||
|
||||
(defun Info-isearch-wrap ()
|
||||
(if isearch-regexp
|
||||
(if isearch-forward (Info-top-node) (Info-final-node))
|
||||
(goto-char (if isearch-forward (point-min) (point-max)))))
|
||||
|
||||
(defun Info-isearch-push-state ()
|
||||
`(lambda (cmd)
|
||||
(Info-isearch-pop-state cmd ,Info-current-file ,Info-current-node)))
|
||||
|
||||
(defun Info-isearch-pop-state (cmd file node)
|
||||
(or (and (string= Info-current-file file)
|
||||
(string= Info-current-node node))
|
||||
(progn (Info-find-node file node) (sit-for 0))))
|
||||
|
||||
|
||||
(defun Info-extract-pointer (name &optional errorname)
|
||||
"Extract the value of the node-pointer named NAME.
|
||||
|
|
@ -3064,6 +3136,14 @@ Advanced commands:
|
|||
(setq desktop-save-buffer 'Info-desktop-buffer-misc-data)
|
||||
(add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t)
|
||||
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
|
||||
(set (make-local-variable 'isearch-search-fun-function)
|
||||
'Info-isearch-search)
|
||||
(set (make-local-variable 'isearch-wrap-function)
|
||||
'Info-isearch-wrap)
|
||||
(set (make-local-variable 'isearch-push-state-function)
|
||||
'Info-isearch-push-state)
|
||||
(set (make-local-variable 'search-whitespace-regexp)
|
||||
Info-search-whitespace-regexp)
|
||||
(Info-set-mode-line)
|
||||
(run-hooks 'Info-mode-hook))
|
||||
|
||||
|
|
@ -3445,23 +3525,24 @@ Preserve text properties."
|
|||
other-tag)
|
||||
(when not-fontified-p
|
||||
(when Info-hide-note-references
|
||||
;; *Note is often used where *note should have been
|
||||
(goto-char start)
|
||||
(skip-syntax-backward " ")
|
||||
(setq other-tag
|
||||
(cond ((memq (char-before) '(nil ?\. ?! ??))
|
||||
"See ")
|
||||
((memq (char-before) '(?\, ?\; ?\: ?-))
|
||||
"see ")
|
||||
((memq (char-before) '(?\( ?\[ ?\{))
|
||||
;; Check whether the paren is preceded by
|
||||
;; an end of sentence
|
||||
(skip-syntax-backward " (")
|
||||
(if (memq (char-before) '(nil ?\. ?! ??))
|
||||
"See "
|
||||
"see "))
|
||||
((save-match-data (looking-at "\n\n"))
|
||||
"See ")))
|
||||
(when (not (eq Info-hide-note-references 'hide))
|
||||
;; *Note is often used where *note should have been
|
||||
(goto-char start)
|
||||
(skip-syntax-backward " ")
|
||||
(setq other-tag
|
||||
(cond ((memq (char-before) '(nil ?\. ?! ??))
|
||||
"See ")
|
||||
((memq (char-before) '(?\, ?\; ?\: ?-))
|
||||
"see ")
|
||||
((memq (char-before) '(?\( ?\[ ?\{))
|
||||
;; Check whether the paren is preceded by
|
||||
;; an end of sentence
|
||||
(skip-syntax-backward " (")
|
||||
(if (memq (char-before) '(nil ?\. ?! ??))
|
||||
"See "
|
||||
"see "))
|
||||
((save-match-data (looking-at "\n\n"))
|
||||
"See "))))
|
||||
(goto-char next)
|
||||
(add-text-properties
|
||||
(match-beginning 1)
|
||||
|
|
@ -3471,7 +3552,7 @@ Preserve text properties."
|
|||
(if (string-match "\n" (match-string 1))
|
||||
(+ start1 (match-beginning 0)))))
|
||||
(match-end 1))
|
||||
(if (and other-tag (not (eq Info-hide-note-references 'hide)))
|
||||
(if other-tag
|
||||
`(display ,other-tag front-sticky nil rear-nonsticky t)
|
||||
'(invisible t front-sticky nil rear-nonsticky t))))
|
||||
(add-text-properties
|
||||
|
|
|
|||
|
|
@ -24,6 +24,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;; Usually this map is empty (even if Encoded-kbd mode is on), but if
|
||||
;; the keyboard coding system is iso-2022-based, it defines dummy key
|
||||
;; bindings for ESC $ ..., etc. so that those bindings in
|
||||
;; key-translation-map take effect.
|
||||
(defconst encoded-kbd-mode-map (make-sparse-keymap)
|
||||
"Keymap for Encoded-kbd minor mode.")
|
||||
|
||||
|
|
@ -69,25 +73,6 @@
|
|||
(fset 'encoded-kbd-iso2022-designation-prefix
|
||||
encoded-kbd-iso2022-designation-map)
|
||||
|
||||
(defvar encoded-kbd-iso2022-non-ascii-map
|
||||
(let ((map (make-keymap))
|
||||
(i 32))
|
||||
(while (< i 128)
|
||||
(define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit)
|
||||
(setq i (1+ i)))
|
||||
(define-key map "\e" 'encoded-kbd-iso2022-esc-prefix)
|
||||
(setq i 160)
|
||||
(while (< i 256)
|
||||
(define-key map (vector i) 'encoded-kbd-handle-8bit)
|
||||
(setq i (1+ i)))
|
||||
map)
|
||||
"Keymap for handling non-ASCII character set in Encoded-kbd mode.")
|
||||
|
||||
;; One of the symbols `sjis', `iso2022-7', `iso2022-8', or `big5' to
|
||||
;; denote what kind of coding-system we are now handling in
|
||||
;; Encoded-kbd mode.
|
||||
(defvar encoded-kbd-coding nil)
|
||||
|
||||
;; Keep information of designation state of ISO2022 encoding. When
|
||||
;; Encoded-kbd mode is on, this is set to a vector of length 4, the
|
||||
;; elements are character sets currently designated to graphic
|
||||
|
|
@ -104,11 +89,14 @@
|
|||
(defvar encoded-kbd-iso2022-invocations nil)
|
||||
(put 'encoded-kbd-iso2022-invocations 'permanent-local t)
|
||||
|
||||
(defun encoded-kbd-iso2022-designation ()
|
||||
(defsubst encoded-kbd-last-key ()
|
||||
(let ((keys (this-single-command-keys)))
|
||||
(aref keys (1- (length keys)))))
|
||||
|
||||
(defun encoded-kbd-iso2022-designation (ignore)
|
||||
"Do ISO2022 designation according to the current key in Encoded-kbd mode.
|
||||
The following key sequence may cause multilingual text insertion."
|
||||
(interactive)
|
||||
(let ((key-seq (this-command-keys))
|
||||
(let ((key-seq (this-single-command-keys))
|
||||
(prev-g0-charset (aref encoded-kbd-iso2022-designations
|
||||
(aref encoded-kbd-iso2022-invocations 0)))
|
||||
intermediate-char final-char
|
||||
|
|
@ -132,143 +120,122 @@ The following key sequence may cause multilingual text insertion."
|
|||
chars (if (< intermediate-char ?,) 94 96)
|
||||
final-char (aref key-seq 2)
|
||||
reg (mod intermediate-char 4))))
|
||||
(if (setq charset (iso-charset dimension chars final-char))
|
||||
(aset encoded-kbd-iso2022-designations reg charset)
|
||||
(error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported"
|
||||
dimension chars final-char))
|
||||
(aset encoded-kbd-iso2022-designations reg
|
||||
(iso-charset dimension chars final-char)))
|
||||
"")
|
||||
|
||||
(if (memq (aref encoded-kbd-iso2022-designations
|
||||
(aref encoded-kbd-iso2022-invocations 0))
|
||||
'(ascii latin-jisx0201))
|
||||
;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have
|
||||
;; to handle characters in this range specially.
|
||||
(if (not (memq prev-g0-charset '(ascii latin-jisx0201)))
|
||||
;; We must exit recursive edit now.
|
||||
(throw 'exit nil))
|
||||
;; Graphic plane 0 is for non-ASCII.
|
||||
(if (memq prev-g0-charset '(ascii latin-jisx0201))
|
||||
;; We must handle keys specially.
|
||||
(let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map))
|
||||
(recursive-edit))))))
|
||||
(defun encoded-kbd-iso2022-single-shift (ignore)
|
||||
(let ((char (encoded-kbd-last-key)))
|
||||
(aset encoded-kbd-iso2022-invocations 2
|
||||
(aref encoded-kbd-iso2022-designations
|
||||
(if (= char ?\216) 2 3))))
|
||||
"")
|
||||
|
||||
(defun encoded-kbd-handle-8bit ()
|
||||
"Handle an 8-bit character entered in Encoded-kbd mode."
|
||||
(interactive)
|
||||
(cond ((eq encoded-kbd-coding 'iso2022-7)
|
||||
(error "Can't handle the character code %d" last-command-char))
|
||||
|
||||
((eq encoded-kbd-coding 'iso2022-8)
|
||||
(cond ((= last-command-char ?\216)
|
||||
(aset encoded-kbd-iso2022-invocations 2 2))
|
||||
|
||||
((= last-command-char ?\217)
|
||||
(aset encoded-kbd-iso2022-invocations 2 3))
|
||||
|
||||
((>= last-command-char ?\240)
|
||||
(encoded-kbd-self-insert-iso2022-8bit))
|
||||
|
||||
(t
|
||||
(error "Can't handle the character code %d"
|
||||
last-command-char))))
|
||||
|
||||
((eq encoded-kbd-coding 'sjis)
|
||||
(encoded-kbd-self-insert-sjis))
|
||||
|
||||
(t
|
||||
(encoded-kbd-self-insert-big5))))
|
||||
|
||||
(defun encoded-kbd-self-insert-iso2022-7bit ()
|
||||
(interactive)
|
||||
(let* ((charset (aref encoded-kbd-iso2022-designations
|
||||
(or (aref encoded-kbd-iso2022-invocations 2)
|
||||
(aref encoded-kbd-iso2022-invocations 0))))
|
||||
(char (if (= (charset-dimension charset) 1)
|
||||
(make-char charset last-command-char)
|
||||
(make-char charset last-command-char (read-char-exclusive)))))
|
||||
(defun encoded-kbd-self-insert-iso2022-7bit (ignore)
|
||||
(let ((char (encoded-kbd-last-key))
|
||||
(charset (aref encoded-kbd-iso2022-designations
|
||||
(or (aref encoded-kbd-iso2022-invocations 2)
|
||||
(aref encoded-kbd-iso2022-invocations 0)))))
|
||||
(aset encoded-kbd-iso2022-invocations 2 nil)
|
||||
(setq unread-command-events (cons char unread-command-events))))
|
||||
(vector (if (= (charset-dimension charset) 1)
|
||||
(make-char charset char)
|
||||
(make-char charset char (read-char-exclusive))))))
|
||||
|
||||
(defun encoded-kbd-self-insert-iso2022-8bit ()
|
||||
(interactive)
|
||||
(cond
|
||||
((= last-command-char ?\216) ; SS2 (Single Shift 2)
|
||||
(aset encoded-kbd-iso2022-invocations 2 2))
|
||||
((= last-command-char ?\217) ; SS3 (Single Shift 3)
|
||||
(aset encoded-kbd-iso2022-invocations 2 3))
|
||||
(t
|
||||
(let* ((charset (aref encoded-kbd-iso2022-designations
|
||||
(or (aref encoded-kbd-iso2022-invocations 2)
|
||||
(aref encoded-kbd-iso2022-invocations 1))))
|
||||
(char (if (= (charset-dimension charset) 1)
|
||||
(make-char charset last-command-char)
|
||||
(make-char charset last-command-char
|
||||
(read-char-exclusive)))))
|
||||
(aset encoded-kbd-iso2022-invocations 2 nil)
|
||||
(setq unread-command-events (cons char unread-command-events))))))
|
||||
(defun encoded-kbd-self-insert-iso2022-8bit (ignore)
|
||||
(let ((char (encoded-kbd-last-key))
|
||||
(charset (aref encoded-kbd-iso2022-designations
|
||||
(or (aref encoded-kbd-iso2022-invocations 2)
|
||||
(aref encoded-kbd-iso2022-invocations 1)))))
|
||||
(aset encoded-kbd-iso2022-invocations 2 nil)
|
||||
(vector (if (= (charset-dimension charset) 1)
|
||||
(make-char charset char)
|
||||
(make-char charset char (read-char-exclusive))))))
|
||||
|
||||
(defun encoded-kbd-self-insert-sjis ()
|
||||
(interactive)
|
||||
(let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0))
|
||||
(decode-sjis-char (+ (ash last-command-char 8)
|
||||
(read-char-exclusive)))
|
||||
(make-char 'katakana-jisx0201 last-command-char))))
|
||||
(setq unread-command-events (cons char unread-command-events))))
|
||||
(defun encoded-kbd-self-insert-sjis (ignore)
|
||||
(let ((char (encoded-kbd-last-key)))
|
||||
(vector
|
||||
(if (or (< char ?\xA0) (>= char ?\xE0))
|
||||
(decode-sjis-char (+ (ash char 8) (read-char-exclusive)))
|
||||
(make-char 'katakana-jisx0201 char)))))
|
||||
|
||||
(defun encoded-kbd-self-insert-big5 ()
|
||||
(interactive)
|
||||
(let ((char (decode-big5-char (+ (ash last-command-char 8)
|
||||
(read-char-exclusive)))))
|
||||
(setq unread-command-events (cons char unread-command-events))))
|
||||
(defun encoded-kbd-self-insert-big5 (ignore)
|
||||
(let ((char (encoded-kbd-last-key)))
|
||||
(vector
|
||||
(decode-big5-char (+ (ash char 8) (read-char-exclusive))))))
|
||||
|
||||
(defun encoded-kbd-self-insert-ccl ()
|
||||
(interactive)
|
||||
(let ((str (char-to-string last-command-char))
|
||||
(defun encoded-kbd-self-insert-ccl (ignore)
|
||||
(let ((str (char-to-string (encoded-kbd-last-key)))
|
||||
(ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4)))
|
||||
(vec [nil nil nil nil nil nil nil nil nil])
|
||||
result)
|
||||
(while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0)
|
||||
(dotimes (i 9) (aset vec i nil))
|
||||
(setq str (format "%s%c" str (read-char-exclusive))))
|
||||
(setq unread-command-events
|
||||
(append result unread-command-events))))
|
||||
(vector (aref result 0))))
|
||||
|
||||
(defun encoded-kbd-setup-keymap (coding)
|
||||
;; At first, reset the keymap.
|
||||
(setcdr encoded-kbd-mode-map nil)
|
||||
(define-key encoded-kbd-mode-map "\e" nil)
|
||||
;; Then setup the keymap according to the keyboard coding system.
|
||||
(cond
|
||||
((eq encoded-kbd-coding 'sjis)
|
||||
((eq (coding-system-type coding) 1) ; SJIS
|
||||
(let ((i 128))
|
||||
(while (< i 256)
|
||||
(define-key encoded-kbd-mode-map
|
||||
(define-key key-translation-map
|
||||
(vector i) 'encoded-kbd-self-insert-sjis)
|
||||
(setq i (1+ i)))))
|
||||
(setq i (1+ i))))
|
||||
8)
|
||||
|
||||
((eq encoded-kbd-coding 'big5)
|
||||
((eq (coding-system-type coding) 3) ; Big5
|
||||
(let ((i 161))
|
||||
(while (< i 255)
|
||||
(define-key encoded-kbd-mode-map
|
||||
(define-key key-translation-map
|
||||
(vector i) 'encoded-kbd-self-insert-big5)
|
||||
(setq i (1+ i)))))
|
||||
(setq i (1+ i))))
|
||||
8)
|
||||
|
||||
((eq encoded-kbd-coding 'iso2022-7)
|
||||
(define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix))
|
||||
((eq (coding-system-type coding) 2) ; ISO-2022
|
||||
(let ((flags (coding-system-flags coding))
|
||||
use-designation)
|
||||
(if (aref flags 8)
|
||||
nil ; Don't support locking-shift.
|
||||
(setq encoded-kbd-iso2022-designations (make-vector 4 nil)
|
||||
encoded-kbd-iso2022-invocations (make-vector 3 nil))
|
||||
(dotimes (i 4)
|
||||
(if (aref flags i)
|
||||
(if (charsetp (aref flags i))
|
||||
(aset encoded-kbd-iso2022-designations
|
||||
i (aref flags i))
|
||||
(setq use-designation t)
|
||||
(if (charsetp (car-safe (aref flags i)))
|
||||
(aset encoded-kbd-iso2022-designations
|
||||
i (car (aref flags i)))))))
|
||||
(aset encoded-kbd-iso2022-invocations 0 0)
|
||||
(if (aref encoded-kbd-iso2022-designations 1)
|
||||
(aset encoded-kbd-iso2022-invocations 1 1))
|
||||
(when use-designation
|
||||
(define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)
|
||||
(define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix))
|
||||
(when (or (aref flags 2) (aref flags 3))
|
||||
(define-key key-translation-map
|
||||
[?\216] 'encoded-kbd-iso2022-single-shift)
|
||||
(define-key key-translation-map
|
||||
[?\217] 'encoded-kbd-iso2022-single-shift))
|
||||
(or (eq (aref flags 0) 'ascii)
|
||||
(dotimes (i 96)
|
||||
(define-key key-translation-map
|
||||
(vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit)))
|
||||
(if (aref flags 7)
|
||||
t
|
||||
(dotimes (i 96)
|
||||
(define-key key-translation-map
|
||||
(vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit))
|
||||
8))))
|
||||
|
||||
((eq encoded-kbd-coding 'iso2022-8)
|
||||
(define-key encoded-kbd-mode-map
|
||||
(vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit)
|
||||
(define-key encoded-kbd-mode-map
|
||||
(vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit)
|
||||
(let ((i 160))
|
||||
(while (< i 256)
|
||||
(define-key encoded-kbd-mode-map
|
||||
(vector i) 'encoded-kbd-self-insert-iso2022-8bit)
|
||||
(setq i (1+ i)))))
|
||||
|
||||
((eq encoded-kbd-coding 'ccl)
|
||||
((eq (coding-system-type coding) 4) ; CCL-base
|
||||
(let ((valid-codes (or (coding-system-get coding 'valid-codes)
|
||||
'((128 . 255))))
|
||||
elt from to)
|
||||
elt from to valid)
|
||||
(while valid-codes
|
||||
(setq elt (car valid-codes) valid-codes (cdr valid-codes))
|
||||
(if (consp elt)
|
||||
|
|
@ -276,13 +243,17 @@ The following key sequence may cause multilingual text insertion."
|
|||
(setq from (setq to elt)))
|
||||
(while (<= from to)
|
||||
(if (>= from 128)
|
||||
(define-key encoded-kbd-mode-map
|
||||
(define-key key-translation-map
|
||||
(vector from) 'encoded-kbd-self-insert-ccl))
|
||||
(setq from (1+ from))))))
|
||||
(setq from (1+ from))))
|
||||
8))
|
||||
|
||||
(t
|
||||
(error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding))))
|
||||
nil)))
|
||||
|
||||
;; key-translation-map at the time Encoded-kbd mode is turned on is
|
||||
;; saved here.
|
||||
(defvar saved-key-translation-map nil)
|
||||
|
||||
;; Input mode at the time Encoded-kbd mode is turned on is saved here.
|
||||
(defvar saved-input-mode nil)
|
||||
|
|
@ -301,60 +272,38 @@ In Encoded-kbd mode, a text sent from keyboard is accepted
|
|||
as a multilingual text encoded in a coding system set by
|
||||
\\[set-keyboard-coding-system]."
|
||||
:global t
|
||||
;; We must at first reset input-mode to the original.
|
||||
(if saved-input-mode (apply 'set-input-mode saved-input-mode))
|
||||
|
||||
(if encoded-kbd-mode
|
||||
(let ((coding (keyboard-coding-system)))
|
||||
(setq saved-input-mode (current-input-mode))
|
||||
(cond ((null coding)
|
||||
(setq encoded-kbd-mode nil)
|
||||
(error "No coding system for keyboard input is set"))
|
||||
;; We are turning on Encoded-kbd mode.
|
||||
(let ((coding (keyboard-coding-system))
|
||||
result)
|
||||
(or saved-key-translation-map
|
||||
(if (keymapp key-translation-map)
|
||||
(setq saved-key-translation-map
|
||||
(copy-keymap key-translation-map))
|
||||
(setq key-translation-map (make-sparse-keymap))))
|
||||
(or saved-input-mode
|
||||
(setq saved-input-mode
|
||||
(current-input-mode)))
|
||||
(setq result (and coding (encoded-kbd-setup-keymap coding)))
|
||||
(if result
|
||||
(if (eq result 8)
|
||||
(set-input-mode
|
||||
(nth 0 saved-input-mode)
|
||||
(nth 1 saved-input-mode)
|
||||
'use-8th-bit
|
||||
(nth 3 saved-input-mode)))
|
||||
(setq encoded-kbd-mode nil
|
||||
saved-key-translation-map nil
|
||||
saved-input-mode nil)
|
||||
(error "Unsupported coding system in Encoded-kbd mode: %S"
|
||||
coding)))
|
||||
|
||||
((= (coding-system-type coding) 1) ; SJIS
|
||||
(set-input-mode
|
||||
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
|
||||
'use-8th-bit (nth 3 saved-input-mode))
|
||||
(setq encoded-kbd-coding 'sjis))
|
||||
|
||||
((= (coding-system-type coding) 2) ; ISO2022
|
||||
(if (aref (coding-system-flags coding) 7) ; 7-bit only
|
||||
(setq encoded-kbd-coding 'iso2022-7)
|
||||
(set-input-mode
|
||||
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
|
||||
'use-8th-bit (nth 3 saved-input-mode))
|
||||
(setq encoded-kbd-coding 'iso2022-8))
|
||||
(setq encoded-kbd-iso2022-designations (make-vector 4 nil))
|
||||
(let ((flags (coding-system-flags coding))
|
||||
(i 0))
|
||||
(while (< i 4)
|
||||
(if (charsetp (aref flags i))
|
||||
(aset encoded-kbd-iso2022-designations i
|
||||
(aref flags i))
|
||||
(if (charsetp (car-safe (aref flags i)))
|
||||
(aset encoded-kbd-iso2022-designations i
|
||||
(car (aref flags i)))))
|
||||
(setq i (1+ i))))
|
||||
(setq encoded-kbd-iso2022-invocations (make-vector 3 nil))
|
||||
(aset encoded-kbd-iso2022-invocations 0 0)
|
||||
(aset encoded-kbd-iso2022-invocations 1 1))
|
||||
|
||||
((= (coding-system-type coding) 3) ; BIG5
|
||||
(set-input-mode
|
||||
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
|
||||
'use-8th-bit (nth 3 saved-input-mode))
|
||||
(setq encoded-kbd-coding 'big5))
|
||||
|
||||
((= (coding-system-type coding) 4) ; CCL based coding
|
||||
(set-input-mode
|
||||
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
|
||||
'use-8th-bit (nth 3 saved-input-mode))
|
||||
(setq encoded-kbd-coding 'ccl))
|
||||
|
||||
(t
|
||||
(setq encoded-kbd-mode nil)
|
||||
(error "Coding-system `%s' is not supported in Encoded-kbd mode"
|
||||
(keyboard-coding-system))))
|
||||
(encoded-kbd-setup-keymap coding))))
|
||||
;; We are turning off Encoded-kbd mode.
|
||||
(setq key-translation-map saved-key-translation-map
|
||||
saved-key-translation-map nil)
|
||||
(apply 'set-input-mode saved-input-mode)
|
||||
(setq saved-input-mode nil)))
|
||||
|
||||
(provide 'encoded-kb)
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -273,7 +273,7 @@ The value nil means that the tables are not yet loaded.")
|
|||
(utf-translate-cjk-load-tables))
|
||||
(gethash code-point
|
||||
(get 'utf-subst-table-for-decode 'translation-hash-table)))
|
||||
|
||||
|
||||
|
||||
(defun utf-lookup-subst-table-for-encode (char)
|
||||
(if (and utf-translate-cjk-mode
|
||||
|
|
@ -282,9 +282,11 @@ The value nil means that the tables are not yet loaded.")
|
|||
(utf-translate-cjk-load-tables))
|
||||
(gethash char
|
||||
(get 'utf-subst-table-for-encode 'translation-hash-table)))
|
||||
|
||||
|
||||
(define-minor-mode utf-translate-cjk-mode
|
||||
"Whether the UTF based coding systems should decode/encode CJK characters.
|
||||
"Toggle whether UTF based coding systems de/encode CJK characters.
|
||||
If ARG is an integer, enable if ARG is positive and disable if
|
||||
zero or negative. This is a minor mode.
|
||||
Enabling this allows the coding systems mule-utf-8,
|
||||
mule-utf-16le and mule-utf-16be to encode characters in the charsets
|
||||
`korean-ksc5601', `chinese-gb2312', `chinese-big5-1',
|
||||
|
|
@ -296,9 +298,10 @@ according to the language environment in effect when this option is
|
|||
turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for
|
||||
Chinese-Big5 and jisx for other environments.
|
||||
|
||||
This option is on by default. If you are not interested in CJK
|
||||
This mode is on by default. If you are not interested in CJK
|
||||
characters and want to avoid some overhead on encoding/decoding
|
||||
by the above coding systems, you can customize this option to nil."
|
||||
by the above coding systems, you can customize the user option
|
||||
`utf-translate-cjk-mode' to nil."
|
||||
:init-value t
|
||||
:version "21.4"
|
||||
:type 'boolean
|
||||
|
|
@ -605,7 +608,7 @@ eight-bit-control and eight-bit-graphic characters.")
|
|||
;; UTF-8 decoder generates an UTF-8 sequence represented by a
|
||||
;; sequence eight-bit-control/graphic chars for an untranslatable
|
||||
;; character and an invalid byte.
|
||||
;;
|
||||
;;
|
||||
;; This CCL parses that sequence (the first byte is already in r1),
|
||||
;; writes out the original bytes of that sequence, and sets r5 to
|
||||
;; -1.
|
||||
|
|
@ -624,7 +627,7 @@ eight-bit-control and eight-bit-graphic characters.")
|
|||
(read-multibyte-character r5 r6)
|
||||
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
|
||||
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
|
||||
((write r1) ; invalid UTF-8
|
||||
((write r1) ; invalid UTF-8
|
||||
(r1 = -1)
|
||||
(end)))
|
||||
|
||||
|
|
@ -641,7 +644,7 @@ eight-bit-control and eight-bit-graphic characters.")
|
|||
(r1 = -1)
|
||||
;; Read the 3rd byte.
|
||||
(read-multibyte-character r5 r6)
|
||||
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
|
||||
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
|
||||
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
|
||||
(end)) ; invalid UTF-8
|
||||
(write r6)
|
||||
|
|
@ -651,7 +654,7 @@ eight-bit-control and eight-bit-graphic characters.")
|
|||
(end)))
|
||||
;; Read the 4th byte.
|
||||
(read-multibyte-character r5 r6)
|
||||
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
|
||||
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
|
||||
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
|
||||
(end)) ; invalid UTF-8
|
||||
;; 4-byte sequence for an untranslated character.
|
||||
|
|
@ -867,7 +870,9 @@ Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
|
|||
;; version of the string in the loop, since it's always loaded as
|
||||
;; unibyte from a byte-compiled file.
|
||||
(let ((range (string-as-multibyte "^\xc0-\xc3\xe1-\xf7"))
|
||||
(buffer-multibyte enable-multibyte-characters)
|
||||
hash-table ch)
|
||||
(set-buffer-multibyte t)
|
||||
(when utf-translate-cjk-mode
|
||||
(if (not utf-translate-cjk-lang-env)
|
||||
;; Check these characters:
|
||||
|
|
@ -890,7 +895,9 @@ Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
|
|||
(progn
|
||||
(insert ch)
|
||||
(delete-char 1))
|
||||
(forward-char 1)))))
|
||||
(forward-char 1))))
|
||||
(or buffer-multibyte
|
||||
(set-buffer-multibyte nil)))
|
||||
|
||||
(when (and utf-8-compose-scripts (> length 1))
|
||||
;; These currently have definitions which cover the relevant
|
||||
|
|
|
|||
349
lisp/isearch.el
349
lisp/isearch.el
|
|
@ -57,47 +57,6 @@
|
|||
;; keep the behavior. No point in forcing nonincremental search until
|
||||
;; the last possible moment.
|
||||
|
||||
;; TODO
|
||||
;; - Integrate the emacs 19 generalized command history.
|
||||
;; - Hooks and options for failed search.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;; Changes before those recorded in ChangeLog:
|
||||
|
||||
;; Revision 1.4 92/09/14 16:26:02 liberte
|
||||
;; Added prefix args to isearch-forward, etc. to switch between
|
||||
;; string and regular expression searching.
|
||||
;; Added some support for lemacs.
|
||||
;; Added general isearch-highlight option - but only for lemacs so far.
|
||||
;; Added support for frame switching in emacs 19.
|
||||
;; Added word search option to isearch-edit-string.
|
||||
;; Renamed isearch-quit to isearch-abort.
|
||||
;; Numerous changes to comments and doc strings.
|
||||
;;
|
||||
;; Revision 1.3 92/06/29 13:10:08 liberte
|
||||
;; Moved modal isearch-mode handling into isearch-mode.
|
||||
;; Got rid of buffer-local isearch variables.
|
||||
;; isearch-edit-string used by ring adjustments, completion, and
|
||||
;; nonincremental searching. C-s and C-r are additional exit commands.
|
||||
;; Renamed all regex to regexp.
|
||||
;; Got rid of found-start and found-point globals.
|
||||
;; Generalized handling of upper-case chars.
|
||||
|
||||
;; Revision 1.2 92/05/27 11:33:57 liberte
|
||||
;; Emacs version 19 has a search ring, which is supported here.
|
||||
;; Other fixes found in the version 19 isearch are included here.
|
||||
;;
|
||||
;; Also see variables search-caps-disable-folding,
|
||||
;; search-nonincremental-instead, search-whitespace-regexp, and
|
||||
;; commands isearch-toggle-regexp, isearch-edit-string.
|
||||
;;
|
||||
;; semi-modal isearching is supported.
|
||||
|
||||
;; Changes for 1.1
|
||||
;; 3/18/92 Fixed invalid-regexp.
|
||||
;; 3/18/92 Fixed yanking in regexps.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
|
|
@ -153,9 +112,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)
|
||||
|
||||
|
|
@ -198,6 +157,15 @@ Ordinarily the text becomes invisible again at the end of the search."
|
|||
(defvar isearch-mode-end-hook nil
|
||||
"Function(s) to call after terminating an incremental search.")
|
||||
|
||||
(defvar isearch-wrap-function nil
|
||||
"Function to call to wrap the search when search is failed.
|
||||
If nil, move point to the beginning of the buffer for a forward search,
|
||||
or to the end of the buffer for a backward search.")
|
||||
|
||||
(defvar isearch-push-state-function nil
|
||||
"Function to save a function restoring the mode-specific isearch state
|
||||
to the search status stack.")
|
||||
|
||||
;; Search ring.
|
||||
|
||||
(defvar search-ring nil
|
||||
|
|
@ -298,11 +266,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.
|
||||
|
|
@ -372,9 +340,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
|
||||
|
|
@ -773,6 +741,81 @@ 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-state (frame)
|
||||
"Return the search string in FRAME."
|
||||
(aref frame 0))
|
||||
(defsubst isearch-message-state (frame)
|
||||
"Return the search string to display to the user in FRAME."
|
||||
(aref frame 1))
|
||||
(defsubst isearch-point-state (frame)
|
||||
"Return the point in FRAME."
|
||||
(aref frame 2))
|
||||
(defsubst isearch-success-state (frame)
|
||||
"Return the success flag in FRAME."
|
||||
(aref frame 3))
|
||||
(defsubst isearch-forward-state (frame)
|
||||
"Return the searching-forward flag in FRAME."
|
||||
(aref frame 4))
|
||||
(defsubst isearch-other-end-state (frame)
|
||||
"Return the other end of the match in FRAME."
|
||||
(aref frame 5))
|
||||
(defsubst isearch-word-state (frame)
|
||||
"Return the search-by-word flag in FRAME."
|
||||
(aref frame 6))
|
||||
(defsubst isearch-invalid-regexp-state (frame)
|
||||
"Return the regexp error message in FRAME, or nil if its regexp is valid."
|
||||
(aref frame 7))
|
||||
(defsubst isearch-wrapped-state (frame)
|
||||
"Return the search-wrapped flag in FRAME."
|
||||
(aref frame 8))
|
||||
(defsubst isearch-barrier-state (frame)
|
||||
"Return the barrier value in FRAME."
|
||||
(aref frame 9))
|
||||
(defsubst isearch-within-brackets-state (frame)
|
||||
"Return the in-character-class flag in FRAME."
|
||||
(aref frame 10))
|
||||
(defsubst isearch-case-fold-search-state (frame)
|
||||
"Return the case-folding flag in FRAME."
|
||||
(aref frame 11))
|
||||
(defsubst isearch-pop-fun-state (frame)
|
||||
"Return the function restoring the mode-specific isearch state in FRAME."
|
||||
(aref frame 12))
|
||||
|
||||
(defun isearch-top-state ()
|
||||
(let ((cmd (car isearch-cmds)))
|
||||
(setq isearch-string (isearch-string-state cmd)
|
||||
isearch-message (isearch-message-state cmd)
|
||||
isearch-success (isearch-success-state cmd)
|
||||
isearch-forward (isearch-forward-state cmd)
|
||||
isearch-other-end (isearch-other-end-state cmd)
|
||||
isearch-word (isearch-word-state cmd)
|
||||
isearch-invalid-regexp (isearch-invalid-regexp-state cmd)
|
||||
isearch-wrapped (isearch-wrapped-state cmd)
|
||||
isearch-barrier (isearch-barrier-state cmd)
|
||||
isearch-within-brackets (isearch-within-brackets-state cmd)
|
||||
isearch-case-fold-search (isearch-case-fold-search-state cmd))
|
||||
(if (functionp (isearch-pop-fun-state cmd))
|
||||
(funcall (isearch-pop-fun-state cmd) cmd))
|
||||
(goto-char (isearch-point-state 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
|
||||
(if isearch-push-state-function
|
||||
(funcall isearch-push-state-function)))
|
||||
isearch-cmds)))
|
||||
|
||||
|
||||
;; Commands active while inside of the isearch minor mode.
|
||||
|
||||
|
|
@ -956,10 +999,13 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
|
|||
(defun isearch-cancel ()
|
||||
"Terminate the search and go back to the starting point."
|
||||
(interactive)
|
||||
(if (functionp (isearch-pop-fun-state (car (last isearch-cmds))))
|
||||
(funcall (isearch-pop-fun-state (car (last isearch-cmds)))
|
||||
(car (last isearch-cmds))))
|
||||
(goto-char isearch-opoint)
|
||||
(isearch-done t)
|
||||
(isearch-done t) ; exit isearch
|
||||
(isearch-clean-overlays)
|
||||
(signal 'quit nil)) ; and pass on quit signal
|
||||
(signal 'quit nil)) ; and pass on quit signal
|
||||
|
||||
(defun isearch-abort ()
|
||||
"Abort incremental search mode if searching is successful, signaling quit.
|
||||
|
|
@ -971,11 +1017,9 @@ Use `isearch-exit' to quit without signaling."
|
|||
(if isearch-success
|
||||
;; If search is successful, move back to starting point
|
||||
;; and really do quit.
|
||||
(progn (goto-char isearch-opoint)
|
||||
(setq isearch-success nil)
|
||||
(isearch-done t) ; exit isearch
|
||||
(isearch-clean-overlays)
|
||||
(signal 'quit nil)) ; and pass on quit signal
|
||||
(progn
|
||||
(setq isearch-success nil)
|
||||
(isearch-cancel))
|
||||
;; If search is failing, or has an incomplete regexp,
|
||||
;; rub out until it is once more successful.
|
||||
(while (or (not isearch-success) isearch-invalid-regexp)
|
||||
|
|
@ -1000,7 +1044,9 @@ Use `isearch-exit' to quit without signaling."
|
|||
;; If already have what to search for, repeat it.
|
||||
(or isearch-success
|
||||
(progn
|
||||
(goto-char (if isearch-forward (point-min) (point-max)))
|
||||
(if isearch-wrap-function
|
||||
(funcall isearch-wrap-function)
|
||||
(goto-char (if isearch-forward (point-min) (point-max))))
|
||||
(setq isearch-wrapped t))))
|
||||
;; C-s in reverse or C-r in forward, change direction.
|
||||
(setq isearch-forward (not isearch-forward)))
|
||||
|
|
@ -1042,6 +1088,7 @@ Use `isearch-exit' to quit without signaling."
|
|||
(interactive)
|
||||
(setq isearch-regexp (not isearch-regexp))
|
||||
(if isearch-regexp (setq isearch-word nil))
|
||||
(setq isearch-success t isearch-adjusted t)
|
||||
(isearch-update))
|
||||
|
||||
(defun isearch-toggle-case-fold ()
|
||||
|
|
@ -1054,34 +1101,39 @@ Use `isearch-exit' to quit without signaling."
|
|||
(isearch-message-prefix nil nil isearch-nonincremental)
|
||||
isearch-message
|
||||
(if isearch-case-fold-search "in" "")))
|
||||
(setq isearch-adjusted t)
|
||||
(setq isearch-success t isearch-adjusted t)
|
||||
(sit-for 1)
|
||||
(isearch-update))
|
||||
|
||||
(defun isearch-query-replace ()
|
||||
(defun isearch-query-replace (&optional regexp-flag)
|
||||
"Start query-replace with string to replace from last search string."
|
||||
(interactive)
|
||||
(barf-if-buffer-read-only)
|
||||
(if regexp-flag (setq isearch-regexp t))
|
||||
(let ((case-fold-search isearch-case-fold-search))
|
||||
(isearch-done)
|
||||
(isearch-clean-overlays)
|
||||
(and isearch-forward isearch-other-end (goto-char isearch-other-end))
|
||||
(if (and (< isearch-other-end (point))
|
||||
(not (and transient-mark-mode mark-active
|
||||
(< isearch-opoint (point)))))
|
||||
(goto-char isearch-other-end))
|
||||
(set query-replace-from-history-variable
|
||||
(cons isearch-string
|
||||
(symbol-value query-replace-from-history-variable)))
|
||||
(perform-replace
|
||||
isearch-string
|
||||
(query-replace-read-to isearch-string "Query replace" isearch-regexp)
|
||||
t isearch-regexp isearch-word)))
|
||||
(query-replace-read-to
|
||||
isearch-string
|
||||
(if isearch-regexp "Query replace regexp" "Query replace")
|
||||
isearch-regexp)
|
||||
t isearch-regexp isearch-word nil nil
|
||||
(if (and transient-mark-mode mark-active) (region-beginning))
|
||||
(if (and transient-mark-mode mark-active) (region-end)))))
|
||||
|
||||
(defun isearch-query-replace-regexp ()
|
||||
"Start query-replace-regexp with string to replace from last search string."
|
||||
(interactive)
|
||||
(let ((query-replace-interactive t)
|
||||
(case-fold-search isearch-case-fold-search))
|
||||
;; Put search string into the right ring
|
||||
(setq isearch-regexp t)
|
||||
(isearch-done)
|
||||
(isearch-clean-overlays)
|
||||
(and isearch-forward isearch-other-end (goto-char isearch-other-end))
|
||||
(call-interactively 'query-replace-regexp)))
|
||||
(isearch-query-replace t))
|
||||
|
||||
|
||||
(defun isearch-delete-char ()
|
||||
|
|
@ -1249,53 +1301,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-state (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-state frame)
|
||||
(let* ((string (isearch-string-state 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-state (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-state (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.
|
||||
|
|
@ -1534,8 +1626,7 @@ Isearch mode."
|
|||
(let ((ab-bel (isearch-string-out-of-window isearch-point)))
|
||||
(if ab-bel
|
||||
(isearch-back-into-window (eq ab-bel 'above) isearch-point)
|
||||
(or (eq (point) isearch-point)
|
||||
(goto-char isearch-point))))
|
||||
(goto-char isearch-point)))
|
||||
(isearch-update))
|
||||
(search-exit-option
|
||||
(let (window)
|
||||
|
|
@ -1774,38 +1865,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
|
||||
|
||||
|
|
@ -1841,7 +1900,9 @@ If there is no completion possible, say so and continue searching."
|
|||
;; If currently failing, display no ellipsis.
|
||||
(or isearch-success (setq ellipsis nil))
|
||||
(let ((m (concat (if isearch-success "" "failing ")
|
||||
(if isearch-adjusted "pending " "")
|
||||
(if (and isearch-wrapped
|
||||
(not isearch-wrap-function)
|
||||
(if isearch-forward
|
||||
(> (point) isearch-opoint)
|
||||
(< (point) isearch-opoint)))
|
||||
|
|
@ -1936,9 +1997,11 @@ 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-state (car isearch-cmds))
|
||||
(ding))
|
||||
(goto-char (nth 2 (car isearch-cmds)))))
|
||||
(if (functionp (isearch-pop-fun-state (car isearch-cmds)))
|
||||
(funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds)))
|
||||
(goto-char (isearch-point-state (car isearch-cmds)))))
|
||||
|
||||
|
||||
;; Called when opening an overlay, and we are still in isearch.
|
||||
|
|
|
|||
|
|
@ -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.)
|
||||
|
||||
|
|
|
|||
|
|
@ -186,6 +186,13 @@ This works whether or not the table is Unicode-based or
|
|||
(define-coding-system-alias 'koi8 'cyrillic-koi8)
|
||||
(define-coding-system-alias 'cp878 'cyrillic-koi8)
|
||||
|
||||
(let ((elt `("koi8-r" koi8-r 1
|
||||
,(get 'cyrillic-koi8-r-encode-table 'translation-table)))
|
||||
(slot (assoc "koi8-r" ctext-non-standard-encodings-alist)))
|
||||
(if slot
|
||||
(setcdr slot (cdr elt))
|
||||
(push elt ctext-non-standard-encodings-alist)))
|
||||
|
||||
;; Allow displaying some of KOI & al with an 8859-5-encoded font. We
|
||||
;; won't bother about the exceptions when encoding the font, since
|
||||
;; NBSP will fall through below and work anyhow, and we'll have
|
||||
|
|
@ -219,6 +226,7 @@ This works whether or not the table is Unicode-based or
|
|||
'translation-table))
|
||||
(coding-system cyrillic-koi8)
|
||||
(coding-priority cyrillic-koi8 cyrillic-iso-8bit)
|
||||
(ctext-non-standard-encodings "koi8-r")
|
||||
(input-method . "russian-typewriter")
|
||||
(features cyril-util)
|
||||
(unibyte-display . cyrillic-koi8)
|
||||
|
|
|
|||
|
|
@ -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,6 +1,6 @@
|
|||
;;; macros.el --- non-primitive commands for keyboard macros
|
||||
|
||||
;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 1985, 86, 87, 92, 94, 95, 04 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: FSF
|
||||
;; Keywords: abbrev
|
||||
|
|
@ -151,7 +151,7 @@ use this command, and then save the file."
|
|||
(cond ((= char ?\\)
|
||||
(insert "\\\\"))
|
||||
((= char ?\")
|
||||
(insert "\\\""))
|
||||
(insert "\\\""))
|
||||
((= char ?\;)
|
||||
(insert "\\;"))
|
||||
((= char 127)
|
||||
|
|
@ -240,8 +240,9 @@ Possibilities: \\<query-replace-map>
|
|||
|
||||
;;;###autoload
|
||||
(defun apply-macro-to-region-lines (top bottom &optional macro)
|
||||
"For each complete line between point and mark, move to the beginning
|
||||
of the line, and run the last keyboard macro.
|
||||
"Apply last keyboard macro to all lines in the region.
|
||||
For each line that begins in the region, move to the beginning of
|
||||
the line, and run the last keyboard macro.
|
||||
|
||||
When called from lisp, this function takes two arguments TOP and
|
||||
BOTTOM, describing the current region. TOP must be before BOTTOM.
|
||||
|
|
@ -277,8 +278,7 @@ and write a macro to massage a word into a table entry:
|
|||
\\C-x )
|
||||
|
||||
and then select the region of un-tablified names and use
|
||||
`\\[apply-macro-to-region-lines]' to build the table from the names.
|
||||
"
|
||||
`\\[apply-macro-to-region-lines]' to build the table from the names."
|
||||
(interactive "r")
|
||||
(or macro
|
||||
(progn
|
||||
|
|
@ -286,10 +286,7 @@ and then select the region of un-tablified names and use
|
|||
(error "No keyboard macro has been defined"))
|
||||
(setq macro last-kbd-macro)))
|
||||
(save-excursion
|
||||
(let ((end-marker (progn
|
||||
(goto-char bottom)
|
||||
(beginning-of-line)
|
||||
(point-marker)))
|
||||
(let ((end-marker (copy-marker bottom))
|
||||
next-line-marker)
|
||||
(goto-char top)
|
||||
(if (not (bolp))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -1434,374 +1435,388 @@ consing a string.)"
|
|||
(if all (nreverse value-list) (car value-list))
|
||||
))
|
||||
|
||||
(defcustom mail-extr-disable-voodoo "\\cj"
|
||||
"*If it is a regexp, names matching it will never be modified.
|
||||
If it is neither nil nor a string, modifying of names will never take
|
||||
place. It affects how `mail-extract-address-components' works."
|
||||
:type '(choice (regexp :size 0)
|
||||
(const :tag "Always enabled" nil)
|
||||
(const :tag "Always disabled" t))
|
||||
:group 'mail-extr)
|
||||
|
||||
(defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer)
|
||||
(let ((word-count 0)
|
||||
(case-fold-search nil)
|
||||
mixed-case-flag lower-case-flag ;;upper-case-flag
|
||||
suffix-flag last-name-comma-flag
|
||||
;;cbeg cend
|
||||
initial
|
||||
begin-again-flag
|
||||
drop-this-word-if-trailing-flag
|
||||
drop-last-word-if-trailing-flag
|
||||
word-found-flag
|
||||
this-word-beg last-word-beg
|
||||
name-beg name-end
|
||||
name-done-flag
|
||||
)
|
||||
(save-excursion
|
||||
(set-syntax-table mail-extr-address-text-syntax-table)
|
||||
(unless (and mail-extr-disable-voodoo
|
||||
(or (not (stringp mail-extr-disable-voodoo))
|
||||
(progn
|
||||
(goto-char (point-min))
|
||||
(re-search-forward mail-extr-disable-voodoo nil t))))
|
||||
(let ((word-count 0)
|
||||
(case-fold-search nil)
|
||||
mixed-case-flag lower-case-flag ;;upper-case-flag
|
||||
suffix-flag last-name-comma-flag
|
||||
;;cbeg cend
|
||||
initial
|
||||
begin-again-flag
|
||||
drop-this-word-if-trailing-flag
|
||||
drop-last-word-if-trailing-flag
|
||||
word-found-flag
|
||||
this-word-beg last-word-beg
|
||||
name-beg name-end
|
||||
name-done-flag
|
||||
)
|
||||
(save-excursion
|
||||
(set-syntax-table mail-extr-address-text-syntax-table)
|
||||
|
||||
;; Get rid of comments.
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
;; Initialize for this iteration of the loop.
|
||||
(skip-chars-forward "^({[\"'`")
|
||||
(let ((cbeg (point)))
|
||||
(set-syntax-table mail-extr-address-text-comment-syntax-table)
|
||||
(if (memq (following-char) '(?\' ?\`))
|
||||
(search-forward "'" nil 'move
|
||||
(if (eq ?\' (following-char)) 2 1))
|
||||
(or (mail-extr-safe-move-sexp 1)
|
||||
(goto-char (point-max))))
|
||||
(set-syntax-table mail-extr-address-text-syntax-table)
|
||||
(when (eq (char-after cbeg) ?\()
|
||||
;; Delete the comment itself.
|
||||
(delete-region cbeg (point))
|
||||
;; Canonicalize whitespace where the comment was.
|
||||
(skip-chars-backward " \t")
|
||||
(if (looking-at "\\([ \t]+$\\|[ \t]+,\\)")
|
||||
(replace-match "")
|
||||
(setq cbeg (point))
|
||||
(skip-chars-forward " \t")
|
||||
(if (bobp)
|
||||
(delete-region (point) cbeg)
|
||||
(just-one-space))))))
|
||||
|
||||
;; This was moved above.
|
||||
;; Fix . used as space
|
||||
;; But it belongs here because it occurs not only as
|
||||
;; rypens@reks.uia.ac.be (Piet.Rypens)
|
||||
;; but also as
|
||||
;; "Piet.Rypens" <rypens@reks.uia.ac.be>
|
||||
;;(goto-char (point-min))
|
||||
;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
||||
;; (replace-match "\\1 \\2" t))
|
||||
|
||||
(unless (search-forward " " nil t)
|
||||
;; Get rid of comments.
|
||||
(goto-char (point-min))
|
||||
(cond ((search-forward "_" nil t)
|
||||
;; Handle the *idiotic* use of underlines as spaces.
|
||||
;; Example: fml@foo.bar.dom (First_M._Last)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "_" nil t)
|
||||
(replace-match " " t)))
|
||||
((search-forward "." nil t)
|
||||
;; Fix . used as space
|
||||
;; Example: danj1@cb.att.com (daniel.jacobson)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
||||
(replace-match "\\1 \\2" t)))))
|
||||
(while (not (eobp))
|
||||
;; Initialize for this iteration of the loop.
|
||||
(skip-chars-forward "^({[\"'`")
|
||||
(let ((cbeg (point)))
|
||||
(set-syntax-table mail-extr-address-text-comment-syntax-table)
|
||||
(if (memq (following-char) '(?\' ?\`))
|
||||
(search-forward "'" nil 'move
|
||||
(if (eq ?\' (following-char)) 2 1))
|
||||
(or (mail-extr-safe-move-sexp 1)
|
||||
(goto-char (point-max))))
|
||||
(set-syntax-table mail-extr-address-text-syntax-table)
|
||||
(when (eq (char-after cbeg) ?\()
|
||||
;; Delete the comment itself.
|
||||
(delete-region cbeg (point))
|
||||
;; Canonicalize whitespace where the comment was.
|
||||
(skip-chars-backward " \t")
|
||||
(if (looking-at "\\([ \t]+$\\|[ \t]+,\\)")
|
||||
(replace-match "")
|
||||
(setq cbeg (point))
|
||||
(skip-chars-forward " \t")
|
||||
(if (bobp)
|
||||
(delete-region (point) cbeg)
|
||||
(just-one-space))))))
|
||||
|
||||
;; Loop over the words (and other junk) in the name.
|
||||
(goto-char (point-min))
|
||||
(while (not name-done-flag)
|
||||
;; This was moved above.
|
||||
;; Fix . used as space
|
||||
;; But it belongs here because it occurs not only as
|
||||
;; rypens@reks.uia.ac.be (Piet.Rypens)
|
||||
;; but also as
|
||||
;; "Piet.Rypens" <rypens@reks.uia.ac.be>
|
||||
;;(goto-char (point-min))
|
||||
;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
||||
;; (replace-match "\\1 \\2" t))
|
||||
|
||||
(when word-found-flag
|
||||
;; Last time through this loop we skipped over a word.
|
||||
(setq last-word-beg this-word-beg)
|
||||
(setq drop-last-word-if-trailing-flag
|
||||
drop-this-word-if-trailing-flag)
|
||||
(setq word-found-flag nil))
|
||||
(unless (search-forward " " nil t)
|
||||
(goto-char (point-min))
|
||||
(cond ((search-forward "_" nil t)
|
||||
;; Handle the *idiotic* use of underlines as spaces.
|
||||
;; Example: fml@foo.bar.dom (First_M._Last)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "_" nil t)
|
||||
(replace-match " " t)))
|
||||
((search-forward "." nil t)
|
||||
;; Fix . used as space
|
||||
;; Example: danj1@cb.att.com (daniel.jacobson)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
||||
(replace-match "\\1 \\2" t)))))
|
||||
|
||||
(when begin-again-flag
|
||||
;; Last time through the loop we found something that
|
||||
;; indicates we should pretend we are beginning again from
|
||||
;; the start.
|
||||
(setq word-count 0)
|
||||
(setq last-word-beg nil)
|
||||
(setq drop-last-word-if-trailing-flag nil)
|
||||
(setq mixed-case-flag nil)
|
||||
(setq lower-case-flag nil)
|
||||
;; (setq upper-case-flag nil)
|
||||
(setq begin-again-flag nil))
|
||||
;; Loop over the words (and other junk) in the name.
|
||||
(goto-char (point-min))
|
||||
(while (not name-done-flag)
|
||||
|
||||
;; Initialize for this iteration of the loop.
|
||||
(mail-extr-skip-whitespace-forward)
|
||||
(if (eq word-count 0) (narrow-to-region (point) (point-max)))
|
||||
(setq this-word-beg (point))
|
||||
(setq drop-this-word-if-trailing-flag nil)
|
||||
(when word-found-flag
|
||||
;; Last time through this loop we skipped over a word.
|
||||
(setq last-word-beg this-word-beg)
|
||||
(setq drop-last-word-if-trailing-flag
|
||||
drop-this-word-if-trailing-flag)
|
||||
(setq word-found-flag nil))
|
||||
|
||||
;; Decide what to do based on what we are looking at.
|
||||
(cond
|
||||
(when begin-again-flag
|
||||
;; Last time through the loop we found something that
|
||||
;; indicates we should pretend we are beginning again from
|
||||
;; the start.
|
||||
(setq word-count 0)
|
||||
(setq last-word-beg nil)
|
||||
(setq drop-last-word-if-trailing-flag nil)
|
||||
(setq mixed-case-flag nil)
|
||||
(setq lower-case-flag nil)
|
||||
;; (setq upper-case-flag nil)
|
||||
(setq begin-again-flag nil))
|
||||
|
||||
;; Delete title
|
||||
((and (eq word-count 0)
|
||||
(looking-at mail-extr-full-name-prefixes))
|
||||
(goto-char (match-end 0))
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
;; Stop after name suffix
|
||||
((and (>= word-count 2)
|
||||
(looking-at mail-extr-full-name-suffix-pattern))
|
||||
(mail-extr-skip-whitespace-backward)
|
||||
(setq suffix-flag (point))
|
||||
(if (eq ?, (following-char))
|
||||
(forward-char 1)
|
||||
(insert ?,))
|
||||
;; Enforce at least one space after comma
|
||||
(or (eq ?\ (following-char))
|
||||
(insert ?\ ))
|
||||
;; Initialize for this iteration of the loop.
|
||||
(mail-extr-skip-whitespace-forward)
|
||||
(cond ((memq (following-char) '(?j ?J ?s ?S))
|
||||
(capitalize-word 1)
|
||||
(if (eq (following-char) ?.)
|
||||
(forward-char 1)
|
||||
(insert ?.)))
|
||||
(t
|
||||
(upcase-word 1)))
|
||||
(setq word-found-flag t)
|
||||
(setq name-done-flag t))
|
||||
(if (eq word-count 0) (narrow-to-region (point) (point-max)))
|
||||
(setq this-word-beg (point))
|
||||
(setq drop-this-word-if-trailing-flag nil)
|
||||
|
||||
;; Handle SCA names
|
||||
((looking-at "MKA \\(.+\\)") ; "Mundanely Known As"
|
||||
(goto-char (match-beginning 1))
|
||||
(narrow-to-region (point) (point-max))
|
||||
(setq begin-again-flag t))
|
||||
|
||||
;; Check for initial last name followed by comma
|
||||
((and (eq ?, (following-char))
|
||||
(eq word-count 1))
|
||||
(forward-char 1)
|
||||
(setq last-name-comma-flag t)
|
||||
(or (eq ?\ (following-char))
|
||||
(insert ?\ )))
|
||||
|
||||
;; Stop before trailing comma-separated comment
|
||||
;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
||||
;; *** This case is redundant???
|
||||
;;((eq ?, (following-char))
|
||||
;; (setq name-done-flag t))
|
||||
|
||||
;; Delete parenthesized/quoted comment/nickname
|
||||
((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
|
||||
(setq cbeg (point))
|
||||
(set-syntax-table mail-extr-address-text-comment-syntax-table)
|
||||
(cond ((memq (following-char) '(?\' ?\`))
|
||||
(or (search-forward "'" nil t
|
||||
(if (eq ?\' (following-char)) 2 1))
|
||||
(delete-char 1)))
|
||||
(t
|
||||
(or (mail-extr-safe-move-sexp 1)
|
||||
(goto-char (point-max)))))
|
||||
(set-syntax-table mail-extr-address-text-syntax-table)
|
||||
(setq cend (point))
|
||||
;; Decide what to do based on what we are looking at.
|
||||
(cond
|
||||
;; Handle case of entire name being quoted
|
||||
|
||||
;; Delete title
|
||||
((and (eq word-count 0)
|
||||
(looking-at " *\\'")
|
||||
(>= (- cend cbeg) 2))
|
||||
(narrow-to-region (1+ cbeg) (1- cend))
|
||||
(goto-char (point-min)))
|
||||
(looking-at mail-extr-full-name-prefixes))
|
||||
(goto-char (match-end 0))
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
;; Stop after name suffix
|
||||
((and (>= word-count 2)
|
||||
(looking-at mail-extr-full-name-suffix-pattern))
|
||||
(mail-extr-skip-whitespace-backward)
|
||||
(setq suffix-flag (point))
|
||||
(if (eq ?, (following-char))
|
||||
(forward-char 1)
|
||||
(insert ?,))
|
||||
;; Enforce at least one space after comma
|
||||
(or (eq ?\ (following-char))
|
||||
(insert ?\ ))
|
||||
(mail-extr-skip-whitespace-forward)
|
||||
(cond ((memq (following-char) '(?j ?J ?s ?S))
|
||||
(capitalize-word 1)
|
||||
(if (eq (following-char) ?.)
|
||||
(forward-char 1)
|
||||
(insert ?.)))
|
||||
(t
|
||||
(upcase-word 1)))
|
||||
(setq word-found-flag t)
|
||||
(setq name-done-flag t))
|
||||
|
||||
;; Handle SCA names
|
||||
((looking-at "MKA \\(.+\\)") ; "Mundanely Known As"
|
||||
(goto-char (match-beginning 1))
|
||||
(narrow-to-region (point) (point-max))
|
||||
(setq begin-again-flag t))
|
||||
|
||||
;; Check for initial last name followed by comma
|
||||
((and (eq ?, (following-char))
|
||||
(eq word-count 1))
|
||||
(forward-char 1)
|
||||
(setq last-name-comma-flag t)
|
||||
(or (eq ?\ (following-char))
|
||||
(insert ?\ )))
|
||||
|
||||
;; Stop before trailing comma-separated comment
|
||||
;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
||||
;; *** This case is redundant???
|
||||
;;((eq ?, (following-char))
|
||||
;; (setq name-done-flag t))
|
||||
|
||||
;; Delete parenthesized/quoted comment/nickname
|
||||
((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
|
||||
(setq cbeg (point))
|
||||
(set-syntax-table mail-extr-address-text-comment-syntax-table)
|
||||
(cond ((memq (following-char) '(?\' ?\`))
|
||||
(or (search-forward "'" nil t
|
||||
(if (eq ?\' (following-char)) 2 1))
|
||||
(delete-char 1)))
|
||||
(t
|
||||
(or (mail-extr-safe-move-sexp 1)
|
||||
(goto-char (point-max)))))
|
||||
(set-syntax-table mail-extr-address-text-syntax-table)
|
||||
(setq cend (point))
|
||||
(cond
|
||||
;; Handle case of entire name being quoted
|
||||
((and (eq word-count 0)
|
||||
(looking-at " *\\'")
|
||||
(>= (- cend cbeg) 2))
|
||||
(narrow-to-region (1+ cbeg) (1- cend))
|
||||
(goto-char (point-min)))
|
||||
(t
|
||||
;; Handle case of quoted initial
|
||||
(if (and (or (= 3 (- cend cbeg))
|
||||
(and (= 4 (- cend cbeg))
|
||||
(eq ?. (char-after (+ 2 cbeg)))))
|
||||
(not (looking-at " *\\'")))
|
||||
(setq initial (char-after (1+ cbeg)))
|
||||
(setq initial nil))
|
||||
(delete-region cbeg cend)
|
||||
(if initial
|
||||
(insert initial ". ")))))
|
||||
|
||||
;; Handle *Stupid* VMS date stamps
|
||||
((looking-at mail-extr-stupid-vms-date-stamp-pattern)
|
||||
(replace-match "" t))
|
||||
|
||||
;; Handle Chinese characters.
|
||||
((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern)
|
||||
(goto-char (match-end 0))
|
||||
(setq word-found-flag t))
|
||||
|
||||
;; Skip initial garbage characters.
|
||||
;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
||||
((and (eq word-count 0)
|
||||
(looking-at mail-extr-leading-garbage))
|
||||
(goto-char (match-end 0))
|
||||
;; *** Skip backward over these???
|
||||
;; (skip-chars-backward "& \"")
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
;; Various stopping points
|
||||
((or
|
||||
|
||||
;; Stop before ALL CAPS acronyms, if preceded by mixed-case
|
||||
;; words. Example: XT-DEM.
|
||||
(and (>= word-count 2)
|
||||
mixed-case-flag
|
||||
(looking-at mail-extr-weird-acronym-pattern)
|
||||
(not (looking-at mail-extr-roman-numeral-pattern)))
|
||||
|
||||
;; Stop before trailing alternative address
|
||||
(looking-at mail-extr-alternative-address-pattern)
|
||||
|
||||
;; Stop before trailing comment not introduced by comma
|
||||
;; THIS CASE MUST BE AFTER AN EARLIER CASE.
|
||||
(looking-at mail-extr-trailing-comment-start-pattern)
|
||||
|
||||
;; Stop before telephone numbers
|
||||
(and (>= word-count 1)
|
||||
(looking-at mail-extr-telephone-extension-pattern)))
|
||||
(setq name-done-flag t))
|
||||
|
||||
;; Delete ham radio call signs
|
||||
((looking-at mail-extr-ham-call-sign-pattern)
|
||||
(delete-region (match-beginning 0) (match-end 0)))
|
||||
|
||||
;; Fixup initials
|
||||
((looking-at mail-extr-initial-pattern)
|
||||
(or (eq (following-char) (upcase (following-char)))
|
||||
(setq lower-case-flag t))
|
||||
(forward-char 1)
|
||||
(if (eq ?. (following-char))
|
||||
(forward-char 1)
|
||||
(insert ?.))
|
||||
(or (eq ?\ (following-char))
|
||||
(insert ?\ ))
|
||||
(setq word-found-flag t))
|
||||
|
||||
;; Handle BITNET LISTSERV list names.
|
||||
((and (eq word-count 0)
|
||||
(looking-at mail-extr-listserv-list-name-pattern))
|
||||
(narrow-to-region (match-beginning 1) (match-end 1))
|
||||
(setq word-found-flag t)
|
||||
(setq name-done-flag t))
|
||||
|
||||
;; Handle & substitution, when & is last and is not first.
|
||||
((and (> word-count 0)
|
||||
(eq ?\ (preceding-char))
|
||||
(eq (following-char) ?&)
|
||||
(eq (1+ (point)) (point-max)))
|
||||
(delete-char 1)
|
||||
(capitalize-region
|
||||
(point)
|
||||
(progn
|
||||
(insert-buffer-substring canonicalization-buffer
|
||||
mbox-beg mbox-end)
|
||||
(point)))
|
||||
(setq disable-initial-guessing-flag t)
|
||||
(setq word-found-flag t))
|
||||
|
||||
;; Handle & between names, as in "Bob & Susie".
|
||||
((and (> word-count 0) (eq (following-char) ?\&))
|
||||
(setq name-beg (point))
|
||||
(setq name-end (1+ name-beg))
|
||||
(setq word-found-flag t)
|
||||
(goto-char name-end))
|
||||
|
||||
;; Regular name words
|
||||
((looking-at mail-extr-name-pattern)
|
||||
(setq name-beg (point))
|
||||
(setq name-end (match-end 0))
|
||||
|
||||
;; Certain words will be dropped if they are at the end.
|
||||
(and (>= word-count 2)
|
||||
(not lower-case-flag)
|
||||
(or
|
||||
;; Trailing 4-or-more letter lowercase words preceded by
|
||||
;; mixed case or uppercase words will be dropped.
|
||||
(looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'")
|
||||
;; Drop a trailing word which is terminated with a period.
|
||||
(eq ?. (char-after (1- name-end))))
|
||||
(setq drop-this-word-if-trailing-flag t))
|
||||
|
||||
;; Set the flags that indicate whether we have seen a lowercase
|
||||
;; word, a mixed case word, and an uppercase word.
|
||||
(if (re-search-forward "[[:lower:]]" name-end t)
|
||||
(if (progn
|
||||
(goto-char name-beg)
|
||||
(re-search-forward "[[:upper:]]" name-end t))
|
||||
(setq mixed-case-flag t)
|
||||
(setq lower-case-flag t))
|
||||
;; (setq upper-case-flag t)
|
||||
)
|
||||
|
||||
(goto-char name-end)
|
||||
(setq word-found-flag t))
|
||||
|
||||
;; Allow a number as a word, if it doesn't mean anything else.
|
||||
((looking-at "[0-9]+\\>")
|
||||
(setq name-beg (point))
|
||||
(setq name-end (match-end 0))
|
||||
(goto-char name-end)
|
||||
(setq word-found-flag t))
|
||||
|
||||
(t
|
||||
;; Handle case of quoted initial
|
||||
(if (and (or (= 3 (- cend cbeg))
|
||||
(and (= 4 (- cend cbeg))
|
||||
(eq ?. (char-after (+ 2 cbeg)))))
|
||||
(not (looking-at " *\\'")))
|
||||
(setq initial (char-after (1+ cbeg)))
|
||||
(setq initial nil))
|
||||
(delete-region cbeg cend)
|
||||
(if initial
|
||||
(insert initial ". ")))))
|
||||
(setq name-done-flag t)
|
||||
))
|
||||
|
||||
;; Handle *Stupid* VMS date stamps
|
||||
((looking-at mail-extr-stupid-vms-date-stamp-pattern)
|
||||
(replace-match "" t))
|
||||
;; Count any word that we skipped over.
|
||||
(if word-found-flag
|
||||
(setq word-count (1+ word-count))))
|
||||
|
||||
;; Handle Chinese characters.
|
||||
((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern)
|
||||
(goto-char (match-end 0))
|
||||
(setq word-found-flag t))
|
||||
;; If the last thing in the name is 2 or more periods, or one or more
|
||||
;; other sentence terminators (but not a single period) then keep them
|
||||
;; and the preceding word. This is for the benefit of whole sentences
|
||||
;; in the name field: it's better behavior than dropping the last word
|
||||
;; of the sentence...
|
||||
(if (and (not suffix-flag)
|
||||
(looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'"))
|
||||
(goto-char (setq suffix-flag (point-max))))
|
||||
|
||||
;; Skip initial garbage characters.
|
||||
;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
||||
((and (eq word-count 0)
|
||||
(looking-at mail-extr-leading-garbage))
|
||||
(goto-char (match-end 0))
|
||||
;; *** Skip backward over these???
|
||||
;; (skip-chars-backward "& \"")
|
||||
;; Drop everything after point and certain trailing words.
|
||||
(narrow-to-region (point-min)
|
||||
(or (and drop-last-word-if-trailing-flag
|
||||
last-word-beg)
|
||||
(point)))
|
||||
|
||||
;; Xerox's mailers SUCK!!!!!!
|
||||
;; We simply refuse to believe that any last name is PARC or ADOC.
|
||||
;; If it looks like that is the last name, that there is no meaningful
|
||||
;; here at all. Actually I guess it would be best to map patterns
|
||||
;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't
|
||||
;; actually know that that is what's going on.
|
||||
(unless suffix-flag
|
||||
(goto-char (point-min))
|
||||
(let ((case-fold-search t))
|
||||
(if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
|
||||
(erase-buffer))))
|
||||
|
||||
;; If last name first put it at end (but before suffix)
|
||||
(when last-name-comma-flag
|
||||
(goto-char (point-min))
|
||||
(search-forward ",")
|
||||
(setq name-end (1- (point)))
|
||||
(goto-char (or suffix-flag (point-max)))
|
||||
(or (eq ?\ (preceding-char))
|
||||
(insert ?\ ))
|
||||
(insert-buffer-substring (current-buffer) (point-min) name-end)
|
||||
(goto-char name-end)
|
||||
(skip-chars-forward "\t ,")
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
;; Various stopping points
|
||||
((or
|
||||
;; Delete leading and trailing junk characters.
|
||||
;; *** This is probably completely unneeded now.
|
||||
;;(goto-char (point-max))
|
||||
;;(skip-chars-backward mail-extr-non-end-name-chars)
|
||||
;;(if (eq ?. (following-char))
|
||||
;; (forward-char 1))
|
||||
;;(narrow-to-region (point)
|
||||
;; (progn
|
||||
;; (goto-char (point-min))
|
||||
;; (skip-chars-forward mail-extr-non-begin-name-chars)
|
||||
;; (point)))
|
||||
|
||||
;; Stop before ALL CAPS acronyms, if preceded by mixed-case
|
||||
;; words. Example: XT-DEM.
|
||||
(and (>= word-count 2)
|
||||
mixed-case-flag
|
||||
(looking-at mail-extr-weird-acronym-pattern)
|
||||
(not (looking-at mail-extr-roman-numeral-pattern)))
|
||||
|
||||
;; Stop before trailing alternative address
|
||||
(looking-at mail-extr-alternative-address-pattern)
|
||||
|
||||
;; Stop before trailing comment not introduced by comma
|
||||
;; THIS CASE MUST BE AFTER AN EARLIER CASE.
|
||||
(looking-at mail-extr-trailing-comment-start-pattern)
|
||||
|
||||
;; Stop before telephone numbers
|
||||
(and (>= word-count 1)
|
||||
(looking-at mail-extr-telephone-extension-pattern)))
|
||||
(setq name-done-flag t))
|
||||
|
||||
;; Delete ham radio call signs
|
||||
((looking-at mail-extr-ham-call-sign-pattern)
|
||||
(delete-region (match-beginning 0) (match-end 0)))
|
||||
|
||||
;; Fixup initials
|
||||
((looking-at mail-extr-initial-pattern)
|
||||
(or (eq (following-char) (upcase (following-char)))
|
||||
(setq lower-case-flag t))
|
||||
(forward-char 1)
|
||||
(if (eq ?. (following-char))
|
||||
(forward-char 1)
|
||||
(insert ?.))
|
||||
(or (eq ?\ (following-char))
|
||||
(insert ?\ ))
|
||||
(setq word-found-flag t))
|
||||
|
||||
;; Handle BITNET LISTSERV list names.
|
||||
((and (eq word-count 0)
|
||||
(looking-at mail-extr-listserv-list-name-pattern))
|
||||
(narrow-to-region (match-beginning 1) (match-end 1))
|
||||
(setq word-found-flag t)
|
||||
(setq name-done-flag t))
|
||||
|
||||
;; Handle & substitution, when & is last and is not first.
|
||||
((and (> word-count 0)
|
||||
(eq ?\ (preceding-char))
|
||||
(eq (following-char) ?&)
|
||||
(eq (1+ (point)) (point-max)))
|
||||
(delete-char 1)
|
||||
(capitalize-region
|
||||
(point)
|
||||
(progn
|
||||
(insert-buffer-substring canonicalization-buffer
|
||||
mbox-beg mbox-end)
|
||||
(point)))
|
||||
(setq disable-initial-guessing-flag t)
|
||||
(setq word-found-flag t))
|
||||
|
||||
;; Handle & between names, as in "Bob & Susie".
|
||||
((and (> word-count 0) (eq (following-char) ?\&))
|
||||
(setq name-beg (point))
|
||||
(setq name-end (1+ name-beg))
|
||||
(setq word-found-flag t)
|
||||
(goto-char name-end))
|
||||
|
||||
;; Regular name words
|
||||
((looking-at mail-extr-name-pattern)
|
||||
(setq name-beg (point))
|
||||
(setq name-end (match-end 0))
|
||||
|
||||
;; Certain words will be dropped if they are at the end.
|
||||
(and (>= word-count 2)
|
||||
(not lower-case-flag)
|
||||
(or
|
||||
;; Trailing 4-or-more letter lowercase words preceded by
|
||||
;; mixed case or uppercase words will be dropped.
|
||||
(looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'")
|
||||
;; Drop a trailing word which is terminated with a period.
|
||||
(eq ?. (char-after (1- name-end))))
|
||||
(setq drop-this-word-if-trailing-flag t))
|
||||
|
||||
;; Set the flags that indicate whether we have seen a lowercase
|
||||
;; word, a mixed case word, and an uppercase word.
|
||||
(if (re-search-forward "[[:lower:]]" name-end t)
|
||||
(if (progn
|
||||
(goto-char name-beg)
|
||||
(re-search-forward "[[:upper:]]" name-end t))
|
||||
(setq mixed-case-flag t)
|
||||
(setq lower-case-flag t))
|
||||
;; (setq upper-case-flag t)
|
||||
)
|
||||
|
||||
(goto-char name-end)
|
||||
(setq word-found-flag t))
|
||||
|
||||
;; Allow a number as a word, if it doesn't mean anything else.
|
||||
((looking-at "[0-9]+\\>")
|
||||
(setq name-beg (point))
|
||||
(setq name-end (match-end 0))
|
||||
(goto-char name-end)
|
||||
(setq word-found-flag t))
|
||||
|
||||
(t
|
||||
(setq name-done-flag t)
|
||||
))
|
||||
|
||||
;; Count any word that we skipped over.
|
||||
(if word-found-flag
|
||||
(setq word-count (1+ word-count))))
|
||||
|
||||
;; If the last thing in the name is 2 or more periods, or one or more
|
||||
;; other sentence terminators (but not a single period) then keep them
|
||||
;; and the preceding word. This is for the benefit of whole sentences
|
||||
;; in the name field: it's better behavior than dropping the last word
|
||||
;; of the sentence...
|
||||
(if (and (not suffix-flag)
|
||||
(looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'"))
|
||||
(goto-char (setq suffix-flag (point-max))))
|
||||
|
||||
;; Drop everything after point and certain trailing words.
|
||||
(narrow-to-region (point-min)
|
||||
(or (and drop-last-word-if-trailing-flag
|
||||
last-word-beg)
|
||||
(point)))
|
||||
|
||||
;; Xerox's mailers SUCK!!!!!!
|
||||
;; We simply refuse to believe that any last name is PARC or ADOC.
|
||||
;; If it looks like that is the last name, that there is no meaningful
|
||||
;; here at all. Actually I guess it would be best to map patterns
|
||||
;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't
|
||||
;; actually know that that is what's going on.
|
||||
(unless suffix-flag
|
||||
;; Compress whitespace
|
||||
(goto-char (point-min))
|
||||
(let ((case-fold-search t))
|
||||
(if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
|
||||
(erase-buffer))))
|
||||
|
||||
;; If last name first put it at end (but before suffix)
|
||||
(when last-name-comma-flag
|
||||
(goto-char (point-min))
|
||||
(search-forward ",")
|
||||
(setq name-end (1- (point)))
|
||||
(goto-char (or suffix-flag (point-max)))
|
||||
(or (eq ?\ (preceding-char))
|
||||
(insert ?\ ))
|
||||
(insert-buffer-substring (current-buffer) (point-min) name-end)
|
||||
(goto-char name-end)
|
||||
(skip-chars-forward "\t ,")
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
;; Delete leading and trailing junk characters.
|
||||
;; *** This is probably completely unneeded now.
|
||||
;;(goto-char (point-max))
|
||||
;;(skip-chars-backward mail-extr-non-end-name-chars)
|
||||
;;(if (eq ?. (following-char))
|
||||
;; (forward-char 1))
|
||||
;;(narrow-to-region (point)
|
||||
;; (progn
|
||||
;; (goto-char (point-min))
|
||||
;; (skip-chars-forward mail-extr-non-begin-name-chars)
|
||||
;; (point)))
|
||||
|
||||
;; Compress whitespace
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "[ \t\n]+" nil t)
|
||||
(replace-match (if (eobp) "" " ") t))
|
||||
)))
|
||||
(while (re-search-forward "[ \t\n]+" nil t)
|
||||
(replace-match (if (eobp) "" " ") t))
|
||||
))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -484,7 +484,7 @@ the variable `rmail-mime-feature'.")
|
|||
|
||||
;;;###autoload
|
||||
(defvar rmail-mime-charset-pattern
|
||||
"^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\"]+\\)\"?"
|
||||
"^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"
|
||||
"Regexp to match MIME-charset specification in a header of message.
|
||||
The first parenthesized expression should match the MIME-charset name.")
|
||||
|
||||
|
|
|
|||
|
|
@ -209,7 +209,7 @@ loaddefs.el-CMD:
|
|||
echo (autoload 'define-derived-mode "derived")>> $@
|
||||
echo (autoload 'encoded-kbd-mode "encoded-kb")>> $@
|
||||
echo (defvar cvs-global-menu nil)>> $@
|
||||
echo. >> $@
|
||||
echo ;;; >> $@
|
||||
echo ;;; Local Variables:>> $@
|
||||
echo ;;; version-control: never>> $@
|
||||
echo ;;; no-byte-compile: t>> $@
|
||||
|
|
|
|||
2080
lisp/mh-e/ChangeLog
2080
lisp/mh-e/ChangeLog
File diff suppressed because it is too large
Load diff
144
lisp/mh-e/mh-acros.el
Normal file
144
lisp/mh-e/mh-acros.el
Normal 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
|
||||
|
|
@ -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 ""))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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'"))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
308
lisp/mh-e/mh-init.el
Normal 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
|
||||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
;;;***
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
279
lisp/mh-e/mh-print.el
Normal 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
|
||||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
;;; novice.el --- handling of disabled commands ("novice mode") for Emacs
|
||||
|
||||
;; Copyright (C) 1985, 1986, 1987, 1994, 2002 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 1985, 1986, 1987, 1994, 2002, 2004
|
||||
;; Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: FSF
|
||||
;; Keywords: internal, help
|
||||
|
|
@ -36,12 +37,17 @@
|
|||
;; and the keys are returned by (this-command-keys).
|
||||
|
||||
;;;###autoload
|
||||
(defvar disabled-command-hook 'disabled-command-hook
|
||||
(defvar disabled-command-function 'disabled-command-function
|
||||
"Function to call to handle disabled commands.
|
||||
If nil, the feature is disabled, i.e., all commands work normally.")
|
||||
|
||||
(defvaralias 'disabled-command-hook 'disabled-command-function)
|
||||
(make-obsolete-variable
|
||||
'disabled-command-hook
|
||||
"use the variable `disabled-command-function' instead." "21.4")
|
||||
|
||||
;;;###autoload
|
||||
(defun disabled-command-hook (&rest ignore)
|
||||
(defun disabled-command-function (&rest ignore)
|
||||
(let (char)
|
||||
(save-window-excursion
|
||||
(with-output-to-temp-buffer "*Help*"
|
||||
|
|
@ -91,7 +97,7 @@ SPC to try the command just this once, but leave it disabled.
|
|||
(ding)
|
||||
(message "Please type y, n, ! or SPC (the space bar): "))))
|
||||
(if (= char ?!)
|
||||
(setq disabled-command-hook nil))
|
||||
(setq disabled-command-function nil))
|
||||
(if (= char ?y)
|
||||
(if (and user-init-file
|
||||
(not (string= "" user-init-file))
|
||||
|
|
@ -104,7 +110,8 @@ SPC to try the command just this once, but leave it disabled.
|
|||
;;;###autoload
|
||||
(defun enable-command (command)
|
||||
"Allow COMMAND to be executed without special confirmation from now on.
|
||||
The user's .emacs file is altered so that this will apply
|
||||
COMMAND must be a symbol.
|
||||
This command alters the user's .emacs file so that this will apply
|
||||
to future sessions."
|
||||
(interactive "CEnable command: ")
|
||||
(put command 'disabled nil)
|
||||
|
|
@ -141,7 +148,8 @@ to future sessions."
|
|||
;;;###autoload
|
||||
(defun disable-command (command)
|
||||
"Require special confirmation to execute COMMAND from now on.
|
||||
The user's .emacs file is altered so that this will apply
|
||||
COMMAND must be a symbol.
|
||||
This command alters the user's .emacs file so that this will apply
|
||||
to future sessions."
|
||||
(interactive "CDisable command: ")
|
||||
(if (not (commandp command))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -974,7 +974,7 @@ Please send all bug fixes and enhancements to
|
|||
|
||||
|
||||
(and (string< ps-print-version "6.6.4")
|
||||
(error "`printing' requires `ps-print' package version 6.6.4 or later."))
|
||||
(error "`printing' requires `ps-print' package version 6.6.4 or later"))
|
||||
|
||||
|
||||
(eval-and-compile
|
||||
|
|
@ -4254,7 +4254,7 @@ are both set to t."
|
|||
(pr-ps-buffer-ps-print
|
||||
(if (integerp n-up)
|
||||
(min (max n-up 1) 100)
|
||||
(error "n-up must be an integer greater than zero."))
|
||||
(error "n-up must be an integer greater than zero"))
|
||||
filename)))
|
||||
|
||||
|
||||
|
|
@ -5031,7 +5031,7 @@ non-nil."
|
|||
(let ((item (cdr (assq value pr-ps-utility-alist))))
|
||||
(or item
|
||||
(error
|
||||
"Invalid PostScript utility name `%s' for variable `pr-ps-utility'."
|
||||
"Invalid PostScript utility name `%s' for variable `pr-ps-utility'"
|
||||
value))
|
||||
(setq pr-ps-utility value)
|
||||
(pr-eval-alist (nthcdr 9 item)))
|
||||
|
|
@ -5042,7 +5042,7 @@ non-nil."
|
|||
(let ((ps (cdr (assq value pr-ps-printer-alist))))
|
||||
(or ps
|
||||
(error
|
||||
"Invalid PostScript printer name `%s' for variable `pr-ps-name'."
|
||||
"Invalid PostScript printer name `%s' for variable `pr-ps-name'"
|
||||
value))
|
||||
(setq pr-ps-name value
|
||||
pr-ps-command (pr-dosify-file-name (nth 0 ps))
|
||||
|
|
@ -5068,7 +5068,7 @@ non-nil."
|
|||
(defun pr-txt-set-printer (value)
|
||||
(let ((txt (cdr (assq value pr-txt-printer-alist))))
|
||||
(or txt
|
||||
(error "Invalid text printer name `%s' for variable `pr-txt-name'."
|
||||
(error "Invalid text printer name `%s' for variable `pr-txt-name'"
|
||||
value))
|
||||
(setq pr-txt-name value
|
||||
pr-txt-command (pr-dosify-file-name (nth 0 txt))
|
||||
|
|
@ -5121,7 +5121,7 @@ non-nil."
|
|||
(setq global nil)))
|
||||
(and inherits
|
||||
(if (memq inherits old)
|
||||
(error "Circular inheritance for `%S'." inherits)
|
||||
(error "Circular inheritance for `%S'" inherits)
|
||||
(setq local-list
|
||||
(pr-eval-setting-alist inherits global
|
||||
(cons inherits old)))))
|
||||
|
|
@ -5349,7 +5349,7 @@ non-nil."
|
|||
|
||||
(defun pr-switches (switches mess)
|
||||
(or (listp switches)
|
||||
(error "%S should have a list of strings." mess))
|
||||
(error "%S should have a list of strings" mess))
|
||||
(ps-flatten-list ; dynamic evaluation
|
||||
(mapcar 'ps-eval-switch switches)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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 "\\(::\\|\\.\\)")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -458,9 +458,9 @@ starting the compilation process.")
|
|||
:version "21.4")
|
||||
|
||||
(defface compilation-info-face
|
||||
'((((class color) (min-colors 16) (background light))
|
||||
'((((class color) (min-colors 16) (background light))
|
||||
(:foreground "Green3" :weight bold))
|
||||
(((class color) (min-colors 16) (background dark))
|
||||
(((class color) (min-colors 16) (background dark))
|
||||
(:foreground "Green" :weight bold))
|
||||
(((class color)) (:foreground "green" :weight bold))
|
||||
(t (:weight bold)))
|
||||
|
|
@ -579,12 +579,17 @@ Faces `compilation-error-face', `compilation-warning-face',
|
|||
(and end-line
|
||||
(setq end-line (match-string-no-properties end-line))
|
||||
(setq end-line (string-to-number end-line)))
|
||||
(and col
|
||||
(setq col (match-string-no-properties col))
|
||||
(setq col (- (string-to-number col) compilation-first-column)))
|
||||
(if (and end-col (setq end-col (match-string-no-properties end-col)))
|
||||
(setq end-col (- (string-to-number end-col) compilation-first-column -1))
|
||||
(if end-line (setq end-col -1)))
|
||||
(if col
|
||||
(if (functionp col)
|
||||
(setq col (funcall col))
|
||||
(and
|
||||
(setq col (match-string-no-properties col))
|
||||
(setq col (- (string-to-number col) compilation-first-column)))))
|
||||
(if (and end-col (functionp end-col))
|
||||
(setq end-col (funcall end-col))
|
||||
(if (and end-col (setq end-col (match-string-no-properties end-col)))
|
||||
(setq end-col (- (string-to-number end-col) compilation-first-column -1))
|
||||
(if end-line (setq end-col -1))))
|
||||
(if (consp type) ; not a static type, check what it is.
|
||||
(setq type (or (and (car type) (match-end (car type)) 1)
|
||||
(and (cdr type) (match-end (cdr type)) 0)
|
||||
|
|
@ -726,9 +731,9 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
|
|||
,@(when end-line
|
||||
`((,end-line compilation-line-face nil t)))
|
||||
|
||||
,@(when col
|
||||
,@(when (integerp col)
|
||||
`((,col compilation-column-face nil t)))
|
||||
,@(when end-col
|
||||
,@(when (integerp end-col)
|
||||
`((,end-col compilation-column-face nil t)))
|
||||
|
||||
,@(nthcdr 6 item)
|
||||
|
|
@ -789,7 +794,10 @@ If this is run in a Compilation mode buffer, re-use the arguments from the
|
|||
original use. Otherwise, recompile using `compile-command'."
|
||||
(interactive)
|
||||
(save-some-buffers (not compilation-ask-about-save) nil)
|
||||
(let ((default-directory (or compilation-directory default-directory)))
|
||||
(let ((default-directory
|
||||
(or (and (not (eq major-mode (nth 1 compilation-arguments)))
|
||||
compilation-directory)
|
||||
default-directory)))
|
||||
(apply 'compilation-start (or compilation-arguments
|
||||
`(,(eval compile-command))))))
|
||||
|
||||
|
|
@ -816,8 +824,7 @@ Otherwise, construct a buffer name from MODE-NAME."
|
|||
(funcall name-function mode-name))
|
||||
(compilation-buffer-name-function
|
||||
(funcall compilation-buffer-name-function mode-name))
|
||||
((and (eq major-mode 'compilation-mode)
|
||||
(equal mode-name (nth 2 compilation-arguments)))
|
||||
((eq major-mode (nth 1 compilation-arguments))
|
||||
(buffer-name))
|
||||
(t
|
||||
(concat "*" (downcase mode-name) "*"))))
|
||||
|
|
@ -1101,7 +1108,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)
|
||||
|
|
@ -1520,7 +1529,8 @@ If nil, don't scroll the compilation output window."
|
|||
|
||||
(defun compilation-goto-locus (msg mk end-mk)
|
||||
"Jump to an error corresponding to MSG at MK.
|
||||
All arguments are markers. If END-MK is non nil, mark is set there."
|
||||
All arguments are markers. If END-MK is non-nil, mark is set there
|
||||
and overlay is highlighted between MK and END-MK."
|
||||
(if (eq (window-buffer (selected-window))
|
||||
(marker-buffer msg))
|
||||
;; If the compilation buffer window is selected,
|
||||
|
|
@ -1536,7 +1546,7 @@ All arguments are markers. If END-MK is non nil, mark is set there."
|
|||
(widen)
|
||||
(goto-char mk))
|
||||
(if end-mk
|
||||
(push-mark end-mk nil t)
|
||||
(push-mark end-mk t)
|
||||
(if mark-active (setq mark-active)))
|
||||
;; If hideshow got in the way of
|
||||
;; seeing the right place, open permanently.
|
||||
|
|
@ -1557,26 +1567,32 @@ All arguments are markers. If END-MK is non nil, mark is set there."
|
|||
compilation-highlight-regexp)))
|
||||
(compilation-set-window-height w)
|
||||
|
||||
(when (and highlight-regexp
|
||||
(not (and end-mk transient-mark-mode)))
|
||||
(when highlight-regexp
|
||||
(unless compilation-highlight-overlay
|
||||
(setq compilation-highlight-overlay
|
||||
(make-overlay (point-min) (point-min)))
|
||||
(overlay-put compilation-highlight-overlay 'face 'region))
|
||||
(overlay-put compilation-highlight-overlay 'face 'next-error))
|
||||
(with-current-buffer (marker-buffer mk)
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(if end-mk (goto-char end-mk) (end-of-line))
|
||||
(let ((end (point)))
|
||||
(beginning-of-line)
|
||||
(if mk (goto-char mk) (beginning-of-line))
|
||||
(if (and (stringp highlight-regexp)
|
||||
(re-search-forward highlight-regexp end t))
|
||||
(progn
|
||||
(goto-char (match-beginning 0))
|
||||
(move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
|
||||
(move-overlay compilation-highlight-overlay (point) end))
|
||||
(sit-for 0.5)
|
||||
(delete-overlay compilation-highlight-overlay)))))))
|
||||
|
||||
(move-overlay compilation-highlight-overlay
|
||||
(match-beginning 0) (match-end 0)
|
||||
(current-buffer)))
|
||||
(move-overlay compilation-highlight-overlay
|
||||
(point) end (current-buffer)))
|
||||
(if (numberp next-error-highlight)
|
||||
(sit-for next-error-highlight))
|
||||
(if (not (eq next-error-highlight t))
|
||||
(delete-overlay compilation-highlight-overlay))))))
|
||||
(when (and (eq next-error-highlight 'fringe-arrow))
|
||||
(set (make-local-variable 'overlay-arrow-position)
|
||||
(copy-marker (line-beginning-position))))))
|
||||
|
||||
(defun compilation-find-file (marker filename dir &rest formats)
|
||||
"Find a buffer for file FILENAME.
|
||||
|
|
|
|||
|
|
@ -772,26 +772,6 @@ Assumes the tags table is the current buffer."
|
|||
(all-completions string (tags-completion-table) predicate)
|
||||
(try-completion string (tags-completion-table) predicate))))
|
||||
|
||||
;; Return a default tag to search for, based on the text at point.
|
||||
(defun find-tag-default ()
|
||||
(save-excursion
|
||||
(while (looking-at "\\sw\\|\\s_")
|
||||
(forward-char 1))
|
||||
(if (or (re-search-backward "\\sw\\|\\s_"
|
||||
(save-excursion (beginning-of-line) (point))
|
||||
t)
|
||||
(re-search-forward "\\(\\sw\\|\\s_\\)+"
|
||||
(save-excursion (end-of-line) (point))
|
||||
t))
|
||||
(progn (goto-char (match-end 0))
|
||||
(buffer-substring-no-properties
|
||||
(point)
|
||||
(progn (forward-sexp -1)
|
||||
(while (looking-at "\\s'")
|
||||
(forward-char 1))
|
||||
(point))))
|
||||
nil)))
|
||||
|
||||
;; Read a tag name from the minibuffer with defaulting and completion.
|
||||
(defun find-tag-tag (string)
|
||||
(let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
|
||||
|
|
@ -1453,53 +1433,58 @@ where they were found."
|
|||
(tags-with-face 'highlight (princ buffer-file-name))
|
||||
(princ "':\n\n"))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward string nil t)
|
||||
(beginning-of-line)
|
||||
(let ((point-max (/ (float (point-max)) 100.0)))
|
||||
(while (re-search-forward string nil t)
|
||||
(message "Making tags apropos buffer for `%s'...%d%%"
|
||||
string
|
||||
(/ (point) point-max))
|
||||
(beginning-of-line)
|
||||
|
||||
(let* (;; Get the local value in the tags table
|
||||
;; buffer before switching buffers.
|
||||
(goto-func goto-tag-location-function)
|
||||
(tag-info (save-excursion (funcall snarf-tag-function)))
|
||||
(tag (if (eq t (car tag-info)) nil (car tag-info)))
|
||||
(file-path (save-excursion (if tag (file-of-tag)
|
||||
(save-excursion (next-line 1)
|
||||
(file-of-tag)))))
|
||||
(file-label (if tag (file-of-tag t)
|
||||
(save-excursion (next-line 1)
|
||||
(file-of-tag t))))
|
||||
(pt (with-current-buffer standard-output (point))))
|
||||
(if tag
|
||||
(progn
|
||||
(princ (format "[%s]: " file-label))
|
||||
(princ tag)
|
||||
(when (= (aref tag 0) ?\() (princ " ...)"))
|
||||
(with-current-buffer standard-output
|
||||
(make-text-button pt (point)
|
||||
'tag-info tag-info
|
||||
'file-path file-path
|
||||
'goto-func goto-func
|
||||
'action (lambda (button)
|
||||
(let ((tag-info (button-get button 'tag-info))
|
||||
(goto-func (button-get button 'goto-func)))
|
||||
(tag-find-file-of-tag (button-get button 'file-path))
|
||||
(widen)
|
||||
(funcall goto-func tag-info)))
|
||||
'face 'tags-tag-face
|
||||
'type 'button)))
|
||||
(princ (format "- %s" file-label))
|
||||
(with-current-buffer standard-output
|
||||
(make-text-button pt (point)
|
||||
'file-path file-path
|
||||
'action (lambda (button)
|
||||
(tag-find-file-of-tag (button-get button 'file-path))
|
||||
;; Get the local value in the tags table
|
||||
;; buffer before switching buffers.
|
||||
(goto-char (point-min)))
|
||||
'face 'tags-tag-face
|
||||
'type 'button))
|
||||
))
|
||||
(terpri)
|
||||
(forward-line 1))
|
||||
(let* ( ;; Get the local value in the tags table
|
||||
;; buffer before switching buffers.
|
||||
(goto-func goto-tag-location-function)
|
||||
(tag-info (save-excursion (funcall snarf-tag-function)))
|
||||
(tag (if (eq t (car tag-info)) nil (car tag-info)))
|
||||
(file-path (save-excursion (if tag (file-of-tag)
|
||||
(save-excursion (next-line 1)
|
||||
(file-of-tag)))))
|
||||
(file-label (if tag (file-of-tag t)
|
||||
(save-excursion (next-line 1)
|
||||
(file-of-tag t))))
|
||||
(pt (with-current-buffer standard-output (point))))
|
||||
(if tag
|
||||
(progn
|
||||
(princ (format "[%s]: " file-label))
|
||||
(princ tag)
|
||||
(when (= (aref tag 0) ?\() (princ " ...)"))
|
||||
(with-current-buffer standard-output
|
||||
(make-text-button pt (point)
|
||||
'tag-info tag-info
|
||||
'file-path file-path
|
||||
'goto-func goto-func
|
||||
'action (lambda (button)
|
||||
(let ((tag-info (button-get button 'tag-info))
|
||||
(goto-func (button-get button 'goto-func)))
|
||||
(tag-find-file-of-tag (button-get button 'file-path))
|
||||
(widen)
|
||||
(funcall goto-func tag-info)))
|
||||
'face 'tags-tag-face
|
||||
'type 'button)))
|
||||
(princ (format "- %s" file-label))
|
||||
(with-current-buffer standard-output
|
||||
(make-text-button pt (point)
|
||||
'file-path file-path
|
||||
'action (lambda (button)
|
||||
(tag-find-file-of-tag (button-get button 'file-path))
|
||||
;; Get the local value in the tags table
|
||||
;; buffer before switching buffers.
|
||||
(goto-char (point-min)))
|
||||
'face 'tags-tag-face
|
||||
'type 'button))
|
||||
))
|
||||
(terpri)
|
||||
(forward-line 1))
|
||||
(message nil))
|
||||
(when tags-apropos-verbose (princ "\n")))
|
||||
|
||||
(defun etags-tags-table-files ()
|
||||
|
|
|
|||
|
|
@ -64,6 +64,21 @@ will be parsed and highlighted as soon as you try to move to them."
|
|||
:version "21.4"
|
||||
:group 'grep)
|
||||
|
||||
(defcustom grep-highlight-matches t
|
||||
"*Non-nil to use special markers to highlight grep matches.
|
||||
|
||||
Some grep programs are able to surround matches with special
|
||||
markers in grep output. Such markers can be used to highlight
|
||||
matches in grep mode.
|
||||
|
||||
This option sets the environment variable GREP_COLOR to specify
|
||||
markers for highlighting and GREP_OPTIONS to add the --color
|
||||
option in front of any explicit grep options before starting
|
||||
the grep."
|
||||
:type 'boolean
|
||||
:version "21.4"
|
||||
:group 'grep)
|
||||
|
||||
(defcustom grep-scroll-output nil
|
||||
"*Non-nil to scroll the *grep* buffer window as output appears.
|
||||
|
||||
|
|
@ -230,6 +245,23 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
|
|||
'(("^\\(.+?\\)[:( \t]+\
|
||||
\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
|
||||
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6))
|
||||
("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
|
||||
1 2
|
||||
((lambda ()
|
||||
(setq compilation-error-screen-columns nil)
|
||||
(- (match-beginning 5) (match-end 3) 8))
|
||||
.
|
||||
(lambda () (- (match-end 5) (match-end 3) 8)))
|
||||
nil nil
|
||||
(4 (list 'face nil 'invisible t 'intangible t))
|
||||
(5 (list 'face compilation-column-face))
|
||||
(6 (list 'face nil 'invisible t 'intangible t))
|
||||
;; highlight other matches on the same line
|
||||
("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
|
||||
nil nil
|
||||
(1 (list 'face nil 'invisible t 'intangible t))
|
||||
(2 (list 'face compilation-column-face) t)
|
||||
(3 (list 'face nil 'invisible t 'intangible t))))
|
||||
("^Binary file \\(.+\\) matches$" 1 nil nil 1))
|
||||
"Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
|
||||
|
||||
|
|
@ -300,6 +332,10 @@ This variable's value takes effect when `grep-compute-defaults' is called.")
|
|||
(defun grep-process-setup ()
|
||||
"Setup compilation variables and buffer for `grep'.
|
||||
Set up `compilation-exit-message-function' and run `grep-setup-hook'."
|
||||
(when grep-highlight-matches
|
||||
;; Modify `process-environment' locally bound in `compilation-start'
|
||||
(setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=always"))
|
||||
(setenv "GREP_COLOR" "01;41"))
|
||||
(set (make-local-variable 'compilation-exit-message-function)
|
||||
(lambda (status code msg)
|
||||
(if (eq status 'exit)
|
||||
|
|
@ -384,9 +420,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
|
|||
(let ((tag-default
|
||||
(funcall (or find-tag-default-function
|
||||
(get major-mode 'find-tag-default-function)
|
||||
;; We use grep-tag-default instead of
|
||||
;; find-tag-default, to avoid loading etags.
|
||||
'grep-tag-default)))
|
||||
'find-tag-default)))
|
||||
(sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
|
||||
(grep-default (or (car grep-history) grep-command)))
|
||||
;; Replace the thing matching for with that around cursor.
|
||||
|
|
@ -457,25 +491,6 @@ temporarily highlight in visited source lines."
|
|||
(set (make-local-variable 'compilation-error-regexp-alist)
|
||||
grep-regexp-alist))
|
||||
|
||||
;; This is a copy of find-tag-default from etags.el.
|
||||
;;;###autoload
|
||||
(defun grep-tag-default ()
|
||||
(save-excursion
|
||||
(while (looking-at "\\sw\\|\\s_")
|
||||
(forward-char 1))
|
||||
(when (or (re-search-backward "\\sw\\|\\s_"
|
||||
(save-excursion (beginning-of-line) (point))
|
||||
t)
|
||||
(re-search-forward "\\(\\sw\\|\\s_\\)+"
|
||||
(save-excursion (end-of-line) (point))
|
||||
t))
|
||||
(goto-char (match-end 0))
|
||||
(buffer-substring (point)
|
||||
(progn (forward-sexp -1)
|
||||
(while (looking-at "\\s'")
|
||||
(forward-char 1))
|
||||
(point))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun grep-find (command-args)
|
||||
"Run grep via find, with user-specified args COMMAND-ARGS.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -213,53 +213,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)))))
|
||||
)
|
||||
;; For Emacs 20.4 and the earlier version.
|
||||
(if (and (boundp 'mule-version)
|
||||
(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 find-composition (pos &rest ignore)
|
||||
(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)))))))
|
||||
;; mule package isn't loaded
|
||||
(or (fboundp 'encode-composition-rule)
|
||||
(defun encode-composition-rule (rule)
|
||||
130))
|
||||
(or (fboundp 'find-composition)
|
||||
(defun find-composition (pos &rest ignore)
|
||||
nil))
|
||||
))
|
||||
|
||||
(defvar ps-mule-font-info-database
|
||||
nil
|
||||
"Alist of charsets with the corresponding font information.
|
||||
|
|
@ -273,7 +226,7 @@ CHARSET is a charset (symbol) for this font family,
|
|||
|
||||
FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
|
||||
|
||||
FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil.
|
||||
FONT-SRC is a font source: builtin, bdf, vflib, or nil.
|
||||
|
||||
If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name.
|
||||
|
||||
|
|
@ -847,7 +800,7 @@ the sequence."
|
|||
run-width)))
|
||||
;; We assume that all characters in this range have the same width.
|
||||
(setq char-width (* char-width (charset-width ps-mule-current-charset)))
|
||||
(let ((run-width (* (chars-in-region from to) char-width)))
|
||||
(let ((run-width (* (abs (- from to)) char-width)))
|
||||
(if (> run-width ps-width-remaining)
|
||||
(cons (min to
|
||||
(save-excursion
|
||||
|
|
|
|||
|
|
@ -10,12 +10,12 @@
|
|||
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
|
||||
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
|
||||
;; Keywords: wp, print, PostScript
|
||||
;; Time-stamp: <2004/03/10 18:57:00 vinicius>
|
||||
;; Version: 6.6.4
|
||||
;; Time-stamp: <2004/07/21 23:12:05 vinicius>
|
||||
;; Version: 6.6.5
|
||||
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
|
||||
|
||||
(defconst ps-print-version "6.6.4"
|
||||
"ps-print.el, v 6.6.4 <2004/03/10 vinicius>
|
||||
(defconst ps-print-version "6.6.5"
|
||||
"ps-print.el, v 6.6.5 <2004/07/21 vinicius>
|
||||
|
||||
Vinicius's last change version -- this file may have been edited as part of
|
||||
Emacs without changes to the version number. When reporting bugs, please also
|
||||
|
|
@ -1353,6 +1353,9 @@ Please send all bug fixes and enhancements to
|
|||
;; Acknowledgments
|
||||
;; ---------------
|
||||
;;
|
||||
;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC
|
||||
;; compliance of the generated PostScript.
|
||||
;;
|
||||
;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
|
||||
;; for black/white PostScript printers.
|
||||
;;
|
||||
|
|
@ -1424,7 +1427,7 @@ Please send all bug fixes and enhancements to
|
|||
;; initial port to Emacs 19. His code is no longer part of ps-print, but his
|
||||
;; work is still appreciated.
|
||||
;;
|
||||
;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, for
|
||||
;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for
|
||||
;; adding underline support. Their code also is no longer part of ps-print,
|
||||
;; but their efforts are not forgotten.
|
||||
;;
|
||||
|
|
@ -4162,6 +4165,7 @@ If EXTENSION is any other symbol, it is ignored."
|
|||
|
||||
(defun ps-message-log-max ()
|
||||
(and (not (string= (buffer-name) "*Messages*"))
|
||||
(boundp 'message-log-max)
|
||||
message-log-max))
|
||||
|
||||
|
||||
|
|
@ -4210,7 +4214,7 @@ If EXTENSION is any other symbol, it is ignored."
|
|||
|
||||
|
||||
(defvar ps-printing-region nil
|
||||
"Variable used to indicate if the region that ps-print is printing.
|
||||
"Variable used to indicate the region that ps-print is printing.
|
||||
It is a cons, the car of which is the line number where the region begins, and
|
||||
its cdr is the total number of lines in the buffer. Formatting functions can
|
||||
use this information to print the original line number (and not the number of
|
||||
|
|
@ -4729,12 +4733,16 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
|
|||
(let (str)
|
||||
(while content
|
||||
(setq str (cons (cond
|
||||
;; string
|
||||
((stringp (car content))
|
||||
(car content))
|
||||
;; function symbol
|
||||
((and (symbolp (car content)) (fboundp (car content)))
|
||||
(concat "(" (funcall (car content)) ")"))
|
||||
;; variable symbol
|
||||
((and (symbolp (car content)) (boundp (car content)))
|
||||
(concat "(" (symbol-value (car content)) ")"))
|
||||
;; otherwise, empty string
|
||||
(t
|
||||
""))
|
||||
str)
|
||||
|
|
@ -5424,9 +5432,9 @@ XSTART YSTART are the relative position for the first page in a sheet.")
|
|||
ps-adobe-tag
|
||||
"%%Title: " (buffer-name) ; Take job name from name of
|
||||
; first buffer printed
|
||||
"\n%%Creator: " (user-full-name)
|
||||
" (using ps-print v" ps-print-version
|
||||
")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
|
||||
"\n%%Creator: ps-print v" ps-print-version
|
||||
"\n%%For: " (user-full-name)
|
||||
"\n%%CreationDate: " (format-time-string "%T %b %d %Y")
|
||||
"\n%%Orientation: "
|
||||
(if ps-landscape-mode "Landscape" "Portrait")
|
||||
"\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
|
||||
|
|
@ -5434,8 +5442,11 @@ XSTART YSTART are the relative position for the first page in a sheet.")
|
|||
(ps-remove-duplicates
|
||||
(append (ps-fonts 'ps-font-for-text)
|
||||
(list (ps-font 'ps-font-for-header 'normal)
|
||||
(ps-font 'ps-font-for-header 'bold))))
|
||||
(ps-font 'ps-font-for-header 'bold)
|
||||
(ps-font 'ps-font-for-footer 'normal)
|
||||
(ps-font 'ps-font-for-footer 'bold))))
|
||||
"\n%%+ font ")
|
||||
"\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
|
||||
"\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
|
||||
(format " %d" (round (ps-page-dimensions-get-width dimensions)))
|
||||
(format " %d" (round (ps-page-dimensions-get-height dimensions)))
|
||||
|
|
@ -5455,11 +5466,11 @@ XSTART YSTART are the relative position for the first page in a sheet.")
|
|||
ps-error-handler-alist))
|
||||
1)) ; send to paper
|
||||
ps-print-prologue-0
|
||||
"\n%%BeginProcSet: UserDefinedPrologue\n\n")
|
||||
"\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
|
||||
|
||||
(ps-insert-string ps-user-defined-prologue)
|
||||
|
||||
(ps-output "\n%%EndProcSet\n\n")
|
||||
(ps-output "\n%%EndResource\n\n")
|
||||
|
||||
(ps-output-boolean "LandscapeMode "
|
||||
(or ps-landscape-mode
|
||||
|
|
@ -5565,26 +5576,37 @@ XSTART YSTART are the relative position for the first page in a sheet.")
|
|||
(setq ps-background-all-pages (nreverse ps-background-all-pages)
|
||||
ps-background-pages (nreverse ps-background-pages))
|
||||
|
||||
(ps-output "\n" ps-print-prologue-1)
|
||||
|
||||
(ps-output "\n/printGlobalBackground{\n")
|
||||
(ps-output "\n" ps-print-prologue-1
|
||||
"\n/printGlobalBackground{\n")
|
||||
(mapcar 'ps-output ps-background-all-pages)
|
||||
(ps-output "}def\n/printLocalBackground{\n}def\n")
|
||||
|
||||
;; Header/line number fonts
|
||||
(ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
|
||||
ps-header-title-font-size-internal
|
||||
(ps-font 'ps-font-for-header 'bold))
|
||||
(format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
|
||||
ps-header-font-size-internal
|
||||
(ps-font 'ps-font-for-header 'normal))
|
||||
(format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
|
||||
(ps-get-font-size 'ps-line-number-font-size)
|
||||
ps-line-number-font)
|
||||
(format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
|
||||
ps-footer-font-size-internal
|
||||
(ps-font 'ps-font-for-footer 'normal))
|
||||
"\n\n% ---- These lines must be kept together because...
|
||||
(ps-output
|
||||
"}def\n/printLocalBackground{\n}def\n"
|
||||
"\n%%EndProlog\n\n%%BeginSetup\n"
|
||||
"\n%%IncludeResource: font Times-Roman"
|
||||
"\n%%IncludeResource: font Times-Italic"
|
||||
"\n%%IncludeResource: font "
|
||||
(mapconcat 'identity
|
||||
(ps-remove-duplicates
|
||||
(append (ps-fonts 'ps-font-for-text)
|
||||
(list (ps-font 'ps-font-for-header 'normal)
|
||||
(ps-font 'ps-font-for-header 'bold)
|
||||
(ps-font 'ps-font-for-footer 'normal)
|
||||
(ps-font 'ps-font-for-footer 'bold))))
|
||||
"\n%%IncludeResource: font ")
|
||||
;; Header/line number fonts
|
||||
(format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
|
||||
ps-header-title-font-size-internal
|
||||
(ps-font 'ps-font-for-header 'bold))
|
||||
(format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
|
||||
ps-header-font-size-internal
|
||||
(ps-font 'ps-font-for-header 'normal))
|
||||
(format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
|
||||
(ps-get-font-size 'ps-line-number-font-size)
|
||||
ps-line-number-font)
|
||||
(format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
|
||||
ps-footer-font-size-internal
|
||||
(ps-font 'ps-font-for-footer 'normal))
|
||||
"\n\n% ---- These lines must be kept together because...
|
||||
|
||||
/h0 F
|
||||
/HeaderTitleLineHeight FontHeight def
|
||||
|
|
@ -5614,7 +5636,6 @@ XSTART YSTART are the relative position for the first page in a sheet.")
|
|||
(ps-output (format "/SpaceWidthRatio %f def\n"
|
||||
(/ (ps-lookup 'space-width) (ps-lookup 'size)))))
|
||||
|
||||
(ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
|
||||
(unless (eq ps-spool-config 'lpr-switches)
|
||||
(ps-output "\n%%BeginFeature: *Duplex "
|
||||
(ps-boolean-capitalized ps-spool-duplex)
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Reference in a new issue