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

upstream

Browse source
This commit is contained in:
Joakim Verona 2012-09-10 16:03:53 +02:00
commit b035a30e5c
185 changed files with 5965 additions and 6281 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
ChangeLog
View file

@ -1,5 +1,55 @@
2012-09-10 Paul Eggert <eggert@cs.ucla.edu>
Improve robustness of 'make bootstrap' (Bug#12376).
Run autogen.sh after bootstrap-clean, to avoid bzr pull issues.
* INSTALL, README: Document autogen.sh.
* Makefile.in (Makefile): Mark it as precious, since it's updated
atomically.
(MAKE_CONFIG_STATUS): New macro.
(config.status, bootstrap): Use it. This causes 'make bootstrap'
to run config.status with the --recheck option, which is more
appropriate for a bootstrap.
(bootstrap): Run autogen.sh right after cleaning. Don't worry
about failures due to missing tools.
* autogen.sh: Exit with status 101 when failing due to missing tools.
* make-dist: Distribute autogen.sh.
2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
Assume C89 or later for math functions (Bug#12381).
* configure.ac (frexp, fmod): Remove checks for these functions,
as we now assume them.
(FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC, NO_MATHERR)
(HAVE_EXCEPTION):
Remove; no longer needed.
2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
More signal-handler cleanup (Bug#12327).
* configure.ac (FLOAT_CHECK_DOMAIN): Comment fix (Bug#12327).
2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
Signal-handler cleanup (Bug#12327).
* configure.ac (PTY_OPEN, PTY_TTY_NAME_SPRINTF):
Adjust to syssignal.h changes.
(SIGNAL_H_AB): Remove; no longer needed.
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Simplify redefinition of 'abort' (Bug#12316).
* configure.ac (NO_ABRT): Remove.
* configure.ac (_setjmp, _longjmp): Check by compiling
instead of by guessing. The guesses were wrong for
recent versions of Solaris, such as Solaris 11.
2012-09-03 Paul Eggert <eggert@cs.ucla.edu>
* configure.ac (WARN_CFLAGS): Omit -Wjump-misses-init.
It generates false alarms in doc.c, regex.c, xdisp.c. See
<http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00040.html>.
Merge from gnulib, incorporating:
2012-08-29 stdbool: be more compatible with mixed C/C++ compiles
2011-11-30 manywarnings: update the list of "all" warnings

6
INSTALL
View file

@ -695,9 +695,9 @@ running the `configure' program, you have to perform the following steps.
corresponding `Makefile.in' files. This isn't so hard, just a matter
of editing in appropriate substitutions for the @...@ constructs.
The `configure' script is built from `configure.ac' by the `autoconf'
program. You need at least the version of autoconf specified in the
AC_PREREQ(...) command to rebuild `configure' from `configure.ac'.
The `configure' script is built from `configure.ac' by the
`autogen.sh' script, which checks that `autoconf' and other build
tools are sufficiently up to date and then runs the build tools.
BUILDING GNU EMACS BY HAND

28
Makefile.in
View file

@ -360,15 +360,17 @@ $(MAKEFILE_NAME): config.status $(srcdir)/src/config.in \
$(srcdir)/Makefile.in $(SUBDIR_MAKEFILES_IN)
./config.status
# Don't erase config.status if make is interrupted while refreshing it.
.PRECIOUS: config.status
# Don't erase these files if make is interrupted while refreshing them.
.PRECIOUS: Makefile config.status
config.status: ${srcdir}/configure ${srcdir}/lisp/version.el
MAKE_CONFIG_STATUS = \
if [ -x ./config.status ]; then \
./config.status --recheck; \
else \
./configure $(CONFIGURE_FLAGS); \
fi
config.status: ${srcdir}/configure ${srcdir}/lisp/version.el
$(MAKE_CONFIG_STATUS)
AUTOCONF_INPUTS = $(srcdir)/configure.ac $(srcdir)/aclocal.m4
@ -383,6 +385,10 @@ AUTOMAKE_INPUTS = $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am \
$(srcdir)/lib/gnulib.mk
$(srcdir)/lib/Makefile.in: $(AUTOMAKE_INPUTS)
cd $(srcdir) && automake --gnu -a -c lib/Makefile
# Regenerate files that this makefile would have made, if this makefile
# had been built by Automake. The name 'am--refresh' is for
# compatibility with subsidiary Automake-generated makefiles.
am--refresh: $(srcdir)/aclocal.m4 $(srcdir)/configure $(srcdir)/src/config.in
.PHONY: am--refresh
@ -776,8 +782,6 @@ bootstrap-clean: FRC
(cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean)
[ ! -f config.log ] || mv -f config.log config.log~
${top_bootclean}
## configure; make bootstrap replaces the real config.log from configure
## with the truncated one from config.status. The former is more useful.
### `maintainer-clean'
### Delete everything from the current directory that can be
@ -883,14 +887,14 @@ dvi:
.PHONY: bootstrap
## configure; make bootstrap replaces the real config.log from configure
## with the truncated one from config.status. The former is more useful.
# Bootstrapping does the following:
# * Remove files to start from a clean slate.
# * Run autogen.sh, but don't worry about exit status 101 (missing tools).
# * Build Makefile, to build the build procedure itself.
# * Do the actual build.
bootstrap: bootstrap-clean FRC
if [ -x ./config.status ]; then \
./config.status; \
else \
./configure $(CONFIGURE_FLAGS); \
fi
cd $(srcdir) && { ./autogen.sh || test $$? -eq 101; }
$(MAKE_CONFIG_STATUS)
$(MAKE) $(MFLAGS) info all
.PHONY: check-declare

11
README
View file

@ -41,9 +41,14 @@ The file `configure.ac' is the input used by the autoconf program to
construct the `configure' script. Since Emacs has some configuration
requirements that autoconf can't meet directly, and for historical
reasons, `configure.ac' uses an unholy marriage of custom-baked
configuration code and autoconf macros. If you want to rebuild
`configure' from `configure.ac', you will need to install a recent
version of autoconf and GNU m4.
configuration code and autoconf macros.
The shell script `autogen.sh' generates 'configure' and other files by
running the GNU build tools autoconf and automake, which in turn use
GNU m4 and Perl. If you want to use it, you will need to install
recent versions of these build tools. This should be needed only if
you edit files like `configure.ac' that specify Emacs's autobuild
procedure.
The file `Makefile.in' is a template used by `configure' to create
`Makefile'.

6
admin/CPP-DEFINES
View file

@ -107,7 +107,6 @@ EMACS_CONFIGURATION
EMACS_CONFIG_OPTIONS
EMACS_INT
EMACS_UINT
FLOAT_CHECK_DOMAIN
GC_MARK_SECONDARY_STACK
GC_MARK_STACK
GC_SETJMP_WORKS
@ -158,12 +157,10 @@ HAVE_ENDPWENT
HAVE_ENVIRON_DECL
HAVE_EUIDACCESS
HAVE_FCNTL_H
HAVE_FMOD
HAVE_FORK
HAVE_FPATHCONF
HAVE_FREEIFADDRS
HAVE_FREETYPE
HAVE_FREXP
HAVE_FSEEKO
HAVE_FSYNC
HAVE_FUTIMENS
@ -217,7 +214,6 @@ HAVE_IFADDRS_H
HAVE_IMAGEMAGICK
HAVE_INET_SOCKETS
HAVE_INTTYPES_H
HAVE_INVERSE_HYPERBOLIC
HAVE_JPEG
HAVE_KERBEROSIV_DES_H
HAVE_KERBEROSIV_KRB_H
@ -428,9 +424,7 @@ MAIL_USE_POP
MAIL_USE_SYSTEM_LOCK
MAXPATHLEN
NLIST_STRUCT
NO_ABORT
NO_EDITRES
NO_MATHERR
NO_TERMIO
NSIG
NSIG_MINIMUM

11
admin/ChangeLog
View file

@ -1,3 +1,14 @@
2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
Assume C89 or later for math functions (Bug#12381).
* CPP-DEFINES (HAVE_FMOD, HAVE_FREXP, FLOAT_CHECK_DOMAIN)
(HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Simplify redefinition of 'abort' (Bug#12316).
* CPP-DEFINES (NO_ABORT): Remove.
2012-08-28 Glenn Morris <rgm@gnu.org>
* bzrmerge.el (bzrmerge-merges): Allow unversioned files in the tree.

2
autogen.sh
View file

@ -201,7 +201,7 @@ This is not recommended - see the comments in \`copy_autogen'.
Please report any problems with this script to bug-gnu-emacs@gnu.org .
EOF
exit 1
exit 101 # Exit status 101 means tools were missing.
fi
echo "Your system has the required tools, running autoreconf..."

28
autogen/config.in
View file

@ -157,10 +157,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
*/
#undef FIRST_PTY_LETTER
/* Define if the float library doesn't handle errors by either setting errno,
or signaling SIGFPE/SIGILL. */
#undef FLOAT_CHECK_DOMAIN
/* Enable compile-time and run-time bounds-checking, and some warnings,
without upsetting glibc 2.15+. */
#if defined __OPTIMIZE__ && __OPTIMIZE__
@ -371,9 +367,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <fcntl.h> header file. */
#undef HAVE_FCNTL_H
/* Define to 1 if you have the `fmod' function. */
#undef HAVE_FMOD
/* Define to 1 if you have the `fork' function. */
#undef HAVE_FORK
@ -386,9 +379,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if using the freetype and fontconfig libraries. */
#undef HAVE_FREETYPE
/* Define to 1 if you have the `frexp' function. */
#undef HAVE_FREXP
/* Define to 1 if fseeko (and presumably ftello) exists and is declared. */
#undef HAVE_FSEEKO
@ -540,9 +530,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <inttypes.h> header file. */
#undef HAVE_INTTYPES_H
/* Define if you have the functions acosh, asinh, and atanh. */
#undef HAVE_INVERSE_HYPERBOLIC
/* Define to 1 if you have the jpeg library (-ljpeg). */
#undef HAVE_JPEG
@ -1179,15 +1166,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
`NO'. */
#undef NARROWPROTO
/* Do not define abort in emacs.c. */
#undef NO_ABORT
/* Define if XEditRes should not be used. */
#undef NO_EDITRES
/* Define to 1 if you don't have struct exception in math.h. */
#undef NO_MATHERR
/* Define to 1 if your C compiler doesn't accept -c and -o together. */
#undef NO_MINUS_C_MINUS_O
@ -1303,9 +1284,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Make process_send_signal work by "typing" a signal character on the pty. */
#undef SIGNALS_VIA_CHARACTERS
/* Define if AH_BOTTOM should include signal.h. */
#undef SIGNAL_H_AHB
/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
'sig_atomic_t'. */
#undef SIG_ATOMIC_T_SUFFIX
@ -1542,10 +1520,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
declarations. Define as empty for no equivalent. */
#undef __restrict_arr
/* Some platforms redefine this. */
/* Define to longjmp if _setjmp and _longjmp do not work. Because longjmp may
alter signal masks, callers of _longjmp should not assume that it leaves
signal masks alone. */
#undef _longjmp
/* Some platforms redefine this. */
/* Define to setjmp if _setjmp and _longjmp do not work. See _longjmp. */
#undef _setjmp
/* Some platforms that do not use configure define this to include extra

4516
autogen/configure vendored
View file

File diff suppressed because it is too large Load diff

66
configure.ac
View file

@ -707,6 +707,7 @@ else
nw="$nw -Wswitch-default" # Too many warnings for now
nw="$nw -Wfloat-equal" # warns about high-quality code
nw="$nw -Winline" # OK to ignore 'inline'
nw="$nw -Wjump-misses-init" # We sometimes safely jump over init.
nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
@ -1303,17 +1304,6 @@ if test $emacs_cv_speed_t = yes; then
[Define to 1 if `speed_t' is declared by <termios.h>.])
fi
AC_CACHE_CHECK(for struct exception, emacs_cv_struct_exception,
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]],
[[static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;]])],
emacs_cv_struct_exception=yes, emacs_cv_struct_exception=no))
HAVE_EXCEPTION=$emacs_cv_struct_exception
dnl Define on Darwin so emacs symbols will not conflict with those
dnl in the System framework. Otherwise -prebind will not work.
if test $emacs_cv_struct_exception != yes || test $opsys = darwin; then
AC_DEFINE(NO_MATHERR, 1, [Define to 1 if you don't have struct exception in math.h.])
fi
AC_CHECK_HEADERS_ONCE(sys/socket.h)
AC_CHECK_HEADERS(net/if.h, , , [AC_INCLUDES_DEFAULT
#if HAVE_SYS_SOCKET_H
@ -2841,7 +2831,7 @@ AC_SUBST(BLESSMAIL_TARGET)
AC_CHECK_FUNCS(gethostname \
closedir getrusage get_current_dir_name \
lrand48 logb frexp fmod cbrt setsid \
lrand48 logb cbrt setsid \
fpathconf select euidaccess getpagesize setlocale \
utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \
__fpending strsignal setitimer \
@ -3271,12 +3261,6 @@ AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written,
so that Emacs can tell instantly when you try to modify a file that
someone else has modified in his/her Emacs.])
AH_TEMPLATE(FLOAT_CHECK_DOMAIN, [Define if the float library doesn't
handle errors by either setting errno, or signaling SIGFPE/SIGILL.])
AH_TEMPLATE(HAVE_INVERSE_HYPERBOLIC, [Define if you have the functions
acosh, asinh, and atanh.])
dnl Everybody supports this, except MS.
dnl Seems like the kind of thing we should be testing for, though.
## Note: PTYs are broken on darwin <6. Use at your own risk.
@ -3411,12 +3395,6 @@ case $opsys in
AC_DEFINE(BROKEN_PTY_READ_AFTER_EAGAIN, 1, [Define on FreeBSD to
work around an issue when reading from a PTY.])
;;
dnl Define the following so emacs symbols will not conflict with those
dnl in the System framework. Otherwise -prebind will not work.
darwin)
AC_DEFINE(NO_ABORT, 1, [Do not define abort in emacs.c.])
;;
esac
case $opsys in
@ -3511,7 +3489,7 @@ case $opsys in
cygwin )
AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)])
dnl multi-line AC_DEFINEs are hard. :(
AC_DEFINE(PTY_OPEN, [ do { int dummy; SIGMASKTYPE mask; mask = sigblock (sigmask (SIGCHLD)); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; sigsetmask (mask); if (fd >= 0) emacs_close (dummy); } while (0)])
AC_DEFINE(PTY_OPEN, [ do { int dummy; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (0)])
AC_DEFINE(PTY_NAME_SPRINTF, [])
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
;;
@ -3540,7 +3518,7 @@ case $opsys in
AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)])
dnl Note that grantpt and unlockpt may fork. We must block SIGCHLD
dnl to prevent sigchld_handler from intercepting the child's death.
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname; sigblock (sigmask (SIGCHLD)); if (grantpt (fd) == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname(fd))) { sigunblock (sigmask (SIGCHLD)); close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); sigunblock (sigmask (SIGCHLD)); }])
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
dnl if HAVE_POSIX_OPENPT
if test "x$ac_cv_func_posix_openpt" = xyes; then
AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_NOCTTY)])
@ -3585,18 +3563,15 @@ case $opsys in
;;
sol2* )
dnl Uses sigblock/sigunblock rather than sighold/sigrelse,
dnl which appear to be BSD4.1 specific. It may also be appropriate
dnl for SVR4.x (x<2) but I'm not sure. fnf@cygnus.com
dnl On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler()
dnl from intercepting that death. If any child but grantpt's should die
dnl within, it should be caught after sigrelse(2).
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock (sigmask (SIGCLD)); if (grantpt (fd) == -1) { emacs_close (fd); return -1; } sigunblock (sigmask (SIGCLD)); if (unlockpt (fd) == -1) { emacs_close (fd); return -1; } if (!(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
;;
unixware )
dnl Comments are as per sol2*.
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock(sigmask(SIGCLD)); if (grantpt(fd) == -1) fatal("could not grant slave pty"); sigunblock(sigmask(SIGCLD)); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
;;
esac
@ -3851,13 +3826,27 @@ else
esac
fi dnl GCC?
AC_CACHE_CHECK([for _setjmp], [emacs_cv_func__setjmp],
[AC_LINK_IFELSE(
[AC_LANG_PROGRAM(
[[#include <setjmp.h>
]],
[[jmp_buf j;
if (! _setjmp (j))
_longjmp (j, 1);]])],
[emacs_cv_func__setjmp=yes],
[emacs_cv_func__setjmp=no])])
if test $emacs_cv_func__setjmp = no; then
AC_DEFINE([_setjmp], [setjmp],
[Define to setjmp if _setjmp and _longjmp do not work. See _longjmp.])
AC_DEFINE([_longjmp], [longjmp],
[Define to longjmp if _setjmp and _longjmp do not work.
Because longjmp may alter signal masks, callers of _longjmp
should not assume that it leaves signal masks alone.])
fi
case $opsys in
sol2* | unixware )
dnl setjmp and longjmp can safely replace _setjmp and _longjmp,
dnl but they will run more slowly.
AC_DEFINE(_setjmp, setjmp, [Some platforms redefine this.])
AC_DEFINE(_longjmp, longjmp, [Some platforms redefine this.])
dnl TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY
dnl subprocesses the usual way. But TIOCSIGNAL does work for PTYs,
dnl and this is all we need.
@ -3872,13 +3861,6 @@ case $opsys in
AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on
some systems, where it requires time.h.])
;;
netbsd | openbsd )
dnl Greg A. Woods <woods@weird.com> says we must include signal.h
dnl before syssignal.h is included, to work around interface conflicts
dnl that are handled with CPP __RENAME() macro in signal.h.
AC_DEFINE(SIGNAL_H_AHB, 1, [Define if AH_BOTTOM should include signal.h.])
;;
esac

22
doc/emacs/ChangeLog
View file

@ -1,8 +1,24 @@
2012-09-08 Jambunathan K <kjambunathan@gmail.com>
* regs.texi (Text Registers): `C-x r +' can now be used instead of
M-x append-to-register. New option `register-separator'.
(Number Registers): Mention that `C-x r +' is polymorphic.
2012-09-07 Chong Yidong <cyd@gnu.org>
* windows.texi (Window Choice): Don't mention obsolete
display-buffer-reuse-frames.
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Give more-useful info on a fatal error (Bug#12328).
* trouble.texi (Crashing): New section, documenting this.
2012-08-24 Michael Albinus <michael.albinus@gmx.de>
* cmdargs.texi (General Variables): Setting
$DBUS_SESSION_BUS_ADDRESS to a dummy value suppresses connections
to the D-Bus session bus. (Bug#12112)
* cmdargs.texi (General Variables):
Setting $DBUS_SESSION_BUS_ADDRESS to a dummy value suppresses
connections to the D-Bus session bus. (Bug#12112)
2012-08-14 Eli Zaretskii <eliz@gnu.org>

3
doc/emacs/emacs.texi
View file

@ -1136,6 +1136,7 @@ Dealing with Emacs Trouble
* Screen Garbled:: Garbage on the screen.
* Text Garbled:: Garbage in the text.
* Memory Full:: How to cope when you run out of memory.
* Crashing:: What Emacs does when it crashes.
* After a Crash:: Recovering editing in an Emacs session that crashed.
* Emergency Escape:: What to do if Emacs stops responding.
@ -1320,7 +1321,7 @@ when you get it, not just free for the manufacturer.
If you find GNU Emacs useful, please @strong{send a donation} to the
Free Software Foundation to support our work. Donations to the Free
Software Foundation are tax deductible in the US. If you use GNU Emacs
at your workplace, please suggest that the company make a donation.
at your workplace, please suggest that the company make a donation.
For more information on how you can help, see
@url{http://www.gnu.org/help/help.html}.

26
doc/emacs/regs.texi
View file

@ -92,6 +92,13 @@ Copy region into register @var{r} (@code{copy-to-register}).
Insert text from register @var{r} (@code{insert-register}).
@item M-x append-to-register @key{RET} @var{r}
Append region to text in register @var{r}.
@kindex C-x r +
When register @var{r} contains text, you can use @kbd{C-x r +}
(@code{increment-register}) to append to that register. Note that
command @kbd{C-x r +} behaves differently if @var{r} contains a
number. @xref{Number Registers}.
@item M-x prepend-to-register @key{RET} @var{r}
Prepend region to text in register @var{r}.
@end table
@ -116,6 +123,19 @@ region after appending it to the register. The command
the region text to the text in the register instead of
@emph{appending} it.
@vindex register-separator
When you are collecting text using @code{append-to-register} and
@code{prepend-to-register}, you may want to separate individual
collected pieces using a separator. In that case, configure a
@code{register-separator} and store the separator text in to that
register. For example, to get double newlines as text separator
during the collection process, you can use the following setting.
@example
(setq register-separator ?+)
(set-register register-separator "\n\n")
@end example
@kindex C-x r i
@findex insert-register
@kbd{C-x r i @var{r}} inserts in the buffer the text from register
@ -191,8 +211,10 @@ Store @var{number} into register @var{r} (@code{number-to-register}).
@item C-u @var{number} C-x r + @var{r}
@kindex C-x r +
@findex increment-register
Increment the number in register @var{r} by @var{number}
(@code{increment-register}).
If @var{r} contains a number, increment the number in that register by
@var{number}. Note that command @kbd{C-x r +}
(@code{increment-register}) behaves differently if @var{r} contains
text. @xref{Text Registers}.
@item C-x r i @var{r}
Insert the number from register @var{r} into the buffer.
@end table

39
doc/emacs/trouble.texi
View file

@ -149,6 +149,7 @@ Emacs.
* Screen Garbled:: Garbage on the screen.
* Text Garbled:: Garbage in the text.
* Memory Full:: How to cope when you run out of memory.
* Crashing:: What Emacs does when it crashes.
* After a Crash:: Recovering editing in an Emacs session that crashed.
* Emergency Escape:: What to do if Emacs stops responding.
@end menu
@ -277,6 +278,44 @@ editing in the same Emacs session.
out of memory, because the buffer menu needs a fair amount of memory
itself, and the reserve supply may not be enough.
@node Crashing
@subsection When Emacs Crashes
Emacs is not supposed to crash, but if it does, before it exits it
reports some information about the crash to the standard error stream
@code{stderr}. This report may be useful to someone who later debugs
the same version of Emacs on the same platform. The format of this
report depends on the platform, and some platforms support backtraces.
Here is an example, generated on x86-64 GNU/Linux with version 2.15 of
the GNU C Library:
@example
Fatal error 11: Segmentation fault
Backtrace:
emacs[0x5094e4]
emacs[0x4ed3e6]
emacs[0x4ed504]
/lib64/libpthread.so.0[0x375220efe0]
/lib64/libpthread.so.0(read+0xe)[0x375220e08e]
emacs[0x509af6]
emacs[0x5acc26]
emacs[0x5adbfb]
emacs[0x56566b]
emacs[0x59bac3]
emacs[0x565151]
...
@end example
@noindent
The number @samp{11} is the system signal number that corresponds to
the problem, a segmentation fault here. The hexadecimal program
addresses can be useful in debugging sessions. For example, the GDB
command @samp{list *0x509af6} prints the source-code lines
corresponding to the @samp{emacs[0x509af6]} entry in the backtrace.
The three dots at the end indicate that Emacs suppressed further
backtrace entries, in the interest of brevity.
@node After a Crash
@subsection Recovery After a Crash

2
doc/emacs/windows.texi
View file

@ -378,12 +378,10 @@ adding the desired buffer's name to the list
expression to the list @code{same-window-regexps}. By default, these
variables are @code{nil}, so this step is skipped.
@vindex display-buffer-reuse-frames
@item
Otherwise, if the buffer is already displayed in an existing window,
``reuse'' that window. Normally, only windows on the selected frame
are considered, but windows on other frames are also reusable if you
change @code{display-buffer-reuse-frames} to @code{t}, or if you
change @code{pop-up-frames} (see below) to @code{t}.
@item

40
doc/lispref/ChangeLog
View file

@ -1,3 +1,43 @@
2012-09-09 Chong Yidong <cyd@gnu.org>
* lists.texi (Sets And Lists): Explain that the return value for
delete should be used, like for delq.
* minibuf.texi (Yes-or-No Queries): Document recentering and
scrolling in y-or-n-p. Remove gratuitous example.
* searching.texi (Search and Replace): Document window scrolling
entries in query-replace-map.
2012-09-08 Chong Yidong <cyd@gnu.org>
* syntax.texi (Syntax Table Internals): Define "raw syntax
descriptor" terminology (Bug#12383).
(Syntax Descriptors): Mention raw syntax descriptors.
2012-09-07 Chong Yidong <cyd@gnu.org>
* variables.texi (Creating Buffer-Local): Fix description of
local-variable-if-set-p (Bug#10713).
* eval.texi (Intro Eval): Add index entry for sexp (Bug#12233).
* windows.texi (Display Action Functions)
(Choosing Window Options): Remove obsolete variable
display-buffer-reuse-frames.
(Switching Buffers): Minor doc tweak for switch-to-buffer.
* positions.texi (Narrowing): Document buffer-narrowed-p.
* markers.texi (Moving Markers): Add xref to Point (Bug#7151).
* syntax.texi (Low-Level Parsing): Add xref to Parser State
(Bug#12269).
2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
* debugging.texi (Explicit Debug): Document `debug-on-message'.
2012-09-02 Chong Yidong <cyd@gnu.org>
* windows.texi (Window Configurations): Recommend against using

5
doc/lispref/debugging.texi
View file

@ -298,6 +298,11 @@ of @code{(debug)} isn't ignored, it will alter the execution of the
program!) The most common suitable places are inside a @code{progn} or
an implicit @code{progn} (@pxref{Sequencing}).
If you don't know exactly where in the source code you want to put
the debug statement, but you want to display a backtrace when a
certain message is displayed, you can set @code{debug-on-message} to a
regular expression matching the desired message.
@node Using Debugger
@subsection Using the Debugger

1
doc/lispref/eval.texi
View file

@ -40,6 +40,7 @@ interpreter.
@cindex form
@cindex expression
@cindex S-expression
@cindex sexp
A Lisp object that is intended for evaluation is called a @dfn{form}
or @dfn{expression}@footnote{It is sometimes also referred to as an
@dfn{S-expression} or @dfn{sexp}, but we generally do not use this

33
doc/lispref/lists.texi
View file

@ -1293,14 +1293,19 @@ compare @var{object} against the elements of the list. For example:
@defun delq object list
@cindex deleting list elements
This function destructively removes all elements @code{eq} to
@var{object} from @var{list}. The letter @samp{q} in @code{delq} says
that it uses @code{eq} to compare @var{object} against the elements of
the list, like @code{memq} and @code{remq}.
@var{object} from @var{list}, and returns the resulting list. The
letter @samp{q} in @code{delq} says that it uses @code{eq} to compare
@var{object} against the elements of the list, like @code{memq} and
@code{remq}.
Typically, when you invoke @code{delq}, you should use the return
value by assigning it to the variable which held the original list.
The reason for this is explained below.
@end defun
When @code{delq} deletes elements from the front of the list, it does so
simply by advancing down the list and returning a sublist that starts
after those elements:
The @code{delq} function deletes elements from the front of the list
by simply advancing down the list, and returning a sublist that starts
after those elements. For example:
@example
@group
@ -1308,6 +1313,7 @@ after those elements:
@end group
@end example
@noindent
When an element to be deleted appears in the middle of the list,
removing it involves changing the @sc{cdr}s (@pxref{Setcdr}).
@ -1432,12 +1438,15 @@ Compare this with @code{memq}:
@end defun
@defun delete object sequence
If @code{sequence} is a list, this function destructively removes all
elements @code{equal} to @var{object} from @var{sequence}. For lists,
@code{delete} is to @code{delq} as @code{member} is to @code{memq}: it
uses @code{equal} to compare elements with @var{object}, like
@code{member}; when it finds an element that matches, it cuts the
element out just as @code{delq} would.
This function removes all elements @code{equal} to @var{object} from
@var{sequence}, and returns the resulting sequence.
If @var{sequence} is a list, @code{delete} is to @code{delq} as
@code{member} is to @code{memq}: it uses @code{equal} to compare
elements with @var{object}, like @code{member}; when it finds an
element that matches, it cuts the element out just as @code{delq}
would. As with @code{delq}, you should typically use the return value
by assigning it to the variable which held the original list.
If @code{sequence} is a vector or string, @code{delete} returns a copy
of @code{sequence} with all elements @code{equal} to @code{object}

6
doc/lispref/markers.texi
View file

@ -355,9 +355,9 @@ the current buffer.
If @var{position} is less than 1, @code{set-marker} moves @var{marker}
to the beginning of the buffer. If @var{position} is greater than the
size of the buffer, @code{set-marker} moves marker to the end of the
buffer. If @var{position} is @code{nil} or a marker that points
nowhere, then @var{marker} is set to point nowhere.
size of the buffer (@pxref{Point}), @code{set-marker} moves marker to
the end of the buffer. If @var{position} is @code{nil} or a marker
that points nowhere, then @var{marker} is set to point nowhere.
The value returned is @var{marker}.

49
doc/lispref/minibuf.texi
View file

@ -1888,47 +1888,14 @@ Echo Area}), which uses the same screen space as the minibuffer. The
cursor moves to the echo area while the question is being asked.
The answers and their meanings, even @samp{y} and @samp{n}, are not
hardwired. The keymap @code{query-replace-map} specifies them.
@xref{Search and Replace}.
In the following example, the user first types @kbd{q}, which is
invalid. At the next prompt the user types @kbd{y}.
@c Need an interactive example, because otherwise the return value
@c obscures the display of the valid answer.
@smallexample
@group
(defun ask ()
(interactive)
(y-or-n-p "Do you need a lift? "))
;; @r{After evaluation of the preceding definition, @kbd{M-x ask}}
;; @r{causes the following prompt to appear in the echo area:}
@end group
@group
---------- Echo area ----------
Do you need a lift? (y or n)
---------- Echo area ----------
@end group
;; @r{If the user then types @kbd{q}, the following appears:}
@group
---------- Echo area ----------
Please answer y or n. Do you need a lift? (y or n)
---------- Echo area ----------
@end group
;; @r{When the user types a valid answer,}
;; @r{it is displayed after the question:}
@group
---------- Echo area ----------
Do you need a lift? (y or n) y
---------- Echo area ----------
@end group
@end smallexample
hardwired, and are specified by the keymap @code{query-replace-map}
(@pxref{Search and Replace}). In particular, if the user enters the
special responses @code{recenter}, @code{scroll-up},
@code{scroll-down}, @code{scroll-other-window}, or
@code{scroll-other-window-down} (respectively bound to @kbd{C-l},
@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
@code{query-replace-map}), this function performs the specified window
recentering or scrolling operation, and poses the question again.
@noindent
We show successive lines of echo area messages, but only one actually

