Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-23 13:27:36 +00:00
Code Issues Projects Releases Packages Wiki Activity

merge trunk

Browse source
This commit is contained in:
Kenichi Handa 2010-09-16 11:11:13 +09:00
commit 38d50547c2
132 changed files with 11534 additions and 10968 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
ChangeLog
View file

@ -1,3 +1,16 @@
2010-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
* configure.in (HAVE_LIBXML2): Check that the libxml2 we found can
be used. This fixes a conf problem on Mac OS X.
2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
* configure.in: Check for libxml2.
2010-09-09 Glenn Morris <rgm@gnu.org>
* make-dist: No more TODO files under lisp/.
2010-09-04 Eli Zaretskii <eliz@gnu.org>
* config.bat: Produce lisp/gnus/_dir-locals.el from

151
README.imagemagick
View file

@ -1,151 +0,0 @@
* README for the ImageMagick Emacs branch
This is the imagemagick branch of Emacs. Imagemagick can now be used
to load many new image formats, and also do useful transforms like
scaling and rotation.
This file will attempt to contain draft NEWS, Changelog and manual
entries for the new functionality.
You might need to regenerate the configure scripts:
aclocal
automake
autoheader
autoconf
./configure --with-imagemagick
* TODO image-type-header-regexps priorities the jpeg loader over the
imagemagick one. This is not wrong, but how should a user go about
prefering the imagemagick loader? The user might like zooming etc in
jpegs.
try (setq image-type-header-regexps nil) for a quick hack to prefer
imagemagick over the jpg loader.
* TODO For some reason its unbearably slow to look at a page in a large
image bundle using the :index feature. The imagemagick "display"
command is also a bit slow, but nowhere near as slow as the emacs
code. It seems imagemagick tries to unpack every page when loading
the bundle. This feature is not the primary usecase for the
imagemagick patch though.
ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load.
It is now way faster to use the :index feature, but its still not
very fast.
** DONE optimize number of pages calculation for bundles as suggested by
imagemagick forum: "set the density to something low like 2 and use
MagickPingImage()"
** TODO try to cache the num pages calculation. it can take a while to
calculate the number of pages, and if you need to do it for each
page view, page-flipping becomes uselessly slow.
* TODO integrate with image-dired
* TODO integrate with docview.
* TODO integrate with image-mode
Some work has been done, M-x image-transform-fit-to-height will fit
the image to the height of the Emacs window for instance.
* TODO look for optimizations for handling images with low depth
Currently the code seems to default to 24 bit RGB which is costly for
images with lower bit depth.
* TODO complete documentation drafts below
* DONE fix inconsistencys with spelling of imagemagick in the src
* DONE report number of images in image bundle types somehow
Works like for "gif" support. Thanks to Juri Linkov.
* DONE probably add pdf to inhibited types
* DONE inhibit types is defconst should probably be defcustom
* TODO decide what to do with some uncommitted imagemagick support
functions for image size etc.
* TODO Test with more systems
Tested on Fedora 12, Fedora 14 so far, and the libmagick that ships with it.
Ubuntu 8.04 was also tested, but it seems it ships a broken
ImageMagick.
I also tried using an imagemagick compiled from their SVN, in
parallell with the one packaged by Fedora, it worked well.
* DONE Also need some way to handle render methods that only work on newer ImageMagicks
Is handled by configure now
* Some nits from Stefan Monnier
I just took a quick look at the code and I see the following nits to fix:
** DONE obviously a merge will have to come with a good ChangeLog.
** DONE also the merge will need to come with documentation. Maybe not in the
Texinfo form yet, but at least in the etc/NEWS with enough info that
describes the `scale' and other such arguments that someone can start
using them.
** DONE the README talks about naming inconsistencies, I think these should be
fixed before a first commit (should be straightforward).
** DONE the "let" in image.el should not be followed by a line break and the while
should be replaced by a dolist.
** DONE the prototype of imagemagick_load_image has some odd indentation in ([[2010.06.14]])
its args, not sure what happened.
** DONE a few lines in the C code break the 80columns limit.
** DONE please use ANSI style function declarations rather than K&R for new code. ([[2010.06.14]])
** DONE you can get rid of the prototypes by reordering the code. ([[2010.06.14]])
** DONE the docstrings in DEFUN should not be indented (they'll display ([[2010.06.14]])
weirdly otherwise in C-h f).
** DONE Some "{" are at the end of a for/if rather than on their own line. ([[2010.06.14]])
** DONE why use "*( imtypes + i)" rather than "imtypes[i]"? ([[2010.06.14]])
** DONE some "," lack a space after them. ([[2010.06.14]])
** DONE several "=" and "==" lack spaces around them. ([[2010.06.14]])
* NEWS entry
** ImageMagick support
It is now possible to use the Imagemagick library to load many new
image formats in Emacs.
To enable, use the following configure option:
--with-imagemagick
The new function (imagemagick-types) returns a list of image file
extensions that your installation of imagemagick supports.
The function (imagemagick-register-types) will enable the imagemagick
support for the extensions in imagemagick-types minus the types listed
in imagemagick-types-inhibit.
imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by default.
This means imagemagick will be used also to load jpeg files, if you
have both jpeg and imagemagick libraries linked. Add 'JPG to
imagemagick-types-inhibit if you do not want this.
imagemagick-render-type is a new variable which can be set to choose
between screen render methods.
- 0 is a conservative metod which works with older ImageMagick
versions. It is a bit slow, but robust.
- 1 utilizes a newer ImageMagick method
Images loaded with imagemagick will support a couple of new display
specification behaviours:
- if the :width and :height keywords are specified, these values are
used for scaling the image. If only one of :width or :height is
specified, the other one will be calculated so as to preserve the
aspect ratio.If both :width and :height are specified, aspect ratio
will not be preserved.
- :rotation specifies a rotation angle in degrees.
- :index specifies which image inside an image bundle file format, such
as TIFF or DJVM, to view.
The image-metadata function can be used to retrieve the total number
of images in an image bundle. This is simmilar to how GIF files work.
* Manual entry
nothing yet, but the NEWS entry could be adapted.

2
admin/unidata/unidata-gen.el
View file

@ -95,7 +95,7 @@
(with-temp-buffer
;; Insert a file of this format:
;; (CHAR NAME CATEGORY ...)
;; where CHAR is a charater code, the following elements are strings
;; where CHAR is a character code, the following elements are strings
;; representing character properties.
(insert-file-contents unidata-text-file)
(goto-char (point-min))

166
configure vendored
View file

@ -660,6 +660,8 @@ BLESSMAIL_TARGET
LIBS_MAIL
liblockfile
ALLOCA
LIBXML2_LIBS
LIBXML2_CFLAGS
LIBXSM
LIBGPM
LIBGIF
@ -807,6 +809,7 @@ with_tiff
with_gif
with_png
with_rsvg
with_xml2
with_imagemagick
with_xft
with_libotf
@ -1514,6 +1517,7 @@ Optional Packages:
--without-gif don't compile with GIF image support
--without-png don't compile with PNG image support
--without-rsvg don't compile with SVG image support
--without-xml2 don't compile with XML parsing support
--with-imagemagick compile with ImageMagick image support
--without-xft don't use XFT for anti aliased fonts
--without-libotf don't use libotf for OpenType font support
@ -2732,6 +2736,14 @@ else
fi
# Check whether --with-xml2 was given.
if test "${with_xml2+set}" = set; then :
withval=$with_xml2;
else
with_xml2=yes
fi
# Check whether --with-imagemagick was given.
if test "${with_imagemagick+set}" = set; then :
withval=$with_imagemagick;
@ -11070,6 +11082,160 @@ $as_echo "#define HAVE_X_SM 1" >>confdefs.h
fi
### Use libxml (-lxml2) if available
if test "${with_xml2}" != "no"; then
### I'm not sure what the version number should be, so I just guessed.
succeeded=no
# Extract the first word of "pkg-config", so it can be a program name with args.
set dummy pkg-config; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
$as_echo_n "(cached) " >&6
else
case $PKG_CONFIG in
[\\/]* | ?:[\\/]*)
ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
;;
esac
fi
PKG_CONFIG=$ac_cv_path_PKG_CONFIG
if test -n "$PKG_CONFIG"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
$as_echo "$PKG_CONFIG" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "$PKG_CONFIG" = "no" ; then
HAVE_LIBXML2=no
else
PKG_CONFIG_MIN_VERSION=0.9.0
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.2.0" >&5
$as_echo_n "checking for libxml-2.0 > 2.2.0... " >&6; }
if $PKG_CONFIG --exists "libxml-2.0 > 2.2.0" 2>&5; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
succeeded=yes
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_CFLAGS" >&5
$as_echo_n "checking LIBXML2_CFLAGS... " >&6; }
LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'`
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_CFLAGS" >&5
$as_echo "$LIBXML2_CFLAGS" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_LIBS" >&5
$as_echo_n "checking LIBXML2_LIBS... " >&6; }
LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'`
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_LIBS" >&5
$as_echo "$LIBXML2_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
LIBXML2_CFLAGS=""
LIBXML2_LIBS=""
## If we have a custom action on failure, don't print errors, but
## do set a variable so people can do so.
LIBXML2_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libxml-2.0 > 2.2.0"`
fi
else
echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
echo "*** See http://www.freedesktop.org/software/pkgconfig"
fi
fi
if test $succeeded = yes; then
HAVE_LIBXML2=yes
else
HAVE_LIBXML2=no
fi
if test "${HAVE_LIBXML2}" = "yes"; then
LIBS="$LIBXML2_LIBS $LIBS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5
$as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; }
if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lxml2 $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char htmlReadMemory ();
int
main ()
{
return htmlReadMemory ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_xml2_htmlReadMemory=yes
else
ac_cv_lib_xml2_htmlReadMemory=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_htmlReadMemory" >&5
$as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; }
if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then :
HAVE_LIBXML2=yes
else
HAVE_LIBXML2=no
fi
if test "${HAVE_LIBXML2}" = "yes"; then
$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h
else
LIBXML2_LIBS=""
LIBXML2_CFLAGS=""
fi
fi
fi
# If netdb.h doesn't declare h_errno, we must declare it by hand.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5
$as_echo_n "checking whether netdb declares h_errno... " >&6; }

19
configure.in
View file

@ -155,6 +155,7 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support])
OPTION_DEFAULT_ON([gif],[don't compile with GIF image support])
OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support])
OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
@ -2535,6 +2536,24 @@ if test "${HAVE_X11}" = "yes"; then
fi
AC_SUBST(LIBXSM)
### Use libxml (-lxml2) if available
if test "${with_xml2}" != "no"; then
### I'm not sure what the version number should be, so I just guessed.
PKG_CHECK_MODULES(LIBXML2, libxml-2.0 > 2.2.0, HAVE_LIBXML2=yes, HAVE_LIBXML2=no)
if test "${HAVE_LIBXML2}" = "yes"; then
LIBS="$LIBXML2_LIBS $LIBS"
AC_CHECK_LIB(xml2, htmlReadMemory, HAVE_LIBXML2=yes, HAVE_LIBXML2=no)
if test "${HAVE_LIBXML2}" = "yes"; then
AC_DEFINE(HAVE_LIBXML2, 1, [Define to 1 if you have the libxml library (-lxml2).])
else
LIBXML2_LIBS=""
LIBXML2_CFLAGS=""
fi
fi
fi
AC_SUBST(LIBXML2_LIBS)
AC_SUBST(LIBXML2_CFLAGS)
# If netdb.h doesn't declare h_errno, we must declare it by hand.
AC_CACHE_CHECK(whether netdb declares h_errno,
emacs_cv_netdb_declares_h_errno,

20
doc/emacs/ChangeLog
View file

@ -1,3 +1,23 @@
2010-09-14 Glenn Morris <rgm@gnu.org>
* cal-xtra.texi (Fancy Diary Display): Emphasize that sort should be
the last hook item.
* calendar.texi (Appointments): Also updated when a diary include file
is saved.
2010-09-14 Glenn Morris <rgm@gnu.org>
* trouble.texi (Bugs): Update the section intro.
(Known Problems): New section.
(Checklist): Misc updates. Prefer M-x report-emacs-bug.
(Sending Patches): Bug fixes are best as responses to existing bugs.
* emacs.texi (Known Problems): Add menu entry for new section.
2010-09-09 Glenn Morris <rgm@gnu.org>
* xresources.texi: Untabify.
2010-09-06 Chong Yidong <cyd@stupidchicken.com>
* dired.texi (Dired Enter): Minor doc fix (Bug#6982).

4
doc/emacs/cal-xtra.texi
View file

@ -613,7 +613,9 @@ each day's diary entries by their time of day. Here's how:
@noindent
For each day, this sorts diary entries that begin with a recognizable
time of day according to their times. Diary entries without times come
first within each day.
first within each day. Note how the sort command is placed at the end
of the hook list, in case earlier members of the list change the order
of the diary entries, or add items.
@vindex diary-include-string
Your main diary file can include other files. This permits a group of

9
doc/emacs/calendar.texi
View file

@ -1508,7 +1508,14 @@ automatically just after midnight. You can force an update at any
time by re-enabling appointment notification. Both these actions also
display the day's diary buffer, unless you set
@code{appt-display-diary} to @code{nil}. The appointments list is
also updated whenever the diary file is saved.
also updated whenever the diary file (or a file it includes; see
@iftex
@inforef{Fancy Diary Display,, emacs-xtra})
@end iftex
@ifnottex
@ref{Fancy Diary Display})
@end ifnottex
is saved.
@findex appt-add
@findex appt-delete

1
doc/emacs/emacs.texi
View file

@ -1137,6 +1137,7 @@ Dealing with Emacs Trouble
Reporting Bugs
* Known Problems:: How to read about known problems and bugs.
* Bug Criteria:: Have you really found a bug?
* Understanding Bug Reporting:: How to report a bug effectively.
* Checklist:: Steps to follow for a good bug report.

187
doc/emacs/trouble.texi
View file

@ -409,29 +409,76 @@ say something to the psychotherapist, you must end it by typing
@section Reporting Bugs
@cindex bugs
Sometimes you will encounter a bug in Emacs. Although we cannot
promise we can or will fix the bug, and we might not even agree that it
is a bug, we want to hear about problems you encounter. Often we agree
they are bugs and want to fix them.
To make it possible for us to fix a bug, you must report it. In order
to do so effectively, you must know when and how to do it.
Before reporting a bug, it is a good idea to see if it is already
known. You can find the list of known problems in the file
@file{etc/PROBLEMS} in the Emacs distribution; type @kbd{C-h C-p} to read
it. Some additional user-level problems can be found in @ref{Bugs and
problems, , Bugs and problems, efaq, GNU Emacs FAQ}. Looking up your
problem in these two documents might provide you with a solution or a
work-around, or give you additional information about related issues.
If you think you have found a bug in Emacs, please report it. We
cannot promise to fix it, or always to agree that it is a bug, but we
certainly want to hear about it. The same applies for new features
you would like to see added. The following sections will help you to
construct an effective bug report.
@menu
* Known Problems:: How to read about known problems and bugs.
* Criteria: Bug Criteria. Have you really found a bug?
* Understanding Bug Reporting:: How to report a bug effectively.
* Checklist:: Steps to follow for a good bug report.
* Sending Patches:: How to send a patch for GNU Emacs.
@end menu
@node Known Problems
@subsection Reading Existing Bug Reports and Known Problems
Before reporting a bug, if at all possible please check to see if it
is already known about. Indeed, it may already have been fixed in a
later release of Emacs, or in the development version. Here is a list
of the main places you can read about known issues:
@itemize
@item
The @file{etc/PROBLEMS} file in the Emacs distribution; type @kbd{C-h
C-p} to read it. This file contains a list of particularly well-known
issues that have been encountered in compiling, installing and running
Emacs. Often, there are suggestions for workarounds and solutions.
@item
Some additional user-level problems can be found in @ref{Bugs and
problems, , Bugs and problems, efaq, GNU Emacs FAQ}.
@item
The @samp{bug-gnu-emacs} mailing list (also available as the newsgroup
@samp{gnu.emacs.bug}). This is where you will find most Emacs bug
reports. You can read the list archives at
@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs}. If you
like, you can also subscribe to the list. Be aware that the sole
purpose of this list is to provide the Emacs maintainers with
information about bugs and feature requests. Reports may contain
fairly large amounts of data; spectators should not complain about
this.
@item
The bug tracker at @url{http://debbugs.gnu.org}. From early 2008,
reports from the @samp{bug-gnu-emacs} list have been sent here. The
tracker contains the same information as the mailing list, just in a
different format. You may prefer to browse and read reports using the
tracker.
@item
The @samp{emacs-pretest-bug} mailing list. This list is no longer
used, and is mainly of historical interest. At one time, it was used
for bug reports in development (i.e., not yet released) versions of
Emacs. You can read the archives for 2003 to mid 2007 at
@url{http://lists.gnu.org/archive/html/emacs-pretest-bug/}. From
late 2007 to mid 2008, the address was an alias for the
@samp{emacs-devel} mailing list. From mid 2008 onwards, it has been
an alias for @samp{bug-gnu-emacs}.
@item
The @samp{emacs-devel} mailing list. Sometimes people report bugs to
this mailing list. This is not the main purpose of the list, however,
and it is much better to send bug reports to the bug list. You should
not feel obliged to read this list before reporting a bug.
@end itemize
@node Bug Criteria
@subsection When Is There a Bug
@ -540,56 +587,81 @@ well.
@subsection Checklist for Bug Reports
@cindex reporting bugs
The best way to send a bug report is to mail it electronically to the
Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}. (If you want to
suggest a change as an improvement, use the same address.)
If you'd like to read the bug reports, you can find them on the
newsgroup @samp{gnu.emacs.bug}; keep in mind, however, that as a
spectator you should not criticize anything about what you see there.
The purpose of bug reports is to give information to the Emacs
maintainers. Spectators are welcome only as long as they do not
interfere with this. In particular, some bug reports contain fairly
large amounts of data; spectators should not complain about this.
Before reporting a bug, first try to see if the problem has already
been reported (@pxref{Known Problems}).
Please do not post bug reports using netnews; mail is more reliable
than netnews about reporting your correct address, which we may need
in order to ask you for more information. If your data is more than
500,000 bytes, please don't include it directly in the bug report;
instead, offer to send it on request, or make it available by ftp and
say where.
If you are able to, try the latest release of Emacs to see if the
problem has already been fixed. Even better is to try the latest
development version. We recognize that this is not easy for some
people, so do not feel that you absolutely must do this before making
a report.
@findex report-emacs-bug
A convenient way to send a bug report for Emacs is to use the command
@kbd{M-x report-emacs-bug}. This sets up a mail buffer (@pxref{Sending
Mail}) and automatically inserts @emph{some} of the essential
information. However, it cannot supply all the necessary information;
you should still read and follow the guidelines below, so you can enter
the other crucial information by hand before you send the message.
The best way to write a bug report for Emacs is to use the command
@kbd{M-x report-emacs-bug}. This sets up a mail buffer
(@pxref{Sending Mail}) and automatically inserts @emph{some} of the
essential information. However, it cannot supply all the necessary
information; you should still read and follow the guidelines below, so
you can enter the other crucial information by hand before you send
the message. You may feel that some of the information inserted by
@kbd{M-x report-emacs-bug} is not relevant, but unless you are
absolutely sure it is best to leave it, so that the developers can
decide for themselves.
When you have finished writing your report, type @kbd{C-c C-c} and it
will be sent to the Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}.
(If you want to suggest an improvement or new feature, use the same
address.) If you cannot send mail from inside Emacs, you can copy the
text of your report to your normal mail client and send it to that
address. Or you can simply send an email to that address describing
the problem.
Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and
stored in the tracker at @url{http://debbugs.gnu.org}. Please try to
include a valid reply email address, in case we need to ask you for
more information about your report. Submissions are moderated, so
there may be a delay before your report appears.
You do not need to know how the @url{http://debbugs.gnu.org} bug
tracker works in order to report a bug, but if you want to, you can
read the tracker's online documentation to see the various features
you can use.
All mail sent to the @samp{bug-gnu-emacs} mailing list is also
gatewayed to the @samp{bug.gnu.emacs} newsgroup. The reverse is also
true, but we ask you not to post bug reports via the newsgroup. It
can make it much harder to contact you if we need to ask for more
information, and it does not integrate well with the bug tracker.
If your data is more than 500,000 bytes, please don't include it
directly in the bug report; instead, offer to send it on request, or
make it available by ftp and say where.
To enable maintainers to investigate a bug, your report
should include all these things:
@itemize @bullet
@item
The version number of Emacs. Without this, we won't know whether there
is any point in looking for the bug in the current version of GNU
Emacs.
The version number of Emacs. Without this, we won't know whether there is any
point in looking for the bug in the current version of GNU Emacs.
You can get the version number by typing @kbd{M-x emacs-version
@key{RET}}. If that command does not work, you probably have something
other than GNU Emacs, so you will have to report the bug somewhere
else.
@kbd{M-x report-emacs-bug} includes this information automatically,
but if you are not using that command for your report you can get the
version number by typing @kbd{M-x emacs-version @key{RET}}. If that
command does not work, you probably have something other than GNU
Emacs, so you will have to report the bug somewhere else.
@item
The type of machine you are using, and the operating system name and
version number. @kbd{M-x emacs-version @key{RET}} provides this
information too. Copy its output from the @samp{*Messages*} buffer, so
that you get it all and get it accurately.
version number (again, automatically included by @kbd{M-x
report-emacs-bug}). @kbd{M-x emacs-version @key{RET}} provides this
information too. Copy its output from the @samp{*Messages*} buffer,
so that you get it all and get it accurately.
@item
The operands given to the @code{configure} command when Emacs was
installed.
installed (automatically included by @kbd{M-x report-emacs-bug}).
@item
A complete list of any modifications you have made to the Emacs source.
@ -619,12 +691,15 @@ the last line is terminated, but try telling the bugs that).
@item
The precise commands we need to type to reproduce the bug.
If at all possible, give a full recipe for an Emacs started with the
@samp{-Q} option (@pxref{Initial Options}). This bypasses your
@file{.emacs} customizations.
@findex open-dribble-file
@cindex dribble file
@cindex logging keystrokes
The easy way to record the input to Emacs precisely is to write a
dribble file. To start the file, execute the Lisp expression
One way to record the input to Emacs precisely is to write a dribble
file. To start the file, execute the Lisp expression
@example
(open-dribble-file "~/dribble")
@ -735,7 +810,7 @@ Check whether any programs you have loaded into the Lisp world,
including your @file{.emacs} file, set any variables that may affect the
functioning of Emacs. Also, see whether the problem happens in a
freshly started Emacs without loading your @file{.emacs} file (start
Emacs with the @code{-q} switch to prevent loading the init file). If
Emacs with the @code{-Q} switch to prevent loading the init files). If
the problem does @emph{not} occur then, you must report the precise
contents of any programs that you must load into the Lisp world in order
to cause the problem to occur.
@ -907,12 +982,10 @@ your best to help.
@itemize @bullet
@item
Send an explanation with your changes of what problem they fix or what
improvement they bring about. For a bug fix, just include a copy of the
bug report, and explain why the change fixes the bug.
(Referring to a bug report is not as good as including it, because then
we will have to look it up, and we have probably already deleted it if
we've already fixed the bug.)
improvement they bring about. For a fix for an existing bug, it is
best to reply to the relevant discussion on the @samp{bug-gnu-emacs}
list, or item in the @url{http://debbugs.gnu.org} tracker. Explain
why your change fixes the bug.
@item
Always include a proper bug report for the problem you think you have

2
doc/emacs/xresources.texi
View file

@ -480,7 +480,7 @@ Emacs.menu*.font: 8x16
For dialog boxes, use @samp{dialog*}:
@example
Emacs.dialog*.faceName: Sans-12
Emacs.dialog*.faceName: Sans-12
@end example
@noindent

8
doc/lispref/ChangeLog
View file

@ -1,3 +1,11 @@
2010-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
* syntax.texi (Syntax Flags): Document new `c' flag.
2010-09-09 Glenn Morris <rgm@gnu.org>
* display.texi (ImageMagick Images): General cleanup.
2010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change)
* files.texi (Directory Names): Use \` rather than ^.

75
doc/lispref/display.texi
View file

@ -4468,47 +4468,56 @@ specifying the bounding box of the PostScript image, analogous to the
@node ImageMagick Images
@subsection ImageMagick Images
The Imagemagick library can be used to load many image formats in Emacs.
@cindex ImageMagick images
@cindex images, support for more formats
The function (imagemagick-types) returns a list of image file
extensions that your installation of imagemagick supports.
If you build Emacs with ImageMagick (@url{http://www.imagemagick.org})
support, you can use the ImageMagick library to load many image formats.
The function (imagemagick-register-types) will enable the imagemagick
support for the extensions in imagemagick-types minus the types listed
in imagemagick-types-inhibit.
@findex imagemagick-types
The function @code{imagemagick-types} returns a list of image file
extensions that your installation of ImageMagick supports. To enable
support, you must call the function @code{imagemagick-register-types}.
imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by
default. There can be overlap between image loaders in your Emacs
installation. If you never want to use the ImageMagick loader to use
Jpeg files, for instance, add 'JPG to imagemagick-types-inhibit. Which
loader that will be used in practice depends on the priority of the
loaders.
@vindex imagemagick-types-inhibit
The variable @code{imagemagick-types-inhibit} specifies a list of
image types that you do @emph{not} want ImageMagick to handle. There
may be overlap between image loaders in your Emacs installation, and
you may prefer to use a different one for a given image type (which
@c FIXME how is this priority determined?
loader will be used in practice depends on the priority of the loaders).
@c FIXME why are these uppercase when image-types is lower-case?
@c FIXME what are the possibe options? Are these actually file extensions?
For example, if you never want to use the ImageMagick loader to use
JPEG files, add @code{JPG} to this list.
imagemagick-render-type is a new variable which can be set to choose
between screen render methods for the ImageMagick loader.
@vindex imagemagick-render-type
You can set the variable @code{imagemagick-render-type} to choose
between screen render methods for the ImageMagick loader. The options
are: @code{0}, a conservative method which works with older
@c FIXME details of this "newer method"?
@c Presumably it is faster but may be less "robust"?
ImageMagick versions (it is a bit slow, but robust); and @code{1},
a newer ImageMagick method.
- 0 is a conservative metod which works with older ImageMagick
versions. It is a bit slow, but robust.
Images loaded with ImageMagick support a few new display specifications:
- 1 utilizes a newer ImageMagick method
@table @code
@item :width, :height
The @code{:width} and @code{:height} keywords are used for scaling the
image. If only one of them is specified, the other one will be
calculated so as to preserve the aspect ratio. If both are specified,
aspect ratio may not be preserved.
@item :rotation
Specifies a rotation angle in degrees.
Images loaded with imagemagick will support a couple of new display
specification behaviours:
- if the :width and :height keywords are specified, these values are
used for scaling the image. If only one of :width or :height is
specified, the other one will be calculated so as to preserve the
aspect ratio.If both :width and :height are specified, aspect ratio
will not be preserved.
- :rotation specifies a rotation angle in degrees.
- :index specifies which image inside an image bundle file format, such
as TIFF or DJVM, to view.
The image-metadata function can be used to retrieve the total number
of images in an image bundle. This is simmilar to how GIF files work.
@item :index
Specifies which image to view inside an image bundle file format, such
as TIFF or DJVM. You can use the @code{image-metadata} function to
retrieve the total number of images in an image bundle (this is
similar to how GIF files work).
@end table
@node Other Image Types

119
doc/lispref/syntax.texi
View file

@ -292,19 +292,21 @@ identifying them as generic string delimiters.
@cindex syntax flags
In addition to the classes, entries for characters in a syntax table
can specify flags. There are seven possible flags, represented by the
characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{n},
and @samp{p}.
can specify flags. There are eight possible flags, represented by the
characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{c},
@samp{n}, and @samp{p}.
All the flags except @samp{n} and @samp{p} are used to describe
multi-character comment delimiters. The digit flags indicate that a
character can @emph{also} be part of a comment sequence, in addition to
the syntactic properties associated with its character class. The flags
are independent of the class and each other for the sake of characters
such as @samp{*} in C mode, which is a punctuation character, @emph{and}
the second character of a start-of-comment sequence (@samp{/*}),
@emph{and} the first character of an end-of-comment sequence
(@samp{*/}).
All the flags except @samp{p} are used to describe comment
delimiters. The digit flags are used for comment delimiters made up
of 2 characters. They indicate that a character can @emph{also} be
part of a comment sequence, in addition to the syntactic properties
associated with its character class. The flags are independent of the
class and each other for the sake of characters such as @samp{*} in
C mode, which is a punctuation character, @emph{and} the second
character of a start-of-comment sequence (@samp{/*}), @emph{and} the
first character of an end-of-comment sequence (@samp{*/}). The flags
@samp{b}, @samp{c}, and @samp{n} are used to qualify the corresponding
comment delimiter.
Here is a table of the possible flags for a character @var{c},
and what they mean:
@ -325,55 +327,15 @@ sequence.
@samp{4} means @var{c} is the second character of such a sequence.
@item
@c Emacs 19 feature
@samp{b} means that @var{c} as a comment delimiter belongs to the
alternative ``b'' comment style.
alternative ``b'' comment style. For a two-character comment starter,
this flag is only significant on the second char, and for a 2-character
comment ender it is only significant on the first char.
Emacs supports two comment styles simultaneously in any one syntax
table. This is for the sake of C++. Each style of comment syntax has
its own comment-start sequence and its own comment-end sequence. Each
comment must stick to one style or the other; thus, if it starts with
the comment-start sequence of style ``b,'' it must also end with the
comment-end sequence of style ``b.''
The two comment-start sequences must begin with the same character; only
the second character may differ. Mark the second character of the
``b''-style comment-start sequence with the @samp{b} flag.
A comment-end sequence (one or two characters) applies to the ``b''
style if its first character has the @samp{b} flag set; otherwise, it
applies to the ``a'' style.
The appropriate comment syntax settings for C++ are as follows:
@table @asis
@item @samp{/}
@samp{124b}
@item @samp{*}
@samp{23}
@item newline
@samp{>b}
@end table
This defines four comment-delimiting sequences:
@table @asis
@item @samp{/*}
This is a comment-start sequence for ``a'' style because the
second character, @samp{*}, does not have the @samp{b} flag.
@item @samp{//}
This is a comment-start sequence for ``b'' style because the second
character, @samp{/}, does have the @samp{b} flag.
@item @samp{*/}
This is a comment-end sequence for ``a'' style because the first
character, @samp{*}, does not have the @samp{b} flag.
@item newline
This is a comment-end sequence for ``b'' style, because the newline
character has the @samp{b} flag.
@end table
@item
@samp{c} means that @var{c} as a comment delimiter belongs to the
alternative ``c'' comment style. For a two-character comment
delimiter, @samp{c} on either character makes it of style ``c''.
@item
@samp{n} on a comment delimiter character specifies
@ -381,6 +343,45 @@ that this kind of comment can be nested. For a two-character
comment delimiter, @samp{n} on either character makes it
nestable.
Emacs supports several comment styles simultaneously in any one syntax
table. A comment style is a set of flags @samp{b}, @samp{c}, and
@samp{n}, so there can be up to 8 different comment styles.
Each comment delimiter has a style and only matches comment delimiters
of the same style. Thus if a comment starts with the comment-start
sequence of style ``bn'', it will extend until the next matching
comment-end sequence of style ``bn''.
The appropriate comment syntax settings for C++ can be as follows:
@table @asis
@item @samp{/}
@samp{124}
@item @samp{*}
@samp{23b}
@item newline
@samp{>}
@end table
This defines four comment-delimiting sequences:
@table @asis
@item @samp{/*}
This is a comment-start sequence for ``b'' style because the
second character, @samp{*}, has the @samp{b} flag.
@item @samp{//}
This is a comment-start sequence for ``a'' style because the second
character, @samp{/}, does not have the @samp{b} flag.
@item @samp{*/}
This is a comment-end sequence for ``b'' style because the first
character, @samp{*}, does have the @samp{b} flag.
@item newline
This is a comment-end sequence for ``a'' style, because the newline
character does not have the @samp{b} flag.
@end table
@item
@c Emacs 19 feature
@samp{p} identifies an additional ``prefix character'' for Lisp syntax.

44
doc/lispref/text.texi
View file

@ -59,6 +59,7 @@ the character after point.
position stored in a register.
* Base 64:: Conversion to or from base 64 encoding.
* MD5 Checksum:: Compute the MD5 "message digest"/"checksum".
* Parsing HTML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes "atomically".
* Change Hooks:: Supplying functions to be run when text is changed.
@end menu
@ -4106,6 +4107,49 @@ using the specified or chosen coding system. However, if
coding instead.
@end defun
@node Parsing HTML
@section Parsing HTML
@cindex parsing html
@cindex parsing xml
Emacs provides an interface to the @code{libxml2} library via two
functions: @code{html-parse-buffer} and @code{xml-parse-buffer}. The
HTML function will parse ``real world'' HTML and try to return a
sensible parse tree, while the XML function is somewhat stricter about
syntax.
They both take a two optional parameter. The first is a buffer, and
the second is a base URL to be used to expand relative URLs in the
document, if any.
Here's an example demonstrating the structure of the parsed data you
get out. Given this HTML document:
@example
<html><hEad></head><body width=101><div class=thing>Foo<div>Yes
@end example
You get this parse tree:
@example
(html
(head)
(body
(:width . "101")
(div
(:class . "thing")
(text . "Foo")
(div
(text . "Yes\n")))))
@end example
It's a simple tree structure, where the @code{car} for each node is
the name of the node, and the @code{cdr} is the value, or the list of
values.
Attributes are coded the same way as child nodes, but with @samp{:} as
the first character.
@node Atomic Changes
@section Atomic Change Groups
@cindex atomic changes

16
doc/misc/ChangeLog
View file

@ -1,3 +1,19 @@
2010-09-13 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi (Inline methods): Remove "ssh1_old", "ssh2_old" and
"fish" methods.
(External methods): Remove "scp1_old" and "scp2_old" methods.
2010-09-09 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi: Remove Japanese manual. Fix typo.
* trampver.texi: Update release number. Remove japanesemanual.
2010-09-09 Glenn Morris <rgm@gnu.org>
* org.texi: Restore clobbered changes (copyright years, untabify).
2010-09-04 Julien Danjou <julien@danjou.info> (tiny change)
* gnus.texi (Adaptive Scoring): Fix typo.

1001
doc/misc/org.texi
View file

File diff suppressed because it is too large Load diff

29
doc/misc/tramp.texi
View file

@ -16,7 +16,7 @@
@include trampver.texi
@c Macro for formatting a filename according to the repective syntax.
@c Macro for formatting a filename according to the respective syntax.
@c xxx and yyy are auxiliary macros in order to omit leading and
@c trailing whitespace. Not very elegant, but I don't know it better.
@ -105,11 +105,6 @@ If you're using the other Emacs flavor, you should read the
@end ifset
@ifhtml
@ifset jamanual
This manual is also available as a @uref{@value{japanesemanual},
Japanese translation}.
@end ifset
The latest release of @value{tramp} is available for
@uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see
@ref{Obtaining Tramp} for more details, including the CVS server
@ -171,7 +166,6 @@ Installing @value{tramp} with your @value{emacsname}
* Installation parameters:: Parameters in order to control installation.
* Load paths:: How to plug-in @value{tramp} into your environment.
* Japanese manual:: Japanese manual.
@end ifset
@ -625,10 +619,6 @@ or 2 to connect to the remote host. (You can also specify in
@file{~/.ssh/config}, the SSH configuration file, which protocol
should be used, and use the regular @option{ssh} method.)
Two other variants, @option{ssh1_old} and @option{ssh2_old}, use the
@command{ssh1} and @command{ssh2} commands explicitly. If you don't
know what these are, you do not need these options.
All the methods based on @command{ssh} have an additional feature: you
can specify a host name which looks like @file{host#42} (the real host
name, then a hash sign, then a port number). This means to connect to
@ -737,19 +727,6 @@ expects PuTTY session names, calling @samp{plink -load @var{session}
hasn't defined a user name. Different port numbers must be defined in
the session.
@item @option{fish}
@cindex method fish
@cindex fish method
This is an experimental implementation of the fish protocol, known from
the GNU Midnight Commander or the KDE Konqueror. @value{tramp} expects
the fish server implementation from the KDE kioslave. That means, the
file @file{~/.fishsrv.pl} is expected to reside on the remote host.
The implementation lacks good performance. The code is offered anyway,
maybe somebody can improve the performance.
@end table
@ -809,10 +786,6 @@ or 2 to connect to the remote host. (You can also specify in
@file{~/.ssh/config}, the SSH configuration file, which protocol
should be used, and use the regular @option{scp} method.)
Two other variants, @option{scp1_old} and @option{scp2_old}, use the
@command{ssh1} and @command{ssh2} commands explicitly. If you don't
know what these are, you do not need these options.
All the @command{ssh} based methods support the @samp{-p} feature
where you can specify a port number to connect to in the host name.
For example, the host name @file{host#42} tells @value{tramp} to

4
doc/misc/trampver.texi
View file

@ -9,7 +9,7 @@
@c In the Tramp CVS, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
@set trampver 2.1.19
@set trampver 2.2.0-pre
@c Other flags from configuration
@set instprefix /usr/local
@ -56,7 +56,6 @@
@set emacsothername XEmacs
@set emacsotherdir xemacs
@set emacsotherfilename tramp-xemacs.html
@set japanesemanual tramp_ja-emacs.html
@end ifset
@c XEmacs counterparts.
@ -73,7 +72,6 @@
@set emacsothername GNU Emacs
@set emacsotherdir emacs
@set emacsotherfilename tramp-emacs.html
@set japanesemanual tramp_ja-xemacs.html
@end ifset
@ignore

13
etc/ChangeLog
View file

@ -1,3 +1,16 @@
2010-09-13 Michael Albinus <michael.albinus@gmx.de>
* NEWS: Some Tramp methods are discontinued.
2010-09-11 Glenn Morris <rgm@gnu.org>
* emacs.bash, emacs.csh, ms-kermit: Remove obsolete files (use
emacsclient -a instead of the first two).
2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
* NEWS: Mention the new libxml2 functions.
2010-08-25 Kenichi Handa <handa@m17n.org>
* HELLO: Change designation sequences for Arabic text.

58
etc/NEWS
View file

@ -113,21 +113,17 @@ The frame-parameter tool-bar-position controls this. It takes the values
top, left, right or bottom. The Options => Show/Hide menu has entries
for this.
** ImageMagick support
** ImageMagick support.
It is now possible to use the Imagemagick library to load many new
image formats in Emacs.
image formats in Emacs. To enable this, use the configure option
`--with-imagemagick'.
To enable, use the following configure option:
--with-imagemagick
The new function `imagemagick-types' returns a list of image file
extensions that your installation of ImageMagick supports. The
function `imagemagick-register-types' enables ImageMagick support for
these imaeg types, minus those listed in `imagemagick-types-inhibit'.
The new function (imagemagick-types) returns a list of image file
extensions that your installation of imagemagick supports.
The function (imagemagick-register-types) will enable the imagemagick
support for the extensions in imagemagick-types minus the types listed
in imagemagick-types-inhibit.
See the Emacs Manual for more information.
See the Emacs Lisp Reference Manual for more information.
** The colors for selected text (the region face) are taken from the GTK
theme when Emacs is built with GTK.
@ -321,10 +317,24 @@ For example, adding "(diff-mode . ((mode . whitespace)))" to your
variables `sql-product', `sql-user', `sql-server', `sql-database' and
`sql-port' can now be safely used as local variables.
*** `sql-dialect' is a synonym for `sql-product'.
*** Added ability to login with a port on MySQL.
The custom variable `sql-port' can be specified for connection to
MySQL servers.
*** Dynamic selection of product in an SQL interactive session.
If you use `sql-product-interactive' to start an SQL interactive
session it uses the current value of `sql-product'. Preceding the
invocation with C-u will force it to ask for the product before
creating the session.
*** Renaming a SQL interactive buffer when it is created.
Prefixing the SQL interactive commands (`sql-sqlite', `sql-postgres',
`sql-mysql', etc.) with C-u will force a new interactive session to be
started and will prompt for the new name. This will reduce the need
for `sql-rename-buffer' is most common use cases.
*** Command continuation prompts in SQL interactive mode are suppressed.
Multiple line commands in SQL interactive mode, generate command
continuation prompts which needlessly confuse the output. These
@ -424,6 +434,11 @@ threads simultaneously.
*** It is possible now, to access alternative buses than the default
system or session bus.
** Tramp
*** The following access methods are discontinued: "ssh1_old",
"ssh2_old", "scp1_old", "scp2_old" and "fish".
* New Modes and Packages in Emacs 24.1
@ -470,8 +485,19 @@ has now been removed.
* Lisp changes in Emacs 24.1
** New variable syntax-propertize-function to set syntax-table properties.
Replaces font-lock-syntactic-keywords which are now obsolete.
This allows syntax-table properties to be set independently from font-lock:
just call syntax-propertize to make sure the text is propertized.
Together with this new variable come a new hook
syntax-propertize-extend-region-functions, as well as two helper functions:
syntax-propertize-via-font-lock to reuse old font-lock-syntactic-keywords
as-is; and syntax-propertize-rules which provides a new way to specify
syntactic rules.
** New hook post-self-insert-hook run at the end of self-insert-command.
+++
** Syntax tables support a new "comment style c" additionally to style b.
** frame-local variables cannot be let-bound any more.
** prog-mode is a new major-mode meant to be the parent of programming mode.
@ -497,6 +523,14 @@ by the Graphic Control Extension of the image.
*** `image-extension-data' is renamed to `image-metadata'.
** XML and HTML parsing
*** If Emacs is compiled with libxml2 support (which is the default),
two new Emacs Lisp-level functions are defined: `html-parse-string'
(which will parse "real world" HTML) and `xml-parse-string' (which
parses XML). Both return an Emacs Lisp parse tree. See the Emacs
Lisp Reference Manual for details.
** Isearch
*** New hook `isearch-update-post-hook' that runs in `isearch-update'.

2
etc/NEWS.23
View file

@ -40,6 +40,8 @@ This can be used in place of the default appt-message-warning-time.
* Lisp changes in Emacs 23.3
** The use of unintern without an obarray arg is declared obsolete.
** New function byte-to-string, like char-to-string but for bytes.

502
etc/TODO
View file

@ -625,6 +625,508 @@ http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg02234.html
the window associated with that modeline.
http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02416.html
* Things to be done for specific packages or features
** ImageMagick support
*** image-type-header-regexps priorities the jpeg loader over the
ImageMagick one. This is not wrong, but how should a user go about
prefering the ImageMagick loader? The user might like zooming etc in jpegs.
Try (setq image-type-header-regexps nil) for a quick hack to prefer
ImageMagick over the jpg loader.
*** For some reason its unbearably slow to look at a page in a large
image bundle using the :index feature. The ImageMagick "display"
command is also a bit slow, but nowhere near as slow as the Emacs
code. It seems ImageMagick tries to unpack every page when loading the
bundle. This feature is not the primary usecase in Emacs though.
ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load. It
is now much faster to use the :index feature, but still not very fast.
*** Try to cache the num pages calculation. It can take a while to
calculate the number of pages, and if you need to do it for each page
view, page-flipping becomes uselessly slow.
*** Integrate with image-dired.
*** Integrate with docview.
*** Integrate with image-mode.
Some work has been done, e.g. M-x image-transform-fit-to-height will
fit the image to the height of the Emacs window.
*** Look for optimizations for handling images with low depth.
Currently the code seems to default to 24 bit RGB which is costly for
images with lower bit depth.
*** Decide what to do with some uncommitted imagemagick support
functions for image size etc.
*** Test with more systems.
Tested on Fedora 12, 14, and the libmagick that ships with it.
I also tried using an ImageMagick compiled from their SVN, in
parallel with the one packaged by Fedora, it worked well.
Ubuntu 8.04 was tested, but it seems it ships a broken ImageMagick.
** nxml mode
*** High priority
**** Command to insert an element template, including all required
attributes and child elements. When there's a choice of elements
possible, we could insert a comment, and put an overlay on that
comment that makes it behave like a button with a pop-up menu to
select the appropriate choice.
**** Command to tag a region. With a schema should complete using legal
tags, but should work without a schema as well.
**** Provide a way to conveniently rename an element. With a schema should
complete using legal tags, but should work without a schema as well.
*** Outlining
**** Implement C-c C-o C-q.
**** Install pre/post command hook for moving out of invisible section.
**** Put a modify hook on invisible sections that expands them.
**** Integrate dumb folding somehow.
**** An element should be able to be its own heading.
**** Optimize to avoid complete buffer scan on each command.
**** Make it work with HTML-style headings (i.e. level indicated by
name of heading element rather than depth of section nesting).
**** Recognize root element as a section provided it has a title, even
if it doesn't match section-element-name-regex.
**** Support for incremental search automatically making hidden text visible.
**** Allow title to be an attribute.
**** Command that says to recognize the tag at point as a section/heading.
**** Explore better ways to determine when an element is a section
or a heading.
**** rng-next-error needs to either ignore invisible portion or reveal it
(maybe use isearch oriented text properties).
**** Errors within hidden section should be highlighted by underlining the
ellipsis.
**** Make indirect buffers work.
**** How should nxml-refresh outline recover from non well-formed tags?
**** Hide tags in title elements?
**** Use overlays instead of text properties for holding outline state?
Necessary for indirect buffers to work?
**** Allow an outline to go in the speedbar.
**** Split up outlining manual section into subsections.
**** More detail in the manual about each outlining command.
**** More menu entries for hiding/showing?
**** Indication of many lines have been hidden?
*** Locating schemas
**** Should rng-validate-mode give the user an opportunity to specify a
schema if there is currently none? Or should it at least give a hint
to the user how to specify a non-vacuous schema?
**** Support for adding new schemas to schema-locating files.
Add documentElement and namespace elements.
**** C-c C-w should be able to report current type id.
**** Implement doctypePublicId.
**** Implement typeIdBase.
**** Implement typeIdProcessingInstruction.
**** Support xml:base.
**** Implement group.
**** Find preferred prefix from schema-locating files. Get rid of
rng-preferred-prefix-alist.
**** Inserting document element with vacuous schema should complete using
document elements declared in schema locating files, and set schema
appropriately.
**** Add a ruleType attribute to the <include> element?
**** Allow processing instruction in prolog to contain the compact syntax
schema directly.
**** Use RDDL to locate a schema based on the namespace URI.
**** Should not prompt to add redundant association to schema locating file.
**** Command to reload current schema.
*** Schema-sensitive features
**** Should filter dynamic markup possibilities using schema validity, by
adding hook to nxml-mode.
**** Dynamic markup word should (at least optionally) be able to look in
other buffers that are using nxml-mode.
**** Should clicking on Invalid move to next error if already on an error?
**** Take advantage of a:documentation. Needs change to schema format.
**** Provide feasible validation (as in Jing) toggle.
**** Save the validation state as a property on the error overlay to enable
more detailed diagnosis.
**** Provide an Error Summary buffer showing all the validation errors.
**** Pop-up menu. What is useful? Tag a region (should be greyed out if
the region is not balanced). Suggestions based on error messages.
**** Have configurable list of namespace URIs so that we can provide
namespace URI completion on extension elements or with schema-less documents.
**** Allow validation to handle XInclude.
**** ID/IDREF support.
*** Completion
**** Make it work with icomplete. Only use a function to complete when
some of the possible names have undeclared namespaces.
**** How should C-return in mixed text work?
**** When there's a vacuous schema, C-return after < will insert the end-tag.
Is this a bug or a feature?
**** After completing start-tag, ensure we don't get unhelpful message
from validation
**** Syntax table for completion.
**** Should complete start-tag name with a space if namespace attributes
are required.
**** When completing start-tag name with no prefix and it doesn't match
should try to infer namespace from local name.
**** Should completion pay attention to characters after point? If so, how?
**** When completing start-tag name, add required atts if only one required
attribute.
**** When completing attribute name, add attribute value if only one value
is possible.
**** After attribute-value completion, insert space after close delimiter
if more attributes are required.
**** Complete on enumerated data values in elements.
**** When in context that allows only elements, should get tag
completion without having to type < first.
**** When immediately after start-tag name, and name is valid and not
prefix of any other name, should C-return complete on attribute names?
**** When completing attributes, more consistent to ignore all attributes
after point.
**** Inserting attribute value completions needs to be sensitive to what
delimiter is used so that it quotes the correct character.
**** Complete on encoding-names in XML decl.
**** Complete namespace declarations by searching for all namespaces
mentioned in the schema.
*** Well-formed XML support
**** Deal better with Mule-UCS
**** Deal with UTF-8 BOM when reading.
**** Complete entity names.
**** Provide some support for entity names for MathML.
**** Command to repeat the last tag.
**** Support for changing between character references and characters.
Need to check that context is one in which character references are
allowed. xmltok prolog parsing will need to distinguish parameter
literals from other kinds of literal.
**** Provide a comment command to bind to M-; that works better than the
normal one.
**** Make indenting in a multi-line comment work.
**** Structure view. Separate buffer displaying element tree.
Be able to navigate from structure view to document and vice-versa.
**** Flash matching >.
**** Smart selection command that selects increasingly large syntactically
coherent chunks of XML. If point is in an attribute value, first
select complete value; then if command is repeated, select value plus
delimiters, then select attribute name as well, then complete
start-tag, then complete element, then enclosing element, etc.
**** ispell integration.
**** Block-level items in mixed content should be indented, e.g:
<para>This is list:
<ul>
<li>item</li>
**** Provide option to indent like this:
<para>This is a paragraph
occupying multiple lines.</para>
**** Option to add make a / that closes a start-tag electrically insert a
space for the XHTML guys.
**** C-M-q should work.
*** Datatypes
**** Figure out workaround for CJK characters with regexps.
**** Does category C contain Cn?
**** Do ENTITY datatype properly.
*** XML Parsing Library
**** Parameter entity parsing option, nil (never), t (always),
unless-standalone (unless standalone="yes" in XML declaration).
**** When a file is currently being edited, there should be an option to
use its buffer instead of the on-disk copy.
*** Handling all XML features
**** Provide better support for editing external general parsed entities.
Perhaps provide a way to force ignoring undefined entities; maybe turn
this on automatically with <?xml encoding=""?> (with no version
pseudo-att).
**** Handle internal general entity declarations containing elements.
**** Handle external general entity declarations.
**** Handle default attribute declarations in internal subset.
**** Handle parameter entities (including DTD).
*** RELAX NG
**** Do complete schema checking, at least optionally.
**** Detect include/external loops during schema parse.
**** Coding system detection for schemas. Should use utf-8/utf-16 per the
spec. But also need to allow encodings other than UTF-8/16 to support
CJK charsets that Emacs cannot represent in Unicode.
*** Catching XML errors
**** Check public identifiers.
**** Check default attribute values.
*** Performance
**** Explore whether overlay-recenter can cure overlays performance problems.
**** Cache schemas. Need to have list of files and mtimes.
**** Make it possible to reduce rng-validate-chunk-size significantly,
perhaps to 500 bytes, without bad performance impact: don't do
redisplay on every chunk; pass continue functions on other uses of
rng-do-some-validation.
**** Cache after first tag.
**** Introduce a new name class that is a choice between names (so that
we can use member)
**** intern-choice should simplify after patterns with same 1st/2nd args
**** Large numbers of overlays slow things down dramatically. Represent
errors using text properties. This implies we cannot incrementally
keep track of the number of errors, in order to determine validity.
Instead, when validation completes, scan for any characters with an
error text property; this seems to be fast enough even with large
buffers. Problem with error at end of buffer, where there's no
character; need special variable for this. Need to merge face from
font-lock with the error face: use :inherit attribute with list of two
faces. How do we avoid making rng-valid depend on nxml-mode?
*** Error recovery
**** Don't stop at newline in looking for close of start-tag.
**** Use indentation to guide recovery from mismatched end-tags
**** Don't keep parsing when currently not well-formed but previously
well-formed
**** Try to recover from a bad start-tag by popping an open element if
there was a mismatched end-tag unaccounted for.
**** Try to recover from a bad start-tag open on the hypothesis that there
was an error in the namespace URI.
**** Better recovery from ill-formed XML declarations.
*** Useability improvements
**** Should print a "Parsing..." message during long movements.
**** Provide better position for reference to undefined pattern error.
**** Put Well-formed in the mode-line when validating against any-content.
**** Trim marking of illegal data for leading and trailing whitespace.
**** Show Invalid status as soon as we are sure it's invalid, rather than
waiting for everything to be completely up to date.
**** When narrowed, Valid or Invalid status should probably consider only
validity of narrowed region.
*** Bug fixes
**** Need to give an error for a document like: <foo/><![CDATA[ ]]>
**** Make nxml-forward-balanced-item work better for the prolog.
**** Make filling and indenting comments work in the prolog.
**** Should delete RNC Input buffers.
**** Figure out what regex use for NCName and use it consistently,
**** Should have not-well-formed tokens in ref.
**** Require version in XML declaration? Probably not because prevents
use for external parsed entities. At least forbid standalone without version.
**** Reject schema that compiles to rng-not-allowed-ipattern.
**** Move point backwards on schema parse error so that it's on the right token.
*** Internal
**** Use rng-quote-string consistently.
**** Use parsing library for XML to texinfo conversion.
**** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of
xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to
nxml-t-token-start.
**** Can we set fill-prefix to nil and rely on indenting?
**** xmltok should make available replacement text of entities containing
elements
**** In rng-valid, instead of using modification-hooks and
insert-behind-hooks on dependent overlays, use same technique as nxml-mode.
**** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on
Mule-UCS); overlays/text properties vs extents; absence of
fontification-functions hook.
*** Fontification
**** Allow face to depend on element qname, attribute qname, attribute
value. Use list with pairs of (R . F), where R specifies regexps and
F specifies faces. How can this list be made to depend on the document type?
*** Other
**** Support RELAX NG XML syntax (use XML parsing library).
**** Support W3C XML Schema (use XML parsing library).
**** Command to infer schema from current document (like trang).
*** Schemas
**** XSLT schema should take advantage of RELAX NG to express cooccurrence
constraints on attributes (e.g. xsl:template).
*** Documentation
**** Move material from README to manual.
**** Document encodings.
*** Notes
**** How can we allow an error to be displayed on a different token from
where it is detected? In particular, for a missing closing ">" we
will need to display it at the beginning of the following token. At the
moment, when we parse the following token the error overlay will get cleared.
**** How should rng-goto-next-error deal with narrowing?
**** Perhaps should merge errors having same start position even if they
have different ends.
**** How to handle surrogates? One possibility is to be compatible with
utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible
with this.
**** Should we distinguish well-formedness errors from invalidity errors?
(I think not: we may want to recover from a bad start-tag by implying
an end-tag.)
**** Seems to be a bug with Emacs, where a mouse movement that causes
help-echo text to appear counts as pending input but does not cause
idle timer to be restarted.
**** Use XML to represent this file.
**** I had a TODO which said simply "split-string". What did I mean?
**** Investigate performance on large files all on one line.
*** Issues for Emacs versions >= 22
**** Take advantage of UTF-8 CJK support.
**** Supply a next-error-function.
**** Investigate this NEWS item "Emacs now tries to set up buffer coding
systems for HTML/XML files automatically."
**** Take advantage of the pointer text property.
**** Leverage char-displayable-p.
* Internal changes
** Cleanup all the GC_ mark bit stuff -- there is no longer any distinction

71
etc/emacs.bash
View file

@ -1,71 +0,0 @@
### emacs.bash --- contact/resume an existing Emacs, or start a new one
## Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
## Free Software Foundation, Inc.
## Author: Noah Friedman
## 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
### Commentary:
## This file is obsolete. Use emacsclient -a instead.
## This defines a bash command named `edit' which contacts/resumes an
## existing emacs or starts a new one if none exists.
## One way or another, any arguments are passed to emacs to specify files
## (provided you have loaded `resume.el').
## This function assumes the emacs program is named `emacs' and is somewhere
## in your load path. If either of these is not true, the most portable
## (and convenient) thing to do is to make an alias called emacs which
## refers to the real program, e.g.
##
## alias emacs=/usr/local/bin/gemacs
function edit ()
{
local windowsys="${WINDOW_PARENT+sun}"
windowsys="${windowsys:-${DISPLAY+x}}"
if [ -n "${windowsys:+set}" ]; then
# Do not just test if these files are sockets. On some systems
# ordinary files or fifos are used instead. Just see if they exist.
if [ -e "${HOME}/.emacs_server" -o -e "/tmp/emacs${UID}/server" ]; then
emacsclient "$@"
return $?
else
echo "edit: starting emacs in background..." 1>&2
fi
case "${windowsys}" in
x ) (emacs "$@" &) ;;
sun ) echo "unsupported window system"; return 1 ;;
esac
else
if jobs %emacs 2> /dev/null ; then
echo "$(pwd)" "$@" >| ${HOME}/.emacs_args && fg %emacs
else
emacs "$@"
fi
fi
}
# arch-tag: 1e1b74b9-bf2c-4b23-870f-9eebff7515cb
### emacs.bash ends here

31
etc/emacs.csh
View file

@ -1,31 +0,0 @@
### emacs.csh
## Add legal notice if non-trivial amounts of code are added.
## Author: Michael DeCorte
### Commentary:
## This file is obsolete. Use emacsclient -a instead.
## This defines a csh command named `edit' which resumes an
## existing Emacs or starts a new one if none exists.
## One way or another, any arguments are passed to Emacs to specify files
## (provided you have loaded `resume.el').
## These are the possible values of $whichjob
## 1 = new ordinary emacs (the -nw is so that it doesn't try to do X)
## 2 = resume emacs
## 3 = new emacs under X (-i is so that you get a reasonable icon)
## 4 = resume emacs under X
set EMACS_PATTERN="^\[[0-9]\] . Stopped ............ $EMACS"
alias edit 'set emacs_command=("emacs -nw \!*" "fg %emacs" "emacs -i \!* &"\
"emacsclient \!* &") ; \
jobs >! $HOME/.jobs; grep "$EMACS_PATTERN" < $HOME/.jobs >& /dev/null; \
@ isjob = ! $status; \
@ whichjob = 1 + $isjob + $?DISPLAY * 2 + $?WINDOW_PARENT * 4; \
test -S ~/.emacs_server && emacsclient \!* \
|| echo `pwd` \!* >! ~/.emacs_args && eval $emacs_command[$whichjob]'
# arch-tag: 433d58df-15b9-446f-ad37-f0393e3a23d4

172
etc/ms-kermit
View file

@ -1,172 +0,0 @@
;;; The code here is forced by the interface, and is not subject to
;;; copyright, constituting the only possible expression of the algorithm
;;; in this format.
;;; This file is designed for an 8-bit connection.
;;; Use the file ms-7bkermit if you have a 7-bit connection.
;; Meta key mappings for EMACS
;; By Robert Earl (rearl@watnxt3.ucr.edu)
;; May 13, 1990
;;
;; WARNING:
;; requires an 8-bit path to host. many dialups and lans won't pass the
;; eighth bit by default and may require a special command to turn this
;; off. `screen' is known to mask the eighth bit of input as well.
set term controls 8-bit
set translation key off
;; control keys
set key \3449 \128 ;; m-c-@
set key \3358 \129 ;; m-c-a
set key \3376 \130 ;; m-c-b
set key \3374 \131 ;; m-c-c
set key \3360 \132 ;; m-c-d
set key \3346 \133 ;; m-c-e
set key \3361 \134 ;; m-c-f
set key \3362 \135 ;; m-c-g
set key \3342 \136 ;; m-bs
set key \3363 \136 ;; m-c-h (sends same code as above)
set key \2469 \137 ;; m-tab
set key \3351 \137 ;; m-c-i (same as above)
set key \3364 \138 ;; m-c-j
set key \3365 \139 ;; m-c-k
set key \3366 \140 ;; m-c-l
;set key \3378 \141 ;; m-c-m
set key \2332 \141 ;; m-ret (sends same code as above)
set key \3377 \142 ;; m-c-n
set key \3352 \143 ;; m-c-o
set key \3353 \144 ;; m-c-p
set key \3344 \145 ;; m-c-q
set key \3347 \146 ;; m-c-r
set key \3359 \147 ;; m-c-s
set key \3348 \148 ;; m-c-t
set key \3350 \149 ;; m-c-u
set key \3375 \150 ;; m-c-v
set key \3345 \151 ;; m-c-w
set key \3373 \152 ;; m-c-x
set key \3349 \153 ;; m-c-y
set key \3372 \154 ;; m-c-z
;; misc keys
;set key \3354 \155 ;; m-c-[
set key \2305 \155 ;; m-esc (sends same as above)
set key \3371 \156 ;; m-c-\
set key \3355 \157 ;; m-c-]
set key \3453 \158 ;; m-c-^
set key \3458 \159 ;; m-c-_
;; \160 is conspicuously missing here--
;; alt-spc doesn't generate a distinct scan code...
;; neither do shift-spc and ctrl-spc.
;; no idea why.
set key \2936 \161 ;; m-!
set key \2856 \162 ;; m-"
set key \2938 \163 ;; m-#
set key \2939 \164 ;; m-$
set key \2940 \165 ;; m-%
set key \2942 \166 ;; m-&
set key \2344 \167 ;; m-'
set key \2944 \168 ;; m-(
set key \2945 \169 ;; m-)
set key \2943 \170 ;; m-*
set key \2947 \171 ;; m-+
set key \2355 \172 ;; m-,
set key \2434 \173 ;; m--
set key \2356 \174 ;; m-.
set key \2357 \175 ;; m-/
;; number keys
set key \2433 \176 ;; m-0
set key \2424 \177 ;; m-1
set key \2425 \178
set key \2426 \179
set key \2427 \180
set key \2428 \181
set key \2429 \182
set key \2430 \183
set key \2431 \184
set key \2432 \185 ;; m-9
set key \2855 \186 ;; m-:
set key \2343 \187 ;; m-;
set key \2867 \188 ;; m-<
set key \2435 \189 ;; m-=
set key \2868 \190 ;; m->
set key \2869 \191 ;; m-?
set key \2937 \192 ;; m-@
;; shifted A-Z
set key \2846 \193 ;; m-A
set key \2864 \194
set key \2862 \195
set key \2848 \196
set key \2834 \197
set key \2849 \198
set key \2850 \199
set key \2851 \200
set key \2839 \201
set key \2852 \202
set key \2853 \203
set key \2854 \204
set key \2866 \205
set key \2865 \206
set key \2840 \207
set key \2841 \208
set key \2832 \209
set key \2835 \210
set key \2847 \211
set key \2836 \212
set key \2838 \213
set key \2863 \214
set key \2833 \215
set key \2861 \216
set key \2837 \217
set key \2860 \218 ;; m-Z
set key \2330 \219 ;; m-[
set key \2347 \220 ;; m-\
set key \2331 \221 ;; m-]
set key \2941 \222 ;; m-^
set key \2946 \223 ;; m-_
set key \2345 \224 ;; m-`
;; lowercase a-z
set key \2334 \225 ;; m-a
set key \2352 \226
set key \2350 \227
set key \2336 \228
set key \2322 \229
set key \2337 \230
set key \2338 \231
set key \2339 \232
set key \2327 \233
set key \2340 \234
set key \2341 \235
set key \2342 \236
set key \2354 \237
set key \2353 \238
set key \2328 \239
set key \2329 \240
set key \2320 \241
set key \2323 \242
set key \2335 \243
set key \2324 \244
set key \2326 \245
set key \2351 \246
set key \2321 \247
set key \2349 \248
set key \2325 \249
set key \2348 \250 ;; m-z
;; more shifted misc. keys
set key \2842 \251 ;; m-{
set key \2859 \252 ;; m-|
set key \2843 \253 ;; m-}
set key \2857 \254 ;; m-~
set key \2318 \255 ;; m-del
;;; arch-tag: 93cefb0a-2b07-4d09-ae78-4d807b15645d

668
lisp/ChangeLog
View file