27
doc/lispref/positions.texi
View file

@ -874,18 +874,18 @@ commands to a limited range of characters in a buffer. The text that
remains addressable is called the @dfn{accessible portion} of the
buffer.
Narrowing is specified with two buffer positions which become the
beginning and end of the accessible portion. For most editing commands
and most Emacs primitives, these positions replace the values of the
beginning and end of the buffer. While narrowing is in effect, no text
outside the accessible portion is displayed, and point cannot move
outside the accessible portion.
Narrowing is specified with two buffer positions, which become the
beginning and end of the accessible portion. For most editing
commands and primitives, these positions replace the values of the
beginning and end of the buffer. While narrowing is in effect, no
text outside the accessible portion is displayed, and point cannot
move outside the accessible portion. Note that narrowing does not
alter actual buffer positions (@pxref{Point}); it only determines
which positions are considered the accessible portion of the buffer.
Most functions refuse to operate on text that is outside the
accessible portion.
Values such as positions or line numbers, which usually count from the
beginning of the buffer, do so despite narrowing, but the functions
which use them refuse to operate on text that is inaccessible.
The commands for saving buffers are unaffected by narrowing; they save
Commands for saving buffers are unaffected by narrowing; they save
the entire buffer regardless of any narrowing.
If you need to display in a single buffer several very different
@ -924,6 +924,11 @@ It is equivalent to the following expression:
@end example
@end deffn
@defun buffer-narrowed-p
This function returns non-@code{nil} if the buffer is narrowed, and
@code{nil} otherwise.
@end defun
@defspec save-restriction body@dots{}
This special form saves the current bounds of the accessible portion,
evaluates the @var{body} forms, and finally restores the saved bounds,

8
doc/lispref/searching.texi
View file

@ -1796,7 +1796,13 @@ Delete the text being considered, then enter a recursive edit to replace
it.
@item recenter
Redisplay and center the window, then ask the same question again.
@itemx scroll-up
@itemx scroll-down
@itemx scroll-other-window
@itemx scroll-other-window-down
Perform the specified window scroll operation, then ask the same
question again. Only @code{y-or-n-p} and related functions use this
answer.
@item quit
Perform a quit right away. Only @code{y-or-n-p} and related functions

64
doc/lispref/syntax.texi
View file

@ -130,6 +130,10 @@ comment-ender), and the entry for @samp{/} is @samp{@w{. 14}} (i.e.,
punctuation, matching character slot unused, first character of a
comment-starter, second character of a comment-ender).
Emacs also defines @dfn{raw syntax descriptors}, which are used to
describe syntax classes at a lower level. @xref{Syntax Table
Internals}.
@menu
* Syntax Class Table:: Table of syntax classes.
* Syntax Flags:: Additional flags each character can have.
@ -531,8 +535,9 @@ the current buffer's syntax table to determine the syntax for the
underlying text character.
@item @code{(@var{syntax-code} . @var{matching-char})}
A cons cell of this format specifies the syntax for the underlying
text character. (@pxref{Syntax Table Internals})
A cons cell of this format is a raw syntax descriptor (@pxref{Syntax
Table Internals}), which directly specifies a syntax class for the
underlying text character.
@item @code{nil}
If the property is @code{nil}, the character's syntax is determined from
@ -878,6 +883,9 @@ This function parses a sexp in the current buffer starting at
@var{start}, not scanning past @var{limit}. It stops at position
@var{limit} or when certain criteria described below are met, and sets
point to the location where parsing stops. It returns a parser state
@ifinfo
(@pxref{Parser State})
@end ifinfo
describing the status of the parse at the point where it stops.
@cindex parenthesis depth
@ -937,16 +945,20 @@ documented in this section. This internal format can also be assigned
as syntax properties (@pxref{Syntax Properties}).
@cindex syntax code
Each entry in a syntax table is a cons cell of the form
@code{(@var{syntax-code} . @var{matching-char})}. @var{syntax-code}
is an integer that encodes the syntax class and syntax flags,
according to the table below. @var{matching-char}, if non-@code{nil},
specifies a matching character (similar to the second character in a
syntax descriptor).
@cindex raw syntax descriptor
Each entry in a syntax table is a @dfn{raw syntax descriptor}: a
cons cell of the form @code{(@var{syntax-code}
. @var{matching-char})}. @var{syntax-code} is an integer which
encodes the syntax class and syntax flags, according to the table
below. @var{matching-char}, if non-@code{nil}, specifies a matching
character (similar to the second character in a syntax descriptor).
Here are the syntax codes corresponding to the various syntax
classes:
@multitable @columnfractions .2 .3 .2 .3
@item
@i{Syntax code} @tab @i{Class} @tab @i{Syntax code} @tab @i{Class}
@i{Code} @tab @i{Class} @tab @i{Code} @tab @i{Class}
@item
0 @tab whitespace @tab 8 @tab paired delimiter
@item
@ -967,7 +979,7 @@ syntax descriptor).
@noindent
For example, in the standard syntax table, the entry for @samp{(} is
@code{(4 . 41)}. (41 is the character code for @samp{)}.)
@code{(4 . 41)}. 41 is the character code for @samp{)}.
Syntax flags are encoded in higher order bits, starting 16 bits from
the least significant bit. This table gives the power of two which
@ -987,33 +999,35 @@ corresponds to each syntax flag.
@end multitable
@defun string-to-syntax @var{desc}
Given a syntax descriptor @var{desc}, this function returns the
corresponding internal form, a cons cell @code{(@var{syntax-code}
. @var{matching-char})}.
Given a syntax descriptor @var{desc} (a string), this function returns
the corresponding raw syntax descriptor.
@end defun
@defun syntax-after pos
This function returns the syntax code of the character in the buffer
after position @var{pos}, taking account of syntax properties as well
as the syntax table. If @var{pos} is outside the buffer's accessible
portion (@pxref{Narrowing, accessible portion}), this function returns
@code{nil}.
This function returns the raw syntax descriptor for the character in
the buffer after position @var{pos}, taking account of syntax
properties as well as the syntax table. If @var{pos} is outside the
buffer's accessible portion (@pxref{Narrowing, accessible portion}),
the return value is @code{nil}.
@end defun
@defun syntax-class syntax
This function returns the syntax class of the syntax code
@var{syntax}. (It masks off the high 16 bits that hold the flags
encoded in the syntax descriptor.) If @var{syntax} is @code{nil}, it
returns @code{nil}; this is so evaluating the expression
This function returns the syntax code for the raw syntax descriptor
@var{syntax}. More precisely, it takes the raw syntax descriptor's
@var{syntax-code} component, masks off the high 16 bits which record
the syntax flags, and returns the resulting integer.
If @var{syntax} is @code{nil}, the return value is returns @code{nil}.
This is so that the expression
@example
(syntax-class (syntax-after pos))
@end example
@noindent
where @code{pos} is outside the buffer's accessible portion, will
yield @code{nil} without throwing errors or producing wrong syntax
class codes.
evaluates to @code{nil} if @code{pos} is outside the buffer's
accessible portion, without throwing errors or returning an incorrect
code.
@end defun
@node Categories

7
doc/lispref/variables.texi
View file

@ -1302,9 +1302,10 @@ This returns @code{t} if @var{variable} is buffer-local in buffer
@end defun
@defun local-variable-if-set-p variable &optional buffer
This returns @code{t} if @var{variable} will become buffer-local in
buffer @var{buffer} (which defaults to the current buffer) if it is
set there.
This returns @code{t} if @var{variable} either has a buffer-local
value in buffer @var{buffer}, or is automatically buffer-local.
Otherwise, it returns @code{nil}. If omitted or @code{nil},
@var{buffer} defaults to the current buffer.
@end defun
@defun buffer-local-value variable buffer

36
doc/lispref/windows.texi
View file

@ -1492,12 +1492,10 @@ to make a buffer current to modify it in Lisp, use
@code{set-buffer}. @xref{Current Buffer}.
@deffn Command switch-to-buffer buffer-or-name &optional norecord force-same-window
This function displays @var{buffer-or-name} in the selected window,
and makes it the current buffer. (In contrast, @code{set-buffer}
makes the buffer current but does not display it; @pxref{Current
Buffer}). It is often used interactively (as the binding of @kbd{C-x
b}), as well as in Lisp programs. The return value is the buffer
switched to.
This command attempts to display @var{buffer-or-name} in the selected
window, and makes it the current buffer. It is often used
interactively (as the binding of @kbd{C-x b}), as well as in Lisp
programs. The return value is the buffer switched to.
If @var{buffer-or-name} is @code{nil}, it defaults to the buffer
returned by @code{other-buffer} (@pxref{The Buffer List}). If
@ -1506,17 +1504,18 @@ buffer, this function creates a new buffer with that name; the new
buffer's major mode is determined by the variable @code{major-mode}
(@pxref{Major Modes}).
Normally the specified buffer is put at the front of the buffer
Normally, the specified buffer is put at the front of the buffer
list---both the global buffer list and the selected frame's buffer
list (@pxref{The Buffer List}). However, this is not done if the
optional argument @var{norecord} is non-@code{nil}.
If this function is unable to display the buffer in the selected
window---usually because the selected window is a minibuffer window or
is strongly dedicated to its buffer (@pxref{Dedicated Windows})---then
it normally tries to display the buffer in some other window, in the
manner of @code{pop-to-buffer} (see below). However, if the optional
argument @var{force-same-window} is non-@code{nil}, it signals an error
Sometimes, @code{switch-to-buffer} may be unable to display the buffer
in the selected window. This happens if the selected window is a
minibuffer window, or if the selected window is strongly dedicated to
its buffer (@pxref{Dedicated Windows}). In that case, the command
normally tries to display the buffer in some other window, by invoking
@code{pop-to-buffer} (see below). However, if the optional argument
@var{force-same-window} is non-@code{nil}, it signals an error
instead.
@end deffn
@ -1728,8 +1727,7 @@ A frame means consider windows on that frame only.
@end itemize
If @var{alist} contains no @code{reusable-frames} entry, this function
normally searches just the selected frame; however, if either the
variable @code{display-buffer-reuse-frames} or the variable
normally searches just the selected frame; however, if the variable
@code{pop-up-frames} is non-@code{nil}, it searches all frames on the
current terminal. @xref{Choosing Window Options}.
@ -1769,14 +1767,6 @@ The behavior of the standard display actions of @code{display-buffer}
(@pxref{Choosing Window}) can be modified by a variety of user
options.
@defopt display-buffer-reuse-frames
If the value of this variable is non-@code{nil}, @code{display-buffer}
may search all frames on the current terminal when looking for a
window already displaying the specified buffer. The default is
@code{nil}. This variable is consulted by the action function
@code{display-buffer-reuse-window} (@pxref{Display Action Functions}).
@end defopt
@defopt pop-up-windows
If the value of this variable is non-@code{nil}, @code{display-buffer}
is allowed to split an existing window to make a new window for

5
etc/ChangeLog
View file

@ -1,3 +1,8 @@
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Give more-useful info on a fatal error (Bug#12328).
* NEWS: Document the change.
2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
Better seeds for (random).

76
etc/NEWS
View file

@ -78,6 +78,10 @@ been adding them there, put them somewhere else, eg site-lisp.
* Changes in Emacs 24.3
** You can now scroll the selected window in most y-or-n prompts.
Typing C-v or M-v at a prompt scrolls forward or backward
respectively, without leaving the y-or-n prompt.
** Help changes
*** `C-h f' (describe-function) can now perform autoloading.
@ -97,6 +101,11 @@ machines. Other functions that use this format, such as
file-attributes and format-time-string, have been changed accordingly.
Old-format time stamps are still accepted.
** Emacs now generates backtraces on fatal errors.
On encountering a fatal error, Emacs now outputs a textual description
of the fatal signal, and a short backtrace on platforms like glibc
that support backtraces.
** New functions `system-users', `system-groups' return lists of the user
name, group names known to the system (where possible).
@ -177,6 +186,14 @@ just removing them, as done by `yank-excluded-properties'.
delete-trailing-whitespace command should delete trailing lines at the
end of the buffer. It defaults to t.
+++
** `C-x r +' is now overloaded to invoke `append-to-register.
+++
** New option `register-separator' specifies the register containing
the text to put between collected texts for use with M-x
append-to-register and M-x prepend-to-register.
** Search changes
*** Global `M-s _' starts a symbol (identifier) incremental search,
@ -192,6 +209,13 @@ of one or more whitespace characters defined by the variable
`isearch-lax-whitespace'. In regexp incremental search, it toggles
the value of the variable `isearch-regexp-lax-whitespace'.
** query-replace changes
*** When new option `replace-lax-whitespace' is non-nil,
and you enter a space or spaces in the strings or regexps
to be replaced, `query-replace' will match any sequence matched
by the regexp `search-whitespace-regexp'.
** M-x move-to-column, if called interactively with no prefix arg, now
prompts for a column number.
@ -411,6 +435,13 @@ channel keys found, if any.
if the command ends in `;' (when operating on multiple files).
Otherwise, it executes the command on each file in parallel.
*** The minibuffer default for `=' (`dired-diff) has changed.
It is now the backup file for the file at point, if one exists, rather
than the file at the mark.
*** `M-=' is no longer bound to `dired-backup-diff' in Dired buffers.
The global binding for `M-=', `count-words-region' is in effect.
** Shell
*** New option `async-shell-command-buffer' specifies what buffer to use
@ -601,6 +632,13 @@ are deprecated and will be removed eventually.
* Lisp changes in Emacs 24.3
** Interpreted files get eagerly macro-expanded during load.
This can significantly speed up execution of non-byte-compiled code, but can
also bump into harmless and previously unnoticed cyclic dependencies.
These should not be fatal: they will simply cause the macro-calls to be left
for later expansion (as before), but will also result in a warning describing
the cycle.
** New minor mode `read-only-mode' to replace toggle-read-only (now obsolete).
** New functions `autoloadp' and `autoload-do-load'.
@ -626,25 +664,40 @@ The interpretation of the DECLS is determined by `defun-declarations-alist'.
** New error type and new function `user-error'. Doesn't trigger the debugger.
** New option `debugger-bury-or-kill'.
+++
** New utility function `buffer-narrowed-p'.
** Window changes
*** The functions get-lru-window, get-mru-window and get-largest-window
now accept a third argument to avoid choosing the selected window.
*** New macro with-temp-buffer-window.
*** New macro `with-temp-buffer-window'.
*** New display action function display-buffer-below-selected.
*** New option `temp-buffer-resize-frames'.
*** New display action alist `inhibit-switch-frame', if non-nil, tells
display action functions to avoid changing which frame is selected.
*** New function `fit-frame-to-buffer' and new option
`fit-frame-to-buffer-bottom-margin'.
*** New display action alist `pop-up-frame-parameters', if non-nil,
specifies frame parameters to give any newly-created frame.
*** New display action functions `display-buffer-below-selected' and
`display-buffer-in-previous-window'.
*** New display action alist entry `inhibit-switch-frame', if non-nil,
tells display action functions to avoid changing which frame is
selected.
*** New display action alist entry `pop-up-frame-parameters', if
non-nil, specifies frame parameters to give any newly-created frame.
*** New display action alist entry `previous-window', if non-nil,
specifies window to reuse in `display-buffer-in-previous-window'.
*** The following variables are obsolete, as they can be replaced by
appropriate entries in the `display-buffer-alist' function introduced
in Emacs 24.1:
+++
**** `display-buffer-reuse-frames'
**** `special-display-regexps'
**** `special-display-frame-alist'
@ -671,6 +724,7 @@ by the underlying C implementation.
** `automount-dir-prefix' is obsolete.
** `buffer-has-markers-at' is obsolete.
** `window-system-version' is obsolete.
* Changes in Emacs 24.3 on non-free operating systems
@ -1403,6 +1457,10 @@ If you had that set, you need to put
in your ~/.authinfo file instead.
*** SMTPmail defaults to using the address in the From: header as the
SMTP MAIL FROM envelope. To override this, set `mail-envelope-from'
to the address you wish to use instead.
** SQL mode
*** New options `sql-port', `sql-connection-alist', `sql-send-terminator',
@ -1900,6 +1958,10 @@ instead of jumping all the way to the top-level.
*** Set `debug-on-event' to enter the debugger on events like SIGUSR1.
This can be useful when `inhibit-quit' is set.
*** Set `debug-on-message' to enter the debugger when a certain
message is displayed in the echo area. This can be useful when trying
to work out which code is doing something.
** The new function `server-eval-at' allows evaluation of Lisp forms on
named Emacs server instances.

4
leim/ChangeLog
View file

@ -1,3 +1,7 @@
2012-09-05 Eli Zaretskii <eliz@gnu.org>
* quail/hebrew.el ("yiddish-royal"): Fix several bogus entries.
2012-08-17 Daniel Bergey <bergey@alum.mit.edu> (tiny change)
* quail/indian.el (quail-define-inscript-package):

6
leim/quail/hebrew.el
View file