@ -1,3 +1,663 @@
2010-09-15 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-compat.el (tramp-compat-with-temp-message)
(tramp-compat-font-lock-add-keywords, tramp-compat-process-get)
(tramp-compat-process-put): New defuns.
* net/tramp.el (top):
* net/tramp-gvfs.el (top):
* net/tramp-cache.el (top): Use `tramp-compat-font-lock-add-keywords'.
* net/tramp.el (tramp-progress-reporter-update): Use
`tramp-compat-funcall.
* net/tramp.el (tramp-process-actions):
* net/tramp-gvfs.el (tramp-handle-vc-registered):
* net/tramp-sh.el (tramp-gvfs-handler-askquestion)
(tramp-get-remote-stat, tramp-get-remote-readlink): Use
`tramp-compat-with-temp-message'.
* net/tramp-sh.el (top): Require 'cl.
(tramp-handle-start-file-process): Use `tramp-compat-process-get'.
(tramp-open-connection-setup-interactive-shell): Use
`tramp-compat-process-put'.
2010-09-15 Alan Mackenzie <acm@muc.de>
* progmodes/cc-engine.el (c-forward-<>-arglist-recur): Correct the
indentation.
(c-forward-<>-arglist-recur): Fix an infinite recursion.
2010-09-15 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (byte-compile-warning-types): New type
`lexical' for warnings related to lexical scoping.
(byte-compile-file-form-defvar, byte-compile-defvar): Warn about
global vars which don't have a prefix and could hence affect lexical
scoping in unrelated files.
2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/imap.el: Revert back to version
cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes
seem problematic.
2010-09-14 Juanma Barranquero <lekktu@gmail.com>
* obsolete/old-whitespace.el (whitespace-unload-function):
Explicitly pass `obarray' to `unintern' to avoid a warning.
2010-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/byte-run.el (set-advertised-calling-convention):
Add `when' argument. Update callers.
* subr.el (unintern): Declare the obarray arg mandatory.
2010-09-14 Glenn Morris <rgm@gnu.org>
* calendar/diary-lib.el (diary-list-entries-hook, diary-sort-entries):
Doc fixes.
* calendar/diary-lib.el (diary-included-files): New variable.
(diary-list-entries): Maybe initialize diary-included-files.
(diary-include-other-diary-files): Append to diary-included-files.
* calendar/appt.el (appt-update-list): Also check the members of
diary-included-files. (Bug#6999)
(appt-check): Doc fix.
2010-09-14 David Reitter <david.reitter@gmail.com>
* simple.el (line-move-visual): Do not truncate goal column to
integer size. (Bug#7020)
2010-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
* repeat.el (repeat): Allow repeating when the last event is a click.
Suggested by Drew Adams (bug#6256).
2010-09-14 Sascha Wilde <wilde@sha-bang.de>
* vc/vc-hg.el (vc-hg-state,vc-hg-working-revision):
Replace setting HGRCPATH to "" by some less invasive --config options.
2010-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
* font-lock.el (font-lock-beginning-of-syntax-function):
Mark as obsolete.
2010-09-14 Glenn Morris <rgm@gnu.org>
* menu-bar.el (menu-bar-options-save): Fix handling of menu-bar
and tool-bar modes. (Bug#6211)
(menu-bar-mode): Move setting of standard-value after the
minor-mode definition, otherwise it seems to have no effect.
2010-09-14 Masatake YAMATO <yamato@redhat.com>
* progmodes/antlr-mode.el (antlr-font-lock-additional-keywords):
Fix typo. (Bug#6976)
2010-09-14 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* whitespace.el: Allow cleaning up blanks without blank
visualization (Bug#6651). Adjust help window for
whitespace-toggle-options (Bug#6479). Allow to use fill-column
instead of whitespace-line-column (from EmacsWiki). New version 13.1.
(whitespace-style): Add new value 'face. Adjust docstring.
(whitespace-space, whitespace-hspace, whitespace-tab):
Adjust foreground property face.
(whitespace-line-column): Adjust docstring and type declaration.
(whitespace-style-value-list, whitespace-toggle-option-alist)
(whitespace-help-text): Adjust const initialization.
(whitespace-toggle-options, global-whitespace-toggle-options):
Adjust docstring.
(whitespace-display-window, whitespace-interactive-char)
(whitespace-style-face-p, whitespace-color-on): Adjust code.
(whitespace-help-scroll): New fun.
2010-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
* calendar/time-date.el (format-seconds): Comment fix.
2010-09-13 Michael R. Mauger <mmaug@yahoo.com>
* progmodes/sql.el: Version 2.7.
(sql-buffer-live-p): Improve detection.
(sql-find-sqli-buffer, sql-set-sqli-buffer-generally)
(sql-set-sqli-buffer): Use it.
(sql-product-interactive): Run `sql-set-sqli-hook'.
(sql-rename-buffer): Code cleanup.
(sql-redirect, sql-redirect-value): New functions. More to come.
2010-09-13 Juanma Barranquero <lekktu@gmail.com>
Port tramp-related Makefile changes of 2010-09-08T14:42:54Z!michael.albinus@gmx.de, 2010-09-13T15:17:01Z!michael.albinus@gmx.de to Windows.
* makefile.w32-in (LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el.
(TRAMP_SRC): New macro.
($(lisp)/net/tramp-loaddefs.el): New target.
2010-09-13 Michael Albinus <michael.albinus@gmx.de>
Major code cleanup. Split tramp.el into tramp.el and tramp-sh.el.
* Makefile.in (TRAMP_SRC): Remove tramp-fish.el. Add tramp-sh.el.
* net/tramp.el (top): Don't show loading message. Require just
'tramp-compat, everything else is required there.
Use `ignore-errors' where appropriate.
(tramp-inline-compress-start-size, tramp-copy-size-limit)
(tramp-terminal-type, tramp-end-of-output)
(tramp-initial-end-of-output, tramp-completion-function-alist-rsh)
(tramp-completion-function-alist-ssh)
(tramp-completion-function-alist-telnet)
(tramp-completion-function-alist-su)
(tramp-completion-function-alist-putty, tramp-remote-path)
(tramp-remote-process-environment, tramp-sh-extra-args)
(tramp-actions-before-shell, tramp-uudecode)
(tramp-perl-file-truename, tramp-perl-file-name-all-completions)
(tramp-perl-file-attributes)
(tramp-perl-directory-files-and-attributes)
(tramp-perl-encode-with-module, tramp-perl-decode-with-module)
(tramp-perl-encode, tramp-perl-decode)
(tramp-vc-registered-read-file-names, tramp-file-mode-type-map)
(tramp-file-name-handler-alist, tramp-make-tramp-temp-file)
(tramp-handle-make-symbolic-link, tramp-handle-load)
(tramp-handle-file-name-as-directory)
(tramp-handle-file-name-directory)
(tramp-handle-file-name-nondirectory, tramp-handle-file-truename)
(tramp-handle-file-exists-p, tramp-handle-file-attributes)
(tramp-do-file-attributes-with-ls)
(tramp-do-file-attributes-with-perl)
(tramp-do-file-attributes-with-stat)
(tramp-handle-set-visited-file-modtime)
(tramp-handle-verify-visited-file-modtime)
(tramp-handle-set-file-modes, tramp-handle-set-file-times)
(tramp-set-file-uid-gid, tramp-remote-selinux-p)
(tramp-handle-file-selinux-context)
(tramp-handle-set-file-selinux-context)
(tramp-handle-file-executable-p, tramp-handle-file-readable-p)
(tramp-handle-file-newer-than-file-p, tramp-handle-file-modes)
(tramp-handle-file-directory-p, tramp-handle-file-regular-p)
(tramp-handle-file-symlink-p, tramp-handle-file-writable-p)
(tramp-handle-file-ownership-preserved-p)
(tramp-handle-directory-file-name, tramp-handle-directory-files)
(tramp-handle-directory-files-and-attributes)
(tramp-do-directory-files-and-attributes-with-perl)
(tramp-do-directory-files-and-attributes-with-stat)
(tramp-handle-file-name-all-completions)
(tramp-handle-file-name-completion, tramp-handle-add-name-to-file)
(tramp-handle-copy-file, tramp-handle-copy-directory)
(tramp-handle-rename-file, tramp-do-copy-or-rename-file)
(tramp-do-copy-or-rename-file-via-buffer)
(tramp-do-copy-or-rename-file-directly)
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-handle-make-directory, tramp-handle-delete-directory)
(tramp-handle-delete-file)
(tramp-handle-dired-recursive-delete-directory)
(tramp-handle-dired-compress-file, tramp-handle-dired-uncache)
(tramp-handle-insert-directory)
(tramp-handle-unhandled-file-name-directory)
(tramp-handle-expand-file-name)
(tramp-handle-substitute-in-file-name)
(tramp-handle-executable-find, tramp-process-sentinel)
(tramp-handle-start-file-process, tramp-handle-process-file)
(tramp-handle-call-process-region, tramp-handle-shell-command)
(tramp-handle-file-local-copy, tramp-handle-file-remote-p)
(tramp-handle-insert-file-contents)
(tramp-handle-insert-file-contents-literally)
(tramp-handle-find-backup-file-name)
(tramp-handle-make-auto-save-file-name, tramp-handle-write-region)
(tramp-vc-registered-file-names, tramp-handle-vc-registered)
(tramp-sh-file-name-handler, tramp-vc-file-name-handler)
(tramp-maybe-send-script, tramp-set-auto-save, tramp-run-test)
(tramp-run-test2, tramp-find-executable, tramp-set-remote-path)
(tramp-find-file-exists-command, tramp-open-shell)
(tramp-find-shell, tramp-barf-if-no-shell-prompt)
(tramp-open-connection-setup-interactive-shell)
(tramp-local-coding-commands, tramp-remote-coding-commands)
(tramp-find-inline-encoding, tramp-call-local-coding-command)
(tramp-inline-compress-commands, tramp-find-inline-compress)
(tramp-compute-multi-hops, tramp-maybe-open-connection)
(tramp-send-command , tramp-wait-for-output)
(tramp-send-command-and-check, tramp-barf-unless-okay)
(tramp-send-command-and-read, tramp-mode-string-to-int)
(tramp-convert-file-attributes, tramp-check-cached-permissions)
(tramp-file-mode-from-int, tramp-file-mode-permissions)
(tramp-shell-case-fold, tramp-make-copy-program-file-name)
(tramp-method-out-of-band-p, tramp-local-host-p)
(tramp-get-remote-path, tramp-get-remote-tmpdir)
(tramp-get-ls-command, tramp-get-ls-command-with-dired)
(tramp-get-test-command, tramp-get-test-nt-command)
(tramp-get-file-exists-command, tramp-get-remote-ln)
(tramp-get-remote-perl, tramp-get-remote-stat)
(tramp-get-remote-readlink, tramp-get-remote-trash)
(tramp-get-remote-id, tramp-get-remote-uid, tramp-get-remote-gid)
(tramp-get-local-uid, tramp-get-local-gid)
(tramp-get-inline-compress, tramp-get-inline-coding): Move to
tramp-sh.el.
(tramp-methods, tramp-default-method-alist)
(tramp-default-user-alist, tramp-foreign-file-name-handler-alist):
Move initialization to tramp-sh.el.
(tramp-temp-name-prefix): Make it a defconst.
(tramp-dissect-file-name): Don't check anymore for multi-hop
methods.
(tramp-debug-outline-regexp): Add a docstring.
(tramp-debug-outline-level): Renamed from `tramp-outline-level'.
(tramp-get-debug-buffer): Use it.
* net/tramp-cache.el (top): Set tramp-autoload cookie for
initialization forms.
(tramp-set-connection-property): Don't protect `tramp-message'
call, it isn't necessary any longer.
(tramp-dump-connection-properties): Use `ignore-errors'.
* net/tramp-compat.el (top): Require 'advice, 'format-spec,
'password-cache and 'auth-source.
* net/tramp-gvfs.el (top):
* net/tramp-smb.el (top): Require 'tramp-sh.
* net/tramp-gw.el (tramp-gw-open-network-stream): Use `ignore-errors'.
* net/tramp-sh.el: New file, derived from tramp.el.
(top): Initialize `tramp-methods', `tramp-default-method-alist',
`tramp-default-user-alist', `tramp-foreign-file-name-handler-alist'.
Remove "scp1_old", "scp2_old", "ssh1_old", "ssh2_old". Use
`ignore-errors' where appropriate.
(tramp-sh-file-name-handler-alist): Renamed from
`tramp-file-name-handler-alist'.
(tramp-send-command-and-check): Return t or nil. Remove all
`zerop' checks, where called.
(tramp-handle-set-file-modes)
(tramp-do-copy-or-rename-file-directly)
(tramp-handle-delete-directory, tramp-handle-delete-file)
(tramp-maybe-send-script, ): Use `tramp-barf-unless-okay'.
(tramp-sh-file-name-handler, tramp-send-command-and-check)
(tramp-get-remote-ln): Set tramp-autoload cookie.
* net/tramp-fish.el: Remove file.
2010-09-13 Daiki Ueno <ueno@unixuser.org>
* epa-file.el (epa-file-insert-file-contents): If visiting, bind
buffer-file-name to avoid file-locking. (Bug#7026)
2010-09-13 Julien Danjou <julien@danjou.info>
* notifications.el (notifications-notify): Add support for
image-path and sound-name.
(notifications-specification-version): Add this variable.
2010-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (y-or-n-p): New function, moved from src/fns.c. Use read-key.
2010-09-12 Leo <sdl.web@gmail.com>
* net/rcirc.el (rcirc-server-commands, rcirc-client-commands)
(rcirc-completion-start): New variables.
(rcirc-nick-completions): Rename to rcirc-completions.
(rcirc-nick-completion-start-offset): Delete.
(rcirc-completion-at-point): New function for constructing
completion data for both nicks and irc commands. Add to
completion-at-point-functions in rcirc mode.
(rcirc-complete): Rename from rcirc-nick-complete; use
rcirc-completion-at-point.
(defun-rcirc-command): Update rcirc-client-commands.
2010-09-11 Glenn Morris <rgm@gnu.org>
* emacs-lisp/bytecomp.el (byte-compile-file): Create .elc files
atomically, to avoid parallel build errors. (Bug#4196)
2010-09-11 Michael R. Mauger <mmaug@yahoo.com>
* progmodes/sql.el: Version 2.6
(sql-dialect): Synonym for "sql-product".
(sql-find-sqli-buffer, sql-set-sqli-buffer-generally)
(sql-set-sqli-buffer, sql-show-sqli-buffer, sql-interactive-mode):
Set "sql-buffer" to buffer name not buffer object so multiple sql
interactive buffers work properly. Reverts misguided changes in
earlier work.
(sql-comint): Make sure different buffer name is used if "*SQL*"
buffer is for a different product.
(sql-make-alternate-buffer-name): Fix bug with "sql-database"
login param.
(sql-oracle, sql-sybase, sql-informix, sql-sqlite, sql-mysql)
(sql-solid, sql-ingres, sql-ms, sql-postgres, sql-interbase)
(sql-db2, sql-linter, sql-product-interactive, sql-rename-buffer):
Accept new buffer name or prompt for one.
(sql-port): Default to zero.
(sql-comint-mysql): Handle "sql-port" as a numeric.
(sql-port-history): Delete unused variable.
(sql-get-login): Default "sql-port" to a number.
(sql-product-alist): Correct Postgres prompt and terminator
regexp.
(sql-sqlite-program): Dynamically detect presence of "sqlite" or
"sqlite3" executables.
(sql-sqlite-login-params): Add "*.sqlite[23]?" database name
pattern.
(sql-buffer-live-p): New function.
(sql-mode-menu, sql-send-string): Use it.
(sql-mode-oracle-font-lock-keywords): Improve SQL*Plus REMARK
syntax pattern.
(sql-mode-postgres-font-lock-keywords): Support Postgres V9.
(sql-mode-sqlite-font-lock-keywords): Hilight sqlite commands.
2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/netrc.el (netrc-credentials): New conveniency function.
2010-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/texinfo.el (texinfo-syntax-propertize-function): New fun
to replace texinfo-font-lock-syntactic-keywords.
(texinfo-mode): Use it.
* textmodes/tex-mode.el (tex-common-initialization, doctex-mode):
Use syntax-propertize-function.
* textmodes/sgml-mode.el (sgml-syntax-propertize-function): New var to
replace sgml-font-lock-syntactic-keywords.
(sgml-mode): Use it.
* textmodes/reftex.el (font-lock-syntactic-keywords): Don't declare
since we don't use it.
* textmodes/bibtex.el (bibtex-mode): Use syntax-propertize-function.
* progmodes/vhdl-mode.el (vhdl-mode): Use syntax-propertize-function
if available.
(vhdl-fontify-buffer): Adjust.
* progmodes/tcl.el (tcl-syntax-propertize-function): New var to
replace tcl-font-lock-syntactic-keywords.
(tcl-mode): Use it.
* progmodes/simula.el (simula-syntax-propertize-function): New var to
replace simula-font-lock-syntactic-keywords.
(simula-mode): Use it.
* progmodes/sh-script.el (sh-st-symbol): Remove.
(sh-font-lock-close-heredoc, sh-font-lock-open-heredoc): Add eol arg.
(sh-font-lock-flush-syntax-ppss-cache, sh-font-lock-here-doc): Remove.
(sh-font-lock-quoted-subshell): Assume we've already matched $(.
(sh-font-lock-paren): Set syntax-multiline.
(sh-font-lock-syntactic-keywords): Remove.
(sh-syntax-propertize-function): New function to replace it.
(sh-mode): Use it.
* progmodes/ruby-mode.el (ruby-here-doc-beg-re):
Define while compiling.
(ruby-here-doc-end-re, ruby-here-doc-beg-match)
(ruby-font-lock-syntactic-keywords, ruby-comment-beg-syntax)
(syntax-ppss, ruby-in-ppss-context-p, ruby-in-here-doc-p)
(ruby-here-doc-find-end, ruby-here-doc-beg-syntax)
(ruby-here-doc-end-syntax): Only define when
syntax-propertize is not available.
(ruby-syntax-propertize-function, ruby-syntax-propertize-heredoc):
New functions.
(ruby-in-ppss-context-p): Update to new syntax of heredocs.
(electric-indent-chars): Silence bytecompiler.
(ruby-mode): Use prog-mode, syntax-propertize-function, and
electric-indent-chars.
* progmodes/python.el (python-syntax-propertize-function): New var to
replace python-font-lock-syntactic-keywords.
(python-mode): Use it.
(python-quote-syntax): Simplify and adjust to new use.
* progmodes/perl-mode.el (perl-syntax-propertize-function): New fun to
replace perl-font-lock-syntactic-keywords.
(perl-syntax-propertize-special-constructs): New fun to replace
perl-font-lock-special-syntactic-constructs.
(perl-font-lock-syntactic-face-function): New fun.
(perl-mode): Use it.
* progmodes/octave-mod.el (octave-syntax-propertize-sqs): New function
to replace octave-font-lock-close-quotes.
(octave-syntax-propertize-function): New function to replace
octave-font-lock-syntactic-keywords.
(octave-mode): Use it.
* progmodes/mixal-mode.el (mixal-syntax-propertize-function): New var;
replaces mixal-font-lock-syntactic-keywords.
(mixal-mode): Use it.
* progmodes/make-mode.el (makefile-syntax-propertize-function):
New var; replaces makefile-font-lock-syntactic-keywords.
(makefile-mode): Use it.
(makefile-imake-mode): Adjust.
* progmodes/js.el (js--regexp-literal): Define while compiling.
(js-syntax-propertize-function): New var; replaces
js-font-lock-syntactic-keywords.
(js-mode): Use it.
* progmodes/gud.el (gdb-script-syntax-propertize-function): New var;
replaces gdb-script-font-lock-syntactic-keywords.
(gdb-script-mode): Use it.
* progmodes/fortran.el (fortran-mode): Use syntax-propertize-function.
(fortran--font-lock-syntactic-keywords): New var.
(fortran-line-length): Update syntax-propertize-function and
fortran--font-lock-syntactic-keywords.
* progmodes/cperl-mode.el (cperl-mode): Use syntax-propertize-function.
* progmodes/cfengine.el (cfengine-mode):
Use syntax-propertize-function.
(cfengine-font-lock-syntactic-keywords): Remove.
* progmodes/autoconf.el (autoconf-mode):
Use syntax-propertize-function.
(autoconf-font-lock-syntactic-keywords): Remove.
* progmodes/ada-mode.el (ada-set-syntax-table-properties)
(ada-after-change-function, ada-initialize-syntax-table-properties)
(ada-handle-syntax-table-properties): Only define when
syntax-propertize is not available.
(ada-mode): Use syntax-propertize-function.
* font-lock.el (font-lock-syntactic-keywords): Make obsolete.
(font-lock-fontify-syntactic-keywords-region): Move handling of
font-lock-syntactically-fontified to...
(font-lock-default-fontify-region): ...here.
Let syntax-propertize-function take precedence.
(font-lock-fontify-syntactically-region): Cal syntax-propertize.
* emacs-lisp/syntax.el (syntax-propertize-function)
(syntax-propertize-chunk-size, syntax-propertize--done)
(syntax-propertize-extend-region-functions): New vars.
(syntax-propertize-wholelines, syntax-propertize-multiline)
(syntax-propertize--shift-groups, syntax-propertize-via-font-lock)
(syntax-propertize): New functions.
(syntax-propertize-rules): New macro.
(syntax-ppss-flush-cache): Set syntax-propertize--done.
(syntax-ppss): Call syntax-propertize.
* emacs-lisp/regexp-opt.el (regexp-opt-depth): Skip named groups.
2010-09-10 Agustín Martín <agustin.martin@hispalinux.es>
* textmodes/ispell.el (ispell-init-process): Improve comments.
XEmacs compatibility changes regarding (add-hook) 'local option
and (set-process-query-on-exit-flag).
2010-09-09 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-cache.el (tramp-parse-connection-properties):
Set tramp-autoload cookie.
2010-09-09 Glenn Morris <rgm@gnu.org>
* image.el (imagemagick-types-inhibit): Add :type, :version, :group.
(imagemagick-register-types): Doc fix.
2010-09-08 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/octave-mod.el (electric-indent-chars): Silence bytecomp.
* progmodes/js.el (require): Require is already "eval-and-compile".
(js--re-search-forward): Avoid `eval'. Preserve the error data.
(js--re-search-backward): Use js--re-search-forward.
* progmodes/fortran.el (fortran-line-length): Don't recompute
syntactic keywords redundantly a second time.
* progmodes/ada-mode.el: Replace "(set '" with setq.
(ada-mode): Simplify.
(ada-create-case-exception, ada-adjust-case-interactive)
(ada-adjust-case-region, ada-format-paramlist, ada-indent-current)
(ada-search-ignore-string-comment, ada-move-to-start)
(ada-move-to-end): Use with-syntax-table.
* font-lock.el (save-buffer-state): Remove `varlist' arg.
(font-lock-unfontify-region, font-lock-default-fontify-region):
Update usage correspondingly.
(font-lock-fontify-syntactic-keywords-region):
Set parse-sexp-lookup-properties buffer-locally here.
(font-lock-fontify-syntactically-region): Remove unused `ppss' arg.
* simple.el (blink-matching-open): Don't burp if we can't find a match.
2010-09-08 Glenn Morris <rgm@gnu.org>
* emacs-lisp/bytecomp.el (byte-compile-report-ops):
Error if not compiled with -DBYTE_CODE_METER.
* emacs-lisp/bytecomp.el (byte-recompile-directory):
Ignore dir-locals-file.
2010-09-08 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/compile.el (compilation-error-regexp-alist-alist):
Not a const.
(compilation-error-regexp-alist-alist): Rule out ": " in file names
for the `gnu' messages.
(compilation-set-skip-threshold): New command.
(compilation-start): Use \' rather than $.
(compilation-forget-errors): Use clrhash.
2010-09-08 Agustín Martín <agustin.martin@hispalinux.es>
* textmodes/ispell.el (ispell-valid-dictionary-list):
Simplify logic.
2010-09-08 Michael Albinus <michael.albinus@gmx.de>
Migrate to Tramp 2.2. Rearrange load dependencies.
(Bug#1529, Bug#5448, Bug#5705)
* Makefile.in (TRAMP_DIR, TRAMP_SRC): New variables.
($(TRAMP_DIR)/tramp-loaddefs.el): New target.
(LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el.
* net/tramp.el (top): Remove all other tramp-* loads except
tramp-compat.el. Remove all changes to tramp-unload-hook for
other tramp-* packages. Rearrange defun order. Change calls of
`tramp-compat-call-process', `tramp-compat-decimal-to-octal',
`tramp-compat-octal-to-decimal' to new function names.
(tramp-terminal-type, tramp-initial-end-of-output)
(tramp-methods, tramp-foreign-file-name-handler-alist)
(tramp-tramp-file-p, tramp-completion-mode-p)
(tramp-send-command-and-check, tramp-get-remote-path)
(tramp-get-remote-tmpdir, tramp-get-remote-ln)
(tramp-shell-quote-argument): Set tramp-autoload cookie.
(with-file-property, with-connection-property): Move to
tramp-cache.el.
(tramp-local-call-process, tramp-decimal-to-octal)
(tramp-octal-to-decimal): Move to tramp-compat.el.
(tramp-handle-shell-command): Do not require 'shell.
(tramp-compute-multi-hops): No special handling for tramp-gw-*
symbols.
(tramp-unload-tramp): Do not call `tramp-unload-file-name-handlers'.
* net/tramp-cache.el (top): Require 'tramp. Add to
`tramp-unload-hook'.
(tramp-cache-data, tramp-get-file-property)
(tramp-set-file-property, tramp-flush-file-property)
(tramp-flush-directory-property, tramp-get-connection-property)
(tramp-set-connection-property, tramp-flush-connection-property)
(tramp-cache-print, tramp-list-connections): Set tramp-autoload
cookie.
(with-file-property, with-connection-property): New defuns, moved
from tramp.el.
(tramp-flush-file-function): Use `with-parsed-tramp-file-name'
macro.
* net/tramp-cmds.el (top): Add to `tramp-unload-hook'.
(tramp-version): Set tramp-autoload cookie.
* net/tramp-compat.el (top): Require 'tramp-loaddefs. Remove all
changes to tramp-unload-hook for other tramp-* packages. Add to
`tramp-unload-hook'.
(tramp-compat-decimal-to-octal, tramp-compat-octal-to-decimal)
(tramp-compat-call-process): New defuns, moved from tramp.el.
* net/tramp-fish.el (top) Require just 'tramp. Add objects to
`tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
to `tramp-unload-hook'. Change call of
`tramp-compat-decimal-to-octal' to new function name.
(tramp-fish-method): Make it a defconst.
(tramp-fish-file-name-p): Make it a defsubst.
(tramp-fish-method, tramp-fish-file-name-handler)
(tramp-fish-file-name-p): Set tramp-autoload cookie.
* net/tramp-ftp.el (top) Add objects to `tramp-methods' and
`tramp-foreign-file-name-handler-alist'. Add to
`tramp-unload-hook'.
(tramp-ftp-method): Make it a defconst.
(tramp-ftp-file-name-p): Make it a defsubst.
(tramp-ftp-method, tramp-ftp-file-name-handler)
(tramp-ftp-file-name-p): Set tramp-autoload cookie.
* net/tramp-gvfs.el (top) Add objects to `tramp-methods' and
`tramp-foreign-file-name-handler-alist'. Add to
`tramp-unload-hook'. Change checks, whether package can be
loaded.
(tramp-gvfs-file-name-p): Make it a defsubst.
(tramp-gvfs-methods, tramp-gvfs-file-name-handler)
(tramp-gvfs-file-name-p): Set tramp-autoload cookie.
(tramp-gvfs-handle-file-directory-p): New defun.
(tramp-gvfs-file-name-handler-alist): Use it.
* net/tramp-gw.el (top) Add objects to `tramp-methods' and
`tramp-foreign-file-name-handler-alist'. Add to
`tramp-unload-hook'.
(tramp-gw-tunnel-method, tramp-gw-default-tunnel-port)
(tramp-gw-socks-method, tramp-gw-default-socks-port): Make it a
defconst.
(tramp-gw-tunnel-method, tramp-gw-socks-method)
(tramp-gw-open-connection): Set tramp-autoload cookie.
* net/tramp-imap.el (top) Require just 'tramp. Add objects to
`tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
to `tramp-unload-hook'. Change checks, whether package can be
loaded.
(tramp-imap-file-name-p): Make it a defsubst.
(tramp-imap-method, tramp-imaps-method)
(tramp-imap-file-name-handler)
(tramp-imap-file-name-p): Set tramp-autoload cookie.
* net/tramp-smb.el (top) Require just 'tramp. Add objects to
`tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
to `tramp-unload-hook'. Change checks, whether package can be
loaded. Change call of `tramp-compat-decimal-to-octal' to new
function name.
(tramp-smb-tunnel-method): Make it a defconst.
(tramp-smb-file-name-p): Make it a defsubst.
(tramp-smb-method, tramp-smb-file-name-handler)
(tramp-smb-file-name-p): Set tramp-autoload cookie.
* net/tramp-uu.el (top) Add to `tramp-unload-hook'.
(tramp-uuencode-region): Set tramp-autoload cookie.
* net/trampver.el (top) Add to `tramp-unload-hook'.
(tramp-version, tramp-bug-report-address): Set tramp-autoload
cookie. Update release number.
2010-09-07 Agustín Martín <agustin.martin@hispalinux.es>
* textmodes/ispell.el (ispell-start-process): Make sure original
@ -22,7 +682,7 @@
2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/imap.el (imap-message-map): Removed optional buffer parameter,
* net/imap.el (imap-message-map): Remove optional buffer parameter,
since no callers use it.
(imap-message-get): Ditto.
(imap-message-put): Ditto.
@ -33,11 +693,11 @@
2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/imap.el (imap-fetch-safe): Removed function, and altered all
* net/imap.el (imap-fetch-safe): Remove function, and alter all
callers to use `imap-fetch' instead. According to the comments, this
should be safe, since all other IMAP clients use the 1:* syntax.
(imap-enable-exchange-bug-workaround): Removed.
(imap-debug): Removed -- doesn't seem very useful.
(imap-enable-exchange-bug-workaround): Remove.
(imap-debug): Remove -- doesn't seem very useful.
2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>

21
lisp/Makefile.in
View file

@ -56,7 +56,8 @@ ETAGS = ../lib-src/etags
LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
$(lisp)/calendar/diary-loaddefs.el \
$(lisp)/calendar/hol-loaddefs.el \
$(lisp)/mh-e/mh-loaddefs.el
$(lisp)/mh-e/mh-loaddefs.el \
$(lisp)/net/tramp-loaddefs.el
# Elisp files auto-generated.
AUTOGENEL = loaddefs.el \
@ -329,6 +330,24 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
--eval "(setq make-backup-files nil)" \
-f batch-update-autoloads $(MH_E_DIR)
# Update TRAMP internal autoloads. Maybe we could move trmp*.el into
# an own subdirectory. OTOH, it does not hurt to keep them in
# lisp/net.
TRAMP_DIR = $(lisp)/net
TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \
$(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \
$(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \
$(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-imap.el \
$(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \
$(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el
$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
$(emacs) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \
--eval "(setq generated-autoload-file \"$@\")" \
--eval "(setq make-backup-files nil)" \
-f batch-update-autoloads $(TRAMP_DIR)
CAL_DIR = $(lisp)/calendar
## Those files that may contain internal calendar autoload cookies.
## Avoids circular dependency warning for *-loaddefs.el.

4
lisp/ansi-color.el
View file

@ -244,9 +244,9 @@ A possible way to install this would be:
(when (boundp 'font-lock-syntactic-keywords)
(remove-text-properties beg end '(syntax-table nil)))
;; instead of just using (remove-text-properties beg end '(face
;; nil)), we find regions with a non-nil face test-property, skip
;; nil)), we find regions with a non-nil face text-property, skip
;; positions with the ansi-color property set, and remove the
;; remaining face test-properties.
;; remaining face text-properties.
(while (setq beg (text-property-not-all beg end 'face nil))
(setq beg (or (text-property-not-all beg end 'ansi-color t) end))
(when (get-text-property beg 'face)

15
lisp/calendar/appt.el
View file

@ -48,8 +48,9 @@
;; package is activated. Additionally, the appointments list is
;; recreated automatically at 12:01am for those who do not logout
;; every day or are programming late. It is also updated when the
;; `diary-file' is saved. Calling `appt-check' with an argument (or
;; re-enabling the package) forces a re-initialization at any time.
;; `diary-file' (or a file it includes) is saved. Calling
;; `appt-check' with an argument (or re-enabling the package) forces a
;; re-initialization at any time.
;;
;; In order to add or delete items from today's list, without
;; changing the diary file, use `appt-add' and `appt-delete'.
@ -262,7 +263,7 @@ The variable `appt-audible' controls the audible reminder."
"Check for an appointment and update any reminder display.
If optional argument FORCE is non-nil, reparse the diary file for
appointments. Otherwise the diary file is only parsed once per day,
and when saved.
or when it (or a file it includes) is saved.
Note: the time must be the first thing in the line in the diary
for a warning to be issued. The format of the time can be either
@ -346,6 +347,8 @@ displayed in a window:
(if d-buff ; diary buffer exists
(with-current-buffer d-buff
diary-selective-display))))
;; FIXME why not using diary-list-entries with
;; non-nil LIST-ONLY?
(diary)
;; If the diary buffer existed before this command,
;; restore its display state. Otherwise, kill it.
@ -643,8 +646,10 @@ hour and minute parts."
(defun appt-update-list ()
"If the current buffer is visiting the diary, update appointments.
This function is intended for use with `write-file-functions'."
(and (string-equal buffer-file-name (expand-file-name diary-file))
This function also acts on any file listed in `diary-included-files'.
It is intended for use with `write-file-functions'."
(and (member buffer-file-name (append diary-included-files
(list (expand-file-name diary-file))))
appt-timer
(let ((appt-display-diary nil))
(appt-check t)))

22
lisp/calendar/diary-lib.el
View file

@ -187,11 +187,12 @@ you will probably also want to add `diary-mark-included-diary-files' to
(setq diary-display-function 'diary-fancy-display)
(add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
(add-hook 'diary-list-entries-hook 'diary-sort-entries)
(add-hook 'diary-list-entries-hook 'diary-sort-entries t)
in your `.emacs' file to cause the fancy diary buffer to be displayed with
diary entries from various included files, each day's entries sorted into
lexicographic order."
lexicographic order. Note how the sort function is placed last,
so that it can sort the entries included from other files."
:type 'hook
:options '(diary-include-other-diary-files diary-sort-entries)
:group 'diary)
@ -699,6 +700,10 @@ of the appropriate type."
(1+ (calendar-absolute-from-gregorian gdate))))))
(goto-char (point-min)))
(defvar diary-including) ; dynamically bound in diary-include-other-diary-files
(defvar diary-included-files nil
"List of any diary files included in the last call to `diary-list-entries'.")
;; FIXME non-greg and list hooks run same number of times?
(defun diary-list-entries (date number &optional list-only)
"Create and display a buffer containing the relevant lines in `diary-file'.
@ -743,6 +748,8 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(date-string (calendar-date-string date))
(diary-buffer (find-buffer-visiting diary-file))
diary-entries-list file-glob-attrs)
(or (bound-and-true-p diary-including)
(setq diary-included-files nil))
(message "Preparing diary...")
(save-current-buffer
(if (not diary-buffer)
@ -828,11 +835,15 @@ the variable `diary-include-string'."
(let ((diary-file (match-string-no-properties 1))
(diary-list-entries-hook 'diary-include-other-diary-files)
(diary-display-function 'ignore)
(diary-including t)
diary-hook diary-list-include-blanks)
(if (file-exists-p diary-file)
(if (file-readable-p diary-file)
(unwind-protect
(setq diary-entries-list
(setq diary-included-files
(append diary-included-files
(list (expand-file-name diary-file)))
diary-entries-list
(append diary-entries-list
(diary-list-entries original-date number)))
(with-current-buffer (find-buffer-visiting diary-file)
@ -1574,7 +1585,10 @@ be used instead of a colon (:) to separate the hour and minute parts."
(string-lessp ts1 ts2)))))))
(defun diary-sort-entries ()
"Sort the list of diary entries by time of day."
"Sort the list of diary entries by time of day.
If you add this function to `diary-list-entries-hook', it should
be the last item in the hook, in case earlier items add diary
entries, or change the order."
(setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
(define-obsolete-function-alias 'sort-diary-entries 'diary-sort-entries "23.1")

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

@ -317,10 +317,10 @@ This function does not work for SECONDS greater than `most-positive-fixnum'."
(setq start (match-end 0)
spec (match-string 1 string))
(unless (string-equal spec "%")
;; `assoc-string' is not available in Emacs 21. So when compiling
;; Gnus (`time-date.el' is part of Gnus) with Emacs 21, we get a
;; warning here. But `format-seconds' is not used anywhere in Gnus so
;; it's not a real problem. --rsteib
;; `assoc-string' is not available in XEmacs or Emacs 21. So when
;; compiling Gnus (`time-date.el' is part of Gnus) with XEmacs or
;; Emacs 21, we get a warning here. But `format-seconds' is not
;; used anywhere in Gnus so it's not a real problem. --rsteib
(or (setq match (assoc-string spec units t))
(error "Bad format specifier: `%s'" spec))
(if (assoc-string spec usedunits t)

13
lisp/emacs-lisp/byte-run.el
View file

@ -108,10 +108,11 @@ The return value of this function is not used."
(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
(defun set-advertised-calling-convention (function signature)
(defun set-advertised-calling-convention (function signature when)
"Set the advertised SIGNATURE of FUNCTION.
This will allow the byte-compiler to warn the programmer when she uses
an obsolete calling convention."
an obsolete calling convention. WHEN specifies since when the calling
convention was modified."
(puthash (indirect-function function) signature
advertised-signature-table))
@ -132,7 +133,7 @@ was first made obsolete, for example a date or a release number."
obsolete-name)
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
'make-obsolete '(obsolete-name current-name when))
'make-obsolete '(obsolete-name current-name when) "23.1")
(defmacro define-obsolete-function-alias (obsolete-name current-name
&optional when docstring)
@ -153,7 +154,7 @@ See the docstrings of `defalias' and `make-obsolete' for more details."
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
'define-obsolete-function-alias
'(obsolete-name current-name when &optional docstring))
'(obsolete-name current-name when &optional docstring) "23.1")
(defun make-obsolete-variable (obsolete-name current-name &optional when)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
@ -175,7 +176,7 @@ was first made obsolete, for example a date or a release number."
obsolete-name)
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
'make-obsolete-variable '(obsolete-name current-name when))
'make-obsolete-variable '(obsolete-name current-name when) "23.1")
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
@ -210,7 +211,7 @@ CURRENT-NAME, if it does not already have them:
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
'define-obsolete-variable-alias
'(obsolete-name current-name when &optional docstring))
'(obsolete-name current-name when &optional docstring) "23.1")
;; FIXME This is only defined in this file because the variable- and
;; function- versions are too. Unlike those two, this one is not used

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

@ -1,7 +1,8 @@
;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
@ -264,7 +265,7 @@ If it is 'byte, then only byte-level optimizations will be logged."
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved
obsolete noruntime cl-functions interactive-only
make-local mapcar constants suspicious)
make-local mapcar constants suspicious lexical)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"List of warnings that the byte-compiler should issue (t for all).
@ -1548,6 +1549,9 @@ that already has a `.elc' file."
(if (and (string-match emacs-lisp-file-regexp bytecomp-source)
(file-readable-p bytecomp-source)
(not (auto-save-file-name-p bytecomp-source))
(not (string-equal dir-locals-file
(file-name-nondirectory
bytecomp-source)))
(setq bytecomp-dest
(byte-compile-dest-file bytecomp-source))
(if (file-exists-p bytecomp-dest)
@ -1694,17 +1698,25 @@ The value is non-nil if there were no errors, nil if errors."
(insert "\n") ; aaah, unix.
(if (file-writable-p target-file)
;; We must disable any code conversion here.
(let ((coding-system-for-write 'no-conversion))
(let ((coding-system-for-write 'no-conversion)
;; Write to a tempfile so that if another Emacs
;; process is trying to load target-file (eg in a
;; parallel bootstrap), it does not risk getting a
;; half-finished file. (Bug#4196)
(tempfile (make-temp-name target-file)))
(if (memq system-type '(ms-dos 'windows-nt))
(setq buffer-file-type t))
(when (file-exists-p target-file)
;; Remove the target before writing it, so that any
;; hard-links continue to point to the old file (this makes
;; it possible for installed files to share disk space with
;; the build tree, without causing problems when emacs-lisp
;; files in the build tree are recompiled).
(delete-file target-file))
(write-region (point-min) (point-max) target-file))
(write-region (point-min) (point-max) tempfile nil 1)
;; This has the intentional side effect that any
;; hard-links to target-file continue to
;; point to the old file (this makes it possible
;; for installed files to share disk space with
;; the build tree, without causing problems when
;; emacs-lisp files in the build tree are
;; recompiled). Previously this was accomplished by
;; deleting target-file before writing it.
(rename-file tempfile target-file t)
(message "Wrote %s" target-file))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
@ -2141,6 +2153,11 @@ list that represents a doc string reference.
;; Since there is no doc string, we can compile this as a normal form,
;; and not do a file-boundary.
(byte-compile-keep-pending form)
(when (and (symbolp (nth 1 form))
(not (string-match "[-*:$]" (symbol-name (nth 1 form))))
(byte-compile-warning-enabled-p 'lexical))
(byte-compile-warn "Global/dynamic var `%s' lacks a prefix"
(nth 1 form)))
(push (nth 1 form) byte-compile-bound-variables)
(if (eq (car form) 'defconst)
(push (nth 1 form) byte-compile-const-variables))
@ -3792,6 +3809,11 @@ that suppresses all warnings during execution of BODY."
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
(when (and (symbolp (nth 1 form))
(not (string-match "[-*:$]" (symbol-name (nth 1 form))))
(byte-compile-warning-enabled-p 'lexical))
(byte-compile-warn "Global/dynamic var `%s' lacks a prefix"
(nth 1 form)))
(let ((fun (nth 0 form))
(var (nth 1 form))
(value (nth 2 form))
@ -4240,6 +4262,8 @@ and corresponding effects."
(defvar byte-code-meter)
(defun byte-compile-report-ops ()
(or (boundp 'byte-metering-on)
(error "You must build Emacs with -DBYTE_CODE_METER to use this"))
(with-output-to-temp-buffer "*Meter*"
(set-buffer "*Meter*")
(let ((i 0) n op off)

2
lisp/emacs-lisp/regexp-opt.el
View file

@ -120,7 +120,7 @@ This means the number of non-shy regexp grouping constructs
(string-match regexp "")
;; Count the number of open parentheses in REGEXP.
(let ((count 0) start last)
(while (string-match "\\\\(\\(\\?:\\)?" regexp start)
(while (string-match "\\\\(\\(\\?[0-9]*:\\)?" regexp start)
(setq start (match-end 0)) ; Start of next search.
(when (and (not (match-beginning 1))
(subregexp-context-p regexp (match-beginning 0) last))

247
lisp/emacs-lisp/syntax.el
View file

@ -34,7 +34,6 @@
;; - do something about the case where the syntax-table is changed.
;; This typically happens with tex-mode and its `$' operator.
;; - move font-lock-syntactic-keywords in here. Then again, maybe not.
;; - new functions `syntax-state', ... to replace uses of parse-partial-state
;; with something higher-level (similar to syntax-ppss-context).
;; - interaction with mmm-mode.
@ -47,6 +46,249 @@
(defvar font-lock-beginning-of-syntax-function)
;;; Applying syntax-table properties where needed.
(defvar syntax-propertize-function nil
;; Rather than a -functions hook, this is a -function because it's easier
;; to do a single scan than several scans: with multiple scans, one cannot
;; assume that the text before point has been propertized, so syntax-ppss
;; gives unreliable results (and stores them in its cache to boot, so we'd
;; have to flush that cache between each function, and we couldn't use
;; syntax-ppss-flush-cache since that would not only flush the cache but also
;; reset syntax-propertize--done which should not be done in this case).
"Mode-specific function to apply the syntax-table properties.
Called with 2 arguments: START and END.")
(defvar syntax-propertize-chunk-size 500)
(defvar syntax-propertize-extend-region-functions
'(syntax-propertize-wholelines)
"Special hook run just before proceeding to propertize a region.
This is used to allow major modes to help `syntax-propertize' find safe buffer
positions as beginning and end of the propertized region. Its most common use
is to solve the problem of /identification/ of multiline elements by providing
a function that tries to find such elements and move the boundaries such that
they do not fall in the middle of one.
Each function is called with two arguments (START and END) and it should return
either a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
These functions are run in turn repeatedly until they all return nil.
Put first the functions more likely to cause a change and cheaper to compute.")
;; Mark it as a special hook which doesn't use any global setting
;; (i.e. doesn't obey the element t in the buffer-local value).
(make-variable-buffer-local 'syntax-propertize-extend-region-functions)
(defun syntax-propertize-wholelines (start end)
(goto-char start)
(cons (line-beginning-position)
(progn (goto-char end)
(if (bolp) (point) (line-beginning-position 2)))))
(defun syntax-propertize-multiline (beg end)
"Let `syntax-propertize' pay attention to the syntax-multiline property."
(when (and (> beg (point-min))
(get-text-property (1- beg) 'syntax-multiline))
(setq beg (or (previous-single-property-change beg 'syntax-multiline)
(point-min))))
;;
(when (get-text-property end 'font-lock-multiline)
(setq end (or (text-property-any end (point-max)
'syntax-multiline nil)
(point-max))))
(cons beg end))
(defvar syntax-propertize--done -1
"Position upto which syntax-table properties have been set.")
(make-variable-buffer-local 'syntax-propertize--done)
(defun syntax-propertize--shift-groups (re n)
(replace-regexp-in-string
"\\\\(\\?\\([0-9]+\\):"
(lambda (s)
(replace-match
(number-to-string (+ n (string-to-number (match-string 1 s))))
t t s 1))
re t t))
(defmacro syntax-propertize-rules (&rest rules)
"Make a function that applies RULES for use in `syntax-propertize-function'.
The function will scan the buffer, applying the rules where they match.
The buffer is scanned a single time, like \"lex\" would, rather than once
per rule.
Each rule has the form (REGEXP HIGHLIGHT1 ... HIGHLIGHTn), where REGEXP
is an expression (evaluated at time of macro-expansion) that returns a regexp,
and where HIGHLIGHTs have the form (NUMBER SYNTAX) which means to
apply the property SYNTAX to the chars matched by the subgroup NUMBER
of the regular expression, if NUMBER did match.
SYNTAX is an expression that returns a value to apply as `syntax-table'
property. Some expressions are handled specially:
- if SYNTAX is a string, then it is converted with `string-to-syntax';
- if SYNTAX has the form (prog1 EXP . EXPS) then the value returned by EXP
will be applied to the buffer before running EXPS and if EXP is a string it
is also converted with `string-to-syntax'.
The SYNTAX expression is responsible to save the `match-data' if needed
for subsequent HIGHLIGHTs.
Also SYNTAX is free to move point, in which case RULES may not be applied to
some parts of the text or may be applied several times to other parts.
Note: back-references in REGEXPs do not work."
(declare (debug (&rest (form &rest
(numberp
[&or stringp
("prog1" [&or stringp def-form] def-body)
def-form])))))
(let* ((offset 0)
(branches '())
;; We'd like to use a real DFA-based lexer, usually, but since Emacs
;; doesn't have one yet, we fallback on building one large regexp
;; and use groups to determine which branch of the regexp matched.
(re
(mapconcat
(lambda (rule)
(let ((re (eval (car rule))))
(when (and (assq 0 rule) (cdr rules))
;; If there's more than 1 rule, and the rule want to apply
;; highlight to match 0, create an extra group to be able to
;; tell when *this* match 0 has succeeded.
(incf offset)
(setq re (concat "\\(" re "\\)")))
(setq re (syntax-propertize--shift-groups re offset))
(let ((code '())
(condition
(cond
((assq 0 rule) (if (zerop offset) t
`(match-beginning ,offset)))
((null (cddr rule))
`(match-beginning ,(+ offset (car (cadr rule)))))
(t
`(or ,@(mapcar
(lambda (case)
`(match-beginning ,(+ offset (car case))))
(cdr rule))))))
(nocode t)
(offset offset))
;; If some of the subgroup rules include Elisp code, then we
;; need to set the match-data so it's consistent with what the
;; code expects. If not, then we can simply use shifted
;; offset in our own code.
(unless (zerop offset)
(dolist (case (cdr rule))
(unless (stringp (cadr case))
(setq nocode nil)))
(unless nocode
(push `(let ((md (match-data 'ints)))
;; Keep match 0 as is, but shift everything else.
(setcdr (cdr md) (nthcdr ,(* (1+ offset) 2) md))
(set-match-data md))
code)
(setq offset 0)))
;; Now construct the code for each subgroup rules.
(dolist (case (cdr rule))
(assert (null (cddr case)))
(let* ((gn (+ offset (car case)))
(action (nth 1 case))
(thiscode
(cond
((stringp action)
`((put-text-property
(match-beginning ,gn) (match-end ,gn)
'syntax-table
',(string-to-syntax action))))
((eq (car-safe action) 'ignore)
(cdr action))
((eq (car-safe action) 'prog1)
(if (stringp (nth 1 action))
`((put-text-property
(match-beginning ,gn) (match-end ,gn)
'syntax-table
',(string-to-syntax (nth 1 action)))
,@(nthcdr 2 action))
`((let ((mb (match-beginning ,gn))
(me (match-end ,gn))
(syntax ,(nth 1 action)))
(if syntax
(put-text-property
mb me 'syntax-table syntax))
,@(nthcdr 2 action)))))
(t
`((let ((mb (match-beginning ,gn))
(me (match-end ,gn))
(syntax ,action))
(if syntax
(put-text-property
mb me 'syntax-table syntax))))))))
(if (or (not (cddr rule)) (zerop gn))
(setq code (nconc (nreverse thiscode) code))
(push `(if (match-beginning ,gn)
;; Try and generate clean code with no
;; extraneous progn.
,(if (null (cdr thiscode))
(car thiscode)
`(progn ,@thiscode)))
code))))
(push (cons condition (nreverse code))
branches))
(incf offset (regexp-opt-depth re))
re))
rules
"\\|")))
`(lambda (start end)
(goto-char start)
(while (and (< (point) end)
(re-search-forward ,re end t))
(cond ,@(nreverse branches))))))
(defun syntax-propertize-via-font-lock (keywords)
"Propertize for syntax in START..END using font-lock syntax.
KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
The return value is a function suitable for `syntax-propertize-function'."
(lexical-let ((keywords keywords))
(lambda (start end)
(with-no-warnings
(let ((font-lock-syntactic-keywords keywords))
(font-lock-fontify-syntactic-keywords-region start end)
;; In case it was eval'd/compiled.
(setq keywords font-lock-syntactic-keywords))))))
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set upto POS."
(when (and syntax-propertize-function
(< syntax-propertize--done pos))
;; (message "Needs to syntax-propertize from %s to %s"
;; syntax-propertize--done pos)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(save-excursion
(with-silent-modifications
(let* ((start (max syntax-propertize--done (point-min)))
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
(funs syntax-propertize-extend-region-functions))
(while funs
(let ((new (funcall (pop funs) start end)))
(if (or (null new)
(and (>= (car new) start) (<= (cdr new) end)))
nil
(setq start (car new))
(setq end (cdr new))
;; If there's been a change, we should go through the
;; list again since this new position may
;; warrant a different answer from one of the funs we've
;; already seen.
(unless (eq funs
(cdr syntax-propertize-extend-region-functions))
(setq funs syntax-propertize-extend-region-functions)))))
;; Move the limit before calling the function, so the function
;; can use syntax-ppss.
(setq syntax-propertize--done end)
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
(funcall syntax-propertize-function start end))))))
;;; Incrementally compute and memoize parser state.
(defsubst syntax-ppss-depth (ppss)
(nth 0 ppss))
@ -92,6 +334,8 @@ point (where the PPSS is equivalent to nil).")
(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
(defun syntax-ppss-flush-cache (beg &rest ignored)
"Flush the cache of `syntax-ppss' starting at position BEG."
;; Set syntax-propertize to refontify anything past beg.
(setq syntax-propertize--done (min beg syntax-propertize--done))
;; Flush invalid cache entries.
(while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg))
(setq syntax-ppss-cache (cdr syntax-ppss-cache)))
@ -128,6 +372,7 @@ the 2nd and 6th values of the returned state cannot be relied upon.
Point is at POS when this function returns."
;; Default values.
(unless pos (setq pos (point)))
(syntax-propertize pos)
;;
(let ((old-ppss (cdr syntax-ppss-last))
(old-pos (car syntax-ppss-last))

17
lisp/epa-file.el
View file

@ -158,12 +158,17 @@ way."
(if (or beg end)
(setq string (substring string (or beg 0) end)))
(save-excursion
(save-restriction
(narrow-to-region (point) (point))
(epa-file-decode-and-insert string file visit beg end replace)
(setq length (- (point-max) (point-min))))
(if replace
(delete-region (point) (point-max)))
;; If visiting, bind off buffer-file-name so that
;; file-locking will not ask whether we should
;; really edit the buffer.
(let ((buffer-file-name
(if visit nil buffer-file-name)))
(save-restriction
(narrow-to-region (point) (point))
(epa-file-decode-and-insert string file visit beg end replace)
(setq length (- (point-max) (point-min))))
(if replace
(delete-region (point) (point-max))))
(if visit
(set-visited-file-modtime))))
(if (and local-copy

45
lisp/font-lock.el
View file

@ -544,6 +544,8 @@ and what they do:
contexts will not be affected.
This is normally set via `font-lock-defaults'.")
(make-obsolete-variable 'font-lock-syntactic-keywords
'syntax-propertize-function "24.1")
(defvar font-lock-syntax-table nil
"Non-nil means use this syntax table for fontifying.
@ -562,6 +564,8 @@ outside of any comment, string, or sexp. This variable is semi-obsolete;
we recommend setting `syntax-begin-function' instead.
This is normally set via `font-lock-defaults'.")
(make-obsolete-variable 'font-lock-beginning-of-syntax-function
'syntax-begin-function "23.3")
(defvar font-lock-mark-block-function nil
"*Non-nil means use this function to mark a block of text.
@ -612,11 +616,10 @@ Major/minor modes can set this variable if they know which option applies.")
;;
;; Borrowed from lazy-lock.el.
;; We use this to preserve or protect things when modifying text properties.
(defmacro save-buffer-state (varlist &rest body)
(defmacro save-buffer-state (&rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
(declare (indent 1) (debug let))
`(let* ,(append varlist
`((inhibit-point-motion-hooks t)))
(declare (indent 0) (debug t))
`(let ((inhibit-point-motion-hooks t))
(with-silent-modifications
,@body)))
;;
@ -1020,7 +1023,7 @@ The region it returns may start or end in the middle of a line.")
(funcall font-lock-fontify-region-function beg end loudly))
(defun font-lock-unfontify-region (beg end)
(save-buffer-state nil
(save-buffer-state
(funcall font-lock-unfontify-region-function beg end)))
(defun font-lock-default-fontify-buffer ()
@ -1113,8 +1116,6 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(defun font-lock-default-fontify-region (beg end loudly)
(save-buffer-state
((parse-sexp-lookup-properties
(or parse-sexp-lookup-properties font-lock-syntactic-keywords)))
;; Use the fontification syntax table, if any.
(with-syntax-table (or font-lock-syntax-table (syntax-table))
(save-restriction
@ -1136,8 +1137,14 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(setq beg font-lock-beg end font-lock-end))
;; Now do the fontification.
(font-lock-unfontify-region beg end)
(when font-lock-syntactic-keywords
(font-lock-fontify-syntactic-keywords-region beg end))
(when (and font-lock-syntactic-keywords
(null syntax-propertize-function))
;; Ensure the beginning of the file is properly syntactic-fontified.
(let ((start beg))
(when (< font-lock-syntactically-fontified start)
(setq start (max font-lock-syntactically-fontified (point-min)))
(setq font-lock-syntactically-fontified end))
(font-lock-fontify-syntactic-keywords-region start end)))
(unless font-lock-keywords-only
(font-lock-fontify-syntactically-region beg end loudly))
(font-lock-fontify-keywords-region beg end loudly)))))
@ -1436,11 +1443,10 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(defun font-lock-fontify-syntactic-keywords-region (start end)
"Fontify according to `font-lock-syntactic-keywords' between START and END.
START should be at the beginning of a line."
;; Ensure the beginning of the file is properly syntactic-fontified.
(when (and font-lock-syntactically-fontified
(< font-lock-syntactically-fontified start))
(setq start (max font-lock-syntactically-fontified (point-min)))
(setq font-lock-syntactically-fontified end))
(unless parse-sexp-lookup-properties
;; We wouldn't go through so much trouble if we didn't intend to use those
;; properties, would we?
(set (make-local-variable 'parse-sexp-lookup-properties) t))
;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
(when (symbolp font-lock-syntactic-keywords)
(setq font-lock-syntactic-keywords (font-lock-eval-keywords
@ -1483,19 +1489,18 @@ START should be at the beginning of a line."
(defvar font-lock-comment-end-skip nil
"If non-nil, Font Lock mode uses this instead of `comment-end'.")
(defun font-lock-fontify-syntactically-region (start end &optional loudly ppss)
(defun font-lock-fontify-syntactically-region (start end &optional loudly)
"Put proper face on each string and comment between START and END.
START should be at the beginning of a line."
(syntax-propertize end) ; Apply any needed syntax-table properties.
(let ((comment-end-regexp
(or font-lock-comment-end-skip
(regexp-quote
(replace-regexp-in-string "^ *" "" comment-end))))
state face beg)
;; Find the `start' state.
(state (syntax-ppss start))
face beg)
(if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
(goto-char start)
;;
;; Find the `start' state.
(setq state (or ppss (syntax-ppss start)))
;;
;; Find each interesting place between here and `end'.
(while

3
lisp/gnus/.dir-locals.el
View file

@ -1 +1,4 @@
((emacs-lisp-mode . ((show-trailing-whitespace . t))))
;; Local Variables:
;; no-byte-compile: t
;; End:

88
lisp/gnus/ChangeLog
View file

@ -1,3 +1,91 @@
2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-html.el (gnus-html-schedule-image-fetching)
(gnus-html-prefetch-images): Check for curl before using it.
* mm-decode.el (mm-text-html-renderer): Don't have gnus-article-html
depend on curl, which isn't essential.
* imap.el: Revert back to version
cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes
seem problematic.
2010-09-14 Juanma Barranquero <lekktu@gmail.com>
* gnus-registry.el (gnus-registry-install-shortcuts):
Explicitly pass `obarray' to `unintern' to avoid a warning.
2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-read-active-for-groups): Reverted the previous
change.
* nnrss.el (nnrss-request-list): Removed this function and related
functions, including the moreover stuff.
2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnrss.el (nnrss-retrieve-groups): New function.
2010-09-14 Juanma Barranquero <lekktu@gmail.com>
* .dir-locals.el: Add no-byte-compile cookie.
2010-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-start.el (gnus-read-active-for-groups): Run gnus-activate-group
for back end that doesn't support request-scan.
2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-read-active-file-1): If gnus-agent isn't set,
then do request scans from the backends.
* gnus-sum.el (gnus-summary-update-hook): Change default to nil, to
avoid running a hook per line, since this takes a lot of time,
profiling shows.
(gnus-summary-prepare-threads): Call `gnus-summary-highlight-line'
directly if gnus-visual-p is true.
2010-09-10 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-start.el (gnus-read-active-for-groups): Check only subscribed
groups; replace mapcar with dolist which is a bit faster; pass groups
info to gnus-read-active-file-1.
(gnus-read-active-file-1): Scan only specified groups if the new
optional arg `infos' is given.
2010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mail-source.el (mail-source-fetch-pop): Use pop3-movemail again.
* pop3.el (pop3-movemail): Removed.
(pop3-streaming-movemail): Renamed to pop3-movemail.
* gnus-html.el (gnus-html-wash-tags): Refactor out the image bit, and
don't restrict end-tag searches to the end of the line.
2010-09-09 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-start.el (gnus-get-unread-articles): Set the number of unread
articles of every unchecked group to t, which means unknown since the
server has never been opened.
2010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-html.el (gnus-html-show-alt-text): New command.
(gnus-html-browse-image): Ditto.
(gnus-html-wash-tags): Add the data to allow showing the ALT text and
to browse the image directly.
(gnus-html-wash-tags): Search for images first, so that <a><img> works
better.
* gnus-async.el (gnus-async-article-callback): Call
`gnus-html-prefetch-images' unconditionally.
* gnus-html.el (gnus-html-schedule-image-fetching): Decode entities
before feeding URLs to curl.
2010-09-07 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-html.el (gnus-html-wash-tags, gnus-html-put-image): Mark cid and

14
lisp/gnus/gnus-async.el
View file

@ -237,13 +237,13 @@ that was fetched."
(setq gnus-async-current-prefetch-article nil)
(when arg
(gnus-async-set-buffer)
(when gnus-async-post-fetch-function
(save-excursion
(save-restriction
(narrow-to-region mark (point-max))
;; Prefetch images for the groups that want that.
(when (fboundp 'gnus-html-prefetch-images)
(gnus-html-prefetch-images summary))
(save-excursion
(save-restriction
(narrow-to-region mark (point-max))
;; Prefetch images for the groups that want that.
(when (fboundp 'gnus-html-prefetch-images)
(gnus-html-prefetch-images summary))
(when gnus-async-post-fetch-function
(funcall gnus-async-post-fetch-function summary))))
(gnus-async-with-semaphore
(setq

242
lisp/gnus/gnus-html.el
View file

@ -72,6 +72,15 @@ fit these criteria."
(define-key map "i" 'gnus-html-insert-image)
map))
(defvar gnus-html-displayed-image-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'gnus-html-show-alt-text)
(define-key map "i" 'gnus-html-browse-image)
(define-key map "\r" 'gnus-html-browse-url)
(define-key map "u" 'gnus-article-copy-string)
(define-key map [tab] 'widget-forward)
map))
;;;###autoload
(defun gnus-article-html (&optional handle)
(let ((article-buffer (current-buffer)))
@ -111,15 +120,104 @@ fit these criteria."
(defvar gnus-article-mouse-face)
(defun gnus-html-wash-tags ()
(defun gnus-html-pre-wash ()
(goto-char (point-min))
(while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t)
(replace-match "" t t))
(goto-char (point-min))
(while (re-search-forward "<a name[^\n>]+>" nil t)
(replace-match "" t t)))
(defun gnus-html-wash-images ()
(let (tag parameters string start end images url)
(goto-char (point-min))
(while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t)
(replace-match "" t t))
(goto-char (point-min))
(while (re-search-forward "<a name[^\n>]+>" nil t)
(replace-match "" t t))
;; Search for all the images first.
(while (re-search-forward "<img_alt \\([^>]*\\)>" nil t)
(setq parameters (match-string 1)
start (match-beginning 0))
(delete-region start (point))
(when (search-forward "</img_alt>" (line-end-position) t)
(delete-region (match-beginning 0) (match-end 0)))
(setq end (point))
(when (string-match "src=\"\\([^\"]+\\)" parameters)
(setq url (match-string 1 parameters))
(gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
(if (string-match "^cid:\\(.*\\)" url)
;; URLs with cid: have their content stashed in other
;; parts of the MIME structure, so just insert them
;; immediately.
(let ((handle (mm-get-content-id
(setq url (match-string 1 url))))
image)
(when handle
(mm-with-part handle
(setq image (gnus-create-image (buffer-string)
nil t))))
(when image
(let ((string (buffer-substring start end)))
(delete-region start end)
(gnus-put-image image (gnus-string-or string "*") 'cid)
(gnus-add-image 'cid image))))
;; Normal, external URL.
(if (gnus-html-image-url-blocked-p
url
(if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
gnus-blocked-images)
gnus-blocked-images))
(progn
(widget-convert-button
'link start end
:action 'gnus-html-insert-image
:help-echo url
:keymap gnus-html-image-map
:button-keymap gnus-html-image-map)
(let ((overlay (gnus-make-overlay start end))
(spec (list url
(set-marker (make-marker) start)
(set-marker (make-marker) end))))
(gnus-overlay-put overlay 'local-map gnus-html-image-map)
(gnus-overlay-put overlay 'gnus-image spec)
(gnus-put-text-property
start end
'gnus-image spec)))
(let ((file (gnus-html-image-id url))
width height alt-text)
(when (string-match "height=\"?\\([0-9]+\\)" parameters)
(setq height (string-to-number (match-string 1 parameters))))
(when (string-match "width=\"?\\([0-9]+\\)" parameters)
(setq width (string-to-number (match-string 1 parameters))))
(when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
parameters)
(setq alt-text (match-string 2 parameters)))
;; Don't fetch images that are really small. They're
;; probably tracking pictures.
(when (and (or (null height)
(> height 4))
(or (null width)
(> width 4)))
(if (file-exists-p file)
;; It's already cached, so just insert it.
(let ((string (buffer-substring start end)))
;; Delete the IMG text.
(delete-region start end)
(gnus-html-put-image file (point) string url alt-text))
;; We don't have it, so schedule it for fetching
;; asynchronously.
(push (list url
(set-marker (make-marker) start)
(point-marker))
images))))))))
(when images
(gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))))
(defun gnus-html-wash-tags ()
(let (tag parameters string start end images url)
(gnus-html-pre-wash)
(gnus-html-wash-images)
(goto-char (point-min))
;; Then do the other tags.
(while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t)
(setq tag (match-string 1)
parameters (match-string 2)
@ -127,78 +225,12 @@ fit these criteria."
(when (plusp (length parameters))
(set-text-properties 0 (1- (length parameters)) nil parameters))
(delete-region start (point))
(when (search-forward (concat "</" tag ">") (line-end-position) t)
(when (search-forward (concat "</" tag ">") nil t)
(delete-region (match-beginning 0) (match-end 0)))
(setq end (point))
(cond
;; Fetch and insert a picture.
((equal tag "img_alt")
(when (string-match "src=\"\\([^\"]+\\)" parameters)
(setq url (match-string 1 parameters))
(gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
(if (string-match "^cid:\\(.*\\)" url)
;; URLs with cid: have their content stashed in other
;; parts of the MIME structure, so just insert them
;; immediately.
(let ((handle (mm-get-content-id
(setq url (match-string 1 url))))
image)
(when handle
(mm-with-part handle
(setq image (gnus-create-image (buffer-string)
nil t))))
(when image
(let ((string (buffer-substring start end)))
(delete-region start end)
(gnus-put-image image (gnus-string-or string "*") 'cid)
(gnus-add-image 'cid image))))
;; Normal, external URL.
(if (gnus-html-image-url-blocked-p
url
(if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
gnus-blocked-images)
gnus-blocked-images))
(progn
(widget-convert-button
'link start end
:action 'gnus-html-insert-image
:help-echo url
:keymap gnus-html-image-map
:button-keymap gnus-html-image-map)
(let ((overlay (gnus-make-overlay start end))
(spec (list url
(set-marker (make-marker) start)
(set-marker (make-marker) end))))
(gnus-overlay-put overlay 'local-map gnus-html-image-map)
(gnus-overlay-put overlay 'gnus-image spec)
(gnus-put-text-property
start end
'gnus-image spec)))
(let ((file (gnus-html-image-id url))
width height)
(when (string-match "height=\"?\\([0-9]+\\)" parameters)
(setq height (string-to-number (match-string 1 parameters))))
(when (string-match "width=\"?\\([0-9]+\\)" parameters)
(setq width (string-to-number (match-string 1 parameters))))
;; Don't fetch images that are really small. They're
;; probably tracking pictures.
(when (and (or (null height)
(> height 4))
(or (null width)
(> width 4)))
(if (file-exists-p file)
;; It's already cached, so just insert it.
(let ((string (buffer-substring start end)))
;; Delete the ALT text.
(delete-region start end)
(gnus-html-put-image file (point) string))
;; We don't have it, so schedule it for fetching
;; asynchronously.
(push (list url
(set-marker (make-marker) start)
(point-marker))
images))))))))
((equal tag "img_alt"))
;; Add a link.
((or (equal tag "a")
(equal tag "A"))
@ -227,8 +259,6 @@ fit these criteria."
;; off any </pre_int>s that were left over.
(while (re-search-forward "</pre_int>\\|</internal>" nil t)
(replace-match "" t t))
(when images
(gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))
(mm-url-decode-entities)))
(defun gnus-html-insert-image ()
@ -237,21 +267,40 @@ fit these criteria."
(gnus-html-schedule-image-fetching
(current-buffer) (list (get-text-property (point) 'gnus-image))))
(defun gnus-html-show-alt-text ()
"Show the ALT text of the image under point."
(interactive)
(message "%s" (get-text-property (point) 'gnus-alt-text)))
(defun gnus-html-browse-image ()
"Browse the image under point."
(interactive)
(browse-url (get-text-property (point) 'gnus-image)))
(defun gnus-html-browse-url ()
"Browse the image under point."
(interactive)
(let ((url (get-text-property (point) 'gnus-string)))
(if (not url)
(message "No URL at point")
(browse-url url))))
(defun gnus-html-schedule-image-fetching (buffer images)
(gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
buffer images)
(let* ((url (caar images))
(process (start-process
"images" nil "curl"
"-s" "--create-dirs"
"--location"
"--max-time" "60"
"-o" (gnus-html-image-id url)
url)))
(process-kill-without-query process)
(set-process-sentinel process 'gnus-html-curl-sentinel)
(gnus-set-process-plist process (list 'images images
'buffer buffer))))
(when (executable-find "curl")
(let* ((url (caar images))
(process (start-process
"images" nil "curl"
"-s" "--create-dirs"
"--location"
"--max-time" "60"
"-o" (gnus-html-image-id url)
(mm-url-decode-entities-string url))))
(process-kill-without-query process)
(set-process-sentinel process 'gnus-html-curl-sentinel)
(gnus-set-process-plist process (list 'images images
'buffer buffer)))))
(defun gnus-html-image-id (url)
(expand-file-name (sha1 url) gnus-html-cache-directory))
@ -276,7 +325,7 @@ fit these criteria."
(when images
(gnus-html-schedule-image-fetching buffer images)))))
(defun gnus-html-put-image (file point string)
(defun gnus-html-put-image (file point string &optional url alt-text)
(when (gnus-graphic-display-p)
(let* ((image (ignore-errors
(gnus-create-image file)))
@ -301,11 +350,17 @@ fit these criteria."
'gif)
(= (car size) 30)
(= (cdr size) 30))))
(progn
(let ((start (point)))
(setq image (gnus-html-rescale-image image file size))
(gnus-put-image image
(gnus-string-or string "*")
'external)
(let ((overlay (gnus-make-overlay start (point))))
(gnus-overlay-put overlay 'local-map
gnus-html-displayed-image-map)
(gnus-put-text-property start (point) 'gnus-alt-text alt-text)
(when url
(gnus-put-text-property start (point) 'gnus-image url)))
(gnus-add-image 'external image)
t)
(insert string)
@ -360,7 +415,7 @@ fit these criteria."
(delete-file (nth 2 file)))))))
(defun gnus-html-image-url-blocked-p (url blocked-images)
"Find out if URL is blocked by BLOCKED-IMAGES."
"Find out if URL is blocked by BLOCKED-IMAGES."
(let ((ret (and blocked-images
(string-match blocked-images url))))
(if ret
@ -387,7 +442,8 @@ This only works if the article in question is HTML."
;;;###autoload
(defun gnus-html-prefetch-images (summary)
(let (blocked-images urls)
(when (buffer-live-p summary)
(when (and (buffer-live-p summary)
(executable-find "curl"))
(with-current-buffer summary
(setq blocked-images gnus-blocked-images))
(save-match-data
@ -395,7 +451,7 @@ This only works if the article in question is HTML."
(let ((url (match-string 1)))
(unless (gnus-html-image-url-blocked-p url blocked-images)
(unless (file-exists-p (gnus-html-image-id url))
(push url urls)
(push (mm-url-decode-entities-string url) urls)
(push (gnus-html-image-id url) urls)
(push "-o" urls)))))
(let ((process

2
lisp/gnus/gnus-registry.el
View file

@ -783,7 +783,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(function-name (format function-format variant-name))
(shortcut (format "%c" data))
(shortcut (if remove (upcase shortcut) shortcut)))
(unintern function-name)
(unintern function-name obarray)
(eval
`(defun
;; function name

47
lisp/gnus/gnus-start.el
View file

@ -1692,7 +1692,7 @@ If SCAN, request a scan of that group as well."
(gnus-agent-article-local-times 0)
(archive-method (gnus-server-to-method "archive"))
infos info group active method cmethod
method-type method-group-list)
method-type method-group-list entry)
(gnus-message 6 "Checking new news...")
(while newsrc
@ -1737,12 +1737,18 @@ If SCAN, request a scan of that group as well."
(push (setq method-group-list (list method method-type nil))
type-cache))
;; Only add groups that need updating.
(when (<= (gnus-info-level info)
(if (eq (cadr method-group-list) 'foreign)
foreign-level
alevel))
(setcar (nthcdr 2 method-group-list)
(cons info (nth 2 method-group-list)))))
(if (<= (gnus-info-level info)
(if (eq (cadr method-group-list) 'foreign)
foreign-level
alevel))
(setcar (nthcdr 2 method-group-list)
(cons info (nth 2 method-group-list)))
;; The group is inactive, so we nix out the number of unread articles.
;; It leads `(gnus-group-unread group)' to return t. See also
;; `gnus-group-prepare-flat'.
(unless active
(when (setq entry (gnus-group-entry group))
(setcar entry t)))))
;; Sort the methods based so that the primary and secondary
;; methods come first. This is done for legacy reasons to try to
@ -1795,14 +1801,15 @@ If SCAN, request a scan of that group as well."
(cond
((gnus-check-backend-function 'retrieve-groups (car method))
(when (gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan nil method))
(gnus-read-active-file-2
(mapcar (lambda (info)
(gnus-group-real-name (gnus-info-group info)))
infos)
method))
(dolist (info infos)
(gnus-request-scan (gnus-info-group info) method)))
(let (groups)
(gnus-read-active-file-2
(dolist (info infos (nreverse groups))
(push (gnus-group-real-name (gnus-info-group info)) groups))
method)))
((gnus-check-backend-function 'request-list (car method))
(gnus-read-active-file-1 method nil))
(gnus-read-active-file-1 method nil infos))
(t
(dolist (info infos)
(gnus-activate-group (gnus-info-group info) nil nil method t))))))
@ -2031,7 +2038,7 @@ If SCAN, request a scan of that group as well."
(message "Quit reading the active file")
nil))))))))
(defun gnus-read-active-file-1 (method force)
(defun gnus-read-active-file-1 (method force &optional infos)
(let (where mesg)
(setq where (nth 1 method)
mesg (format "Reading active file%s via %s..."
@ -2041,10 +2048,14 @@ If SCAN, request a scan of that group as well."
(gnus-message 5 mesg)
(when (gnus-check-server method)
;; Request that the backend scan its incoming messages.
(when (and gnus-agent
(gnus-online method)
(when (and (or (and gnus-agent
(gnus-online method))
(not gnus-agent))
(gnus-check-backend-function 'request-scan (car method)))
(gnus-request-scan nil method))
(if infos
(dolist (info infos)
(gnus-request-scan (gnus-info-group info) method))
(gnus-request-scan nil method)))
(cond
((and (eq gnus-read-active-file 'some)
(gnus-check-backend-function 'retrieve-groups (car method))

10
lisp/gnus/gnus-sum.el
View file

@ -985,8 +985,7 @@ This hook is not called from the non-updating exit commands like `Q'."
:group 'gnus-various
:type 'hook)
(defcustom gnus-summary-update-hook
(list 'gnus-summary-highlight-line)
(defcustom gnus-summary-update-hook nil
"*A hook called when a summary line is changed.
The hook will not be called if `gnus-visual' is nil.
@ -3753,6 +3752,7 @@ buffer that was in action when the last article was fetched."
(error (gnus-message 5 "Error updating the summary line")))
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
(gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))))
@ -3785,6 +3785,7 @@ buffer that was in action when the last article was fetched."
'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
(gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
@ -5363,7 +5364,9 @@ or a straight list of headers."
'gnus-number number)
(when gnus-visual-p
(forward-line -1)
(gnus-run-hooks 'gnus-summary-update-hook)
(gnus-summary-highlight-line)
(when gnus-summary-update-hook
(gnus-run-hooks 'gnus-summary-update-hook))
(forward-line 1))
(setq gnus-tmp-prev-subject simp-subject)))
@ -10734,6 +10737,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(t gnus-no-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
(gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook))
t)

8
lisp/gnus/mail-source.el
View file

@ -34,7 +34,7 @@
(require 'cl)
(require 'imap))
(autoload 'auth-source-user-or-password "auth-source")
(autoload 'pop3-streaming-movemail "pop3")
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
(autoload 'nnheader-cancel-timer "nnheader")
(require 'mm-util)
@ -839,11 +839,9 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(if (eq authentication 'apop) 'apop 'pass))
(pop3-stream-type stream))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-streaming-movemail
mail-source-crash-box))
(save-excursion (pop3-movemail mail-source-crash-box))
(condition-case err
(save-excursion (pop3-streaming-movemail
mail-source-crash-box))
(save-excursion (pop3-movemail mail-source-crash-box))
(error
;; We nix out the password in case the error
;; was because of a wrong password being given.

4
lisp/gnus/mm-decode.el
View file

@ -105,9 +105,7 @@
,disposition ,description ,cache ,id))
(defcustom mm-text-html-renderer
(cond ((and (executable-find "w3m")
(executable-find "curl"))
'gnus-article-html)
(cond ((executable-find "w3m") 'gnus-article-html)
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
((locate-library "w3") 'w3)

58
lisp/gnus/nnrss.el
View file

@ -342,11 +342,6 @@ used to render text. If it is nil, text will simply be folded.")
;; we return the article number.
(cons nnrss-group (car e))))))
(deffoo nnrss-request-list (&optional server)
(nnrss-possibly-change-group nil server)
(nnrss-generate-active)
t)
(deffoo nnrss-open-server (server &optional defs connectionless)
(nnrss-read-server-data server)
(nnoo-change-server 'nnrss server defs)
@ -397,6 +392,18 @@ used to render text. If it is nil, text will simply be folded.")
(insert (car elem) "\t" (third elem) "\n"))))
t)
(deffoo nnrss-retrieve-groups (groups &optional server)
(nnrss-possibly-change-group nil server)
(dolist (group groups)
(nnrss-check-group group server))
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(dolist (group groups)
(let ((elem (assoc group nnrss-server-data)))
(insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
'active))
(nnoo-define-skeleton nnrss)
;;; Internal functions
@ -479,20 +486,6 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
(nnrss-read-group-data group server)
(setq nnrss-group group)))
(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
(defun nnrss-generate-active ()
(when (y-or-n-p "Fetch extra categories? ")
(mapc 'funcall nnrss-extra-categories))
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(dolist (elem nnrss-group-alist)
(insert (prin1-to-string (car elem)) " 0 1 y\n"))
(dolist (elem nnrss-server-data)
(unless (assoc (car elem) nnrss-group-alist)
(insert (prin1-to-string (car elem)) " 0 1 y\n")))))
(autoload 'timezone-parse-date "timezone")
(defun nnrss-normalize-date (date)
@ -868,33 +861,6 @@ It is useful when `(setq nnrss-use-local t)'."
(append nnheader-file-name-translation-alist '((?' . ?_)))))
(nnheader-translate-file-chars name)))
(defvar nnrss-moreover-url
"http://w.moreover.com/categories/category_list_rss.html"
"The url of moreover.com categories.")
(defun nnrss-snarf-moreover-categories ()
"Snarf RSS links from moreover.com."
(interactive)
(let (category name url changed)
(with-temp-buffer
(nnrss-insert nnrss-moreover-url)
(goto-char (point-min))
(while (re-search-forward
"<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t)
(if (match-string 1)
(setq category (match-string 1))
(setq url (match-string 2)
name (mm-url-decode-entities-string
(rfc2231-decode-encoded-string
(match-string 3))))
(if category
(setq name (concat category "." name)))
(unless (assoc name nnrss-server-data)
(setq changed t)
(push (list name 0 url) nnrss-server-data)))))
(if changed
(nnrss-save-server-data ""))))
(defun nnrss-node-text (namespace local-name element)
(let* ((node (assq (intern (concat namespace (symbol-name local-name)))
element))

41
lisp/gnus/pop3.el
View file

@ -129,7 +129,8 @@ Shorter values mean quicker response, but are more CPU intensive.")
(truncate pop3-read-timeout))
1000))))))
(defun pop3-streaming-movemail (file)
;;;###autoload
(defun pop3-movemail (file)
"Transfer contents of a maildrop to the specified FILE.
Use streaming commands."
(let* ((process (pop3-open-server pop3-mailhost pop3-port))
@ -227,44 +228,6 @@ Use streaming commands."
(pop3-pass process))
(t (error "Invalid POP3 authentication scheme")))))
(defun pop3-movemail (&optional crashbox)
"Transfer contents of a maildrop to the specified CRASHBOX."
(or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
(let* ((process (pop3-open-server pop3-mailhost pop3-port))
(crashbuf (get-buffer-create " *pop3-retr*"))
(n 1)
message-count
message-sizes)
(pop3-logon process)
(setq message-count (car (pop3-stat process)))
(when (> message-count 0)
(setq message-sizes (pop3-list process)))
(unwind-protect
(while (<= n message-count)
(message "Retrieving message %d of %d from %s... (%.1fk)"
n message-count pop3-mailhost
(/ (cdr (assoc n message-sizes))
1024.0))
(pop3-retr process n crashbuf)
(save-excursion
(set-buffer crashbuf)
(let ((coding-system-for-write 'binary))
(write-region (point-min) (point-max) crashbox t 'nomesg))
(set-buffer (process-buffer process))
(erase-buffer))
(unless pop3-leave-mail-on-server
(pop3-dele process n))
(setq n (+ 1 n))
(pop3-accept-process-output process))
(when (and pop3-leave-mail-on-server
(> n 1))
(message "pop3.el doesn't support UIDL. Setting `pop3-leave-mail-on-server'
to %s might not give the result you'd expect." pop3-leave-mail-on-server)
(sit-for 1))
(pop3-quit process))
(kill-buffer crashbuf))
t)
(defun pop3-get-message-count ()
"Return the number of messages in the maildrop."
(let* ((process (pop3-open-server pop3-mailhost pop3-port))

15
lisp/image.el
View file

@ -697,21 +697,28 @@ shall be displayed."
(defcustom imagemagick-types-inhibit
'(C HTML HTM TXT PDF)
"Types the imagemagick loader should not try to handle.")
;; FIXME what are the possible options?
;; Are these actually file-name extensions?
;; Why are these upper-case when eg image-types is lower-case?
"Types the ImageMagick loader should not try to handle."
:type '(choice (const :tag "Let ImageMagick handle all the types it can" nil)
(repeat symbol))
:version "24.1"
:group 'image)
;;;###autoload
(defun imagemagick-register-types ()
"Register file types that imagemagick is able to handle."
"Register the file types that ImageMagick is able to handle."
(let ((im-types (imagemagick-types)))
(dolist (im-inhibit imagemagick-types-inhibit)
(setq im-types (remove im-inhibit im-types)))
(dolist (im-type im-types)
(let ((extension (downcase (symbol-name im-type))))
(push
(cons (concat "\\." extension "\\'") 'image-mode)
(cons (concat "\\." extension "\\'") 'image-mode)
auto-mode-alist)
(push
(cons (concat "\\." extension "\\'") 'imagemagick)
(cons (concat "\\." extension "\\'") 'imagemagick)
image-type-file-name-regexps)))))

2
lisp/international/ucs-normalize.el
View file

@ -100,7 +100,7 @@
;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars')
;;
;; The block will be split to multiple samller blocks by starter
;; charcters. Each block is sorted, and composed if necessary.
;; characters. Each block is sorted, and composed if necessary.
;;
;; E. Composition of Entire Block (`ucs-normalize-compose-chars')
;;

4
lisp/language/hebrew.el
View file

@ -88,14 +88,14 @@ Bidirectional editing is supported.")))
;; corresponding glyph of FONT-OBJECT.
(defun hebrew-font-get-precomposed (font-object)
(let ((precomposed (font-get font-object 'hebrew-precomposed))
;; Vector of Hebrew precomposed charaters.
;; Vector of Hebrew precomposed characters.
(chars [#xFB2A #xFB2B #xFB2C #xFB2D #xFB2E #xFB2F #xFB30 #xFB31
#xFB32 #xFB33 #xFB34 #xFB35 #xFB36 #xFB38 #xFB39 #xFB3A
#xFB3B #xFB3C #xFB3E #xFB40 #xFB41 #xFB43 #xFB44 #xFB46
#xFB47 #xFB48 #xFB49 #xFB4A #xFB4B #xFB4C #xFB4D #xFB4E])
;; Vector of decomposition character sequences corresponding
;; to the above vector.
(decomposed
(decomposed
[[#x05E9 #x05C1]
[#x05E9 #x05C2]
[#x05E9 #x05BC #x05C1]

21
lisp/makefile.w32-in
View file

@ -55,7 +55,7 @@ ETAGS = "../lib-src/$(BLD)/etags"
# Automatically generated autoload files, apart from lisp/loaddefs.el.
LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
$(lisp)/calendar/diary-loaddefs.el $(lisp)/calendar/hol-loaddefs.el \
$(lisp)/mh-e/mh-loaddefs.el
$(lisp)/mh-e/mh-loaddefs.el $(lisp)/net/tramp-loaddefs.el
AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \
$(lisp)/finder-inf.el $(lisp)/subdirs.el $(lisp)/eshell/esh-groups.el \
@ -403,6 +403,25 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
-f w32-batch-update-autoloads \
$(ARGQUOTE)$(lisp)/mh-e/mh-loaddefs.el$(ARGQUOTE) $(MAKE) ./mh-e
# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
# its own subdirectory. OTOH, it does not hurt to keep them in
# lisp/net.
TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \
$(lisp)/net/tramp-cmds.el $(lisp)/net/tramp-compat.el \
$(lisp)/net/tramp-ftp.el $(lisp)/net/tramp-gvfs.el \
$(lisp)/net/tramp-gw.el $(lisp)/net/tramp-imap.el \
$(lisp)/net/tramp-sh.el $(lisp)/net/tramp-smb.el \
$(lisp)/net/tramp-uu.el $(lisp)/net/trampver.el
$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC)
"$(EMACS)" $(EMACSOPT) \
-l autoload \
--eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \
--eval $(ARGQUOTE)(setq find-file-suppress-same-file-warnings t)$(ARGQUOTE) \
--eval $(ARGQUOTE)(setq make-backup-files nil)$(ARGQUOTE) \
-f w32-batch-update-autoloads \
$(ARGQUOTE)$(lisp)/net/tramp-loaddefs.el$(ARGQUOTE) $(MAKE) ./net
# Prepare a bootstrap in the lisp subdirectory.
#
# Build loaddefs.el to make sure it's up-to-date. If it's not, that

24
lisp/menu-bar.el
View file

@ -664,13 +664,23 @@ by \"Save Options\" in Custom buffers.")
;; put on a customized-value property.
(dolist (elt '(line-number-mode column-number-mode size-indication-mode
cua-mode show-paren-mode transient-mark-mode
blink-cursor-mode display-time-mode display-battery-mode))
blink-cursor-mode display-time-mode display-battery-mode
;; These are set by other functions that don't set
;; the customized state. Having them here has the
;; side-effect that turning them off via X
;; resources acts like having customized them, but
;; that seems harmless.
menu-bar-mode tool-bar-mode))
;; FIXME ? It's a little annoying that running this command
;; always loads cua-base, paren, time, and battery, even if they
;; have not been customized in any way. (Due to custom-load-symbol.)
(and (customize-mark-to-save elt)
(setq need-save t)))
;; These are set with `customize-set-variable'.
(dolist (elt '(scroll-bar-mode
debug-on-quit debug-on-error
tooltip-mode menu-bar-mode tool-bar-mode
;; Somehow this works, when tool-bar and menu-bar don't.
tooltip-mode
save-place uniquify-buffer-name-style fringe-mode
indicate-empty-lines indicate-buffer-boundaries
case-fold-search font-use-system-font
@ -2037,6 +2047,16 @@ turn on menu bars; otherwise, turn off menu bars."
(run-with-idle-timer 0 nil 'message
"Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear.")))
;;;###autoload
;; (This does not work right unless it comes after the above definition.)
;; This comment is taken from tool-bar.el near
;; (put 'tool-bar-mode ...)
;; We want to pretend the menu bar by standard is on, as this will make
;; customize consider disabling the menu bar a customization, and save
;; that. We could do this for real by setting :init-value above, but
;; that would overwrite disabling the menu bar from X resources.
(put 'menu-bar-mode 'standard-value '(t))
(defun toggle-menu-bar-mode-from-frame (&optional arg)
"Toggle menu bar on or off, based on the status of the current frame.
See `menu-bar-mode' for more information."

238
lisp/net/imap.el
View file

@ -448,6 +448,18 @@ The actual value is really the text on the continuation line.")
The function should take two arguments, the first the IMAP tag and the
second the status (OK, NO, BAD etc) of the command.")
(defvar imap-enable-exchange-bug-workaround nil
"Send FETCH UID commands as *:* instead of *.
When non-nil, use an alternative UIDS form. Enabling appears to
be required for some servers (e.g., Microsoft Exchange 2007)
which otherwise would trigger a response 'BAD The specified
message set is invalid.'. We don't unconditionally use this
form, since this is said to be significantly inefficient.
This variable is set to t automatically per server if the
canonical form fails.")
;; Utility functions:
@ -1303,38 +1315,40 @@ If BUFFER is nil, the current buffer is assumed."
;; Mailbox functions:
(defun imap-mailbox-put (propname value &optional mailbox)
(if imap-mailbox-data
(put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
propname value)
(error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
propname value mailbox (current-buffer)))
t)
(defun imap-mailbox-put (propname value &optional mailbox buffer)
(with-current-buffer (or buffer (current-buffer))
(if imap-mailbox-data
(put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
propname value)
(error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
propname value mailbox (current-buffer)))
t))
(defsubst imap-mailbox-get-1 (propname &optional mailbox)
(get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
propname))
(defun imap-mailbox-get (propname &optional mailbox buffer)
(let ((mailbox (imap-utf7-encode mailbox)))
(with-current-buffer (or buffer (current-buffer))
(imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
(with-current-buffer (or buffer (current-buffer))
(imap-mailbox-get-1 propname (or (imap-utf7-encode mailbox)
imap-current-mailbox))))
(let (result)
(mapatoms
(lambda (s)
(push (funcall func (if mailbox-decoder
(funcall mailbox-decoder (symbol-name s))
(symbol-name s))) result))
imap-mailbox-data)
result)))
(defun imap-mailbox-map-1 (func &optional mailbox-decoder)
(let (result)
(mapatoms
(lambda (s)
(push (funcall func (if mailbox-decoder
(funcall mailbox-decoder (symbol-name s))
(symbol-name s))) result))
imap-mailbox-data)
result))
(defun imap-mailbox-map (func)
(defun imap-mailbox-map (func &optional buffer)
"Map a function across each mailbox in `imap-mailbox-data', returning a list.
Function should take a mailbox name (a string) as
the only argument."
(imap-mailbox-map-1 func 'imap-utf7-decode))
(imap-mailbox-map-1 func 'imap-utf7-decode buffer))
(defun imap-current-mailbox (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
@ -1648,26 +1662,29 @@ is non-nil return these properties."
uids)
(imap-message-get uids receive))))))
(defun imap-message-put (uid propname value)
(if imap-message-data
(put (intern (number-to-string uid) imap-message-data)
propname value)
(error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
uid propname value (current-buffer)))
t)
(defun imap-message-put (uid propname value &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(if imap-message-data
(put (intern (number-to-string uid) imap-message-data)
propname value)
(error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
uid propname value (current-buffer)))
t))
(defun imap-message-get (uid propname)
(get (intern-soft (number-to-string uid) imap-message-data)
propname))
(defun imap-message-get (uid propname &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(get (intern-soft (number-to-string uid) imap-message-data)
propname)))
(defun imap-message-map (func propname)
(defun imap-message-map (func propname &optional buffer)
"Map a function across each message in `imap-message-data', returning a list."
(let (result)
(mapatoms
(lambda (s)
(push (funcall func (get s 'UID) (get s propname)) result))
imap-message-data)
result))
(with-current-buffer (or buffer (current-buffer))
(let (result)
(mapatoms
(lambda (s)
(push (funcall func (get s 'UID) (get s propname)) result))
imap-message-data)
result)))
(defmacro imap-message-envelope-date (uid &optional buffer)
`(with-current-buffer (or ,buffer (current-buffer))
@ -1763,6 +1780,48 @@ is non-nil return these properties."
(format "String %s cannot be converted to a Lisp integer" number))
number)))
(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
"Like `imap-fetch', but DTRT with Exchange 2007 bug.
However, UIDS here is a cons, where the car is the canonical form
of the UIDS specification, and the cdr is the one which works with
Exchange 2007 or, potentially, other buggy servers.
See `imap-enable-exchange-bug-workaround'."
;; The first time we get here for a given, we'll try the canonical
;; form. If we get the known error from the buggy server, set the
;; flag buffer-locally (to account for connections to multiple
;; servers), then re-try with the alternative UIDS spec. We don't
;; unconditionally use the alternative form, since the
;; currently-used alternatives are seriously inefficient with some
;; servers (although they are valid).
;;
;; FIXME: Maybe it would be cleaner to have a flag to not signal
;; the error (which otherwise gives a message), and test
;; `imap-failed-tags'. Also, Other IMAP clients use other forms of
;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not
;; to do the same?
(condition-case data
;; Binding `debug-on-error' allows us to get the error from
;; `imap-parse-response' -- it's normally caught by Emacs around
;; execution of a process filter.
(let ((debug-on-error t))
(imap-fetch (if imap-enable-exchange-bug-workaround
(cdr uids)
(car uids))
props receive nouidfetch buffer))
(error
(if (and (not imap-enable-exchange-bug-workaround)
;; This is the Exchange 2007 response. It may be more
;; robust just to check for a BAD response to the
;; attempted fetch.
(string-match "The specified message set is invalid"
(cadr data)))
(with-current-buffer (or buffer (current-buffer))
(set (make-local-variable 'imap-enable-exchange-bug-workaround)
t)
(imap-fetch (cdr uids) props receive nouidfetch))
(signal (car data) (cdr data))))))
(defun imap-message-copyuid-1 (mailbox)
(if (imap-capability 'UIDPLUS)
(list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
@ -1772,7 +1831,7 @@ is non-nil return these properties."
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch "*:*" "UID")
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
@ -1818,7 +1877,7 @@ first element. The rest of list contains the saved articles' UIDs."
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch "*:*" "UID")
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
@ -2892,6 +2951,105 @@ Return nil if no complete line has arrived."
(imap-forward)
(nreverse body)))))
(when imap-debug ; (untrace-all)
(require 'trace)
(buffer-disable-undo (get-buffer-create imap-debug-buffer))
(mapc (lambda (f) (trace-function-background f imap-debug-buffer))
'(
imap-utf7-encode
imap-utf7-decode
imap-error-text
imap-kerberos4s-p
imap-kerberos4-open
imap-ssl-p
imap-ssl-open
imap-network-p
imap-network-open
imap-interactive-login
imap-kerberos4a-p
imap-kerberos4-auth
imap-cram-md5-p
imap-cram-md5-auth
imap-login-p
imap-login-auth
imap-anonymous-p
imap-anonymous-auth
imap-open-1
imap-open
imap-opened
imap-ping-server
imap-authenticate
imap-close
imap-capability
imap-namespace
imap-send-command-wait
imap-mailbox-put
imap-mailbox-get
imap-mailbox-map-1
imap-mailbox-map
imap-current-mailbox
imap-current-mailbox-p-1
imap-current-mailbox-p
imap-mailbox-select-1
imap-mailbox-select
imap-mailbox-examine-1
imap-mailbox-examine
imap-mailbox-unselect
imap-mailbox-expunge
imap-mailbox-close
imap-mailbox-create-1
imap-mailbox-create
imap-mailbox-delete
imap-mailbox-rename
imap-mailbox-lsub
imap-mailbox-list
imap-mailbox-subscribe
imap-mailbox-unsubscribe
imap-mailbox-status
imap-mailbox-acl-get
imap-mailbox-acl-set
imap-mailbox-acl-delete
imap-current-message
imap-list-to-message-set
imap-fetch-asynch
imap-fetch
imap-fetch-safe
imap-message-put
imap-message-get
imap-message-map
imap-search
imap-message-flag-permanent-p
imap-message-flags-set
imap-message-flags-del
imap-message-flags-add
imap-message-copyuid-1
imap-message-copyuid
imap-message-copy
imap-message-appenduid-1
imap-message-appenduid
imap-message-append
imap-body-lines
imap-envelope-from
imap-send-command-1
imap-send-command
imap-wait-for-tag
imap-sentinel
imap-find-next-line
imap-arrival-filter
imap-parse-greeting
imap-parse-response
imap-parse-resp-text
imap-parse-resp-text-code
imap-parse-data-list
imap-parse-fetch
imap-parse-status
imap-parse-acl
imap-parse-flag-list
imap-parse-envelope
imap-parse-body-extension
imap-parse-body
)))
(provide 'imap)
;;; imap.el ends here

22
lisp/net/netrc.el
View file

@ -54,12 +54,19 @@
"Netrc configuration."
:group 'comm)
(defcustom netrc-file "~/.authinfo"
"File where user credentials are stored."
:type 'file
:group 'netrc)
(defvar netrc-services-file "/etc/services"
"The name of the services file.")
(defun netrc-parse (file)
(defun netrc-parse (&optional file)
(interactive "fFile to Parse: ")
"Parse FILE and return a list of all entries in the file."
(unless file
(setq file netrc-file))
(if (listp file)
file
(when (file-exists-p file)
@ -221,6 +228,19 @@ MODE can be \"login\" or \"password\", suitable for passing to
(eq type (car (cddr service)))))))
(cadr service)))
(defun netrc-credentials (machine &rest ports)
"Return a user name/password pair.
Port specifications will be prioritised in the order they are
listed in the PORTS list."
(let ((list (netrc-parse))
found)
(while (and ports
(not found))
(setq found (netrc-machine list machine (pop ports))))
(when found
(list (cdr (assoc "login" found))
(cdr (assoc "password" found))))))
(provide 'netrc)
;;; netrc.el ends here

111
lisp/net/rcirc.el
View file

@ -774,42 +774,64 @@ If SILENT is non-nil, do not print the message in any irc buffer."
(setq rcirc-input-ring-index (1- rcirc-input-ring-index))
(insert (rcirc-prev-input-string -1))))
(defvar rcirc-nick-completions nil)
(defvar rcirc-nick-completion-start-offset nil)
(defvar rcirc-server-commands
'("/admin" "/away" "/connect" "/die" "/error" "/info"
"/invite" "/ison" "/join" "/kick" "/kill" "/links"
"/list" "/lusers" "/mode" "/motd" "/names" "/nick"
"/notice" "/oper" "/part" "/pass" "/ping" "/pong"
"/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist"
"/server" "/squery" "/squit" "/stats" "/summon" "/time"
"/topic" "/trace" "/user" "/userhost" "/users" "/version"
"/wallops" "/who" "/whois" "/whowas")
"A list of user commands by IRC server.
The value defaults to RFCs 1459 and 2812.")
(defun rcirc-complete-nick ()
"Cycle through nick completions from list of nicks in channel."
;; /me and /ctcp are not defined by `defun-rcirc-command'.
(defvar rcirc-client-commands '("/me" "/ctcp")
"A list of user commands defined by IRC client rcirc.
The list is updated automatically by `defun-rcirc-command'.")
(defun rcirc-completion-at-point ()
"Function used for `completion-at-point-functions' in `rcirc-mode'."
(let* ((beg (save-excursion
(if (re-search-backward " " rcirc-prompt-end-marker t)
(1+ (point))
rcirc-prompt-end-marker)))
(table (if (and (= beg rcirc-prompt-end-marker)
(eq (char-after beg) ?/))
(delete-dups
(nconc
(sort (copy-sequence rcirc-client-commands) 'string-lessp)
(sort (copy-sequence rcirc-server-commands) 'string-lessp)))
(rcirc-channel-nicks (rcirc-buffer-process) rcirc-target))))
(list beg (point) table)))
(defvar rcirc-completions nil)
(defvar rcirc-completion-start nil)
(defun rcirc-complete ()
"Cycle through completions from list of nicks in channel or IRC commands.
IRC command completion is performed only if '/' is the first input char."
(interactive)
(if (eq last-command this-command)
(setq rcirc-nick-completions
(append (cdr rcirc-nick-completions)
(list (car rcirc-nick-completions))))
(setq rcirc-nick-completion-start-offset
(- (save-excursion
(if (re-search-backward " " rcirc-prompt-end-marker t)
(1+ (point))
rcirc-prompt-end-marker))
rcirc-prompt-end-marker))
(setq rcirc-nick-completions
(let ((completion-ignore-case t))
(all-completions
(buffer-substring
(+ rcirc-prompt-end-marker
rcirc-nick-completion-start-offset)
(point))
(mapcar (lambda (x) (cons x nil))
(rcirc-channel-nicks (rcirc-buffer-process)
rcirc-target))))))
(let ((completion (car rcirc-nick-completions)))
(setq rcirc-completions
(append (cdr rcirc-completions) (list (car rcirc-completions))))
(let ((completion-ignore-case t)
(table (rcirc-completion-at-point)))
(setq rcirc-completion-start (car table))
(setq rcirc-completions
(all-completions (buffer-substring rcirc-completion-start
(cadr table))
(nth 2 table)))))
(let ((completion (car rcirc-completions)))
(when completion
(delete-region (+ rcirc-prompt-end-marker
rcirc-nick-completion-start-offset)
(point))
(insert (concat completion
(if (= (+ rcirc-prompt-end-marker
rcirc-nick-completion-start-offset)
rcirc-prompt-end-marker)
": "))))))
(delete-region rcirc-completion-start (point))
(insert
(concat completion
(cond
((= (aref completion 0) ?/) " ")
((= rcirc-completion-start rcirc-prompt-end-marker) ": ")
(t "")))))))
(defun set-rcirc-decode-coding-system (coding-system)
"Set the decode coding system used in this channel."
@ -827,7 +849,7 @@ If SILENT is non-nil, do not print the message in any irc buffer."
(define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input)
(define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input)
(define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input)
(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick)
(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete)
(define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url)
(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline)
(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join)
@ -948,6 +970,9 @@ This number is independent of the number of lines in the buffer.")
rcirc-buffer-alist))))
(rcirc-update-short-buffer-names))
(add-hook 'completion-at-point-functions
'rcirc-completion-at-point nil 'local)
(run-hooks 'rcirc-mode-hook))
(defun rcirc-update-prompt (&optional all)
@ -2004,16 +2029,18 @@ activity. Only run if the buffer is not visible and
;; containing the text following the /cmd.
(defmacro defun-rcirc-command (command argument docstring interactive-form
&rest body)
&rest body)
"Define a command."
`(defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
(,@argument &optional process target)
,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
"\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
,interactive-form
(let ((process (or process (rcirc-buffer-process)))
(target (or target rcirc-target)))
,@body)))
`(progn
(add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
(defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
(,@argument &optional process target)
,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
"\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
,interactive-form
(let ((process (or process (rcirc-buffer-process)))
(target (or target rcirc-target)))
,@body))))
(defun-rcirc-command msg (message)
"Send private MESSAGE to TARGET."

150
lisp/net/tramp-cache.el
View file

@ -50,24 +50,12 @@
;;; Code:
;; Pacify byte-compiler.
(eval-when-compile
(require 'cl)
(autoload 'tramp-message "tramp")
(autoload 'tramp-tramp-file-p "tramp")
;; We cannot autoload macro `with-parsed-tramp-file-name', it
;; results in problems of byte-compiled code.
(autoload 'tramp-dissect-file-name "tramp")
(autoload 'tramp-file-name-method "tramp")
(autoload 'tramp-file-name-user "tramp")
(autoload 'tramp-file-name-host "tramp")
(autoload 'tramp-file-name-localname "tramp")
(autoload 'tramp-run-real-handler "tramp")
(autoload 'tramp-time-less-p "tramp")
(autoload 'time-stamp-string "time-stamp"))
(require 'tramp)
(autoload 'time-stamp-string "time-stamp")
;;; -- Cache --
;;;###tramp-autoload
(defvar tramp-cache-data (make-hash-table :test 'equal)
"Hash table for remote files properties.")
@ -103,6 +91,7 @@ time.")
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
;;;###tramp-autoload
(defun tramp-get-file-property (vec file property default)
"Get the PROPERTY of FILE from the cache context of VEC.
Returns DEFAULT if not set."
@ -130,6 +119,7 @@ Returns DEFAULT if not set."
(tramp-message vec 8 "%s %s %s" file property value)
value))
;;;###tramp-autoload
(defun tramp-set-file-property (vec file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
Returns VALUE."
@ -144,6 +134,28 @@ Returns VALUE."
(tramp-message vec 8 "%s %s %s" file property value)
value))
;;;###tramp-autoload
(defmacro with-file-property (vec file property &rest body)
"Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
FILE must be a local file name on a connection identified via VEC."
`(if (file-name-absolute-p ,file)
(let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
(when (eq value 'undef)
;; We cannot pass @body as parameter to
;; `tramp-set-file-property' because it mangles our
;; debug messages.
(setq value (progn ,@body))
(tramp-set-file-property ,vec ,file ,property value))
value)
,@body))
;;;###tramp-autoload
(put 'with-file-property 'lisp-indent-function 3)
(put 'with-file-property 'edebug-form-spec t)
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-file-property\\>"))
;;;###tramp-autoload
(defun tramp-flush-file-property (vec file)
"Remove all properties of FILE in the cache context of VEC."
;; Unify localname.
@ -152,6 +164,7 @@ Returns VALUE."
(tramp-message vec 8 "%s" file)
(remhash vec tramp-cache-data))
;;;###tramp-autoload
(defun tramp-flush-directory-property (vec directory)
"Remove all properties of DIRECTORY in the cache context of VEC.
Remove also properties of all files in subdirectories."
@ -175,8 +188,7 @@ Remove also properties of all files in subdirectories."
(buffer-file-name)
default-directory)))
(when (tramp-tramp-file-p bfn)
(let* ((v (tramp-dissect-file-name bfn))
(localname (tramp-file-name-localname v)))
(with-parsed-tramp-file-name bfn nil
(tramp-flush-file-property v localname)))))
(add-hook 'before-revert-hook 'tramp-flush-file-function)
@ -193,6 +205,7 @@ Remove also properties of all files in subdirectories."
;;; -- Properties --
;;;###tramp-autoload
(defun tramp-get-connection-property (key property default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a vector.
@ -209,6 +222,7 @@ If the value is not set for the connection, returns DEFAULT."
(tramp-message key 7 "%s %s" property value)
value))
;;;###tramp-autoload
(defun tramp-set-connection-property (key property value)
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a vector.
@ -223,14 +237,28 @@ PROPERTY is set persistent when KEY is a vector."
tramp-cache-data))))
(puthash property value hash)
(setq tramp-cache-data-changed t)
;; This function is called also during initialization of
;; tramp-cache.el. `tramp-message´ is not defined yet at this
;; time, so we ignore the corresponding error.
(condition-case nil
(tramp-message key 7 "%s %s" property value)
(error nil))
(tramp-message key 7 "%s %s" property value)
value))
;;;###tramp-autoload
(defmacro with-connection-property (key property &rest body)
"Check in Tramp for property PROPERTY, otherwise executes BODY and set."
`(let ((value (tramp-get-connection-property ,key ,property 'undef)))
(when (eq value 'undef)
;; We cannot pass ,@body as parameter to
;; `tramp-set-connection-property' because it mangles our debug
;; messages.
(setq value (progn ,@body))
(tramp-set-connection-property ,key ,property value))
value))
;;;###tramp-autoload
(put 'with-connection-property 'lisp-indent-function 2)
(put 'with-connection-property 'edebug-form-spec t)
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-connection-property\\>"))
;;;###tramp-autoload
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a vector."
@ -251,6 +279,7 @@ KEY identifies the connection, it is either a process or a vector."
(setq tramp-cache-data-changed t)
(remhash key tramp-cache-data))
;;;###tramp-autoload
(defun tramp-cache-print (table)
"Print hash table TABLE."
(when (hash-table-p table)
@ -271,6 +300,7 @@ KEY identifies the connection, it is either a process or a vector."
table)
result)))
;;;###tramp-autoload
(defun tramp-list-connections ()
"Return a list of all known connection vectors according to `tramp-cache'."
(let (result)
@ -284,41 +314,40 @@ KEY identifies the connection, it is either a process or a vector."
(defun tramp-dump-connection-properties ()
"Write persistent connection properties into file `tramp-persistency-file-name'."
;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed.
(condition-case nil
(when (and (hash-table-p tramp-cache-data)
(not (zerop (hash-table-count tramp-cache-data)))
tramp-cache-data-changed
(stringp tramp-persistency-file-name))
(let ((cache (copy-hash-table tramp-cache-data)))
;; Remove temporary data.
(maphash
'(lambda (key value)
(if (and (vectorp key) (not (tramp-file-name-localname key)))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
(remhash "first-password-request" value))
(remhash key cache)))
cache)
;; Dump it.
(with-temp-buffer
(insert
";; -*- emacs-lisp -*-"
;; `time-stamp-string' might not exist in all (X)Emacs flavors.
(condition-case nil
(progn
(format
" <%s %s>\n"
(time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
tramp-persistency-file-name))
(error "\n"))
";; Tramp connection history. Don't change this file.\n"
";; You can delete it, forcing Tramp to reapply the checks.\n\n"
(with-output-to-string
(pp (read (format "(%s)" (tramp-cache-print cache))))))
(write-region
(point-min) (point-max) tramp-persistency-file-name))))
(error nil)))
(ignore-errors
(when (and (hash-table-p tramp-cache-data)
(not (zerop (hash-table-count tramp-cache-data)))
tramp-cache-data-changed
(stringp tramp-persistency-file-name))
(let ((cache (copy-hash-table tramp-cache-data)))
;; Remove temporary data.
(maphash
'(lambda (key value)
(if (and (vectorp key) (not (tramp-file-name-localname key)))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
(remhash "first-password-request" value))
(remhash key cache)))
cache)
;; Dump it.
(with-temp-buffer
(insert
";; -*- emacs-lisp -*-"
;; `time-stamp-string' might not exist in all (X)Emacs flavors.
(condition-case nil
(progn
(format
" <%s %s>\n"
(time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
tramp-persistency-file-name))
(error "\n"))
";; Tramp connection history. Don't change this file.\n"
";; You can delete it, forcing Tramp to reapply the checks.\n\n"
(with-output-to-string
(pp (read (format "(%s)" (tramp-cache-print cache))))))
(write-region
(point-min) (point-max) tramp-persistency-file-name))))))
(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)
(add-hook 'tramp-cache-unload-hook
@ -326,6 +355,7 @@ KEY identifies the connection, it is either a process or a vector."
(remove-hook 'kill-emacs-hook
'tramp-dump-connection-properties)))
;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
@ -364,6 +394,10 @@ for all methods. Resulting data are derived from connection history."
tramp-persistency-file-name (error-message-string err))
(clrhash tramp-cache-data))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-cache 'force)))
(provide 'tramp-cache)
;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26

8
lisp/net/tramp-cmds.el
View file

@ -129,6 +129,7 @@ This includes password cache, file cache, connection cache, buffers."
;; Tramp version is useful in a number of situations.
;;;###tramp-autoload
(defun tramp-version (arg)
"Print version number of tramp.el in minibuffer or current buffer."
(interactive "P")
@ -387,6 +388,9 @@ please ensure that the buffers are attached to your email.\n\n")
(defalias 'tramp-submit-bug 'tramp-bug)
(add-hook 'tramp-unload-hook
(lambda () (unload-feature 'tramp-cmds 'force)))
(provide 'tramp-cmds)
;;; TODO:
@ -395,7 +399,7 @@ please ensure that the buffers are attached to your email.\n\n")
;; * WIBNI there was an interactive command prompting for Tramp
;; method, hostname, username and filename and translates the user
;; input into the correct filename syntax (depending on the Emacs
;; flavor) (Reiner Steib)
;; flavor) (Reiner Steib)
;; * Let the user edit the connection properties interactively.
;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
;; * It's just that when I come to Customize `tramp-default-user-alist'
@ -404,7 +408,7 @@ please ensure that the buffers are attached to your email.\n\n")
;; Option and should not be modified by the code. add-to-list is
;; called in several places. One way to handle that is to have a new
;; ordinary variable that gets its initial value from
;; tramp-default-user-alist and then is added to. (Pete Forman)
;; tramp-default-user-alist and then is added to. (Pete Forman)
;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c
;;; tramp-cmds.el ends here

103
lisp/net/tramp-compat.el
View file

@ -29,6 +29,8 @@
;;; Code:
(require 'tramp-loaddefs)
(eval-when-compile
;; Pacify byte-compiler.
@ -36,40 +38,41 @@
(eval-and-compile
(require 'advice)
(require 'custom)
(require 'format-spec)
;; As long as password.el is not part of (X)Emacs, it shouldn't be
;; mandatory.
(if (featurep 'xemacs)
(load "password" 'noerror)
(or (require 'password-cache nil 'noerror)
(require 'password nil 'noerror))) ; Part of contrib.
;; auth-source is relatively new.
(if (featurep 'xemacs)
(load "auth-source" 'noerror)
(require 'auth-source nil 'noerror))
;; Load the appropriate timer package.
(if (featurep 'xemacs)
(require 'timer-funcs)
(require 'timer))
(autoload 'tramp-tramp-file-p "tramp")
(autoload 'tramp-file-name-handler "tramp")
;; We check whether `start-file-process' is bound.
(unless (fboundp 'start-file-process)
;; tramp-util offers integration into other (X)Emacs packages like
;; compile.el, gud.el etc. Not necessary in Emacs 23.
(eval-after-load "tramp"
'(progn
(require 'tramp-util)
(add-hook 'tramp-unload-hook
'(lambda ()
(when (featurep 'tramp-util)
(unload-feature 'tramp-util 'force))))))
'(require 'tramp-util))
;; Make sure that we get integration with the VC package. When it
;; is loaded, we need to pull in the integration module. Not
;; necessary in Emacs 23.
(eval-after-load "vc"
(eval-after-load "tramp"
'(progn
(require 'tramp-vc)
(add-hook 'tramp-unload-hook
'(lambda ()
(when (featurep 'tramp-vc)
(unload-feature 'tramp-vc 'force))))))))
'(require 'tramp-vc))))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
@ -93,11 +96,6 @@
(defvar byte-compile-not-obsolete-vars nil))
(setq byte-compile-not-obsolete-vars '(directory-sep-char))
;; `with-temp-message' does not exists in XEmacs.
(condition-case nil
(with-temp-message (current-message) nil)
(error (defmacro with-temp-message (message &rest body) `(progn ,@body))))
;; For not existing functions, or functions with a changed argument
;; list, there are compiler warnings. We want to avoid them in
;; cases we know what we do.
@ -111,10 +109,6 @@
(unless (fboundp 'set-buffer-multibyte)
(defalias 'set-buffer-multibyte 'ignore))
;; `font-lock-add-keywords' does not exist in XEmacs.
(unless (fboundp 'font-lock-add-keywords)
(defalias 'font-lock-add-keywords 'ignore))
;; The following functions cannot be aliases of the corresponding
;; `tramp-handle-*' functions, because this would bypass the locking
;; mechanism.
@ -187,6 +181,19 @@
'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
(ad-activate 'file-expand-wildcards)))))
;; `with-temp-message' does not exists in XEmacs.
(if (fboundp 'with-temp-message)
(defalias 'tramp-compat-with-temp-message 'with-temp-message)
(defun tramp-compat-with-temp-message (message &rest body)
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
;; `font-lock-add-keywords' does not exist in XEmacs.
(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
"Add highlighting KEYWORDS for MODE."
(ignore-errors
(tramp-compat-funcall 'font-lock-add-keywords mode keywords how)))
(defsubst tramp-compat-line-beginning-position ()
"Return point at beginning of line (compat function).
Calls `line-beginning-position' or `point-at-bol' if defined, else
@ -263,6 +270,24 @@ Add the extension of FILENAME, if existing."
;; Default value in XEmacs.
(t 134217727)))
(defun tramp-compat-decimal-to-octal (i)
"Return a string consisting of the octal digits of I.
Not actually used. Use `(format \"%o\" i)' instead?"
(cond ((< i 0) (error "Cannot convert negative number to octal"))
((not (integerp i)) (error "Cannot convert non-integer to octal"))
((zerop i) "0")
(t (concat (tramp-compat-decimal-to-octal (/ i 8))
(number-to-string (% i 8))))))
;; Kudos to Gerd Moellmann for this suggestion.
(defun tramp-compat-octal-to-decimal (ostr)
"Given a string of octal digits, return a decimal number."
(let ((x (or ostr "")))
;; `save-match' is in `tramp-mode-string-to-int' which calls this.
(unless (string-match "\\`[0-7]*\\'" x)
(error "Non-octal junk in string `%s'" x))
(string-to-number ostr 8)))
;; ID-FORMAT does not exists in XEmacs.
(defun tramp-compat-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files (compat function)."
@ -397,6 +422,20 @@ This is, the first, empty, element is omitted. In XEmacs, the first
element is not omitted."
(delete "" (split-string string pattern)))
(defun tramp-compat-call-process
(program &optional infile destination display &rest args)
"Calls `call-process' on the local host.
This is needed because for some Emacs flavors Tramp has
defadviced `call-process' to behave like `process-file'. The
Lisp error raised when PROGRAM is nil is trapped also, returning 1."
(let ((default-directory
(if (file-remote-p default-directory)
(tramp-compat-temporary-file-directory)
default-directory)))
(if (executable-find program)
(apply 'call-process program infile destination display args)
1)))
(defun tramp-compat-process-running-p (process-name)
"Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
(when (stringp process-name)
@ -439,6 +478,22 @@ element is not omitted."
(setenv "UNIX95" unix95)
result)))))
;; The following functions do not exist in XEmacs. We ignore this;
;; they are used for checking a remote tty.
(defun tramp-compat-process-get (process propname)
"Return the value of PROCESS' PROPNAME property.
This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
(ignore-errors (tramp-compat-funcall 'process-get process propname)))
(defun tramp-compat-process-put (process propname value)
"Change PROCESS' PROPNAME property to VALUE.
It can be retrieved with `(process-get PROCESS PROPNAME)'."
(ignore-errors (tramp-compat-funcall 'process-put process propname value)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-compat 'force)))
(provide 'tramp-compat)
;;; TODO:

1181
lisp/net/tramp-fish.el
View file

File diff suppressed because it is too large Load diff

32
lisp/net/tramp-ftp.el
View file

@ -30,7 +30,6 @@
;;; Code:
(require 'tramp)
(autoload 'tramp-set-connection-property "tramp-cache")
(eval-when-compile
@ -99,13 +98,14 @@ present for backward compatibility."
(add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp)
;; Define FTP method ...
(defcustom tramp-ftp-method "ftp"
"*When this method name is used, forward all calls to Ange-FTP."
:group 'tramp
:type 'string)
;;;###tramp-autoload
(defconst tramp-ftp-method "ftp"
"*When this method name is used, forward all calls to Ange-FTP.")
;; ... and add it to the method list.
(add-to-list 'tramp-methods (cons tramp-ftp-method nil))
;;;###tramp-autoload
(unless (featurep 'xemacs)
(add-to-list 'tramp-methods (cons tramp-ftp-method nil)))
;; Add some defaults for `tramp-default-method-alist'
(add-to-list 'tramp-default-method-alist
@ -129,6 +129,7 @@ present for backward compatibility."
(symbol-plist
'substitute-in-file-name))))))
;;;###tramp-autoload
(defun tramp-ftp-file-name-handler (operation &rest args)
"Invoke the Ange-FTP handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@ -199,23 +200,26 @@ pass to the OPERATION."
(inhibit-file-name-operation operation))
(apply 'ange-ftp-hook-function operation args)))))))
(defun tramp-ftp-file-name-p (filename)
;;;###tramp-autoload
(defsubst tramp-ftp-file-name-p (filename)
"Check if it's a filename that should be forwarded to Ange-FTP."
(let ((v (tramp-dissect-file-name filename)))
(string= (tramp-file-name-method v) tramp-ftp-method)))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
;;;###tramp-autoload
(unless (featurep 'xemacs)
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-ftp 'force)))
(provide 'tramp-ftp)
;;; TODO:
;; * In case of "/ftp:host:file" this works only for functions which
;; are defined in `tramp-file-name-handler-alist'. Call has to be
;; pretended in `tramp-file-name-handler' otherwise.
;; Furthermore, there are no backup files on FTP hosts.
;; Worth further investigations.
;; * There are no backup files on FTP hosts.
;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff
;;; tramp-ftp.el ends here

55
lisp/net/tramp-gvfs.el
View file

@ -103,11 +103,17 @@
(require 'custom))
(require 'tramp)
;; We call several `tramp-handle-*' functions directly. So we must
;; reqire that package as well.
(require 'tramp-sh)
(require 'dbus)
(require 'url-parse)
(require 'url-util)
(require 'zeroconf)
;;;###tramp-autoload
(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
"*List of methods for remote files, accessed with GVFS."
:group 'tramp
@ -133,11 +139,11 @@
;; Add the methods to `tramp-methods', in order to allow minibuffer
;; completion.
(eval-after-load "tramp-gvfs"
'(when (featurep 'tramp-gvfs)
(dolist (elt tramp-gvfs-methods)
(unless (assoc elt tramp-methods)
(add-to-list 'tramp-methods (cons elt nil))))))
;;;###tramp-autoload
(when (featurep 'dbusbind)
(dolist (elt tramp-gvfs-methods)
(unless (assoc elt tramp-methods)
(add-to-list 'tramp-methods (cons elt nil)))))
(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
"The preceeding object path for own objects.")
@ -145,9 +151,12 @@
(defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
"The well known name of the GVFS daemon.")
;; Check that GVFS is available.
(unless (dbus-ping :session tramp-gvfs-service-daemon 100)
(throw 'tramp-loading nil))
;; Check that GVFS is available. D-Bus integration is available since
;; Emacs 23 on some system types. We don't call `dbus-ping', because
;; this would load dbus.el.
(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session)
(tramp-compat-process-running-p "gvfs-fuse-daemon"))
(error "Package `tramp-gvfs' not supported"))
(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
"The object path of the GVFS daemon.")
@ -385,7 +394,7 @@ Every entry is a list (NAME ADDRESS).")
(expand-file-name . tramp-gvfs-handle-expand-file-name)
;; `file-accessible-directory-p' performed by default handler.
(file-attributes . tramp-gvfs-handle-file-attributes)
(file-directory-p . tramp-smb-handle-file-directory-p)
(file-directory-p . tramp-gvfs-handle-file-directory-p)
(file-executable-p . tramp-gvfs-handle-file-executable-p)
(file-exists-p . tramp-gvfs-handle-file-exists-p)
(file-local-copy . tramp-gvfs-handle-file-local-copy)
@ -431,13 +440,15 @@ Every entry is a list (NAME ADDRESS).")
"Alist of handler functions for Tramp GVFS method.
Operations not mentioned here will be handled by the default Emacs primitives.")
(defun tramp-gvfs-file-name-p (filename)
;;;###tramp-autoload
(defsubst tramp-gvfs-file-name-p (filename)
"Check if it's a filename handled by the GVFS daemon."
(and (tramp-tramp-file-p filename)
(let ((method
(tramp-file-name-method (tramp-dissect-file-name filename))))
(and (stringp method) (member method tramp-gvfs-methods)))))
;;;###tramp-autoload
(defun tramp-gvfs-file-name-handler (operation &rest args)
"Invoke the GVFS related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@ -449,8 +460,10 @@ pass to the OPERATION."
;; This might be moved to tramp.el. It shall be the first file name
;; handler.
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler))
;;;###tramp-autoload
(when (featurep 'dbusbind)
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)))
(defun tramp-gvfs-stringify-dbus-message (message)
"Convert a D-Bus message into readable UTF8 strings, used for traces."
@ -485,7 +498,8 @@ will be traced by Tramp with trace level 6."
(put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
(defmacro with-tramp-gvfs-error-message (filename handler &rest args)
"Apply a Tramp GVFS `handler'.
@ -494,7 +508,7 @@ In case of an error, modify the error message by replacing
`(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename)))
elt)
(condition-case err
(funcall ,handler ,@args)
(tramp-compat-funcall ,handler ,@args)
(error
(setq elt (cdr err))
(while elt
@ -506,7 +520,8 @@ In case of an error, modify the error message by replacing
(put 'with-tramp-gvfs-error-message 'lisp-indent-function 2)
(put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))
(defvar tramp-gvfs-dbus-event-vector nil
"Current Tramp file name to be used, as vector.
@ -647,6 +662,10 @@ is no information where to trace the message.")
"Like `file-attributes' for Tramp files."
(file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
(defun tramp-gvfs-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
(file-directory-p (tramp-gvfs-fuse-file-name filename)))
(defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
(file-executable-p (tramp-gvfs-fuse-file-name filename)))
@ -956,7 +975,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
;; host signature.
(with-temp-buffer
;; Preserve message for `progress-reporter'.
(with-temp-message ""
(tramp-compat-with-temp-message ""
(insert message)
(pop-to-buffer (current-buffer))
(setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))
@ -1403,6 +1422,10 @@ They are retrieved from the hal daemon."
(tramp-set-completion-function
"synce" '((tramp-synce-parse-device-names "")))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-gvfs 'force)))
(provide 'tramp-gvfs)
;;; TODO:

32
lisp/net/tramp-gw.el
View file

@ -38,11 +38,6 @@
(require 'cl)
(require 'custom))
;; Autoload the socks library. It is used only when we access a SOCKS server.
(autoload 'socks-open-network-stream "socks")
(defvar socks-username (user-login-name))
(defvar socks-server (list "Default server" "socks" 1080 5))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
@ -50,21 +45,29 @@
(byte-compiler-options (warnings (- unused-vars)))))
;; Define HTTP tunnel method ...
(defvar tramp-gw-tunnel-method "tunnel"
;;;###tramp-autoload
(defconst tramp-gw-tunnel-method "tunnel"
"*Method to connect HTTP gateways.")
;; ... and port.
(defvar tramp-gw-default-tunnel-port 8080
(defconst tramp-gw-default-tunnel-port 8080
"*Default port for HTTP gateways.")
;; Define SOCKS method ...
(defvar tramp-gw-socks-method "socks"
;;;###tramp-autoload
(defconst tramp-gw-socks-method "socks"
"*Method to connect SOCKS servers.")
;; ... and port.
(defvar tramp-gw-default-socks-port 1080
(defconst tramp-gw-default-socks-port 1080
"*Default port for SOCKS servers.")
;; Autoload the socks library. It is used only when we access a SOCKS server.
(autoload 'socks-open-network-stream "socks")
(defvar socks-username (user-login-name))
(defvar socks-server
(list "Default server" "socks" tramp-gw-default-socks-port 5))
;; Add a default for `tramp-default-user-alist'. Default is the local user.
(add-to-list 'tramp-default-user-alist
`(,tramp-gw-tunnel-method nil ,(user-login-name)))
@ -125,6 +128,7 @@
(process-send-string
(tramp-get-connection-property proc "process" nil) string)))
;;;###tramp-autoload
(defun tramp-gw-open-connection (vec gw-vec target-vec)
"Open a remote connection to VEC (see `tramp-file-name' structure).
Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a
@ -239,10 +243,9 @@ authentication is requested from proxy server, provide it."
;; Trap errors to be traced in the right trace buffer. Often,
;; proxies have a timeout of 60". We wait 65" in order to
;; receive an answer this case.
(condition-case nil
(let (tramp-verbose)
(tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))
(error nil))
(ignore-errors
(let (tramp-verbose)
(tramp-wait-for-regexp proc 65 "\r?\n\r?\n")))
;; Check return code.
(goto-char (point-min))
(narrow-to-region
@ -310,6 +313,9 @@ password in password cache. This is done for the first try only."
(format
"Password for %s@[%s]: " socks-username (read (current-buffer)))))))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-gw 'force)))
(provide 'tramp-gw)

27
lisp/net/tramp-imap.el
View file

@ -55,7 +55,6 @@
(require 'assoc)
(require 'tramp)
(require 'tramp-compat)
(autoload 'auth-source-user-or-password "auth-source")
(autoload 'epg-context-operation "epg")
@ -76,21 +75,29 @@
'(add-to-list 'imap-hash-headers 'X-Size 'append))
;; Define Tramp IMAP method ...
;;;###tramp-autoload
(defconst tramp-imap-method "imap"
"*Method to connect via IMAP protocol.")
(add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143)))
;;;###tramp-autoload
(when (and (locate-library "epa") (locate-library "imap-hash"))
(add-to-list 'tramp-methods
(list tramp-imap-method '(tramp-default-port 143))))
;; Add a default for `tramp-default-user-alist'. Default is the local user.
(add-to-list 'tramp-default-user-alist
`(,tramp-imap-method nil ,(user-login-name)))
;; Define Tramp IMAPS method ...
;;;###tramp-autoload
(defconst tramp-imaps-method "imaps"
"*Method to connect via secure IMAP protocol.")
;; ... and add it to the method list.
(add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port 993)))
;;;###tramp-autoload
(when (and (locate-library "epa") (locate-library "imap-hash"))
(add-to-list 'tramp-methods
(list tramp-imaps-method '(tramp-default-port 993))))
;; Add a default for `tramp-default-user-alist'. Default is the local user.
(add-to-list 'tramp-default-user-alist
@ -184,13 +191,15 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never
(defvar tramp-imap-passphrase nil)
(defun tramp-imap-file-name-p (filename)
;;;###tramp-autoload
(defsubst tramp-imap-file-name-p (filename)
"Check if it's a filename for IMAP protocol."
(let ((v (tramp-dissect-file-name filename)))
(or
(string= (tramp-file-name-method v) tramp-imap-method)
(string= (tramp-file-name-method v) tramp-imaps-method))))
;;;###tramp-autoload
(defun tramp-imap-file-name-handler (operation &rest args)
"Invoke the IMAP related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@ -200,8 +209,10 @@ pass to the OPERATION."
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args))))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler))
;;;###tramp-autoload
(when (and (locate-library "epa") (locate-library "imap-hash"))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)))
(defun tramp-imap-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@ -776,6 +787,10 @@ With NEEDED-SUBJECT, alters the imap-hash test accordingly."
tramp-imap-subject-marker
(if needed-subject needed-subject "")))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-imap 'force)))
;;; TODO:
;; * Implement `tramp-imap-handle-delete-directory',

5509
lisp/net/tramp-sh.el Normal file
View file

File diff suppressed because it is too large Load diff

34
lisp/net/tramp-smb.el
View file

@ -30,17 +30,20 @@
(eval-when-compile (require 'cl)) ; block, return
(require 'tramp)
(require 'tramp-cache)
(require 'tramp-compat)
;; We call several `tramp-handle-*' functions directly. So we must
;; reqire that package as well.
(require 'tramp-sh)
;; Define SMB method ...
(defcustom tramp-smb-method "smb"
"*Method to connect SAMBA and M$ SMB servers."
:group 'tramp
:type 'string)
;;;###tramp-autoload
(defconst tramp-smb-method "smb"
"*Method to connect SAMBA and M$ SMB servers.")
;; ... and add it to the method list.
(add-to-list 'tramp-methods (cons tramp-smb-method nil))
;;;###tramp-autoload
(unless (memq system-type '(cygwin windows-nt))
(add-to-list 'tramp-methods (cons tramp-smb-method nil)))
;; Add a default for `tramp-default-method-alist'. Rule: If there is
;; a domain in USER, it must be the SMB method.
@ -205,11 +208,13 @@ See `tramp-actions-before-shell' for more info.")
"Alist of handler functions for Tramp SMB method.
Operations not mentioned here will be handled by the default Emacs primitives.")
(defun tramp-smb-file-name-p (filename)
;;;###tramp-autoload
(defsubst tramp-smb-file-name-p (filename)
"Check if it's a filename for SMB servers."
(let ((v (tramp-dissect-file-name filename)))
(string= (tramp-file-name-method v) tramp-smb-method)))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
"Invoke the SMB related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@ -219,8 +224,10 @@ pass to the OPERATION."
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args))))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
;;;###tramp-autoload
(unless (memq system-type '(cygwin windows-nt))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)))
;; File name primitives.
@ -784,7 +791,7 @@ PRESERVE-UID-GID is completely ignored."
(if (tramp-smb-get-cifs-capabilities v)
(format
"posix_mkdir \"%s\" %s"
file (tramp-decimal-to-octal (default-file-modes)))
file (tramp-compat-decimal-to-octal (default-file-modes)))
(format "mkdir \"%s\"" file)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
@ -893,7 +900,7 @@ target of the symlink differ."
(unless (tramp-smb-send-command
v (format "chmod \"%s\" %s"
(tramp-smb-get-localname v)
(tramp-decimal-to-octal mode)))
(tramp-compat-decimal-to-octal mode)))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))
@ -1397,6 +1404,9 @@ Returns nil if an error message has appeared."
(tramp-message vec 6 "\n%s" (buffer-string))
(not err))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
(provide 'tramp-smb)

5
lisp/net/tramp-uu.el
View file

@ -50,6 +50,7 @@
"Return the byte that is encoded as CHAR."
(cdr (assq char tramp-uu-b64-char-to-byte)))
;;;###tramp-autoload
(defun tramp-uuencode-region (beg end)
"UU-encode the region between BEG and END."
;; First we base64 encode the region, then we transmogrify that into
@ -87,6 +88,10 @@
(goto-char beg)
(insert "begin 600 xxx\n"))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-uu 'force)))
(provide 'tramp-uu)
;; arch-tag: 7153f2c6-8be5-4cd2-8c06-0fbcf5190ef6

6478
lisp/net/tramp.el
View file

File diff suppressed because it is too large Load diff

17
lisp/net/trampver.el
View file

@ -31,16 +31,29 @@
;; version check is defined in macro AC_EMACS_INFO of aclocal.m4;
;; should be changed only there.
(defconst tramp-version "2.1.19"
;;;###tramp-autoload
(defconst tramp-version "2.2.0-pre"
"This version of Tramp.")
;;;###tramp-autoload
(defconst tramp-bug-report-address "tramp-devel@gnu.org"
"Email address to send bug reports to.")
;; Check for (X)Emacs version.
(let ((x (if (or (>= emacs-major-version 22) (and (featurep 'xemacs) (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" (format "Tramp 2.1.19 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))))))
(let ((x (if (or (>= emacs-major-version 22)
(and (featurep 'xemacs)
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
(format "Tramp 2.2.0-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'trampver 'force)))
(provide 'trampver)
;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1

20
lisp/notifications.el
View file

@ -42,6 +42,9 @@
(require 'dbus)
(defconst notifications-specification-version "1.1"
"The version of the Desktop Notifications Specification implemented.")
(defconst notifications-application-name "Emacs"
"Default application name.")
@ -151,7 +154,14 @@ Various PARAMS can be set:
:image-data This is a raw data image format which describes the width,
height, rowstride, has alpha, bits per sample, channels and
image data respectively.
:image-path This is represented either as a URI (file:// is the
only URI schema supported right now) or a name
in a freedesktop.org-compliant icon theme.
:sound-file The path to a sound file to play when the notification pops up.
:sound-name A themeable named sound from the freedesktop.org sound naming
specification to play when the notification pops up.
Similar to icon-name,only for sounds. An example would
be \"message-new-instant\".
:suppress-sound Causes the server to suppress playing any sounds, if it has
that ability.
:x Specifies the X location on the screen that the notification
@ -186,7 +196,9 @@ used to manipulate the notification item with
(category (plist-get params :category))
(desktop-entry (plist-get params :desktop-entry))
(image-data (plist-get params :image-data))
(image-path (plist-get params :image-path))
(sound-file (plist-get params :sound-file))
(sound-name (plist-get params :sound-name))
(suppress-sound (plist-get params :suppress-sound))
(x (plist-get params :x))
(y (plist-get params :y))
@ -211,10 +223,18 @@ used to manipulate the notification item with
(add-to-list 'hints `(:dict-entry
"image_data"
(:variant :struct ,image-data)) t))
(when image-path
(add-to-list 'hints `(:dict-entry
"image_path"
(:variant :string ,image-path)) t))
(when sound-file
(add-to-list 'hints `(:dict-entry
"sound-file"
(:variant :string ,sound-file)) t))
(when sound-name
(add-to-list 'hints `(:dict-entry
"sound-name"
(:variant :string ,sound-name)) t))
(when suppress-sound
(add-to-list 'hints `(:dict-entry
"suppress-sound"

468
lisp/nxml/TODO
View file

@ -1,468 +0,0 @@
* High priority
** Command to insert an element template, including all required
attributes and child elements. When there's a choice of elements
possible, we could insert a comment, and put an overlay on that
comment that makes it behave like a button with a pop-up menu to
select the appropriate choice.
** Command to tag a region. With a schema should complete using legal
tags, but should work without a schema as well.
** Provide a way to conveniently rename an element. With a schema should
complete using legal tags, but should work without a schema as well.
* Outlining
** Implement C-c C-o C-q.
** Install pre/post command hook for moving out of invisible section.
** Put a modify hook on invisible sections that expands them.
** Integrate dumb folding somehow.
** An element should be able to be its own heading.
** Optimize to avoid complete buffer scan on each command.
** Make it work with HTML-style headings (i.e. level indicated by
name of heading element rather than depth of section nesting).
** Recognize root element as a section provided it has a title, even
if it doesn't match section-element-name-regex.
** Support for incremental search automatically making hidden text
visible.
** Allow title to be an attribute.
** Command that says to recognize the tag at point as a section/heading.
** Explore better ways to determine when an element is a section
or a heading.
** rng-next-error needs to either ignore invisible portion or reveal it
(maybe use isearch oriented text properties).
** Errors within hidden section should be highlighted by underlining the
ellipsis.
** Make indirect buffers work.
** How should nxml-refresh outline recover from non well-formed tags?
** Hide tags in title elements?
** Use overlays instead of text properties for holding outline state?
Necessary for indirect buffers to work?
** Allow an outline to go in the speedbar.
** Split up outlining manual section into subsections.
** More detail in the manual about each outlining command.
** More menu entries for hiding/showing?
** Indication of many lines have been hidden?
* Locating schemas
** Should rng-validate-mode give the user an opportunity to specify a
schema if there is currently none? Or should it at least give a hint
to the user how to specify a non-vacuous schema?
** Support for adding new schemas to schema-locating files. Add
documentElement and namespace elements.
** C-c C-w should be able to report current type id.
** Implement doctypePublicId.
** Implement typeIdBase.
** Implement typeIdProcessingInstruction.
** Support xml:base.
** Implement group.
** Find preferred prefix from schema-locating files. Get rid of
rng-preferred-prefix-alist.
** Inserting document element with vacuous schema should complete using
document elements declared in schema locating files, and set schema
appropriately.
** Add a ruleType attribute to the <include> element?
** Allow processing instruction in prolog to contain the compact syntax
schema directly.
** Use RDDL to locate a schema based on the namespace URI.
** Should not prompt to add redundant association to schema locating
file.
** Command to reload current schema.
* Schema-sensitive features
** Should filter dynamic markup possibilities using schema validity, by
adding hook to nxml-mode.
** Dynamic markup word should (at least optionally) be able to look in
other buffers that are using nxml-mode.
** Should clicking on Invalid move to next error if already on an error?
** Take advantage of a:documentation. Needs change to schema format.
** Provide feasible validation (as in Jing) toggle.
** Save the validation state as a property on the error overlay to enable
more detailed diagnosis.
** Provide an Error Summary buffer showing all the validation errors.
** Pop-up menu. What is useful? Tag a region (should be greyed out if
the region is not balanced). Suggestions based on error messages.
** Have configurable list of namespace URIs so that we can provide
namespace URI completion on extension elements or with schema-less
documents.
** Allow validation to handle XInclude.
** ID/IDREF support.
* Completion
** Make it work with icomplete. Only use a function to complete when
some of the possible names have undeclared namespaces.
** How should C-return in mixed text work?
** When there's a vacuous schema, C-return after < will insert the
end-tag. Is this a bug or a feature?
** After completing start-tag, ensure we don't get unhelpful message
from validation
** Syntax table for completion.
** Should complete start-tag name with a space if namespace attributes
are required.
** When completing start-tag name with no prefix and it doesn't match
should try to infer namespace from local name.
** Should completion pay attention to characters after point? If so,
how?
** When completing start-tag name, add required atts if only one required
attribute.
** When completing attribute name, add attribute value if only one value
is possible.
** After attribute-value completion, insert space after close delimiter
if more attributes are required.
** Complete on enumerated data values in elements.
** When in context that allows only elements, should get tag
completion without having to type < first.
** When immediately after start-tag name, and name is valid and not
prefix of any other name, should C-return complete on attribute names?
** When completing attributes, more consistent to ignore all attributes
after point.
** Inserting attribute value completions needs to be sensitive to what
delimiter is used so that it quotes the correct character.
** Complete on encoding-names in XML decl.
** Complete namespace declarations by searching for all namespaces
mentioned in the schema.
* Well-formed XML support
** Deal better with Mule-UCS
** Deal with UTF-8 BOM when reading.
** Complete entity names.
** Provide some support for entity names for MathML.
** Command to repeat the last tag.
** Support for changing between character references and characters.
Need to check that context is one in which character references are
allowed. xmltok prolog parsing will need to distinguish parameter
literals from other kinds of literal.
** Provide a comment command to bind to M-; that works better than the
normal one.
** Make indenting in a multi-line comment work.
** Structure view. Separate buffer displaying element tree. Be able to
navigate from structure view to document and vice-versa.
** Flash matching >.
** Smart selection command that selects increasingly large syntactically
coherent chunks of XML. If point is in an attribute value, first
select complete value; then if command is repeated, select value plus
delimiters, then select attribute name as well, then complete
start-tag, then complete element, then enclosing element, etc.
** ispell integration.
** Block-level items in mixed content should be indented, e.g:
<para>This is list:
<ul>
<li>item</li>
** Provide option to indent like this:
** <para>This is a paragraph
occupying multiple lines.</para>
** Option to add make a / that closes a start-tag electrically insert a
space for the XHTML guys.
** C-M-q should work.
* Datatypes
** Figure out workaround for CJK characters with regexps.
** Does category C contain Cn?
** Do ENTITY datatype properly.
* XML Parsing Library
** Parameter entity parsing option, nil (never), t (always),
unless-standalone (unless standalone="yes" in XML declaration).
** When a file is currently being edited, there should be an option to
use its buffer instead of the on-disk copy.
* Handling all XML features
** Provide better support for editing external general parsed entities.
Perhaps provide a way to force ignoring undefined entities; maybe turn
this on automatically with <?xml encoding=""?> (with no version
pseudo-att).
** Handle internal general entity declarations containing elements.
** Handle external general entity declarations.
** Handle default attribute declarations in internal subset.
** Handle parameter entities (including DTD).
* RELAX NG
** Do complete schema checking, at least optionally.
** Detect include/external loops during schema parse.
** Coding system detection for schemas. Should use utf-8/utf-16 per the
spec. But also need to allow encodings other than UTF-8/16 to support
CJK charsets that Emacs cannot represent in Unicode.
* Catching XML errors
** Check public identifiers.
** Check default attribute values.
* Performance
** Explore whether overlay-recenter can cure overlays performance
problems.
** Cache schemas. Need to have list of files and mtimes.
** Make it possible to reduce rng-validate-chunk-size significantly,
perhaps to 500 bytes, without bad performance impact: don't do
redisplay on every chunk; pass continue functions on other uses of
rng-do-some-validation.
** Cache after first tag.
** Introduce a new name class that is a choice between names (so that
we can use member)
** intern-choice should simplify after patterns with same 1st/2nd args
** Large numbers of overlays slow things down dramatically. Represent
errors using text properties. This implies we cannot incrementally
keep track of the number of errors, in order to determine validity.
Instead, when validation completes, scan for any characters with an
error text property; this seems to be fast enough even with large
buffers. Problem with error at end of buffer, where there's no
character; need special variable for this. Need to merge face from
font-lock with the error face: use :inherit attribute with list of two
faces. How do we avoid making rng-valid depend on nxml-mode?
* Error recovery
** Don't stop at newline in looking for close of start-tag.
** Use indentation to guide recovery from mismatched end-tags
** Don't keep parsing when currently not well-formed but previously
well-formed
** Try to recover from a bad start-tag by popping an open element if
there was a mismatched end-tag unaccounted for.
** Try to recover from a bad start-tag open on the hypothesis that there
was an error in the namespace URI.
** Better recovery from ill-formed XML declarations.
* Useability improvements
** Should print a "Parsing..." message during long movements.
** Provide better position for reference to undefined pattern error.
** Put Well-formed in the mode-line when validating against any-content.
** Trim marking of illegal data for leading and trailing whitespace.
** Show Invalid status as soon as we are sure it's invalid, rather than
waiting for everything to be completely up to date.
** When narrowed, Valid or Invalid status should probably consider only
validity of narrowed region.
* Bug fixes
** Need to give an error for a document like: <foo/><![CDATA[ ]]>
** Make nxml-forward-balanced-item work better for the prolog.
** Make filling and indenting comments work in the prolog.
** Should delete RNC Input buffers.
** Figure out what regex use for NCName and use it consistently,
** Should have not-well-formed tokens in ref.
** Require version in XML declaration? Probably not because prevents
use for external parsed entities. At least forbid standalone
without version.
** Reject schema that compiles to rng-not-allowed-ipattern.
** Move point backwards on schema parse error so that it's on the right token.
* Internal
** Use rng-quote-string consistently.
** Use parsing library for XML to texinfo conversion.
** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of
xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to
nxml-t-token-start.
** Can we set fill-prefix to nil and rely on indenting?
** xmltok should make available replacement text of entities containing
elements
** In rng-valid, instead of using modification-hooks and
insert-behind-hooks on dependent overlays, use same technique as
nxml-mode.
** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on
Mule-UCS); overlays/text properties vs extents; absence of
fontification-functions hook.
* Fontification
** Allow face to depend on element qname, attribute qname, attribute
value. Use list with pairs of (R . F), where R specifies regexps and
F specifies faces. How can this list be made to depend on the
document type?
* Other
** Support RELAX NG XML syntax (use XML parsing library).
** Support W3C XML Schema (use XML parsing library).
** Command to infer schema from current document (like trang).
* Schemas
** XSLT schema should take advantage of RELAX NG to express cooccurrence
constraints on attributes (e.g. xsl:template).
* Documentation
** Move material from README to manual.
** Document encodings.
* Notes
** How can we allow an error to be displayed on a different token from
where it is detected? In particular, for a missing closing ">" we
will need to display it at the beginning of the following token. At
the moment, when we parse the following token the error overlay will
get cleared.
** How should rng-goto-next-error deal with narrowing?
** Perhaps should merge errors having same start position even if they
have different ends.
** How to handle surrogates? One possibility is to be compatible with
utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible
with this.
** Should we distinguish well-formedness errors from invalidity errors?
(I think not: we may want to recover from a bad start-tag by implying
an end-tag.)
** Seems to be a bug with Emacs, where a mouse movement that causes
help-echo text to appear counts as pending input but does not cause
idle timer to be restarted.
** Use XML to represent this file.
** I had a TODO which said simply "split-string". What did I mean?
** Investigate performance on large files all on one line.
* Issues for Emacs versions >= 22
** Take advantage of UTF-8 CJK support.
** Supply a next-error-function.
** Investigate this NEWS item "Emacs now tries to set up buffer coding
systems for HTML/XML files automatically."
** Take advantage of the pointer text property.
** Leverage char-displayable-p.
Local variables:
mode: outline
end:

2
lisp/obsolete/old-whitespace.el
View file

@ -788,7 +788,7 @@ This is meant to be added buffer-locally to `write-file-functions'."
(defun whitespace-unload-function ()
"Unload the whitespace library."
(if (unintern "whitespace-unload-hook")
(if (unintern "whitespace-unload-hook" obarray)
;; if whitespace-unload-hook is defined, let's get rid of it
;; and recursively call `unload-feature'
(progn (unload-feature 'whitespace) t)

606
lisp/progmodes/ada-mode.el
View file

@ -834,10 +834,7 @@ the 4 file locations can be clicked on and jumped to."
;;
;; On Emacs, this is done through the `syntax-table' text property. The
;; corresponding action is applied automatically each time the buffer
;; changes. If `font-lock-mode' is enabled (the default) the action is
;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it
;; manually in `ada-after-change-function'. The proper method is
;; installed by `ada-handle-syntax-table-properties'.
;; changes via syntax-propertize-function.
;;
;; on XEmacs, the `syntax-table' property does not exist and we have to use a
;; slow advice to `parse-partial-sexp' to do the same thing.
@ -937,6 +934,12 @@ declares it as a word constituent."
(insert (caddar change))
(setq change (cdr change)))))))
(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
;; Before `syntax-propertize', we had to use font-lock to apply syntax-table
;; properties, and in some cases we even had to do it manually (in
;; `ada-after-change-function'). `ada-handle-syntax-table-properties'
;; decides which method to use.
(defun ada-set-syntax-table-properties ()
"Assign `syntax-table' properties in accessible part of buffer.
In particular, character constants are said to be strings, #...#
@ -991,6 +994,8 @@ OLD-LEN indicates what the length of the replaced text was."
;; Take care of `syntax-table' properties manually.
(ada-initialize-syntax-table-properties)))
) ;;(not (fboundp 'syntax-propertize))
;;------------------------------------------------------------------
;; Testing the grammatical context
;;------------------------------------------------------------------
@ -1118,7 +1123,8 @@ the file name."
;;;###autoload
(defun ada-mode ()
"Ada mode is the major mode for editing Ada code."
"Ada mode is the major mode for editing Ada code.
\\{ada-mode-map}"
(interactive)
(kill-all-local-variables)
@ -1161,9 +1167,9 @@ the file name."
(set (make-local-variable 'comment-padding) 0)
(set (make-local-variable 'parse-sexp-lookup-properties) t))
(set 'case-fold-search t)
(setq case-fold-search t)
(if (boundp 'imenu-case-fold-search)
(set 'imenu-case-fold-search t))
(setq imenu-case-fold-search t))
(set (make-local-variable 'fill-paragraph-function)
'ada-fill-comment-paragraph)
@ -1186,8 +1192,13 @@ the file name."
'(ada-font-lock-keywords
nil t
((?\_ . "w") (?# . "."))
beginning-of-line
(font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
beginning-of-line))
(if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords))
(set (make-local-variable 'font-lock-syntactic-keywords)
ada-font-lock-syntactic-keywords))
;; Set up support for find-file.el.
(set (make-local-variable 'ff-other-file-alist)
@ -1322,22 +1333,24 @@ the file name."
;; To be run after the hook, in case the user modified
;; ada-fill-comment-prefix
(make-local-variable 'comment-start)
(if ada-fill-comment-prefix
(set 'comment-start ada-fill-comment-prefix)
(set 'comment-start "-- "))
;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs
;; then it was already available before running the hook, and if he
;; modifies it in the hook, he might as well modify comment-start instead.
(set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- "))
;; Run this after the hook to give the users a chance to activate
;; font-lock-mode
(unless (featurep 'xemacs)
(unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
(featurep 'xemacs))
(ada-initialize-syntax-table-properties)
(add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t))
;; the following has to be done after running the ada-mode-hook
;; because users might want to set the values of these variable
;; inside the hook
;; FIXME: it might even be set later on via file-local vars, no?
;; so maybe ada-keywords should be set lazily.
(cond ((eq ada-language-version 'ada83)
(setq ada-keywords ada-83-keywords))
((eq ada-language-version 'ada95)
@ -1397,25 +1410,21 @@ If WORD is not given, then the current word in the buffer is used instead.
The new word is added to the first file in `ada-case-exception-file'.
The standard casing rules will no longer apply to this word."
(interactive)
(let ((previous-syntax-table (syntax-table))
file-name
)
(let ((file-name
(cond ((stringp ada-case-exception-file)
ada-case-exception-file)
((listp ada-case-exception-file)
(car ada-case-exception-file))
(t
(error (concat "No exception file specified. "
"See variable ada-case-exception-file"))))))
(cond ((stringp ada-case-exception-file)
(setq file-name ada-case-exception-file))
((listp ada-case-exception-file)
(setq file-name (car ada-case-exception-file)))
(t
(error (concat "No exception file specified. "
"See variable ada-case-exception-file"))))
(set-syntax-table ada-mode-symbol-syntax-table)
(unless word
(save-excursion
(skip-syntax-backward "w")
(setq word (buffer-substring-no-properties
(point) (save-excursion (forward-word 1) (point))))))
(set-syntax-table previous-syntax-table)
(with-syntax-table ada-mode-symbol-syntax-table
(save-excursion
(skip-syntax-backward "w")
(setq word (buffer-substring-no-properties
(point) (save-excursion (forward-word 1) (point)))))))
;; Reread the exceptions file, in case it was modified by some other,
(ada-case-read-exceptions-from-file file-name)
@ -1425,11 +1434,9 @@ The standard casing rules will no longer apply to this word."
(if (and (not (equal ada-case-exception '()))
(assoc-string word ada-case-exception t))
(setcar (assoc-string word ada-case-exception t) word)
(add-to-list 'ada-case-exception (cons word t))
)
(add-to-list 'ada-case-exception (cons word t)))
(ada-save-exceptions-to-file file-name)
))
(ada-save-exceptions-to-file file-name)))
(defun ada-create-case-exception-substring (&optional word)
"Define the substring WORD as an exception for the casing system.
@ -1464,7 +1471,7 @@ word itself has a special casing."
(modify-syntax-entry ?_ "." (syntax-table))
(save-excursion
(skip-syntax-backward "w")
(set 'word (buffer-substring-no-properties
(setq word (buffer-substring-no-properties
(point)
(save-excursion (forward-word 1) (point))))))
(modify-syntax-entry ?_ (make-string 1 underscore-syntax)
@ -1633,37 +1640,30 @@ ARG is the prefix the user entered with \\[universal-argument]."
(interactive "P")
(if ada-auto-case
(let ((lastk last-command-event)
(previous-syntax-table (syntax-table)))
(let ((lastk last-command-event))
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
(cond ((or (eq lastk ?\n)
(eq lastk ?\r))
;; horrible kludge
(insert " ")
(ada-adjust-case)
;; horrible dekludge
(delete-char -1)
;; some special keys and their bindings
(cond
((eq lastk ?\n)
(funcall ada-lfd-binding))
((eq lastk ?\r)
(funcall ada-ret-binding))))
((eq lastk ?\C-i) (ada-tab))
;; Else just insert the character
((self-insert-command (prefix-numeric-value arg))))
;; if there is a keyword in front of the underscore
;; then it should be part of an identifier (MH)
(if (eq lastk ?_)
(ada-adjust-case t)
(ada-adjust-case))
)
;; Restore the syntax table
(set-syntax-table previous-syntax-table))
)
(with-syntax-table ada-mode-symbol-syntax-table
(cond ((or (eq lastk ?\n)
(eq lastk ?\r))
;; horrible kludge
(insert " ")
(ada-adjust-case)
;; horrible dekludge
(delete-char -1)
;; some special keys and their bindings
(cond
((eq lastk ?\n)
(funcall ada-lfd-binding))
((eq lastk ?\r)
(funcall ada-ret-binding))))
((eq lastk ?\C-i) (ada-tab))
;; Else just insert the character
((self-insert-command (prefix-numeric-value arg))))
;; if there is a keyword in front of the underscore
;; then it should be part of an identifier (MH)
(if (eq lastk ?_)
(ada-adjust-case t)
(ada-adjust-case))))
;; Else, no auto-casing
(cond
@ -1672,10 +1672,10 @@ ARG is the prefix the user entered with \\[universal-argument]."
((eq last-command-event ?\r)
(funcall ada-ret-binding))
(t
(self-insert-command (prefix-numeric-value arg))))
))
(self-insert-command (prefix-numeric-value arg))))))
(defun ada-activate-keys-for-case ()
;; FIXME: Use post-self-insert-hook instead of changing key bindings.
"Modify the key bindings for all the keys that should readjust the casing."
(interactive)
;; Save original key-bindings to allow swapping ret/lfd
@ -1735,44 +1735,41 @@ Attention: This function might take very long for big regions!"
(let ((begin nil)
(end nil)
(keywordp nil)
(attribp nil)
(previous-syntax-table (syntax-table)))
(attribp nil))
(message "Adjusting case ...")
(unwind-protect
(save-excursion
(set-syntax-table ada-mode-symbol-syntax-table)
(goto-char to)
;;
;; loop: look for all identifiers, keywords, and attributes
;;
(while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
(setq end (match-end 1))
(setq attribp
(and (> (point) from)
(save-excursion
(forward-char -1)
(setq attribp (looking-at "'.[^']")))))
(or
;; do nothing if it is a string or comment
(ada-in-string-or-comment-p)
(progn
;;
;; get the identifier or keyword or attribute
;;
(setq begin (point))
(setq keywordp (looking-at ada-keywords))
(goto-char end)
;;
;; casing according to user-option
;;
(if attribp
(funcall ada-case-attribute -1)
(if keywordp
(funcall ada-case-keyword -1)
(ada-adjust-case-identifier)))
(goto-char begin))))
(message "Adjusting case ... Done"))
(set-syntax-table previous-syntax-table))))
(with-syntax-table ada-mode-symbol-syntax-table
(save-excursion
(goto-char to)
;;
;; loop: look for all identifiers, keywords, and attributes
;;
(while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
(setq end (match-end 1))
(setq attribp
(and (> (point) from)
(save-excursion
(forward-char -1)
(setq attribp (looking-at "'.[^']")))))
(or
;; do nothing if it is a string or comment
(ada-in-string-or-comment-p)
(progn
;;
;; get the identifier or keyword or attribute
;;
(setq begin (point))
(setq keywordp (looking-at ada-keywords))
(goto-char end)
;;
;; casing according to user-option
;;
(if attribp
(funcall ada-case-attribute -1)
(if keywordp
(funcall ada-case-keyword -1)
(ada-adjust-case-identifier)))
(goto-char begin))))
(message "Adjusting case ... Done")))))
(defun ada-adjust-case-buffer ()
"Adjust the case of all words in the whole buffer.
@ -1803,46 +1800,39 @@ ATTENTION: This function might take very long for big buffers!"
(let ((begin nil)
(end nil)
(delend nil)
(paramlist nil)
(previous-syntax-table (syntax-table)))
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
(paramlist nil))
(with-syntax-table ada-mode-symbol-syntax-table
;; check if really inside parameter list
(or (ada-in-paramlist-p)
(error "Not in parameter list"))
;; check if really inside parameter list
(or (ada-in-paramlist-p)
(error "Not in parameter list"))
;; find start of current parameter-list
(ada-search-ignore-string-comment
(concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
(down-list 1)
(backward-char 1)
(setq begin (point))
;; find start of current parameter-list
(ada-search-ignore-string-comment
(concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
(down-list 1)
(backward-char 1)
(setq begin (point))
;; find end of parameter-list
(forward-sexp 1)
(setq delend (point))
(delete-char -1)
(insert "\n")
;; find end of parameter-list
(forward-sexp 1)
(setq delend (point))
(delete-char -1)
(insert "\n")
;; find end of last parameter-declaration
(forward-comment -1000)
(setq end (point))
;; find end of last parameter-declaration
(forward-comment -1000)
(setq end (point))
;; build a list of all elements of the parameter-list
(setq paramlist (ada-scan-paramlist (1+ begin) end))
;; build a list of all elements of the parameter-list
(setq paramlist (ada-scan-paramlist (1+ begin) end))
;; delete the original parameter-list
(delete-region begin delend)
;; delete the original parameter-list
(delete-region begin delend)
;; insert the new parameter-list
(goto-char begin)
(ada-insert-paramlist paramlist))
;; restore syntax-table
(set-syntax-table previous-syntax-table)
)))
;; insert the new parameter-list
(goto-char begin)
(ada-insert-paramlist paramlist))))
(defun ada-scan-paramlist (begin end)
"Scan the parameter list found in between BEGIN and END.
@ -2186,14 +2176,12 @@ Return the new position of point or nil if not found."
Return the calculation that was done, including the reference point
and the offset."
(interactive)
(let ((previous-syntax-table (syntax-table))
(orgpoint (point-marker))
(let ((orgpoint (point-marker))
cur-indent tmp-indent
prev-indent)
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
(with-syntax-table ada-mode-symbol-syntax-table
;; This need to be done here so that the advice is not always
;; activated (this might interact badly with other modes)
@ -2203,14 +2191,14 @@ and the offset."
(save-excursion
(setq cur-indent
;; Not First line in the buffer ?
(if (save-excursion (zerop (forward-line -1)))
(progn
(back-to-indentation)
(ada-get-current-indent))
;; Not First line in the buffer ?
(if (save-excursion (zerop (forward-line -1)))
(progn
(back-to-indentation)
(ada-get-current-indent))
;; first line in the buffer
(list (point-min) 0))))
;; first line in the buffer
(list (point-min) 0))))
;; Evaluate the list to get the column to indent to
;; prev-indent contains the column to indent to
@ -2242,14 +2230,10 @@ and the offset."
(if (< (current-column) (current-indentation))
(back-to-indentation)))
;; restore syntax-table
(set-syntax-table previous-syntax-table)
(if (featurep 'xemacs)
(ad-deactivate 'parse-partial-sexp))
)
(ad-deactivate 'parse-partial-sexp)))
cur-indent
))
cur-indent))
(defun ada-get-current-indent ()
"Return the indentation to use for the current line."
@ -2512,11 +2496,11 @@ and the offset."
(if (looking-at "renames")
(let (pos)
(save-excursion
(set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
(setq pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
(if (and pos
(= (downcase (char-after (car pos))) ?r))
(goto-char (car pos)))
(set 'var 'ada-indent-renames)))
(setq var 'ada-indent-renames)))
(forward-comment -1000)
(if (= (char-before) ?\))
@ -2533,7 +2517,7 @@ and the offset."
(looking-at "\\(function\\|procedure\\)\\>"))
(progn
(backward-word 1)
(set 'num-back 2)
(setq num-back 2)
(looking-at "\\(function\\|procedure\\)\\>")))))
;; The indentation depends of the value of ada-indent-return
@ -4046,8 +4030,7 @@ Point is moved at the beginning of the SEARCH-RE."
(let (found
begin
end
parse-result
(previous-syntax-table (syntax-table)))
parse-result)
;; FIXME: need to pass BACKWARD to search-func!
(unless search-func
@ -4057,67 +4040,65 @@ Point is moved at the beginning of the SEARCH-RE."
;; search until found or end-of-buffer
;; We have to test that we do not look further than limit
;;
(set-syntax-table ada-mode-symbol-syntax-table)
(while (and (not found)
(or (not limit)
(or (and backward (<= limit (point)))
(>= limit (point))))
(funcall search-func search-re limit 1))
(setq begin (match-beginning 0))
(setq end (match-end 0))
(with-syntax-table ada-mode-symbol-syntax-table
(while (and (not found)
(or (not limit)
(or (and backward (<= limit (point)))
(>= limit (point))))
(funcall search-func search-re limit 1))
(setq begin (match-beginning 0))
(setq end (match-end 0))
(setq parse-result (parse-partial-sexp
(save-excursion (beginning-of-line) (point))
(point)))
(setq parse-result (parse-partial-sexp
(save-excursion (beginning-of-line) (point))
(point)))
(cond
;;
;; If inside a string, skip it (and the following comments)
;;
((ada-in-string-p parse-result)
(if (featurep 'xemacs)
(search-backward "\"" nil t)
(goto-char (nth 8 parse-result)))
(unless backward (forward-sexp 1)))
;;
;; If inside a comment, skip it (and the following comments)
;; There is a special code for comments at the end of the file
;;
((ada-in-comment-p parse-result)
(if (featurep 'xemacs)
(progn
(forward-line 1)
(beginning-of-line)
(forward-comment -1))
(goto-char (nth 8 parse-result)))
(unless backward
;; at the end of the file, it is not possible to skip a comment
;; so we just go at the end of the line
(if (forward-comment 1)
(progn
(forward-comment 1000)
(beginning-of-line))
(end-of-line))))
;;
;; directly in front of a comment => skip it, if searching forward
;;
((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
(unless backward (progn (forward-char -1) (forward-comment 1000))))
(cond
;;
;; If inside a string, skip it (and the following comments)
;;
((ada-in-string-p parse-result)
(if (featurep 'xemacs)
(search-backward "\"" nil t)
(goto-char (nth 8 parse-result)))
(unless backward (forward-sexp 1)))
;;
;; If inside a comment, skip it (and the following comments)
;; There is a special code for comments at the end of the file
;;
((ada-in-comment-p parse-result)
(if (featurep 'xemacs)
(progn
(forward-line 1)
(beginning-of-line)
(forward-comment -1))
(goto-char (nth 8 parse-result)))
(unless backward
;; at the end of the file, it is not possible to skip a comment
;; so we just go at the end of the line
(if (forward-comment 1)
(progn
(forward-comment 1000)
(beginning-of-line))
(end-of-line))))
;;
;; directly in front of a comment => skip it, if searching forward
;;
((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
(unless backward (progn (forward-char -1) (forward-comment 1000))))
;;
;; found a parameter-list but should ignore it => skip it
;;
((and (not paramlists) (ada-in-paramlist-p))
(if backward
(search-backward "(" nil t)
(search-forward ")" nil t)))
;;
;; found what we were looking for
;;
(t
(setq found t)))) ; end of loop
(set-syntax-table previous-syntax-table)
;;
;; found a parameter-list but should ignore it => skip it
;;
((and (not paramlists) (ada-in-paramlist-p))
(if backward
(search-backward "(" nil t)
(search-forward ")" nil t)))
;;
;; found what we were looking for
;;
(t
(setq found t))))) ; end of loop
(if found
(cons begin end)
@ -4398,122 +4379,109 @@ of the region. Otherwise, operate only on the current line."
(defun ada-move-to-start ()
"Move point to the matching start of the current Ada structure."
(interactive)
(let ((pos (point))
(previous-syntax-table (syntax-table)))
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
(let ((pos (point)))
(with-syntax-table ada-mode-symbol-syntax-table
(save-excursion
;;
;; do nothing if in string or comment or not on 'end ...;'
;; or if an error occurs during processing
;;
(or
(ada-in-string-or-comment-p)
(and (progn
(or (looking-at "[ \t]*\\<end\\>")
(backward-word 1))
(or (looking-at "[ \t]*\\<end\\>")
(backward-word 1))
(or (looking-at "[ \t]*\\<end\\>")
(error "Not on end ...;")))
(ada-goto-matching-start 1)
(setq pos (point))
(save-excursion
;;
;; do nothing if in string or comment or not on 'end ...;'
;; or if an error occurs during processing
;;
(or
(ada-in-string-or-comment-p)
(and (progn
(or (looking-at "[ \t]*\\<end\\>")
(backward-word 1))
(or (looking-at "[ \t]*\\<end\\>")
(backward-word 1))
(or (looking-at "[ \t]*\\<end\\>")
(error "Not on end ...;")))
(ada-goto-matching-start 1)
(setq pos (point))
;;
;; on 'begin' => go on, according to user option
;;
ada-move-to-declaration
(looking-at "\\<begin\\>")
(ada-goto-decl-start)
(setq pos (point))))
;;
;; on 'begin' => go on, according to user option
;;
ada-move-to-declaration
(looking-at "\\<begin\\>")
(ada-goto-decl-start)
(setq pos (point))))
) ; end of save-excursion
) ; end of save-excursion
;; now really move to the found position
(goto-char pos))
;; restore syntax-table
(set-syntax-table previous-syntax-table))))
;; now really move to the found position
(goto-char pos))))
(defun ada-move-to-end ()
"Move point to the end of the block around point.
Moves to 'begin' if in a declarative part."
(interactive)
(let ((pos (point))
decl-start
(previous-syntax-table (syntax-table)))
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
decl-start)
(with-syntax-table ada-mode-symbol-syntax-table
(save-excursion
(save-excursion
(cond
;; Go to the beginning of the current word, and check if we are
;; directly on 'begin'
((save-excursion
(skip-syntax-backward "w")
(looking-at "\\<begin\\>"))
(ada-goto-matching-end 1)
)
(cond
;; Go to the beginning of the current word, and check if we are
;; directly on 'begin'
((save-excursion
(skip-syntax-backward "w")
(looking-at "\\<begin\\>"))
(ada-goto-matching-end 1))
;; on first line of subprogram body
;; Do nothing for specs or generic instantion, since these are
;; handled as the general case (find the enclosing block)
;; We also need to make sure that we ignore nested subprograms
((save-excursion
(and (skip-syntax-backward "w")
(looking-at "\\<function\\>\\|\\<procedure\\>" )
(ada-search-ignore-string-comment "is\\|;")
(not (= (char-before) ?\;))
))
(skip-syntax-backward "w")
(ada-goto-matching-end 0 t))
;; on first line of subprogram body
;; Do nothing for specs or generic instantion, since these are
;; handled as the general case (find the enclosing block)
;; We also need to make sure that we ignore nested subprograms
((save-excursion
(and (skip-syntax-backward "w")
(looking-at "\\<function\\>\\|\\<procedure\\>" )
(ada-search-ignore-string-comment "is\\|;")
(not (= (char-before) ?\;))
))
(skip-syntax-backward "w")
(ada-goto-matching-end 0 t))
;; on first line of task declaration
((save-excursion
(and (ada-goto-stmt-start)
(looking-at "\\<task\\>" )
(forward-word 1)
(ada-goto-next-non-ws)
(looking-at "\\<body\\>")))
(ada-search-ignore-string-comment "begin" nil nil nil
'word-search-forward))
;; accept block start
((save-excursion
(and (ada-goto-stmt-start)
(looking-at "\\<accept\\>" )))
(ada-goto-matching-end 0))
;; package start
((save-excursion
(setq decl-start (and (ada-goto-decl-start t) (point)))
(and decl-start (looking-at "\\<package\\>")))
(ada-goto-matching-end 1))
;; on first line of task declaration
((save-excursion
(and (ada-goto-stmt-start)
(looking-at "\\<task\\>" )
(forward-word 1)
(ada-goto-next-non-ws)
(looking-at "\\<body\\>")))
(ada-search-ignore-string-comment "begin" nil nil nil
'word-search-forward))
;; accept block start
((save-excursion
(and (ada-goto-stmt-start)
(looking-at "\\<accept\\>" )))
(ada-goto-matching-end 0))
;; package start
((save-excursion
(setq decl-start (and (ada-goto-decl-start t) (point)))
(and decl-start (looking-at "\\<package\\>")))
(ada-goto-matching-end 1))
;; On a "declare" keyword
((save-excursion
(skip-syntax-backward "w")
(looking-at "\\<declare\\>"))
(ada-goto-matching-end 0 t))
;; On a "declare" keyword
((save-excursion
(skip-syntax-backward "w")
(looking-at "\\<declare\\>"))
(ada-goto-matching-end 0 t))
;; inside a 'begin' ... 'end' block
(decl-start
(goto-char decl-start)
(ada-goto-matching-end 0 t))
;; inside a 'begin' ... 'end' block
(decl-start
(goto-char decl-start)
(ada-goto-matching-end 0 t))
;; (hopefully ;-) everything else
(t
(ada-goto-matching-end 1)))
(setq pos (point))
)
;; (hopefully ;-) everything else
(t
(ada-goto-matching-end 1)))
(setq pos (point))
)
;; now really move to the position found
(goto-char pos))
;; restore syntax-table
(set-syntax-table previous-syntax-table))))
;; now really move to the position found
(goto-char pos))))
(defun ada-next-procedure ()
"Move point to next procedure."
@ -4818,7 +4786,7 @@ Moves to 'begin' if in a declarative part."
(if (featurep 'xemacs)
(progn
(define-key ada-mode-map [menu-bar] ada-mode-menu)
(set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
(setq mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
;; -------------------------------------------------------
@ -5040,7 +5008,7 @@ or the spec otherwise."
(ada-find-src-file-in-dir
(file-name-nondirectory (concat name (car suffixes))))))
(if other
(set 'is-spec other)))
(setq is-spec other)))
;; Else search in the current directory
(if (file-exists-p (concat name (car suffixes)))

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

@ -951,7 +951,7 @@ group. The string matched by the first group is highlighted with
(3 antlr-keyword-face)
(4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
antlr-keyword-face
type-face)))
font-lock-type-face)))
(,(lambda (limit)
(antlr-re-search-forward
"\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"

7
lisp/progmodes/autoconf.el
View file

@ -43,9 +43,6 @@
(defvar autoconf-mode-hook nil
"Hook run by `autoconf-mode'.")
(defconst autoconf-font-lock-syntactic-keywords
'(("\\<dnl\\>" 0 '(11))))
(defconst autoconf-definition-regexp
"AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*")
@ -94,8 +91,8 @@ searching backwards at another AC_... command."
"^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+")
(set (make-local-variable 'comment-start) "dnl ")
(set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +")
(set (make-local-variable 'font-lock-syntactic-keywords)
autoconf-font-lock-syntactic-keywords)
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-rules ("\\<dnl\\>" (0 "<"))))
(set (make-local-variable 'font-lock-defaults)
`(autoconf-font-lock-keywords nil nil (("_" . "w"))))
(set (make-local-variable 'imenu-generic-expression)

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

@ -5449,49 +5449,47 @@ comment at the start of cc-engine.el for more info."
(forward-char)
(unless (looking-at c-<-op-cont-regexp)
(while (and
(while (and
(progn
(c-forward-syntactic-ws)
(let ((orig-record-found-types c-record-found-types))
(when (or (and c-record-type-identifiers all-types)
(c-major-mode-is 'java-mode))
;; All encountered identifiers are types, so set the
;; promote flag and parse the type.
(progn
(c-forward-syntactic-ws)
(if (looking-at "\\?")
(forward-char)
(when (looking-at c-identifier-start)
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-type))))
(c-forward-syntactic-ws)
(let ((orig-record-found-types c-record-found-types))
(when (or (and c-record-type-identifiers all-types)
(c-major-mode-is 'java-mode))
;; All encountered identifiers are types, so set the
;; promote flag and parse the type.
(progn
(c-forward-syntactic-ws)
(if (looking-at "\\?")
(forward-char)
(when (looking-at c-identifier-start)
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-type))))
(c-forward-syntactic-ws)
(c-forward-syntactic-ws)
(when (or (looking-at "extends")
(looking-at "super"))
(forward-word)
(c-forward-syntactic-ws)
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-type)
(c-forward-syntactic-ws))))))
(when (or (looking-at "extends")
(looking-at "super"))
(forward-word)
(c-forward-syntactic-ws)
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-type)
(c-forward-syntactic-ws))))))
(setq pos (point))
(setq pos (point))
(or
;; Note: These regexps exploit the match order in \| so
;; that "<>" is matched by "<" rather than "[^>:-]>".
(c-syntactic-re-search-forward
;; Stop on ',', '|', '&', '+' and '-' to catch
;; common binary operators that could be between
;; two comparison expressions "a<b" and "c>d".
"[<;{},|+&-]\\|[>)]"
nil t t)
t))
;; Note: These regexps exploit the match order in \| so
;; that "<>" is matched by "<" rather than "[^>:-]>".
(c-syntactic-re-search-forward
;; Stop on ',', '|', '&', '+' and '-' to catch
;; common binary operators that could be between
;; two comparison expressions "a<b" and "c>d".
"[<;{},|+&-]\\|[>)]"
nil t t))
(cond
((eq (char-before) ?>)
(cond
((eq (char-before) ?>)
;; Either an operator starting with '>' or the end of
;; the angle bracket arglist.
@ -5532,14 +5530,14 @@ comment at the start of cc-engine.el for more info."
(when (or (setq keyword-match
(looking-at c-opt-<>-sexp-key))
(not (looking-at c-keywords-regexp)))
(setq id-start (point))))
(setq id-start (point))))
(setq subres
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-<>-arglist-recur
(and keyword-match
(c-keyword-member
(setq subres
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-<>-arglist-recur
(and keyword-match
(c-keyword-member
(c-keyword-sym (match-string 1))
'c-<>-type-kwds)))))
)))
@ -5560,16 +5558,16 @@ comment at the start of cc-engine.el for more info."
(c-forward-syntactic-ws)
(looking-at c-opt-identifier-concat-key)))
(c-record-ref-id (cons id-start id-end))
(c-record-type-id (cons id-start id-end))))))
t)
(c-record-type-id (cons id-start id-end))))))
t)
((and (not c-restricted-<>-arglists)
(or (and (eq (char-before) ?&)
(not (eq (char-after) ?&)))
(eq (char-before) ?,)))
;; Just another argument. Record the position. The
;; type check stuff that made us stop at it is at
;; the top of the loop.
((and (not c-restricted-<>-arglists)
(or (and (eq (char-before) ?&)
(not (eq (char-after) ?&)))
(eq (char-before) ?,)))
;; Just another argument. Record the position. The
;; type check stuff that made us stop at it is at
;; the top of the loop.
(setq arg-start-pos (cons (point) arg-start-pos)))
(t

20
lisp/progmodes/cfengine.el
View file

@ -83,12 +83,6 @@ This includes those for cfservd as well as cfagent."))
;; File, acl &c in group: { token ... }
("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
(defconst cfengine-font-lock-syntactic-keywords
;; In the main syntax-table, backslash is marked as a punctuation, because
;; of its use in DOS-style directory separators. Here we try to recognize
;; the cases where backslash is used as an escape inside strings.
'(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\")))
(defvar cfengine-imenu-expression
`((nil ,(concat "^[ \t]*" (eval-when-compile
(regexp-opt cfengine-actions t))
@ -237,13 +231,15 @@ to the action header."
(set (make-local-variable 'fill-paragraph-function)
#'cfengine-fill-paragraph)
(define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs)
;; Fixme: Use `font-lock-syntactic-keywords' to set the args of
;; functions in evaluated classes to string syntax, and then obey
;; syntax properties.
(setq font-lock-defaults
'(cfengine-font-lock-keywords nil nil nil beginning-of-line
(font-lock-syntactic-keywords
. cfengine-font-lock-syntactic-keywords)))
'(cfengine-font-lock-keywords nil nil nil beginning-of-line))
;; Fixme: set the args of functions in evaluated classes to string
;; syntax, and then obey syntax properties.
(set (make-local-variable 'syntax-propertize-function)
;; In the main syntax-table, \ is marked as a punctuation, because
;; of its use in DOS-style directory separators. Here we try to
;; recognize the cases where \ is used as an escape inside strings.
(syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
(setq imenu-generic-expression cfengine-imenu-expression)
(set (make-local-variable 'beginning-of-defun-function)
#'cfengine-beginning-of-defun)

33
lisp/progmodes/compile.el
View file

@ -164,7 +164,7 @@ and a string describing how the process finished.")
(defvar compilation-num-errors-found)
(defconst compilation-error-regexp-alist-alist
(defvar compilation-error-regexp-alist-alist
'((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@ -263,9 +263,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; The core of the regexp is the one with *?. It says that a file name
;; can be composed of any non-newline char, but it also rules out some
;; valid but unlikely cases, such as a trailing space or a space
;; followed by a -.
;; followed by a -, or a colon followed by a space.
;; The "in \\|from " exception was added to handle messages from Ruby.
"^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\
\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
\\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
@ -766,12 +768,27 @@ The value can be either 2 -- skip anything less than error, 1 --
skip anything less than warning or 0 -- don't skip any messages.
Note that all messages not positively identified as warning or
info, are considered errors."
:type '(choice (const :tag "Warnings and info" 2)
(const :tag "Info" 1)
(const :tag "None" 0))
:type '(choice (const :tag "Skip warnings and info" 2)
(const :tag "Skip info" 1)
(const :tag "No skip" 0))
:group 'compilation
:version "22.1")
(defun compilation-set-skip-threshold (level)
"Switch the `compilation-skip-threshold' level."
(interactive
(list
(mod (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
(1+ compilation-skip-threshold))
3)))
(setq compilation-skip-threshold level)
(message "Skipping %s"
(case compilation-skip-threshold
(0 "Nothing")
(1 "Info messages")
(2 "Warnings and info"))))
(defcustom compilation-skip-visited nil
"Compilation motion commands skip visited messages if this is t.
Visited messages are ones for which the file, line and column have been jumped
@ -1212,7 +1229,7 @@ Returns the compilation buffer created."
(let* ((name-of-mode
(if (eq mode t)
"compilation"
(replace-regexp-in-string "-mode$" "" (symbol-name mode))))
(replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
(thisdir default-directory)
outwin outbuf)
(with-current-buffer
@ -2377,7 +2394,7 @@ The file-structure looks like this:
(defun compilation-forget-errors ()
;; In case we hit the same file/line specs, we want to recompute a new
;; marker for them, so flush our cache.
(setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
(clrhash compilation-locs)
(setq compilation-gcpro nil)
;; FIXME: the old code reset the directory-stack, so maybe we should
;; put a `directory change' marker of some sort, but where? -stef

8
lisp/progmodes/cperl-mode.el
View file

@ -1840,7 +1840,13 @@ or as help on variables `cperl-tips', `cperl-problems',
(make-local-variable 'cperl-syntax-state)
(setq cperl-syntax-state nil) ; reset syntaxification cache
(if cperl-use-syntax-table-text-property
(progn
(if (boundp 'syntax-propertize-function)
(progn
;; Reset syntaxification cache.
(set (make-local-variable 'cperl-syntax-done-to) nil)
(set (make-local-variable 'syntax-propertize-function)
(lambda (start end)
(goto-char start) (cperl-fontify-syntaxically end))))
(make-local-variable 'parse-sexp-lookup-properties)
;; Do not introduce variable if not needed, we check it!
(set 'parse-sexp-lookup-properties t)

19
lisp/progmodes/fortran.el
View file

@ -483,6 +483,7 @@ The only difference is, it returns t in a case when the default returns nil."
"Maximum highlighting for Fortran mode.
Consists of level 3 plus all other intrinsics not already highlighted.")
(defvar fortran--font-lock-syntactic-keywords)
;; Comments are real pain in Fortran because there is no way to
;; represent the standard comment syntax in an Emacs syntax table.
;; (We can do so for F90-style). Therefore an unmatched quote in a
@ -887,9 +888,11 @@ with no args, if that value is non-nil."
fortran-font-lock-keywords-3
fortran-font-lock-keywords-4)
nil t ((?/ . "$/") ("_$" . "w"))
fortran-beginning-of-subprogram
(font-lock-syntactic-keywords
. fortran-font-lock-syntactic-keywords)))
fortran-beginning-of-subprogram))
(set (make-local-variable 'fortran--font-lock-syntactic-keywords)
(fortran-make-syntax-propertize-function))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-via-font-lock fortran--font-lock-syntactic-keywords))
(set (make-local-variable 'imenu-case-fold-search) t)
(set (make-local-variable 'imenu-generic-expression)
fortran-imenu-generic-expression)
@ -917,11 +920,13 @@ affects all Fortran buffers, and also the default."
(when (eq major-mode 'fortran-mode)
(setq fortran-line-length nchars
fill-column fortran-line-length
new (fortran-font-lock-syntactic-keywords))
new (fortran-make-syntax-propertize-function))
;; Refontify only if necessary.
(unless (equal new font-lock-syntactic-keywords)
(setq font-lock-syntactic-keywords
(fortran-font-lock-syntactic-keywords))
(unless (equal new fortran--font-lock-syntactic-keywords)
(setq fortran--font-lock-syntactic-keywords new)
(setq syntax-propertize-function
(syntax-propertize-via-font-lock new))
(syntax-ppss-flush-cache (point-min))
(if font-lock-mode (font-lock-mode 1))))))
(if global
(buffer-list)

24
lisp/progmodes/gud.el
View file

@ -3123,10 +3123,12 @@ class of the file (using s to separate nested class ids)."
("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face))))
(defvar gdb-script-font-lock-syntactic-keywords
'(("^document\\s-.*\\(\n\\)" (1 "< b"))
("^end\\>"
(0 (unless (eq (match-beginning 0) (point-min))
(defconst gdb-script-syntax-propertize-function
(syntax-propertize-rules
("^document\\s-.*\\(\n\\)" (1 "< b"))
("^end\\(\\>\\)"
(1 (ignore
(unless (eq (match-beginning 0) (point-min))
;; We change the \n in front, which is more difficult, but results
;; in better highlighting. If the doc is empty, the single \n is
;; both the beginning and the end of the docstring, which can't be
@ -3138,10 +3140,9 @@ class of the file (using s to separate nested class ids)."
'syntax-table (eval-when-compile
(string-to-syntax "> b")))
;; Make sure that rehighlighting the previous line won't erase our
;; syntax-table property.
;; syntax-table property and that modifying `end' will.
(put-text-property (1- (match-beginning 0)) (match-end 0)
'font-lock-multiline t)
nil)))))
'syntax-multiline t)))))))
(defun gdb-script-font-lock-syntactic-face (state)
(cond
@ -3239,10 +3240,13 @@ Treats actions as defuns."
#'gdb-script-end-of-defun)
(set (make-local-variable 'font-lock-defaults)
'(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
(font-lock-syntactic-keywords
. gdb-script-font-lock-syntactic-keywords)
(font-lock-syntactic-face-function
. gdb-script-font-lock-syntactic-face))))
. gdb-script-font-lock-syntactic-face)))
;; Recognize docstrings.
(set (make-local-variable 'syntax-propertize-function)
gdb-script-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local))
;;; tooltips for GUD

76
lisp/progmodes/js.el
View file

@ -45,16 +45,16 @@
;;; Code:
(eval-and-compile
(require 'cc-mode)
(require 'font-lock)
(require 'newcomment)
(require 'imenu)
(require 'etags)
(require 'thingatpt)
(require 'easymenu)
(require 'moz nil t)
(require 'json nil t))
(require 'cc-mode)
(require 'font-lock)
(require 'newcomment)
(require 'imenu)
(require 'etags)
(require 'thingatpt)
(require 'easymenu)
(require 'moz nil t)
(require 'json nil t)
(eval-when-compile
(require 'cl)
@ -725,20 +725,19 @@ as if strings, cpp macros, and comments have been removed.
If invoked while inside a macro, it treats the contents of the
macro as normal text."
(unless count (setq count 1))
(let ((saved-point (point))
(search-expr
(cond ((null count)
'(js--re-search-forward-inner regexp bound 1))
((< count 0)
'(js--re-search-backward-inner regexp bound (- count)))
((> count 0)
'(js--re-search-forward-inner regexp bound count)))))
(search-fun
(cond ((< count 0) (setq count (- count))
#'js--re-search-backward-inner)
((> count 0) #'js--re-search-forward-inner)
(t #'ignore))))
(condition-case err
(eval search-expr)
(funcall search-fun regexp bound count)
(search-failed
(goto-char saved-point)
(unless noerror
(error (error-message-string err)))))))
(signal (car err) (cdr err)))))))
(defun js--re-search-backward-inner (regexp &optional bound count)
@ -782,20 +781,7 @@ as if strings, preprocessor macros, and comments have been
removed.
If invoked while inside a macro, treat the macro as normal text."
(let ((saved-point (point))
(search-expr
(cond ((null count)
'(js--re-search-backward-inner regexp bound 1))
((< count 0)
'(js--re-search-forward-inner regexp bound (- count)))
((> count 0)
'(js--re-search-backward-inner regexp bound count)))))
(condition-case err
(eval search-expr)
(search-failed
(goto-char saved-point)
(unless noerror
(error (error-message-string err)))))))
(js--re-search-forward regexp bound noerror (if count (- count) -1)))
(defun js--forward-expression ()
"Move forward over a whole JavaScript expression.
@ -1674,18 +1660,19 @@ This performs fontification according to `js--class-styles'."
;; XXX: Javascript can continue a regexp literal across lines so long
;; as the newline is escaped with \. Account for that in the regexp
;; below.
(defconst js--regexp-literal
(eval-and-compile
(defconst js--regexp-literal
"[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)"
"Regexp matching a JavaScript regular expression literal.
Match groups 1 and 2 are the characters forming the beginning and
end of the literal.")
end of the literal."))
;; we want to match regular expressions only at the beginning of
;; expressions
(defconst js-font-lock-syntactic-keywords
`((,js--regexp-literal (1 "|") (2 "|")))
"Syntactic font lock keywords matching regexps in JavaScript.
See `font-lock-keywords'.")
(defconst js-syntax-propertize-function
(syntax-propertize-rules
;; We want to match regular expressions only at the beginning of
;; expressions.
(js--regexp-literal (1 "\"") (2 "\""))))
;;; Indentation
@ -3317,10 +3304,9 @@ Key bindings:
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
(set (make-local-variable 'font-lock-defaults)
(list js--font-lock-keywords
nil nil nil nil
'(font-lock-syntactic-keywords
. js-font-lock-syntactic-keywords)))
'(js--font-lock-keywords))
(set (make-local-variable 'syntax-propertize-function)
js-syntax-propertize-function)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'parse-sexp-lookup-properties) t)

37
lisp/progmodes/make-mode.el
View file

@ -505,15 +505,16 @@ not be enclosed in { } or ( )."
cpp-font-lock-keywords))
(defconst makefile-font-lock-syntactic-keywords
;; From sh-script.el.
;; A `#' begins a comment in sh when it is unquoted and at the beginning
;; of a word. In the shell, words are separated by metacharacters.
;; The list of special chars is taken from the single-unix spec of the
;; shell command language (under `quoting') but with `$' removed.
'(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_")
;; Change the syntax of a quoted newline so that it does not end a comment.
("\\\\\n" 0 ".")))
(defconst makefile-syntax-propertize-function
(syntax-propertize-rules
;; From sh-script.el.
;; A `#' begins a comment in sh when it is unquoted and at the beginning
;; of a word. In the shell, words are separated by metacharacters.
;; The list of special chars is taken from the single-unix spec of the
;; shell command language (under `quoting') but with `$' removed.
("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
;; Change the syntax of a quoted newline so that it does not end a comment.
("\\\\\n" (0 "."))))
(defvar makefile-imenu-generic-expression
`(("Dependencies" makefile-previous-dependency 1)
@ -872,9 +873,9 @@ Makefile mode can be configured by modifying the following variables:
'(makefile-font-lock-keywords
nil nil
((?$ . "."))
backward-paragraph
(font-lock-syntactic-keywords
. makefile-font-lock-syntactic-keywords)))
backward-paragraph))
(set (make-local-variable 'syntax-propertize-function)
makefile-syntax-propertize-function)
;; Add-log.
(set (make-local-variable 'add-log-current-defun-function)
@ -943,15 +944,9 @@ Makefile mode can be configured by modifying the following variables:
(define-derived-mode makefile-imake-mode makefile-mode "Imakefile"
"An adapted `makefile-mode' that knows about imake."
:syntax-table makefile-imake-mode-syntax-table
(let ((base `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))
new)
;; Remove `font-lock-syntactic-keywords' entry from font-lock-defaults.
(mapc (lambda (elt)
(unless (and (consp elt)
(eq (car elt) 'font-lock-syntactic-keywords))
(setq new (cons elt new))))
base)
(setq font-lock-defaults (nreverse new))))
(set (make-local-variable 'syntax-propertize-function) nil)
(setq font-lock-defaults
`(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))

23
lisp/progmodes/mixal-mode.el
View file

@ -89,7 +89,7 @@
(defvar mixal-mode-syntax-table
(let ((st (make-syntax-table)))
;; We need to do a bit more to make fontlocking for comments work.
;; See mixal-font-lock-syntactic-keywords.
;; See use of syntax-propertize-function.
;; (modify-syntax-entry ?* "<" st)
(modify-syntax-entry ?\n ">" st)
st)
@ -1028,13 +1028,14 @@ EXECUTION-TIME holds info about the time it takes, number or string.")
;;; Font-locking:
(defvar mixal-font-lock-syntactic-keywords
;; Normal comments start with a * in column 0 and end at end of line.
'(("^\\*" (0 '(11))) ;(string-to-syntax "<") == '(11)
;; Every line can end with a comment which is placed after the operand.
;; I assume here that mnemonics without operands can not have a comment.
("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]"
(1 '(11)))))
(defconst mixal-syntax-propertize-function
(syntax-propertize-rules
;; Normal comments start with a * in column 0 and end at end of line.
("^\\*" (0 "<"))
;; Every line can end with a comment which is placed after the operand.
;; I assume here that mnemonics without operands can not have a comment.
("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]"
(1 "<"))))
(defvar mixal-font-lock-keywords
`(("^\\([A-Z0-9a-z]+\\)"
@ -1110,9 +1111,9 @@ Assumes that file has been compiled with debugging support."
(set (make-local-variable 'comment-start) "*")
(set (make-local-variable 'comment-start-skip) "^\\*[ \t]*")
(set (make-local-variable 'font-lock-defaults)
`(mixal-font-lock-keywords nil nil nil nil
(font-lock-syntactic-keywords . ,mixal-font-lock-syntactic-keywords)
(parse-sexp-lookup-properties . t)))
`(mixal-font-lock-keywords))
(set (make-local-variable 'syntax-propertize-function)
mixal-syntax-propertize-function)
;; might add an indent function in the future
;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line)
(set (make-local-variable 'compile-command) (concat "mixasm "

47
lisp/progmodes/octave-mod.el
View file

@ -179,38 +179,28 @@ parenthetical grouping.")
'(3 font-lock-function-name-face nil t)))
"Additional Octave expressions to highlight.")
(defvar octave-font-lock-syntactic-keywords
(defun octave-syntax-propertize-function (start end)
(goto-char start)
(octave-syntax-propertize-sqs end)
(funcall (syntax-propertize-rules
;; Try to distinguish the string-quotes from the transpose-quotes.
'(("[[({,; ]\\('\\)" (1 "\"'"))
(octave-font-lock-close-quotes)))
("[[({,; ]\\('\\)"
(1 (prog1 "\"'" (octave-syntax-propertize-sqs end)))))
(point) end))
(defun octave-font-lock-close-quotes (limit)
"Fix the syntax-table of the closing quotes of single-quote strings."
;; Freely inspired from perl-font-lock-special-syntactic-constructs.
(let ((state (syntax-ppss)))
(while (< (point) limit)
(cond
((eq (nth 3 state) ?\')
(defun octave-syntax-propertize-sqs (end)
"Propertize the content/end of single-quote strings."
(when (eq (nth 3 (syntax-ppss)) ?\')
;; A '..' string.
(save-excursion
(when (re-search-forward "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)[^']"
nil t)
(goto-char (1- (point)))
;; Remove any syntax-table property we may have applied to
;; some of the (doubled) single quotes within the string.
;; Since these are the only chars on which we place properties,
;; we take a shortcut and just remove all properties.
(remove-text-properties (1+ (nth 8 state)) (match-beginning 1)
'(syntax-table nil))
(when (re-search-forward
"\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move)
(goto-char (match-beginning 2))
(when (eq (char-before (match-beginning 1)) ?\\)
;; Backslash cannot escape a single quote.
(put-text-property (1- (match-beginning 1)) (match-beginning 1)
'syntax-table (string-to-syntax ".")))
(put-text-property (match-beginning 1) (match-end 1)
'syntax-table (string-to-syntax "\"'"))))))
(setq state (parse-partial-sexp (point) limit nil nil state
'syntax-table)))))
'syntax-table (string-to-syntax "\"'")))))
(defcustom inferior-octave-buffer "*Inferior Octave*"
"Name of buffer for running an inferior Octave process."
@ -544,6 +534,8 @@ Non-nil means always go to the next Octave code line after sending."
0)
((:before . "case") octave-block-offset)))
(defvar electric-indent-chars)
;;;###autoload
(define-derived-mode octave-mode prog-mode "Octave"
"Major mode for editing Octave code.
@ -682,9 +674,10 @@ including a reproducible test case and send the message."
(set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill)
(set (make-local-variable 'font-lock-defaults)
'(octave-font-lock-keywords nil nil nil nil
(font-lock-syntactic-keywords . octave-font-lock-syntactic-keywords)
(parse-sexp-lookup-properties . t)))
'(octave-font-lock-keywords))
(set (make-local-variable 'syntax-propertize-function)
#'octave-syntax-propertize-function)
(set (make-local-variable 'imenu-generic-expression)
octave-mode-imenu-generic-expression)

332
lisp/progmodes/perl-mode.el
View file

@ -250,59 +250,76 @@ The expansion is entirely correct because it uses the C preprocessor."
;; y /.../.../
;;
;; <file*glob>
(defvar perl-font-lock-syntactic-keywords
;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
`(;; Turn POD into b-style comments
("^\\(=\\)\\sw" (1 "< b"))
("^=cut[ \t]*\\(\n\\)" (1 "> b"))
;; Catch ${ so that ${var} doesn't screw up indentation.
;; This also catches $' to handle 'foo$', although it should really
;; check that it occurs inside a '..' string.
("\\(\\$\\)[{']" (1 ". p"))
;; Handle funny names like $DB'stop.
("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
;; format statements
("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7)))
;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
;; Be careful not to match "sub { (...) ... }".
("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
1 '(1))
;; Regexp and funny quotes. Distinguishing a / that starts a regexp
;; match from the division operator is ...interesting.
;; Basically, / is a regexp match if it's preceded by an infix operator
;; (or some similar separator), or by one of the special keywords
;; corresponding to builtin functions that can take their first arg
;; without parentheses. Of course, that presume we're looking at the
;; *opening* slash. We can afford to mis-match the closing ones
;; here, because they will be re-treated separately later in
;; perl-font-lock-special-syntactic-constructs.
(,(concat "\\(?:\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
(regexp-opt '("split" "if" "unless" "until" "while" "split"
"grep" "map" "not" "or" "and"))
"\\)\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
(2 (if (and (match-end 1)
(save-excursion
(goto-char (match-end 1))
;; Not 100% correct since we haven't finished setting up
;; the syntax-table before point, but better than nothing.
(forward-comment (- (point-max)))
(put-text-property (point) (match-end 2)
'jit-lock-defer-multiline t)
(not (memq (char-before)
'(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
nil ;; A division sign instead of a regexp-match.
'(7))))
("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
;; Nasty cases:
;; /foo/m $a->m $#m $m @m %m
;; \s (appears often in regexps).
;; -s file
(3 (if (assoc (char-after (match-beginning 3))
perl-quote-like-pairs)
'(15) '(7))))
;; Find and mark the end of funny quotes and format statements.
(perl-font-lock-special-syntactic-constructs)
))
(defun perl-syntax-propertize-function (start end)
(let ((case-fold-search nil))
(goto-char start)
(perl-syntax-propertize-special-constructs end)
;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
(funcall
(syntax-propertize-rules
;; Turn POD into b-style comments. Place the cut rule first since it's
;; more specific.
("^=cut\\>.*\\(\n\\)" (1 "> b"))
("^\\(=\\)\\sw" (1 "< b"))
;; Catch ${ so that ${var} doesn't screw up indentation.
;; This also catches $' to handle 'foo$', although it should really
;; check that it occurs inside a '..' string.
("\\(\\$\\)[{']" (1 ". p"))
;; Handle funny names like $DB'stop.
("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
;; format statements
("^[ \t]*format.*=[ \t]*\\(\n\\)"
(1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
;; Be careful not to match "sub { (...) ... }".
("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
(1 "."))
;; Regexp and funny quotes. Distinguishing a / that starts a regexp
;; match from the division operator is ...interesting.
;; Basically, / is a regexp match if it's preceded by an infix operator
;; (or some similar separator), or by one of the special keywords
;; corresponding to builtin functions that can take their first arg
;; without parentheses. Of course, that presume we're looking at the
;; *opening* slash. We can afford to mis-match the closing ones
;; here, because they will be re-treated separately later in
;; perl-font-lock-special-syntactic-constructs.
((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
(regexp-opt '("split" "if" "unless" "until" "while" "split"
"grep" "map" "not" "or" "and"))
"\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
(2 (ignore
(if (and (match-end 1) ; / at BOL.
(save-excursion
(goto-char (match-end 1))
(forward-comment (- (point-max)))
(put-text-property (point) (match-end 2)
'syntax-multiline t)
(not (memq (char-before)
'(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
nil ;; A division sign instead of a regexp-match.
(put-text-property (match-beginning 2) (match-end 2)
'syntax-table (string-to-syntax "\""))
(perl-syntax-propertize-special-constructs end)))))
("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
;; Nasty cases:
;; /foo/m $a->m $#m $m @m %m
;; \s (appears often in regexps).
;; -s file
;; sub tr {...}
(3 (ignore
(if (save-excursion (goto-char (match-beginning 0))
(forward-word -1)
(looking-at-p "sub[ \t\n]"))
;; This is defining a function.
nil
(put-text-property (match-beginning 3) (match-end 3)
'syntax-table
(if (assoc (char-after (match-beginning 3))
perl-quote-like-pairs)
(string-to-syntax "|")
(string-to-syntax "\"")))
(perl-syntax-propertize-special-constructs end))))))
(point) end)))
(defvar perl-empty-syntax-table
(let ((st (copy-syntax-table)))
@ -321,95 +338,123 @@ The expansion is entirely correct because it uses the C preprocessor."
(modify-syntax-entry close ")" st))
st))
(defun perl-font-lock-special-syntactic-constructs (limit)
;; We used to do all this in a font-lock-syntactic-face-function, which
;; did not work correctly because sometimes some parts of the buffer are
;; treated with font-lock-syntactic-keywords but not with
;; font-lock-syntactic-face-function (mostly because of
;; font-lock-syntactically-fontified). That meant that some syntax-table
;; properties were missing. So now we do the parse-partial-sexp loop
;; ourselves directly from font-lock-syntactic-keywords, so we're sure
;; it's done when necessary.
(defun perl-syntax-propertize-special-constructs (limit)
"Propertize special constructs like regexps and formats."
(let ((state (syntax-ppss))
char)
(while (< (point) limit)
(cond
((or (null (setq char (nth 3 state)))
(and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
;; Normal text, or comment, or docstring, or normal string.
nil)
((eq (nth 3 state) ?\n)
;; A `format' command.
(save-excursion
(when (and (re-search-forward "^\\s *\\.\\s *$" nil t)
(not (eobp)))
(put-text-property (point) (1+ (point)) 'syntax-table '(7)))))
(t
;; This is regexp like quote thingy.
(setq char (char-after (nth 8 state)))
(save-excursion
(let ((twoargs (save-excursion
(goto-char (nth 8 state))
(skip-syntax-backward " ")
(skip-syntax-backward "w")
(member (buffer-substring
(point) (progn (forward-word 1) (point)))
'("tr" "s" "y"))))
(close (cdr (assq char perl-quote-like-pairs)))
(pos (point))
(st (perl-quote-syntax-table char)))
(if (not close)
;; The closing char is the same as the opening char.
(with-syntax-table st
(parse-partial-sexp (point) (point-max)
nil nil state 'syntax-table)
(when twoargs
(parse-partial-sexp (point) (point-max)
nil nil state 'syntax-table)))
;; The open/close chars are matched like () [] {} and <>.
(let ((parse-sexp-lookup-properties nil))
(condition-case err
(progn
(with-syntax-table st
(goto-char (nth 8 state)) (forward-sexp 1))
(when twoargs
(save-excursion
;; Skip whitespace and make sure that font-lock will
;; refontify the second part in the proper context.
(put-text-property
(point) (progn (forward-comment (point-max)) (point))
'font-lock-multiline t)
;;
(unless
(or (eobp)
(save-excursion
(with-syntax-table
(perl-quote-syntax-table (char-after))
(forward-sexp 1))
(put-text-property pos (line-end-position)
'jit-lock-defer-multiline t)
(looking-at "\\s-*\\sw*e")))
(put-text-property (point) (1+ (point))
'syntax-table
(if (assoc (char-after)
perl-quote-like-pairs)
'(15) '(7)))))))
;; The arg(s) is not terminated, so it extends until EOB.
(scan-error (goto-char (point-max))))))
;; Point is now right after the arg(s).
;; Erase any syntactic marks within the quoted text.
(put-text-property pos (1- (point)) 'syntax-table nil)
(when (eq (char-before (1- (point))) ?$)
(put-text-property (- (point) 2) (1- (point))
'syntax-table '(1)))
(put-text-property (1- (point)) (point)
'syntax-table (if close '(15) '(7)))))))
(setq state (parse-partial-sexp (point) limit nil nil state
'syntax-table))))
;; Tell font-lock that this needs not further processing.
nil)
(cond
((or (null (setq char (nth 3 state)))
(and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
;; Normal text, or comment, or docstring, or normal string.
nil)
((eq (nth 3 state) ?\n)
;; A `format' command.
(when (re-search-forward "^\\s *\\.\\s *\n" limit 'move)
(put-text-property (1- (point)) (point)
'syntax-table (string-to-syntax "\""))))
(t
;; This is regexp like quote thingy.
(setq char (char-after (nth 8 state)))
(let ((twoargs (save-excursion
(goto-char (nth 8 state))
(skip-syntax-backward " ")
(skip-syntax-backward "w")
(member (buffer-substring
(point) (progn (forward-word 1) (point)))
'("tr" "s" "y"))))
(close (cdr (assq char perl-quote-like-pairs)))
(st (perl-quote-syntax-table char)))
(when (with-syntax-table st
(if close
;; For paired delimiters, Perl allows nesting them, but
;; since we treat them as strings, Emacs does not count
;; those delimiters in `state', so we don't know how deep
;; we are: we have to go back to the beginning of this
;; "string" and count from there.
(condition-case nil
(progn
;; Start after the first char since it doesn't have
;; paren-syntax (an alternative would be to let-bind
;; parse-sexp-lookup-properties).
(goto-char (1+ (nth 8 state)))
(up-list 1)
t)
(scan-error nil))
(not (or (nth 8 (parse-partial-sexp
(point) limit nil nil state 'syntax-table))
;; If we have a self-paired opener and a twoargs
;; command, the form is s/../../ so we have to skip
;; a second time.
;; In the case of s{...}{...}, we only handle the
;; first part here and the next below.
(when (and twoargs (not close))
(nth 8 (parse-partial-sexp
(point) limit
nil nil state 'syntax-table)))))))
;; Point is now right after the arg(s).
(when (eq (char-before (1- (point))) ?$)
(put-text-property (- (point) 2) (1- (point))
'syntax-table '(1)))
(put-text-property (1- (point)) (point)
'syntax-table
(if close
(string-to-syntax "|")
(string-to-syntax "\"")))
;; If we have two args with a non-self-paired starter (e.g.
;; s{...}{...}) we're right after the first arg, so we still have to
;; handle the second part.
(when (and twoargs close)
;; Skip whitespace and make sure that font-lock will
;; refontify the second part in the proper context.
(put-text-property
(point) (progn (forward-comment (point-max)) (point))
'syntax-multiline t)
;;
(when (< (point) limit)
(put-text-property (point) (1+ (point))
'syntax-table
(if (assoc (char-after)
perl-quote-like-pairs)
;; Put an `e' in the cdr to mark this
;; char as "second arg starter".
(string-to-syntax "|e")
(string-to-syntax "\"e")))
(forward-char 1)
;; Re-use perl-syntax-propertize-special-constructs to handle the
;; second part (the first delimiter of second part can't be
;; preceded by "s" or "tr" or "y", so it will not be considered
;; as twoarg).
(perl-syntax-propertize-special-constructs limit)))))))))
(defun perl-font-lock-syntactic-face-function (state)
(cond
((and (nth 3 state)
(eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
;; This is a second-arg of s{..}{...} form; let's check if this second
;; arg is executable code rather than a string. For that, we need to
;; look for an "e" after this second arg, so we have to hunt for the
;; end of the arg. Depending on whether the whole arg has already
;; been syntax-propertized or not, the end-char will have different
;; syntaxes, so let's ignore syntax-properties temporarily so we can
;; pretend it has not been syntax-propertized yet.
(let* ((parse-sexp-lookup-properties nil)
(char (char-after (nth 8 state)))
(paired (assq char perl-quote-like-pairs)))
(with-syntax-table (perl-quote-syntax-table char)
(save-excursion
(if (not paired)
(parse-partial-sexp (point) (point-max)
nil nil state 'syntax-table)
(condition-case nil
(progn
(goto-char (1+ (nth 8 state)))
(up-list 1))
(scan-error (goto-char (point-max)))))
(put-text-property (nth 8 state) (point)
'jit-lock-defer-multiline t)
(looking-at "[ \t]*\\sw*e")))))
nil)
(t (funcall (default-value 'font-lock-syntactic-face-function) state))))
(defcustom perl-indent-level 4
"*Indentation of Perl statements with respect to containing block."
@ -574,9 +619,12 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
perl-font-lock-keywords-1
perl-font-lock-keywords-2)
nil nil ((?\_ . "w")) nil
(font-lock-syntactic-keywords
. perl-font-lock-syntactic-keywords)
(parse-sexp-lookup-properties . t)))
(font-lock-syntactic-face-function
. perl-font-lock-syntactic-face-function)))
(set (make-local-variable 'syntax-propertize-function)
#'perl-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
;; Tell imenu how to handle Perl.
(set (make-local-variable 'imenu-generic-expression)
perl-imenu-generic-expression)

94
lisp/progmodes/python.el
View file

@ -166,29 +166,32 @@
symbol-end)
. font-lock-builtin-face)))
(defconst python-font-lock-syntactic-keywords
(defconst python-syntax-propertize-function
;; Make outer chars of matching triple-quote sequences into generic
;; string delimiters. Fixme: Is there a better way?
;; First avoid a sequence preceded by an odd number of backslashes.
`((,(rx (not (any ?\\))
?\\ (* (and ?\\ ?\\))
(group (syntax string-quote))
(backref 1)
(group (backref 1)))
(2 ,(string-to-syntax "\""))) ; dummy
(,(rx (group (optional (any "uUrR"))) ; prefix gets syntax property
(optional (any "rR")) ; possible second prefix
(group (syntax string-quote)) ; maybe gets property
(backref 2) ; per first quote
(group (backref 2))) ; maybe gets property
(1 (python-quote-syntax 1))
(2 (python-quote-syntax 2))
(3 (python-quote-syntax 3)))
;; This doesn't really help.
;;; (,(rx (and ?\\ (group ?\n))) (1 " "))
))
(syntax-propertize-rules
(;; (rx (not (any ?\\))
;; ?\\ (* (and ?\\ ?\\))
;; (group (syntax string-quote))
;; (backref 1)
;; (group (backref 1)))
;; ¡Backrefs don't work in syntax-propertize-rules!
"[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)"
(2 "\"")) ; dummy
(;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property
;; (optional (any "rR")) ; possible second prefix
;; (group (syntax string-quote)) ; maybe gets property
;; (backref 2) ; per first quote
;; (group (backref 2))) ; maybe gets property
;; ¡Backrefs don't work in syntax-propertize-rules!
"\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)"
(3 (ignore (python-quote-syntax))))
;; This doesn't really help.
;;((rx (and ?\\ (group ?\n))) (1 " "))
))
(defun python-quote-syntax (n)
(defun python-quote-syntax ()
"Put `syntax-table' property correctly on triple quote.
Used for syntactic keywords. N is the match number (1, 2 or 3)."
;; Given a triple quote, we have to check the context to know
@ -206,28 +209,25 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
;; x '"""' x """ \"""" x
(save-excursion
(goto-char (match-beginning 0))
(cond
;; Consider property for the last char if in a fenced string.
((= n 3)
(let* ((font-lock-syntactic-keywords nil)
(syntax (syntax-ppss)))
(when (eq t (nth 3 syntax)) ; after unclosed fence
(goto-char (nth 8 syntax)) ; fence position
(skip-chars-forward "uUrR") ; skip any prefix
;; Is it a matching sequence?
(if (eq (char-after) (char-after (match-beginning 2)))
(eval-when-compile (string-to-syntax "|"))))))
;; Consider property for initial char, accounting for prefixes.
((or (and (= n 2) ; leading quote (not prefix)
(= (match-beginning 1) (match-end 1))) ; prefix is null
(and (= n 1) ; prefix
(/= (match-beginning 1) (match-end 1)))) ; non-empty
(let ((font-lock-syntactic-keywords nil))
(unless (eq 'string (syntax-ppss-context (syntax-ppss)))
(eval-when-compile (string-to-syntax "|")))))
;; Otherwise (we're in a non-matching string) the property is
;; nil, which is OK.
)))
(let ((syntax (save-match-data (syntax-ppss))))
(cond
((eq t (nth 3 syntax)) ; after unclosed fence
;; Consider property for the last char if in a fenced string.
(goto-char (nth 8 syntax)) ; fence position
(skip-chars-forward "uUrR") ; skip any prefix
;; Is it a matching sequence?
(if (eq (char-after) (char-after (match-beginning 2)))
(put-text-property (match-beginning 3) (match-end 3)
'syntax-table (string-to-syntax "|"))))
((match-end 1)
;; Consider property for initial char, accounting for prefixes.
(put-text-property (match-beginning 1) (match-end 1)
'syntax-table (string-to-syntax "|")))
(t
;; Consider property for initial char, accounting for prefixes.
(put-text-property (match-beginning 2) (match-end 2)
'syntax-table (string-to-syntax "|"))))
)))
;; This isn't currently in `font-lock-defaults' as probably not worth
;; it -- we basically only mess with a few normally-symbol characters.
@ -2495,12 +2495,12 @@ with skeleton expansions for compound statement templates.
:group 'python
(set (make-local-variable 'font-lock-defaults)
'(python-font-lock-keywords nil nil nil nil
(font-lock-syntactic-keywords
. python-font-lock-syntactic-keywords)
;; This probably isn't worth it.
;; (font-lock-syntactic-face-function
;; . python-font-lock-syntactic-face-function)
))
;; This probably isn't worth it.
;; (font-lock-syntactic-face-function
;; . python-font-lock-syntactic-face-function)
))
(set (make-local-variable 'syntax-propertize-function)
python-syntax-propertize-function)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'comment-start) "# ")

388
lisp/progmodes/ruby-mode.el
View file

@ -100,17 +100,10 @@
(defconst ruby-block-end-re "\\<end\\>")
(defconst ruby-here-doc-beg-re
(eval-and-compile
(defconst ruby-here-doc-beg-re
"\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
"Regexp to match the beginning of a heredoc.")
(defconst ruby-here-doc-end-re
"^\\([ \t]+\\)?\\(.*\\)\\(.\\)$"
"Regexp to match the end of heredocs.
This will actually match any line with one or more characters.
It's useful in that it divides up the match string so that
`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
"Regexp to match the beginning of a heredoc."))
(defun ruby-here-doc-end-match ()
"Return a regexp to find the end of a heredoc.
@ -123,18 +116,6 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(match-string 5)
(match-string 6)))))
(defun ruby-here-doc-beg-match ()
"Return a regexp to find the beginning of a heredoc.
This should only be called after matching against `ruby-here-doc-end-re'."
(let ((contents (regexp-quote (concat (match-string 2) (match-string 3)))))
(concat "<<"
(let ((match (match-string 1)))
(if (and match (> (length match) 0))
(concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" (match-string 1) "\\)"
contents "\\b\\(\\1\\|\\2\\)")
(concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
(defconst ruby-delimiter
(concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\("
ruby-block-beg-re
@ -362,7 +343,7 @@ Also ignores spaces after parenthesis when 'space."
(back-to-indentation)
(current-column)))
(defun ruby-indent-line (&optional flag)
(defun ruby-indent-line (&optional ignored)
"Correct the indentation of the current Ruby line."
(interactive)
(ruby-indent-to (ruby-calculate-indent)))
@ -405,8 +386,7 @@ and `\\' when preceded by `?'."
"TODO: document."
(save-excursion
(store-match-data nil)
(let ((space (skip-chars-backward " \t"))
(start (point)))
(let ((space (skip-chars-backward " \t")))
(cond
((bolp) t)
((progn
@ -700,7 +680,7 @@ and `\\' when preceded by `?'."
(beginning-of-line)
(let ((ruby-indent-point (point))
(case-fold-search nil)
state bol eol begin op-end
state eol begin op-end
(paren (progn (skip-syntax-forward " ")
(and (char-after) (matching-paren (char-after)))))
(indent 0))
@ -780,7 +760,6 @@ and `\\' when preceded by `?'."
(if (re-search-forward "^\\s *#" end t)
(beginning-of-line)
(setq done t))))
(setq bol (point))
(end-of-line)
;; skip the comment at the end
(skip-chars-backward " \t")
@ -1037,10 +1016,8 @@ With ARG, do it many times. Negative ARG means move forward."
(ruby-beginning-of-defun)
(re-search-backward "^\n" (- (point) 1) t))
(defun ruby-indent-exp (&optional shutup-p)
"Indent each line in the balanced expression following the point.
If a prefix arg is given or SHUTUP-P is non-nil, no errors
are signalled if a balanced expression isn't found."
(defun ruby-indent-exp (&optional ignored)
"Indent each line in the balanced expression following the point."
(interactive "*P")
(let ((here (point-marker)) start top column (nest t))
(set-marker-insertion-type here t)
@ -1133,58 +1110,208 @@ See `add-log-current-defun-function'."
(if mlist (concat mlist mname) mname)
mlist)))))
(defconst ruby-font-lock-syntactic-keywords
`(;; #{ }, #$hoge, #@foo are not comments
("\\(#\\)[{$@]" 1 (1 . nil))
;; the last $', $", $` in the respective string is not variable
;; the last ?', ?", ?` in the respective string is not ascii code
("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
(2 (7 . nil))
(4 (7 . nil)))
;; $' $" $` .... are variables
;; ?' ?" ?` are ascii codes
("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
;; regexps
("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
(4 (7 . ?/))
(6 (7 . ?/)))
("^=en\\(d\\)\\_>" 1 "!")
("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
;; Currently, the following case is highlighted incorrectly:
;;
;; <<FOO
;; FOO
;; <<BAR
;; <<BAZ
;; BAZ
;; BAR
;;
;; This is because all here-doc beginnings are highlighted before any endings,
;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
;; it thinks <<BAR is part of a string so it's marked as well.
;;
;; This may be fixable by modifying ruby-in-here-doc-p to use
;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
;; but I don't want to try that until we've got unit tests set up
;; to make sure I don't break anything else.
(,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
(ruby-here-doc-beg-syntax))
(,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
"Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.")
(if (eval-when-compile (fboundp #'syntax-propertize-rules))
;; New code that works independently from font-lock.
(progn
(defun ruby-syntax-propertize-function (start end)
"Syntactic keywords for Ruby mode. See `syntax-propertize-function'."
(goto-char start)
(ruby-syntax-propertize-heredoc end)
(funcall
(syntax-propertize-rules
;; #{ }, #$hoge, #@foo are not comments
("\\(#\\)[{$@]" (1 "."))
;; the last $', $", $` in the respective string is not variable
;; the last ?', ?", ?` in the respective string is not ascii code
("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
(2 "\"")
(4 "\""))
;; $' $" $` .... are variables
;; ?' ?" ?` are ascii codes
("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" (3 "."))
;; regexps
("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
(4 "\"/")
(6 "\"/"))
("^=en\\(d\\)\\_>" (1 "!"))
("^\\(=\\)begin\\_>" (1 "!"))
;; Handle here documents.
((concat ruby-here-doc-beg-re ".*\\(\n\\)")
(7 (prog1 "\"" (ruby-syntax-propertize-heredoc end)))))
(point) end))
(defun ruby-comment-beg-syntax ()
"Return the syntax cell for a the first character of a =begin.
(defun ruby-syntax-propertize-heredoc (limit)
(let ((ppss (syntax-ppss))
(res '()))
(when (eq ?\n (nth 3 ppss))
(save-excursion
(goto-char (nth 8 ppss))
(beginning-of-line)
(while (re-search-forward ruby-here-doc-beg-re
(line-end-position) t)
(push (concat (ruby-here-doc-end-match) "\n") res)))
(let ((start (point)))
;; With multiple openers on the same line, we don't know in which
;; part `start' is, so we have to go back to the beginning.
(when (cdr res)
(goto-char (nth 8 ppss))
(setq res (nreverse res)))
(while (and res (re-search-forward (pop res) limit 'move))
(if (null res)
(put-text-property (1- (point)) (point)
'syntax-table (string-to-syntax "\""))))
;; Make extra sure we don't move back, lest we could fall into an
;; inf-loop.
(if (< (point) start) (goto-char start))))))
)
;; For Emacsen where syntax-propertize-rules is not (yet) available,
;; fallback on the old font-lock-syntactic-keywords stuff.
(defconst ruby-here-doc-end-re
"^\\([ \t]+\\)?\\(.*\\)\\(\n\\)"
"Regexp to match the end of heredocs.
This will actually match any line with one or more characters.
It's useful in that it divides up the match string so that
`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
(defun ruby-here-doc-beg-match ()
"Return a regexp to find the beginning of a heredoc.
This should only be called after matching against `ruby-here-doc-end-re'."
(let ((contents (regexp-quote (match-string 2))))
(concat "<<"
(let ((match (match-string 1)))
(if (and match (> (length match) 0))
(concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" match "\\)"
contents "\\b\\(\\1\\|\\2\\)")
(concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
(defconst ruby-font-lock-syntactic-keywords
`( ;; #{ }, #$hoge, #@foo are not comments
("\\(#\\)[{$@]" 1 (1 . nil))
;; the last $', $", $` in the respective string is not variable
;; the last ?', ?", ?` in the respective string is not ascii code
("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
(2 (7 . nil))
(4 (7 . nil)))
;; $' $" $` .... are variables
;; ?' ?" ?` are ascii codes
("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
;; regexps
("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
(4 (7 . ?/))
(6 (7 . ?/)))
("^=en\\(d\\)\\_>" 1 "!")
("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
;; Currently, the following case is highlighted incorrectly:
;;
;; <<FOO
;; FOO
;; <<BAR
;; <<BAZ
;; BAZ
;; BAR
;;
;; This is because all here-doc beginnings are highlighted before any endings,
;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
;; it thinks <<BAR is part of a string so it's marked as well.
;;
;; This may be fixable by modifying ruby-in-here-doc-p to use
;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
;; but I don't want to try that until we've got unit tests set up
;; to make sure I don't break anything else.
(,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
(ruby-here-doc-beg-syntax))
(,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
"Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.")
(defun ruby-comment-beg-syntax ()
"Return the syntax cell for a the first character of a =begin.
See the definition of `ruby-font-lock-syntactic-keywords'.
This returns a comment-delimiter cell as long as the =begin
isn't in a string or another comment."
(when (not (nth 3 (syntax-ppss)))
(string-to-syntax "!")))
(when (not (nth 3 (syntax-ppss)))
(string-to-syntax "!")))
(unless (functionp 'syntax-ppss)
(defun syntax-ppss (&optional pos)
(parse-partial-sexp (point-min) (or pos (point)))))
(defun ruby-in-here-doc-p ()
"Return whether or not the point is in a heredoc."
(save-excursion
(let ((old-point (point)) (case-fold-search nil))
(beginning-of-line)
(catch 'found-beg
(while (re-search-backward ruby-here-doc-beg-re nil t)
(if (not (or (ruby-in-ppss-context-p 'anything)
(ruby-here-doc-find-end old-point)))
(throw 'found-beg t)))))))
(defun ruby-here-doc-find-end (&optional limit)
"Expects the point to be on a line with one or more heredoc openers.
Returns the buffer position at which all heredocs on the line
are terminated, or nil if they aren't terminated before the
buffer position `limit' or the end of the buffer."
(save-excursion
(beginning-of-line)
(catch 'done
(let ((eol (save-excursion (end-of-line) (point)))
(case-fold-search nil)
;; Fake match data such that (match-end 0) is at eol
(end-match-data (progn (looking-at ".*$") (match-data)))
beg-match-data end-re)
(while (re-search-forward ruby-here-doc-beg-re eol t)
(setq beg-match-data (match-data))
(setq end-re (ruby-here-doc-end-match))
(set-match-data end-match-data)
(goto-char (match-end 0))
(unless (re-search-forward end-re limit t) (throw 'done nil))
(setq end-match-data (match-data))
(set-match-data beg-match-data)
(goto-char (match-end 0)))
(set-match-data end-match-data)
(goto-char (match-end 0))
(point)))))
(defun ruby-here-doc-beg-syntax ()
"Return the syntax cell for a line that may begin a heredoc.
See the definition of `ruby-font-lock-syntactic-keywords'.
This sets the syntax cell for the newline ending the line
containing the heredoc beginning so that cases where multiple
heredocs are started on one line are handled correctly."
(save-excursion
(goto-char (match-beginning 0))
(unless (or (ruby-in-ppss-context-p 'non-heredoc)
(ruby-in-here-doc-p))
(string-to-syntax "\""))))
(defun ruby-here-doc-end-syntax ()
"Return the syntax cell for a line that may end a heredoc.
See the definition of `ruby-font-lock-syntactic-keywords'."
(let ((pss (syntax-ppss)) (case-fold-search nil))
;; If we aren't in a string, we definitely aren't ending a heredoc,
;; so we can just give up.
;; This means we aren't doing a full-document search
;; every time we enter a character.
(when (ruby-in-ppss-context-p 'heredoc pss)
(save-excursion
(goto-char (nth 8 pss)) ; Go to the beginning of heredoc.
(let ((eol (point)))
(beginning-of-line)
(if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
(not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
(progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
(not (re-search-forward ruby-here-doc-beg-re eol t))))
(string-to-syntax "\"")))))))
(unless (functionp 'syntax-ppss)
(defun syntax-ppss (&optional pos)
(parse-partial-sexp (point-min) (or pos (point)))))
)
(defun ruby-in-ppss-context-p (context &optional ppss)
(let ((ppss (or ppss (syntax-ppss (point)))))
@ -1195,10 +1322,7 @@ isn't in a string or another comment."
((eq context 'string)
(nth 3 ppss))
((eq context 'heredoc)
(and (nth 3 ppss)
;; If it's generic string, it's a heredoc and we don't care
;; See `parse-partial-sexp'
(not (numberp (nth 3 ppss)))))
(eq ?\n (nth 3 ppss)))
((eq context 'non-heredoc)
(and (ruby-in-ppss-context-p 'anything)
(not (ruby-in-ppss-context-p 'heredoc))))
@ -1210,77 +1334,6 @@ isn't in a string or another comment."
"context name `" (symbol-name context) "' is unknown"))))
t)))
(defun ruby-in-here-doc-p ()
"Return whether or not the point is in a heredoc."
(save-excursion
(let ((old-point (point)) (case-fold-search nil))
(beginning-of-line)
(catch 'found-beg
(while (re-search-backward ruby-here-doc-beg-re nil t)
(if (not (or (ruby-in-ppss-context-p 'anything)
(ruby-here-doc-find-end old-point)))
(throw 'found-beg t)))))))
(defun ruby-here-doc-find-end (&optional limit)
"Expects the point to be on a line with one or more heredoc openers.
Returns the buffer position at which all heredocs on the line
are terminated, or nil if they aren't terminated before the
buffer position `limit' or the end of the buffer."
(save-excursion
(beginning-of-line)
(catch 'done
(let ((eol (save-excursion (end-of-line) (point)))
(case-fold-search nil)
;; Fake match data such that (match-end 0) is at eol
(end-match-data (progn (looking-at ".*$") (match-data)))
beg-match-data end-re)
(while (re-search-forward ruby-here-doc-beg-re eol t)
(setq beg-match-data (match-data))
(setq end-re (ruby-here-doc-end-match))
(set-match-data end-match-data)
(goto-char (match-end 0))
(unless (re-search-forward end-re limit t) (throw 'done nil))
(setq end-match-data (match-data))
(set-match-data beg-match-data)
(goto-char (match-end 0)))
(set-match-data end-match-data)
(goto-char (match-end 0))
(point)))))
(defun ruby-here-doc-beg-syntax ()
"Return the syntax cell for a line that may begin a heredoc.
See the definition of `ruby-font-lock-syntactic-keywords'.
This sets the syntax cell for the newline ending the line
containing the heredoc beginning so that cases where multiple
heredocs are started on one line are handled correctly."
(save-excursion
(goto-char (match-beginning 0))
(unless (or (ruby-in-ppss-context-p 'non-heredoc)
(ruby-in-here-doc-p))
(string-to-syntax "|"))))
(defun ruby-here-doc-end-syntax ()
"Return the syntax cell for a line that may end a heredoc.
See the definition of `ruby-font-lock-syntactic-keywords'."
(let ((pss (syntax-ppss)) (case-fold-search nil))
;; If we aren't in a string, we definitely aren't ending a heredoc,
;; so we can just give up.
;; This means we aren't doing a full-document search
;; every time we enter a character.
(when (ruby-in-ppss-context-p 'heredoc pss)
(save-excursion
(goto-char (nth 8 pss)) ; Go to the beginning of heredoc.
(let ((eol (point)))
(beginning-of-line)
(if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
(not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
(progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
(not (re-search-forward ruby-here-doc-beg-re eol t))))
(string-to-syntax "|")))))))
(if (featurep 'xemacs)
(put 'ruby-mode 'font-lock-defaults
'((ruby-font-lock-keywords)
@ -1377,8 +1430,10 @@ See `font-lock-syntax-table'.")
)
"Additional expressions to highlight in Ruby mode.")
(defvar electric-indent-chars)
;;;###autoload
(defun ruby-mode ()
(define-derived-mode ruby-mode prog-mode "Ruby"
"Major mode for editing Ruby scripts.
\\[ruby-indent-line] properly indents subexpressions of multi-line
class, module, def, if, while, for, do, and case statements, taking
@ -1387,27 +1442,22 @@ nesting into account.
The variable `ruby-indent-level' controls the amount of indentation.
\\{ruby-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map ruby-mode-map)
(setq mode-name "Ruby")
(setq major-mode 'ruby-mode)
(ruby-mode-variables)
(set (make-local-variable 'indent-line-function)
'ruby-indent-line)
(set (make-local-variable 'imenu-create-index-function)
'ruby-imenu-create-index)
(set (make-local-variable 'add-log-current-defun-function)
'ruby-add-log-current-method)
(add-hook
(cond ((boundp 'before-save-hook)
(make-local-variable 'before-save-hook)
'before-save-hook)
(cond ((boundp 'before-save-hook) 'before-save-hook)
((boundp 'write-contents-functions) 'write-contents-functions)
((boundp 'write-contents-hooks) 'write-contents-hooks))
'ruby-mode-set-encoding)
'ruby-mode-set-encoding nil 'local)
(set (make-local-variable 'electric-indent-chars)
(append '(?\{ ?\}) (if (boundp 'electric-indent-chars)
(default-value 'electric-indent-chars))))
(set (make-local-variable 'font-lock-defaults)
'((ruby-font-lock-keywords) nil nil))
@ -1415,12 +1465,12 @@ The variable `ruby-indent-level' controls the amount of indentation.
ruby-font-lock-keywords)
(set (make-local-variable 'font-lock-syntax-table)
ruby-font-lock-syntax-table)
(set (make-local-variable 'font-lock-syntactic-keywords)
ruby-font-lock-syntactic-keywords)
(if (fboundp 'run-mode-hooks)
(run-mode-hooks 'ruby-mode-hook)
(run-hooks 'ruby-mode-hook)))
(if (eval-when-compile (fboundp 'syntax-propertize-rules))
(set (make-local-variable 'syntax-propertize-function)
#'ruby-syntax-propertize-function)
(set (make-local-variable 'font-lock-syntactic-keywords)
ruby-font-lock-syntactic-keywords)))
;;; Invoke ruby-mode when appropriate

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

@ -939,7 +939,6 @@ See `sh-feature'.")
;; These are used for the syntax table stuff (derived from cperl-mode).
;; Note: parse-sexp-lookup-properties must be set to t for it to work.
(defconst sh-st-punc (string-to-syntax "."))
(defconst sh-st-symbol (string-to-syntax "_"))
(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
(defconst sh-escaped-line-re
@ -957,7 +956,7 @@ See `sh-feature'.")
(defvar sh-here-doc-re sh-here-doc-open-re)
(make-variable-buffer-local 'sh-here-doc-re)
(defun sh-font-lock-close-heredoc (bol eof indented)
(defun sh-font-lock-close-heredoc (bol eof indented eol)
"Determine the syntax of the \\n after an EOF.
If non-nil INDENTED indicates that the EOF was indented."
(let* ((eof-re (if eof (regexp-quote eof) ""))
@ -971,6 +970,8 @@ If non-nil INDENTED indicates that the EOF was indented."
(ere (concat "^" (if indented "[ \t]*") eof-re "\n"))
(start (save-excursion
(goto-char bol)
;; FIXME: will incorrectly find a <<EOF embedded inside
;; the heredoc.
(re-search-backward (concat sre "\\|" ere) nil t))))
;; If subgroup 1 matched, we found an open-heredoc, otherwise we first
;; found a close-heredoc which makes the current close-heredoc inoperant.
@ -990,7 +991,7 @@ If non-nil INDENTED indicates that the EOF was indented."
(sh-in-comment-or-string (point)))))
;; No <<EOF2 found after our <<.
(= (point) start)))
sh-here-doc-syntax)
(put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))
((not (or start (save-excursion (re-search-forward sre nil t))))
;; There's no <<EOF either before or after us,
;; so we should remove ourselves from font-lock's keywords.
@ -1000,7 +1001,7 @@ If non-nil INDENTED indicates that the EOF was indented."
(regexp-opt sh-here-doc-markers t) "\\(\n\\)"))
nil))))
(defun sh-font-lock-open-heredoc (start string)
(defun sh-font-lock-open-heredoc (start string eol)
"Determine the syntax of the \\n after a <<EOF.
START is the position of <<.
STRING is the actual word used as delimiter (e.g. \"EOF\").
@ -1030,13 +1031,8 @@ Point is at the beginning of the next line."
;; Don't bother fixing it now, but place a multiline property so
;; that when jit-lock-context-* refontifies the rest of the
;; buffer, it also refontifies the current line with it.
(put-text-property start (point) 'font-lock-multiline t)))
sh-here-doc-syntax))
(defun sh-font-lock-here-doc (limit)
"Search for a heredoc marker."
;; This looks silly, but it's because `sh-here-doc-re' keeps changing.
(re-search-forward sh-here-doc-re limit t))
(put-text-property start (point) 'syntax-multiline t)))
(put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)))
(defun sh-font-lock-quoted-subshell (limit)
"Search for a subshell embedded in a string.
@ -1045,9 +1041,7 @@ subshells can nest."
;; FIXME: This can (and often does) match multiple lines, yet it makes no
;; effort to handle multiline cases correctly, so it ends up being
;; rather flakey.
(when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t)
;; Make sure the " we matched is an opening quote.
(eq ?\" (nth 3 (syntax-ppss))))
(when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote.
;; bingo we have a $( or a ` inside a ""
(let ((char (char-after (point)))
;; `state' can be: double-quote, backquote, code.
@ -1082,8 +1076,7 @@ subshells can nest."
(double-quote nil)
(t (setq state (pop states)))))
(t (error "Internal error in sh-font-lock-quoted-subshell")))
(forward-char 1)))
t))
(forward-char 1)))))
(defun sh-is-quoted-p (pos)
@ -1122,7 +1115,7 @@ subshells can nest."
(when (progn (backward-char 2)
(if (> start (line-end-position))
(put-text-property (point) (1+ start)
'font-lock-multiline t))
'syntax-multiline t))
;; FIXME: The `in' may just be a random argument to
;; a normal command rather than the real `in' keyword.
;; I.e. we should look back to try and find the
@ -1136,40 +1129,44 @@ subshells can nest."
sh-st-punc
nil))
(defun sh-font-lock-flush-syntax-ppss-cache (limit)
;; This should probably be a standard function provided by font-lock.el
;; (or syntax.el).
(syntax-ppss-flush-cache (point))
(goto-char limit)
nil)
(defconst sh-font-lock-syntactic-keywords
;; A `#' begins a comment when it is unquoted and at the beginning of a
;; word. In the shell, words are separated by metacharacters.
;; The list of special chars is taken from the single-unix spec
;; of the shell command language (under `quoting') but with `$' removed.
`(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol)
;; In a '...' the backslash is not escaping.
("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
;; The previous rule uses syntax-ppss, but the subsequent rules may
;; change the syntax, so we have to tell syntax-ppss that the states it
;; has just computed will need to be recomputed.
(sh-font-lock-flush-syntax-ppss-cache)
;; Make sure $@ and $? are correctly recognized as sexps.
("\\$\\([?@]\\)" 1 ,sh-st-symbol)
;; Find HEREDOC starters and add a corresponding rule for the ender.
(sh-font-lock-here-doc
(2 (sh-font-lock-open-heredoc
(match-beginning 0) (match-string 1)) nil t)
(5 (sh-font-lock-close-heredoc
(match-beginning 0) (match-string 4)
(and (match-beginning 3) (/= (match-beginning 3) (match-end 3))))
nil t))
;; Distinguish the special close-paren in `case'.
(")" 0 (sh-font-lock-paren (match-beginning 0)))
;; highlight (possibly nested) subshells inside "" quoted regions correctly.
;; This should be at the very end because it uses syntax-ppss.
(sh-font-lock-quoted-subshell)))
(defun sh-syntax-propertize-function (start end)
(goto-char start)
(while (prog1
(re-search-forward sh-here-doc-re end 'move)
(save-excursion
(save-match-data
(funcall
(syntax-propertize-rules
;; A `#' begins a comment when it is unquoted and at the
;; beginning of a word. In the shell, words are separated by
;; metacharacters. The list of special chars is taken from
;; the single-unix spec of the shell command language (under
;; `quoting') but with `$' removed.
("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
;; In a '...' the backslash is not escaping.
("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
;; Make sure $@ and $? are correctly recognized as sexps.
("\\$\\([?@]\\)" (1 "_"))
;; Distinguish the special close-paren in `case'.
(")" (0 (sh-font-lock-paren (match-beginning 0))))
;; Highlight (possibly nested) subshells inside "" quoted
;; regions correctly.
("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)"
(1 (ignore
;; Save excursion because we want to also apply other
;; syntax-propertize rules within the affected region.
(save-excursion
(sh-font-lock-quoted-subshell end))))))
(prog1 start (setq start (point))) (point)))))
(if (match-beginning 2)
;; FIXME: actually, once we see an heredoc opener, we should just
;; search for its ender without propertizing anything in it.
(sh-font-lock-open-heredoc
(match-beginning 0) (match-string 1) (match-beginning 2))
(sh-font-lock-close-heredoc
(match-beginning 0) (match-string 4)
(and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))
(match-beginning 5)))))
(defun sh-font-lock-syntactic-face-function (state)
(let ((q (nth 3 state)))
@ -1553,9 +1550,12 @@ with your script for an edit-interpret-debug cycle."
sh-font-lock-keywords-1 sh-font-lock-keywords-2)
nil nil
((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
(font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords)
(font-lock-syntactic-face-function
. sh-font-lock-syntactic-face-function)))
(set (make-local-variable 'syntax-propertize-function)
#'sh-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
(set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`)))
(set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p)
(set (make-local-variable 'skeleton-further-elements)

28
lisp/progmodes/simula.el
View file

@ -163,17 +163,18 @@ for SIMULA mode to function correctly."
(defvar simula-mode-syntax-table nil
"Syntax table in SIMULA mode buffers.")
(defconst simula-font-lock-syntactic-keywords
`(;; `comment' directive.
("\\<\\(c\\)omment\\>" 1 "<")
;; end comments
(,(concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
(regexp-opt '("end" "else" "when" "otherwise"))
"\\)\\)")
(1 "< b")
(3 "> b" nil t))
;; non-quoted single-quote char.
("'\\('\\)'" 1 ".")))
(defconst simula-syntax-propertize-function
(syntax-propertize-rules
;; `comment' directive.
("\\<\\(c\\)omment\\>" (1 "<"))
;; end comments
((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
(regexp-opt '("end" "else" "when" "otherwise"))
"\\)\\)")
(1 "< b")
(3 "> b"))
;; non-quoted single-quote char.
("'\\('\\)'" (1 "."))))
;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>.
(defconst simula-font-lock-keywords-1
@ -396,8 +397,9 @@ with no arguments, if that value is non-nil."
(setq font-lock-defaults
'((simula-font-lock-keywords simula-font-lock-keywords-1
simula-font-lock-keywords-2 simula-font-lock-keywords-3)
nil t ((?_ . "w")) nil
(font-lock-syntactic-keywords . simula-font-lock-syntactic-keywords)))
nil t ((?_ . "w"))))
(set (make-local-variable 'syntax-propertize-function)
simula-syntax-propertize-function)
(abbrev-mode 1))
(defun simula-indent-exp ()

703
lisp/progmodes/sql.el
View file

File diff suppressed because it is too large Load diff

13
lisp/progmodes/tcl.el
View file

@ -411,9 +411,10 @@ This variable is generally set from `tcl-proc-regexp',
`tcl-typeword-list', and `tcl-keyword-list' by the function
`tcl-set-font-lock-keywords'.")
(defvar tcl-font-lock-syntactic-keywords
;; Mark the few `#' that are not comment-markers.
'(("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
(defconst tcl-syntax-propertize-function
(syntax-propertize-rules
;; Mark the few `#' that are not comment-markers.
("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
"Syntactic keywords for `tcl-mode'.")
;; FIXME need some way to recognize variables because array refs look
@ -593,9 +594,9 @@ Commands:
(set (make-local-variable 'outline-level) 'tcl-outline-level)
(set (make-local-variable 'font-lock-defaults)
'(tcl-font-lock-keywords nil nil nil beginning-of-defun
(font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords)
(parse-sexp-lookup-properties . t)))
'(tcl-font-lock-keywords nil nil nil beginning-of-defun))
(set (make-local-variable 'syntax-propertize-function)
tcl-syntax-propertize-function)
(set (make-local-variable 'imenu-generic-expression)
tcl-imenu-generic-expression)

18
lisp/progmodes/vhdl-mode.el
View file

@ -4693,8 +4693,15 @@ Key bindings:
(set (make-local-variable 'font-lock-defaults)
(list
'(nil vhdl-font-lock-keywords) nil
(not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
'(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
(not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
(if (eval-when-compile (fboundp 'syntax-propertize-rules))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-rules
;; Mark single quotes as having string quote syntax in
;; 'c' instances.
("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
(set (make-local-variable 'font-lock-syntactic-keywords)
vhdl-font-lock-syntactic-keywords))
(unless vhdl-emacs-21
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
@ -12914,10 +12921,9 @@ This does background highlighting of translate-off regions.")
"Re-initialize fontification and fontify buffer."
(interactive)
(setq font-lock-defaults
(list
'vhdl-font-lock-keywords nil
(not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
'(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
`(vhdl-font-lock-keywords
nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
beginning-of-line))
(when (fboundp 'font-lock-unset-defaults)
(font-lock-unset-defaults)) ; not implemented in XEmacs
(font-lock-set-defaults)

7
lisp/repeat.el
View file

@ -335,7 +335,12 @@ recently executed command not bound to an input event\"."
(setq real-last-command 'repeat)
(setq repeat-undo-count 1)
(unwind-protect
(while (eq (read-event) repeat-repeat-char)
(while (let ((evt (read-event))) ;FIXME: read-key maybe?
;; For clicks, we need to strip the meta-data to
;; check the underlying event name.
(eq (or (car-safe evt) evt)
(or (car-safe repeat-repeat-char)
repeat-repeat-char)))
(repeat repeat-arg))
;; Make sure `repeat-undo-count' is reset.
(setq repeat-undo-count nil))

3
lisp/simple.el
View file

@ -4343,7 +4343,7 @@ into account variable-width characters and line continuation."
(or (and (= (vertical-motion
(cons (or goal-column
(if (consp temporary-goal-column)
(truncate (car temporary-goal-column))
(car temporary-goal-column)
temporary-goal-column))
arg))
arg)
@ -5541,6 +5541,7 @@ The function should return non-nil if the two tokens do not match.")
(if (minibufferp)
(minibuffer-message " [Unmatched parenthesis]")
(message "Unmatched parenthesis"))))
((not blinkpos) nil)
((pos-visible-in-window-p blinkpos)
;; Matching open within window, temporarily move to blinkpos but only
;; if `blink-matching-paren-on-screen' is non-nil.

59
lisp/subr.el
View file

@ -239,7 +239,7 @@ letter but *do not* end with a period. Please follow this convention
for the sake of consistency."
(while t
(signal 'error (list (apply 'format args)))))
(set-advertised-calling-convention 'error '(string &rest args))
(set-advertised-calling-convention 'error '(string &rest args) "23.1")
;; We put this here instead of in frame.el so that it's defined even on
;; systems where frame.el isn't loaded.
@ -1039,9 +1039,10 @@ is converted into a string by expressing it in decimal."
(make-obsolete 'make-variable-frame-local
"explicitly check for a frame-parameter instead." "22.2")
(make-obsolete 'interactive-p 'called-interactively-p "23.2")
(set-advertised-calling-convention 'called-interactively-p '(kind))
(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1")
(set-advertised-calling-convention
'all-completions '(string collection &optional predicate))
'all-completions '(string collection &optional predicate) "23.1")
(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
;;;; Obsolescence declarations for variables, and aliases.
@ -2064,7 +2065,7 @@ floating point support."
(setq read (cons t read)))
(push read unread-command-events)
nil))))))
(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp))
(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1")
;;; Atomic change groups.
@ -2592,7 +2593,7 @@ discouraged."
(start-process name buffer shell-file-name shell-command-switch
(mapconcat 'identity args " ")))
(set-advertised-calling-convention 'start-process-shell-command
'(name buffer command))
'(name buffer command) "23.1")
(defun start-file-process-shell-command (name buffer &rest args)
"Start a program in a subprocess. Return the process object for it.
@ -2603,7 +2604,7 @@ Similar to `start-process-shell-command', but calls `start-file-process'."
(if (file-remote-p default-directory) "-c" shell-command-switch)
(mapconcat 'identity args " ")))
(set-advertised-calling-convention 'start-file-process-shell-command
'(name buffer command))
'(name buffer command) "23.1")
(defun call-process-shell-command (command &optional infile buffer display
&rest args)
@ -3358,6 +3359,52 @@ clone should be incorporated in the clone."
(overlay-put ol2 'evaporate t)
(overlay-put ol2 'text-clones dups)))
;;;; Misc functions moved over from the C side.
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question. Return t if answer is \"y\".
The argument PROMPT is the string to display to ask the question.
It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
No confirmation of the answer is requested; a single character is enough.
Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
the bindings in `query-replace-map'; see the documentation of that variable
for more information. In this case, the useful bindings are `act', `skip',
`recenter', and `quit'.\)
Under a windowing system a dialog box will be used if `last-nonmenu-event'
is nil and `use-dialog-box' is non-nil."
;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
;; where all the keys were unbound (i.e. it somehow got triggered
;; within read-key, apparently). I had to kill it.
(let ((answer 'none)
(xprompt prompt))
(if (and (display-popup-menus-p)
(listp last-nonmenu-event)
use-dialog-box)
(setq answer
(x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
(while
(let* ((key
(let ((cursor-in-echo-area t))
(when minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
(read-key (propertize xprompt 'face 'minibuffer-prompt)))))
(setq answer (lookup-key query-replace-map (vector key) t))
(cond
((memq answer '(skip act)) nil)
((eq answer 'recenter) (recenter) t)
((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
(t t)))
(ding)
(discard-input)
(setq xprompt
(if (eq answer 'recenter) prompt
(concat "Please answer y or n. " prompt)))))
(let ((ret (eq answer 'act)))
(unless noninteractive
(message "%s %s" prompt (if ret "y" "n")))
ret)))
;;;; Mail user agents.
;; Here we include just enough for other packages to be able

4
lisp/textmodes/bibtex.el
View file

@ -3027,12 +3027,14 @@ if that value is non-nil.
;; brace-delimited ones
)
nil
(font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords)
(font-lock-extra-managed-props . (category))
(font-lock-mark-block-function
. (lambda ()
(set-mark (bibtex-end-of-entry))
(bibtex-beginning-of-entry)))))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-via-font-lock
bibtex-font-lock-syntactic-keywords))
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)

53
lisp/textmodes/ispell.el
View file

@ -1116,26 +1116,24 @@ The variable `ispell-library-directory' defines the library location."
(let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist))
(dict-list (cons "default" nil))
name load-dict)
name dict-bname)
(dolist (dict dicts)
(setq name (car dict)
load-dict (car (cdr (member "-d" (nth 5 dict)))))
dict-bname (or (car (cdr (member "-d" (nth 5 dict))))
name))
;; Include if the dictionary is in the library, or dir not defined.
(if (and
name
;; include all dictionaries if lib directory not known.
;; For Aspell, we already know which dictionaries exist.
(or ispell-really-aspell
;; Include all dictionaries if lib directory not known.
;; Same for Hunspell, where ispell-library-directory is nil.
(not ispell-library-directory)
(file-exists-p (concat ispell-library-directory
"/" name ".hash"))
(file-exists-p (concat ispell-library-directory "/" name ".has"))
(and load-dict
(or (file-exists-p (concat ispell-library-directory
"/" load-dict ".hash"))
(file-exists-p (concat ispell-library-directory
"/" load-dict ".has"))))))
(setq dict-list (cons name dict-list))))
"/" dict-bname ".hash"))
(file-exists-p (concat ispell-library-directory
"/" dict-bname ".has"))))
(push name dict-list)))
dict-list))
;;; define commands in menu in opposite order you want them to appear.
@ -2676,24 +2674,27 @@ Keeps argument list for future ispell invocations for no async support."
ispell-filter-continue nil
ispell-process-directory default-directory)
;; Kill ispell process when killing its associated buffer if using Ispell
;; per-directory personal dictionaries.
(unless (equal ispell-process-directory (expand-file-name "~/"))
(with-current-buffer
(if (and (window-minibuffer-p)
(fboundp 'minibuffer-selected-window)) ;; E.g. XEmacs.
;; When spellchecking minibuffer contents, assign ispell
;; process to parent buffer if known (not known for XEmacs).
;; Use (buffer-name) otherwise.
;; At this point, `ispell-process-directory' will be "~/" unless using
;; Ispell with directory-specific dicts and not in XEmacs minibuffer.
;; If not, kill ispell process when killing buffer. It may be in a
;; removable device that would otherwise become un-mountable.
(with-current-buffer
(if (and (window-minibuffer-p) ;; In minibuffer
(fboundp 'minibuffer-selected-window)) ;; Not XEmacs.
;; In this case kill ispell only when parent buffer is killed
;; to avoid over and over ispell kill.
(window-buffer (minibuffer-selected-window))
(current-buffer))
(add-hook 'kill-buffer-hook (lambda () (ispell-kill-ispell t))
nil 'local)))
(current-buffer))
;; 'local does not automatically make hook buffer-local in XEmacs.
(if (featurep 'xemacs)
(make-local-hook 'kill-buffer-hook))
(add-hook 'kill-buffer-hook
(lambda () (ispell-kill-ispell t)) nil 'local)))
(if ispell-async-processp
(set-process-filter ispell-process 'ispell-filter))
;; protect against bogus binding of `enable-multibyte-characters' in
;; XEmacs.
;; Protect against XEmacs bogus binding of `enable-multibyte-characters'.
(if (and (or (featurep 'xemacs)
(and (boundp 'enable-multibyte-characters)
enable-multibyte-characters))
@ -2729,7 +2730,9 @@ Keeps argument list for future ispell invocations for no async support."
(if extended-char-mode ; ~ extended character mode
(ispell-send-string (concat extended-char-mode "\n"))))
(if ispell-async-processp
(set-process-query-on-exit-flag ispell-process nil)))))
(if (fboundp 'set-process-query-on-exit-flag) ;; not XEmacs
(set-process-query-on-exit-flag ispell-process nil)
(process-kill-without-query ispell-process))))))
;;;###autoload
(defun ispell-kill-ispell (&optional no-error)

1
lisp/textmodes/reftex.el
View file

@ -599,7 +599,6 @@ on the menu bar.
(defvar font-lock-mode)
(defvar font-lock-keywords)
(defvar font-lock-fontify-region-function)
(defvar font-lock-syntactic-keywords)
;;; =========================================================================
;;;

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