@ -773,9 +773,9 @@ Better for yiddish than Hebrew methods.
("@" ?,Y%(B) ; Double Low-9 Quotation Mark
("(" ?\)) ; mirroring
(")" ?\() ; mirroring
("Q" ?,A=(B) ; Right Double Quotation Mark
("W" ?,A<(B)
("E" ?,A>(B) ; Yiddish Double Yod (x2)
("Q" ?,Y4(B) ; Left Double Quotation Mark
("W" ?,Y!(B) ; Right Double Quotation Mark
("E" ?$,1-2(B) ; Yiddish Double Yod (x2)
("R" [ ",H`$,1,W(B" ]) ; Patah Alef (Pasekh Alef)
; ("T" "")
("Y" ?$,1-1(B) ; Ligature Yiddish Vav Yod (vov yud)

310
lisp/ChangeLog
View file

@ -1,13 +1,311 @@
2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var.
(emacs-lisp-byte-code-comment)
(emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode):
New functions.
(eval-sexp-add-defvars): Don't skip defvars in column >0.
(eval-defun-2): Remove bogus interactive spec.
(lisp-indent-line): Remove redundant whole-exp code, now done in
indent-according-to-mode.
(save-match-data): Remove redundant indent data.
* emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled):
Use `declare'.
2012-09-09 Juri Linkov <juri@jurta.org>
* replace.el (replace-regexp-lax-whitespace): New defcustom.
(replace-lax-whitespace, query-replace-regexp)
(query-replace-regexp-eval, replace-regexp): Doc fix.
(perform-replace, replace-highlight): Let-bind
isearch-lax-whitespace to replace-lax-whitespace and
isearch-regexp-lax-whitespace to replace-regexp-lax-whitespace.
* isearch.el (isearch-query-replace): Let-bind
replace-lax-whitespace to isearch-lax-whitespace and
replace-regexp-lax-whitespace to
isearch-regexp-lax-whitespace. (Bug#10885)
2012-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
* eshell/em-unix.el (eshell/sudo): Explicitly drop return value.
2012-09-09 Alan Mackenzie <acm@muc.de>
* progmodes/cc-engine.el (c-state-cache-init):
Initialise c-state-semi-nonlit-pos-cache\(-limit\)? properly.
(c-record-parse-state-state):
Record c-state-semi-nonlit-pos-cache\(-limit\)?.
2012-09-09 Andreas Schwab <schwab@linux-m68k.org>
* register.el (register-separator): Rename from
separator-register. All uses changed. Doc fix.
(register): Fix version.
2012-09-09 Chong Yidong <cyd@gnu.org>
* replace.el (query-replace-map): Bind four new symbols for
requesting window scrolling.
* subr.el (y-or-n-p): Handle the window-scrolling bindings in
query-replace-map (Bug#8948).
* custom.el (custom-theme-load-confirm): Use y-or-n-p.
* emacs-lisp/map-ynp.el (map-y-or-n-p): Don't bind scrolling keys
since they are now in query-replace-map.
* window.el (scroll-other-window-down): Make the arg optional.
2012-09-09 Chong Yidong <cyd@gnu.org>
* files.el (hack-local-variables-confirm): Use quit-window to kill
the *Local Variables* buffer.
2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-toggle-block): Guess the current block,
not just expect to be at its beginning. Adjust callees.
Succeed when do-end block has no space before the pipe character.
(ruby-brace-to-do-end): When the original block is one-liner,
convert to multiline. Reindent the result.
2012-09-08 Jambunathan K <kjambunathan@gmail.com>
* register.el (register): New group.
(register-separator): New user option.
(increment-register): Route it to `append-to-register', if
register contains text. Implication is that `C-x r +' can now be
used for appending to a text register (bug#12217).
(append-to-register, prepend-to-register): Add separator based on
`register-separator.
2012-09-08 Alan Mackenzie <acm@muc.de>
AWK Mode: make auto-newline work when there's "==" in the pattern.
* progmodes/cc-cmds.el (c-point-syntax): Handle virtual semicolons
correctly.
* progmodes/cc-engine.el (c-guess-basic-syntax CASE 5A.3):
Test more rigorously for "=" token.
2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-match-expression-expansion):
Only fail when reached LIMIT.
2012-09-08 Chong Yidong <cyd@gnu.org>
* dired.el (dired-mode-map): Don't bind M-=.
* dired-aux.el (dired-diff): Use backup file as default.
2012-09-08 Drew Adams <drew.adams@oracle.com>
* subr.el (add-to-history): Fix delete usage (Bug#12314).
2012-09-08 Chong Yidong <cyd@gnu.org>
* subr.el (syntax-after, syntax-class): Doc fix.
2012-09-08 Martin Rudalics <rudalics@gmx.at>
* window.el (display-buffer-in-previous-window): New buffer
display action function.
* emacs-lisp/debug.el (debugger-bury-or-kill): New option.
(debugger-previous-window): New variable.
(debug): Rewrite using display-buffer-in-previous-window,
quit-restore-window and debugger-bury-or-kill. (Bug#8789)
2012-09-07 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/byte-run.el (defun): Tweak message. Simplify code.
2012-09-07 Matt McClure <mlm@aya.yale.edu> (tiny change)
* progmodes/python.el (python-shell-send-string):
When default-directory is remote, create temp file on remote
filesystem.
(python-shell-send-file): When file is remote, pass local view of
file paths to remote Python interpreter. (Bug#12340)
2012-09-07 Chong Yidong <cyd@gnu.org>
* window.el (switch-to-buffer): Doc fix (Bug#12181).
* files.el (after-find-file): Don't fail on a read-only buffer if
require-final-newline is `visit' or `visit-save' (Bug#11156).
* subr.el (read-char-choice): Allow quitting via ESC ESC.
* userlock.el (ask-user-about-supersession-threat):
Use read-char-choice (Bug#12093).
2012-09-07 Chong Yidong <cyd@gnu.org>
* subr.el (buffer-narrowed-p): New function.
* ses.el (ses-widen):
* simple.el (count-words--buffer-message):
* net/browse-url.el (browse-url-of-buffer): Use it
* simple.el (count-words-region): Don't signal an error if there
is a non-nil prefix arg and the mark is not set.
* help.el (describe-key-briefly): Allow the message to be seen
when invoked from the minibuffer (Bug#7014).
2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-end-of-defun)
(ruby-beginning-of-defun): Simplify, allow indentation before
block beginning and end keywords.
(ruby-beginning-of-defun): Only consider 3 keywords defun beginners.
(ruby-end-of-defun): Expect that the point is at the beginning of
the defun.
2012-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el (cl--do-arglist): Understand _ on &key args
(bug#12367).
(cl--make-usage-args): Strip _ from argument names.
2012-09-06 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
* progmodes/vhdl-mode.el (vhdl-speedbar-initialize): Don't use
obsolete alias speedbar-key-map.
(vhdl-doc-variable, vhdl-doc-mode): Use called-interactively-p.
(vhdl-index-menu-init): Don't use obsolete variable
font-lock-maximum-size.
2012-09-06 Chong Yidong <cyd@gnu.org>
* frame.el (window-system-version): Mark as obsolete.
* speedbar.el (speedbar-update-flag, speedbar-mode): Remove uses
of obsolete variable speedbar-key-map.
2012-09-06 Juri Linkov <juri@jurta.org>
* replace.el (replace-lax-whitespace): New defcustom.
(query-replace, query-replace-regexp, query-replace-regexp-eval)
(replace-string, replace-regexp): Mention it in docstrings.
(perform-replace, replace-highlight): Let-bind
isearch-lax-whitespace and isearch-regexp-lax-whitespace according
to the values of replace-lax-whitespace and regexp-flag.
Don't let-bind search-whitespace-regexp. (Bug#10885)
* isearch.el (isearch-query-replace): Let-bind
replace-lax-whitespace instead of let-binding
replace-search-function and replace-re-search-function.
(isearch-lazy-highlight-search): Let-bind isearch-lax-whitespace
and isearch-regexp-lax-whitespace to lazy-highlight variables.
(isearch-toggle-symbol): Set isearch-regexp to nil
in isearch-word mode (like in isearch-toggle-word).
2012-09-06 Juri Linkov <juri@jurta.org>
* replace.el (replace-search-function)
(replace-re-search-function): Set default values to nil.
(perform-replace): Let-bind isearch-related variables based on
replace-related values, call `isearch-search-fun' and let-bind
the result to `search-function'. Remove code that sets
`search-function' and `search-string' separately for
`delimited-flag'.
(replace-highlight): Add new argument `delimited-flag' and
rename other arguments to the names used in `perform-replace'.
Let-bind `isearch-word' to the argument `delimited-flag'.
(Bug#10885, bug#10887)
2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-indent-beg-re): Add pieces from
ruby-beginning-of-indent, simplify, allow all keywords to have
indentation before them.
(ruby-beginning-of-indent): Adjust for above. Search until the
found point is not inside a string or comment.
(ruby-font-lock-keywords): Allow symbols to start with "@"
character, give them higher priority than variables.
(ruby-syntax-propertize-function)
(ruby-font-lock-syntactic-keywords): Remove the "not comments"
matchers. Expression expansions are not comments when inside a
string, and there comment syntax status is irrelevant.
(ruby-match-expression-expansion): New function. Check that
expression expansion is inside a string, and it's not escaped.
(ruby-font-lock-keywords): Use it.
2012-09-05 Martin Rudalics <rudalics@gmx.at>
* help.el (temp-buffer-max-height): New default value.
(temp-buffer-resize-frames): New option.
(resize-temp-buffer-window): Optionally resize frame.
* window.el (fit-frame-to-buffer-bottom-margin): New option.
(fit-frame-to-buffer): New function.
2012-09-05 Glenn Morris <rgm@gnu.org>
* emulation/cua-rect.el (cua--init-rectangles):
* textmodes/picture.el (picture-mode-map):
* play/blackbox.el (blackbox-mode-map): Remap right-char and left-char
like forward-char and backward-char. (Bug#12317)
2012-09-05 Leo Liu <sdl.web@gmail.com>
* progmodes/flymake.el (flymake-warning-re): New variable.
(flymake-parse-line): Use it.
2012-09-05 Glenn Morris <rgm@gnu.org>
* calendar/holidays.el (holiday-christian-holidays):
Rename an entry. (Bug#12289)
2012-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/sh-script.el (sh-font-lock-paren): Don't burp at BOB
(bug#12222).
2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
* loadup.el: Load macroexp. Remove hack.
* emacs-lisp/macroexp.el (macroexp--eval-if-compile): New function.
(macroexp--expand-all): Use it to get better warnings.
(macroexp--backtrace, macroexp--trim-backtrace-frame)
(internal-macroexpand-for-load): New functions.
(macroexp--pending-eager-loads): New var.
(emacs-startup-hook): New hack to replace one in loadup.el.
* emacs-lisp/cl-macs.el (cl--compiler-macro-list*)
(cl--compiler-macro-cXXr): Move to top, before they can be used.
(cl-psetf): Simplify.
(cl-defstruct): Add indent rule.
2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
* mail/smtpmail.el (smtpmail-send-it): Prefer the From: header
over `user-mail-address' for the SMTP MAIL FROM envelope.
(smtpmail-via-smtp): Ditto.
2012-09-04 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el: Clean up keybindings.
(ruby-mode-map): Don't bind ruby-electric-brace,
ruby-beginning-of-defun, ruby-end-of-defun, ruby-mark-defun,
backward-kill-word, reindent-then-newline-and-indent.
(ruby-mark-defun): Remove.
(ruby-electric-brace): Remove. Obsoleted by electric-indent-chars.
(ruby-mode): Set local beginning-of-defun-function and
end-of-defun-function values.
2012-09-03 Martin Rudalics <rudalics@gmx.at>
* window.el (temp-buffer-window-setup-hook)
(temp-buffer-window-show-hook): New hooks.
(temp-buffer-window-setup, temp-buffer-window-show)
(with-temp-buffer-window): New functions.
(fit-window-to-buffer): Remove unused optional argument
OVERRIDE.
(special-display-popup-frame): Make sure the window used shows
BUFFER.
(fit-window-to-buffer): Remove unused optional argument OVERRIDE.
(special-display-popup-frame): Make sure the window used shows BUFFER.
* help.el (temp-buffer-resize-mode): Fix doc-string.
(resize-temp-buffer-window): New optional argument WINDOW.
@ -149,8 +447,8 @@
2012-08-29 Michael Albinus <michael.albinus@gmx.de>
* eshell/esh-ext.el (eshell-external-command): Do not examine
remote shell scripts. See
<https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>.
remote shell scripts.
See <https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>.
* net/tramp-sh.el (tramp-remote-path): Add "/sbin" and
"/usr/local/sbin".

2
lisp/calendar/holidays.el
View file

@ -250,7 +250,7 @@ See the documentation for `calendar-holidays' for details."
(if calendar-christian-all-holidays-flag
(append
(holiday-fixed 1 6 "Epiphany")
(holiday-julian 12 25 "Eastern Orthodox Christmas")
(holiday-julian 12 25 "Christmas (Julian calendar)")
(holiday-greek-orthodox-easter)
(holiday-fixed 8 15 "Assumption")
(holiday-advent 0 "Advent")))))

45
lisp/custom.el
View file

@ -1223,38 +1223,19 @@ Return t if THEME was successfully loaded, nil otherwise."
"Query the user about loading a Custom theme that may not be safe.
The theme should be in the current buffer. If the user agrees,
query also about adding HASH to `custom-safe-themes'."
(if noninteractive
nil
(let ((exit-chars '(?y ?n ?\s))
window prompt char)
(save-window-excursion
(rename-buffer "*Custom Theme*" t)
(emacs-lisp-mode)
(setq window (display-buffer (current-buffer)))
(setq prompt
(format "Loading a theme can run Lisp code. Really load?%s"
(if (and window
(< (line-number-at-pos (point-max))
(window-body-height)))
" (y or n) "
(push ?\C-v exit-chars)
"\nType y or n, or C-v to scroll: ")))
(goto-char (point-min))
(while (null char)
(setq char (read-char-choice prompt exit-chars))
(when (eq char ?\C-v)
(if window
(with-selected-window window
(condition-case nil
(scroll-up)
(error (goto-char (point-min))))))
(setq char nil)))
(when (memq char '(?\s ?y))
;; Offer to save to `custom-safe-themes'.
(and (or custom-file user-init-file)
(y-or-n-p "Treat this theme as safe in future sessions? ")
(customize-push-and-save 'custom-safe-themes (list hash)))
t)))))
(unless noninteractive
(save-window-excursion
(rename-buffer "*Custom Theme*" t)
(emacs-lisp-mode)
(setq window (pop-to-buffer (current-buffer)))
(goto-char (point-min))
(prog1 (when (y-or-n-p "Loading a theme can run Lisp code. Really load? ")
;; Offer to save to `custom-safe-themes'.
(and (or custom-file user-init-file)
(y-or-n-p "Treat this theme as safe in future sessions? ")
(customize-push-and-save 'custom-safe-themes (list hash)))
t)
(quit-window)))))
(defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise.

53
lisp/dired-aux.el
View file

@ -54,43 +54,30 @@ into this list; they also should call `dired-log' to log the errors.")
;;;###autoload
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
FILE defaults to the file at the mark. (That's the mark set by
\\[set-mark-command], not by Dired's \\[dired-mark] command.)
The prompted-for FILE is the first file given to `diff'.
If called interactively, prompt for FILE; if the file at point
has a backup file, use that as the default.
FILE is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
which is the string of command switches for `diff'."
(interactive
(let* ((current (dired-get-filename t))
;; Get the file at the mark.
(file-at-mark (if (mark t)
(save-excursion (goto-char (mark t))
(dired-get-filename t t))))
;; Use it as default if it's not the same as the current file,
;; and the target dir is the current dir or the mark is active.
(default (if (and (not (equal file-at-mark current))
(or (equal (dired-dwim-target-directory)
(dired-current-directory))
mark-active))
file-at-mark))
(target-dir (if default
(dired-current-directory)
(dired-dwim-target-directory)))
(defaults (dired-dwim-target-defaults (list current) target-dir)))
(require 'diff)
(list
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function) nil)
(setq minibuffer-default defaults))
(read-file-name
(format "Diff %s with%s: " current
(if default (format " (default %s)" default) ""))
target-dir default t))
(if current-prefix-arg
(read-string "Options for diff: "
(if (stringp diff-switches)
diff-switches
(mapconcat 'identity diff-switches " ")))))))
(oldf (file-newest-backup current))
(dir (if oldf (file-name-directory oldf))))
(list (read-file-name
(format "Diff %s with%s: "
(file-name-nondirectory current)
(if oldf
(concat " (default "
(file-name-nondirectory oldf)
")")
""))
dir oldf t)
(if current-prefix-arg
(read-string "Options for diff: "
(if (stringp diff-switches)
diff-switches
(mapconcat 'identity diff-switches " ")))))))
(let ((current (dired-get-filename t)))
(when (or (equal (expand-file-name file)
(expand-file-name current))

10
lisp/dired.el
View file

@ -1410,7 +1410,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map "&" 'dired-do-async-shell-command)
;; Comparison commands
(define-key map "=" 'dired-diff)
(define-key map "\M-=" 'dired-backup-diff)
;; Tree Dired commands
(define-key map "\M-\C-?" 'dired-unmark-all-files)
(define-key map "\M-\C-d" 'dired-tree-down)
@ -3745,14 +3744,15 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown
;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
;;;;;; dired-diff) "dired-aux" "dired-aux.el" "9499f79f5853da0aa93d26465c7bf3a1")
;;;;;; dired-diff) "dired-aux" "dired-aux.el" "4b260eda371d319a6c8e8e5ec917e287")
;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\
Compare file at point with file FILE using `diff'.
FILE defaults to the file at the mark. (That's the mark set by
\\[set-mark-command], not by Dired's \\[dired-mark] command.)
The prompted-for FILE is the first file given to `diff'.
If called interactively, prompt for FILE; if the file at point
has a backup file, use that as the default.
FILE is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
which is the string of command switches for `diff'.

6
lisp/emacs-lisp/benchmark.el
View file

@ -53,6 +53,7 @@ FORMS once.
Return a list of the total elapsed time for execution, the number of
garbage collections that ran, and the time taken by garbage collection.
See also `benchmark-run-compiled'."
(declare (indent 1) (debug t))
(unless (natnump repetitions)
(setq forms (cons repetitions forms)
repetitions 1))
@ -69,8 +70,6 @@ See also `benchmark-run-compiled'."
`(benchmark-elapse ,@forms))
(- gcs-done ,gcs)
(- gc-elapsed ,gc)))))
(put 'benchmark-run 'edebug-form-spec t)
(put 'benchmark-run 'lisp-indent-function 2)
;;;###autoload
(defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@ -78,6 +77,7 @@ See also `benchmark-run-compiled'."
This is like `benchmark-run', but what is timed is a funcall of the
byte code obtained by wrapping FORMS in a `lambda' and compiling the
result. The overhead of the `lambda's is accounted for."
(declare (indent 1) (debug t))
(unless (natnump repetitions)
(setq forms (cons repetitions forms)
repetitions 1))
@ -96,8 +96,6 @@ result. The overhead of the `lambda's is accounted for."
(funcall ,lambda-code))))
`(benchmark-elapse (funcall ,code)))
(- gcs-done ,gcs) (- gc-elapsed ,gc)))))
(put 'benchmark-run-compiled 'edebug-form-spec t)
(put 'benchmark-run-compiled 'lisp-indent-function 2)
;;;###autoload
(defun benchmark (repetitions form)

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

@ -185,11 +185,10 @@ The return value is undefined.
((and (featurep 'cl)
(memq (car x) ;C.f. cl-do-proclaim.
'(special inline notinline optimize warn)))
(if (null (stringp docstring))
(push (list 'declare x) body)
(setcdr body (cons (list 'declare x) (cdr body))))
(push (list 'declare x)
(if (stringp docstring) (cdr body) body))
nil)
(t (message "Warning: Unknown defun property %S in %S"
(t (message "Warning: Unknown defun property `%S' in %S"
(car x) name)))))
decls))
(def (list 'defalias

28
lisp/emacs-lisp/cl-loaddefs.el
View file

@ -249,8 +249,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
;;;***
;;;### (autoloads (cl--compiler-macro-cXXr cl--compiler-macro-list*
;;;;;; cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
;;;### (autoloads (cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep
;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf
;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally
@ -260,9 +259,20 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "a1ca04b3f2acc7c9b06f45ef5486d443")
;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
;;;;;; "cl-macs" "cl-macs.el" "00526d56a1062b9c308cf37b59374f2b")
;;; Generated autoloads from cl-macs.el
(autoload 'cl--compiler-macro-list* "cl-macs" "\
\(fn FORM ARG &rest OTHERS)" nil nil)
(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
\(fn FORM X)" nil nil)
(autoload 'cl-gensym "cl-macs" "\
Generate a new uninterned symbol.
The name is made by appending a number to PREFIX, default \"G\".
@ -659,6 +669,8 @@ value, that slot cannot be set via `setf'.
(put 'cl-defstruct 'doc-string-elt '2)
(put 'cl-defstruct 'lisp-indent-function '1)
(autoload 'cl-deftype "cl-macs" "\
Define NAME as a new data type.
The type name can then be used in `cl-typecase', `cl-check-type', etc.
@ -722,16 +734,6 @@ surrounded by (cl-block NAME ...).
\(fn FORM A LIST &rest KEYS)" nil nil)
(autoload 'cl--compiler-macro-list* "cl-macs" "\
\(fn FORM ARG &rest OTHERS)" nil nil)
(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
\(fn FORM X)" nil nil)
;;;***
;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not

83
lisp/emacs-lisp/cl-macs.el
View file

@ -58,6 +58,33 @@
;;; Initialization.
;; Place compiler macros at the beginning, otherwise uses of the corresponding
;; functions can lead to recursive-loads that prevent the calls from
;; being optimized.
;;;###autoload
(defun cl--compiler-macro-list* (_form arg &rest others)
(let* ((args (reverse (cons arg others)))
(form (car args)))
(while (setq args (cdr args))
(setq form `(cons ,(car args) ,form)))
form))
;;;###autoload
(defun cl--compiler-macro-cXXr (form x)
(let* ((head (car form))
(n (symbol-name (car form)))
(i (- (length n) 2)))
(if (not (string-match "c[ad]+r\\'" n))
(if (and (fboundp head) (symbolp (symbol-function head)))
(cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
x)
(error "Compiler macro for cXXr applied to non-cXXr form"))
(while (> i (match-beginning 0))
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
(setq i (1- i)))
x)))
;;; Some predicates for analyzing Lisp forms.
;; These are used by various
;; macro expanders to optimize the results in certain common cases.
@ -366,9 +393,14 @@ its argument list allows full Common Lisp conventions."
(mapcar (lambda (x)
(cond
((symbolp x)
(if (eq ?\& (aref (symbol-name x) 0))
(setq state x)
(make-symbol (upcase (symbol-name x)))))
(let ((first (aref (symbol-name x) 0)))
(if (eq ?\& first)
(setq state x)
;; Strip a leading underscore, since it only
;; means that this argument is unused.
(make-symbol (upcase (if (eq ?_ first)
(substring (symbol-name x) 1)
(symbol-name x)))))))
((not (consp x)) x)
((memq state '(nil &rest)) (cl--make-usage-args x))
(t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
@ -452,7 +484,13 @@ its argument list allows full Common Lisp conventions."
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(let* ((karg (if (consp (car arg)) (caar arg)
(intern (format ":%s" (car arg)))))
(let ((name (symbol-name (car arg))))
;; Strip a leading underscore, since it only
;; means that this argument is unused, but
;; shouldn't affect the key's name (bug#12367).
(if (eq ?_ (aref name 0))
(setq name (substring name 1)))
(intern (format ":%s" name)))))
(varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
(or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
@ -1425,8 +1463,15 @@ Valid clauses are:
cl--loop-accum-var))))
(defun cl--loop-build-ands (clauses)
"Return various representations of (and . CLAUSES).
CLAUSES is a list of Elisp expressions, where clauses of the form
\(progn E1 E2 E3 .. t) are the focus of particular optimizations.
The return value has shape (COND BODY COMBO)
such that COMBO is equivalent to (and . CLAUSES)."
(let ((ands nil)
(body nil))
;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C
;; into (progn ,@A ,@B) ,@C.
(while clauses
(if (and (eq (car-safe (car clauses)) 'progn)
(eq (car (last (car clauses))) t))
@ -1437,6 +1482,7 @@ Valid clauses are:
(cl-cdadr clauses)
(list (cadr clauses))))
(cddr clauses)))
;; A final (progn ,@A t) is moved outside of the `and'.
(setq body (cdr (butlast (pop clauses)))))
(push (pop clauses) ands)))
(setq ands (or (nreverse ands) (list t)))
@ -1905,8 +1951,6 @@ See Info node `(cl)Declarations' for details."
(cl-do-proclaim (pop specs) nil)))
nil)
;;; The standard modify macros.
;; `setf' is now part of core Elisp, defined in gv.el.
@ -1929,7 +1973,7 @@ before assigning any PLACEs to the corresponding values.
(or p (error "Odd number of arguments to cl-psetf"))
(pop p))
(if simple
`(progn (setf ,@args) nil)
`(progn (setq ,@args) nil)
(setq args (reverse args))
(let ((expr `(setf ,(cadr args) ,(car args))))
(while (setq args (cddr args))
@ -2119,7 +2163,7 @@ one keyword is supported, `:read-only'. If this has a non-nil
value, that slot cannot be set via `setf'.
\(fn NAME SLOTS...)"
(declare (doc-string 2)
(declare (doc-string 2) (indent 1)
(debug
(&define ;Makes top-level form not be wrapped.
[&or symbolp
@ -2597,14 +2641,6 @@ surrounded by (cl-block NAME ...).
`(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list))
form))
;;;###autoload
(defun cl--compiler-macro-list* (_form arg &rest others)
(let* ((args (reverse (cons arg others)))
(form (car args)))
(while (setq args (cdr args))
(setq form `(cons ,(car args) ,form)))
form))
(defun cl--compiler-macro-get (_form sym prop &optional def)
(if def
`(cl-getf (symbol-plist ,sym) ,prop ,def)
@ -2616,21 +2652,6 @@ surrounded by (cl-block NAME ...).
(cl--make-type-test temp (cl--const-expr-val type)))
form))
;;;###autoload
(defun cl--compiler-macro-cXXr (form x)
(let* ((head (car form))
(n (symbol-name (car form)))
(i (- (length n) 2)))
(if (not (string-match "c[ad]+r\\'" n))
(if (and (fboundp head) (symbolp (symbol-function head)))
(cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
x)
(error "Compiler macro for cXXr applied to non-cXXr form"))
(while (> i (match-beginning 0))
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
(setq i (1- i)))
x)))
(dolist (y '(cl-first cl-second cl-third cl-fourth
cl-fifth cl-sixth cl-seventh
cl-eighth cl-ninth cl-tenth

163
lisp/emacs-lisp/debug.el
View file

@ -48,6 +48,39 @@ the middle is discarded, and just the beginning and end are displayed."
:group 'debugger
:version "21.1")
(defcustom debugger-bury-or-kill 'bury
"How to proceed with the debugger buffer when exiting `debug'.
The value used here affects the behavior of operations on any
window previously showing the debugger buffer.
`nil' means that if its window is not deleted when exiting the
debugger, invoking `switch-to-prev-buffer' will usually show
the debugger buffer again.
`append' means that if the window is not deleted, the debugger
buffer moves to the end of the window's previous buffers so
it's less likely that a future invocation of
`switch-to-prev-buffer' will switch to it. Also, it moves the
buffer to the end of the frame's buffer list.
`bury' means that if the window is not deleted, its buffer is
removed from the window's list of previous buffers. Also, it
moves the buffer to the end of the frame's buffer list. This
value provides the most reliable remedy to not have
`switch-to-prev-buffer' switch to the debugger buffer again
without killing the buffer.
`kill' means to kill the debugger buffer.
The value used here is passed to `quit-restore-window'."
:type '(choice
(const :tag "Keep alive" nil)
(const :tag "Append" 'append)
(const :tag "Bury" 'bury)
(const :tag "Kill" 'kill))
:group 'debugger
:version "24.2")
(defvar debug-function-list nil
"List of functions currently set for debug on entry.")
@ -60,6 +93,9 @@ the middle is discarded, and just the beginning and end are displayed."
(defvar debugger-old-buffer nil
"This is the buffer that was current when the debugger was entered.")
(defvar debugger-previous-window nil
"This is the window last showing the debugger buffer.")
(defvar debugger-previous-backtrace nil
"The contents of the previous backtrace (including text properties).
This is to optimize `debugger-make-xrefs'.")
@ -133,7 +169,7 @@ first will be printed into the backtrace buffer."
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
(debugger-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
(debugger-window nil)
(debugger-step-after-exit nil)
(debugger-will-be-back nil)
;; Don't keep reading from an executing kbd macro!
@ -184,78 +220,63 @@ first will be printed into the backtrace buffer."
(cursor-in-echo-area nil))
(unwind-protect
(save-excursion
(save-window-excursion
(with-no-warnings
(setq unread-command-char -1))
(when (eq (car debugger-args) 'debug)
;; Skip the frames for backtrace-debug, byte-code,
;; and implement-debug-on-entry.
(backtrace-debug 4 t)
;; Place an extra debug-on-exit for macro's.
(when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
(backtrace-debug 5 t)))
(pop-to-buffer debugger-buffer)
(debugger-mode)
(debugger-setup-buffer debugger-args)
(when noninteractive
;; If the backtrace is long, save the beginning
;; and the end, but discard the middle.
(when (> (count-lines (point-min) (point-max))
debugger-batch-max-lines)
(goto-char (point-min))
(forward-line (/ 2 debugger-batch-max-lines))
(let ((middlestart (point)))
(goto-char (point-max))
(forward-line (- (/ 2 debugger-batch-max-lines)
debugger-batch-max-lines))
(delete-region middlestart (point)))
(insert "...\n"))
(with-no-warnings
(setq unread-command-char -1))
(when (eq (car debugger-args) 'debug)
;; Skip the frames for backtrace-debug, byte-code,
;; and implement-debug-on-entry.
(backtrace-debug 4 t)
;; Place an extra debug-on-exit for macro's.
(when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
(backtrace-debug 5 t)))
(pop-to-buffer
debugger-buffer
`((display-buffer-reuse-window
display-buffer-in-previous-window)
. (,(when debugger-previous-window
`(previous-window . ,debugger-previous-window)))))
(setq debugger-window (selected-window))
(setq debugger-previous-window debugger-window)
(debugger-mode)
(debugger-setup-buffer debugger-args)
(when noninteractive
;; If the backtrace is long, save the beginning
;; and the end, but discard the middle.
(when (> (count-lines (point-min) (point-max))
debugger-batch-max-lines)
(goto-char (point-min))
(message "%s" (buffer-string))
(kill-emacs -1))
(forward-line (/ 2 debugger-batch-max-lines))
(let ((middlestart (point)))
(goto-char (point-max))
(forward-line (- (/ 2 debugger-batch-max-lines)
debugger-batch-max-lines))
(delete-region middlestart (point)))
(insert "...\n"))
(goto-char (point-min))
(message "%s" (buffer-string))
(kill-emacs -1))
(message "")
(let ((standard-output nil)
(buffer-read-only t))
(message "")
(let ((standard-output nil)
(buffer-read-only t))
(message "")
;; Make sure we unbind buffer-read-only in the right buffer.
(save-excursion
(recursive-edit)))))
;; Kill or at least neuter the backtrace buffer, so that users
;; don't try to execute debugger commands in an invalid context.
(if (get-buffer-window debugger-buffer 0)
;; Still visible despite the save-window-excursion? Maybe it
;; it's in a pop-up frame. It would be annoying to delete and
;; recreate it every time the debugger stops, so instead we'll
;; erase it (and maybe hide it) but keep it alive.
(with-current-buffer debugger-buffer
(with-selected-window (get-buffer-window debugger-buffer 0)
(when (and (window-dedicated-p (selected-window))
(not debugger-will-be-back))
;; If the window is not dedicated, burying the buffer
;; will mean that the frame created for it is left
;; around showing some random buffer, and next time we
;; pop to the debugger buffer we'll create yet
;; another frame.
;; If debugger-will-be-back is non-nil, the frame
;; would need to be de-iconified anyway immediately
;; after when we re-enter the debugger, so iconifying it
;; here would cause flashing.
;; Drew Adams is not happy with this: he wants to frame
;; to be left at the top-level, still working on how
;; best to do that.
(bury-buffer))))
(unless debugger-previous-state
(kill-buffer debugger-buffer)))
;; Restore the previous state of the debugger-buffer, in case we were
;; in a recursive invocation of the debugger.
(when (buffer-live-p debugger-buffer)
(with-current-buffer debugger-buffer
(let ((inhibit-read-only t))
(erase-buffer)
(if (null debugger-previous-state)
(fundamental-mode)
(insert (nth 1 debugger-previous-state))
(funcall (nth 0 debugger-previous-state))))))
;; Make sure we unbind buffer-read-only in the right buffer.
(save-excursion
(recursive-edit))))
(when (and (window-live-p debugger-window)
(eq (window-buffer debugger-window) debugger-buffer))
;; Unshow debugger-buffer.
(quit-restore-window debugger-window debugger-bury-or-kill))
;; Restore previous state of debugger-buffer in case we were
;; in a recursive invocation of the debugger, otherwise just
;; erase the buffer and put it into fundamental mode.
(when (buffer-live-p debugger-buffer)
(with-current-buffer debugger-buffer
(let ((inhibit-read-only t))
(erase-buffer)
(if (null debugger-previous-state)
(fundamental-mode)
(insert (nth 1 debugger-previous-state))
(funcall (nth 0 debugger-previous-state))))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
;; Put into effect the modified values of these variables

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

@ -431,6 +431,61 @@ if that value is non-nil."
(add-hook 'completion-at-point-functions
'lisp-completion-at-point nil 'local))
;;; Emacs Lisp Byte-Code mode
(eval-and-compile
(defconst emacs-list-byte-code-comment-re
(concat "\\(#\\)@\\([0-9]+\\) "
;; Make sure it's a docstring and not a lazy-loaded byte-code.
"\\(?:[^(]\\|([^\"]\\)")))
(defun emacs-lisp-byte-code-comment (end &optional _point)
"Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
(let ((ppss (syntax-ppss)))
(when (and (nth 4 ppss)
(eq (char-after (nth 8 ppss)) ?#))
(let* ((n (save-excursion
(goto-char (nth 8 ppss))
(when (looking-at emacs-list-byte-code-comment-re)
(string-to-number (match-string 2)))))
;; `maxdiff' tries to make sure the loop below terminates.
(maxdiff n))
(when n
(let* ((bchar (match-end 2))
(b (position-bytes bchar)))
(goto-char (+ b n))
(while (let ((diff (- (position-bytes (point)) b n)))
(unless (zerop diff)
(when (> diff maxdiff) (setq diff maxdiff))
(forward-char (- diff))
(setq maxdiff (if (> diff 0) diff
(max (1- maxdiff) 1)))
t))))
(if (<= (point) end)
(put-text-property (1- (point)) (point)
'syntax-table
(string-to-syntax "> b"))
(goto-char end)))))))
(defun emacs-lisp-byte-code-syntax-propertize (start end)
(emacs-lisp-byte-code-comment end (point))
(funcall
(syntax-propertize-rules
(emacs-list-byte-code-comment-re
(1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
start end))
(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
"Elisp-Byte-Code"
"Major mode for *.elc files."
;; TODO: Add way to disassemble byte-code under point.
(setq-local open-paren-in-column-0-is-defun-start nil)
(setq-local syntax-propertize-function
#'emacs-lisp-byte-code-syntax-propertize))
;;; Generic Lisp mode.
(defvar lisp-mode-map
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Lisp")))
@ -730,10 +785,12 @@ POS specifies the starting position where EXP was found and defaults to point."
(let ((vars ()))
(goto-char (point-min))
(while (re-search-forward
"^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
"(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
pos t)
(let ((var (intern (match-string 1))))
(unless (special-variable-p var)
(and (not (special-variable-p var))
(save-excursion
(zerop (car (syntax-ppss (match-beginning 0)))))
(push var vars))))
`(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
@ -820,7 +877,6 @@ if it already has a value.\)
With argument, insert value in current buffer after the defun.
Return the result of evaluation."
(interactive "P")
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
(let ((debug-on-error eval-expression-debug-on-error)
@ -925,6 +981,7 @@ rigidly along with this one."
(if (or (null indent) (looking-at "\\s<\\s<\\s<"))
;; Don't alter indentation of a ;;; comment line
;; or a line that starts in a string.
;; FIXME: inconsistency: comment-indent moves ;;; to column 0.
(goto-char (- (point-max) pos))
(if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
;; Single-semicolon comment lines should be indented
@ -939,18 +996,7 @@ rigidly along with this one."
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
;; If desired, shift remaining lines of expression the same amount.
(and whole-exp (not (zerop shift-amt))
(save-excursion
(goto-char beg)
(forward-sexp 1)
(setq end (point))
(goto-char beg)
(forward-line 1)
(setq beg (point))
(> end beg))
(indent-code-rigidly beg end shift-amt)))))
(goto-char (- (point-max) pos))))))
(defvar calculate-lisp-indent-last-sexp)
@ -1230,7 +1276,6 @@ Lisp function does not specify a special indentation."
(put 'prog2 'lisp-indent-function 2)
(put 'save-excursion 'lisp-indent-function 0)
(put 'save-restriction 'lisp-indent-function 0)
(put 'save-match-data 'lisp-indent-function 0)
(put 'save-current-buffer 'lisp-indent-function 0)
(put 'let 'lisp-indent-function 1)
(put 'let* 'lisp-indent-function 1)

110
lisp/emacs-lisp/macroexp.el
View file

@ -100,6 +100,17 @@ each clause."
(error (message "Compiler-macro error for %S: %S" (car form) err)
form)))
(defun macroexp--eval-if-compile (&rest _forms)
"Pseudo function used internally by macroexp to delay warnings.
The purpose is to delay warnings to bytecomp.el, so they can use things
like `byte-compile-log-warning' to get better file-and-line-number data
and also to avoid outputting the warning during normal execution."
nil)
(put 'macroexp--eval-if-compile 'byte-compile
(lambda (form)
(mapc (lambda (x) (funcall (eval x))) (cdr form))
(byte-compile-constant nil)))
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
@ -112,14 +123,17 @@ Assumes the caller has bound `macroexpand-all-environment'."
(macroexpand (macroexp--all-forms form 1)
macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments.
(let ((new-form (macroexpand form macroexpand-all-environment)))
(when (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
(get (car form) 'byte-obsolete-info)
(fboundp 'byte-compile-warn-obsolete))
(byte-compile-warn-obsolete (car form)))
(setq form new-form))
(let ((new-form
(macroexpand form macroexpand-all-environment)))
(setq form
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
(get (car form) 'byte-obsolete-info))
`(progn (macroexp--eval-if-compile
(lambda () (byte-compile-warn-obsolete ',(car form))))
,new-form)
new-form)))
(pcase form
(`(cond . ,clauses)
(macroexp--cons 'cond (macroexp--all-clauses clauses) form))
@ -323,6 +337,86 @@ symbol itself."
"Return non-nil if EXP can be copied without extra cost."
(or (symbolp exp) (macroexp-const-p exp)))
;;; Load-time macro-expansion.
;; Because macro-expansion used to be more lazy, eager macro-expansion
;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
;; So, we have to delay macro-expansion like we used to when we detect
;; such a cycle, and we also want to help coders resolve those cycles (since
;; they can be non-obvious) by providing a usefully trimmed backtrace
;; (hopefully) highlighting the problem.
(defun macroexp--backtrace ()
"Return the Elisp backtrace, more recent frames first."
(let ((bt ())
(i 0))
(while
(let ((frame (backtrace-frame i)))
(when frame
(push frame bt)
(setq i (1+ i)))))
(nreverse bt)))
(defun macroexp--trim-backtrace-frame (frame)
(pcase frame
(`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
(`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
(if (or (symbolp second)
(and (eq 'quote (car-safe second))
(symbolp (cadr second))))
`(macroexpand-all (,head ,second …))
'(macroexpand-all …)))
(`(,_ load-with-code-conversion ,name . ,_)
`(load ,(file-name-nondirectory name)))))
(defvar macroexp--pending-eager-loads nil
"Stack of files currently undergoing eager macro-expansion.")
(defun internal-macroexpand-for-load (form)
;; Called from the eager-macroexpansion in readevalloop.
(cond
;; Don't repeat the same warning for every top-level element.
((eq 'skip (car macroexp--pending-eager-loads)) form)
;; If we detect a cycle, skip macro-expansion for now, and output a warning
;; with a trimmed backtrace.
((and load-file-name (member load-file-name macroexp--pending-eager-loads))
(let* ((bt (delq nil
(mapcar #'macroexp--trim-backtrace-frame
(macroexp--backtrace))))
(elem `(load ,(file-name-nondirectory load-file-name)))
(tail (member elem (cdr (member elem bt)))))
(if tail (setcdr tail (list '…)))
(if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
(message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
(mapconcat #'prin1-to-string (nreverse bt) " => "))
(push 'skip macroexp--pending-eager-loads)
form))
(t
(condition-case err
(let ((macroexp--pending-eager-loads
(cons load-file-name macroexp--pending-eager-loads)))
(macroexpand-all form))
(error
;; Hopefully this shouldn't happen thanks to the cycle detection,
;; but in case it does happen, let's catch the error and give the
;; code a chance to macro-expand later.
(message "Eager macro-expansion failure: %S" err)
form)))))
;; ¡¡¡ Big Ugly Hack !!!
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
;; by compiling those files first, but this only makes a difference if those
;; files are not preloaded. But macroexp.el is preloaded so we reload it if
;; the current version is interpreted and there's a compiled version available.
(eval-when-compile
(add-hook 'emacs-startup-hook
(lambda ()
(and (not (byte-code-function-p
(symbol-function 'macroexpand-all)))
(locate-library "macroexp.elc")
(load "macroexp.elc")))))
(provide 'macroexp)
;;; macroexp.el ends here

10
lisp/emacs-lisp/map-ynp.el
View file

@ -123,16 +123,6 @@ Returns the number of actions taken."
map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map query-replace-map)
(define-key map [?\C-\M-v] 'scroll-other-window)
(define-key map [M-next] 'scroll-other-window)
(define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
(define-key map [M-prior] 'scroll-other-window-down)
;; The above are rather inconvenient, so maybe we should
;; provide the non-other keys for the other-scroll as well.
;; (define-key map [?\C-v] 'scroll-other-window)
;; (define-key map [next] 'scroll-other-window)
;; (define-key map [?\M-v] 'scroll-other-window-down)
;; (define-key map [prior] 'scroll-other-window-down)
(dolist (elt action-alist)
(define-key map (vector (car elt)) (vector (nth 1 elt))))
map)))

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

@ -60,6 +60,8 @@
;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
;; memoize previous macro expansions to try and avoid recomputing them
;; over and over again.
;; FIXME: Now that macroexpansion is also performed when loading an interpreted
;; file, this is not a real problem any more.
(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))

2
lisp/emulation/cua-rect.el
View file

@ -1423,7 +1423,9 @@ With prefix arg, indent to that column."
(define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark)
(define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right)
(define-key cua--rectangle-keymap [remap right-char] 'cua-resize-rectangle-right)
(define-key cua--rectangle-keymap [remap backward-char] 'cua-resize-rectangle-left)
(define-key cua--rectangle-keymap [remap left-char] 'cua-resize-rectangle-left)
(define-key cua--rectangle-keymap [remap next-line] 'cua-resize-rectangle-down)
(define-key cua--rectangle-keymap [remap previous-line] 'cua-resize-rectangle-up)
(define-key cua--rectangle-keymap [remap end-of-line] 'cua-resize-rectangle-eol)

2
lisp/eshell/em-unix.el
View file

@ -1111,7 +1111,7 @@ Execute a COMMAND as the superuser or another USER.")
(substring prefix 0 -1) user host dir)
(format "/sudo:%s@%s:%s" user host dir))))
;; Ensure, that Tramp has connected to that construct already.
(file-exists-p default-directory)
(ignore (file-exists-p default-directory))
(eshell-named-command (car orig-args) (cdr orig-args))))))))
(put 'eshell/sudo 'eshell-no-numeric-conversions t)

74
lisp/files.el
View file

@ -2145,7 +2145,7 @@ unless NOMODES is non-nil."
(not buffer-read-only)
(save-excursion
(goto-char (point-max))
(insert "\n")))
(ignore-errors (insert "\n"))))
(when (and buffer-read-only
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
@ -2951,20 +2951,16 @@ UNSAFE-VARS is the list of those that aren't marked as safe or risky.
RISKY-VARS is the list of those that are marked as risky.
If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
(if noninteractive
nil
(save-window-excursion
(let* ((name (or dir-name
(if buffer-file-name
(file-name-nondirectory buffer-file-name)
(concat "buffer " (buffer-name)))))
(offer-save (and (eq enable-local-variables t)
unsafe-vars))
(exit-chars
(if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
(buf (pop-to-buffer "*Local Variables*"))
prompt char)
(set (make-local-variable 'cursor-type) nil)
(unless noninteractive
(let ((name (cond (dir-name)
(buffer-file-name
(file-name-nondirectory buffer-file-name))
((concat "buffer " (buffer-name)))))
(offer-save (and (eq enable-local-variables t)
unsafe-vars))
(buf (get-buffer-create "*Local Variables*")))
;; Set up the contents of the *Local Variables* buffer.
(with-current-buffer buf
(erase-buffer)
(cond
(unsafe-vars
@ -2999,25 +2995,35 @@ n -- to ignore the local variables list.")
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
(setq prompt
(format "Please type %s%s: "
(if offer-save "y, n, or !" "y or n")
(if (< (line-number-at-pos) (window-body-height))
""
(push ?\C-v exit-chars)
", or C-v to scroll")))
(goto-char (point-min))
(while (null char)
(setq char (read-char-choice prompt exit-chars t))
(when (eq char ?\C-v)
(condition-case nil
(scroll-up)
(error (goto-char (point-min))))
(setq char nil)))
(kill-buffer buf)
(when (and offer-save (= char ?!) unsafe-vars)
(customize-push-and-save 'safe-local-variable-values unsafe-vars))
(memq char '(?! ?\s ?y))))))
(set (make-local-variable 'cursor-type) nil)
(set-buffer-modified-p nil)
(goto-char (point-min)))
;; Display the buffer and read a choice.
(save-window-excursion
(pop-to-buffer buf)
(let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
(prompt (format "Please type %s%s: "
(if offer-save "y, n, or !" "y or n")
(if (< (line-number-at-pos (point-max))
(window-body-height))
""
(push ?\C-v exit-chars)
", or C-v to scroll")))
char)
(if offer-save (push ?! exit-chars))
(while (null char)
(setq char (read-char-choice prompt exit-chars t))
(when (eq char ?\C-v)
(condition-case nil
(scroll-up)
(error (goto-char (point-min))
(recenter 1)))
(setq char nil)))
(when (and offer-save (= char ?!) unsafe-vars)
(customize-push-and-save 'safe-local-variable-values unsafe-vars))
(prog1 (memq char '(?! ?\s ?y))
(quit-window t)))))))
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.

4
lisp/frame.el
View file

@ -1657,6 +1657,10 @@ terminals, cursor blinking is controlled by the terminal."
(make-variable-buffer-local 'show-trailing-whitespace)
;; Defined in dispnew.c.
(make-obsolete-variable
'window-system-version "it does not give useful information." "24.3")
(provide 'frame)
;;; frame.el ends here

111
lisp/gnus/ChangeLog
View file

@ -1,3 +1,112 @@
2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
* qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction.
2012-09-07 Chong Yidong <cyd@gnu.org>
* gnus-util.el
(gnus-put-text-property-excluding-characters-with-faces): Restore.
* gnus-salt.el (gnus-tree-highlight-node):
* gnus-sum.el (gnus-summary-highlight-line):
* gnus-group.el (gnus-group-highlight-line): Revert use of add-face.
2012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-util.el: Fix compilation error on XEmacs 21.4.
2012-09-06 Juri Linkov <juri@jurta.org>
* gnus-group.el (gnus-read-ephemeral-gmane-group): Change the naming
scheme for buffer names to be more consistent with other group and
article buffer names in Gnus.
2012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-util.el
(gnus-put-text-property-excluding-characters-with-faces): Remove.
* gnus-compat.el: Define compat function `add-face' from Wolfgang
Jenkner.
* gnus-group.el (gnus-group-highlight-line): Use combining faces.
* gnus-sum.el (gnus-summary-highlight-line): Ditto.
* gnus-salt.el (gnus-tree-highlight-node): Ditto.
2012-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-score.el (gnus-score-decode-text-parts): Use #' for
mm-text-parts used in labels macro to make it work with XEmacs 21.5.
* gnus-util.el (gnus-string-prefix-p): New function, an alias to
string-prefix-p in Emacs >=23.2.
* nnmaildir.el (nnmaildir--ensure-suffix, nnmaildir--add-flag)
(nnmaildir--remove-flag, nnmaildir--scan): Use gnus-string-match-p
instead of string-match-p.
(nnmaildir--scan): Use gnus-string-prefix-p instead of string-prefix-p.
2012-09-06 Kenichi Handa <handa@gnu.org>
* qp.el (quoted-printable-decode-region): Fix previous change; handle
lowercase a..f.
2012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
* nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error.
2012-09-05 Martin Stjernholm <mast@lysator.liu.se>
* gnus-demon.el (gnus-demon-init): Fixed regression when IDLE is t and
TIME is set.
2012-09-05 Juri Linkov <juri@jurta.org>
* gnus-group.el (gnus-read-ephemeral-bug-group): Allow opening more
than one group at a time (bug#11961).
2012-09-05 Julien Danjou <julien@danjou.info>
* gnus-srvr.el (gnus-server-open-server): Don't message on failure:
this hide the real reason with a message giving absolutely no hint.
2012-09-05 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-group.el (gnus-group-mark-article-read): Propagate the read mark
to the backend (bug#11804).
* message.el (message-insert-newsgroups): Don't insert newsgroup
duplicates (bug#12275).
2012-09-05 John Wiegley <johnw@newartisans.com>
* gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in
sieve rules.
2012-09-05 Jan Tatarik <jan.tatarik@gmail.com>
* gnus-score.el (gnus-score-decode-text-parts): Use #' for the local
function.
* gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies.
* gnus-score.el (gnus-score-decode-text-parts): Ditto.
2012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
* nnmaildir.el: Make nnmaildir understand and write maildir flags.
That is, rename files from "unique:2," to "unique:2,S" for "seen", etc.
This should make nnmaildir more usable with offlineimap.
2012-09-03 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-notifications.el (gnus-notifications-notify): Use it.
* gnus-fun.el (gnus-funcall-no-warning): New function to silence
warnings on XEmacs.
2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
Better seeds for (random).
@ -2291,8 +2400,6 @@
2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
* dgnushack.el: Autoload sha1 on XEmacs.
* gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional
quit window configuration.

9
lisp/gnus/gnus-demon.el
View file

@ -144,9 +144,12 @@ marked with SPECIAL."
(* (gnus-demon-time-to-step time) gnus-demon-timestep))
(t
(* time gnus-demon-timestep))))
(idle (if (numberp idle)
(* idle gnus-demon-timestep)
idle))
(idle (cond ((numberp idle)
(* idle gnus-demon-timestep))
((and (eq idle t) (numberp time))
time)
(t
idle)))
(timer
(cond

4
lisp/gnus/gnus-fun.el
View file

@ -278,6 +278,10 @@ colors of the displayed X-Faces."
values))
(mapconcat 'identity values " ")))
(defun gnus-funcall-no-warning (function &rest args)
(when (fboundp function)
(apply function args)))
(provide 'gnus-fun)
;;; gnus-fun.el ends here

7
lisp/gnus/gnus-group.el
View file

@ -2388,7 +2388,7 @@ specified by `gnus-gmane-group-download-format'."
group start (+ start range)))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
(format "%s.start-%s.range-%s" group start range)
(format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
`(nndoc ,tmpfile
(nndoc-article-type mbox))))
(delete-file tmpfile)))
@ -2481,7 +2481,8 @@ the bug number, and browsing the URL must return mbox output."
"/.*$" ""))))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
"gnus-read-ephemeral-bug"
(format "nndoc+ephemeral:bug#%s"
(mapconcat 'number-to-string ids ","))
`(nndoc ,tmpfile
(nndoc-article-type mbox))
nil window-conf))
@ -4670,6 +4671,8 @@ you the groups that have both dormant articles and cached articles."
(setq mark gnus-expirable-mark))
(setq mark (gnus-request-update-mark
group article mark))
(gnus-request-set-mark
group (list (list (list article) 'add '(read))))
(gnus-mark-article-as-read article mark)
(setq gnus-newsgroup-active (gnus-active group))
(when active

73
lisp/gnus/gnus-logic.el
View file

@ -180,46 +180,51 @@
(setq header "article"))
(with-current-buffer nntp-server-buffer
(let* ((request-func (cond ((string= "head" header)
'gnus-request-head)
((string= "body" header)
'gnus-request-body)
(t 'gnus-request-article)))
ofunc article)
'gnus-request-head)
;; We need to peek at the headers to detect the
;; content encoding
((string= "body" header)
'gnus-request-article)
(t 'gnus-request-article)))
ofunc article handles)
;; Not all backends support partial fetching. In that case, we
;; just fetch the entire article.
(unless (gnus-check-backend-function
(intern (concat "request-" header))
gnus-newsgroup-name)
(setq ofunc request-func)
(setq request-func 'gnus-request-article))
(intern (concat "request-" header))
gnus-newsgroup-name)
(setq ofunc request-func)
(setq request-func 'gnus-request-article))
(setq article (mail-header-number gnus-advanced-headers))
(gnus-message 7 "Scoring article %s..." article)
(when (funcall request-func article gnus-newsgroup-name)
(goto-char (point-min))
;; If just parts of the article is to be searched and the
;; backend didn't support partial fetching, we just narrow to
;; the relevant parts.
(when ofunc
(if (eq ofunc 'gnus-request-head)
(narrow-to-region
(point)
(or (search-forward "\n\n" nil t) (point-max)))
(narrow-to-region
(or (search-forward "\n\n" nil t) (point))
(point-max))))
(let* ((case-fold-search (not (eq (downcase (symbol-name type))
(symbol-name type))))
(search-func
(cond ((memq type '(r R regexp Regexp))
're-search-forward)
((memq type '(s S string String))
'search-forward)
(t
(error "Invalid match type: %s" type)))))
(goto-char (point-min))
(prog1
(funcall search-func match nil t)
(widen)))))))
(when (string= "body" header)
(setq handles (gnus-score-decode-text-parts)))
(goto-char (point-min))
;; If just parts of the article is to be searched and the
;; backend didn't support partial fetching, we just narrow to
;; the relevant parts.
(when ofunc
(if (eq ofunc 'gnus-request-head)
(narrow-to-region
(point)
(or (search-forward "\n\n" nil t) (point-max)))
(narrow-to-region
(or (search-forward "\n\n" nil t) (point))
(point-max))))
(let* ((case-fold-search (not (eq (downcase (symbol-name type))
(symbol-name type))))
(search-func
(cond ((memq type '(r R regexp Regexp))
're-search-forward)
((memq type '(s S string String))
'search-forward)
(t
(error "Invalid match type: %s" type)))))
(goto-char (point-min))
(prog1
(funcall search-func match nil t)
(widen)))
(when handles (mm-destroy-parts handles))))))
(provide 'gnus-logic)

16
lisp/gnus/gnus-notifications.el
View file

@ -29,13 +29,16 @@
;;; Code:
(require 'notifications nil t)
(ignore-errors
(require 'notifications))
(require 'gnus-sum)
(require 'gnus-group)
(require 'gnus-int)
(require 'gnus-art)
(require 'gnus-util)
(require 'google-contacts nil t) ; Optional
(ignore-errors
(require 'google-contacts)) ; Optional
(require 'gnus-fun)
(defgroup gnus-notifications nil
"Send notifications on new message in Gnus."
@ -81,12 +84,14 @@ not get notifications."
"Send a notification about a new mail.
Return a notification id if any, or t on success."
(if (fboundp 'notifications-notify)
(notifications-notify
(gnus-funcall-no-warning
'notifications-notify
:title from
:body subject
:actions '("read" "Read")
:on-action 'gnus-notifications-action
:app-icon (image-search-load-path "gnus/gnus.png")
:app-icon (gnus-funcall-no-warning
'image-search-load-path "gnus/gnus.png")
:app-name "Gnus"
:category "email.arrived"
:timeout gnus-notifications-timeout
@ -100,7 +105,8 @@ Return a notification id if any, or t on success."
(let ((google-photo (when (and gnus-notifications-use-google-contacts
(fboundp 'google-contacts-get-photo))
(ignore-errors
(google-contacts-get-photo mail-address)))))
(gnus-funcall-no-warning
'google-contacts-get-photo mail-address)))))
(if google-photo
google-photo
(when gnus-notifications-use-gravatar

231
lisp/gnus/gnus-score.el
View file

@ -1717,105 +1717,140 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq entries rest)))))
nil)
(defun gnus-score-decode-text-parts ()
(labels ((mm-text-parts (handle)
(cond ((stringp (car handle))
(let ((parts (mapcan #'mm-text-parts (cdr handle))))
(if (equal "multipart/alternative" (car handle))
;; pick the first supported alternative
(list (car parts))
parts)))
((bufferp (car handle))
(when (string-match "^text/" (mm-handle-media-type handle))
(list handle)))
(t (mapcan #'mm-text-parts handle))))
(my-mm-display-part (handle)
(when handle
(save-restriction
(narrow-to-region (point) (point))
(mm-display-inline handle)
(goto-char (point-max))))))
(let (;(mm-text-html-renderer 'w3m-standalone)
(handles (mm-dissect-buffer t)))
(save-excursion
(article-goto-body)
(delete-region (point) (point-max))
(mapc #'my-mm-display-part (mm-text-parts handles))
handles))))
(defun gnus-score-body (scores header now expire &optional trace)
(if gnus-agent-fetching
nil
(save-excursion
(setq gnus-scores-articles
(sort gnus-scores-articles
(lambda (a1 a2)
(< (mail-header-number (car a1))
(mail-header-number (car a2))))))
(set-buffer nntp-server-buffer)
(save-restriction
(let* ((buffer-read-only nil)
(articles gnus-scores-articles)
(all-scores scores)
(request-func (cond ((string= "head" header)
'gnus-request-head)
((string= "body" header)
'gnus-request-body)
(t 'gnus-request-article)))
entries alist ofunc article last)
(when articles
(setq last (mail-header-number (caar (last articles))))
;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
(unless (gnus-check-backend-function
(and (string-match "^gnus-" (symbol-name request-func))
(intern (substring (symbol-name request-func)
(match-end 0))))
gnus-newsgroup-name)
(setq ofunc request-func)
(setq request-func 'gnus-request-article))
(while articles
(setq article (mail-header-number (caar articles)))
(gnus-message 7 "Scoring article %s of %s..." article last)
(widen)
(when (funcall request-func article gnus-newsgroup-name)
(goto-char (point-min))
;; If just parts of the article is to be searched, but the
;; backend didn't support partial fetching, we just narrow
;; to the relevant parts.
(when ofunc
(if (eq ofunc 'gnus-request-head)
(narrow-to-region
(point)
(or (search-forward "\n\n" nil t) (point-max)))
(narrow-to-region
(or (search-forward "\n\n" nil t) (point))
(point-max))))
(setq scores all-scores)
;; Find matches.
(while scores
(setq alist (pop scores)
entries (assoc header alist))
(while (cdr entries) ;First entry is the header index.
(let* ((rest (cdr entries))
(kill (car rest))
(match (nth 0 kill))
(type (or (nth 3 kill) 's))
(score (or (nth 1 kill)
gnus-score-interactive-default-score))
(date (nth 2 kill))
(found nil)
(case-fold-search
(not (or (eq type 'R) (eq type 'S)
(eq type 'Regexp) (eq type 'String))))
(search-func
(cond ((or (eq type 'r) (eq type 'R)
(eq type 'regexp) (eq type 'Regexp))
're-search-forward)
((or (eq type 's) (eq type 'S)
(eq type 'string) (eq type 'String))
'search-forward)
(t
(error "Invalid match type: %s" type)))))
(goto-char (point-min))
(when (funcall search-func match nil t)
;; Found a match, update scores.
(setcdr (car articles) (+ score (cdar articles)))
(setq found t)
(when trace
(push
(cons (car-safe (rassq alist gnus-score-cache))
kill)
gnus-score-trace)))
;; Update expire date
(unless trace
(cond
((null date)) ;Permanent entry.
((and found gnus-update-score-entry-dates)
;; Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
((and expire (< date expire)) ;Old entry, remove.
(gnus-score-set 'touched '(t) alist)
(setcdr entries (cdr rest))
(setq rest entries))))
(setq entries rest)))))
(setq articles (cdr articles)))))))
nil))
(if gnus-agent-fetching
nil
(save-excursion
(setq gnus-scores-articles
(sort gnus-scores-articles
(lambda (a1 a2)
(< (mail-header-number (car a1))
(mail-header-number (car a2))))))
(set-buffer nntp-server-buffer)
(save-restriction
(let* ((buffer-read-only nil)
(articles gnus-scores-articles)
(all-scores scores)
(request-func (cond ((string= "head" header)
'gnus-request-head)
;; We need to peek at the headers to detect
;; the content encoding
((string= "body" header)
'gnus-request-article)
(t 'gnus-request-article)))
entries alist ofunc article last)
(when articles
(setq last (mail-header-number (caar (last articles))))
;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
(unless (gnus-check-backend-function
(and (string-match "^gnus-" (symbol-name request-func))
(intern (substring (symbol-name request-func)
(match-end 0))))
gnus-newsgroup-name)
(setq ofunc request-func)
(setq request-func 'gnus-request-article))
(while articles
(setq article (mail-header-number (caar articles)))
(gnus-message 7 "Scoring article %s of %s..." article last)
(widen)
(let (handles)
(when (funcall request-func article gnus-newsgroup-name)
(when (string= "body" header)
(setq handles (gnus-score-decode-text-parts)))
(goto-char (point-min))
;; If just parts of the article is to be searched, but the
;; backend didn't support partial fetching, we just narrow
;; to the relevant parts.
(when ofunc
(if (eq ofunc 'gnus-request-head)
(narrow-to-region
(point)
(or (search-forward "\n\n" nil t) (point-max)))
(narrow-to-region
(or (search-forward "\n\n" nil t) (point))
(point-max))))
(setq scores all-scores)
;; Find matches.
(while scores
(setq alist (pop scores)
entries (assoc header alist))
(while (cdr entries) ;First entry is the header index.
(let* ((rest (cdr entries))
(kill (car rest))
(match (nth 0 kill))
(type (or (nth 3 kill) 's))
(score (or (nth 1 kill)
gnus-score-interactive-default-score))
(date (nth 2 kill))
(found nil)
(case-fold-search
(not (or (eq type 'R) (eq type 'S)
(eq type 'Regexp) (eq type 'String))))
(search-func
(cond ((or (eq type 'r) (eq type 'R)
(eq type 'regexp) (eq type 'Regexp))
're-search-forward)
((or (eq type 's) (eq type 'S)
(eq type 'string) (eq type 'String))
'search-forward)
(t
(error "Invalid match type: %s" type)))))
(goto-char (point-min))
(when (funcall search-func match nil t)
;; Found a match, update scores.
(setcdr (car articles) (+ score (cdar articles)))
(setq found t)
(when trace
(push
(cons (car-safe (rassq alist gnus-score-cache))
kill)
gnus-score-trace)))
;; Update expire date
(unless trace
(cond
((null date)) ;Permanent entry.
((and found gnus-update-score-entry-dates)
;; Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
((and expire (< date expire)) ;Old entry, remove.
(gnus-score-set 'touched '(t) alist)
(setcdr entries (cdr rest))
(setq rest entries))))
(setq entries rest))))
(when handles (mm-destroy-parts handles))))
(setq articles (cdr articles)))))))
nil))
(defun gnus-score-thread (scores header now expire &optional trace)
(gnus-score-followup scores header now expire trace t))

3
lisp/gnus/gnus-srvr.el
View file

@ -490,8 +490,7 @@ The following commands are available:
(error "No such server: %s" server))
(gnus-server-set-status method 'ok)
(prog1
(or (gnus-open-server method)
(progn (message "Couldn't open %s" server) nil))
(gnus-open-server method)
(gnus-server-update-server server)
(gnus-server-position-point))))

12
lisp/gnus/gnus-util.el
View file

@ -1926,6 +1926,18 @@ Same as `string-match' except this function does not change the match data."
(save-match-data
(string-match regexp string start))))
(if (fboundp 'string-prefix-p)
(defalias 'gnus-string-prefix-p 'string-prefix-p)
(defun gnus-string-prefix-p (str1 str2 &optional ignore-case)
"Return non-nil if STR1 is a prefix of STR2.
If IGNORE-CASE is non-nil, the comparison is done without paying attention
to case differences."
(and (<= (length str1) (length str2))
(let ((prefix (substring str2 0 (length str1))))
(if ignore-case
(string-equal (downcase str1) (downcase prefix))
(string-equal str1 prefix))))))
(eval-and-compile
(if (fboundp 'macroexpand-all)
(defalias 'gnus-macroexpand-all 'macroexpand-all)

45
lisp/gnus/gnus.el
View file

@ -3824,12 +3824,28 @@ You should probably use `gnus-find-method-for-group' instead."
"Go through PARAMETERS and expand them according to the match data."
(let (new)
(dolist (elem parameters)
(if (and (stringp (cdr elem))
(string-match "\\\\[0-9&]" (cdr elem)))
(push (cons (car elem)
(gnus-expand-group-parameter match (cdr elem) group))
new)
(push elem new)))
(cond
((and (stringp (cdr elem))
(string-match "\\\\[0-9&]" (cdr elem)))
(push (cons (car elem)
(gnus-expand-group-parameter match (cdr elem) group))
new))
;; For `sieve' group parameters, perform substitutions for every
;; string within the match rule. This allows for parameters such
;; as:
;; ("list\\.\\(.*\\)"
;; (sieve header :is "list-id" "<\\1.domain.org>"))
((eq 'sieve (car elem))
(push (mapcar (lambda (sieve-elem)
(if (and (stringp sieve-elem)
(string-match "\\\\[0-9&]" sieve-elem))
(gnus-expand-group-parameter match sieve-elem
group)
sieve-elem))
(cdr elem))
new))
(t
(push elem new))))
new))
(defun gnus-group-fast-parameter (group symbol &optional allow-list)
@ -3861,9 +3877,20 @@ The function `gnus-group-find-parameter' will do that for you."
(when this-result
(setq result (car this-result))
;; Expand if necessary.
(if (and (stringp result) (string-match "\\\\[0-9&]" result))
(setq result (gnus-expand-group-parameter
(car head) result group)))))))
(cond
((and (stringp result) (string-match "\\\\[0-9&]" result))
(setq result (gnus-expand-group-parameter
(car head) result group)))
;; For `sieve' group parameters, perform substitutions
;; for every string within the match rule (see above).
((eq symbol 'sieve)
(setq result
(mapcar (lambda (elem)
(if (stringp elem)
(gnus-expand-group-parameter (car head)
elem group)
elem))
result))))))))
;; Done.
result))))

32
lisp/gnus/message.el
View file

@ -3292,11 +3292,33 @@ or in the synonym headers, defined by `message-header-synonyms'."
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
(when (and (message-position-on-field "Newsgroups")
(mail-fetch-field "newsgroups")
(not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
(insert ","))
(insert (or (message-fetch-reply-field "newsgroups") "")))
(let ((old-newsgroups (mail-fetch-field "newsgroups"))
(new-newsgroups (message-fetch-reply-field "newsgroups"))
(first t)
insert-newsgroups)
(message-position-on-field "Newsgroups")
(cond
((not new-newsgroups)
(error "No Newsgroups to insert"))
((not old-newsgroups)
(insert new-newsgroups))
(t
(setq new-newsgroups (split-string new-newsgroups "[, ]+")
old-newsgroups (split-string old-newsgroups "[, ]+"))
(dolist (group new-newsgroups)
(unless (member group old-newsgroups)
(push group insert-newsgroups)))
(if (null insert-newsgroups)
(error "Newgroup%s already in the header"
(if (> (length new-newsgroups) 1)
"s" ""))
(when old-newsgroups
(setq first nil))
(dolist (group insert-newsgroups)
(unless first
(insert ","))
(setq first nil)
(insert group)))))))

286
lisp/gnus/nnmaildir.el
View file

@ -77,6 +77,56 @@
(defconst nnmaildir-version "Gnus")
(defconst nnmaildir-flag-mark-mapping
'((?F . tick)
(?R . reply)
(?S . read))
"Alist mapping Maildir filename flags to Gnus marks.
Maildir filenames are of the form \"unique-id:2,FLAGS\",
where FLAGS are a string of characters in ASCII order.
Some of the FLAGS correspond to Gnus marks.")
(defsubst nnmaildir--mark-to-flag (mark)
"Find the Maildir flag that corresponds to MARK (an atom).
Return a character, or `nil' if not found.
See `nnmaildir-flag-mark-mapping'."
(car (rassq mark nnmaildir-flag-mark-mapping)))
(defsubst nnmaildir--flag-to-mark (flag)
"Find the Gnus mark that corresponds to FLAG (a character).
Return an atom, or `nil' if not found.
See `nnmaildir-flag-mark-mapping'."
(cdr (assq flag nnmaildir-flag-mark-mapping)))
(defun nnmaildir--ensure-suffix (filename)
"Ensure that FILENAME contains the suffix \":2,\"."
(if (gnus-string-match-p ":2," filename)
filename
(concat filename ":2,")))
(defun nnmaildir--add-flag (flag suffix)
"Return a copy of SUFFIX where FLAG is set.
SUFFIX should start with \":2,\"."
(unless (gnus-string-match-p "^:2," suffix)
(error "Invalid suffix `%s'" suffix))
(let* ((flags (substring suffix 3))
(flags-as-list (append flags nil))
(new-flags
(concat (gnus-delete-duplicates
;; maildir flags must be sorted
(sort (cons flag flags-as-list) '<)))))
(concat ":2," new-flags)))
(defun nnmaildir--remove-flag (flag suffix)
"Return a copy of SUFFIX where FLAG is cleared.
SUFFIX should start with \":2,\"."
(unless (gnus-string-match-p "^:2," suffix)
(error "Invalid suffix `%s'" suffix))
(let* ((flags (substring suffix 3))
(flags-as-list (append flags nil))
(new-flags (concat (delq flag flags-as-list))))
(concat ":2," new-flags)))
(defvar nnmaildir-article-file-name nil
"*The filename of the most recently requested article. This variable is set
by nnmaildir-request-article.")
@ -152,6 +202,16 @@ by nnmaildir-request-article.")
(gnm nil) ;; flag: split from mail-sources?
(target-prefix nil :type string)) ;; symlink target prefix
(defun nnmaildir--article-set-flags (article new-suffix curdir)
(let* ((prefix (nnmaildir--art-prefix article))
(suffix (nnmaildir--art-suffix article))
(article-file (concat curdir prefix suffix))
(new-name (concat curdir prefix new-suffix)))
(unless (file-exists-p article-file)
(error "Couldn't find article file %s" article-file))
(rename-file article-file new-name 'replace)
(setf (nnmaildir--art-suffix article) new-suffix)))
(defun nnmaildir--expired-article (group article)
(setf (nnmaildir--art-nov article) nil)
(let ((flist (nnmaildir--grp-flist group))
@ -208,29 +268,33 @@ by nnmaildir-request-article.")
(eval param))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
(declare (debug (body)))
`(with-current-buffer nntp-server-buffer
,@body))
(defmacro nnmaildir--with-work-buffer (&rest body)
(declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir work*")
,@body))
(defmacro nnmaildir--with-nov-buffer (&rest body)
(declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir nov*")
,@body))
(defmacro nnmaildir--with-move-buffer (&rest body)
(declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir move*")
,@body))
(defmacro nnmaildir--subdir (dir subdir)
`(file-name-as-directory (concat ,dir ,subdir)))
(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
`(nnmaildir--subdir ,srv-dir ,gname))
(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
(defsubst nnmaildir--subdir (dir subdir)
(file-name-as-directory (concat dir subdir)))
(defsubst nnmaildir--srvgrp-dir (srv-dir gname)
(nnmaildir--subdir srv-dir gname))
(defsubst nnmaildir--tmp (dir) (nnmaildir--subdir dir "tmp"))
(defsubst nnmaildir--new (dir) (nnmaildir--subdir dir "new"))
(defsubst nnmaildir--cur (dir) (nnmaildir--subdir dir "cur"))
(defsubst nnmaildir--nndir (dir) (nnmaildir--subdir dir ".nnmaildir"))
(defsubst nnmaildir--nov-dir (dir) (nnmaildir--subdir dir "nov"))
(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks"))
(defsubst nnmaildir--num-dir (dir) (nnmaildir--subdir dir "num"))
(defmacro nnmaildir--unlink (file-arg)
`(let ((file ,file-arg))
@ -305,6 +369,7 @@ by nnmaildir-request-article.")
string)
(defmacro nnmaildir--condcase (errsym body &rest handler)
(declare (debug (sexp form body)))
`(condition-case ,errsym
(let ((system-messages-locale "C")) ,body)
(error . ,handler)))
@ -759,7 +824,7 @@ by nnmaildir-request-article.")
(dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
(setq x (concat ndir file))
(and (time-less-p (nth 5 (file-attributes x)) (current-time))
(rename-file x (concat cdir file ":2,"))))
(rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
(setf (nnmaildir--grp-new group) nattr))
(setq cattr (nth 5 (file-attributes cdir)))
(if (equal cattr (nnmaildir--grp-cur group))
@ -784,11 +849,23 @@ by nnmaildir-request-article.")
cdir (nnmaildir--marks-dir nndir)
ndir (nnmaildir--subdir cdir "tick")
cdir (nnmaildir--subdir cdir "read"))
(dolist (file files)
(setq file (car file))
(if (or (not (file-exists-p (concat cdir file)))
(file-exists-p (concat ndir file)))
(setq num (1+ num)))))
(dolist (prefix-suffix files)
(let ((prefix (car prefix-suffix))
(suffix (cdr prefix-suffix)))
;; increase num for each unread or ticked article
(when (or
;; first look for marks in suffix, if it's valid...
(when (and (stringp suffix)
(gnus-string-prefix-p ":2," suffix))
(or
(not (gnus-string-match-p
(string (nnmaildir--mark-to-flag 'read)) suffix))
(gnus-string-match-p
(string (nnmaildir--mark-to-flag 'tick)) suffix)))
;; then look in marks directories
(not (file-exists-p (concat cdir prefix)))
(file-exists-p (concat ndir prefix)))
(incf num)))))
(setf (nnmaildir--grp-cache group) (make-vector num nil))
(let ((inhibit-quit t))
(set (intern gname groups) group))
@ -916,12 +993,15 @@ by nnmaildir-request-article.")
"\n")))))
'group)
(defun nnmaildir-request-marks (gname info &optional server)
(let ((group (nnmaildir--prepare server gname))
pgname flist always-marks never-marks old-marks dotfile num dir
markdirs marks mark ranges markdir article read end new-marks ls
old-mmth new-mmth mtime mark-sym existing missing deactivate-mark
article-list)
(defun nnmaildir-request-update-info (gname info &optional server)
(let* ((group (nnmaildir--prepare server gname))
(curdir (nnmaildir--cur
(nnmaildir--srvgrp-dir
(nnmaildir--srv-dir nnmaildir--cur-server) gname)))
(curdir-mtime (nth 5 (file-attributes curdir)))
pgname flist always-marks never-marks old-marks dotfile num dir
all-marks marks mark ranges markdir read end new-marks ls
old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
(catch 'return
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
@ -950,34 +1030,71 @@ by nnmaildir-request-article.")
dir (nnmaildir--nndir dir)
dir (nnmaildir--marks-dir dir)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
new-mmth (nnmaildir--up2-1 (length markdirs))
all-marks (gnus-delete-duplicates
;; get mark names from mark dirs and from flag
;; mappings
(append
(mapcar 'cdr nnmaildir-flag-mark-mapping)
(mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort))))
new-mmth (nnmaildir--up2-1 (length all-marks))
new-mmth (make-vector new-mmth 0)
old-mmth (nnmaildir--grp-mmth group))
(dolist (mark markdirs)
(setq markdir (nnmaildir--subdir dir mark)
mark-sym (intern mark)
(dolist (mark all-marks)
(setq markdir (nnmaildir--subdir dir (symbol-name mark))
ranges nil)
(catch 'got-ranges
(if (memq mark-sym never-marks) (throw 'got-ranges nil))
(when (memq mark-sym always-marks)
(if (memq mark never-marks) (throw 'got-ranges nil))
(when (memq mark always-marks)
(setq ranges existing)
(throw 'got-ranges nil))
(setq mtime (nth 5 (file-attributes markdir)))
(set (intern mark new-mmth) mtime)
(when (equal mtime (symbol-value (intern-soft mark old-mmth)))
(setq ranges (assq mark-sym old-marks))
;; Find the mtime for this mark. If this mark can be expressed as
;; a filename flag, get the later of the mtimes for markdir and
;; curdir, otherwise only the markdir counts.
(setq mtime
(let ((markdir-mtime (nth 5 (file-attributes markdir))))
(cond
((null (nnmaildir--mark-to-flag mark))
markdir-mtime)
((null markdir-mtime)
curdir-mtime)
((null curdir-mtime)
;; this should never happen...
markdir-mtime)
((time-less-p markdir-mtime curdir-mtime)
curdir-mtime)
(t
markdir-mtime))))
(set (intern (symbol-name mark) new-mmth) mtime)
(when (equal mtime (symbol-value (intern-soft (symbol-name mark) old-mmth)))
(setq ranges (assq mark old-marks))
(if ranges (setq ranges (cdr ranges)))
(throw 'got-ranges nil))
(setq article-list nil)
(dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
(setq article (nnmaildir--flist-art flist prefix))
(if article
(setq article-list
(cons (nnmaildir--art-num article) article-list))))
(setq ranges (gnus-add-to-range ranges (sort article-list '<))))
(if (eq mark-sym 'read) (setq read ranges)
(if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
(let ((article-list nil))
;; Consider the article marked if it either has the flag in the
;; filename, or is in the markdir. As you'd rarely remove a
;; flag/mark, this should avoid losing information in the most
;; common usage pattern.
(or
(let ((flag (nnmaildir--mark-to-flag mark)))
;; If this mark has a corresponding maildir flag...
(when flag
(let ((regexp
(concat "\\`[^.].*:2,[A-Z]*" (string flag))))
;; ...then find all files with that flag.
(dolist (filename (funcall ls curdir nil regexp 'nosort))
(let* ((prefix (car (split-string filename ":2,")))
(article (nnmaildir--flist-art flist prefix)))
(when article
(push (nnmaildir--art-num article) article-list)))))))
;; Also check Gnus-specific mark directory, if it exists.
(when (file-directory-p markdir)
(dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
(let ((article (nnmaildir--flist-art flist prefix)))
(when article
(push (nnmaildir--art-num article) article-list))))))
(setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
(if (eq mark 'read) (setq read ranges)
(if ranges (setq marks (cons (cons mark ranges) marks)))))
(gnus-info-set-read info (gnus-range-add read missing))
(gnus-info-set-marks info marks 'extend)
(setf (nnmaildir--grp-mmth group) new-mmth)
@ -1525,39 +1642,63 @@ by nnmaildir-request-article.")
didnt)))
(defun nnmaildir-request-set-mark (gname actions &optional server)
(let ((group (nnmaildir--prepare server gname))
(coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
(file-coding-system-alist nil)
del-mark del-action add-action set-action marksdir nlist
ranges begin end article all-marks todo-marks mdir mfile
pgname ls permarkfile deactivate-mark)
(let* ((group (nnmaildir--prepare server gname))
(curdir (nnmaildir--cur
(nnmaildir--srvgrp-dir
(nnmaildir--srv-dir nnmaildir--cur-server)
gname)))
(coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
(file-coding-system-alist nil)
del-mark del-action add-action set-action marksdir nlist
ranges begin end article all-marks todo-marks mdir mfile
pgname ls permarkfile deactivate-mark)
(setq del-mark
(lambda (mark)
(setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
mfile (concat mfile (nnmaildir--art-prefix article)))
(nnmaildir--unlink mfile))
(let ((prefix (nnmaildir--art-prefix article))
(suffix (nnmaildir--art-suffix article))
(flag (nnmaildir--mark-to-flag mark)))
(when flag
;; If this mark corresponds to a flag, remove the flag from
;; the file name.
(nnmaildir--article-set-flags
article (nnmaildir--remove-flag flag suffix) curdir))
;; We still want to delete the hardlink in the marks dir if
;; present, regardless of whether this mark has a maildir flag or
;; not, to avoid getting out of sync.
(setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
mfile (concat mfile prefix))
(nnmaildir--unlink mfile)))
del-action (lambda (article) (mapcar del-mark todo-marks))
add-action
(lambda (article)
(mapcar
(lambda (mark)
(setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
permarkfile (concat mdir ":")
mfile (concat mdir (nnmaildir--art-prefix article)))
(nnmaildir--condcase err (add-name-to-file permarkfile mfile)
(cond
((nnmaildir--eexist-p err))
((nnmaildir--enoent-p err)
(nnmaildir--mkdir mdir)
(nnmaildir--mkfile permarkfile)
(add-name-to-file permarkfile mfile))
((nnmaildir--emlink-p err)
(let ((permarkfilenew (concat permarkfile "{new}")))
(nnmaildir--mkfile permarkfilenew)
(rename-file permarkfilenew permarkfile 'replace)
(add-name-to-file permarkfile mfile)))
(t (signal (car err) (cdr err))))))
(let ((prefix (nnmaildir--art-prefix article))
(suffix (nnmaildir--art-suffix article))
(flag (nnmaildir--mark-to-flag mark)))
(if flag
;; If there is a corresponding maildir flag, just rename
;; the file.
(nnmaildir--article-set-flags
article (nnmaildir--add-flag flag suffix) curdir)
;; Otherwise, use nnmaildir-specific marks dir.
(setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
permarkfile (concat mdir ":")
mfile (concat mdir prefix))
(nnmaildir--condcase err (add-name-to-file permarkfile mfile)
(cond
((nnmaildir--eexist-p err))
((nnmaildir--enoent-p err)
(nnmaildir--mkdir mdir)
(nnmaildir--mkfile permarkfile)
(add-name-to-file permarkfile mfile))
((nnmaildir--emlink-p err)
(let ((permarkfilenew (concat permarkfile "{new}")))
(nnmaildir--mkfile permarkfilenew)
(rename-file permarkfilenew permarkfile 'replace)
(add-name-to-file permarkfile mfile)))
(t (signal (car err) (cdr err))))))))
todo-marks))
set-action (lambda (article)
(funcall add-action article)
@ -1581,7 +1722,12 @@ by nnmaildir-request-article.")
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
all-marks (mapcar 'intern all-marks))
all-marks (gnus-delete-duplicates
;; get mark names from mark dirs and from flag
;; mappings
(append
(mapcar 'cdr nnmaildir-flag-mark-mapping)
(mapcar 'intern all-marks))))
(dolist (action actions)
(setq ranges (car action)
todo-marks (caddr action))

16
lisp/gnus/qp.el
View file

@ -53,10 +53,7 @@ them into characters should be done separately."
;; or both of which are lowercase letters in "abcdef", is
;; formally illegal. A robust implementation might choose to
;; recognize them as the corresponding uppercase letters.''
(let ((case-fold-search t)
(decode-hex #'(lambda (n1 n2)
(+ (* (if (<= n1 ?9) (- n1 ?0) (+ (- n1 ?A) 10)) 16)
(if (<= n2 ?9) (- n2 ?0) (+ (- n2 ?A) 10))))))
(let ((case-fold-search t))
(narrow-to-region from to)
;; Do this in case we're called from Gnus, say, in a buffer
;; which already contains non-ASCII characters which would
@ -74,8 +71,15 @@ them into characters should be done separately."
(let* ((n (/ (- (match-end 0) (point)) 3))
(str (make-string n 0)))
(dotimes (i n)
(aset str i (funcall decode-hex (char-after (1+ (point)))
(char-after (+ 2 (point)))))
(let ((n1 (char-after (1+ (point))))
(n2 (char-after (+ 2 (point)))))
(aset str i
(+ (* 16 (- n1 (if (<= n1 ?9) ?0
(if (<= n1 ?F) (- ?A 10)
(- ?a 10)))))
(- n2 (if (<= n2 ?9) ?0
(if (<= n2 ?F) (- ?A 10)
(- ?a 10)))))))
(forward-char 3))
(delete-region (match-beginning 0) (match-end 0))
(insert str)))

37
lisp/help.el
View file

@ -585,6 +585,8 @@ temporarily enables it to allow getting help on disabled items and buttons."
(setq saved-yank-menu (copy-sequence yank-menu))
(menu-bar-update-yank-menu "(any string)" nil))
(setq key (read-key-sequence "Describe key (or click or menu item): "))
;; Clear the echo area message (Bug#7014).
(message nil)
;; If KEY is a down-event, read and discard the
;; corresponding up-event. Note that there are also
;; down-events on scroll bars and mode lines: the actual
@ -962,7 +964,11 @@ is currently activated with completion."
result))
;;; Automatic resizing of temporary buffers.
(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
(defcustom temp-buffer-max-height
(lambda (buffer)
(if (eq (selected-window) (frame-root-window))
(/ (x-display-pixel-height) (frame-char-height) 2)
(/ (- (frame-height) 2) 2)))
"Maximum height of a window displaying a temporary buffer.
This is effective only when Temp Buffer Resize mode is enabled.
The value is the maximum height (in lines) which
@ -973,7 +979,16 @@ buffer, and should return a positive integer. At the time the
function is called, the window to be resized is selected."
:type '(choice integer function)
:group 'help
:version "20.4")
:version "24.2")
(defcustom temp-buffer-resize-frames nil
"Non-nil means `temp-buffer-resize-mode' can resize frames.
A frame can be resized if and only if its root window is a live
window. The height of the root window is subject to the values of
`temp-buffer-max-height' and `window-min-height'."
:type 'boolean
:version "24.2"
:group 'help)
(define-minor-mode temp-buffer-resize-mode
"Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
@ -1008,9 +1023,21 @@ view."
(with-selected-window window
(funcall temp-buffer-max-height (window-buffer)))
temp-buffer-max-height)))
(when (and (pos-visible-in-window-p (point-min) window)
(window-combined-p window))
(fit-window-to-buffer window height))))
(cond
((and (pos-visible-in-window-p (point-min) window)
(window-combined-p window))
(fit-window-to-buffer window height))
((and temp-buffer-resize-frames
(eq window (frame-root-window window))
(memq (car (window-parameter window 'quit-restore))
;; If 'same is too strong, we might additionally check
;; whether the second element is 'frame.
'(same frame)))
(let ((frame (window-frame window)))
(fit-frame-to-buffer
frame (+ (frame-height frame)
(- (window-total-size window))
height)))))))
;;; Help windows.
(defcustom help-window-select 'other

19
lisp/isearch.el
View file

@ -1405,6 +1405,7 @@ Use `isearch-exit' to quit without signaling."
(interactive)
(setq isearch-word (unless (eq isearch-word 'isearch-symbol-regexp)
'isearch-symbol-regexp))
(if isearch-word (setq isearch-regexp nil))
(setq isearch-success t isearch-adjusted t)
(isearch-update))
@ -1579,14 +1580,10 @@ way to run word replacements from Isearch is `M-s w ... M-%'."
;; set `search-upper-case' to nil to not call
;; `isearch-no-upper-case-p' in `perform-replace'
(search-upper-case nil)
(replace-search-function
(if (and isearch-lax-whitespace (not regexp-flag))
#'search-forward-lax-whitespace
replace-search-function))
(replace-re-search-function
(if (and isearch-regexp-lax-whitespace regexp-flag)
#'re-search-forward-lax-whitespace
replace-re-search-function))
(replace-lax-whitespace
isearch-lax-whitespace)
(replace-regexp-lax-whitespace
isearch-regexp-lax-whitespace)
;; Set `isearch-recursive-edit' to nil to prevent calling
;; `exit-recursive-edit' in `isearch-done' that terminates
;; the execution of this command when it is non-nil.
@ -2956,10 +2953,14 @@ Attempt to do the search exactly the way the pending Isearch would."
(let ((case-fold-search isearch-lazy-highlight-case-fold-search)
(isearch-regexp isearch-lazy-highlight-regexp)
(isearch-word isearch-lazy-highlight-word)
(isearch-lax-whitespace
isearch-lazy-highlight-lax-whitespace)
(isearch-regexp-lax-whitespace
isearch-lazy-highlight-regexp-lax-whitespace)
(isearch-forward isearch-lazy-highlight-forward)
(search-invisible nil) ; don't match invisible text
(retry t)
(success nil)
(isearch-forward isearch-lazy-highlight-forward)
(bound (if isearch-lazy-highlight-forward
(min (or isearch-lazy-highlight-end-limit (point-max))
(if isearch-lazy-highlight-wrapped

28
lisp/loadup.el
View file

@ -102,6 +102,19 @@
(setq load-source-file-function 'load-with-code-conversion)
(load "files")
;; Load-time macro-expansion can only take effect after setting
;; load-source-file-function because of where it is called in lread.c.
(load "emacs-lisp/macroexp")
(if (byte-code-function-p (symbol-function 'macroexpand-all))
nil
;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
;; fail until pcase is explicitly loaded. This also means that we have to
;; disable eager macro-expansion while loading pcase.
(let ((macroexp--pending-eager-loads '(skip)))
(load "emacs-lisp/pcase"))
;; Re-load macroexp so as to eagerly macro-expand its uses of pcase.
(load "emacs-lisp/macroexp"))
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
@ -266,21 +279,6 @@
;For other systems, you must edit ../src/Makefile.in.
(load "site-load" t)
;; ¡¡¡ Big Ugly Hack !!!
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
;; by compiling those files first, but this only makes a difference if those
;; files are not preloaded. As it so happens, macroexp.el tends to be
;; accidentally preloaded in src/bootstrap-emacs because cl.el and cl-macs.el
;; require it. So let's unload it here, if needed, to make sure the
;; byte-compiled version is used.
(if (or (not (fboundp 'macroexpand-all))
(byte-code-function-p (symbol-function 'macroexpand-all)))
nil
(fmakunbound 'macroexpand-all)
(setq features (delq 'macroexp features))
(autoload 'macroexpand-all "macroexp"))
;; Determine which last version number to use
;; based on the executables that now exist.
(if (and (or (equal (nth 3 command-line-args) "dump")

12
lisp/mail/smtpmail.el
View file

@ -200,10 +200,10 @@ The list is in preference order.")
;; local binding in the mail buffer will take effect.
(smtpmail-mail-address
(or (and mail-specify-envelope-from (mail-envelope-from))
(smtpmail-user-mail-address)
(let ((from (mail-fetch-field "from")))
(let ((from (mail-fetch-field "from")))
(and from
(cadr (mail-extract-address-components from))))))
(cadr (mail-extract-address-components from))))
(smtpmail-user-mail-address)))
(smtpmail-code-conv-from
(if enable-multibyte-characters
(let ((sendmail-coding-system smtpmail-code-conv-from))
@ -653,12 +653,10 @@ Returns an error if the server cannot be contacted."
(or smtpmail-mail-address
(and mail-specify-envelope-from
(mail-envelope-from))
(smtpmail-user-mail-address)
;; Fall back on the From: header as the envelope From
;; address.
(let ((from (mail-fetch-field "from")))
(and from
(cadr (mail-extract-address-components from))))))
(cadr (mail-extract-address-components from))))
(smtpmail-user-mail-address)))
response-code
process-buffer
result

2
lisp/net/browse-url.el
View file

@ -744,7 +744,7 @@ narrowed."
(and buffer (set-buffer buffer))
(let ((file-name
;; Ignore real name if restricted
(and (= (- (point-max) (point-min)) (buffer-size))
(and (not (buffer-narrowed-p))
(or buffer-file-name
(and (boundp 'dired-directory) dired-directory)))))
(or file-name

2
lisp/play/blackbox.el
View file

@ -97,7 +97,9 @@
(let ((map (make-keymap)))
(suppress-keymap map t)
(blackbox-redefine-key map 'backward-char 'bb-left)
(blackbox-redefine-key map 'left-char 'bb-left)
(blackbox-redefine-key map 'forward-char 'bb-right)
(blackbox-redefine-key map 'right-char 'bb-right)
(blackbox-redefine-key map 'previous-line 'bb-up)
(blackbox-redefine-key map 'next-line 'bb-down)
(blackbox-redefine-key map 'move-end-of-line 'bb-eol)

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

@ -493,13 +493,16 @@ inside a literal or a macro, nothing special happens."
(insert-char ?\n 1)
;; In AWK (etc.) or in a macro, make sure this CR hasn't changed
;; the syntax. (There might already be an escaped NL there.)
(when (or (c-at-vsemi-p (1- (point)))
(let ((pt (point)))
(save-excursion
(backward-char)
(and (c-beginning-of-macro)
(progn (c-end-of-macro)
(< (point) pt))))))
(when (or
(save-excursion
(c-skip-ws-backward (c-point 'bopl))
(c-at-vsemi-p))
(let ((pt (point)))
(save-excursion
(backward-char)
(and (c-beginning-of-macro)
(progn (c-end-of-macro)
(< (point) pt))))))
(backward-char)
(insert-char ?\\ 1)
(forward-char))

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

@ -3091,6 +3091,8 @@ comment at the start of cc-engine.el for more info."
c-state-cache-good-pos 1
c-state-nonlit-pos-cache nil
c-state-nonlit-pos-cache-limit 1
c-state-semi-nonlit-pos-cache nil
c-state-semi-nonlit-pos-cache-limit 1
c-state-brace-pair-desert nil
c-state-point-min 1
c-state-point-min-lit-type nil
@ -3350,6 +3352,8 @@ comment at the start of cc-engine.el for more info."
c-state-cache-good-pos
c-state-nonlit-pos-cache
c-state-nonlit-pos-cache-limit
c-state-semi-nonlit-pos-cache
c-state-semi-nonlit-pos-cache-limit
c-state-brace-pair-desert
c-state-point-min
c-state-point-min-lit-type
@ -9579,12 +9583,12 @@ comment at the start of cc-engine.el for more info."
(setq tmpsymbol nil)
(while (and (> (point) placeholder)
(zerop (c-backward-token-2 1 t))
(/= (char-after) ?=))
(not (looking-at "=\\([^=]\\|$\\)")))
(and c-opt-inexpr-brace-list-key
(not tmpsymbol)
(looking-at c-opt-inexpr-brace-list-key)
(setq tmpsymbol 'topmost-intro-cont)))
(eq (char-after) ?=))
(looking-at "=\\([^=]\\|$\\)"))
(looking-at c-brace-list-key))
(save-excursion
(while (and (< (point) indent-point)

5
lisp/progmodes/flymake.el
View file

@ -977,6 +977,9 @@ from compile.el")
;; :type '(repeat (string number number number))
;;)
(defvar flymake-warning-re "^[wW]arning"
"Regexp matching against err-text to detect a warning.")
(defun flymake-parse-line (line)
"Parse LINE to see if it is an error or warning.
Return its components if so, nil otherwise."
@ -997,7 +1000,7 @@ Return its components if so, nil otherwise."
(match-string (nth 4 (car patterns)) line)
(flymake-patch-err-text (substring line (match-end 0)))))
(or err-text (setq err-text "<no error text>"))
(if (and err-text (string-match "^[wW]arning" err-text))
(if (and err-text (string-match flymake-warning-re err-text))
(setq err-type "w")
)
(flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx

16
lisp/progmodes/python.el
View file

@ -1824,7 +1824,11 @@ When MSG is non-nil messages the first line of STRING."
(lines (split-string string "\n" t)))
(and msg (message "Sent: %s..." (nth 0 lines)))
(if (> (length lines) 1)
(let* ((temp-file-name (make-temp-file "py"))
(let* ((temporary-file-directory
(if (file-remote-p default-directory)
(concat (file-remote-p default-directory) "/tmp")
temporary-file-directory))
(temp-file-name (make-temp-file "py"))
(file-name (or (buffer-file-name) temp-file-name)))
(with-temp-file temp-file-name
(insert string)
@ -1931,8 +1935,14 @@ FILE-NAME."
(interactive "fFile to send: ")
(let* ((process (or process (python-shell-get-or-create-process)))
(temp-file-name (when temp-file-name
(expand-file-name temp-file-name)))
(file-name (or (expand-file-name file-name) temp-file-name)))
(expand-file-name
(or (file-remote-p temp-file-name 'localname)
temp-file-name))))
(file-name (or (when file-name
(expand-file-name
(or (file-remote-p file-name 'localname)
file-name)))
temp-file-name)))
(when (not file-name)
(error "If FILE-NAME is nil then TEMP-FILE-NAME must be non-nil"))
(python-shell-send-string

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

@ -64,8 +64,8 @@
"Regexp to match keywords that nest without blocks.")
(defconst ruby-indent-beg-re
(concat "\\(\\s *" (regexp-opt '("class" "module" "def") t) "\\)\\|"
(regexp-opt '("if" "unless" "case" "while" "until" "for" "begin")))
(concat "^\\s *" (regexp-opt '("class" "module" "def" "if" "unless" "case"
"while" "until" "for" "begin")) "\\_>")
"Regexp to match where the indentation gets deeper.")
(defconst ruby-modifier-beg-keywords
@ -98,6 +98,10 @@
(defconst ruby-block-end-re "\\_<end\\_>")
(defconst ruby-defun-beg-re
'"\\(def\\|class\\|module\\)"
"Regexp to match the beginning of a defun, in the general sense.")
(eval-and-compile
(defconst ruby-here-doc-beg-re
"\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
@ -138,18 +142,11 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(defvar ruby-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "{" 'ruby-electric-brace)
(define-key map "}" 'ruby-electric-brace)
(define-key map (kbd "M-C-a") 'ruby-beginning-of-defun)
(define-key map (kbd "M-C-e") 'ruby-end-of-defun)
(define-key map (kbd "M-C-b") 'ruby-backward-sexp)
(define-key map (kbd "M-C-f") 'ruby-forward-sexp)
(define-key map (kbd "M-C-p") 'ruby-beginning-of-block)
(define-key map (kbd "M-C-n") 'ruby-end-of-block)
(define-key map (kbd "M-C-h") 'ruby-mark-defun)
(define-key map (kbd "M-C-q") 'ruby-indent-exp)
(define-key map (kbd "C-M-h") 'backward-kill-word)
(define-key map (kbd "C-j") 'reindent-then-newline-and-indent)
(define-key map (kbd "C-c {") 'ruby-toggle-block)
map)
"Keymap used in Ruby mode.")
@ -840,20 +837,13 @@ and `\\' when preceded by `?'."
(+ indent ruby-indent-level)
indent))))
(defun ruby-electric-brace (arg)
"Insert a brace and re-indent the current line."
(interactive "P")
(self-insert-command (prefix-numeric-value arg))
(ruby-indent-line t))
;; TODO: Why isn't one ruby-*-of-defun written in terms of the other?
(defun ruby-beginning-of-defun (&optional arg)
"Move backward to the beginning of the current top-level defun.
With ARG, move backward multiple defuns. Negative ARG means
move forward."
(interactive "p")
(and (re-search-backward (concat "^\\(" ruby-block-beg-re "\\)\\b")
nil 'move (or arg 1))
(and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>")
nil t (or arg 1))
(beginning-of-line)))
(defun ruby-end-of-defun (&optional arg)
@ -861,19 +851,18 @@ move forward."
With ARG, move forward multiple defuns. Negative ARG means
move backward."
(interactive "p")
(and (re-search-forward (concat "^\\(" ruby-block-end-re "\\)\\($\\|\\b[^_]\\)")
nil 'move (or arg 1))
(beginning-of-line))
(forward-line 1))
(ruby-forward-sexp)
(when (looking-back (concat "^\\s *" ruby-block-end-re))
(forward-line 1)))
(defun ruby-beginning-of-indent ()
"TODO: document"
;; I don't understand this function.
;; It seems like it should move to the line where indentation should deepen,
;; but ruby-indent-beg-re only accounts for whitespace before class, module and def,
;; so this will only match other block beginners at the beginning of the line.
(and (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\_>") nil 'move)
(beginning-of-line)))
"Backtrack to a line which can be used as a reference for
calculating indentation on the lines after it."
(while (and (re-search-backward ruby-indent-beg-re nil 'move)
(if (ruby-in-ppss-context-p 'anything)
t
;; We can stop, then.
(beginning-of-line)))))
(defun ruby-move-to-block (n)
"Move to the beginning (N < 0) or the end (N > 0) of the current block
@ -1024,15 +1013,6 @@ With ARG, do it many times. Negative ARG means move forward."
((error)))
i)))
(defun ruby-mark-defun ()
"Put mark at end of this Ruby function, point at beginning."
(interactive)
(push-mark (point))
(ruby-end-of-defun)
(push-mark (point) nil t)
(ruby-beginning-of-defun)
(re-search-backward "^\n" (- (point) 1) t))
(defun ruby-indent-exp (&optional ignored)
"Indent each line in the balanced expression following the point."
(interactive "*P")
@ -1073,7 +1053,7 @@ See `add-log-current-defun-function'."
(let (mname mlist (indent 0))
;; get current method (or class/module)
(if (re-search-backward
(concat "^[ \t]*\\(def\\|class\\|module\\)[ \t]+"
(concat "^[ \t]*" ruby-defun-beg-re "[ \t]+"
"\\("
;; \\. and :: for class method
"\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
@ -1127,46 +1107,65 @@ See `add-log-current-defun-function'."
(if mlist (concat mlist mname) mname)
mlist)))))
(defun ruby-brace-to-do-end ()
(when (looking-at "{")
(let ((orig (point)) (end (progn (ruby-forward-sexp) (point))))
(when (eq (char-before) ?\})
(delete-char -1)
(if (eq (char-syntax (char-before)) ?w)
(insert " "))
(insert "end")
(if (eq (char-syntax (char-after)) ?w)
(insert " "))
(goto-char orig)
(delete-char 1)
(if (eq (char-syntax (char-before)) ?w)
(insert " "))
(insert "do")
(when (looking-at "\\sw\\||")
(insert " ")
(backward-char))
t))))
(defun ruby-brace-to-do-end (orig end)
(let (beg-marker end-marker)
(goto-char end)
(when (eq (char-before) ?\})
(delete-char -1)
(skip-chars-backward " \t")
(when (not (bolp))
(insert "\n"))
(insert "end")
(setq end-marker (point-marker))
(when (and (not (eobp)) (eq (char-syntax (char-after)) ?w))
(insert " "))
(goto-char orig)
(delete-char 1)
(when (eq (char-syntax (char-before)) ?w)
(insert " "))
(insert "do")
(setq beg-marker (point-marker))
(when (looking-at "\\(\\s \\)*|")
(unless (match-beginning 1)
(insert " "))
(goto-char (1+ (match-end 0)))
(search-forward "|"))
(unless (looking-at "\\s *$")
(insert "\n"))
(indent-region beg-marker end-marker)
(goto-char beg-marker)
t)))
(defun ruby-do-end-to-brace ()
(when (and (or (bolp)
(not (memq (char-syntax (char-before)) '(?w ?_))))
(looking-at "\\<do\\(\\s \\|$\\)"))
(let ((orig (point)) (end (progn (ruby-forward-sexp) (point))))
(backward-char 3)
(when (looking-at ruby-block-end-re)
(delete-char 3)
(insert "}")
(goto-char orig)
(delete-char 2)
(insert "{")
(if (looking-at "\\s +|")
(delete-char (- (match-end 0) (match-beginning 0) 1)))
t))))
(defun ruby-do-end-to-brace (orig end)
(goto-char (- end 3))
(when (looking-at ruby-block-end-re)
(delete-char 3)
(insert "}")
(goto-char orig)
(delete-char 2)
(insert "{")
(if (looking-at "\\s +|")
(delete-char (- (match-end 0) (match-beginning 0) 1)))
t))
(defun ruby-toggle-block ()
"Toggle block type from do-end to braces or back.
The block must begin on the current line or above it and end after the point.
If the result is do-end block, it will always be multiline."
(interactive)
(or (ruby-brace-to-do-end)
(ruby-do-end-to-brace)))
(let ((start (point)) beg end)
(end-of-line)
(unless
(if (and (re-search-backward "\\({\\)\\|\\_<do\\(\\s \\|$\\||\\)")
(progn
(setq beg (point))
(save-match-data (ruby-forward-sexp))
(setq end (point))
(> end start)))
(if (match-beginning 1)
(ruby-brace-to-do-end beg end)
(ruby-do-end-to-brace beg end)))
(goto-char start))))
(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit))
(declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit))
@ -1193,8 +1192,6 @@ It will be properly highlighted even when the call omits parens."))
(ruby-syntax-enclosing-percent-literal end)
(funcall
(syntax-propertize-rules
;; #{ }, #$hoge, #@foo are not comments.
("\\(#\\)[{$@]" (1 "."))
;; $' $" $` .... are variables.
;; ?' ?" ?` are ascii codes.
("\\([?$]\\)[#\"'`]"
@ -1326,8 +1323,7 @@ This should only be called after matching against `ruby-here-doc-end-re'."
(concat "-?\\([\"']\\|\\)" contents "\\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\\)"
@ -1549,6 +1545,9 @@ See `font-lock-syntax-table'.")
;; variables
'("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>"
2 font-lock-variable-name-face)
;; symbols
'("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
2 font-lock-reference-face)
;; variables
'("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W"
1 font-lock-variable-name-face)
@ -1557,12 +1556,9 @@ See `font-lock-syntax-table'.")
;; constants
'("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)"
2 font-lock-type-face)
;; symbols
'("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
2 font-lock-reference-face)
'("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face)
;; expression expansion
'("#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)"
'(ruby-match-expression-expansion
0 font-lock-variable-name-face t)
;; warn lower camel case
;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)"
@ -1570,6 +1566,11 @@ See `font-lock-syntax-table'.")
)
"Additional expressions to highlight in Ruby mode.")
(defun ruby-match-expression-expansion (limit)
(when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move)
(or (ruby-in-ppss-context-p 'string)
(ruby-match-expression-expansion limit))))
;;;###autoload
(define-derived-mode ruby-mode prog-mode "Ruby"
"Major mode for editing Ruby scripts.
@ -1586,6 +1587,10 @@ The variable `ruby-indent-level' controls the amount of indentation.
'ruby-imenu-create-index)
(set (make-local-variable 'add-log-current-defun-function)
'ruby-add-log-current-method)
(set (make-local-variable 'beginning-of-defun-function)
'ruby-beginning-of-defun)
(set (make-local-variable 'end-of-defun-function)
'ruby-end-of-defun)
(add-hook
(cond ((boundp 'before-save-hook) 'before-save-hook)

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

@ -1062,21 +1062,22 @@ subshells can nest."
(backward-char 1))
(when (eq (char-before) ?|)
(backward-char 1) t)))
(when (progn (backward-char 2)
(if (> start (line-end-position))
(put-text-property (point) (1+ start)
'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
;; corresponding `case'.
(and (looking-at ";[;&]\\|\\_<in")
;; ";; esac )" is a case that looks like a case-pattern
;; but it's really just a close paren after a case
;; statement. I.e. if we skipped over `esac' just now,
;; we're not looking at a case-pattern.
(not (looking-at "..[ \t\n]+esac[^[:word:]_]"))))
sh-st-punc))))
(and (> (point) (1+ (point-min)))
(progn (backward-char 2)
(if (> start (line-end-position))
(put-text-property (point) (1+ start)
'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
;; corresponding `case'.
(and (looking-at ";[;&]\\|\\_<in")
;; ";; esac )" is a case that looks like a case-pattern
;; but it's really just a close paren after a case
;; statement. I.e. if we skipped over `esac' just now,
;; we're not looking at a case-pattern.
(not (looking-at "..[ \t\n]+esac[^[:word:]_]"))))
sh-st-punc))))
(defun sh-font-lock-backslash-quote ()
(if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\')

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

@ -4138,10 +4138,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(set (make-local-variable 'imenu-generic-expression)
vhdl-imenu-generic-expression)
(when (and vhdl-index-menu (fboundp 'imenu))
(if (or (not (boundp 'font-lock-maximum-size))
(> font-lock-maximum-size (buffer-size)))
(imenu-add-to-menubar "Index")
(message "Scanning buffer for index...buffer too big"))))
(imenu-add-to-menubar "Index")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Source file menu (using `easy-menu.el')
@ -14385,10 +14382,10 @@ if required."
(define-key vhdl-speedbar-key-map (int-to-string key)
`(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
(setq key (1+ key)))))
(define-key speedbar-key-map "h"
(define-key speedbar-mode-map "h"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl directory")))
(define-key speedbar-key-map "H"
(define-key speedbar-mode-map "H"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl project")))
;; menu
@ -17400,7 +17397,8 @@ to visually support naming conventions.")
"Display VARIABLE's documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
(help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
(help-setup-xref (list #'vhdl-doc-variable variable)
(called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ (documentation-property variable 'variable-documentation))
@ -17412,7 +17410,8 @@ to visually support naming conventions.")
"Display VHDL Mode documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
(help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
(help-setup-xref (list #'vhdl-doc-mode)
(called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ mode-name)

51
lisp/register.el
View file

@ -76,6 +76,22 @@ A list of the form (WINDOW-CONFIGURATION POSITION)
A list of the form (FRAME-CONFIGURATION POSITION)
represents a saved frame configuration plus a saved value of point.")
(defgroup register nil
"Register commands."
:group 'convenience
:version "24.3")
(defcustom register-separator nil
"Register containing the text to put between collected texts, or nil if none.
When collecting text with
`append-to-register' (resp. `prepend-to-register') contents of
this register is added to the beginning (resp. end) of the marked
text."
:group 'register
:type '(choice (const :tag "None" nil)
(character :tag "Use register" :value ?+)))
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
(cdr (assq register register-alist)))
@ -192,13 +208,24 @@ Interactively, NUMBER is the prefix arg (none means nil)."
(string-to-number (match-string 0)))
0))))
(defun increment-register (number register)
"Add NUMBER to the contents of register REGISTER.
Interactively, NUMBER is the prefix arg."
(interactive "p\ncIncrement register: ")
(or (numberp (get-register register))
(error "Register does not contain a number"))
(set-register register (+ number (get-register register))))
(defun increment-register (prefix register)
"Augment contents of REGISTER.
Interactively, PREFIX is in raw form.
If REGISTER contains a number, add `prefix-numeric-value' of
PREFIX to it.
If REGISTER is empty or if it contains text, call
`append-to-register' with `delete-flag' set to PREFIX."
(interactive "P\ncIncrement register: ")
(let ((register-val (get-register register)))
(cond
((numberp register-val)
(let ((number (prefix-numeric-value prefix)))
(set-register register (+ number register-val))))
((or (not register-val) (stringp register-val))
(append-to-register register (region-beginning) (region-end) prefix))
(t (error "Register does not contain a number or text")))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
@ -349,10 +376,11 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions indicating what to append."
(interactive "cAppend to register: \nr\nP")
(let ((reg (get-register register))
(text (filter-buffer-substring start end)))
(text (filter-buffer-substring start end))
(separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
((stringp reg) (concat reg text))
((stringp reg) (concat reg separator text))
(t (error "Register does not contain text")))))
(cond (delete-flag
(delete-region start end))
@ -366,10 +394,11 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions indicating what to prepend."
(interactive "cPrepend to register: \nr\nP")
(let ((reg (get-register register))
(text (filter-buffer-substring start end)))
(text (filter-buffer-substring start end))
(separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
((stringp reg) (concat text reg))
((stringp reg) (concat text separator reg))
(t (error "Register does not contain text")))))
(cond (delete-flag
(delete-region start end))

110
lisp/replace.el
View file

@ -33,6 +33,22 @@
:type 'boolean
:group 'matching)
(defcustom replace-lax-whitespace nil
"Non-nil means `query-replace' matches a sequence of whitespace chars.
When you enter a space or spaces in the strings to be replaced,
it will match any sequence matched by the regexp `search-whitespace-regexp'."
:type 'boolean
:group 'matching
:version "24.3")
(defcustom replace-regexp-lax-whitespace nil
"Non-nil means `query-replace-regexp' matches a sequence of whitespace chars.
When you enter a space or spaces in the regexps to be replaced,
it will match any sequence matched by the regexp `search-whitespace-regexp'."
:type 'boolean
:group 'matching
:version "24.3")
(defvar query-replace-history nil
"Default history list for query-replace commands.
See `query-replace-from-history-variable' and
@ -226,6 +242,10 @@ letters. \(Transferring the case pattern means that if the old text
matched is all caps, or capitalized, then its replacement is upcased
or capitalized.)
If `replace-lax-whitespace' is non-nil, a space or spaces in the string
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
@ -270,6 +290,10 @@ pattern of the old text to the new text, if `case-replace' and
all caps, or capitalized, then its replacement is upcased or
capitalized.)
If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
@ -346,6 +370,10 @@ minibuffer.
Preserves case in each replacement if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches that are surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on."
@ -437,6 +465,10 @@ are non-nil and FROM-STRING has no uppercase letters.
\(Preserving case means that if the string matched is all caps, or capitalized,
then its replacement is upcased or capitalized.)
If `replace-lax-whitespace' is non-nil, a space or spaces in the string
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
@ -475,6 +507,10 @@ and TO-STRING is also null.)"
Preserve case in each match if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
@ -1589,14 +1625,28 @@ E to edit the replacement string"
(define-key map "?" 'help)
(define-key map "\C-g" 'quit)
(define-key map "\C-]" 'quit)
(define-key map "\e" 'exit-prefix)
(define-key map "\C-v" 'scroll-up)
(define-key map "\M-v" 'scroll-down)
(define-key map [next] 'scroll-up)
(define-key map [prior] 'scroll-down)
(define-key map [?\C-\M-v] 'scroll-other-window)
(define-key map [M-next] 'scroll-other-window)
(define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
(define-key map [M-prior] 'scroll-other-window-down)
;; Binding ESC would prohibit the M-v binding. Instead, callers
;; should check for ESC specially.
;; (define-key map "\e" 'exit-prefix)
(define-key map [escape] 'exit-prefix)
map)
"Keymap that defines the responses to questions in `query-replace'.
"Keymap of responses to questions posed by commands like `query-replace'.
The \"bindings\" in this map are not commands; they are answers.
The valid answers include `act', `skip', `act-and-show',
`exit', `act-and-exit', `edit', `edit-replacement', `delete-and-edit',
`recenter', `automatic', `backup', `exit-prefix', `quit', and `help'.")
`act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
`scroll-down', `scroll-other-window', `scroll-other-window-down',
`edit', `edit-replacement', `delete-and-edit', `automatic',
`backup', `quit', and `help'.
This keymap is used by `y-or-n-p' as well as `query-replace'.")
(defvar multi-query-replace-map
(let ((map (make-sparse-keymap)))
@ -1717,12 +1767,12 @@ passed in. If LITERAL is set, no checking is done, anyway."
(replace-match newtext fixedcase literal)
noedit)
(defvar replace-search-function 'search-forward
(defvar replace-search-function nil
"Function to use when searching for strings to replace.
It is used by `query-replace' and `replace-string', and is called
with three arguments, as if it were `search-forward'.")
(defvar replace-re-search-function 're-search-forward
(defvar replace-re-search-function nil
"Function to use when searching for regexps to replace.
It is used by `query-replace-regexp', `replace-regexp',
`query-replace-regexp-eval', and `map-query-replace-regexp'.
@ -1755,9 +1805,18 @@ make, or the user didn't cancel the call."
(nocasify (not (and case-replace case-fold-search)))
(literal (or (not regexp-flag) (eq regexp-flag 'literal)))
(search-function
(if regexp-flag
replace-re-search-function
replace-search-function))
(or (if regexp-flag
replace-re-search-function
replace-search-function)
(let ((isearch-regexp regexp-flag)
(isearch-word delimited-flag)
(isearch-lax-whitespace
replace-lax-whitespace)
(isearch-regexp-lax-whitespace
replace-regexp-lax-whitespace)
(isearch-case-fold-search case-fold-search)
(isearch-forward t))
(isearch-search-fun))))
(search-string from-string)
(real-match-data nil) ; The match data for the current match.
(next-replacement nil)
@ -1811,12 +1870,6 @@ make, or the user didn't cancel the call."
(vector repeat-count repeat-count
replacements replacements)))))
(if delimited-flag
(setq search-function 're-search-forward
search-string (concat "\\b"
(if regexp-flag from-string
(regexp-quote from-string))
"\\b")))
(when query-replace-lazy-highlight
(setq isearch-lazy-highlight-last-string nil))
@ -1898,7 +1951,7 @@ make, or the user didn't cancel the call."
(replace-highlight
(nth 0 real-match-data) (nth 1 real-match-data)
start end search-string
(or delimited-flag regexp-flag) case-fold-search))
regexp-flag delimited-flag case-fold-search))
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
@ -1917,7 +1970,7 @@ make, or the user didn't cancel the call."
(replace-highlight
(match-beginning 0) (match-end 0)
start end search-string
(or delimited-flag regexp-flag) case-fold-search)
regexp-flag delimited-flag case-fold-search)
;; Bind message-log-max so we don't fill up the message log
;; with a bunch of identical messages.
(let ((message-log-max nil)
@ -2099,15 +2152,11 @@ make, or the user didn't cancel the call."
(if (= replace-count 1) "" "s")))
(or (and keep-going stack) multi-buffer)))
(defvar isearch-error)
(defvar isearch-forward)
(defvar isearch-case-fold-search)
(defvar isearch-string)
(defvar replace-overlay nil)
(defun replace-highlight (match-beg match-end range-beg range-end
string regexp case-fold)
search-string regexp-flag delimited-flag
case-fold-search)
(if query-replace-highlight
(if replace-overlay
(move-overlay replace-overlay match-beg match-end (current-buffer))
@ -2115,13 +2164,14 @@ make, or the user didn't cancel the call."
(overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
(if query-replace-lazy-highlight
(let ((isearch-string string)
(isearch-regexp regexp)
;; Set isearch-word to nil because word-replace is regexp-based,
;; so `isearch-search-fun' should not use `word-search-forward'.
(isearch-word nil)
(search-whitespace-regexp nil)
(isearch-case-fold-search case-fold)
(let ((isearch-string search-string)
(isearch-regexp regexp-flag)
(isearch-word delimited-flag)
(isearch-lax-whitespace
replace-lax-whitespace)
(isearch-regexp-lax-whitespace
replace-regexp-lax-whitespace)
(isearch-case-fold-search case-fold-search)
(isearch-forward t)
(isearch-error nil))
(isearch-lazy-highlight-new-loop range-beg range-end))))

4
lisp/ses.el
View file

@ -1270,11 +1270,9 @@ when the width of cell (ROW,COL) has changed."
;; The data area
;;----------------------------------------------------------------------------
(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size)))
(defun ses-widen ()
"Turn off narrowing, to be reenabled at end of command loop."
(if (ses-narrowed-p)
(if (buffer-narrowed-p)
(setq ses--deferred-narrow t))
(widen))

8
lisp/simple.el
View file

@ -974,7 +974,9 @@ rather than the region.
If called from Lisp, return the number of words between positions
START and END."
(interactive "r\nP")
(interactive (if current-prefix-arg
(list nil nil current-prefix-arg)
(list (region-beginning) (region-end) nil)))
(cond ((not (called-interactively-p 'any))
(count-words start end))
(arg
@ -1008,9 +1010,7 @@ END, without printing any message."
(defun count-words--buffer-message ()
(count-words--message
(if (= (point-max) (1+ (buffer-size)))
"Buffer"
"Narrowed part of buffer")
(if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
(point-min) (point-max)))
(defun count-words--message (str start end)

6
lisp/speedbar.el
View file

@ -763,7 +763,7 @@ DIRECTORY-EXPRESSION to `speedbar-ignored-directory-expressions'."
"Non-nil means to automatically update the display.
When this is nil then speedbar will not follow the attached frame's directory.
If you want to change this while speedbar is active, either use
\\[customize] or call \\<speedbar-key-map> `\\[speedbar-toggle-updates]'."
\\[customize] or call \\<speedbar-mode-map> `\\[speedbar-toggle-updates]'."
:group 'speedbar
:initialize 'custom-initialize-default
:set (lambda (sym val)
@ -1083,7 +1083,7 @@ Return nil if it doesn't exist."
(define-derived-mode speedbar-mode fundamental-mode "Speedbar"
"Major mode for managing a display of directories and tags.
\\<speedbar-key-map>
\\<speedbar-mode-map>
The first line represents the default directory of the speedbar frame.
Each directory segment is a button which jumps speedbar's default
directory to that directory. Buttons are activated by clicking `\\[speedbar-click]'.
@ -1120,7 +1120,7 @@ category of tags. Click the {+} to expand the category. Jump-able
tags start with >. Click the name of the tag to go to that position
in the selected file.
\\{speedbar-key-map}"
\\{speedbar-mode-map}"
(save-excursion
(setq font-lock-keywords nil) ;; no font-locking please
(setq truncate-lines t)

68
lisp/subr.el
View file

@ -1548,7 +1548,7 @@ if it is empty or a duplicate."
(or keep-all
(not (equal (car history) newelt))))
(if history-delete-duplicates
(delete newelt history))
(setq history (delete newelt history)))
(setq history (cons newelt history))
(when (integerp maxelt)
(if (= 0 maxelt)
@ -2237,7 +2237,8 @@ keyboard-quit events while waiting for a valid input."
(error "Called `read-char-choice' without valid char choices"))
(let (char done show-help (helpbuf " *Char Help*"))
(let ((cursor-in-echo-area t)
(executing-kbd-macro executing-kbd-macro))
(executing-kbd-macro executing-kbd-macro)
(esc-flag nil))
(save-window-excursion ; in case we call help-form-show
(while (not done)
(unless (get-text-property 0 'face prompt)
@ -2261,8 +2262,12 @@ keyboard-quit events while waiting for a valid input."
;; there are no more events in the macro. Attempt to
;; get an event interactively.
(setq executing-kbd-macro nil))
((and (not inhibit-keyboard-quit) (eq char ?\C-g))
(keyboard-quit))))))
((not inhibit-keyboard-quit)
(cond
((and (null esc-flag) (eq char ?\e))
(setq esc-flag t))
((memq char '(?\C-g ?\e))
(keyboard-quit))))))))
;; Display the question with the answer. But without cursor-in-echo-area.
(message "%s%s" prompt (char-to-string char))
char))
@ -2314,11 +2319,19 @@ floating point support."
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'.\)
No confirmation of the answer is requested; a single character is
enough. SPC also means yes, and DEL means no.
To be precise, this function translates user input into responses
by consulting 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',
`scroll-up', `scroll-down', and `quit'.
An `act' response means yes, and a `skip' response means no.
A `quit' response means to invoke `keyboard-quit'.
If the user enters `recenter', `scroll-up', or `scroll-down'
responses, perform the requested window recentering or scrolling
and ask again.
Under a windowing system a dialog box will be used if `last-nonmenu-event'
is nil and `use-dialog-box' is non-nil."
@ -2350,21 +2363,33 @@ is nil and `use-dialog-box' is non-nil."
"" " ")
"(y or n) "))
(while
(let* ((key
(let* ((scroll-actions '(recenter scroll-up scroll-down
scroll-other-window scroll-other-window-down))
(key
(let ((cursor-in-echo-area t))
(when minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
(read-key (propertize (if (eq answer 'recenter)
(read-key (propertize (if (memq answer scroll-actions)
prompt
(concat "Please answer y or n. "
prompt))
'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)))
((memq answer '(skip act)) nil)
((eq answer 'recenter)
(recenter) t)
((eq answer 'scroll-up)
(ignore-errors (scroll-up-command)) t)
((eq answer 'scroll-down)
(ignore-errors (scroll-down-command)) t)
((eq answer 'scroll-other-window)
(ignore-errors (scroll-other-window)) t)
((eq answer 'scroll-other-window-down)
(ignore-errors (scroll-other-window-down)) t)
((or (memq answer '(exit-prefix quit)) (eq key ?\e))
(signal 'quit nil) t)
(t t)))
(ding)
(discard-input))))
(let ((ret (eq answer 'act)))
@ -2647,6 +2672,10 @@ directory if it does not exist."
;;;; Misc. useful functions.
(defsubst buffer-narrowed-p ()
"Return non-nil if the current buffer is narrowed."
(/= (- (point-max) (point-min)) (buffer-size)))
(defun find-tag-default ()
"Determine default tag to search for, based on text at point.
If there is no plausible default, return nil."
@ -3728,7 +3757,7 @@ from `standard-syntax-table' otherwise."
table))
(defun syntax-after (pos)
"Return the raw syntax of the char after POS.
"Return the raw syntax descriptor for the char after POS.
If POS is outside the buffer's accessible portion, return nil."
(unless (or (< pos (point-min)) (>= pos (point-max)))
(let ((st (if parse-sexp-lookup-properties
@ -3737,7 +3766,12 @@ If POS is outside the buffer's accessible portion, return nil."
(aref (or st (syntax-table)) (char-after pos))))))
(defun syntax-class (syntax)
"Return the syntax class part of the syntax descriptor SYNTAX.
"Return the code for the syntax class described by SYNTAX.
SYNTAX should be a raw syntax descriptor; the return value is a
integer which encodes the corresponding syntax class. See Info
node `(elisp)Syntax Table Internals' for a list of codes.
If SYNTAX is nil, return nil."
(and syntax (logand (car syntax) 65535)))

8
lisp/textmodes/picture.el
View file

@ -612,13 +612,15 @@ Leaves the region surrounding the rectangle."
(define-key map [remap self-insert-command] 'picture-self-insert)
(define-key map [remap self-insert-command] 'picture-self-insert)
(define-key map [remap completion-separator-self-insert-command]
'picture-self-insert)
'picture-self-insert)
(define-key map [remap completion-separator-self-insert-autofilling]
'picture-self-insert)
'picture-self-insert)
(define-key map [remap forward-char] 'picture-forward-column)
(define-key map [remap right-char] 'picture-forward-column)
(define-key map [remap backward-char] 'picture-backward-column)
(define-key map [remap left-char] 'picture-backward-column)
(define-key map [remap delete-char] 'picture-clear-column)
;; There are two possibilities for what is normally on DEL.
;; There are two possibilities for what is normally on DEL.
(define-key map [remap backward-delete-char-untabify]
'picture-backward-clear-column)
(define-key map [remap delete-backward-char] 'picture-backward-clear-column)

48
lisp/userlock.el
View file

@ -108,37 +108,27 @@ You can rewrite this to use any criterion you like to choose which one to do.
The buffer in question is current when this function is called."
(discard-input)
(save-window-excursion
(let (answer)
(let ((prompt
(format "%s changed on disk; \
really edit the buffer? (y, n, r or C-h) "
(file-name-nondirectory fn)))
(choices '(?y ?n ?r ?? ?\C-h))
answer)
(while (null answer)
(message "%s changed on disk; really edit the buffer? (y, n, r or C-h) "
(file-name-nondirectory fn))
(let ((tem (downcase (let ((cursor-in-echo-area t))
(read-char-exclusive)))))
(setq answer
(if (= tem help-char)
'help
(cdr (assoc tem '((?n . yield)
(?\C-g . yield)
(?y . proceed)
(?r . revert)
(?? . help))))))
(cond ((null answer)
(beep)
(message "Please type y, n or r; or ? for help")
(sit-for 3))
((eq answer 'help)
(ask-user-about-supersession-help)
(setq answer nil))
((eq answer 'revert)
(revert-buffer nil (not (buffer-modified-p)))
; ask confirmation if buffer modified
(signal 'file-supersession
(list "File reverted" fn)))
((eq answer 'yield)
(signal 'file-supersession
(list "File changed on disk" fn))))))
(setq answer (read-char-choice prompt choices))
(cond ((memq answer '(?? ?\C-h))
(ask-user-about-supersession-help)
(setq answer nil))
((eq answer ?r)
;; Ask for confirmation if buffer modified
(revert-buffer nil (not (buffer-modified-p)))
(signal 'file-supersession
(list "File reverted" fn)))
((eq answer ?n)
(signal 'file-supersession
(list "File changed on disk" fn)))))
(message
"File on disk now will become a backup file if you save these changes.")
"File on disk now will become a backup file if you save these changes.")
(setq buffer-backed-up nil))))
(defun ask-user-about-supersession-help ()

170
lisp/window.el
View file

@ -5521,6 +5521,62 @@ the selected one."
(window--display-buffer
buffer window 'reuse display-buffer-mark-dedicated)))))
(defun display-buffer-in-previous-window (buffer alist)
"Display BUFFER in a window previously showing it.
If ALIST has a non-nil `inhibit-same-window' entry, the selected
window is not eligible for reuse.
If ALIST contains a `reusable-frames' entry, its value determines
which frames to search for a reusable window:
nil -- the selected frame (actually the last non-minibuffer frame)
A frame -- just that frame
`visible' -- all visible frames
0 -- all frames on the current terminal
t -- all frames.
If ALIST contains no `reusable-frames' entry, search just the
selected frame if `display-buffer-reuse-frames' and
`pop-up-frames' are both nil; search all frames on the current
terminal if either of those variables is non-nil.
If ALIST has a `previous-window' entry, the window specified by
that entry will override any other window found by the methods
above, even if that window never showed BUFFER before."
(let* ((alist-entry (assq 'reusable-frames alist))
(inhibit-same-window
(cdr (assq 'inhibit-same-window alist)))
(frames (cond
(alist-entry (cdr alist-entry))
((if (eq pop-up-frames 'graphic-only)
(display-graphic-p)
pop-up-frames)
0)
(display-buffer-reuse-frames 0)
(t (last-nonminibuffer-frame))))
entry best-window second-best-window window)
;; Scan windows whether they have shown the buffer recently.
(catch 'best
(dolist (window (window-list-1 (frame-first-window) 'nomini frames))
(when (and (assq buffer (window-prev-buffers window))
(not (window-dedicated-p window)))
(if (eq window (selected-window))
(unless inhibit-same-window
(setq second-best-window window))
(setq best-window window)
(throw 'best t)))))
;; When ALIST has a `previous-window' entry, that entry may override
;; anything we found so far.
(when (and (setq window (cdr (assq 'previous-window alist)))
(window-live-p window)
(not (window-dedicated-p window)))
(if (eq window (selected-window))
(unless inhibit-same-window
(setq second-best-window window))
(setq best-window window)))
;; Return best or second best window found.
(when (setq window (or best-window second-best-window))
(window--display-buffer buffer window 'reuse))))
(defun display-buffer-use-some-window (buffer alist)
"Display BUFFER in an existing window.
Search for a usable window, set that window to the buffer, and
@ -5642,26 +5698,28 @@ buffer with the name BUFFER-OR-NAME and return that buffer."
(defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
"Switch to buffer BUFFER-OR-NAME in the selected window.
If called interactively, prompt for the buffer name using the
If the selected window cannot display the specified
buffer (e.g. if it is a minibuffer window or strongly dedicated
to another buffer), call `pop-to-buffer' to select the buffer in
another window.
If called interactively, read the buffer name using the
minibuffer. The variable `confirm-nonexistent-file-or-buffer'
determines whether to request confirmation before creating a new
buffer.
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
nil. If BUFFER-OR-NAME is a string that does not identify an
existing buffer, create a buffer with that name. If
BUFFER-OR-NAME is nil, switch to the buffer returned by
`other-buffer'.
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
If BUFFER-OR-NAME is a string that does not identify an existing
buffer, create a buffer with that name. If BUFFER-OR-NAME is
nil, switch to the buffer returned by `other-buffer'.
Optional argument NORECORD non-nil means do not put the buffer
specified by BUFFER-OR-NAME at the front of the buffer list and
do not make the window displaying it the most recently selected
one.
If optional argument NORECORD is non-nil, do not put the buffer
at the front of the buffer list, and do not make the window
displaying it the most recently selected one.
If FORCE-SAME-WINDOW is non-nil, BUFFER-OR-NAME must be displayed
in the selected window; signal an error if that is
impossible (e.g. if the selected window is minibuffer-only). If
nil, BUFFER-OR-NAME may be displayed in another window.
If optional argument FORCE-SAME-WINDOW is non-nil, the buffer
must be displayed in the selected window; if that is impossible,
signal an error rather than calling `pop-to-buffer'.
Return the buffer switched to."
(interactive
@ -5918,6 +5976,88 @@ WINDOW was scrolled."
(error (setq delta nil)))
delta))))
(defcustom fit-frame-to-buffer-bottom-margin 4
"Bottom margin for `fit-frame-to-buffer'.
This is the number of lines `fit-frame-to-buffer' leaves free at the
bottom of the display in order to not obscure the system task bar."
:type 'integer
:version "24.2"
:group 'windows)
(defun fit-frame-to-buffer (&optional frame max-height min-height)
"Adjust height of FRAME to display its buffer's contents exactly.
FRAME can be any live frame and defaults to the selected one.
Optional argument MAX-HEIGHT specifies the maximum height of
FRAME and defaults to the height of the display below the current
top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN.
Optional argument MIN-HEIGHT specifies the minimum height of
FRAME."
(interactive)
(setq frame (window-normalize-frame frame))
(let* ((root (frame-root-window frame))
(frame-min-height
(+ (- (frame-height frame) (window-total-size root))
window-min-height))
(frame-top (frame-parameter frame 'top))
(top (if (consp frame-top)
(funcall (car frame-top) (cadr frame-top))
frame-top))
(frame-max-height
(- (/ (- (x-display-pixel-height frame) top)
(frame-char-height frame))
fit-frame-to-buffer-bottom-margin))
(compensate 0)
delta)
(when (and (window-live-p root) (not (window-size-fixed-p root)))
(with-selected-window root
(cond
((not max-height)
(setq max-height frame-max-height))
((numberp max-height)
(setq max-height (min max-height frame-max-height)))
(t
(error "%s is an invalid maximum height" max-height)))
(cond
((not min-height)
(setq min-height frame-min-height))
((numberp min-height)
(setq min-height (min min-height frame-min-height)))
(t
(error "%s is an invalid minimum height" min-height)))
;; When tool-bar-mode is enabled and we have just created a new
;; frame, reserve lines for toolbar resizing. This is needed
;; because for reasons unknown to me Emacs (1) reserves one line
;; for the toolbar when making the initial frame and toolbars
;; are enabled, and (2) later adds the remaining lines needed.
;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a
;; system that behaves differently.
(let ((quit-restore (window-parameter root 'quit-restore))
(lines (tool-bar-lines-needed frame)))
(when (and quit-restore (eq (car quit-restore) 'frame)
(not (zerop lines)))
(setq compensate (1- lines))))
(message "%s" compensate)
(setq delta
;; Always count a final newline - we don't do any
;; post-processing, so let's play safe.
(+ (count-screen-lines nil nil t)
(- (window-body-size))
compensate)))
;; Move away from final newline.
(when (and (eobp) (bolp) (not (bobp)))
(set-window-point root (line-beginning-position 0)))
(set-window-start root (point-min))
(set-window-vscroll root 0)
(condition-case nil
(set-frame-height
frame
(min (max (+ (frame-height frame) delta)
min-height)
max-height))
(error (setq delta nil))))
delta))
(defun window-safely-shrinkable-p (&optional window)
"Return t if WINDOW can be shrunk without shrinking other windows.
WINDOW defaults to the selected window."
@ -6161,7 +6301,7 @@ This is different from `scroll-down-command' that scrolls a full screen."
(put 'scroll-down-line 'scroll-command t)
(defun scroll-other-window-down (lines)
(defun scroll-other-window-down (&optional lines)
"Scroll the \"other window\" down.
For more details, see the documentation for `scroll-other-window'."
(interactive "P")

2
make-dist
View file

@ -273,7 +273,7 @@ mkdir ${tempdir}
### README while the rest of the tar file is still unpacking. Whoopee.
echo "Making links to top-level files"
ln INSTALL README BUGS ${tempdir}
ln ChangeLog Makefile.in configure configure.ac ${tempdir}
ln ChangeLog Makefile.in autogen.sh configure configure.ac ${tempdir}
ln config.bat make-dist .dir-locals.el ${tempdir}
ln aclocal.m4 ${tempdir}

23
nt/ChangeLog
View file

@ -1,3 +1,26 @@
2012-09-08 Eli Zaretskii <eliz@gnu.org>
* configure.bat <use_extensions>: Don't leave it set in the
environment when the script exits.
2012-09-07 Juanma Barranquero <lekktu@gmail.com>
* config.nt: Sync with autogen/config.in.
(NO_ABORT, SIGNAL_H_AHB): Remove.
2012-09-07 Eli Zaretskii <eliz@gnu.org>
* inc/ms-w32.h (struct sigaction): Declare sa_handler __cdecl.
2012-09-05 Juanma Barranquero <lekktu@gmail.com>
* config.nt: Sync with autogen/config.in.
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Simplify redefinition of 'abort' (Bug#12316).
* inc/ms-w32.h (w32_abort) [HAVE_NTGUI]: Remove.
2012-09-02 Juanma Barranquero <lekktu@gmail.com>
* config.nt: Sync with autogen/config.in.

24
nt/config.nt
View file

@ -162,9 +162,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define FIRST_PTY_LETTER 'a'
/* Define if the float library doesn't handle errors by either setting errno,
or signaling SIGFPE/SIGILL. */
or signaling SIGFPE. */
#undef FLOAT_CHECK_DOMAIN
/* Enable compile-time and run-time bounds-checking, and some warnings,
without upsetting glibc 2.15+. */
#if defined __OPTIMIZE__ && __OPTIMIZE__
# define _FORTIFY_SOURCE 2
#endif
/* Define to 1 if futimesat mishandles a NULL file name. */
#undef FUTIMESAT_NULL_BUG
@ -1182,9 +1189,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
`NO'. */
#undef NARROWPROTO
/* Do not define abort in emacs.c. */
#undef NO_ABORT
/* Define if XEditRes should not be used. */
#undef NO_EDITRES
@ -1306,9 +1310,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Make process_send_signal work by "typing" a signal character on the pty. */
#undef SIGNALS_VIA_CHARACTERS
/* Define if AH_BOTTOM should include signal.h. */
#undef SIGNAL_H_AHB
/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
'sig_atomic_t'. */
#undef SIG_ATOMIC_T_SUFFIX
@ -1468,9 +1469,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Number of bits in a file offset, on hosts where this is settable. */
#undef _FILE_OFFSET_BITS
/* enable compile-time and run-time bounds-checking, and some warnings */
#undef _FORTIFY_SOURCE
/* Define to 1 if Gnulib overrides 'struct stat' on Windows so that struct
stat.st_size becomes 64-bit. */
#undef _GL_WINDOWS_64_BIT_ST_SIZE
@ -1547,10 +1545,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
declarations. Define as empty for no equivalent. */
#undef __restrict_arr
/* Some platforms redefine this. */
/* Define to longjmp if _setjmp and _longjmp do not work. Because longjmp may
alter signal masks, callers of _longjmp should not assume that it leaves
signal masks alone. */
#undef _longjmp
/* Some platforms redefine this. */
/* Define to setjmp if _setjmp and _longjmp do not work. See _longjmp. */
#undef _setjmp
/* Some platforms that do not use configure define this to include extra

2
nt/configure.bat
View file

@ -949,4 +949,6 @@ set HAVE_PNG=
set HAVE_TIFF=
set HAVE_XPM=
set dbginfo=
endlocal
set use_extensions=

11
nt/inc/ms-w32.h
View file

@ -127,7 +127,7 @@ typedef int ssize_t;
struct sigaction {
int sa_flags;
void (*sa_handler)(int);
void (_CALLBACK_ *sa_handler)(int);
sigset_t sa_mask;
};
#define SIG_BLOCK 1
@ -334,16 +334,7 @@ extern char *get_emacs_configuration_options (void);
#include <malloc.h>
#endif
/* stdlib.h must be included after redefining malloc & friends, but
before redefining abort. Isn't library redefinition funny? */
#include <stdlib.h>
/* Redefine abort. */
#ifdef HAVE_NTGUI
#define abort w32_abort
extern _Noreturn void w32_abort (void);
#endif
#include <sys/stat.h>
/* Define for those source files that do not include enough NT system files. */

6
nt/inc/unistd.h
View file

@ -3,8 +3,12 @@
#ifndef _UNISTD_H
#define _UNISTD_H
/* On Microsoft platforms, <stdlib.h> declares 'environ'; on POSIX
platforms, <unistd.h> does. Every file in Emacs that includes
<unistd.h> also includes <stdlib.h>, so there's no need to declare
'environ' here. */
extern ssize_t readlink (const char *, char *, size_t);
extern int symlink (char const *, char const *);
#endif /* _UNISTD_H */

11
src/.gdbinit
View file

@ -1222,14 +1222,9 @@ if ($ptr != 0)
set $tem = (struct Lisp_String *) $ptr
set $tem = (char *) $tem->data
# Don't let abort actually run, as it will make stdio stop working and
# therefore the `pr' command above as well.
if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
# The windows-nt build replaces abort with its own function.
break w32_abort
else
break abort
end
# Don't let emacs_abort actually run, as it will make stdio stop
# working and therefore the 'pr' command above as well.
break emacs_abort
end
# x_error_quitter is defined only on X. But window-system is set up

439
src/ChangeLog
View file

@ -1,11 +1,440 @@
2012-09-10 Chong Yidong <cyd@gnu.org>
* fns.c (Fdelq, Fdelete): Doc fix.
2012-09-10 Paul Eggert <eggert@cs.ucla.edu>
* lisp.h (XSETINT, XSETCONS, XSETVECTOR, XSETSTRING, XSETSYMBOL)
(XSETFLOAT, XSETMISC): Parenthesize macro bodies.
2012-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp.h (make_lisp_ptr): New macro to replace XSET.
(XSETCONS, XSETVECTOR, XSETSTRING, XSETSYMBOL, XSETFLOAT, XSETMISC):
Use it.
2012-09-09 Eli Zaretskii <eliz@gnu.org>
* fringe.c (draw_fringe_bitmap_1): Don't reduce the width of the
left fringe if the window has a left margin. This avoids leaving
traces of the cursor because its leftmost pixel is not drawn over.
* dispnew.c (update_window_line): When the left margin area of a
screen line is updated, set the redraw_fringe_bitmaps_p flag of
that screen line. (Bug#12277)
2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
Assume C89 or later for math functions (Bug#12381).
This simplifies the code, and makes it a bit smaller and faster,
and (most important) makes it easier to clean up signal handling
since we can stop worring about floating-point exceptions in
library code. That was a problem before C89, but the problem
went away many years ago on all practical Emacs targets.
* data.c, image.c, lread.c, print.c:
Don't include <math.h>; no longer needed.
* data.c, floatfns.c (IEEE_FLOATING_POINT): Don't worry that it
might be autoconfigured, as that never happens.
* data.c (fmod):
* doprnt.c (DBL_MAX_10_EXP):
* print.c (DBL_DIG):
Remove. C89 or later always defines these.
* floatfns.c (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CHECK_DOMAIN)
(in_float, float_error_arg, float_error_arg2, float_error_fn_name)
(arith_error, domain_error, domain_error2):
Remove all this pre-C89 cruft. Do not include <errno.h> as that's
no longer needed -- we simply return what C returns. All uses removed.
(IN_FLOAT, IN_FLOAT2): Remove. All uses replaced with
the wrapped code.
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error, range_error2):
Remove. All uses expanded, as these macros are no longer used
more than once and are now more trouble than they're worth.
(Ftan): Use tan, not sin / cos.
(Flogb): Assume C89 frexp.
(fmod_float): Assume C89 fmod.
(matherr) [HAVE_MATHERR]: Remove; no longer needed.
(init_floatfns): Remove. All uses removed.
2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Take back
compositeToPoint for OSX < 10.6 (Bug#12390).
2012-09-08 Paul Eggert <eggert@cs.ucla.edu>
* floatfns.c (Ftan): Use tan (x), not (sin (x) / cos (x)).
This produces more-accurate results.
2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (updateFrameSize): Call setFrame: on the view when size
changes (Bug#12088).
2012-09-08 Chong Yidong <cyd@gnu.org>
* syntax.c (Fstring_to_syntax): Doc fix.
2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (ns_clip_to_row): Remove code that deals with drawing fringe
in the internal border.
(x_set_window_size): Remove static variables and their usage.
(ns_redraw_scroll_bars): Fix NSTRACE arg.
(ns_after_update_window_line, ns_draw_fringe_bitmap): Remove
fringe/internal border adjustment (Bug#11052).
(ns_draw_fringe_bitmap): Make code more like other terms (xterm.c).
(ns_draw_window_cursor): Remove fringe/internal border adjustment.
(ns_fix_rect_ibw): Remove.
(ns_get_glyph_string_clip_rect): Remove call to ns_fix_rect_ibw.
(ns_dumpglyphs_box_or_relief): Ditto.
(ns_maybe_dumpglyphs_background): Remove fringe/internal border
adjustment.
(ns_dumpglyphs_image): Ditto.
(ns_dumpglyphs_stretch): Fix coding style. Remove fringe/internal
border adjustment.
(ns_set_vertical_scroll_bar): Remove variables barOnVeryLeft/Right and
their usage. Add fringe_extended_p and its use as in other terms.
(ns_judge_scroll_bars): Code style fix. Call updateFrameSize if
scroll bar was removed.
(updateFrameSize): New function.
(windowDidResize): Move code to updateFrameSize and call it.
* nsterm.h (EmacsView): Add updateFrameSize.
2012-09-07 Chong Yidong <cyd@gnu.org>
* textprop.c (Fget_text_property): Minor doc fix (Bug#12323).
* data.c (Flocal_variable_if_set_p): Doc fix (Bug#10713).
2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
More signal-handler cleanup (Bug#12327).
* emacs.c (main): Convert three 'signal' calls to 'sigaction' calls.
Problem introduced when merging patches. Noted by Eli Zaretskii in
<http://bugs.gnu.org/12327#67>.
* floatfns.c: Comment fix.
* lisp.h (force_auto_save_soon): Declare regardless of SIGDANGER.
SIGDANGER might not be in scope so "#ifdef SIGDANGER" is not right,
and anyway the declaration is harmless even if SIGDANGER is not defined.
* syssignal.h (SIGIO): Also #undef if (! defined FIONREAD ||
defined BROKEN_FIONREAD). systty.h formerly did this, but other
source files not surprisingly expected syssignal.h to define, or
not define, SIGIO, and it's cleaner to do it that way, for consistency.
Include <sys/ioctl.h>, for FIONREAD.
* systty.h (SIGIO): Do not #undef here; it's now syssignal.h's job.
This eliminates a problem whereby other files mysteriously had
to include "syssignal.h" before including "systty.h" if they
wanted to use "#ifdef SIGIO".
2012-09-07 Eli Zaretskii <eliz@gnu.org>
* w32proc.c (sigaction): New function, emulates Posix 'sigaction'.
* w32.c (sigemptyset): Empty the set.
(sigsetmask, sigmask, sigblock, sigunblock): Remove unused functions.
* alloc.c [ENABLE_CHECKING]: Include signal.h, since we need SIGABRT.
2012-09-07 Dmitry Antipov <dmantipov@yandex.ru>
* alloc.c (mark_buffer): Revert unsafe marking optimization.
(mark_object): Likewise for frame objects.
2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
* syssignal.h (handle_on_main_thread): Always declare,
even if FORWARD_SIGNAL_TO_MAIN_THREAD is not defined.
This ports to platforms without HAVE_PTHREAD.
2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
Signal-handler cleanup (Bug#12327).
Emacs's signal handlers were written in the old 4.2BSD style with
sigblock and sigmask and so forth, and this led to some
inefficiencies and confusion. Rewrite these to use
pthread_sigmask etc. without copying signal sets around. Also,
get rid of the confusing macros 'SIGNAL_THREAD_CHECK' and
'signal', and instead use functions that do not attempt to take
over the system name space. This patch causes Emacs's text
segment to shrink by 0.7% on my platform, Fedora 17 x86-64.
* alloc.c, emacsgtkfixed.c, nsfns.m, widget.c, xmenu.c:
Do not include <signal.h> or "syssignal.h", as these
modules do not use signals.
* atimer.c, callproc.c, data.c, dispnew.c, emacs.c, floatfns.c:
* gtkutil.c, keyboard.c, process.c, sound.c, sysdep.c, term.c, xterm.c:
Do not include <signal.h>, as "syssignal.h" does that for us now.
* atimer.c (sigmask_atimers): New function.
(block_atimers, unblock_atimers): New functions,
replacing the old macros BLOCK_ATIMERS and UNBLOCK_ATIMERS.
All uses replaced.
* conf_post.h [SIGNAL_H_AHB]: Do not include <signal.h>;
no longer needed here.
* emacs.c (main): Inspect existing signal handler with sigaction,
so that there's no need to block and unblock SIGHUP.
* sysdep.c (struct save_signal): New member 'action', replacing
old member 'handler'.
(save_signal_handlers, restore_signal_handlers):
Use sigaction instead of 'signal' to save and restore.
(get_set_sighandler, set_sighandler) [!WINDOWSNT]:
New function. All users of 'signal' modified to use set_sighandler
if they're writeonly, and to use sys_signal if they're read+write.
(emacs_sigaction_init, forwarded_signal): New functions.
(sys_signal): Remove. All uses replaced by calls to sigaction
and emacs_sigaction_init, or by direct calls to 'signal'.
(sys_sigmask) [!__GNUC__]: Remove; no longer needed.
(sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove;
all uses replaced by pthread_sigmask etc. calls.
* syssignal.h: Include <signal.h>.
(emacs_sigaction_init, forwarded_signal): New decls.
(SIGMASKTYPE): Remove. All uses replaced by its definiens, sigset_t.
(SIGEMPTYMASK): Remove; all uses replaced by its definiens, empty_mask.
(sigmask, sys_sigmask): Remove; no longer needed.
(sigpause): Remove. All uses replaced by its definiens, sigsuspend.
(sigblock, sigunblock, sigfree):
(sigsetmask) [!defined sigsetmask]:
Remove. All uses replaced by pthread_sigmask.
(signal): Remove. Its remaining uses (with SIG_DFL and SIG_IGN)
no longer need to be replaced, and its typical old uses
are now done via emacs_sigaction_init and sigaction.
(sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove decls.
(sys_sigdel): Remove; unused.
(NSIG): Remove a FIXME; the code's fine. Remove an unnecessary ifdef.
2012-09-06 Eli Zaretskii <eliz@gnu.org>
* process.c (CAN_HANDLE_MULTIPLE_CHILDREN): Fix a typo that broke
SIGCHLD handling on systems that don't have WNOHANG. (Bug#12327)
2012-09-06 Dmitry Antipov <dmantipov@yandex.ru>
Explicitly mark buffer_defaults and buffer_local_symbols.
* alloc.c (Fgarbage_collect): Mark buffer_defaults and
mark_local_symbols here.
(mark_object): If GC_CHECK_MARKED_OBJECTS, simplify checking
since special buffers aren't marked here any more.
(allocate_buffer): Chain new buffer with all_buffers here...
* buffer.c (Fget_buffer_create, Fmake_indirect_buffer): ...and
not here.
(Vbuffer_defaults, Vbuffer_local_symbols): Remove.
(syms_of_buffer): Remove staticpro of the above.
(init_buffer_once): Set names for buffer_defaults and
buffer_local_symbols.
2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
Use bool for booleans in font-related modules.
* font.c (font_intern_prop, font_style_to_value)
(font_style_symbolic, font_parse_xlfd, font_parse_fcname)
(generate_otf_features, font_check_otf_features, font_check_otf)
(font_match_p, font_list_entities, font_at):
* fontset.c (fontset_id_valid_p, reorder_font_vector
(fontset_find_font, Fset_fontset_font)
(face_suitable_for_char_p) [0]:
* ftfont.c (fc_initialized, ftfont_get_open_type_spec)
(ftfont_open, ftfont_text_extents, ftfont_check_otf):
(m17n_flt_initialized, ftfont_shape_by_flt):
* ftxfont.c (ftxfont_draw_bitmap, ftxfont_draw):
* nsfont.m (nsfont_draw):
* w32font.c (w32font_draw):
* w32term.c (x_draw_glyphless_glyph_string_foreground):
Use bool for booleans.
* font.h: Adjust to above API changes.
(struct font, struct font_driver, struct font_driver_list):
Use bool for booleans.
(struct font): Remove useless member encoding_type.
All users removed.
* fontset.c, xftfont.c: Omit unnecessary static decls.
2012-09-06 Dmitry Antipov <dmantipov@yandex.ru>
* alloc.c (mark_object): Revert window marking code
since it's unsafe for the Fset_window_configuration.
2012-09-05 Paul Eggert <eggert@cs.ucla.edu>
Fix race conditions with signal handlers and errno (Bug#12327).
Be more systematic about preserving errno whenever a signal
handler returns, even if it's not in the main thread. Do this by
renaming signal handlers to distinguish between signal delivery
and signal handling. All uses changed.
* atimer.c (deliver_alarm_signal): Rename from alarm_signal_handler.
* data.c (deliver_arith_signal): Rename from arith_error.
* dispnew.c (deliver_window_change_signal): Rename from
window_change_signal.
* emacs.c (deliver_error_signal): Rename from fatal_error_signal.
(deliver_danger_signal) [SIGDANGER]: Rename from memory_warning_signal.
* keyboard.c (deliver_input_available_signal): Rename from
input_available_signal.
(deliver_user_signal): Rename from handle_user_signal.
(deliver_interrupt_signal): Rename from interrupt_signal.
* process.c (deliver_pipe_signal): Rename from send_process_trap.
(deliver_child_signal): Rename from sigchld_handler.
* atimer.c (handle_alarm_signal):
* data.c (handle_arith_signal):
* dispnew.c (handle_window_change_signal):
* emacs.c (handle_fatal_signal, handle_danger_signal):
* keyboard.c (handle_input_available_signal):
* keyboard.c (handle_user_signal, handle_interrupt_signal):
* process.c (handle_pipe_signal, handle_child_signal):
New functions, with the actual signal-handling code taken from the
original respective signal handlers, sans the sporadic attempts to
preserve errno, since that's now done by handle_on_main_thread.
* atimer.c (alarm_signal_handler): Remove unnecessary decl.
* emacs.c, floatfns.c, lisp.h: Remove unused FLOAT_CATCH_SIGKILL cruft.
* emacs.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
Move to sysdep.c.
(main) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
Move initialization of main_thread to sysdep.c's init_signals.
* process.c (waitpid) [!WNOHANG]: #define to wait; that's good enough for
our usage, and simplifies the mainline code.
(record_child_status_change): New static function, as a helper
for handle_child_signal, and with most of the old child handler's
contents.
(CAN_HANDLE_MULTIPLE_CHILDREN): New constant.
(handle_child_signal): Use the above.
* sysdep.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
Moved here from emacs.c.
(init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it;
code moved here from emacs.c's main function.
* sysdep.c, syssignal.h (handle_on_main_thread): New function,
replacing the old SIGNAL_THREAD_CHECK. All uses changed. This
lets callers save and restore errno properly.
2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
Remove redundant or unused things here and there.
* lisp.h (CYCLE_CHECK, CHAR_TABLE_TRANSLATE): Remove.
* conf_post.h (RE_TRANSLATE): Use char_table_translate.
* editfns.c (Fcompare_buffer_substrings): Likewise.
* frame.h (struct terminal, struct font_driver_list):
Remove redundant declarations.
* window.h (Qleft, Qright): Likewise.
2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
Do not mark objects from deleted buffers, windows and frames.
* alloc.c (mark_buffer): Mark just the buffer if it is dead.
(mark_object): Likewise for windows and frames.
2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
* alloc.c (valid_lisp_object_p): Treat killed buffers,
buffer_defaults and buffer_local_symbols as valid objects.
Return special value to denote them.
2012-09-05 Paul Eggert <eggert@cs.ucla.edu>
* fileio.c, filelock.c, floatfns.c, fns.c: Use bool for boolean.
* fileio.c (auto_saving, auto_save_error_occurred, make_temp_name)
(Fexpand_file_name, barf_or_query_if_file_exists, Fcopy_file)
(file_name_absolute_p, Fsubstitute_in_file_name):
(check_executable, check_writable, Ffile_accessible_directory_p)
(Fset_file_selinux_context, Fdefault_file_modes)
(Finsert_file_contents, choose_write_coding_system)
(Fwrite_region, build_annotations, a_write, e_write)
(Fdo_auto_save):
* filelock.c (boot_time_initialized, get_boot_time)
(get_boot_time_1, lock_file_1, within_one_second):
* floatfns.c (in_float):
* fns.c (concat, internal_equal, Frequire, base64_encode_1)
(base64_decode_1, cmpfn_eql, cmpfn_user_defined)
(sweep_weak_table, sweep_weak_hash_tables, secure_hash):
* lisp.h (struct Lisp_Hash_Table.cmpfn):
* window.c (compare_window_configurations):
Use bool for booleans.
* fileio.c (auto_saving_dir_umask, auto_saving_mode_bits)
(Fdefault_file_modes): Now mode_t, not int, for modes.
(Fdo_auto_save): Set a boolean to 1 rather than using ++.
(internal_delete_file): Now returns void, not a (boolean) int,
since nobody was looking at the return value.
* lisp.h, window.h: Adjust to above API changes.
* xdisp.c (set_message): Simplify and reindent last change.
2012-09-05 Juanma Barranquero <lekktu@gmail.com>
* makefile.w32-in ($(BLD)/sysdep.$(O)): Update dependencies.
2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
* eval.c (call_debugger): Make the function non-static so that we
can call it from set_message.
* xdisp.c (set_message): Implement the new variable `debug-on-message'.
(syms_of_xdisp): Defvar it and `inhibit-debug-on-message'.
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Give more-useful info on a fatal error (Bug#12328).
* alloc.c [ENABLE_CHECKING]: Do not include <execinfo.h>.
(die) [ENABLE_CHECKING]: Call fatal_error_backtrace instead
of doing the work ourselves.
* emacs.c (fatal_error_signal): Let fatal_error_backtrace
do most of the work.
(fatal_error_backtrace): New function, taken from the guts
of the old fatal_error_signal, but with a new option to output
a backtrace.
(shut_down_emacs) [!DOS_NT]: Use strsignal to give more-useful
info about the signal than just its number.
* lisp.h (fatal_error_backtrace, emacs_backtrace): New decls.
* sysdep.c: Include <execinfo.h>
(emacs_backtrace): New function, taken partly from the previous
code of the 'die' function.
(emacs_abort): Call fatal_error_backtrace rather than abort.
2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
* lread.c (readevalloop): Call internal-macroexpand-for-load to perform
eager (load-time) macro-expansion.
* lisp.mk (lisp): Add macroexp.
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Simplify redefinition of 'abort' (Bug#12316).
Do not try to redefine the 'abort' function. Instead, redo
the code so that it calls 'emacs_abort' rather than 'abort'.
This removes the need for the NO_ABORT configure-time macro
and makes it easier to change the abort code to do a backtrace.
* .gdbinit: Just stop at emacs_abort, not at w32_abort or abort.
* emacs.c (abort) [!DOS_NT && !NO_ABORT]:
Remove; sysdep.c's emacs_abort now takes its place.
* lisp.h (emacs_abort): New decl. All calls from Emacs code to
'abort' changed to use 'emacs_abort'.
* msdos.c (dos_abort) [defined abort]: Remove; not used.
(abort) [!defined abort]: Rename to ...
(emacs_abort): ... new name.
* sysdep.c (emacs_abort) [!HAVE_NTGUI]: New function, taking
the place of the old 'abort' in emacs.c.
* w32.c, w32fns.c (abort): Do not #undef.
* w32.c (emacs_abort): Rename from w32_abort.
2012-09-04 Eli Zaretskii <eliz@gnu.org>
* w32uniscribe.c (uniscribe_shape): Reverse the sign of
offsets[j].dv, since the y axis of the screen coordinates points
down, while the y axis of the font definition coordinates points
up. This fixes display of Arabic diacritics such as KASRA and
KASRATAN. (Bug#11860)
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
Be more systematic about _setjmp vs setjmp.
* alloc.c (test_setjmp, mark_stack):
* image.c (PNG_LONGJMP) [PNG_LIBPNG_VER < 10500]:
(PNG_JMPBUF) [! (PNG_LIBPNG_VER < 10500)]:
(png_load, my_error_exit, jpeg_load):
* process.c (send_process_trap, send_process):
Uniformly prefer _setjmp and _longjmp to setjmp and longjmp.
The underscored versions are up to 30x faster on some hosts.
Formerly, the code used setjmp+longjmp sometimes and
_setjmp+_longjmp at other times, with no particular reason to
prefer setjmp+longjmp.
2012-09-03 Paul Eggert <eggert@cs.ucla.edu>
Fix minor problems found by static checking.
Fix minor problem found by static checking.
* buffer.c (Fdelete_all_overlays): Return nil.
* doc.c (Fsubstitute_command_keys):
* regex.c (WEAK_ALIAS):
* xdisp.c (redisplay_internal):
Move initialization down, to pacify GCC 4.7.1 -Wjump-misses-init.
2012-09-03 Martin Rudalics <rudalics@gmx.at>

124
src/alloc.c
View file

@ -26,7 +26,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <limits.h> /* For CHAR_BIT. */
#include <setjmp.h>
#include <signal.h>
#ifdef ENABLE_CHECKING
#include <signal.h> /* For SIGABRT. */
#endif
#ifdef HAVE_PTHREAD
#include <pthread.h>
@ -42,7 +44,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
#include "syssignal.h"
#include "termhooks.h" /* For struct terminal. */
#include <setjmp.h>
#include <verify.h>
@ -278,6 +279,7 @@ static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
static void mark_glyph_matrix (struct glyph_matrix *);
static void mark_face_cache (struct face_cache *);
static void mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
@ -613,7 +615,7 @@ overrun_check_malloc (size_t size)
register unsigned char *val;
int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
if (SIZE_MAX - overhead < size)
abort ();
emacs_abort ();
val = malloc (size + overhead);
if (val && check_depth == 1)
@ -638,7 +640,7 @@ overrun_check_realloc (void *block, size_t size)
register unsigned char *val = (unsigned char *) block;
int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
if (SIZE_MAX - overhead < size)
abort ();
emacs_abort ();
if (val
&& check_depth == 1
@ -649,7 +651,7 @@ overrun_check_realloc (void *block, size_t size)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
abort ();
emacs_abort ();
memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
@ -686,7 +688,7 @@ overrun_check_free (void *block)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
abort ();
emacs_abort ();
#ifdef XMALLOC_CLEAR_FREE_MEMORY
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
@ -1272,7 +1274,7 @@ emacs_blocked_free (void *ptr, const void *ptr2)
{
fprintf (stderr,
"Freeing `%p' which wasn't allocated with malloc\n", ptr);
abort ();
emacs_abort ();
}
else
{
@ -1331,7 +1333,7 @@ emacs_blocked_malloc (size_t size, const void *ptr)
fprintf (stderr, "Region in use is %p...%p, %td bytes, type %d\n",
m->start, m->end, (char *) m->end - (char *) m->start,
m->type);
abort ();
emacs_abort ();
}
if (!dont_register_blocks)
@ -1369,7 +1371,7 @@ emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
fprintf (stderr,
"Realloc of %p which wasn't allocated with malloc\n",
ptr);
abort ();
emacs_abort ();
}
mem_delete (m);
@ -1391,7 +1393,7 @@ emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
if (m != MEM_NIL)
{
fprintf (stderr, "Realloc returns memory that is already in use\n");
abort ();
emacs_abort ();
}
/* Can't handle zero size regions in the red-black tree. */
@ -1804,7 +1806,7 @@ string_bytes (struct Lisp_String *s)
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
abort ();
emacs_abort ();
return nbytes;
}
@ -1878,7 +1880,7 @@ check_string_free_list (void)
while (s != NULL)
{
if ((uintptr_t) s < 1024)
abort ();
emacs_abort ();
s = NEXT_FREE_LISP_STRING (s);
}
}
@ -2107,7 +2109,7 @@ sweep_strings (void)
back-pointer so that we know it's free. */
#ifdef GC_CHECK_STRING_BYTES
if (string_bytes (s) != SDATA_NBYTES (data))
abort ();
emacs_abort ();
#else
data->u.nbytes = STRING_BYTES (s);
#endif
@ -2218,7 +2220,7 @@ compact_small_strings (void)
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
if (s && string_bytes (s) != SDATA_NBYTES (from))
abort ();
emacs_abort ();
#endif /* GC_CHECK_STRING_BYTES */
nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
@ -2231,7 +2233,7 @@ compact_small_strings (void)
if (memcmp (string_overrun_cookie,
(char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
GC_STRING_OVERRUN_COOKIE_SIZE))
abort ();
emacs_abort ();
#endif
/* Non-NULL S means it's alive. Copy its data. */
@ -2488,7 +2490,7 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
struct Lisp_String *s;
if (nchars < 0)
abort ();
emacs_abort ();
if (!nbytes)
return empty_multibyte_string;
@ -2809,7 +2811,7 @@ listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...)
else if (type == CONSTYPE_HEAP)
val = Fcons (objp[i], val);
else
abort ();
emacs_abort ();
}
return val;
}
@ -3281,7 +3283,10 @@ allocate_buffer (void)
XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
- header_size) / word_size);
/* Note that the fields of B are not initialized. */
/* Put B on the chain of all buffers including killed ones. */
b->header.next.buffer = all_buffers;
all_buffers = b;
/* Note that the rest fields of B are not initialized. */
return b;
}
@ -3919,7 +3924,7 @@ mem_insert (void *start, void *end, enum mem_type type)
while (c != MEM_NIL)
{
if (start >= c->start && start < c->end)
abort ();
emacs_abort ();
parent = c;
c = start < c->start ? c->left : c->right;
}
@ -3938,7 +3943,7 @@ mem_insert (void *start, void *end, enum mem_type type)
#ifdef GC_MALLOC_CHECK
x = _malloc_internal (sizeof *x);
if (x == NULL)
abort ();
emacs_abort ();
#else
x = xmalloc (sizeof *x);
#endif
@ -4613,7 +4618,7 @@ mark_maybe_pointer (void *p)
break;
default:
abort ();
emacs_abort ();
}
if (!NILP (obj))
@ -4764,7 +4769,7 @@ test_setjmp (void)
x = strlen (buf);
x = 2 * x - 1;
setjmp (jbuf);
_setjmp (jbuf);
if (longjmps_done == 1)
{
/* Came here after the longjmp at the end of the function.
@ -4789,7 +4794,7 @@ test_setjmp (void)
++longjmps_done;
x = 2;
if (longjmps_done == 1)
longjmp (jbuf, 1);
_longjmp (jbuf, 1);
}
#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */
@ -4810,7 +4815,7 @@ check_gcpros (void)
if (!survives_gc_p (p->var[i]))
/* FIXME: It's not necessarily a bug. It might just be that the
GCPRO is unnecessary or should release the object sooner. */
abort ();
emacs_abort ();
}
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
@ -4931,7 +4936,7 @@ mark_stack (void)
}
#endif /* GC_SETJMP_WORKS */
setjmp (j.j);
_setjmp (j.j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
#endif /* not HAVE___BUILTIN_UNWIND_INIT */
@ -4981,7 +4986,8 @@ valid_pointer_p (void *p)
#endif
}
/* Return 1 if OBJ is a valid lisp object.
/* Return 2 if OBJ is a killed or special buffer object.
Return 1 if OBJ is a valid lisp object.
Return 0 if OBJ is NOT a valid lisp object.
Return -1 if we cannot validate OBJ.
This function can be quite slow,
@ -5002,6 +5008,9 @@ valid_lisp_object_p (Lisp_Object obj)
if (PURE_POINTER_P (p))
return 1;
if (p == &buffer_defaults || p == &buffer_local_symbols)
return 2;
#if !GC_MARK_STACK
return valid_pointer_p (p);
#else
@ -5027,7 +5036,7 @@ valid_lisp_object_p (Lisp_Object obj)
return 0;
case MEM_TYPE_BUFFER:
return live_buffer_p (m, p);
return live_buffer_p (m, p) ? 1 : 2;
case MEM_TYPE_CONS:
return live_cons_p (m, p);
@ -5351,7 +5360,7 @@ staticpro (Lisp_Object *varaddress)
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
abort ();
emacs_abort ();
}
@ -5406,7 +5415,7 @@ See Info node `(elisp)Garbage Collection'. */)
Lisp_Object retval = Qnil;
if (abort_on_gc)
abort ();
emacs_abort ();
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
@ -5469,6 +5478,9 @@ See Info node `(elisp)Garbage Collection'. */)
/* Mark all the special slots that serve as the roots of accessibility. */
mark_buffer (&buffer_defaults);
mark_buffer (&buffer_local_symbols);
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
@ -5887,7 +5899,7 @@ mark_object (Lisp_Object arg)
do { \
m = mem_find (po); \
if (m == MEM_NIL) \
abort (); \
emacs_abort (); \
} while (0)
/* Check that the object pointed to by PO is live, using predicate
@ -5895,7 +5907,7 @@ mark_object (Lisp_Object arg)
#define CHECK_LIVE(LIVEP) \
do { \
if (!LIVEP (m, po)) \
abort (); \
emacs_abort (); \
} while (0)
/* Check both of the above conditions. */
@ -5940,10 +5952,8 @@ mark_object (Lisp_Object arg)
#ifdef GC_CHECK_MARKED_OBJECTS
m = mem_find (po);
if (m == MEM_NIL && !SUBRP (obj)
&& po != &buffer_defaults
&& po != &buffer_local_symbols)
abort ();
if (m == MEM_NIL && !SUBRP (obj))
emacs_abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
if (ptr->header.size & PSEUDOVECTOR_FLAG)
@ -5959,15 +5969,14 @@ mark_object (Lisp_Object arg)
{
case PVEC_BUFFER:
#ifdef GC_CHECK_MARKED_OBJECTS
if (po != &buffer_defaults && po != &buffer_local_symbols)
{
struct buffer *b;
FOR_EACH_BUFFER (b)
if (b == po)
break;
if (b == NULL)
abort ();
}
{
struct buffer *b;
FOR_EACH_BUFFER (b)
if (b == po)
break;
if (b == NULL)
emacs_abort ();
}
#endif /* GC_CHECK_MARKED_OBJECTS */
mark_buffer ((struct buffer *) ptr);
break;
@ -5992,10 +6001,8 @@ mark_object (Lisp_Object arg)
break;
case PVEC_FRAME:
{
mark_vectorlike (ptr);
mark_face_cache (((struct frame *) ptr)->face_cache);
}
mark_vectorlike (ptr);
mark_face_cache (((struct frame *) ptr)->face_cache);
break;
case PVEC_WINDOW:
@ -6042,7 +6049,7 @@ mark_object (Lisp_Object arg)
break;
case PVEC_FREE:
abort ();
emacs_abort ();
default:
mark_vectorlike (ptr);
@ -6089,7 +6096,7 @@ mark_object (Lisp_Object arg)
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
break;
default: abort ();
default: emacs_abort ();
}
if (!PURE_POINTER_P (XSTRING (ptr->name)))
MARK_STRING (XSTRING (ptr->name));
@ -6143,7 +6150,7 @@ mark_object (Lisp_Object arg)
break;
default:
abort ();
emacs_abort ();
}
break;
@ -6165,7 +6172,7 @@ mark_object (Lisp_Object arg)
obj = ptr->u.cdr;
cdr_count++;
if (cdr_count == mark_object_loop_halt)
abort ();
emacs_abort ();
goto loop;
}
@ -6178,7 +6185,7 @@ mark_object (Lisp_Object arg)
break;
default:
abort ();
emacs_abort ();
}
#undef CHECK_LIVE
@ -6247,7 +6254,7 @@ survives_gc_p (Lisp_Object obj)
break;
default:
abort ();
emacs_abort ();
}
return survives_p || PURE_POINTER_P ((void *) XPNTR (obj));
@ -6685,21 +6692,14 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max)
#ifdef ENABLE_CHECKING
# include <execinfo.h>
bool suppress_checking;
void
die (const char *msg, const char *file, int line)
{
enum { NPOINTERS_MAX = 500 };
void *buffer[NPOINTERS_MAX];
int npointers;
fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
file, line, msg);
npointers = backtrace (buffer, NPOINTERS_MAX);
backtrace_symbols_fd (buffer, npointers, STDERR_FILENO);
abort ();
fatal_error_backtrace (SIGABRT, INT_MAX);
}
#endif

69
src/atimer.c
View file

@ -17,7 +17,6 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <signal.h>
#include <stdio.h>
#include <setjmp.h>
#include "lisp.h"
@ -41,7 +40,7 @@ static struct atimer *stopped_atimers;
static struct atimer *atimers;
/* Non-zero means alarm_signal_handler has found ripe timers but
/* Non-zero means alarm signal handler has found ripe timers but
interrupt_input_blocked was non-zero. In this case, timer
functions are not called until the next UNBLOCK_INPUT because timer
functions are expected to call X, and X cannot be assumed to be
@ -51,8 +50,24 @@ int pending_atimers;
/* Block/unblock SIGALRM. */
#define BLOCK_ATIMERS sigblock (sigmask (SIGALRM))
#define UNBLOCK_ATIMERS sigunblock (sigmask (SIGALRM))
static void
sigmask_atimers (int how)
{
sigset_t blocked;
sigemptyset (&blocked);
sigaddset (&blocked, SIGALRM);
pthread_sigmask (how, &blocked, 0);
}
static void
block_atimers (void)
{
sigmask_atimers (SIG_BLOCK);
}
static void
unblock_atimers (void)
{
sigmask_atimers (SIG_UNBLOCK);
}
/* Function prototypes. */
@ -60,8 +75,6 @@ static void set_alarm (void);
static void schedule_atimer (struct atimer *);
static struct atimer *append_atimer_lists (struct atimer *,
struct atimer *);
static void alarm_signal_handler (int signo);
/* Start a new atimer of type TYPE. TIME specifies when the timer is
ripe. FN is the function to call when the timer fires.
@ -111,7 +124,7 @@ start_atimer (enum atimer_type type, EMACS_TIME timestamp, atimer_callback fn,
t->fn = fn;
t->client_data = client_data;
BLOCK_ATIMERS;
block_atimers ();
/* Compute the timer's expiration time. */
switch (type)
@ -132,7 +145,7 @@ start_atimer (enum atimer_type type, EMACS_TIME timestamp, atimer_callback fn,
/* Insert the timer in the list of active atimers. */
schedule_atimer (t);
UNBLOCK_ATIMERS;
unblock_atimers ();
/* Arrange for a SIGALRM at the time the next atimer is ripe. */
set_alarm ();
@ -148,7 +161,7 @@ cancel_atimer (struct atimer *timer)
{
int i;
BLOCK_ATIMERS;
block_atimers ();
for (i = 0; i < 2; ++i)
{
@ -175,7 +188,7 @@ cancel_atimer (struct atimer *timer)
}
}
UNBLOCK_ATIMERS;
unblock_atimers ();
}
@ -206,7 +219,7 @@ append_atimer_lists (struct atimer *list_1, struct atimer *list_2)
void
stop_other_atimers (struct atimer *t)
{
BLOCK_ATIMERS;
block_atimers ();
if (t)
{
@ -231,7 +244,7 @@ stop_other_atimers (struct atimer *t)
stopped_atimers = append_atimer_lists (atimers, stopped_atimers);
atimers = t;
UNBLOCK_ATIMERS;
unblock_atimers ();
}
@ -246,7 +259,7 @@ run_all_atimers (void)
struct atimer *t = atimers;
struct atimer *next;
BLOCK_ATIMERS;
block_atimers ();
atimers = stopped_atimers;
stopped_atimers = NULL;
@ -257,7 +270,7 @@ run_all_atimers (void)
t = next;
}
UNBLOCK_ATIMERS;
unblock_atimers ();
}
}
@ -374,13 +387,9 @@ run_timers (void)
/* Signal handler for SIGALRM. SIGNO is the signal number, i.e.
SIGALRM. */
void
alarm_signal_handler (int signo)
static void
handle_alarm_signal (int sig)
{
#ifndef SYNC_INPUT
SIGNAL_THREAD_CHECK (signo);
#endif
pending_atimers = 1;
#ifdef SYNC_INPUT
pending_signals = 1;
@ -389,17 +398,23 @@ alarm_signal_handler (int signo)
#endif
}
static void
deliver_alarm_signal (int sig)
{
handle_on_main_thread (sig, handle_alarm_signal);
}
/* Call alarm_signal_handler for pending timers. */
/* Call alarm signal handler for pending timers. */
void
do_pending_atimers (void)
{
if (pending_atimers)
{
BLOCK_ATIMERS;
block_atimers ();
run_timers ();
UNBLOCK_ATIMERS;
unblock_atimers ();
}
}
@ -412,7 +427,9 @@ turn_on_atimers (bool on)
{
if (on)
{
signal (SIGALRM, alarm_signal_handler);
struct sigaction action;
emacs_sigaction_init (&action, deliver_alarm_signal);
sigaction (SIGALRM, &action, 0);
set_alarm ();
}
else
@ -423,8 +440,10 @@ turn_on_atimers (bool on)
void
init_atimer (void)
{
struct sigaction action;
free_atimers = stopped_atimers = atimers = NULL;
pending_atimers = 0;
/* pending_signals is initialized in init_keyboard.*/
signal (SIGALRM, alarm_signal_handler);
emacs_sigaction_init (&action, deliver_alarm_signal);
sigaction (SIGALRM, &action, 0);
}

79
src/bidi.c
View file

@ -105,7 +105,7 @@ bidi_get_type (int ch, bidi_dir_t override)
if (ch == BIDI_EOB)
return NEUTRAL_B;
if (ch < 0 || ch > MAX_CHAR)
abort ();
emacs_abort ();
default_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
/* Every valid character code, even those that are unassigned by the
@ -113,7 +113,7 @@ bidi_get_type (int ch, bidi_dir_t override)
DerivedBidiClass.txt file. Therefore, if we ever get UNKNOWN_BT
(= zero) code from CHAR_TABLE_REF, that's a bug. */
if (default_type == UNKNOWN_BT)
abort ();
emacs_abort ();
if (override == NEUTRAL_DIR)
return default_type;
@ -141,7 +141,7 @@ bidi_get_type (int ch, bidi_dir_t override)
else if (override == R2L)
return STRONG_R;
else
abort (); /* can't happen: handled above */
emacs_abort (); /* can't happen: handled above */
}
}
}
@ -183,7 +183,7 @@ bidi_get_category (bidi_type_t type)
case NEUTRAL_ON:
return NEUTRAL;
default:
abort ();
emacs_abort ();
}
}
@ -199,7 +199,7 @@ bidi_mirror_char (int c)
if (c == BIDI_EOB)
return c;
if (c < 0 || c > MAX_CHAR)
abort ();
emacs_abort ();
val = CHAR_TABLE_REF (bidi_mirror_table, c);
if (INTEGERP (val))
@ -215,7 +215,7 @@ bidi_mirror_char (int c)
/* Minimal test we must do in optimized builds, to prevent weird
crashes further down the road. */
if (v < 0 || v > MAX_CHAR)
abort ();
emacs_abort ();
return v;
}
@ -373,7 +373,7 @@ bidi_cache_fetch_state (ptrdiff_t idx, struct bidi_it *bidi_it)
int current_scan_dir = bidi_it->scan_dir;
if (idx < bidi_cache_start || idx >= bidi_cache_idx)
abort ();
emacs_abort ();
bidi_copy_it (bidi_it, &bidi_cache[idx]);
bidi_it->scan_dir = current_scan_dir;
@ -518,7 +518,7 @@ bidi_cache_iterator_state (struct bidi_it *bidi_it, bool resolved)
/* We should never cache on backward scans. */
if (bidi_it->scan_dir == -1)
abort ();
emacs_abort ();
idx = bidi_cache_search (bidi_it->charpos, -1, 1);
if (idx < 0)
@ -537,7 +537,7 @@ bidi_cache_iterator_state (struct bidi_it *bidi_it, bool resolved)
idx = bidi_cache_start;
}
if (bidi_it->nchars <= 0)
abort ();
emacs_abort ();
bidi_copy_it (&bidi_cache[idx], bidi_it);
if (!resolved)
bidi_cache[idx].resolved_level = -1;
@ -592,7 +592,7 @@ static inline int
bidi_peek_at_next_level (struct bidi_it *bidi_it)
{
if (bidi_cache_idx == bidi_cache_start || bidi_cache_last_idx == -1)
abort ();
emacs_abort ();
return bidi_cache[bidi_cache_last_idx + bidi_it->scan_dir].resolved_level;
}
@ -629,7 +629,7 @@ void
bidi_pop_it (struct bidi_it *bidi_it)
{
if (bidi_cache_start <= 0)
abort ();
emacs_abort ();
/* Reset the next free cache slot index to what it was before the
call to bidi_push_it. */
@ -640,7 +640,7 @@ bidi_pop_it (struct bidi_it *bidi_it)
/* Pop the previous cache start from the stack. */
if (bidi_cache_sp <= 0)
abort ();
emacs_abort ();
bidi_cache_start = bidi_cache_start_stack[--bidi_cache_sp];
/* Invalidate the last-used cache slot data. */
@ -762,12 +762,12 @@ bidi_initialize (void)
{
bidi_type_table = uniprop_table (intern ("bidi-class"));
if (NILP (bidi_type_table))
abort ();
emacs_abort ();
staticpro (&bidi_type_table);
bidi_mirror_table = uniprop_table (intern ("mirroring"));
if (NILP (bidi_mirror_table))
abort ();
emacs_abort ();
staticpro (&bidi_mirror_table);
Qparagraph_start = intern ("paragraph-start");
@ -885,7 +885,7 @@ bidi_count_bytes (const unsigned char *s, const ptrdiff_t beg,
else
{
if (!CHAR_HEAD_P (*p))
abort ();
emacs_abort ();
while (pos < end)
{
@ -965,7 +965,7 @@ bidi_fetch_char (ptrdiff_t bytepos, ptrdiff_t charpos, ptrdiff_t *disp_pos,
/* We don't expect to find ourselves in the middle of a display
property. Hopefully, it will never be needed. */
if (charpos > *disp_pos)
abort ();
emacs_abort ();
/* Text covered by `display' properties and overlays with
display properties or display strings is handled as a single
character that represents the entire run of characters
@ -995,7 +995,7 @@ bidi_fetch_char (ptrdiff_t bytepos, ptrdiff_t charpos, ptrdiff_t *disp_pos,
}
*nchars = disp_end_pos - *disp_pos;
if (*nchars <= 0)
abort ();
emacs_abort ();
if (string->s)
*ch_len = bidi_count_bytes (string->s, *disp_pos, bytepos,
disp_end_pos, string->unibyte);
@ -1160,7 +1160,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p)
dir = L2R;
/* We should never be called at EOB or before BEGV. */
else if (bidi_it->charpos >= end || bytepos < begbyte)
abort ();
emacs_abort ();
if (dir == L2R)
{
@ -1298,7 +1298,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p)
&& no_default_p && bidi_it->paragraph_dir == NEUTRAL_DIR);
}
else
abort ();
emacs_abort ();
/* Contrary to UAX#9 clause P3, we only default the paragraph
direction to L2R if we have no previous usable paragraph
@ -1325,7 +1325,7 @@ bidi_explicit_dir_char (int ch)
bidi_type_t ch_type;
if (!bidi_initialized)
abort ();
emacs_abort ();
ch_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
return (ch_type == LRE || ch_type == LRO
|| ch_type == RLE || ch_type == RLO
@ -1378,10 +1378,10 @@ bidi_resolve_explicit_1 (struct bidi_it *bidi_it)
/* Advance to the next character, skipping characters covered by
display strings (nchars > 1). */
if (bidi_it->nchars <= 0)
abort ();
emacs_abort ();
bidi_it->charpos += bidi_it->nchars;
if (bidi_it->ch_len == 0)
abort ();
emacs_abort ();
bidi_it->bytepos += bidi_it->ch_len;
}
@ -1581,7 +1581,7 @@ bidi_resolve_explicit (struct bidi_it *bidi_it)
}
if (bidi_it->nchars <= 0)
abort ();
emacs_abort ();
if (level == prev_level) /* empty embedding */
saved_it.ignore_bn_limit = bidi_it->charpos + bidi_it->nchars;
else /* this embedding is non-empty */
@ -1644,7 +1644,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
|| type == RLE
|| type == RLO
|| type == PDF)
abort ();
emacs_abort ();
if (new_level != prev_level
|| bidi_it->type == NEUTRAL_B)
@ -1685,7 +1685,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
else if (bidi_it->sor == L2R)
type = STRONG_L;
else /* shouldn't happen! */
abort ();
emacs_abort ();
}
if (type == WEAK_EN /* W2 */
&& bidi_it->last_strong.type_after_w1 == STRONG_AL)
@ -1767,7 +1767,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
: bidi_it->string.s);
if (bidi_it->nchars <= 0)
abort ();
emacs_abort ();
next_char
= (bidi_it->charpos + bidi_it->nchars >= eob
? BIDI_EOB
@ -1875,7 +1875,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
|| type == NEUTRAL_S
|| type == NEUTRAL_WS
|| type == NEUTRAL_ON))
abort ();
emacs_abort ();
if ((type != NEUTRAL_B /* Don't risk entering the long loop below if
we are already at paragraph end. */
@ -1930,7 +1930,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
bidi_type_t next_type;
if (bidi_it->scan_dir == -1)
abort ();
emacs_abort ();
bidi_copy_it (&saved_it, bidi_it);
/* Scan the text forward until we find the first non-neutral
@ -1979,7 +1979,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
break;
case WEAK_BN:
if (!bidi_explicit_dir_char (bidi_it->ch))
abort (); /* can't happen: BNs are skipped */
emacs_abort (); /* can't happen: BNs are skipped */
/* FALLTHROUGH */
case NEUTRAL_B:
/* Marched all the way to the end of this level run.
@ -1998,7 +1998,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
}
break;
default:
abort ();
emacs_abort ();
}
type = bidi_resolve_neutral_1 (saved_it.prev_for_neutral.type,
next_type, current_level);
@ -2023,7 +2023,7 @@ bidi_type_of_next_char (struct bidi_it *bidi_it)
/* This should always be called during a forward scan. */
if (bidi_it->scan_dir != 1)
abort ();
emacs_abort ();
/* Reset the limit until which to ignore BNs if we step out of the
area where we found only empty levels. */
@ -2107,7 +2107,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
if (bidi_it->scan_dir > 0)
{
if (bidi_it->nchars <= 0)
abort ();
emacs_abort ();
next_char_pos = bidi_it->charpos + bidi_it->nchars;
}
else if (bidi_it->charpos >= bob)
@ -2143,7 +2143,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
if (bidi_it->scan_dir == -1)
/* If we are going backwards, the iterator state is already cached
from previous scans, and should be fully resolved. */
abort ();
emacs_abort ();
if (type == UNKNOWN_BT)
type = bidi_type_of_next_char (bidi_it);
@ -2156,7 +2156,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
|| (type == WEAK_BN && prev_level == level))
{
if (bidi_it->next_for_neutral.type == UNKNOWN_BT)
abort ();
emacs_abort ();
/* If the cached state shows a neutral character, it was not
resolved by bidi_resolve_neutral, so do it now. */
@ -2170,7 +2170,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
|| type == WEAK_BN
|| type == WEAK_EN
|| type == WEAK_AN))
abort ();
emacs_abort ();
bidi_it->type = type;
bidi_check_type (bidi_it->type);
@ -2192,7 +2192,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
int dpp = bidi_it->disp_prop;
if (bidi_it->nchars <= 0)
abort ();
emacs_abort ();
do {
ch = bidi_fetch_char (bpos += clen, cpos += nc, &disp_pos, &dpp, &bs,
fwp, &clen, &nc);
@ -2301,8 +2301,9 @@ bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, bool end_flag)
{
int new_level;
/* If we are at end of level, its edges must be cached. */
if (end_flag)
abort (); /* if we are at end of level, its edges must be cached */
emacs_abort ();
bidi_cache_iterator_state (bidi_it, 1);
do {
@ -2320,7 +2321,7 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
struct gcpro gcpro1;
if (bidi_it->charpos < 0 || bidi_it->bytepos < 0)
abort ();
emacs_abort ();
if (bidi_it->scan_dir == 0)
{
@ -2431,7 +2432,7 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
= bidi_at_paragraph_end (bidi_it->charpos + bidi_it->nchars,
bidi_it->bytepos + bidi_it->ch_len);
if (bidi_it->nchars <= 0)
abort ();
emacs_abort ();
if (sep_len >= 0)
{
bidi_it->new_paragraph = 1;

3
src/blockinput.h
View file

@ -89,7 +89,7 @@ extern int pending_atimers;
do_pending_atimers (); \
} \
else if (interrupt_input_blocked < 0) \
abort (); \
emacs_abort (); \
} \
while (0)
@ -124,4 +124,3 @@ extern int pending_atimers;
extern void reinvoke_input_signal (void);
#endif /* EMACS_BLOCKINPUT_H */

44
src/buffer.c
View file

@ -44,7 +44,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keymap.h"
#include "frame.h"
struct buffer *current_buffer; /* the current buffer */
struct buffer *current_buffer; /* The current buffer. */
/* First buffer in chain of all buffers (in reverse order of creation).
Threaded through ->header.next.buffer. */
@ -60,10 +60,6 @@ struct buffer *all_buffers;
struct buffer alignas (GCALIGNMENT) buffer_defaults;
/* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_defaults;
/* This structure marks which slots in a buffer have corresponding
default values in buffer_defaults.
Each such slot has a nonzero value in this structure.
@ -78,18 +74,15 @@ static Lisp_Object Vbuffer_defaults;
and the corresponding slot in buffer_defaults is not used.
If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
zero, that is a bug */
zero, that is a bug. */
struct buffer buffer_local_flags;
/* This structure holds the names of symbols whose values may be
buffer-local. It is indexed and accessed in the same way as the above. */
buffer-local. It is indexed and accessed in the same way as the above. */
struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
/* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_local_symbols;
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
@ -115,7 +108,7 @@ static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
static void swap_out_buffer_local_variables (struct buffer *b);
static void reset_buffer_local_variables (struct buffer *, bool);
/* Alist of all buffer names vs the buffers. */
/* Alist of all buffer names vs the buffers. */
/* This used to be a variable, but is no longer,
to prevent lossage due to user rplac'ing this alist or its elements. */
Lisp_Object Vbuffer_alist;
@ -134,7 +127,7 @@ static Lisp_Object Qpermanent_local_hook;
static Lisp_Object Qprotected_field;
static Lisp_Object QSFundamental; /* A string "Fundamental" */
static Lisp_Object QSFundamental; /* A string "Fundamental". */
static Lisp_Object Qkill_buffer_hook;
static Lisp_Object Qbuffer_list_update_hook;
@ -595,10 +588,6 @@ even if it is dead. The return value is never nil. */)
bset_width_table (b, Qnil);
b->prevent_redisplay_optimizations_p = 1;
/* Put this on the chain of all buffers including killed ones. */
b->header.next.buffer = all_buffers;
all_buffers = b;
/* An ordinary buffer normally doesn't need markers
to handle BEGV and ZV. */
bset_pt_marker (b, Qnil);
@ -819,10 +808,6 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
b->width_run_cache = 0;
bset_width_table (b, Qnil);
/* Put this on the chain of all buffers including killed ones. */
b->header.next.buffer = all_buffers;
all_buffers = b;
name = Fcopy_sequence (name);
set_string_intervals (name, NULL);
bset_name (b, name);
@ -1242,7 +1227,7 @@ buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer)
result = Fdefault_value (variable);
break;
}
default: abort ();
default: emacs_abort ();
}
return result;
@ -2671,7 +2656,7 @@ current buffer is cleared. */)
/* Make sure no markers were put on the chain
while the chain value was incorrect. */
if (BUF_MARKERS (current_buffer))
abort ();
emacs_abort ();
BUF_MARKERS (current_buffer) = markers;
@ -3413,7 +3398,7 @@ overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
}
}
if (p != overlay_str_buf + total)
abort ();
emacs_abort ();
if (pstr)
*pstr = overlay_str_buf;
return total;
@ -4596,7 +4581,7 @@ buffer_slot_type_mismatch (Lisp_Object newval, int type)
case_Lisp_Int: predicate = Qintegerp; break;
case Lisp_String: predicate = Qstringp; break;
case Lisp_Symbol: predicate = Qsymbolp; break;
default: abort ();
default: emacs_abort ();
}
wrong_type_argument (predicate, newval);
@ -5145,10 +5130,11 @@ init_buffer_once (void)
buffer_local_symbols.indirections = 0;
set_buffer_intervals (&buffer_defaults, NULL);
set_buffer_intervals (&buffer_local_symbols, NULL);
/* This is not strictly necessary, but let's make them initialized. */
bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, pvecsize);
XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, pvecsize);
XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
/* Set up the default values of various buffer slots. */
/* Must do these before making the first buffer! */
@ -5277,7 +5263,7 @@ init_buffer_once (void)
/* Need more room? */
if (idx >= MAX_PER_BUFFER_VARS)
abort ();
emacs_abort ();
last_per_buffer_idx = idx;
Vbuffer_alist = Qnil;
@ -5418,7 +5404,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
if (PER_BUFFER_IDX (offset) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding
slot of buffer_local_flags */
abort ();
emacs_abort ();
}
@ -5430,8 +5416,6 @@ syms_of_buffer (void)
last_overlay_modification_hooks
= Fmake_vector (make_number (10), Qnil);
staticpro (&Vbuffer_defaults);
staticpro (&Vbuffer_local_symbols);
staticpro (&Qfundamental_mode);
staticpro (&Qmode_class);
staticpro (&QSFundamental);

6
src/buffer.h
View file

@ -1149,7 +1149,7 @@ BUF_FETCH_MULTIBYTE_CHAR (struct buffer *buf, ptrdiff_t pos)
We assume you know which buffer it's pointing into. */
#define OVERLAY_POSITION(P) \
(MARKERP (P) ? marker_position (P) : (abort (), 0))
(MARKERP (P) ? marker_position (P) : (emacs_abort (), 0))
/***********************************************************************
@ -1189,7 +1189,7 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_VALUE_P(B, IDX) \
(((IDX) < 0 || IDX >= last_per_buffer_idx) \
? (abort (), 0) \
? (emacs_abort (), 0) \
: ((B)->local_flags[IDX] != 0))
/* Set whether per-buffer variable with index IDX has a buffer-local
@ -1198,7 +1198,7 @@ extern int last_per_buffer_idx;
#define SET_PER_BUFFER_VALUE_P(B, IDX, VAL) \
do { \
if ((IDX) < 0 || (IDX) >= last_per_buffer_idx) \
abort (); \
emacs_abort (); \
(B)->local_flags[IDX] = (VAL); \
} while (0)

16
src/bytecode.c
View file

@ -435,7 +435,7 @@ unmark_byte_stack (void)
#ifdef BYTE_CODE_SAFE
#define CHECK_RANGE(ARG) \
if (ARG >= bytestr_length) abort ()
if (ARG >= bytestr_length) emacs_abort ()
#else /* not BYTE_CODE_SAFE */
@ -508,7 +508,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (FRAME_X_P (f)
&& FRAME_FONT (f)->direction != 0
&& FRAME_FONT (f)->direction != 1)
abort ();
emacs_abort ();
}
#endif
@ -600,9 +600,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{
#ifdef BYTE_CODE_SAFE
if (top > stacke)
abort ();
emacs_abort ();
else if (top < stack.bottom - 1)
abort ();
emacs_abort ();
#endif
#ifdef BYTE_CODE_METER
@ -1875,7 +1875,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
/* CASE (Bstack_ref): */
abort ();
emacs_abort ();
/* Handy byte-codes for lexical binding. */
CASE (Bstack_ref1):
@ -1928,11 +1928,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
#ifdef BYTE_CODE_SAFE
if (op < Bconstant)
{
abort ();
emacs_abort ();
}
if ((op -= Bconstant) >= const_length)
{
abort ();
emacs_abort ();
}
PUSH (vectorp[op]);
#else
@ -1951,7 +1951,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
#ifdef BYTE_CODE_SAFE
error ("binding stack not balanced (serious byte compiler bug)");
#else
abort ();
emacs_abort ();
#endif
return result;

4
src/callproc.c
View file

@ -19,7 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <signal.h>
#include <errno.h>
#include <stdio.h>
#include <setjmp.h>
@ -506,9 +505,6 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
if (fd_output >= 0)
fd1 = fd_output;
#if 0 /* Some systems don't have sigblock. */
mask = sigblock (sigmask (SIGCHLD));
#endif
/* Record that we're about to create a synchronous process. */
synch_process_alive = 1;

2
src/character.c
View file

@ -541,7 +541,7 @@ multibyte_chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
int len = MULTIBYTE_LENGTH (ptr, endp);
if (len == 0)
abort ();
emacs_abort ();
ptr += len;
chars++;
}

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