mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity

merge trunk

Browse Source
This commit is contained in:
Kenichi Handa 2012-08-22 18:05:50 +09:00
commit fabc1281e9
123 changed files with 4569 additions and 2730 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
ChangeLog
View File

@ -1,3 +1,32 @@
2012-08-22 Glenn Morris <rgm@gnu.org>
* Makefile.in (install-arch-dep): If NO_BIN_LINK is non-null,
do not create the bin/emacs link. (Bug#12011)
2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
Merge from gnulib, incorporating:
2012-08-20 extern-inline: support old GCC 'inline'
2012-08-20 Glenn Morris <rgm@gnu.org>
* configure.ac (AC_PROG_LN_S): Test for ln.
* Makefile.in (LN_S): New, set by configure.
(install-arch-dep): Use $LN_S.
2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
Merge from gnulib, incorporating:
2012-08-19 ignore-value, stat-time, timespec: omit AC_C_INLINE
2012-08-19 mktime, sys_select: avoid 'static inline'
2012-08-19 gnulib-tool: Fix indentation.
2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
* lib/sigprocmask.c, m4/signalblocking.m4: Remove.
These files have been unused since the 2012-06-22 patch that
introduced high-resolution time stamps.
2012-08-17 Jan Beich <jbeich@tormail.org> (tiny change)
* configure.ac (PTY_OPEN): Try posix_openpt on gnu-linux,

7
Makefile.in
View File

@ -246,6 +246,7 @@ INSTALL_INFO = @INSTALL_INFO@
# By default, we uphold the dignity of our programs.
INSTALL_STRIP =
MKDIR_P = @MKDIR_P@
LN_S = @LN_S@
# We use gzip to compress installed .el files.
GZIP_PROG = @GZIP_PROG@
@ -436,8 +437,10 @@ install-arch-dep: install-arch-indep install-doc
if test "${ns_self_contained}" = "no"; then \
${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} $(DESTDIR)${bindir}/$(EMACSFULL) || exit 1 ; \
chmod 1755 $(DESTDIR)${bindir}/$(EMACSFULL) ; \
rm -f $(DESTDIR)${bindir}/$(EMACS) ; \
ln $(DESTDIR)${bindir}/$(EMACSFULL) $(DESTDIR)${bindir}/$(EMACS) || true ; \
if test "x${NO_BIN_LINK}" = x; then \
rm -f $(DESTDIR)${bindir}/$(EMACS) ; \
cd $(DESTDIR)${bindir} && $(LN_S) $(EMACSFULL) $(EMACS); \
fi; \
else \
subdir=${ns_appresdir}/site-lisp; \
${write_subdir} || exit 1; \

3
admin/CPP-DEFINES
View File

@ -508,9 +508,6 @@ dup2
lib/signal.h:
signal
lib/sigprocmask.c:
signal
lib/stdio.h:
fdopen
fopen

3
autogen/Makefile.in
View File

@ -36,7 +36,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
@ -561,6 +561,7 @@ LIB_MATH = @LIB_MATH@
LIB_PTHREAD = @LIB_PTHREAD@
LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
LIB_STANDARD = @LIB_STANDARD@
LN_S = @LN_S@
LTLIBINTL = @LTLIBINTL@
LTLIBOBJS = @LTLIBOBJS@
M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@

101
autogen/configure vendored
View File

@ -1224,6 +1224,7 @@ HAVE_MAKEINFO
PAXCTL
GZIP_PROG
INSTALL_INFO
LN_S
GNULIB_WARN_CFLAGS
WARN_CFLAGS
WERROR_CFLAGS
@ -7758,6 +7759,17 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5
$as_echo_n "checking whether ln -s works... " >&6; }
LN_S=$as_ln_s
if test "$LN_S" = "ln -s"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5
$as_echo "no, using $LN_S" >&6; }
fi
# Extract the first word of "install-info", so it can be a program name with args.
set dummy install-info; ac_word=$2
@ -17317,9 +17329,7 @@ cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_GETENV $ac_have_decl
_ACEOF
:
@ -20051,7 +20061,7 @@ $as_echo "$gl_cv_func_dup2_works" >&6; }
fi
if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
@ -20063,7 +20073,7 @@ if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
gl_LIBOBJS="$gl_LIBOBJS dup2.$ac_objext"
fi
fi
@ -20487,7 +20497,7 @@ else
fi
if test $HAVE_GETLOADAVG = 0; then
if test $HAVE_GETLOADAVG = 0; then
@ -20615,7 +20625,7 @@ fi
done
fi
fi
@ -20632,7 +20642,7 @@ fi
if test $REPLACE_GETOPT = 1; then
if test $REPLACE_GETOPT = 1; then
@ -20656,8 +20666,8 @@ if test $REPLACE_GETOPT = 1; then
GNULIB_GL_UNISTD_H_GETOPT=1
fi
GNULIB_GL_UNISTD_H_GETOPT=1
fi
@ -20680,7 +20690,7 @@ $as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
fi
if test $REPLACE_GETOPT = 1; then
if test $REPLACE_GETOPT = 1; then
@ -20704,8 +20714,8 @@ if test $REPLACE_GETOPT = 1; then
GNULIB_GL_UNISTD_H_GETOPT=1
fi
GNULIB_GL_UNISTD_H_GETOPT=1
fi
@ -20865,7 +20875,7 @@ cat >>confdefs.h <<_ACEOF
_ACEOF
if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
@ -20901,7 +20911,7 @@ fi
done
fi
fi
@ -20918,7 +20928,6 @@ fi
if test $ac_cv_func_lstat = yes; then
case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
@ -20930,7 +20939,7 @@ fi
HAVE_LSTAT=0
fi
if test $REPLACE_LSTAT = 1; then
if test $REPLACE_LSTAT = 1; then
@ -20945,7 +20954,7 @@ if test $REPLACE_LSTAT = 1; then
:
fi
fi
@ -21194,7 +21203,7 @@ $as_echo "$gl_cv_func_working_mktime" >&6; }
REPLACE_MKTIME=0
fi
if test $REPLACE_MKTIME = 1; then
if test $REPLACE_MKTIME = 1; then
@ -21205,10 +21214,8 @@ if test $REPLACE_MKTIME = 1; then
gl_LIBOBJS="$gl_LIBOBJS mktime.$ac_objext"
fi
:
fi
@ -21263,7 +21270,7 @@ $as_echo "$gl_cv_sig_pselect" >&6; }
REPLACE_PSELECT=1
fi
if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
@ -21274,7 +21281,7 @@ if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
gl_LIBOBJS="$gl_LIBOBJS pselect.$ac_objext"
fi
fi
@ -21492,7 +21499,7 @@ $as_echo "#define PTHREAD_SIGMASK_UNBLOCK_BUG 1" >>confdefs.h
esac
fi
if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
@ -21510,7 +21517,7 @@ $as_echo "#define HAVE_PTHREAD_SIGMASK 1" >>confdefs.h
fi
fi
fi
@ -21613,7 +21620,7 @@ $as_echo "#define READLINK_TRAILING_SLASH_BUG 1" >>confdefs.h
esac
fi
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
@ -21627,7 +21634,7 @@ if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
:
fi
fi
@ -21741,7 +21748,7 @@ fi
ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "
ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "
/* <sys/types.h> is not needed according to POSIX, but the
<sys/socket.h> in i386-unknown-freebsd4.10 and
powerpc-apple-darwin5.5 required it. */
@ -21841,7 +21848,6 @@ $as_echo "#define ssize_t int" >>confdefs.h
ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.tv_nsec" "ac_cv_member_struct_stat_st_atim_tv_nsec" "#include <sys/types.h>
#include <sys/stat.h>
"
@ -21937,7 +21943,6 @@ fi
ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtimespec.tv_nsec" "ac_cv_member_struct_stat_st_birthtimespec_tv_nsec" "#include <sys/types.h>
#include <sys/stat.h>
"
@ -22648,7 +22653,7 @@ $as_echo "$gl_cv_func_strtoimax" >&6; }
HAVE_STRTOIMAX=0
fi
if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
@ -22673,7 +22678,7 @@ _ACEOF
fi
fi
@ -22693,7 +22698,7 @@ fi
HAVE_DECL_STRTOUMAX=0
fi
if test $ac_cv_func_strtoumax = no; then
if test $ac_cv_func_strtoumax = no; then
@ -22718,7 +22723,7 @@ _ACEOF
fi
fi
@ -22790,7 +22795,7 @@ $as_echo "$gl_cv_func_symlink_works" >&6; }
esac
fi
if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
@ -22801,7 +22806,7 @@ if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
gl_LIBOBJS="$gl_LIBOBJS symlink.$ac_objext"
fi
fi
@ -23192,7 +23197,7 @@ $as_echo "$gl_cv_time_r_posix" >&6; }
HAVE_LOCALTIME_R=0
fi
if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
@ -23206,7 +23211,7 @@ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
:
fi
fi
@ -23218,9 +23223,7 @@ fi
:
@ -23512,7 +23515,7 @@ $as_echo "#define REPLACE_FUNC_STAT_FILE 1" >>confdefs.h
;;
esac
if test $REPLACE_STAT = 1; then
if test $REPLACE_STAT = 1; then
@ -23527,7 +23530,7 @@ if test $REPLACE_STAT = 1; then
:
fi
fi
@ -23574,7 +23577,7 @@ done
fi
fi
if test $HAVE_STRTOLL = 0; then
if test $HAVE_STRTOLL = 0; then
@ -23588,7 +23591,7 @@ if test $HAVE_STRTOLL = 0; then
:
fi
fi
@ -23626,7 +23629,7 @@ done
fi
fi
if test $HAVE_STRTOULL = 0; then
if test $HAVE_STRTOULL = 0; then
@ -23640,7 +23643,7 @@ if test $HAVE_STRTOULL = 0; then
:
fi
fi

1
configure.ac
View File

@ -731,6 +731,7 @@ dnl AC_PROG_MKDIR_P
dnl if test "x$RANLIB" = x; then
dnl AC_PROG_RANLIB
dnl fi
AC_PROG_LN_S
AC_PATH_PROG(INSTALL_INFO, install-info, :,
$PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin)

6
doc/lispref/ChangeLog
View File

@ -1,3 +1,9 @@
2012-08-21 Martin Rudalics <rudalics@gmx.at>
* windows.texi (Window Point): Document recent changes in
window-point and set-window-point.
(Selecting Windows): Document recent change in select-window.
2012-08-06 Eli Zaretskii <eliz@gnu.org>
* functions.texi (Closures): Put the main index entry for

30
doc/lispref/windows.texi
View File

@ -1129,16 +1129,15 @@ are the opposite of what they are in those other functions.
@defun select-window window &optional norecord
This function makes @var{window} the selected window, as well as the
window selected within its frame (@pxref{Basic Windows}).
@var{window} must be a live window. Unless @var{window} already is the
selected window, its buffer becomes the current buffer (@pxref{Buffers
and Windows}). The return value is @var{window}.
window selected within its frame (@pxref{Basic Windows}). @var{window}
must be a live window. This function makes also @var{window}'s buffer
current (@pxref{Buffers and Windows}). The return value is
@var{window}.
By default, this function also moves @var{window}'s selected buffer to
the front of the buffer list (@pxref{The Buffer List}), and makes
@var{window} the most recently selected window. However, if the
optional argument @var{norecord} is non-@code{nil}, these additional
actions are omitted.
By default, this function also moves @var{window}'s buffer to the front
of the buffer list (@pxref{The Buffer List}), and makes @var{window} the
most recently selected window. However, if the optional argument
@var{norecord} is non-@code{nil}, these additional actions are omitted.
@end defun
@cindex most recently selected windows
@ -2276,19 +2275,18 @@ For a nonselected window, this is the value point would have (in that
window's buffer) if that window were selected. The default for
@var{window} is the selected window.
When @var{window} is the selected window and its buffer is also the
current buffer, the value returned is the same as point in that buffer.
Strictly speaking, it would be more correct to return the ``top-level''
value of point, outside of any @code{save-excursion} forms. But that
value is hard to find.
When @var{window} is the selected window, the value returned is the
value of point in that window's buffer. Strictly speaking, it would be
more correct to return the ``top-level'' value of point, outside of any
@code{save-excursion} forms. But that value is hard to find.
@end defun
@defun set-window-point window position
This function positions point in @var{window} at position
@var{position} in @var{window}'s buffer. It returns @var{position}.
If @var{window} is selected, and its buffer is current,
this simply does @code{goto-char}.
If @var{window} is selected, this simply does @code{goto-char} in
@var{window}'s buffer.
@end defun
@defvar window-point-insertion-type

9
etc/NEWS
View File

@ -38,6 +38,11 @@ may be useful.
** The configure option '--disable-maintainer-mode' has been removed,
as it was confusingly-named and rarely useful.
---
** You can use `NO_BIN_LINK=t make install' to prevent the installation
overwriting "emacs" in the installation bin/ directory with a link
to emacs-VERSION.
---
** Emacs uses libtinfo in preference to libncurses, if available.
@ -160,6 +165,10 @@ The PCL-CVS commands are still available via the keyboard.
* Editing Changes in Emacs 24.3
** New option `yank-handled-properties' allows processing of text
properties on yanked text, in more ways that are more general than
just removing them, as done by `yank-excluded-properties'.
** New option `delete-trailing-lines' specifies whether the M-x
delete-trailing-whitespace command should delete trailing lines at the
end of the buffer. It defaults to t.

5
lib-src/ChangeLog
View File

@ -1,3 +1,8 @@
2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
Rely on <config.h> + <unistd.h> to declare 'environ'.
* emacsclient.c (environ): Remove decl.
2012-08-17 Juanma Barranquero <lekktu@gmail.com>
* makefile.w32-in ($(BLD)/regex.$(O)): Update dependencies.

5
lib-src/emacsclient.c
View File

@ -1584,11 +1584,6 @@ main (int argc, char **argv)
/* Send over our environment and current directory. */
if (!current_frame)
{
#ifndef WINDOWSNT
/* This is defined in stdlib.h on MS-Windows. It's defined in
unistd.h on some POSIX hosts, but not all (Bug#10155). */
extern char **environ;
#endif
int i;
for (i = 0; environ[i]; i++)
{

2
lib/gnulib.mk
View File

@ -21,7 +21,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings
MOSTLYCLEANFILES += core *.stackdump

4
lib/mktime.c
View File

@ -142,7 +142,7 @@ verify (twos_complement_arithmetic,
verify (base_year_is_a_multiple_of_100, TM_YEAR_BASE % 100 == 0);
/* Return 1 if YEAR + TM_YEAR_BASE is a leap year. */
static inline int
static int
leapyear (long_int year)
{
/* Don't add YEAR to TM_YEAR_BASE, as that might overflow.
@ -196,7 +196,7 @@ isdst_differ (int a, int b)
The result may overflow. It is the caller's responsibility to
detect overflow. */
static inline time_t
static time_t
ydhms_diff (long_int year1, long_int yday1, int hour1, int min1, int sec1,
int year0, int yday0, int hour0, int min0, int sec0)
{

349
lib/sigprocmask.c
View File

@ -1,349 +0,0 @@
/* POSIX compatible signal blocking.
Copyright (C) 2006-2012 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2006.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
/* Specification. */
#include <signal.h>
#include <errno.h>
#include <stdint.h>
#include <stdlib.h>
#if HAVE_MSVC_INVALID_PARAMETER_HANDLER
# include "msvc-inval.h"
#endif
/* We assume that a platform without POSIX signal blocking functions
also does not have the POSIX sigaction() function, only the
signal() function. We also assume signal() has SysV semantics,
where any handler is uninstalled prior to being invoked. This is
true for native Windows platforms. */
/* We use raw signal(), but also provide a wrapper rpl_signal() so
that applications can query or change a blocked signal. */
#undef signal
/* Provide invalid signal numbers as fallbacks if the uncatchable
signals are not defined. */
#ifndef SIGKILL
# define SIGKILL (-1)
#endif
#ifndef SIGSTOP
# define SIGSTOP (-1)
#endif
/* On native Windows, as of 2008, the signal SIGABRT_COMPAT is an alias
for the signal SIGABRT. Only one signal handler is stored for both
SIGABRT and SIGABRT_COMPAT. SIGABRT_COMPAT is not a signal of its own. */
#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
# undef SIGABRT_COMPAT
# define SIGABRT_COMPAT 6
#endif
#ifdef SIGABRT_COMPAT
# define SIGABRT_COMPAT_MASK (1U << SIGABRT_COMPAT)
#else
# define SIGABRT_COMPAT_MASK 0
#endif
typedef void (*handler_t) (int);
#if HAVE_MSVC_INVALID_PARAMETER_HANDLER
static inline handler_t
signal_nothrow (int sig, handler_t handler)
{
handler_t result;
TRY_MSVC_INVAL
{
result = signal (sig, handler);
}
CATCH_MSVC_INVAL
{
result = SIG_ERR;
errno = EINVAL;
}
DONE_MSVC_INVAL;
return result;
}
# define signal signal_nothrow
#endif
/* Handling of gnulib defined signals. */
#if GNULIB_defined_SIGPIPE
static handler_t SIGPIPE_handler = SIG_DFL;
#endif
#if GNULIB_defined_SIGPIPE
static handler_t
ext_signal (int sig, handler_t handler)
{
switch (sig)
{
case SIGPIPE:
{
handler_t old_handler = SIGPIPE_handler;
SIGPIPE_handler = handler;
return old_handler;
}
default: /* System defined signal */
return signal (sig, handler);
}
}
# undef signal
# define signal ext_signal
#endif
int
sigismember (const sigset_t *set, int sig)
{
if (sig >= 0 && sig < NSIG)
{
#ifdef SIGABRT_COMPAT
if (sig == SIGABRT_COMPAT)
sig = SIGABRT;
#endif
return (*set >> sig) & 1;
}
else
return 0;
}
int
sigemptyset (sigset_t *set)
{
*set = 0;
return 0;
}
int
sigaddset (sigset_t *set, int sig)
{
if (sig >= 0 && sig < NSIG)
{
#ifdef SIGABRT_COMPAT
if (sig == SIGABRT_COMPAT)
sig = SIGABRT;
#endif
*set |= 1U << sig;
return 0;
}
else
{
errno = EINVAL;
return -1;
}
}
int
sigdelset (sigset_t *set, int sig)
{
if (sig >= 0 && sig < NSIG)
{
#ifdef SIGABRT_COMPAT
if (sig == SIGABRT_COMPAT)
sig = SIGABRT;
#endif
*set &= ~(1U << sig);
return 0;
}
else
{
errno = EINVAL;
return -1;
}
}
int
sigfillset (sigset_t *set)
{
*set = ((2U << (NSIG - 1)) - 1) & ~ SIGABRT_COMPAT_MASK;
return 0;
}
/* Set of currently blocked signals. */
static volatile sigset_t blocked_set /* = 0 */;
/* Set of currently blocked and pending signals. */
static volatile sig_atomic_t pending_array[NSIG] /* = { 0 } */;
/* Signal handler that is installed for blocked signals. */
static void
blocked_handler (int sig)
{
/* Reinstall the handler, in case the signal occurs multiple times
while blocked. There is an inherent race where an asynchronous
signal in between when the kernel uninstalled the handler and
when we reinstall it will trigger the default handler; oh
well. */
signal (sig, blocked_handler);
if (sig >= 0 && sig < NSIG)
pending_array[sig] = 1;
}
int
sigpending (sigset_t *set)
{
sigset_t pending = 0;
int sig;
for (sig = 0; sig < NSIG; sig++)
if (pending_array[sig])
pending |= 1U << sig;
*set = pending;
return 0;
}
/* The previous signal handlers.
Only the array elements corresponding to blocked signals are relevant. */
static volatile handler_t old_handlers[NSIG];
int
sigprocmask (int operation, const sigset_t *set, sigset_t *old_set)
{
if (old_set != NULL)
*old_set = blocked_set;
if (set != NULL)
{
sigset_t new_blocked_set;
sigset_t to_unblock;
sigset_t to_block;
switch (operation)
{
case SIG_BLOCK:
new_blocked_set = blocked_set | *set;
break;
case SIG_SETMASK:
new_blocked_set = *set;
break;
case SIG_UNBLOCK:
new_blocked_set = blocked_set & ~*set;
break;
default:
errno = EINVAL;
return -1;
}
to_unblock = blocked_set & ~new_blocked_set;
to_block = new_blocked_set & ~blocked_set;
if (to_block != 0)
{
int sig;
for (sig = 0; sig < NSIG; sig++)
if ((to_block >> sig) & 1)
{
pending_array[sig] = 0;
if ((old_handlers[sig] = signal (sig, blocked_handler)) != SIG_ERR)
blocked_set |= 1U << sig;
}
}
if (to_unblock != 0)
{
sig_atomic_t received[NSIG];
int sig;
for (sig = 0; sig < NSIG; sig++)
if ((to_unblock >> sig) & 1)
{
if (signal (sig, old_handlers[sig]) != blocked_handler)
/* The application changed a signal handler while the signal
was blocked, bypassing our rpl_signal replacement.
We don't support this. */
abort ();
received[sig] = pending_array[sig];
blocked_set &= ~(1U << sig);
pending_array[sig] = 0;
}
else
received[sig] = 0;
for (sig = 0; sig < NSIG; sig++)
if (received[sig])
raise (sig);
}
}
return 0;
}
/* Install the handler FUNC for signal SIG, and return the previous
handler. */
handler_t
rpl_signal (int sig, handler_t handler)
{
/* We must provide a wrapper, so that a user can query what handler
they installed even if that signal is currently blocked. */
if (sig >= 0 && sig < NSIG && sig != SIGKILL && sig != SIGSTOP
&& handler != SIG_ERR)
{
#ifdef SIGABRT_COMPAT
if (sig == SIGABRT_COMPAT)
sig = SIGABRT;
#endif
if (blocked_set & (1U << sig))
{
/* POSIX states that sigprocmask and signal are both
async-signal-safe. This is not true of our
implementation - there is a slight data race where an
asynchronous interrupt on signal A can occur after we
install blocked_handler but before we have updated
old_handlers for signal B, such that handler A can see
stale information if it calls signal(B). Oh well -
signal handlers really shouldn't try to manipulate the
installed handlers of unrelated signals. */
handler_t result = old_handlers[sig];
old_handlers[sig] = handler;
return result;
}
else
return signal (sig, handler);
}
else
{
errno = EINVAL;
return SIG_ERR;
}
}
#if GNULIB_defined_SIGPIPE
/* Raise the signal SIGPIPE. */
int
_gl_raise_SIGPIPE (void)
{
if (blocked_set & (1U << SIGPIPE))
pending_array[SIGPIPE] = 1;
else
{
handler_t handler = SIGPIPE_handler;
if (handler == SIG_DFL)
exit (128 + SIGPIPE);
else if (handler != SIG_IGN)
(*handler) (SIGPIPE);
}
return 0;
}
#endif

2
lib/sys_select.in.h
View File

@ -130,7 +130,7 @@
/* Re-define FD_ISSET to avoid a WSA call while we are not using
network sockets. */
static inline int
static int
rpl_fd_isset (SOCKET fd, fd_set * set)
{
u_int i;

187
lisp/ChangeLog
View File

@ -1,3 +1,190 @@
2012-08-22 Martin Rudalics <rudalics@gmx.at>
* window.el (walk-window-tree, window-with-parameter): New
optional argument MINIBUF to control whether these functions
should run on the minibuffer window.
(window-at-side-list): Don't operate on minibuffer window.
(window-in-direction): Simplify and rewrite doc-string.
(window--size-ignore): Rename to window--size-ignore-p. Update
callers.
2012-08-22 Christopher Schmidt <christopher@ch.ristopher.com>
* help-fns.el (help-fns--key-bindings):
Abbreviate non-symbol remap targets. (Bug#12174)
2012-08-22 Martin Rudalics <rudalics@gmx.at>
* dired.el (dired-mark-remembered): Don't clobber point.
(Bug#11795)
2012-08-22 Glenn Morris <rgm@gnu.org>
* progmodes/bug-reference.el (bug-reference): New custom group.
(bug-reference-bug-regexp): Make it a defcustom.
2012-08-22 Daiki Ueno <ueno@unixuser.org>
* progmodes/js.el (js-indent-level, js-expr-indent-offset)
(js-paren-indent-offset, js-square-indent-offset)
(js-curly-indent-offset): Add :safe (Bug#12257).
2012-08-22 Edward O'Connor <hober0@gmail.com>
* json.el (json-key-format): Add error properties.
(json-encode-key): New function.
(json-encode-hash-table, json-encode-alist, json-encode-plist):
Use json-encode-key.
2012-08-22 Glenn Morris <rgm@gnu.org>
* calendar/cal-tex.el (cal-tex-longday): New function, replacing...
(cal-tex-leftday, cal-tex-rightday): Remove functions.
(cal-tex-weekly-common, cal-tex-cursor-filofax-2week):
Update for above change.
2012-08-21 Andreas Schwab <schwab@linux-m68k.org>
* cus-face.el (custom-face-attributes): Fix customize type for the
:underline attribute. (Bug#11805)
2012-08-21 Martin Rudalics <rudalics@gmx.at>
* window.el (window-point-1, set-window-point-1): Remove.
(window-in-direction, record-window-buffer)
(set-window-buffer-start-and-point, split-window-below)
(window--state-get-1, display-buffer-record-window): Replace
calls to window-point-1 and set-window-point-1 by calls to
window-point and set-window-point respectively.
2012-08-21 Glenn Morris <rgm@gnu.org>
* calendar/cal-tex.el (cal-tex-weekly-common): New function.
(cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-week):
Use it.
* calendar/cal-tex.el (cal-tex-rightday): Add optional funcname arg.
(cal-tex-shortday): New function.
(cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-week)
(cal-tex-cursor-filofax-daily): Use the above.
* calendar/cal-tex.el (cal-tex-leftday, cal-tex-rightday):
New functions.
(cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-2week)
(cal-tex-cursor-filofax-week): Use them.
* calendar/cal-tex.el (cal-tex-lefthead, cal-tex-righthead):
New constants.
(cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-2week)
(cal-tex-cursor-filofax-week, cal-tex-cursor-filofax-daily): Use them.
* calendar/cal-tex.el (cal-tex-preamble): Generate new buffers.
(cal-tex-end-document): Don't rely on buffer name.
* calendar/cal-tex.el (cal-tex-cursor-filofax-year):
Use cal-tex-vspace.
(cal-tex-vspace, cal-tex-hspace, cal-tex-em, cal-tex-bf)
(cal-tex-Huge-bf, cal-tex-large-bf): Use cal-tex-cmd.
(cal-tex-scriptsize, cal-tex-huge, cal-tex-Huge, cal-tex-large):
Use cal-tex-arg.
* calendar/cal-tex.el (cal-tex-cursor-filofax-year)
(cal-tex-cursor-week, cal-tex-cursor-week2)
(cal-tex-cursor-week-iso, cal-tex-cursor-week-at-a-glance)
(cal-tex-cursor-filofax-2week, cal-tex-cursor-filofax-week)
(cal-tex-cursor-filofax-daily, cal-tex-cursor-day)
(cal-tex-insert-preamble, cal-tex-b-document)
(cal-tex-e-document, cal-tex-b-center, cal-tex-e-center):
Improve cal-tex-cmd usage.
* calendar/cal-tex.el (cal-tex-filofax-paper): New function.
(cal-tex-cursor-filofax-year, cal-tex-cursor-filofax-2week)
(cal-tex-cursor-filofax-week, cal-tex-cursor-filofax-daily): Use it.
(cal-tex-weekly-paper): New function.
(cal-tex-cursor-week, cal-tex-cursor-week2)
(cal-tex-cursor-week-iso, cal-tex-cursor-week-monday)
(cal-tex-cursor-day): Use it.
* calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance)
(cal-tex-cursor-filofax-week): Remove leading blank page.
* calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance):
Add autoload cookie. For now at least, don't use color, since
no other cal-tex function does.
* calendar/cal-tex.el (cal-tex-cursor-week-iso)
(cal-tex-cursor-filofax-2week, cal-tex-cursor-filofax-week)
(cal-tex-cursor-filofax-daily): Correct start date for diary entries.
2012-08-21 Juri Linkov <juri@jurta.org>
* info.el (Info-file-attributes): New variable.
(info-insert-file-contents): Add file attributes to
`Info-file-attributes'. Clear the caches `Info-index-nodes' and
`Info-toc-nodes' when previous modtime of the Info file is less
than new modtime.
(Info-toc-nodes, Info-index-nodes): Move definitions up to the top
of info.el. (Bug#12230)
2012-08-20 Glenn Morris <rgm@gnu.org>
* calendar/diary-lib.el (diary-include-files, diary-sexp-entry):
* calendar/holidays.el (calendar-holiday-list):
Report errors with display-warning rather than beep'n'sleep.
2012-08-20 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-accept-process-output): Accept only output
from PROC. Otherwise, process filters and sentinels might be
confused. (Bug#12145)
2012-08-20 Chong Yidong <cyd@gnu.org>
* descr-text.el (describe-text-properties-1): Use overlays-in to
report on empty overlays (Bug#3322).
2012-08-20 Glenn Morris <rgm@gnu.org>
* mail/rmailout.el (rmail-output-read-file-name):
Trap and report errors in rmail-output-file-alist elements.
* font-lock.el (font-lock-add-keywords): Doc fix (quote face names
since most non-font-lock faces are not also variables).
2012-08-20 Edward Reingold <reingold@iit.edu>
* calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance):
New function. (Bug12160)
2012-08-19 Glenn Morris <rgm@gnu.org>
* mail/rmailout.el (rmail-output-read-file-name):
Fix previous change (when the alist is nil or does not match).
2012-08-19 Chong Yidong <cyd@gnu.org>
* xml.el (xml-escape-string): Don't refer to xml-entity-alist
(Bug#12228).
2012-08-18 Chong Yidong <cyd@gnu.org>
* simple.el (yank-handled-properties): New defcustom.
(yank-excluded-properties): Add font-lock-face and category.
(yank): Doc fix.
* subr.el (remove-yank-excluded-properties): Obey
yank-handled-properties. The special handling of font-lock-face
and category is now done this way, instead of being hard-coded.
(insert-for-yank-1): Remove font-lock-face handling.
(yank-handle-font-lock-face-property)
(yank-handle-category-property): New function.
2012-08-17 Glenn Morris <rgm@gnu.org>
* mail/rmailout.el (rmail-output-read-file-name):
Check rmail-output-file-alist against the full message body
in the correct rmail buffer. (Bug#12214)
2012-08-17 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-sh.el (tramp-sh-handle-start-file-process): Eliminate

533
lisp/calendar/cal-tex.el
View File

@ -237,6 +237,14 @@ The names are taken from `calendar-day-name-array'.")
"LaTeX code to insert one box with date info in calendar.
This definition is the heart of the calendar!")
(defconst cal-tex-lefthead
"\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}\n"
"LaTeX code for left header.")
(defconst cal-tex-righthead
"\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}\n"
"LaTeX code for right header.")
(autoload 'holiday-in-range "holidays")
(define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range "24.3")
@ -253,14 +261,14 @@ This definition is the heart of the calendar!")
"Insert the LaTeX calendar preamble into `cal-tex-buffer'.
Preamble includes initial definitions for various LaTeX commands.
Optional string ARGS are included as options for the article document class."
;; FIXME use generate-new-buffer, and adjust cal-tex-end-document.
(set-buffer (get-buffer-create cal-tex-buffer))
(set-buffer (generate-new-buffer cal-tex-buffer))
(insert (format "\\documentclass%s{article}\n"
(if (stringp args)
(format "[%s]" args)
"")))
(if (stringp cal-tex-preamble-extra)
(insert cal-tex-preamble-extra "\n"))
;; FIXME boxwidth and boxheight unused?
(insert "\\hbadness 20000
\\hfuzz=1000pt
\\vbadness 20000
@ -344,6 +352,54 @@ landscape mode with three rows of four months each."
(run-hooks 'cal-tex-year-hook))
(run-hooks 'cal-tex-hook))
(defun cal-tex-filofax-paper (&optional year)
"Insert some page size settings for filofax layouts."
(insert "\\textwidth 3.25in
\\textheight 6.5in
\\headheight -0.875in
\\topmargin 0pt
")
(insert
;; Why is this one subtly different? Who knows...
(if year "\\oddsidemargin 1.675in
\\evensidemargin 1.675in
"
"\\oddsidemargin 1.75in
\\evensidemargin 1.5in
\\headsep 0.125in
\\footskip 0.125in
")))
(defun cal-tex-longday (funcname height)
"Insert LaTeX code for a long day function."
(insert "\\long\\def\\" funcname "#1#2#3#4#5{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox to " height "{%
\\vspace*{2pt}%
\\hbox to \\textwidth{"
(if (string-equal funcname "leftday")
"\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%\n"
"\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%\n")
" \\hbox to \\textwidth{\\vbox {\\"
(if (string-equal funcname "leftday") "noindent" "raggedleft")
" \\footnotesize \\em #4}}%
\\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n"))
(defun cal-tex-shortday (funcname)
"Insert LaTeX code for a short day function."
(insert "\\long\\def\\" funcname "#1#2#3{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox {%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
\\hbox to \\textwidth{\\vbox {\\"
(if (string-equal funcname "rightday") "raggedleft" "noindent")
" \\em #2}}%
\\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}\n"))
;;;###cal-autoload
(defun cal-tex-cursor-filofax-year (&optional n event)
"Make a Filofax one page yearly calendar of year indicated by cursor.
@ -354,16 +410,11 @@ Optional EVENT indicates a buffer position to use instead of point."
(or n (setq n 1))
(let ((year (calendar-extract-year (calendar-cursor-to-date t event))))
(cal-tex-preamble "twoside")
(cal-tex-cmd "\\textwidth 3.25in")
(cal-tex-cmd "\\textheight 6.5in")
(cal-tex-cmd "\\oddsidemargin 1.675in")
(cal-tex-cmd "\\evensidemargin 1.675in")
(cal-tex-cmd "\\topmargin 0pt")
(cal-tex-cmd "\\headheight -0.875in")
(cal-tex-filofax-paper 'year)
(cal-tex-cmd "\\fboxsep 0.5mm")
(cal-tex-cmd "\\pagestyle{empty}")
(cal-tex-cmd "\\pagestyle" "empty")
(cal-tex-b-document)
(cal-tex-cmd "\\vspace*{0.25in}")
(cal-tex-vspace "0.25in")
(dotimes (j n)
(insert (format "\\hfil \\textbf{\\Large %s} \\hfil\\\\\n" year))
(cal-tex-b-center)
@ -391,7 +442,7 @@ Optional EVENT indicates a buffer position to use instead of point."
(if (= j (1- n))
(cal-tex-end-document)
(cal-tex-newpage)
(cal-tex-cmd "\\vspace*{0.25in}"))
(cal-tex-vspace "0.25in"))
(run-hooks 'cal-tex-year-hook))
(run-hooks 'cal-tex-hook)))
@ -653,6 +704,15 @@ this is only an upper bound."
{\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n"
"One hour and a line on the right.")
(defun cal-tex-weekly-paper (&optional nomargins)
"Insert some page size settings for weekly layouts."
(insert "\\textwidth 6.5in
\\textheight 10.5in
")
(or nomargins (insert "\\oddsidemargin 0in
\\evensidemargin 0in
")))
;; TODO cal-tex-diary-support.
;; TODO respect cal-tex-daily-start,end (see cal-tex-week-hours).
;;;###cal-autoload
@ -677,13 +737,10 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm."
(holidays (if cal-tex-holidays
(holiday-in-range d1 d2))))
(cal-tex-preamble "11pt")
(cal-tex-cmd "\\textwidth 6.5in")
(cal-tex-cmd "\\textheight 10.5in")
(cal-tex-cmd "\\oddsidemargin 0in")
(cal-tex-cmd "\\evensidemargin 0in")
(cal-tex-weekly-paper)
(insert cal-tex-LaTeX-hourbox)
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
(cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
@ -732,13 +789,10 @@ Optional EVENT indicates a buffer position to use instead of point."
(holidays (if cal-tex-holidays
(holiday-in-range d1 d2))))
(cal-tex-preamble "12pt")
(cal-tex-cmd "\\textwidth 6.5in")
(cal-tex-cmd "\\textheight 10.5in")
(cal-tex-cmd "\\oddsidemargin 0in")
(cal-tex-cmd "\\evensidemargin 0in")
(cal-tex-weekly-paper)
(insert cal-tex-LaTeX-hourbox)
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
(cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
@ -816,18 +870,12 @@ position to use instead of point."
(holidays (if cal-tex-holidays
(holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
(cal-tex-list-diary-entries
;; FIXME d1?
(calendar-absolute-from-gregorian (list month 1 year))
d2)))
(cal-tex-list-diary-entries d1 d2)))
s)
(cal-tex-preamble "11pt")
(cal-tex-cmd "\\textwidth 6.5in")
(cal-tex-cmd "\\textheight 10.5in")
(cal-tex-cmd "\\oddsidemargin 0in")
(cal-tex-cmd "\\evensidemargin 0in")
(cal-tex-weekly-paper)
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
(cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
@ -944,10 +992,7 @@ to use instead of point."
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event))))))
(cal-tex-preamble "11pt")
(cal-tex-cmd "\\textwidth 6.5in")
(cal-tex-cmd "\\textheight 10.5in")
(cal-tex-cmd "\\oddsidemargin 0in")
(cal-tex-cmd "\\evensidemargin 0in")
(cal-tex-weekly-paper)
(cal-tex-b-document)
(dotimes (i n)
(cal-tex-vspace "-1cm")
@ -1009,6 +1054,160 @@ shown are hard-coded to 8-12, 13-17."
(cal-tex-e-framebox)
(cal-tex-hspace "1cm")))
(defun cal-tex-weekly-common (n event &optional filofax)
"Common code for weekly calendars."
(or n (setq n 1))
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
(holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
(cal-tex-list-diary-entries d1 d2))))
(if filofax
(progn
(cal-tex-preamble "twoside")
(cal-tex-filofax-paper)
(insert cal-tex-righthead)
(cal-tex-longday "rightday" "1.85in")
(cal-tex-longday "weekend" "0.8in")
(insert cal-tex-lefthead)
(cal-tex-longday "leftday" "1.85in"))
(cal-tex-preamble "twoside,12pt")
(insert "\\textwidth 7in
\\textheight 10.5in
\\oddsidemargin 0in
\\evensidemargin 0in
\\topmargin 0pt
\\headheight -0.875in
\\headsep 0.125in
\\footskip .125in
")
(insert cal-tex-righthead)
(cal-tex-longday "rightday" "2.75in")
(cal-tex-longday "weekend" "1.8in")
(insert cal-tex-lefthead)
(cal-tex-longday "leftday" "2.75in"))
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(insert "\\lefthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 2)))
(if (= (calendar-extract-month date)
(calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(if (= (calendar-extract-year date)
(calendar-extract-year d))
(format "%s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year date))
(format "%s %s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date)
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year d))))))
(insert "%\n")
(dotimes (_jdummy 3)
(insert "\\leftday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
(unless filofax
(cal-tex-nl)
(insert (cal-tex-mini-calendar
(calendar-extract-month (cal-tex-previous-month date))
(calendar-extract-year (cal-tex-previous-month date))
"lastmonth" "1.1in" "1in"))
(insert (cal-tex-mini-calendar
(calendar-extract-month date)
(calendar-extract-year date)
"thismonth" "1.1in" "1in"))
(insert (cal-tex-mini-calendar
(calendar-extract-month (cal-tex-next-month date))
(calendar-extract-year (cal-tex-next-month date))
"nextmonth" "1.1in" "1in"))
(insert "\\hbox to \\textwidth{")
(cal-tex-hfill)
(insert "\\lastmonth")
(cal-tex-hfill)
(insert "\\thismonth")
(cal-tex-hfill)
(insert "\\nextmonth")
(cal-tex-hfill)
(insert "}"))
(cal-tex-newpage)
(insert "\\righthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 3)))
(if (= (calendar-extract-month date)
(calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(if (= (calendar-extract-year date)
(calendar-extract-year d))
(format "%s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year date))
(format "%s %s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date)
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year d))))))
(insert "%\n")
(dotimes (_jdummy 2)
(insert "\\rightday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(dotimes (_jdummy 2)
(insert "\\weekend")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
(cal-tex-newpage)))
(cal-tex-end-document)
(run-hooks 'cal-tex-hook)))
;;;###cal-autoload
(defun cal-tex-cursor-week-at-a-glance (&optional n event)
"One-week-at-a-glance full page calendar for week indicated by cursor.
Optional prefix argument N specifies number of weeks (default 1),
starting on Mondays. The calendar shows holiday and diary entries
if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
It does not show hours of the day. Optional EVENT indicates a buffer
position to use instead of point."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(cal-tex-weekly-common n event))
;;;###cal-autoload
(defun cal-tex-cursor-filofax-2week (&optional n event)
"Two-weeks-at-a-glance Filofax style calendar for week cursor is in.
@ -1032,40 +1231,15 @@ Optional EVENT indicates a buffer position to use instead of point."
(holidays (if cal-tex-holidays
(holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
(cal-tex-list-diary-entries
;; FIXME d1?
(calendar-absolute-from-gregorian (list month 1 year))
d2))))
(cal-tex-list-diary-entries d1 d2))))
(cal-tex-preamble "twoside")
(cal-tex-cmd "\\textwidth 3.25in")
(cal-tex-cmd "\\textheight 6.5in")
(cal-tex-cmd "\\oddsidemargin 1.75in")
(cal-tex-cmd "\\evensidemargin 1.5in")
(cal-tex-cmd "\\topmargin 0pt")
(cal-tex-cmd "\\headheight -0.875in")
(cal-tex-cmd "\\headsep 0.125in")
(cal-tex-cmd "\\footskip .125in")
(insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
\\long\\def\\rightday#1#2#3#4#5{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox to 0.7in{%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
\\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
\\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
\\long\\def\\leftday#1#2#3#4#5{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox to 0.7in{%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
\\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
\\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
")
(cal-tex-filofax-paper)
(insert cal-tex-righthead)
(cal-tex-longday "rightday" "0.7in")
(insert cal-tex-lefthead)
(cal-tex-longday "leftday" "0.7in")
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
(cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(if (zerop (mod i 2))
(insert "\\righthead")
@ -1115,138 +1289,7 @@ if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
Optional EVENT indicates a buffer position to use instead of point."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
(holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
(cal-tex-list-diary-entries
;; FIXME d1?
(calendar-absolute-from-gregorian (list month 1 year))
d2))))
(cal-tex-preamble "twoside")
(cal-tex-cmd "\\textwidth 3.25in")
(cal-tex-cmd "\\textheight 6.5in")
(cal-tex-cmd "\\oddsidemargin 1.75in")
(cal-tex-cmd "\\evensidemargin 1.5in")
(cal-tex-cmd "\\topmargin 0pt")
(cal-tex-cmd "\\headheight -0.875in")
(cal-tex-cmd "\\headsep 0.125in")
(cal-tex-cmd "\\footskip .125in")
(insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
\\long\\def\\rightday#1#2#3#4#5{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox to 1.85in{%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
\\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
\\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
\\long\\def\\weekend#1#2#3#4#5{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox to .8in{%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
\\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
\\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
\\long\\def\\leftday#1#2#3#4#5{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox to 1.85in{%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
\\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
\\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
")
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}\\ ")
(cal-tex-newpage)
(dotimes (i n)
(insert "\\lefthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 2)))
(if (= (calendar-extract-month date)
(calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(if (= (calendar-extract-year date)
(calendar-extract-year d))
(format "%s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year date))
(format "%s %s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date)
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year d))))))
(insert "%\n")
(dotimes (_jdummy 3)
(insert "\\leftday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
(cal-tex-newpage)
(insert "\\righthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 3)))
(if (= (calendar-extract-month date)
(calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(if (= (calendar-extract-year date)
(calendar-extract-year d))
(format "%s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year date))
(format "%s %s---%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date)
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year d))))))
(insert "%\n")
(dotimes (_jdummy 2)
(insert "\\rightday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(dotimes (_jdummy 2)
(insert "\\weekend")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
(cal-tex-newpage)))
(cal-tex-end-document)
(run-hooks 'cal-tex-hook)))
(cal-tex-weekly-common n event t))
;;;###cal-autoload
(defun cal-tex-cursor-filofax-daily (&optional n event)
@ -1272,52 +1315,21 @@ Optional EVENT indicates a buffer position to use instead of point."
(holidays (if cal-tex-holidays
(holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
(cal-tex-list-diary-entries
;; FIXME d1?
(calendar-absolute-from-gregorian (list month 1 year))
d2))))
(cal-tex-list-diary-entries d1 d2))))
(cal-tex-preamble "twoside")
(cal-tex-cmd "\\textwidth 3.25in")
(cal-tex-cmd "\\textheight 6.5in")
(cal-tex-cmd "\\oddsidemargin 1.75in")
(cal-tex-cmd "\\evensidemargin 1.5in")
(cal-tex-cmd "\\topmargin 0pt")
(cal-tex-cmd "\\headheight -0.875in")
(cal-tex-cmd "\\headsep 0.125in")
(cal-tex-cmd "\\footskip .125in")
(insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
\\long\\def\\rightday#1#2#3{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox {%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
\\hbox to \\textwidth{\\vbox {\\raggedleft \\em #2}}%
\\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
\\long\\def\\weekend#1#2#3{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox {%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
\\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
\\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
\\long\\def\\leftday#1#2#3{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
\\vbox {%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
\\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
\\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
\\newbox\\LineBox
(cal-tex-filofax-paper)
(insert cal-tex-righthead)
(cal-tex-shortday "rightday")
(cal-tex-shortday "weekend")
(insert cal-tex-lefthead)
(cal-tex-shortday "leftday")
(insert "\\newbox\\LineBox
\\setbox\\LineBox=\\hbox to\\textwidth{%
\\vrule height.2in width0pt\\leaders\\hrule\\hfill}
\\def\\linesfill{\\par\\leaders\\copy\\LineBox\\vfill}
")
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
(cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(dotimes (j 4)
(let ((even (zerop (% j 2))))
@ -1377,10 +1389,9 @@ a buffer position to use instead of point."
(let ((date (calendar-absolute-from-gregorian
(calendar-cursor-to-date t event))))
(cal-tex-preamble "12pt")
(cal-tex-cmd "\\textwidth 6.5in")
(cal-tex-cmd "\\textheight 10.5in")
(cal-tex-weekly-paper 'nomargins)
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
(cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.7in")
(cal-tex-daily-page (calendar-gregorian-from-absolute date))
@ -1574,7 +1585,7 @@ informative header, and run HOOK."
;; FIXME latin1 might not always be right.
(insert "\\usepackage[latin1]{inputenc}\n"))))
(latex-mode)
(pop-to-buffer cal-tex-buffer)
(pop-to-buffer (current-buffer))
(goto-char (point-min))
;; FIXME auctex equivalents?
(cal-tex-comment
@ -1599,16 +1610,16 @@ non-nil, means add to end of buffer without erasing current contents."
(if (not landscape)
(progn
(cal-tex-cmd "\\oddsidemargin -1.75cm")
(cal-tex-cmd "\\def\\holidaymult{.06}"))
(cal-tex-cmd "\\special{landscape}")
(cal-tex-cmd "\\def\\holidaymult" ".06"))
(cal-tex-cmd "\\special" "landscape")
(cal-tex-cmd "\\textwidth 9.5in")
(cal-tex-cmd "\\textheight 7in")
(cal-tex-comment)
(cal-tex-cmd "\\def\\holidaymult{.08}"))
(cal-tex-cmd "\\def\\holidaymult" ".08"))
(cal-tex-cmd cal-tex-caldate)
(cal-tex-cmd cal-tex-myday)
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}"))
(cal-tex-cmd "\\pagestyle" "empty"))
(cal-tex-cmd "\\setlength{\\cellwidth}" width)
(insert (format "\\setlength{\\cellwidth}{%f\\cellwidth}\n"
(/ 1.1 (length cal-tex-which-days))))
@ -1671,13 +1682,11 @@ non-nil, means add to end of buffer without erasing current contents."
(defun cal-tex-vspace (space)
"Insert vspace command to move SPACE vertically."
(insert "\\vspace*{" space "}")
(cal-tex-comment))
(cal-tex-cmd "\\vspace*" space))
(defun cal-tex-hspace (space)
"Insert hspace command to move SPACE horizontally."
(insert "\\hspace*{" space "}")
(cal-tex-comment))
(cal-tex-cmd "\\hspace*" space))
(defun cal-tex-comment (&optional comment)
"Insert `% ', followed by optional string COMMENT, followed by newline.
@ -1716,20 +1725,20 @@ Add trailing COMMENT if present."
(defun cal-tex-b-document ()
"Insert beginning of document."
(cal-tex-cmd "\\begin{document}"))
(cal-tex-cmd "\\begin" "document"))
(defun cal-tex-e-document ()
"Insert end of document."
(cal-tex-cmd "\\end{document}"))
(cal-tex-cmd "\\end" "document"))
(defun cal-tex-b-center ()
"Insert beginning of centered block."
(cal-tex-cmd "\\begin{center}"))
(cal-tex-cmd "\\begin" "center"))
(defun cal-tex-e-center ()
"Insert end of centered block."
(cal-tex-comment)
(cal-tex-cmd "\\end{center}"))
(cal-tex-cmd "\\end" "center"))
;;;
@ -1784,35 +1793,35 @@ Add trailing COMMENT if present."
(defun cal-tex-em (string)
"Insert STRING in italic font."
(insert "\\textit{" string "}"))
(cal-tex-cmd "\\textit" string))
(defun cal-tex-bf (string)
"Insert STRING in bf font."
(insert "\\textbf{ " string "}"))
(cal-tex-cmd "\\textbf" string))
(defun cal-tex-scriptsize (string)
"Insert STRING in scriptsize font."
(insert "{\\scriptsize " string "}"))
(cal-tex-arg (concat "\\scriptsize " string)))
(defun cal-tex-huge (string)
"Insert STRING in huge font."
(insert "{\\huge " string "}"))
(cal-tex-arg (concat "\\huge " string)))
(defun cal-tex-Huge (string)
"Insert STRING in Huge font."
(insert "{\\Huge " string "}"))
(cal-tex-arg (concat "\\Huge " string)))
(defun cal-tex-Huge-bf (string)
"Insert STRING in Huge bf font."
(insert "\\textbf{\\Huge " string "}"))
(cal-tex-cmd "\\textbf" (concat "\\Huge " string)))
(defun cal-tex-large (string)
"Insert STRING in large font."
(insert "{\\large " string "}"))
(cal-tex-arg (concat "\\large " string)))
(defun cal-tex-large-bf (string)
"Insert STRING in large bf font."
(insert "\\textbf{\\large " string "}"))
(cal-tex-cmd "\\textbf" (concat "\\large " string)))
(provide 'cal-tex)

31
lisp/calendar/diary-lib.el
View File

@ -951,12 +951,12 @@ This is recursive; that is, included files may include other files."
(setq diary-entries-list
(append diary-entries-list
(diary-list-entries original-date number t)))))
(beep)
(message "Can't read included diary file %s" diary-file)
(sleep-for 2))
(beep)
(message "Can't find included diary file %s" diary-file)
(sleep-for 2))))
(display-warning
:error
(format "Can't read included diary file %s\n" diary-file)))
(display-warning
:error
(format "Can't find included diary file %s\n" diary-file)))))
(goto-char (point-min)))
(defun diary-include-other-diary-files ()
@ -1456,14 +1456,17 @@ marks. This is intended to deal with deleted diary entries."
(let ((result (if calendar-debug-sexp
(let ((debug-on-error t))
(eval (car (read-from-string sexp))))
(condition-case nil
(eval (car (read-from-string sexp)))
(error
(beep)
(message "Bad sexp at line %d in %s: %s"
(count-lines (point-min) (point))
diary-file sexp)
(sleep-for 2))))))
(let (err)
(condition-case err
(eval (car (read-from-string sexp)))
(error
(display-warning
:error
(format "Bad diary sexp at line %d in %s:\n%s\n\
Error: %s\n"
(count-lines (point-min) (point))
diary-file sexp err))
nil))))))
(cond ((stringp result) result)
((and (consp result)
(stringp (cdr result))) result)

13
lisp/calendar/holidays.el
View File

@ -458,17 +458,20 @@ with descriptive strings such as
(defun calendar-holiday-list ()
"Form the list of holidays that occur on dates in the calendar window.
The holidays are those in the list `calendar-holidays'."
(let (res h)
(let (res h err)
(sort
(dolist (p calendar-holidays res)
(if (setq h (if calendar-debug-sexp
(let ((debug-on-error t))
(eval p))
(condition-case nil
(condition-case err
(eval p)
(error (beep)
(message "Bad holiday list item: %s" p)
(sleep-for 2)))))
(error
(display-warning
:error
(format "Bad holiday list item: %s\nError: %s\n"
p err))
nil))))
(setq res (append h res))))
'calendar-date-compare)))

34
lisp/cus-face.el
View File

@ -136,12 +136,36 @@
:help-echo "Control text underlining."
(const :tag "Off" nil)
(list :tag "On"
:value (:color foreground-color :style line)
(const :format "" :value :color)
(choice :tag "Color" (const :tag "Foreground Color" foreground-color) color)
(const :format "" :value :style)
(choice :tag "Style"
(const :tag "Line" line)
(const :tag "Wave" wave)))))
(choice :tag "Color"
(const :tag "Foreground Color" foreground-color)
color)
(const :format "" :value :style)
(choice :tag "Style"
(const :tag "Line" line)
(const :tag "Wave" wave))))
;; filter to make value suitable for customize
(lambda (real-value)
(and real-value
(let ((color
(or (and (consp real-value) (plist-get real-value :color))
(and (stringp real-value) real-value)
'foreground-color))
(style
(or (and (consp real-value) (plist-get real-value :style))
'line)))
(list :color color :style style))))
;; filter to make customized-value suitable for storing
(lambda (cus-value)
(and cus-value
(let ((color (plist-get cus-value :color))
(style (plist-get cus-value :style)))
(cond ((eq style 'line)
;; Use simple value for default style
(if (eq color 'foreground-color) t color))
(t
`(:color ,color :style ,style)))))))
(:overline
(choice :tag "Overline"

2
lisp/descr-text.el
View File

@ -140,7 +140,7 @@ otherwise."
(defun describe-text-properties-1 (pos output-buffer)
(let* ((properties (text-properties-at pos))
(overlays (overlays-at pos))
(overlays (overlays-in pos (1+ pos)))
(wid-field (get-char-property pos 'field))
(wid-button (get-char-property pos 'button))
(wid-doc (get-char-property pos 'widget-doc))

20
lisp/dired.el
View File

@ -1331,16 +1331,16 @@ DIRED-FILENAME WINDOW-POINT)."
"Mark all files remembered in ALIST.
Each element of ALIST looks like (FILE . MARKERCHAR)."
(let (elt fil chr)
(while alist
(setq elt (car alist)
alist (cdr alist)
fil (car elt)
chr (cdr elt))
(if (dired-goto-file fil)
(save-excursion
(beginning-of-line)
(delete-char 1)
(insert chr))))))
(save-excursion
(while alist
(setq elt (car alist)
alist (cdr alist)
fil (car elt)
chr (cdr elt))
(when (dired-goto-file fil)
(beginning-of-line)
(delete-char 1)
(insert chr))))))
(defun dired-remember-hidden ()
"Return a list of names of subdirs currently hidden."

26
lisp/erc/ChangeLog
View File

@ -1,3 +1,29 @@
2012-08-21 Josh Feinstein <jlf@foxtail.org>
* erc-join.el (erc-autojoin-timing): Fix defcustom type.
2012-08-21 Julien Danjou <julien@danjou.info>
* erc-match.el (erc-match-message): Use
`erc-match-exclude-server-buffer' not
`erc-track-exclude-server-buffer'.
2012-08-20 Josh Feinstein <jlf@foxtail.org>
* erc.el (erc-display-message): Abstract message hiding decision
to new function erc-hide-current-message-p.
(erc-lurker): New customization group.
(erc-lurker-state, erc-lurker-trim-nicks, erc-lurker-ignore-chars)
(erc-lurker-hide-list, erc-lurker-cleanup-interval)
(erc-lurker-threshold-time): New variables.
(erc-lurker-maybe-trim, erc-lurker-initialize, erc-lurker-cleanup)
(erc-hide-current-message-p, erc-canonicalize-server-name)
(erc-lurker-update-status, erc-lurker-p): New functions. Together
they maintain state about which users have spoken in the last
erc-lurker-threshold-time, with all other users being considered
lurkers whose messages of types in erc-lurker-hide-list will not
be displayed by erc-display-message.
2012-08-06 Julien Danjou <julien@danjou.info>
* erc-match.el (erc-match-exclude-server-buffer)

4
lisp/erc/erc-join.el
View File

@ -84,8 +84,8 @@ identification, or after `erc-autojoin-delay' seconds.
Any other value means the same as `connect'."
:group 'erc-autojoin
:version "24.1"
:type '(choice (const :tag "On Connection" 'connect)
(const :tag "When Identified" 'ident)))
:type '(choice (const :tag "On Connection" connect)
(const :tag "When Identified" ident)))
(defcustom erc-autojoin-delay 30
"Number of seconds to wait before attempting to autojoin channels.

2
lisp/erc/erc-match.el
View File

@ -458,7 +458,7 @@ Use this defun with `erc-insert-modify-hook'."
(point-min))
(point-max))))
(when (and vector
(not (and erc-track-exclude-server-buffer
(not (and erc-match-exclude-server-buffer
(erc-server-buffer-p))))
(mapc
(lambda (match-type)

174
lisp/erc/erc.el
View File

@ -100,6 +100,10 @@
"Ignoring certain messages"
:group 'erc)
(defgroup erc-lurker nil
"Hide specified message types sent by lurkers"
:group 'erc-ignore)
(defgroup erc-query nil
"Using separate buffers for private discussions"
:group 'erc)
@ -2455,6 +2459,174 @@ See also `erc-make-notice'."
string)
string)))
(defvar erc-lurker-state nil
"Track the time of the last PRIVMSG for each (server,nick) pair.
This is implemented as a hash of hashes, where the outer key is
the canonicalized server name (as returned by
`erc-canonicalize-server-name') and the outer value is a hash
table mapping nicks (as returned by `erc-lurker-maybe-trim') to
the times of their most recently received PRIVMSG on any channel
on the given server.")
(defcustom erc-lurker-trim-nicks t
"If t, trim trailing `erc-lurker-ignore-chars' from nicks.
This causes e.g. nick and nick` to be considered as the same
individual for activity tracking and lurkiness detection
purposes."
:group 'erc-lurker
:type 'boolean)
(defun erc-lurker-maybe-trim (nick)
"Maybe trim trailing `erc-lurker-ignore-chars' from NICK.
Returns NICK unmodified unless `erc-lurker-trim-nicks' is
non-nil."
(if erc-lurker-trim-nicks
(replace-regexp-in-string
(format "[%s]"
(mapconcat (lambda (char)
(regexp-quote (char-to-string char)))
erc-lurker-ignore-chars ""))
"" nick)
nick))
(defcustom erc-lurker-ignore-chars "`_"
"Characters at the end of a nick to strip for activity tracking purposes.
See also `erc-lurker-trim-nicks'."
:group 'erc-lurker
:type 'string)
(defcustom erc-lurker-hide-list nil
"List of IRC type messages to hide when sent by lurkers.
A typical value would be '(\"JOIN\" \"PART\" \"QUIT\").
See also `erc-lurker-p' and `erc-hide-list'."
:group 'erc-lurker
:type 'erc-message-type)
(defcustom erc-lurker-threshold-time (* 60 60 24) ; 24h by default
"Nicks from which no PRIVMSGs have been received within this
interval (in units of seconds) are considered lurkers by
`erc-lurker-p' and as a result their messages of types in
`erc-lurker-hide-list' will be hidden."
:group 'erc-lurker
:type 'integer)
(defun erc-lurker-initialize ()
"Initialize ERC lurker tracking functionality.
This function adds `erc-lurker-update-status' to
`erc-insert-pre-hook' in order to record the time of each nick's
most recent PRIVMSG as well as initializing the state variable
storing this information."
(setq erc-lurker-state (make-hash-table :test 'equal))
(add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
(defun erc-lurker-cleanup ()
"Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
This should be called regularly to avoid excessive resource
consumption for long-lived IRC or Emacs sessions."
(maphash
(lambda (server hash)
(maphash
(lambda (nick last-PRIVMSG-time)
(when
(> (time-to-seconds (time-subtract
(current-time)
last-PRIVMSG-time))
erc-lurker-threshold-time)
(remhash nick hash)))
hash)
(if (zerop (hash-table-count hash))
(remhash server erc-lurker-state)))
erc-lurker-state))
(defvar erc-lurker-cleanup-count 0
"Internal counter variable for use with `erc-lurker-cleanup-interval'.")
(defvar erc-lurker-cleanup-interval 100
"Specifies frequency of cleaning up stale erc-lurker state.
`erc-lurker-update-status' calls `erc-lurker-cleanup' once for
every `erc-lurker-cleanup-interval' updates to
`erc-lurker-state'. This is designed to limit the memory
consumption of lurker state during long Emacs sessions and/or ERC
sessions with large numbers of incoming PRIVMSGs.")
(defun erc-lurker-update-status (message)
"Update `erc-lurker-state' if necessary.
This function is called from `erc-insert-pre-hook'. If the
current message is a PRIVMSG, update `erc-lurker-state' to
reflect the fact that its sender has issued a PRIVMSG at the
current time. Otherwise, take no action.
This function depends on the fact that `erc-display-message'
dynamically binds `parsed', which is used to check if the current
message is a PRIVMSG and to determine its sender. See also
`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
In order to limit memory consumption, this function also calls
`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
updates of `erc-lurker-state'."
(when (and (boundp 'parsed) (erc-response-p parsed))
(let* ((command (erc-response.command parsed))
(sender
(erc-lurker-maybe-trim
(car (erc-parse-user (erc-response.sender parsed)))))
(server
(erc-canonicalize-server-name erc-server-announced-name)))
(when (equal command "PRIVMSG")
(when (>= (incf erc-lurker-cleanup-count) erc-lurker-cleanup-interval)
(setq erc-lurker-cleanup-count 0)
(erc-lurker-cleanup))
(unless (gethash server erc-lurker-state)
(puthash server (make-hash-table :test 'equal) erc-lurker-state))
(puthash sender (current-time)
(gethash server erc-lurker-state))))))
(defun erc-lurker-p (nick)
"Predicate indicating NICK's lurking status on the current server.
Lurking is the condition where NICK has issued no PRIVMSG on this
server within `erc-lurker-threshold-time'. See also
`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'."
(unless erc-lurker-state (erc-lurker-initialize))
(let* ((server
(erc-canonicalize-server-name erc-server-announced-name))
(last-PRIVMSG-time
(gethash (erc-lurker-maybe-trim nick)
(gethash server erc-lurker-state (make-hash-table)))))
(or (null last-PRIVMSG-time)
(> (time-to-seconds
(time-subtract (current-time) last-PRIVMSG-time))
erc-lurker-threshold-time))))
(defun erc-canonicalize-server-name (server)
"Returns the canonical network name for SERVER if any,
otherwise `erc-server-announced-name'. SERVER is matched against
`erc-common-server-suffixes'."
(when server
(or (cdar (erc-remove-if-not
(lambda (net) (string-match (car net) server))
erc-common-server-suffixes))
erc-server-announced-name)))
(defun erc-hide-current-message-p (parsed)
"Predicate indicating whether the parsed ERC response PARSED should be hidden.
Messages are always hidden if the message type of PARSED appears in
`erc-hide-list'. In addition, messages whose type is a member of
`erc-lurker-hide-list' are hidden if `erc-lurker-p' returns true."
(let* ((command (erc-response.command parsed))
(sender (car (erc-parse-user (erc-response.sender parsed)))))
(or (member command erc-hide-list)
(and (member command erc-lurker-hide-list) (erc-lurker-p sender)))))
(defun erc-display-message (parsed type buffer msg &rest args)
"Display MSG in BUFFER.
@ -2479,7 +2651,7 @@ See also `erc-format-message' and `erc-display-line'."
(if (not (erc-response-p parsed))
(erc-display-line string buffer)
(unless (member (erc-response.command parsed) erc-hide-list)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(erc-put-text-property 0 (length string) 'rear-sticky t string)
(erc-display-line string buffer)))))

16
lisp/font-lock.el
View File

@ -146,8 +146,8 @@
;; fontified automagically. In your ~/.emacs there could be:
;;
;; (defvar foo-font-lock-keywords
;; '(("\\<\\(one\\|two\\|three\\)\\>" . font-lock-keyword-face)
;; ("\\<\\(four\\|five\\|six\\)\\>" . font-lock-type-face))
;; '(("\\<\\(one\\|two\\|three\\)\\>" . 'font-lock-keyword-face)
;; ("\\<\\(four\\|five\\|six\\)\\>" . 'font-lock-type-face))
;; "Default expressions to highlight in Foo mode.")
;;
;; (add-hook 'foo-mode-hook
@ -167,8 +167,8 @@
;; could be:
;;
;; (defvar bar-font-lock-keywords
;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . font-lock-keyword-face)
;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . font-lock-type-face))
;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . 'font-lock-keyword-face)
;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . 'font-lock-type-face))
;; "Default expressions to highlight in Bar mode.")
;;
;; and within `bar-mode' there could be:
@ -679,8 +679,8 @@ end of the current highlighting list.
For example:
(font-lock-add-keywords 'c-mode
'((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
(\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face)))
'((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
(\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . 'font-lock-keyword-face)))
adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
comments, and to fontify `and', `or' and `not' words as keywords.
@ -694,9 +694,9 @@ For example:
(add-hook 'c-mode-hook
(lambda ()
(font-lock-add-keywords nil
'((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
'((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
(\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
font-lock-keyword-face)))))
'font-lock-keyword-face)))))
The above procedure may fail to add keywords to derived modes if
some involved major mode does not follow the standard conventions.

5
lisp/gnus/ChangeLog
View File

@ -1,3 +1,8 @@
2012-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-msg.el (gnus-summary-resend-message): Honor posting-style for
`name' and `address' in Resent-From header.
2012-08-14 Chong Yidong <cyd@gnu.org>
* gnus-art.el (article-display-face): Handle failure in

16
lisp/gnus/gnus-msg.el
View File

@ -1369,7 +1369,21 @@ For the \"inline\" alternatives, also see the variable
(nnmail-fetch-field "to"))))
current-prefix-arg))
(let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
(message-sent-hook (copy-sequence message-sent-hook)))
(message-sent-hook (copy-sequence message-sent-hook))
;; Honor posting-style for `name' and `address' in Resent-From header.
(styles (gnus-group-find-parameter gnus-newsgroup-name
'posting-style t))
(user-full-name user-full-name)
(user-mail-address user-mail-address)
tem)
(dolist (style (if styles
(append gnus-posting-styles (list (cons ".*" styles)))
gnus-posting-styles))
(when (string-match (pop style) gnus-newsgroup-name)
(when (setq tem (cadr (assq 'name style)))
(setq user-full-name tem))
(when (setq tem (cadr (assq 'address style)))
(setq user-mail-address tem))))
;; `gnus-summary-resend-message-insert-gcc' must run last.
(add-hook 'message-header-setup-hook
'gnus-summary-resend-message-insert-gcc t)

8
lisp/help-fns.el
View File

@ -397,9 +397,11 @@ suitable file is found, return nil."
(if (member (event-modifiers (aref key 0)) '(nil (shift)))
(push key non-modified-keys)))
(when remapped
(princ "Its keys are remapped to `")
(princ (symbol-name remapped))
(princ "'.\n"))
(princ "Its keys are remapped to ")
(princ (if (symbolp remapped)
(concat "`" (symbol-name remapped) "'")
"an anonymous command"))
(princ ".\n"))
(when keys
(princ (if remapped

47
lisp/info.el
View File

@ -417,6 +417,21 @@ If number, the point is moved to the corresponding line.")
(defvar Info-standalone nil
"Non-nil if Emacs was started solely as an Info browser.")
(defvar Info-file-attributes nil
"Alist of file attributes of visited Info files.
Each element is a list (FILE-NAME FILE-ATTRIBUTES...).")
(defvar Info-toc-nodes nil
"Alist of cached parent-children node information in visited Info files.
Each element is (FILE (NODE-NAME PARENT SECTION CHILDREN) ...)
where PARENT is the parent node extracted from the Up pointer,
SECTION is the section name in the Top node where this node is placed,
CHILDREN is a list of child nodes extracted from the node menu.")
(defvar Info-index-nodes nil
"Alist of cached index node names of visited Info files.
Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
(defvar Info-virtual-files nil
"List of definitions of virtual Info files.
Each element of the list has the format (FILENAME (OPERATION . HANDLER) ...)
@ -609,7 +624,26 @@ Do the right thing if the file has been compressed or zipped."
(apply 'call-process-region (point-min) (point-max)
(car decoder) t t nil (cdr decoder))))
(let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes
(insert-file-contents fullname visit)))))
(insert-file-contents fullname visit)))
;; Clear the caches of modified Info files.
(let* ((attribs-old (cdr (assoc fullname Info-file-attributes)))
(modtime-old (and attribs-old (nth 5 attribs-old)))
(attribs-new (and (stringp fullname) (file-attributes fullname)))
(modtime-new (and attribs-new (nth 5 attribs-new))))
(when (and modtime-old modtime-new
(> (float-time modtime-new) (float-time modtime-old)))
(setq Info-index-nodes (remove (assoc (or Info-current-file filename)
Info-index-nodes)
Info-index-nodes))
(setq Info-toc-nodes (remove (assoc (or Info-current-file filename)
Info-toc-nodes)
Info-toc-nodes)))
;; Add new modtime to `Info-file-attributes'.
(setq Info-file-attributes
(cons (cons fullname attribs-new)
(remove (assoc fullname Info-file-attributes)
Info-file-attributes))))))
(defun Info-file-supports-index-cookies (&optional file)
"Return non-nil value if FILE supports Info index cookies.
@ -2394,13 +2428,6 @@ Table of contents is created from the tree structure of menus."
(message "")
(nreverse nodes))))
(defvar Info-toc-nodes nil
"Alist of cached parent-children node information in visited Info files.
Each element is (FILE (NODE-NAME PARENT SECTION CHILDREN) ...)
where PARENT is the parent node extracted from the Up pointer,
SECTION is the section name in the Top node where this node is placed,
CHILDREN is a list of child nodes extracted from the node menu.")
(defun Info-toc-nodes (filename)
"Return a node list of Info FILENAME with parent-children information.
This information is cached in the variable `Info-toc-nodes' with the help
@ -3032,10 +3059,6 @@ See `Info-scroll-down'."
(if (looking-at "^\\* ")
(forward-char 2)))))
(defvar Info-index-nodes nil
"Alist of cached index node names of visited Info files.
Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
(defun Info-index-nodes (&optional file)
"Return a list of names of all index nodes in Info FILE.
If FILE is omitted, it defaults to the current Info file.

19
lisp/json.el
View File

@ -174,6 +174,10 @@ this around your call to `json-read' instead of `setq'ing it.")
(put 'json-string-format 'error-conditions
'(json-string-format json-error error))
(put 'json-key-format 'error-message "Bad JSON object key")
(put 'json-key-format 'error-conditions
'(json-key-format json-error error))
(put 'json-object-format 'error-message "Bad JSON object")
(put 'json-object-format 'error-conditions
'(json-object-format json-error error))
@ -321,6 +325,15 @@ representation will be parsed correctly."
"Return a JSON representation of STRING."
(format "\"%s\"" (mapconcat 'json-encode-char string "")))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
If the resulting JSON object isn't a valid JSON object key,
this signals `json-key-format'."
(let ((encoded (json-encode object)))
(unless (stringp (json-read-from-string encoded))
(signal 'json-key-format (list object)))
encoded))
;;; JSON Objects
(defun json-new-object ()
@ -395,7 +408,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(maphash
(lambda (k v)
(push (format "%s:%s"
(json-encode k)
(json-encode-key k)
(json-encode v))
r))
hash-table)
@ -409,7 +422,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(format "{%s}"
(json-join (mapcar (lambda (cons)
(format "%s:%s"
(json-encode (car cons))
(json-encode-key (car cons))
(json-encode (cdr cons))))
alist)
", ")))
@ -418,7 +431,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
"Return a JSON representation of PLIST."
(let (result)
(while plist
(push (concat (json-encode (car plist))
(push (concat (json-encode-key (car plist))
":"
(json-encode (cadr plist)))
result)

1
lisp/mail/rmail.el
View File

@ -663,6 +663,7 @@ Element N specifies the summary line for message N+1.")
(defvar rmail-last-regexp nil)
(put 'rmail-last-regexp 'permanent-local t)
;; Note that rmail-output-read-file-name modifies this.
(defcustom rmail-default-file "~/xmail"
"Default file name for \\[rmail-output]."
:type 'file

80
lisp/mail/rmailout.el
View File

@ -34,7 +34,6 @@
:type 'boolean
:group 'rmail-output)
;; FIXME risky?
(defcustom rmail-output-file-alist nil
"Alist matching regexps to suggested output Rmail files.
This is a list of elements of the form (REGEXP . NAME-EXP).
@ -47,6 +46,7 @@ a file name as a string."
(string :tag "File Name")
sexp)))
:group 'rmail-output)
;; This is risky because NAME-EXP gets evalled.
;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t)
(defcustom rmail-fields-not-to-output nil
@ -58,35 +58,57 @@ The function `rmail-delete-unwanted-fields' uses this, ignoring case."
(defun rmail-output-read-file-name ()
"Read the file name to use for `rmail-output'.
Set `rmail-default-file' to this name as well as returning it."
(let ((default-file
(let (answer tail)
(setq tail rmail-output-file-alist)
;; Suggest a file based on a pattern match.
(while (and tail (not answer))
(save-excursion
(goto-char (point-min))
(if (re-search-forward (car (car tail)) nil t)
(setq answer (eval (cdr (car tail)))))
(setq tail (cdr tail))))
Set `rmail-default-file' to this name as well as returning it.
This uses `rmail-output-file-alist'."
(let* ((default-file
(or
(when rmail-output-file-alist
(or rmail-buffer (error "There is no Rmail buffer"))
(save-current-buffer
(set-buffer rmail-buffer)
(let ((beg (rmail-msgbeg rmail-current-message))
(end (rmail-msgend rmail-current-message)))
(if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
(save-excursion
(save-restriction
(widen)
(narrow-to-region beg end)
(let ((tail rmail-output-file-alist)
answer err)
;; Suggest a file based on a pattern match.
(while (and tail (not answer))
(goto-char (point-min))
(if (re-search-forward (caar tail) nil t)
(setq answer
(condition-case err
(eval (cdar tail))
(error
(display-warning
:error
(format "Error evaluating \
`rmail-output-file-alist' element:\nregexp: %s\naction: %s\nerror: %S\n"
(caar tail) (cdar tail) err))
nil))))
(setq tail (cdr tail)))
answer))))))
;; If no suggestion, use same file as last time.
(or answer rmail-default-file))))
(let ((read-file
(expand-file-name
(read-file-name
(concat "Output message to mail file (default "
(file-name-nondirectory default-file)
"): ")
(file-name-directory default-file)
(abbreviate-file-name default-file))
(file-name-directory default-file))))
(setq rmail-default-file
(if (file-directory-p read-file)
(expand-file-name (file-name-nondirectory default-file)
read-file)
(expand-file-name
(or read-file (file-name-nondirectory default-file))
(file-name-directory default-file)))))))
rmail-default-file))
(read-file
(expand-file-name
(read-file-name
(concat "Output message to mail file (default "
(file-name-nondirectory default-file)
"): ")
(file-name-directory default-file)
(abbreviate-file-name default-file))
(file-name-directory default-file))))
(setq rmail-default-file
(if (file-directory-p read-file)
(expand-file-name (file-name-nondirectory default-file)
read-file)
(expand-file-name
(or read-file (file-name-nondirectory default-file))
(file-name-directory default-file))))))
(defun rmail-delete-unwanted-fields (preserve)
"Delete all headers matching `rmail-fields-not-to-output'.

2
lisp/net/tramp.el
View File

@ -3293,7 +3293,7 @@ for process communication also."
;; Under Windows XP, accept-process-output doesn't return
;; sometimes. So we add an additional timeout.
(with-timeout ((or timeout 1))
(accept-process-output proc timeout timeout-msecs)))
(accept-process-output proc timeout timeout-msecs (and proc t))))
(tramp-message proc 10 "\n%s" (buffer-string))))
(defun tramp-check-for-regexp (proc regexp)

13
lisp/progmodes/bug-reference.el
View File

@ -32,6 +32,11 @@
;;; Code:
(defgroup bug-reference nil
"Hyperlinking references to bug reports"
;; Somewhat arbitrary, by analogy with eg goto-address.
:group 'comm)
(defvar bug-reference-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'bug-reference-push-button)
@ -63,9 +68,13 @@ so that it is considered safe, see `enable-local-variables'.")
(and (symbolp s)
(get s 'bug-reference-url-format)))))
(defconst bug-reference-bug-regexp
(defcustom bug-reference-bug-regexp
"\\([Bb]ug ?#\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z-+]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
"Regular expression which matches bug references.")
"Regular expression matching bug references.
The second subexpression should match the bug reference (usually a number)."
:type 'string
:safe 'stringp
:group 'bug-reference)
(defun bug-reference-set-overlay-properties ()
"Set properties of bug reference overlays."

5
lisp/progmodes/js.el
View File

@ -426,18 +426,21 @@ Match group 1 is the name of the macro.")
(defcustom js-indent-level 4
"Number of spaces for each indentation step in `js-mode'."
:type 'integer
:safe 'integerp
:group 'js)
(defcustom js-expr-indent-offset 0
"Number of additional spaces for indenting continued expressions.
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
:group 'js)
(defcustom js-paren-indent-offset 0
"Number of additional spaces for indenting expressions in parentheses.
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
:group 'js
:version "24.1")
@ -445,6 +448,7 @@ The value must be no less than minus `js-indent-level'."
"Number of additional spaces for indenting expressions in square braces.
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
:group 'js
:version "24.1")
@ -452,6 +456,7 @@ The value must be no less than minus `js-indent-level'."
"Number of additional spaces for indenting expressions in curly braces.
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
:group 'js
:version "24.1")

45
lisp/simple.el
View File

@ -3474,16 +3474,36 @@ The argument is used for internal purposes; do not supply one."
;; Yanking.
(defcustom yank-handled-properties
'((font-lock-face . yank-handle-font-lock-face-property)
(category . yank-handle-category-property))
"List of special text property handling conditions for yanking.
Each element should have the form (PROP . FUN), where PROP is a
property symbol and FUN is a function. When the `yank' command
inserts text into the buffer, it scans the inserted text for
stretches of text that have `eq' values of the text property
PROP; for each such stretch of text, FUN is called with three
arguments: the property's value in that text, and the start and
end positions of the text.
This is done prior to removing the properties specified by
`yank-excluded-properties'."
:group 'killing
:version "24.3")
;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
'(read-only invisible intangible field mouse-face help-echo local-map keymap
yank-handler follow-link fontified)
'(category field follow-link fontified font-lock-face help-echo
intangible invisible keymap local-map mouse-face read-only
yank-handler)
"Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
which means to discard all text properties."
which means to discard all text properties.
See also `yank-handled-properties'."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'killing
:version "22.1")
:version "24.3")
(defvar yank-window-start nil)
(defvar yank-undo-function nil
@ -3535,15 +3555,16 @@ doc string for `insert-for-yank-1', which see."
(defun yank (&optional arg)
"Reinsert (\"paste\") the last stretch of killed text.
More precisely, reinsert the stretch of killed text most recently
killed OR yanked. Put point at end, and set mark at beginning.
With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
With argument N, reinsert the Nth most recently killed stretch of killed
text.
More precisely, reinsert the most recent kill, which is the
stretch of killed text most recently killed OR yanked. Put point
at the end, and set mark at the beginning without activating it.
With just \\[universal-argument] as argument, put point at beginning, and mark at end.
With argument N, reinsert the Nth most recent kill.
When this command inserts killed text into the buffer, it honors
`yank-excluded-properties' and `yank-handler' as described in the
doc string for `insert-for-yank-1', which see.
When this command inserts text into the buffer, it honors the
`yank-handled-properties' and `yank-excluded-properties'
variables, and the `yank-handler' text property. See
`insert-for-yank-1' for details.
See also the command `yank-pop' (\\[yank-pop])."
(interactive "*P")

129
lisp/subr.el
View File

@ -2805,35 +2805,24 @@ if it's an autoloaded macro."
;;;; Support for yanking and text properties.
(defvar yank-handled-properties)
(defvar yank-excluded-properties)
(defun remove-yank-excluded-properties (start end)
"Remove `yank-excluded-properties' between START and END positions.
Replaces `category' properties with their defined properties."
"Process text properties between START and END, inserted for a `yank'.
Perform the handling specified by `yank-handled-properties', then
remove properties specified by `yank-excluded-properties'."
(let ((inhibit-read-only t))
;; Replace any `category' property with the properties it stands
;; for. This is to remove `mouse-face' properties that are placed
;; on categories in *Help* buffers' buttons. See
;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
;; for the details.
(unless (memq yank-excluded-properties '(t nil))
(save-excursion
(goto-char start)
(while (< (point) end)
(let ((cat (get-text-property (point) 'category))
run-end)
(setq run-end
(next-single-property-change (point) 'category nil end))
(when cat
(let (run-end2 original)
(remove-list-of-text-properties (point) run-end '(category))
(while (< (point) run-end)
(setq run-end2 (next-property-change (point) nil run-end))
(setq original (text-properties-at (point)))
(set-text-properties (point) run-end2 (symbol-plist cat))
(add-text-properties (point) run-end2 original)
(goto-char run-end2))))
(goto-char run-end)))))
(dolist (handler yank-handled-properties)
(let ((prop (car handler))
(fun (cdr handler))
(run-start start))
(while (< run-start end)
(let ((value (get-text-property run-start prop))
(run-end (next-single-property-change
run-start prop nil end)))
(funcall fun value run-start run-end)
(setq run-start run-end)))))
(if (eq yank-excluded-properties t)
(set-text-properties start end nil)
(remove-list-of-text-properties start end yank-excluded-properties))))
@ -2851,29 +2840,31 @@ See `insert-for-yank-1' for more details."
(insert-for-yank-1 string))
(defun insert-for-yank-1 (string)
"Insert STRING at point, stripping some text properties.
"Insert STRING at point for the `yank' command.
This function is like `insert', except it honors the variables
`yank-handled-properties' and `yank-excluded-properties', and the
`yank-handler' text property.
Strip text properties from the inserted text according to
`yank-excluded-properties'. Otherwise just like (insert STRING).
Properties listed in `yank-handled-properties' are processed,
then those listed in `yank-excluded-properties' are discarded.
If STRING has a non-nil `yank-handler' property on the first character,
the normal insert behavior is modified in various ways. The value of
the yank-handler property must be a list with one to four elements
with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
When FUNCTION is present and non-nil, it is called instead of `insert'
to insert the string. FUNCTION takes one argument--the object to insert.
If PARAM is present and non-nil, it replaces STRING as the object
passed to FUNCTION (or `insert'); for example, if FUNCTION is
`yank-rectangle', PARAM may be a list of strings to insert as a
rectangle.
If NOEXCLUDE is present and non-nil, the normal removal of the
If STRING has a non-nil `yank-handler' property on its first
character, the normal insert behavior is altered. The value of
the `yank-handler' property must be a list of one to four
elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO).
FUNCTION, if non-nil, should be a function of one argument, an
object to insert; it is called instead of `insert'.
PARAM, if present and non-nil, replaces STRING as the argument to
FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM
may be a list of strings to insert as a rectangle.
If NOEXCLUDE is present and non-nil, the normal removal of
`yank-excluded-properties' is not performed; instead FUNCTION is
responsible for removing those properties. This may be necessary
if FUNCTION adjusts point before or after inserting the object.
If UNDO is present and non-nil, it is a function that will be called
responsible for the removal. This may be necessary if FUNCTION
adjusts point before or after inserting the object.
UNDO, if present and non-nil, should be a function to be called
by `yank-pop' to undo the insertion of the current object. It is
called with two arguments, the start and end of the current region.
FUNCTION may set `yank-undo-function' to override the UNDO value."
given two arguments, the start and end of the region. FUNCTION
may set `yank-undo-function' to override UNDO."
(let* ((handler (and (stringp string)
(get-text-property 0 'yank-handler string)))
(param (or (nth 1 handler) string))
@ -2882,7 +2873,7 @@ If UNDO is present and non-nil, it is a function that will be called
end)
(setq yank-undo-function t)
(if (nth 0 handler) ;; FUNCTION
(if (nth 0 handler) ; FUNCTION
(funcall (car handler) param)
(insert param))
(setq end (point))
@ -2891,34 +2882,17 @@ If UNDO is present and non-nil, it is a function that will be called
;; following text property changes.
(setq inhibit-read-only t)
;; What should we do with `font-lock-face' properties?
(if font-lock-defaults
;; No, just wipe them.
(remove-list-of-text-properties opoint end '(font-lock-face))
;; Convert them to `face'.
(save-excursion
(goto-char opoint)
(while (< (point) end)
(let ((face (get-text-property (point) 'font-lock-face))
run-end)
(setq run-end
(next-single-property-change (point) 'font-lock-face nil end))
(when face
(remove-text-properties (point) run-end '(font-lock-face nil))
(put-text-property (point) run-end 'face face))
(goto-char run-end)))))
(unless (nth 2 handler) ;; NOEXCLUDE
(remove-yank-excluded-properties opoint (point)))
(unless (nth 2 handler) ; NOEXCLUDE
(remove-yank-excluded-properties opoint end))
;; If last inserted char has properties, mark them as rear-nonsticky.
(if (and (> end opoint)
(text-properties-at (1- end)))
(put-text-property (1- end) end 'rear-nonsticky t))
(if (eq yank-undo-function t) ;; not set by FUNCTION
(setq yank-undo-function (nth 3 handler))) ;; UNDO
(if (nth 4 handler) ;; COMMAND
(if (eq yank-undo-function t) ; not set by FUNCTION
(setq yank-undo-function (nth 3 handler))) ; UNDO
(if (nth 4 handler) ; COMMAND
(setq this-command (nth 4 handler)))))
(defun insert-buffer-substring-no-properties (buffer &optional start end)
@ -2944,6 +2918,27 @@ Strip text properties from the inserted text according to
(insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point))))
(defun yank-handle-font-lock-face-property (face start end)
"If `font-lock-defaults' is nil, apply FACE as a `face' property.
START and END denote the start and end of the text to act on.
Do nothing if FACE is nil."
(and face
(null font-lock-defaults)
(put-text-property start end 'face face)))
;; This removes `mouse-face' properties in *Help* buffer buttons:
;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
(defun yank-handle-category-property (category start end)
"Apply property category CATEGORY's properties between START and END."
(when category
(let ((start2 start))
(while (< start2 end)
(let ((end2 (next-property-change start2 nil end))
(original (text-properties-at start2)))
(set-text-properties start2 end2 (symbol-plist category))
(add-text-properties start2 end2 original)
(setq start2 end2))))))
;;;; Synchronous shell commands.

114
lisp/window.el
View File

@ -271,19 +271,32 @@ windows horizontally arranged within WINDOW."
(setq walk-window-tree-window
(window-right walk-window-tree-window))))))
(defun walk-window-tree (fun &optional frame any)
(defun walk-window-tree (fun &optional frame any minibuf)
"Run function FUN on each live window of FRAME.
FUN must be a function with one argument - a window. FRAME must
be a live frame and defaults to the selected one. ANY, if
non-nil means to run FUN on all live and internal windows of
non-nil, means to run FUN on all live and internal windows of
FRAME.
Optional argument MINIBUF t means run FUN on FRAME's minibuffer
window even if it isn't active. MINIBUF nil or omitted means run
FUN on FRAME's minibuffer window only if it's active. In both
cases the minibuffer window must be part of FRAME. MINIBUF
neither nil nor t means never run FUN on the minibuffer window.
This function performs a pre-order, depth-first traversal of the
window tree. If FUN changes the window tree, the result is
unpredictable."
(let ((walk-window-tree-frame (window-normalize-frame frame)))
(walk-window-tree-1
fun (frame-root-window walk-window-tree-frame) any)))
(setq frame (window-normalize-frame frame))
(walk-window-tree-1 fun (frame-root-window frame) any)
(when (memq minibuf '(nil t))
;; Run FUN on FRAME's minibuffer window if requested.
(let ((minibuffer-window (minibuffer-window frame)))
(when (and (window-live-p minibuffer-window)
(eq (window-frame minibuffer-window) frame)
(or (eq minibuf t)
(minibuffer-window-active-p minibuffer-window)))
(funcall fun minibuffer-window)))))
(defun walk-window-subtree (fun &optional window any)
"Run function FUN on the subtree of windows rooted at WINDOW.
@ -299,13 +312,19 @@ is unpredictable."
(setq window (window-normalize-window window))
(walk-window-tree-1 fun window any t))
(defun window-with-parameter (parameter &optional value frame any)
(defun window-with-parameter (parameter &optional value frame any minibuf)
"Return first window on FRAME with PARAMETER non-nil.
FRAME defaults to the selected frame. Optional argument VALUE
non-nil means only return a window whose window-parameter value
for PARAMETER equals VALUE (comparison is done with `equal').
Optional argument ANY non-nil means consider internal windows
too."
too.
Optional argument MINIBUF t means consider FRAME's minibuffer
window even if it isn't active. MINIBUF nil or omitted means
consider FRAME's minibuffer window only if it's active. In both
cases the minibuffer window must be part of FRAME. MINIBUF
neither nil nor t means never consider the minibuffer window."
(let (this-value)
(catch 'found
(walk-window-tree
@ -313,7 +332,7 @@ too."
(when (and (setq this-value (window-parameter window parameter))
(or (not value) (equal value this-value)))
(throw 'found window)))
frame any))))
frame any minibuf))))
;;; Atomic windows.
(defun window-atom-root (&optional window)
@ -516,7 +535,7 @@ unless it has no other choice (like when deleting a neighboring
window).")
(make-variable-buffer-local 'window-size-fixed)
(defun window--size-ignore (window ignore)
(defun window--size-ignore-p (window ignore)
"Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
(if (window-valid-p ignore) (eq window ignore) ignore))
@ -559,7 +578,7 @@ means ignore all of the above restrictions for all windows."
value)
(with-current-buffer (window-buffer window)
(cond
((and (not (window--size-ignore window ignore))
((and (not (window--size-ignore-p window ignore))
(window-size-fixed-p window horizontal))
;; The minimum size of a fixed size window is its size.
(window-total-size window horizontal))
@ -588,7 +607,7 @@ means ignore all of the above restrictions for all windows."
(ceiling (or (frame-parameter frame 'scroll-bar-width) 14)
(frame-char-width)))
(t 0)))
(if (and (not (window--size-ignore window ignore))
(if (and (not (window--size-ignore-p window ignore))
(numberp window-min-width))
window-min-width
0))))
@ -598,7 +617,7 @@ means ignore all of the above restrictions for all windows."
(max (+ window-safe-min-height
(if header-line-format 1 0)
(if mode-line-format 1 0))
(if (and (not (window--size-ignore window ignore))
(if (and (not (window--size-ignore-p window ignore))
(numberp window-min-height))
window-min-height
0))))))))
@ -637,7 +656,7 @@ ignore all of the above restrictions for all windows."
(max (- (window-min-size window horizontal ignore)
(window-total-size window horizontal))
delta))
((window--size-ignore window ignore)
((window--size-ignore-p window ignore)
delta)
((> delta 0)
(if (window-size-fixed-p window horizontal)
@ -719,7 +738,7 @@ WINDOW can be resized in the desired direction. The function
((eq sub window)
(setq skip (eq trail 'before)))
(skip)
((and (not (window--size-ignore window ignore))
((and (not (window--size-ignore-p window ignore))
(window-size-fixed-p sub horizontal)))
(t
;; We found a non-fixed-size child window.
@ -809,7 +828,7 @@ at least one other window can be enlarged appropriately."
;; child window is fixed-size.
(while sub
(when (and (not (eq sub window))
(not (window--size-ignore sub ignore))
(not (window--size-ignore-p sub ignore))
(window-size-fixed-p sub horizontal))
(throw 'fixed delta))
(setq sub (window-right sub))))
@ -849,7 +868,7 @@ Optional argument NODOWN non-nil means do not check whether
WINDOW itself (and its child windows) can be enlarged; check
only whether other windows can be shrunk appropriately."
(setq window (window-normalize-window window))
(if (and (not (window--size-ignore window ignore))
(if (and (not (window--size-ignore-p window ignore))
(not nodown) (window-size-fixed-p window horizontal))
;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
;; size.
@ -1062,32 +1081,6 @@ windows nor the buffer list."
(dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
(funcall fun walk-windows-window))))
(defun window-point-1 (&optional window)
"Return value of WINDOW's point.
WINDOW can be any live window and defaults to the selected one.
This function is like `window-point' with one exception: If
WINDOW is selected, it returns the value of `point' of WINDOW's
buffer regardless of whether that buffer is current or not."
(setq window (window-normalize-window window t))
(if (eq window (selected-window))
(with-current-buffer (window-buffer window)
(point))
(window-point window)))
(defun set-window-point-1 (window pos)
"Set value of WINDOW's point to POS.
WINDOW can be any live window and defaults to the selected one.
This function is like `set-window-point' with one exception: If
WINDOW is selected, it moves `point' of WINDOW's buffer to POS
regardless of whether that buffer is current or not."
(setq window (window-normalize-window window t))
(if (eq window (selected-window))
(with-current-buffer (window-buffer window)
(goto-char pos))
(set-window-point window pos)))
(defun window-at-side-p (&optional window side)
"Return t if WINDOW is at SIDE of its containing frame.
WINDOW must be a valid window and defaults to the selected one.
@ -1114,7 +1107,7 @@ SIDE can be any of the symbols `left', `top', `right' or
(lambda (window)
(when (window-at-side-p window side)
(setq windows (cons window windows))))
frame)
frame nil 'nomini)
(nreverse windows)))
(defun window--in-direction-2 (window posn &optional horizontal)
@ -1129,12 +1122,25 @@ SIDE can be any of the symbols `left', `top', `right' or
(- left posn)
(- posn left (window-total-width window))))))
;; Predecessors to the below have been devised by Julian Assange in
;; change-windows-intuitively.el and Hovav Shacham in windmove.el.
;; Neither of these allow to selectively ignore specific windows
;; (windows whose `no-other-window' parameter is non-nil) as targets of
;; the movement.
(defun window-in-direction (direction &optional window ignore)
"Return window in DIRECTION as seen from WINDOW.
More precisely, return the nearest window in direction DIRECTION
as seen from the position of `window-point' in window WINDOW.
DIRECTION must be one of `above', `below', `left' or `right'.
WINDOW must be a live window and defaults to the selected one.
IGNORE non-nil means a window can be returned even if its
`no-other-window' parameter is non-nil."
Do not return a window whose `no-other-window' parameter is
non-nil. If the nearest window's `no-other-window' parameter is
non-nil, try to find another window in the indicated direction.
If, however, the optional argument IGNORE is non-nil, return that
window even if its `no-other-window' parameter is non-nil.
Return nil if no suitable window can be found."
(setq window (window-normalize-window window t))
(unless (memq direction '(above below left right))
(error "Wrong direction %s" direction))
@ -1146,7 +1152,7 @@ IGNORE non-nil means a window can be returned even if its
(last (+ first (if hor
(window-total-width window)
(window-total-height window))))
(posn-cons (nth 6 (posn-at-point (window-point-1 window) window)))
(posn-cons (nth 6 (posn-at-point (window-point window) window)))
;; The column / row value of `posn-at-point' can be nil for the
;; mini-window, guard against that.
(posn (if hor
@ -1221,7 +1227,7 @@ IGNORE non-nil means a window can be returned even if its
(setq best-edge-2 w-top)
(setq best-diff-2 best-diff-2-new)
(setq best-2 w)))))))
(window-frame window))
frame)
(or best best-2)))
(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
@ -1865,7 +1871,7 @@ preferably only resize windows adjacent to EDGE."
;; Make sure this sibling is left alone when
;; resizing its siblings.
(set-window-new-normal sub 'ignore))
((or (window--size-ignore sub ignore)
((or (window--size-ignore-p sub ignore)
(not (window-size-fixed-p sub horizontal)))
;; Set this-delta to t to signal that we found a sibling
;; of WINDOW whose size is not fixed.
@ -2613,7 +2619,7 @@ WINDOW must be a live window and defaults to the selected one."
;; Add an entry for buffer to WINDOW's previous buffers.
(with-current-buffer buffer
(let ((start (window-start window))
(point (window-point-1 window)))
(point (window-point window)))
(setq entry
(cons buffer
(if entry
@ -2657,7 +2663,7 @@ before was current this also makes BUFFER the current buffer."
;; Don't force window-start here (even if POINT is nil).
(set-window-start window start t))
(when point
(set-window-point-1 window point))))
(set-window-point window point))))
(defcustom switch-to-visible-buffer t
"If non-nil, allow switching to an already visible buffer.
@ -3393,7 +3399,7 @@ Otherwise, the window starts are chosen so as to minimize the
amount of redisplay; this is convenient on slow terminals."
(interactive "P")
(let ((old-window (selected-window))
(old-point (window-point-1))
(old-point (window-point))
(size (and size (prefix-numeric-value size)))
moved-by-window-height moved new-window bottom)
(when (and size (< size 0) (< (- size) window-min-height))
@ -3418,7 +3424,7 @@ amount of redisplay; this is convenient on slow terminals."
(setq bottom (point)))
(and moved-by-window-height
(<= bottom (point))
(set-window-point-1 old-window (1- bottom)))
(set-window-point old-window (1- bottom)))
(and moved-by-window-height
(<= (window-start new-window) old-point)
(set-window-point new-window old-point)
@ -3727,7 +3733,7 @@ specific buffers."
`((parameters . ,list))))
,@(when buffer
;; All buffer related things go in here.
(let ((point (window-point-1 window))
(let ((point (window-point window))
(start (window-start window)))
`((buffer
,(buffer-name buffer)
@ -4020,7 +4026,7 @@ element is BUFFER."
(list 'other
;; A quadruple of WINDOW's buffer, start, point and height.
(list (window-buffer window) (window-start window)
(window-point-1 window) (window-total-size window))
(window-point window) (window-total-size window))
(selected-window) buffer))))
((eq type 'window)
;; WINDOW has been created on an existing frame.

26
lisp/xml.el
View File

@ -1011,13 +1011,25 @@ The first line is indented with the optional INDENT-STRING."
(defalias 'xml-print 'xml-debug-print)
(defun xml-escape-string (string)
"Return STRING with entity substitutions made from `xml-entity-alist'."
(mapconcat (lambda (byte)
(let ((char (char-to-string byte)))
(if (rassoc char xml-entity-alist)
(concat "&" (car (rassoc char xml-entity-alist)) ";")
char)))
string ""))
"Convert STRING into a string containing valid XML character data.
Replace occurrences of &<>'\" in STRING with their default XML
entity references (e.g. replace each & with &amp;).
XML character data must not contain & or < characters, nor the >
character under some circumstances. The XML spec does not impose
restriction on \" or ', but we just substitute for these too
\(as is permitted by the spec)."
(with-temp-buffer
(insert string)
(dolist (substitution '(("&" . "&amp;")
("<" . "&lt;")
(">" . "&gt;")
("'" . "&apos;")
("\"" . "&quot;")))
(goto-char (point-min))
(while (search-forward (car substitution) nil t)
(replace-match (cdr substitution) t t nil)))
(buffer-string)))
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.

30
m4/extern-inline.m4
View File

@ -21,20 +21,34 @@ AC_DEFUN([gl_EXTERN_INLINE],
#if __GNUC__ ? __GNUC_STDC_INLINE__ : 199901L <= __STDC_VERSION__
# define _GL_INLINE inline
# define _GL_EXTERN_INLINE extern inline
# if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
# define _GL_INLINE_HEADER_BEGIN \
_Pragma ("GCC diagnostic push") \
_Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
_Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"")
# define _GL_INLINE_HEADER_END \
_Pragma ("GCC diagnostic pop")
#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
# if __GNUC_GNU_INLINE__
/* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
# else
# define _GL_INLINE extern inline
# endif
# define _GL_EXTERN_INLINE extern
#else
# define _GL_INLINE static inline
# define _GL_EXTERN_INLINE static inline
#endif
#ifndef _GL_INLINE_HEADER_BEGIN
#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
# if __GNUC_STDC_INLINE__
# define _GL_INLINE_HEADER_CONST_PRAGMA
# else
# define _GL_INLINE_HEADER_CONST_PRAGMA \
_Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
# endif
# define _GL_INLINE_HEADER_BEGIN \
_Pragma ("GCC diagnostic push") \
_Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
_Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") \
_GL_INLINE_HEADER_CONST_PRAGMA
# define _GL_INLINE_HEADER_END \
_Pragma ("GCC diagnostic pop")
#else
# define _GL_INLINE_HEADER_BEGIN
# define _GL_INLINE_HEADER_END
#endif])

299
m4/gnulib-comp.m4
View File

@ -136,135 +136,134 @@ AC_DEFUN([gl_INIT],
m4_pushdef([gl_LIBSOURCES_DIR], [])
gl_COMMON
gl_source_base='lib'
gl_FUNC_ALLOCA
AC_CHECK_FUNCS_ONCE([readlinkat])
gl_CLOCK_TIME
gl_MD5
gl_SHA1
gl_SHA256
gl_SHA512
AC_REQUIRE([gl_C99_STRTOLD])
gl_FUNC_DUP2
if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
AC_LIBOBJ([dup2])
gl_PREREQ_DUP2
fi
gl_UNISTD_MODULE_INDICATOR([dup2])
gl_ENVIRON
gl_UNISTD_MODULE_INDICATOR([environ])
AC_REQUIRE([gl_EXTERN_INLINE])
gl_FILEMODE
gl_GETLOADAVG
if test $HAVE_GETLOADAVG = 0; then
AC_LIBOBJ([getloadavg])
gl_PREREQ_GETLOADAVG
fi
gl_STDLIB_MODULE_INDICATOR([getloadavg])
gl_FUNC_GETOPT_GNU
if test $REPLACE_GETOPT = 1; then
AC_LIBOBJ([getopt])
AC_LIBOBJ([getopt1])
gl_PREREQ_GETOPT
dnl Arrange for unistd.h to include getopt.h.
GNULIB_GL_UNISTD_H_GETOPT=1
fi
AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu])
gl_FUNC_GETOPT_POSIX
if test $REPLACE_GETOPT = 1; then
AC_LIBOBJ([getopt])
AC_LIBOBJ([getopt1])
gl_PREREQ_GETOPT
dnl Arrange for unistd.h to include getopt.h.
GNULIB_GL_UNISTD_H_GETOPT=1
fi
AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
gl_GETTIME
gl_FUNC_GETTIMEOFDAY
if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
AC_LIBOBJ([gettimeofday])
gl_PREREQ_GETTIMEOFDAY
fi
gl_SYS_TIME_MODULE_INDICATOR([gettimeofday])
AC_REQUIRE([AC_C_INLINE])
gl_INTTYPES_INCOMPLETE
AC_REQUIRE([gl_LARGEFILE])
gl_FUNC_LSTAT
if test $REPLACE_LSTAT = 1; then
AC_LIBOBJ([lstat])
gl_PREREQ_LSTAT
fi
gl_SYS_STAT_MODULE_INDICATOR([lstat])
gl_FUNC_MKTIME
if test $REPLACE_MKTIME = 1; then
AC_LIBOBJ([mktime])
gl_PREREQ_MKTIME
fi
gl_TIME_MODULE_INDICATOR([mktime])
gl_MULTIARCH
gl_FUNC_PSELECT
if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
AC_LIBOBJ([pselect])
fi
gl_SYS_SELECT_MODULE_INDICATOR([pselect])
gl_FUNC_PTHREAD_SIGMASK
if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
AC_LIBOBJ([pthread_sigmask])
gl_PREREQ_PTHREAD_SIGMASK
fi
gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
gl_FUNC_READLINK
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
AC_LIBOBJ([readlink])
gl_PREREQ_READLINK
fi
gl_UNISTD_MODULE_INDICATOR([readlink])
gl_SIGNAL_H
gl_TYPE_SOCKLEN_T
gt_TYPE_SSIZE_T
gl_STAT_TIME
gl_STAT_BIRTHTIME
gl_STDALIGN_H
gl_STDARG_H
AM_STDBOOL_H
gl_STDDEF_H
gl_STDINT_H
gl_STDIO_H
gl_STDLIB_H
gl_FUNC_GNU_STRFTIME
gl_FUNC_STRTOIMAX
if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
AC_LIBOBJ([strtoimax])
gl_PREREQ_STRTOIMAX
fi
gl_INTTYPES_MODULE_INDICATOR([strtoimax])
gl_FUNC_STRTOUMAX
if test $ac_cv_func_strtoumax = no; then
AC_LIBOBJ([strtoumax])
gl_PREREQ_STRTOUMAX
fi
gl_INTTYPES_MODULE_INDICATOR([strtoumax])
gl_FUNC_SYMLINK
if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
AC_LIBOBJ([symlink])
fi
gl_UNISTD_MODULE_INDICATOR([symlink])
gl_HEADER_SYS_SELECT
AC_PROG_MKDIR_P
gl_HEADER_SYS_STAT_H
AC_PROG_MKDIR_P
gl_HEADER_SYS_TIME_H
AC_PROG_MKDIR_P
gl_HEADER_TIME_H
gl_TIME_R
if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
AC_LIBOBJ([time_r])
gl_PREREQ_TIME_R
fi
gl_TIME_MODULE_INDICATOR([time_r])
gl_TIMESPEC
gl_UNISTD_H
gl_UTIMENS
gl_FUNC_ALLOCA
AC_CHECK_FUNCS_ONCE([readlinkat])
gl_CLOCK_TIME
gl_MD5
gl_SHA1
gl_SHA256
gl_SHA512
AC_REQUIRE([gl_C99_STRTOLD])
gl_FUNC_DUP2
if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
AC_LIBOBJ([dup2])
gl_PREREQ_DUP2
fi
gl_UNISTD_MODULE_INDICATOR([dup2])
gl_ENVIRON
gl_UNISTD_MODULE_INDICATOR([environ])
AC_REQUIRE([gl_EXTERN_INLINE])
gl_FILEMODE
gl_GETLOADAVG
if test $HAVE_GETLOADAVG = 0; then
AC_LIBOBJ([getloadavg])
gl_PREREQ_GETLOADAVG
fi
gl_STDLIB_MODULE_INDICATOR([getloadavg])
gl_FUNC_GETOPT_GNU
if test $REPLACE_GETOPT = 1; then
AC_LIBOBJ([getopt])
AC_LIBOBJ([getopt1])
gl_PREREQ_GETOPT
dnl Arrange for unistd.h to include getopt.h.
GNULIB_GL_UNISTD_H_GETOPT=1
fi
AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu])
gl_FUNC_GETOPT_POSIX
if test $REPLACE_GETOPT = 1; then
AC_LIBOBJ([getopt])
AC_LIBOBJ([getopt1])
gl_PREREQ_GETOPT
dnl Arrange for unistd.h to include getopt.h.
GNULIB_GL_UNISTD_H_GETOPT=1
fi
AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
gl_GETTIME
gl_FUNC_GETTIMEOFDAY
if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
AC_LIBOBJ([gettimeofday])
gl_PREREQ_GETTIMEOFDAY
fi
gl_SYS_TIME_MODULE_INDICATOR([gettimeofday])
gl_INTTYPES_INCOMPLETE
AC_REQUIRE([gl_LARGEFILE])
gl_FUNC_LSTAT
if test $REPLACE_LSTAT = 1; then
AC_LIBOBJ([lstat])
gl_PREREQ_LSTAT
fi
gl_SYS_STAT_MODULE_INDICATOR([lstat])
gl_FUNC_MKTIME
if test $REPLACE_MKTIME = 1; then
AC_LIBOBJ([mktime])
gl_PREREQ_MKTIME
fi
gl_TIME_MODULE_INDICATOR([mktime])
gl_MULTIARCH
gl_FUNC_PSELECT
if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
AC_LIBOBJ([pselect])
fi
gl_SYS_SELECT_MODULE_INDICATOR([pselect])
gl_FUNC_PTHREAD_SIGMASK
if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
AC_LIBOBJ([pthread_sigmask])
gl_PREREQ_PTHREAD_SIGMASK
fi
gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
gl_FUNC_READLINK
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
AC_LIBOBJ([readlink])
gl_PREREQ_READLINK
fi
gl_UNISTD_MODULE_INDICATOR([readlink])
gl_SIGNAL_H
gl_TYPE_SOCKLEN_T
gt_TYPE_SSIZE_T
gl_STAT_TIME
gl_STAT_BIRTHTIME
gl_STDALIGN_H
gl_STDARG_H
AM_STDBOOL_H
gl_STDDEF_H
gl_STDINT_H
gl_STDIO_H
gl_STDLIB_H
gl_FUNC_GNU_STRFTIME
gl_FUNC_STRTOIMAX
if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
AC_LIBOBJ([strtoimax])
gl_PREREQ_STRTOIMAX
fi
gl_INTTYPES_MODULE_INDICATOR([strtoimax])
gl_FUNC_STRTOUMAX
if test $ac_cv_func_strtoumax = no; then
AC_LIBOBJ([strtoumax])
gl_PREREQ_STRTOUMAX
fi
gl_INTTYPES_MODULE_INDICATOR([strtoumax])
gl_FUNC_SYMLINK
if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
AC_LIBOBJ([symlink])
fi
gl_UNISTD_MODULE_INDICATOR([symlink])
gl_HEADER_SYS_SELECT
AC_PROG_MKDIR_P
gl_HEADER_SYS_STAT_H
AC_PROG_MKDIR_P
gl_HEADER_SYS_TIME_H
AC_PROG_MKDIR_P
gl_HEADER_TIME_H
gl_TIME_R
if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
AC_LIBOBJ([time_r])
gl_PREREQ_TIME_R
fi
gl_TIME_MODULE_INDICATOR([time_r])
gl_TIMESPEC
gl_UNISTD_H
gl_UTIMENS
gl_gnulib_enabled_dosname=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
gl_gnulib_enabled_pathmax=false
@ -281,27 +280,27 @@ gl_UTIMENS
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
{
if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
AC_SUBST([LIBINTL])
AC_SUBST([LTLIBINTL])
AC_SUBST([LIBINTL])
AC_SUBST([LTLIBINTL])
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
fi
}
func_gl_gnulib_m4code_pathmax ()
{
if ! $gl_gnulib_enabled_pathmax; then
gl_PATHMAX
gl_PATHMAX
gl_gnulib_enabled_pathmax=true
fi
}
func_gl_gnulib_m4code_stat ()
{
if ! $gl_gnulib_enabled_stat; then
gl_FUNC_STAT
if test $REPLACE_STAT = 1; then
AC_LIBOBJ([stat])
gl_PREREQ_STAT
fi
gl_SYS_STAT_MODULE_INDICATOR([stat])
gl_FUNC_STAT
if test $REPLACE_STAT = 1; then
AC_LIBOBJ([stat])
gl_PREREQ_STAT
fi
gl_SYS_STAT_MODULE_INDICATOR([stat])
gl_gnulib_enabled_stat=true
if test $REPLACE_STAT = 1; then
func_gl_gnulib_m4code_dosname
@ -317,24 +316,24 @@ gl_SYS_STAT_MODULE_INDICATOR([stat])
func_gl_gnulib_m4code_strtoll ()
{
if ! $gl_gnulib_enabled_strtoll; then
gl_FUNC_STRTOLL
if test $HAVE_STRTOLL = 0; then
AC_LIBOBJ([strtoll])
gl_PREREQ_STRTOLL
fi
gl_STDLIB_MODULE_INDICATOR([strtoll])
gl_FUNC_STRTOLL
if test $HAVE_STRTOLL = 0; then
AC_LIBOBJ([strtoll])
gl_PREREQ_STRTOLL
fi
gl_STDLIB_MODULE_INDICATOR([strtoll])
gl_gnulib_enabled_strtoll=true
fi
}
func_gl_gnulib_m4code_strtoull ()
{
if ! $gl_gnulib_enabled_strtoull; then
gl_FUNC_STRTOULL
if test $HAVE_STRTOULL = 0; then
AC_LIBOBJ([strtoull])
gl_PREREQ_STRTOULL
fi
gl_STDLIB_MODULE_INDICATOR([strtoull])
gl_FUNC_STRTOULL
if test $HAVE_STRTOULL = 0; then
AC_LIBOBJ([strtoull])
gl_PREREQ_STRTOULL
fi
gl_STDLIB_MODULE_INDICATOR([strtoull])
gl_gnulib_enabled_strtoull=true
fi
}

7
m4/mktime.m4
View File

@ -1,4 +1,4 @@
# serial 23
# serial 24
dnl Copyright (C) 2002-2003, 2005-2007, 2009-2012 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
@ -247,7 +247,4 @@ AC_DEFUN([gl_FUNC_MKTIME_INTERNAL], [
])
# Prerequisites of lib/mktime.c.
AC_DEFUN([gl_PREREQ_MKTIME],
[
AC_REQUIRE([AC_C_INLINE])
])
AC_DEFUN([gl_PREREQ_MKTIME], [:])

27
m4/signalblocking.m4
View File

@ -1,27 +0,0 @@
# signalblocking.m4 serial 13
dnl Copyright (C) 2001-2002, 2006-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
# Determine available signal blocking primitives. Three different APIs exist:
# 1) POSIX: sigemptyset, sigaddset, sigprocmask
# 2) SYSV: sighold, sigrelse
# 3) BSD: sigblock, sigsetmask
# For simplicity, here we check only for the POSIX signal blocking.
AC_DEFUN([gl_SIGNALBLOCKING],
[
AC_REQUIRE([gl_SIGNAL_H_DEFAULTS])
AC_REQUIRE([gl_CHECK_TYPE_SIGSET_T])
if test $gl_cv_type_sigset_t = yes; then
AC_CHECK_FUNC([sigprocmask], [gl_cv_func_sigprocmask=1])
fi
if test -z "$gl_cv_func_sigprocmask"; then
HAVE_POSIX_SIGNALBLOCKING=0
fi
])
# Prerequisites of lib/sigprocmask.c.
AC_DEFUN([gl_PREREQ_SIGPROCMASK], [
AC_REQUIRE([AC_C_INLINE])
])

2
m4/stat-time.m4
View File

@ -19,7 +19,6 @@ dnl From Paul Eggert.
AC_DEFUN([gl_STAT_TIME],
[
AC_REQUIRE([AC_C_INLINE])
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
AC_CHECK_HEADERS_ONCE([sys/time.h])
@ -70,7 +69,6 @@ AC_DEFUN([gl_STAT_TIME],
#
AC_DEFUN([gl_STAT_BIRTHTIME],
[
AC_REQUIRE([AC_C_INLINE])
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
AC_CHECK_HEADERS_ONCE([sys/time.h])
AC_CHECK_MEMBERS([struct stat.st_birthtimespec.tv_nsec], [],

8
m4/timespec.m4
View File

@ -1,4 +1,4 @@
#serial 14
#serial 15
# Copyright (C) 2000-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
@ -8,8 +8,4 @@
dnl From Jim Meyering
AC_DEFUN([gl_TIMESPEC],
[
dnl Prerequisites of lib/timespec.h.
AC_REQUIRE([AC_C_INLINE])
])
AC_DEFUN([gl_TIMESPEC], [:])

10
src/.gdbinit
View File

@ -18,9 +18,9 @@
# Boston, MA 02110-1301, USA.
# Force loading of symbols, enough to give us VALBITS etc.
set main
set $dummy = main + 8
# With some compilers, we need this to give us struct Lisp_Symbol etc.:
set Fmake_symbol
set $dummy = Fmake_symbol + 8
# Find lwlib source files too.
dir ../lwlib
@ -89,7 +89,7 @@ define pp
set $tmp = $arg0
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
set safe_debug_print ($tmp)
call safe_debug_print ($tmp)
set print_output_debug_flag = $output_debug
end
document pp
@ -102,7 +102,7 @@ define pv
set $tmp = "$arg0"
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
set safe_debug_print (find_symbol_value (intern ($tmp)))
call safe_debug_print (find_symbol_value (intern ($tmp)))
set print_output_debug_flag = $output_debug
end
document pv
@ -1162,7 +1162,7 @@ end
define xwhichsymbols
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
set safe_debug_print (which_symbols ($arg0, $arg1))
call safe_debug_print (which_symbols ($arg0, $arg1))
set print_output_debug_flag = $output_debug
end
document xwhichsymbols

365
src/ChangeLog
View File

@ -1,3 +1,368 @@
2012-08-22 Paul Eggert <eggert@cs.ucla.edu>
* fontset.c (FONTSET_ADD): Return void, not Lisp_Object.
Otherwise, the compiler complains about (A?B:C) where B is void
and C is Lisp_Object. This fixes an incompatibility with Sun C 5.12.
(fontset_add): Return void, for FONTSET_ADD.
2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
* alloc.c: Use bool for booleans.
(gc_in_progress, abort_on_gc)
(setjmp_tested_p) [!GC_SAVE_REGISTERS_ON_STACK && !GC_SETJMP_WORKS]:
(dont_register_blocks) [GC_MALLOC_CHECK]:
(suppress_checking) [ENABLE_CHECKING]: Now bool, not int.
(check_string_bytes, make_specified_string, memory_full)
(live_string_p, live_cons_p, live_symbol_p, live_float_p)
(live_misc_p, live_vector_p, live_buffer_p, mark_maybe_object)
(mark_stack, valid_pointer_p, make_pure_string)
(Fgarbage_collect, survives_gc_p, gc_sweep):
Use bool for booleans, instead of int.
(test_setjmp) [!GC_SAVE_REGISTERS_ON_STACK && !GC_SETJMP_WORKS]:
Remove unused local.
* alloc.c (PURE_POINTER_P):
* lisp.h (STRING_MULTIBYTE): Document that it returns a boolean.
* editfns.c (Fformat):
* fileio.c (Fexpand_file_name, Fsubstitute_in_file_name)
(Fdo_auto_save):
* fns.c (sweep_weak_table):
* lisp.h (suppress_checking, push_message, survives_gc_p)
(make_pure_string, gc_in_progress, abort_on_gc):
* lread.c (readchar, read1):
* print.c (Fprin1_to_string):
* xdisp.c (push_message):
Use bool for booleans affected directly or indirectly by
alloc.c's changes.
Make recently-introduced setters macros.
* fontset.c (set_fontset_id, set_fontset_name, set_fontset_ascii)
(set_fontset_base, set_fontset_frame, set_fontset_nofont_face)
(set_fontset_default, set_fontset_fallback): Rename from their
upper-case counterparts, and make them functions rather than macros.
This is more consistent with the other recently-introduced setters.
These don't need to be inline, since they're local.
2012-08-21 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (fd_handler:): Alloc and release a NSAutoreleasePool in
the loop (Bug#12247).
2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
* lisp.h (vcopy): Use memcpy rather than our own loop.
This fixes a performance regression introduced by the recent
addition of vcopy. This means 'vcopy' will need to be modified
for a copying collector, but that's OK. Also, tighten the
checking in the assertion.
2012-08-21 Eli Zaretskii <eliz@gnu.org>
* w32uniscribe.c (uniscribe_shape): Fix producing gstring
components for RTL text (Bug#11860). Adjust X-OFFSET of each
non-base glyph for the width of the base character, according to
what x_draw_composite_glyph_string_foreground expects. Generate
WADJUST value according to composition_gstring_width's
expectations, to produce correct width of the composed character.
Reverse the sign of the DU offset produced by ScriptPlace.
2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
* dbusbind.c (xd_remove_watch): Do not assume C99 comments.
2012-08-21 Dmitry Antipov <dmantipov@yandex.ru>
Avoid direct writes to contents member of struct Lisp_Vector.
* lisp.h (vcopy): New function to copy data into vector.
* dispnew.c (Fframe_or_buffer_changed_p): Use AREF and ASET.
* fns.c (Ffillarray): Use ASET.
* keyboard.c (timer_check_2): Use AREF and ASET.
(append_tool_bar_item, Frecent_keys): Use vcopy.
* lread.c (read_vector): Use ASET.
* msdos.c (Frecent_doskeys): Use vcopy.
* xface.c (Finternal_copy_lisp_face): Use vcopy.
(Finternal_merge_in_global_face): Use ASET and vcopy.
* xfont.c (xfont_list_pattern): Likewise.
2012-08-21 Martin Rudalics <rudalics@gmx.at>
* window.c (Fwindow_point): For the selected window always return
the position of its buffer's point.
(Fset_window_point): For the selected window always go in its
buffer to the specified position.
2012-08-21 Dmitry Antipov <dmantipov@yandex.ru>
Setter macros for fontsets.
* fontset.c (SET_FONTSET_ID, SET_FONTSET_NAME, SET_FONTSET_ASCII)
(SET_FONTSET_BASE, SET_FONTSET_FRAME, SET_FONTSET_NOFONT_FACE)
(SET_FONTSET_DEFAULT, SET_FONTSET_FALLBACK): New macros.
Adjust users.
2012-08-20 Glenn Morris <rgm@gnu.org>
* Makefile.in (emacs$(EXEEXT), bootstrap-emacs$(EXEEXT)):
Don't assume that `ln -f' works.
2012-08-20 Eli Zaretskii <eliz@gnu.org>
* .gdbinit: Use "set $dummy = ..." to avoid warnings from GDB 7.5
and later about non-assignments with no effect. See discussion at
http://sourceware.org/ml/gdb-patches/2012-08/msg00518.html for
details.
2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
Inline setter functions for Lisp_Objects slots of struct specbinding.
* eval.c (set_specpdl_symbol, set_specpdl_old_value): New functions.
Adjust users.
2012-08-20 Martin Rudalics <rudalics@gmx.at>
* window.c (select_window): Always make selected window's buffer
current.
2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
Use AREF and ASET for docstrings of category tables.
* category.h (CATEGORY_DOCSTRING): Use AREF.
(SET_CATEGORY_DOCSTRING): Use ASET.
* category.c (Fdefine_category): Use SET_CATEGORY_DOCSTRING.
2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
Inline setter functions for hash table members.
* lisp.h (set_hash_key, set_hash_value, set_hash_next)
(set_hash_hash, set_hash_index): Rename with _slot suffix.
(set_hash_key_and_value, set_hash_index, set_hash_next)
(set_hash_hash): New functions.
* charset.c, fns.c: Adjust users.
2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
Inline getter and setter functions for per-buffer values.
* buffer.h (per_buffer_default, set_per_buffer_default)
(per_buffer_value, set_per_buffer_value): New functions.
(PER_BUFFER_VALUE, PER_BUFFER_DEFAULT): Remove.
* buffer.c, data.c: Adjust users.
2012-08-20 Juanma Barranquero <lekktu@gmail.com>
* makefile.w32-in ($(BLD)/vm-limit.$(O)): Update dependencies.
2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
Rely on <config.h> + <unistd.h> to declare 'environ',
as gnulib does this if the system doesn't.
* callproc.c, editfns.c, process.c (environ) [!USE_CRT_DLL]:
Remove declaration. MS-Windows declares it on stdlib.h which is
included by conf_post.h.
* emacs.c (environ) [DOUG_LEA_MALLOC]:
* vm-limit.c (environ) [ORDINARY_LINK]: Remove decl.
* vm-limit.c: Include <unistd.h>, for 'environ'.
* unexaix.c, unexcoff.c: Include "mem-limits.h".
(start_of_data): Remove decl; mem-limits.h provides it.
* xdisp.c (handle_invisible_prop): Make it a bit faster
and avoid a gcc -Wmaybe-uninitialized diagnostic.
2012-08-19 Chong Yidong <cyd@gnu.org>
* xdisp.c (handle_invisible_prop): Fix ellipses at overlay string
ends (Bug#3874).
2012-08-19 Andreas Schwab <schwab@linux-m68k.org>
* .gdbinit: Use call instead of set when calling a function in the
inferior.
* data.c (set_internal): Don't use set_blv_found.
(Fkill_local_variable): Likewise.
2012-08-18 Alp Aker <alp.tekin.aker@gmail.com>
* nsfont.m (ns_ascii_average_width): Ensure the string
ascii_printable is initialized with a null-terminated character
array. Otherwise, it can contain undesired extra characters.
2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
port new setting code to Sun C 5.8 2005/10/13
* chartab.c, lisp.h (char_table_set, char_table_set_range):
Return void, not Lisp_Object. Otherwise, the compiler
complains about (A?B:C) where B is void and C is Lisp_Object
when compiling CHAR_TABLE_SET, due to the recent change to
the API of sub_char_table_set_contents.
2012-08-18 Chong Yidong <cyd@gnu.org>
* xdisp.c (handle_invisible_prop): Obey TEXT_PROP_MEANS_INVISIBLE
for the string case (Bug#3874).
2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
* buffer.h (BSET): Remove (Bug#12215).
Replace all uses with calls to new setter functions.
(bset_bidi_paragraph_direction, bset_case_canon_table)
(bset_case_eqv_table, bset_directory, bset_display_count)
(bset_display_time, bset_downcase_table)
(bset_enable_multibyte_characters, bset_filename, bset_keymap)
(bset_last_selected_window, bset_local_var_alist)
(bset_mark_active, bset_point_before_scroll, bset_read_only)
(bset_truncate_lines, bset_undo_list, bset_upcase_table)
(bset_width_table):
* buffer.c (bset_abbrev_mode, bset_abbrev_table)
(bset_auto_fill_function, bset_auto_save_file_format)
(bset_auto_save_file_name, bset_backed_up, bset_begv_marker)
(bset_bidi_display_reordering, bset_buffer_file_coding_system)
(bset_cache_long_line_scans, bset_case_fold_search)
(bset_ctl_arrow, bset_cursor_in_non_selected_windows)
(bset_cursor_type, bset_display_table, bset_extra_line_spacing)
(bset_file_format, bset_file_truename, bset_fringe_cursor_alist)
(bset_fringe_indicator_alist, bset_fringes_outside_margins)
(bset_header_line_format, bset_indicate_buffer_boundaries)
(bset_indicate_empty_lines, bset_invisibility_spec)
(bset_left_fringe_width, bset_major_mode, bset_mark)
(bset_minor_modes, bset_mode_line_format, bset_mode_name)
(bset_name, bset_overwrite_mode, bset_pt_marker)
(bset_right_fringe_width, bset_save_length)
(bset_scroll_bar_width, bset_scroll_down_aggressively)
(bset_scroll_up_aggressively, bset_selective_display)
(bset_selective_display_ellipses, bset_vertical_scroll_bar_type)
(bset_word_wrap, bset_zv_marker):
* category.c (bset_category_table):
* syntax.c (bset_syntax_table):
New setter functions.
* process.h (PSET): Remove (Bug#12215).
Replace all uses with calls to new setter functions.
Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
(PROCESS_INLINE): New macro.
(pset_childp): New setter function.
(pset_gnutls_cred_type) [HAVE_GNUTLS]: New setter function.
* process.c (PROCESS_INLINE):
Define to EXTERN_INLINE, so that the corresponding functions
are compiled into code.
(pset_buffer, pset_command, pset_decode_coding_system)
(pset_decoding_buf, pset_encode_coding_system)
(pset_encoding_buf, pset_filter, pset_log, pset_mark, pset_name)
(pset_plist, pset_sentinel, pset_status, pset_tty_name)
(pset_type, pset_write_queue): New setter functions.
* window.h (WSET): Remove (Bug#12215).
Replace all uses with calls to new setter functions.
Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
(WINDOW_INLINE): New macro.
(wset_buffer, wset_frame, wset_left_col, wset_next, wset_prev)
(wset_redisplay_end_trigger, wset_top_line, wset_total_cols)
(wset_total_lines, wset_vertical_scroll_bar)
(wset_window_end_pos, wset_window_end_valid)
(wset_window_end_vpos): New setter functions.
* window.c (WINDOW_INLINE):
Define to EXTERN_INLINE, so that the corresponding functions
are compiled into code.
(wset_combination_limit, wset_dedicated, wset_display_table)
(wset_hchild, wset_left_fringe_width, wset_left_margin_cols)
(wset_new_normal, wset_new_total, wset_next_buffers)
(wset_normal_cols, wset_normal_lines, wset_parent, wset_pointm)
(wset_prev_buffers, wset_right_fringe_width)
(wset_right_margin_cols, wset_scroll_bar_width, wset_start)
(wset_temslot, wset_vchild, wset_vertical_scroll_bar_type)
(wset_window_parameters):
* xdisp.c (wset_base_line_number, wset_base_line_pos)
(wset_column_number_displayed, wset_region_showing):
New setter functions.
* termhooks.h (TSET): Remove (Bug#12215).
Replace all uses with calls to new setter functions.
Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
(TERMHOOKS_INLINE): New macro.
(tset_charset_list, tset_selection_alist): New setter functions.
* terminal.c (TERMHOOKS_INLINE):
Define to EXTERN_INLINE, so that the corresponding functions
are compiled into code.
(tset_param_alist): New setter function.
2012-08-17 Paul Eggert <eggert@cs.ucla.edu>
* keyboard.h (KSET): Remove (Bug#12215).
Replace all uses with calls to new setter functions.
Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
(KEYBOARD_INLINE): New macro.
(kset_default_minibuffer_frame, kset_defining_kbd_macro)
(kset_input_decode_map, kset_last_command, kset_last_kbd_macro)
(kset_prefix_arg, kset_system_key_alist, kset_window_system):
New setter functions.
* keyboard.c (KEYBOARD_INLINE):
Define to EXTERN_INLINE, so that the corresponding functions
are compiled into code.
(kset_echo_string, kset_kbd_queue)
(kset_keyboard_translate_table, kset_last_prefix_arg)
(kset_last_repeatable_command, kset_local_function_key_map)
(kset_overriding_terminal_local_map, kset_real_last_command)
(kset_system_key_syms): New setter functions.
* frame.h (FSET): Remove (Bug#12215).
Replace all uses with calls to new setter functions.
Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
(FRAME_INLINE): New macro.
(fset_buffer_list, fset_buried_buffer_list, fset_condemned_scroll_bars)
(fset_current_tool_bar_string, fset_desired_tool_bar_string)
(fset_face_alist, fset_focus_frame, fset_icon_name, fset_menu_bar_items)
(fset_menu_bar_vector, fset_menu_bar_window, fset_name)
(fset_param_alist, fset_root_window, fset_scroll_bars)
(fset_selected_window, fset_title, fset_tool_bar_items)
(fset_tool_bar_position, fset_tool_bar_window): New functions.
* frame.c (FRAME_INLINE):
Define to EXTERN_INLINE, so that the corresponding functions
are compiled into code.
(fset_buffer_predicate, fset_minibuffer_window): New setter functions.
A few more naming-convention fixes for getters and setters.
* buffer.c (set_buffer_overlays_before): Move here from buffer.h,
and rename from buffer_overlays_set_before.
(set_buffer_overlays_after): Move here from buffer.h, and rename
from buffer_overlays_set_after.
* buffer.h (buffer_intervals): Rename from buffer_get_intervals.
All uses changed.
(set_buffer_intervals): Rename from buffer_set_intervals.
* intervals.c (set_interval_object): Move here from intervals.h,
and rename from interval_set_object.
(set_interval_left): Move here from intervals.h, and rename from
interval_set_left.
(set_interval_right): Move here from intervals.h, and rename from
interval_set_right.
(copy_interval_parent): Move here from intervals.h, and rename from
interval_copy_parent.
* intervals.h (set_interval_parent): Rename from interval_set_parent.
(set_interval_plist): Rename from interval_set_plist.
Return void, not Lisp_Object, since no caller uses the result.
* lisp.h (string_intervals): Rename from string_get_intervals.
(set_string_intervals): Rename from string_set_intervals.
* lisp.h (set_char_table_extras): Rename from char_table_set_extras.
(set_char_table_contents): Rename from char_table_set_contents.
(set_sub_char_table_contents): Rename from sub_char_table_set_contents.
All uses changed. See the end of
<http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00549.html>.
* lisp.h (CSET): Remove (Bug#12215).
(set_char_table_ascii, set_char_table_defalt, set_char_table_parent)
(set_char_table_purpose): New functions,
replacing CSET. All uses changed. For example, replace
"CSET (XCHAR_TABLE (char_table), parent, parent);" with
"set_char_table_parent (char_table, parent);".
The old version was confusing because it used the same name
'parent' for two different things.
2012-08-17 Dmitry Antipov <dmantipov@yandex.ru>
Functions to get and set Lisp_Object fields of buffer-local variables.
* lisp.h (blv_found, set_blv_found, blv_value, set_blv_value)
(set_blv_where, set_blv_defcell, set_blv_valcell): New functions.
(BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): Remove.
* data.c, eval.c, frame.c: Adjust users.
2012-08-17 Chong Yidong <cyd@gnu.org>
* xfaces.c (merge_face_vectors): If the target font specfies a

9
src/Makefile.in
View File

@ -402,11 +402,13 @@ $(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
## on all of $lisp, and emacs depends on DOC, so it is ok to use $lisp here.
emacs$(EXEEXT): temacs$(EXEEXT) $(etc)/DOC $(lisp) $(leimdir)/leim-list.el
if test "$(CANNOT_DUMP)" = "yes"; then \
ln -f temacs$(EXEEXT) emacs$(EXEEXT); \
rm -f emacs$(EXEEXT); \
ln temacs$(EXEEXT) emacs$(EXEEXT); \
else \
LC_ALL=C $(RUN_TEMACS) -batch -l loadup dump || exit 1; \
test "X$(PAXCTL)" = X || $(PAXCTL) -zex emacs$(EXEEXT); \
ln -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
rm -f bootstrap-emacs$(EXEEXT); \
ln emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
fi
## We run make-docfile twice because the command line may get too long
@ -600,7 +602,8 @@ $(lispsource)/loaddefs.el: $(BOOTSTRAPEMACS) $(VCSWITNESS)
bootstrap-emacs$(EXEEXT): temacs$(EXEEXT)
cd ../lisp; $(MAKE) $(MFLAGS) update-subdirs
if test "$(CANNOT_DUMP)" = "yes"; then \
ln -f temacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
rm -f bootstrap-emacs$(EXEEXT); \
ln temacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
else \
$(RUN_TEMACS) --batch --load loadup bootstrap || exit 1; \
test "X$(PAXCTL)" = X || $(PAXCTL) -zex emacs$(EXEEXT); \

86
src/alloc.c
View File

@ -173,15 +173,15 @@ EMACS_INT gc_relative_threshold;
EMACS_INT memory_full_cons_threshold;
/* Nonzero during GC. */
/* True during GC. */
int gc_in_progress;
bool gc_in_progress;
/* Nonzero means abort if try to GC.
/* True means abort if try to GC.
This is for code which is written on the assumption that
no GC will happen, so as to verify that assumption. */
int abort_on_gc;
bool abort_on_gc;
/* Number of live and free conses etc. */
@ -223,7 +223,7 @@ static ptrdiff_t pure_size;
static ptrdiff_t pure_bytes_used_before_overflow;
/* Value is non-zero if P points into pure space. */
/* True if P points into pure space. */
#define PURE_POINTER_P(P) \
((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size)
@ -392,13 +392,13 @@ static struct mem_node mem_z;
static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
static void lisp_free (void *);
static void mark_stack (void);
static int live_vector_p (struct mem_node *, void *);
static int live_buffer_p (struct mem_node *, void *);
static int live_string_p (struct mem_node *, void *);
static int live_cons_p (struct mem_node *, void *);
static int live_symbol_p (struct mem_node *, void *);
static int live_float_p (struct mem_node *, void *);
static int live_misc_p (struct mem_node *, void *);
static bool live_vector_p (struct mem_node *, void *);
static bool live_buffer_p (struct mem_node *, void *);
static bool live_string_p (struct mem_node *, void *);
static bool live_cons_p (struct mem_node *, void *);
static bool live_symbol_p (struct mem_node *, void *);
static bool live_float_p (struct mem_node *, void *);
static bool live_misc_p (struct mem_node *, void *);
static void mark_maybe_object (Lisp_Object);
static void mark_memory (void *, void *);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
@ -1241,7 +1241,7 @@ static void (*old_free_hook) (void*, const void*);
#endif
#ifdef GC_MALLOC_CHECK
static int dont_register_blocks;
static bool dont_register_blocks;
#endif
static size_t bytes_used_when_reconsidered;
@ -1828,11 +1828,11 @@ check_sblock (struct sblock *b)
/* Check validity of Lisp strings' string_bytes member. ALL_P
non-zero means check all strings, otherwise check only most
means check all strings, otherwise check only most
recently allocated strings. Used for hunting a bug. */
static void
check_string_bytes (int all_p)
check_string_bytes (bool all_p)
{
if (all_p)
{
@ -2437,9 +2437,9 @@ make_string_from_bytes (const char *contents,
Lisp_Object
make_specified_string (const char *contents,
ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
{
register Lisp_Object val;
Lisp_Object val;
if (nchars < 0)
{
@ -3094,7 +3094,7 @@ sweep_vectors (void)
for (block = vector_blocks; block; block = *bprev)
{
int free_this_block = 0;
bool free_this_block = 0;
for (vector = (struct Lisp_Vector *) block->data;
VECTOR_IN_BLOCK (vector, block); vector = next)
@ -3753,7 +3753,7 @@ void
memory_full (size_t nbytes)
{
/* Do not go into hysterics merely because a large request failed. */
int enough_free_memory = 0;
bool enough_free_memory = 0;
if (SPARE_MEMORY < nbytes)
{
void *p;
@ -4246,7 +4246,7 @@ mem_delete_fixup (struct mem_node *x)
/* Value is non-zero if P is a pointer to a live Lisp string on
the heap. M is a pointer to the mem_block for P. */
static inline int
static inline bool
live_string_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
@ -4269,7 +4269,7 @@ live_string_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp cons on
the heap. M is a pointer to the mem_block for P. */
static inline int
static inline bool
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
@ -4295,7 +4295,7 @@ live_cons_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp symbol on
the heap. M is a pointer to the mem_block for P. */
static inline int
static inline bool
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
@ -4321,7 +4321,7 @@ live_symbol_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp float on
the heap. M is a pointer to the mem_block for P. */
static inline int
static inline bool
live_float_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_FLOAT)
@ -4345,7 +4345,7 @@ live_float_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp Misc on
the heap. M is a pointer to the mem_block for P. */
static inline int
static inline bool
live_misc_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
@ -4371,7 +4371,7 @@ live_misc_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live vector-like object.
M is a pointer to the mem_block for P. */
static inline int
static inline bool
live_vector_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_VECTOR_BLOCK)
@ -4407,7 +4407,7 @@ live_vector_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
static inline int
static inline bool
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
@ -4487,7 +4487,7 @@ mark_maybe_object (Lisp_Object obj)
if (m != MEM_NIL)
{
int mark_p = 0;
bool mark_p = 0;
switch (XTYPE (obj))
{
@ -4707,7 +4707,8 @@ mark_memory (void *start, void *end)
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
static int setjmp_tested_p, longjmps_done;
static bool setjmp_tested_p;
static int longjmps_done;
#define SETJMP_WILL_LIKELY_WORK "\
\n\
@ -4751,7 +4752,6 @@ test_setjmp (void)
char buf[10];
register int x;
jmp_buf jbuf;
int result = 0;
/* Arrange for X to be put in a register. */
sprintf (buf, "1");
@ -4891,7 +4891,7 @@ mark_stack (void)
Lisp_Object o;
jmp_buf j;
} j;
volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base;
#endif
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
@ -4965,7 +4965,7 @@ valid_pointer_p (void *p)
if (pipe (fd) == 0)
{
int valid = (emacs_write (fd[1], (char *) p, 16) == 16);
bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
emacs_close (fd[1]);
emacs_close (fd[0]);
return valid;
@ -5186,7 +5186,7 @@ find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
/* Return a string allocated in pure space. DATA is a buffer holding
NCHARS characters, and NBYTES bytes of string data. MULTIBYTE
non-zero means make the result string multibyte.
means make the result string multibyte.
Must get an error if pure storage is full, since if it cannot hold
a large string it may be able to hold conses that point to that
@ -5194,7 +5194,7 @@ find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
Lisp_Object
make_pure_string (const char *data,
ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
{
Lisp_Object string;
struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
@ -5389,11 +5389,11 @@ returns nil, because real GC can't be done.
See Info node `(elisp)Garbage Collection'. */)
(void)
{
register struct specbinding *bind;
register struct buffer *nextb;
struct specbinding *bind;
struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
int message_p;
bool message_p;
ptrdiff_t count = SPECPDL_INDEX ();
EMACS_TIME start;
Lisp_Object retval = Qnil;
@ -5836,7 +5836,7 @@ mark_buffer (struct buffer *buffer)
/* ...but there are some buffer-specific things. */
MARK_INTERVAL_TREE (buffer_get_intervals (buffer));
MARK_INTERVAL_TREE (buffer_intervals (buffer));
/* For now, we just don't mark the undo_list. It's done later in
a special way just before the sweep phase, and after stripping
@ -6090,7 +6090,7 @@ mark_object (Lisp_Object arg)
}
if (!PURE_POINTER_P (XSTRING (ptr->name)))
MARK_STRING (XSTRING (ptr->name));
MARK_INTERVAL_TREE (string_get_intervals (ptr->name));
MARK_INTERVAL_TREE (string_intervals (ptr->name));
ptr = ptr->next;
if (ptr)
@ -6208,10 +6208,10 @@ mark_terminals (void)
/* Value is non-zero if OBJ will survive the current GC because it's
either marked or does not need to be marked to survive. */
int
bool
survives_gc_p (Lisp_Object obj)
{
int survives_p;
bool survives_p;
switch (XTYPE (obj))
{
@ -6405,7 +6405,7 @@ gc_sweep (void)
{
if (!iblk->intervals[i].gcmarkbit)
{
interval_set_parent (&iblk->intervals[i], interval_free_list);
set_interval_parent (&iblk->intervals[i], interval_free_list);
interval_free_list = &iblk->intervals[i];
this_free++;
}
@ -6456,7 +6456,7 @@ gc_sweep (void)
/* Check if the symbol was created during loadup. In such a case
it might be pointed to by pure bytecode which we don't trace,
so we conservatively assume that it is live. */
int pure_p = PURE_POINTER_P (XSTRING (sym->s.name));
bool pure_p = PURE_POINTER_P (XSTRING (sym->s.name));
if (!sym->s.gcmarkbit && !pure_p)
{
@ -6681,7 +6681,7 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max)
}
#ifdef ENABLE_CHECKING
int suppress_checking;
bool suppress_checking;
void
die (const char *msg, const char *file, int line)

591
src/buffer.c
View File

@ -157,6 +157,228 @@ static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay
static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
static Lisp_Object buffer_lisp_local_variables (struct buffer *, int);
/* These setters are used only in this file, so they can be private. */
static inline void
bset_abbrev_mode (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (abbrev_mode) = val;
}
static inline void
bset_abbrev_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (abbrev_table) = val;
}
static inline void
bset_auto_fill_function (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (auto_fill_function) = val;
}
static inline void
bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (auto_save_file_format) = val;
}
static inline void
bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (auto_save_file_name) = val;
}
static inline void
bset_backed_up (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (backed_up) = val;
}
static inline void
bset_begv_marker (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (begv_marker) = val;
}
static inline void
bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (bidi_display_reordering) = val;
}
static inline void
bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (buffer_file_coding_system) = val;
}
static inline void
bset_cache_long_line_scans (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (cache_long_line_scans) = val;
}
static inline void
bset_case_fold_search (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (case_fold_search) = val;
}
static inline void
bset_ctl_arrow (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (ctl_arrow) = val;
}
static inline void
bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val;
}
static inline void
bset_cursor_type (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (cursor_type) = val;
}
static inline void
bset_display_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (display_table) = val;
}
static inline void
bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (extra_line_spacing) = val;
}
static inline void
bset_file_format (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (file_format) = val;
}
static inline void
bset_file_truename (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (file_truename) = val;
}
static inline void
bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (fringe_cursor_alist) = val;
}
static inline void
bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (fringe_indicator_alist) = val;
}
static inline void
bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (fringes_outside_margins) = val;
}
static inline void
bset_header_line_format (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (header_line_format) = val;
}
static inline void
bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (indicate_buffer_boundaries) = val;
}
static inline void
bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (indicate_empty_lines) = val;
}
static inline void
bset_invisibility_spec (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (invisibility_spec) = val;
}
static inline void
bset_left_fringe_width (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (left_fringe_width) = val;
}
static inline void
bset_major_mode (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (major_mode) = val;
}
static inline void
bset_mark (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (mark) = val;
}
static inline void
bset_minor_modes (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (minor_modes) = val;
}
static inline void
bset_mode_line_format (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (mode_line_format) = val;
}
static inline void
bset_mode_name (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (mode_name) = val;
}
static inline void
bset_name (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (name) = val;
}
static inline void
bset_overwrite_mode (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (overwrite_mode) = val;
}
static inline void
bset_pt_marker (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (pt_marker) = val;
}
static inline void
bset_right_fringe_width (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (right_fringe_width) = val;
}
static inline void
bset_save_length (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (save_length) = val;
}
static inline void
bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (scroll_bar_width) = val;
}
static inline void
bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (scroll_down_aggressively) = val;
}
static inline void
bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (scroll_up_aggressively) = val;
}
static inline void
bset_selective_display (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (selective_display) = val;
}
static inline void
bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (selective_display_ellipses) = val;
}
static inline void
bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (vertical_scroll_bar_type) = val;
}
static inline void
bset_word_wrap (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (word_wrap) = val;
}
static inline void
bset_zv_marker (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (zv_marker) = val;
}
/* For debugging; temporary. See set_buffer_internal. */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
@ -360,7 +582,7 @@ even if it is dead. The return value is never nil. */)
BUF_CHARS_MODIFF (b) = 1;
BUF_OVERLAY_MODIFF (b) = 1;
BUF_SAVE_MODIFF (b) = 1;
buffer_set_intervals (b, NULL);
set_buffer_intervals (b, NULL);
BUF_UNCHANGED_MODIFIED (b) = 1;
BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
BUF_END_UNCHANGED (b) = 0;
@ -370,7 +592,7 @@ even if it is dead. The return value is never nil. */)
b->newline_cache = 0;
b->width_run_cache = 0;
BSET (b, width_table, Qnil);
bset_width_table (b, Qnil);
b->prevent_redisplay_optimizations_p = 1;
/* Put this on the chain of all buffers including killed ones. */
@ -379,20 +601,20 @@ even if it is dead. The return value is never nil. */)
/* An ordinary buffer normally doesn't need markers
to handle BEGV and ZV. */
BSET (b, pt_marker, Qnil);
BSET (b, begv_marker, Qnil);
BSET (b, zv_marker, Qnil);
bset_pt_marker (b, Qnil);
bset_begv_marker (b, Qnil);
bset_zv_marker (b, Qnil);
name = Fcopy_sequence (buffer_or_name);
string_set_intervals (name, NULL);
BSET (b, name, name);
set_string_intervals (name, NULL);
bset_name (b, name);
BSET (b, undo_list, (SREF (name, 0) != ' ') ? Qnil : Qt);
bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
reset_buffer (b);
reset_buffer_local_variables (b, 1);
BSET (b, mark, Fmake_marker ());
bset_mark (b, Fmake_marker ());
BUF_MARKERS (b) = NULL;
/* Put this in the alist of all live buffers. */
@ -439,6 +661,19 @@ copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
return result;
}
/* Set an appropriate overlay of B. */
static inline void
set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
{
b->overlays_before = o;
}
static inline void
set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
{
b->overlays_after = o;
}
/* Clone per-buffer values of buffer FROM.
@ -460,7 +695,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to)
if (offset == PER_BUFFER_VAR_OFFSET (name))
continue;
obj = PER_BUFFER_VALUE (from, offset);
obj = per_buffer_value (from, offset);
if (MARKERP (obj) && XMARKER (obj)->buffer == from)
{
struct Lisp_Marker *m = XMARKER (obj);
@ -469,17 +704,17 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to)
XMARKER (obj)->insertion_type = m->insertion_type;
}
PER_BUFFER_VALUE (to, offset) = obj;
set_per_buffer_value (to, offset, obj);
}
memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
buffer_set_overlays_before (to, copy_overlays (to, from->overlays_before));
buffer_set_overlays_after (to, copy_overlays (to, from->overlays_after));
set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
/* Get (a copy of) the alist of Lisp-level local variables of FROM
and install that in TO. */
BSET (to, local_var_alist, buffer_lisp_local_variables (from, 1));
bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
}
@ -582,15 +817,15 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
b->newline_cache = 0;
b->width_run_cache = 0;
BSET (b, width_table, Qnil);
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);
string_set_intervals (name, NULL);
BSET (b, name, name);
set_string_intervals (name, NULL);
bset_name (b, name);
reset_buffer (b);
reset_buffer_local_variables (b, 1);
@ -599,10 +834,11 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
XSETBUFFER (buf, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
BSET (b, mark, Fmake_marker ());
bset_mark (b, Fmake_marker ());
/* The multibyte status belongs to the base buffer. */
BSET (b, enable_multibyte_characters, BVAR (b->base_buffer, enable_multibyte_characters));
bset_enable_multibyte_characters
(b, BVAR (b->base_buffer, enable_multibyte_characters));
/* Make sure the base buffer has markers for its narrowing. */
if (NILP (BVAR (b->base_buffer, pt_marker)))
@ -610,14 +846,17 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
eassert (NILP (BVAR (b->base_buffer, begv_marker)));
eassert (NILP (BVAR (b->base_buffer, zv_marker)));
BSET (b->base_buffer, pt_marker,
build_marker (b->base_buffer, b->base_buffer->pt, b->base_buffer->pt_byte));
bset_pt_marker (b->base_buffer,
build_marker (b->base_buffer, b->base_buffer->pt,
b->base_buffer->pt_byte));
BSET (b->base_buffer, begv_marker,
build_marker (b->base_buffer, b->base_buffer->begv, b->base_buffer->begv_byte));
bset_begv_marker (b->base_buffer,
build_marker (b->base_buffer, b->base_buffer->begv,
b->base_buffer->begv_byte));
BSET (b->base_buffer, zv_marker,
build_marker (b->base_buffer, b->base_buffer->zv, b->base_buffer->zv_byte));
bset_zv_marker (b->base_buffer,
build_marker (b->base_buffer, b->base_buffer->zv,
b->base_buffer->zv_byte));
XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
}
@ -625,9 +864,9 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
if (NILP (clone))
{
/* Give the indirect buffer markers for its narrowing. */
BSET (b, pt_marker, build_marker (b, b->pt, b->pt_byte));
BSET (b, begv_marker, build_marker (b, b->begv, b->begv_byte));
BSET (b, zv_marker, build_marker (b, b->zv, b->zv_byte));
bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
}
else
@ -635,11 +874,11 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
struct buffer *old_b = current_buffer;
clone_per_buffer_values (b->base_buffer, b);
BSET (b, filename, Qnil);
BSET (b, file_truename, Qnil);
BSET (b, display_count, make_number (0));
BSET (b, backed_up, Qnil);
BSET (b, auto_save_file_name, Qnil);
bset_filename (b, Qnil);
bset_file_truename (b, Qnil);
bset_display_count (b, make_number (0));
bset_backed_up (b, Qnil);
bset_auto_save_file_name (b, Qnil);
set_buffer_internal_1 (b);
Fset (intern ("buffer-save-without-query"), Qnil);
Fset (intern ("buffer-file-number"), Qnil);
@ -688,8 +927,8 @@ delete_all_overlays (struct buffer *b)
ov->next = NULL;
}
buffer_set_overlays_before (b, NULL);
buffer_set_overlays_after (b, NULL);
set_buffer_overlays_before (b, NULL);
set_buffer_overlays_after (b, NULL);
}
/* Reinitialize everything about a buffer except its name and contents
@ -702,10 +941,9 @@ delete_all_overlays (struct buffer *b)
void
reset_buffer (register struct buffer *b)
{
BSET (b, filename, Qnil);
BSET (b, file_truename, Qnil);
BSET (b, directory,
(current_buffer) ? BVAR (current_buffer, directory) : Qnil);
bset_filename (b, Qnil);
bset_file_truename (b, Qnil);
bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
b->modtime_size = -1;
XSETFASTINT (BVAR (b, save_length), 0);
@ -713,25 +951,25 @@ reset_buffer (register struct buffer *b)
/* It is more conservative to start out "changed" than "unchanged". */
b->clip_changed = 0;
b->prevent_redisplay_optimizations_p = 1;
BSET (b, backed_up, Qnil);
bset_backed_up (b, Qnil);
BUF_AUTOSAVE_MODIFF (b) = 0;
b->auto_save_failure_time = 0;
BSET (b, auto_save_file_name, Qnil);
BSET (b, read_only, Qnil);
buffer_set_overlays_before (b, NULL);
buffer_set_overlays_after (b, NULL);
bset_auto_save_file_name (b, Qnil);
bset_read_only (b, Qnil);
set_buffer_overlays_before (b, NULL);
set_buffer_overlays_after (b, NULL);
b->overlay_center = BEG;
BSET (b, mark_active, Qnil);
BSET (b, point_before_scroll, Qnil);
BSET (b, file_format, Qnil);
BSET (b, auto_save_file_format, Qt);
BSET (b, last_selected_window, Qnil);
BSET (b, display_count, make_number (0));
BSET (b, display_time, Qnil);
BSET (b, enable_multibyte_characters,
BVAR (&buffer_defaults, enable_multibyte_characters));
BSET (b, cursor_type, BVAR (&buffer_defaults, cursor_type));
BSET (b, extra_line_spacing, BVAR (&buffer_defaults, extra_line_spacing));
bset_mark_active (b, Qnil);
bset_point_before_scroll (b, Qnil);
bset_file_format (b, Qnil);
bset_auto_save_file_format (b, Qt);
bset_last_selected_window (b, Qnil);
bset_display_count (b, make_number (0));
bset_display_time (b, Qnil);
bset_enable_multibyte_characters
(b, BVAR (&buffer_defaults, enable_multibyte_characters));
bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
b->display_error_modiff = 0;
}
@ -755,10 +993,10 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
things that depend on the major mode.
default-major-mode is handled at a higher level.
We ignore it here. */
BSET (b, major_mode, Qfundamental_mode);
BSET (b, keymap, Qnil);
BSET (b, mode_name, QSFundamental);
BSET (b, minor_modes, Qnil);
bset_major_mode (b, Qfundamental_mode);
bset_keymap (b, Qnil);
bset_mode_name (b, QSFundamental);
bset_minor_modes (b, Qnil);
/* If the standard case table has been altered and invalidated,
fix up its insides first. */
@ -767,15 +1005,15 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
&& CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
Fset_standard_case_table (Vascii_downcase_table);
BSET (b, downcase_table, Vascii_downcase_table);
BSET (b, upcase_table, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
BSET (b, case_canon_table, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
BSET (b, case_eqv_table, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
BSET (b, invisibility_spec, Qt);
bset_downcase_table (b, Vascii_downcase_table);
bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
bset_invisibility_spec (b, Qt);
/* Reset all (or most) per-buffer variables to their defaults. */
if (permanent_too)
BSET (b, local_var_alist, Qnil);
bset_local_var_alist (b, Qnil);
else
{
Lisp_Object tmp, prop, last = Qnil;
@ -809,7 +1047,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
}
/* Delete this local variable. */
else if (NILP (last))
BSET (b, local_var_alist, XCDR (tmp));
bset_local_var_alist (b, XCDR (tmp));
else
XSETCDR (last, XCDR (tmp));
}
@ -825,7 +1063,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
if ((idx > 0
&& (permanent_too
|| buffer_permanent_local_flags[idx] == 0)))
PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
set_per_buffer_value (b, offset, per_buffer_default (offset));
}
}
@ -1001,7 +1239,7 @@ buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer)
{
union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (fwd))
result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
else
result = Fdefault_value (variable);
break;
@ -1081,7 +1319,7 @@ No argument or nil as argument means use current buffer as BUFFER. */)
&& SYMBOLP (PER_BUFFER_SYMBOL (offset)))
{
Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
Lisp_Object val = PER_BUFFER_VALUE (buf, offset);
Lisp_Object val = per_buffer_value (buf, offset);
result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
result);
}
@ -1286,7 +1524,7 @@ This does not change the name of the visited file (if any). */)
error ("Buffer name `%s' is in use", SDATA (newname));
}
BSET (current_buffer, name, newname);
bset_name (current_buffer, newname);
/* Catch redisplay's attention. Unless we do this, the mode lines for
any windows displaying current_buffer will stay unchanged. */
@ -1431,7 +1669,7 @@ No argument or nil as argument means do this for the current buffer. */)
}
if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
BSET (XBUFFER (real_buffer), undo_list, Qnil);
bset_undo_list (XBUFFER (real_buffer), Qnil);
return Qnil;
}
@ -1691,7 +1929,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
m = next;
}
BUF_MARKERS (b) = NULL;
buffer_set_intervals (b, NULL);
set_buffer_intervals (b, NULL);
/* Perhaps we should explicitly free the interval tree here... */
}
@ -1703,7 +1941,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
swap_out_buffer_local_variables (b);
reset_buffer_local_variables (b, 1);
BSET (b, name, Qnil);
bset_name (b, Qnil);
BLOCK_INPUT;
if (b->base_buffer)
@ -1727,9 +1965,9 @@ cleaning up all windows currently displaying the buffer to be killed. */)
free_region_cache (b->width_run_cache);
b->width_run_cache = 0;
}
BSET (b, width_table, Qnil);
bset_width_table (b, Qnil);
UNBLOCK_INPUT;
BSET (b, undo_list, Qnil);
bset_undo_list (b, Qnil);
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
@ -1770,8 +2008,8 @@ record_buffer (Lisp_Object buffer)
Vinhibit_quit = tem;
/* Update buffer list of selected frame. */
FSET (f, buffer_list, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
FSET (f, buried_buffer_list, Fdelq (buffer, f->buried_buffer_list));
fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
@ -1808,9 +2046,9 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
Vinhibit_quit = tem;
/* Update buffer lists of selected frame. */
FSET (f, buffer_list, Fdelq (buffer, f->buffer_list));
FSET (f, buried_buffer_list,
Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
fset_buried_buffer_list
(f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
@ -1910,7 +2148,7 @@ set_buffer_internal_1 (register struct buffer *b)
/* Put the undo list back in the base buffer, so that it appears
that an indirect buffer shares the undo list of its base. */
if (old_buf->base_buffer)
BSET (old_buf->base_buffer, undo_list, BVAR (old_buf, undo_list));
bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
/* If the old current buffer has markers to record PT, BEGV and ZV
when it is not current, update them now. */
@ -1920,7 +2158,7 @@ set_buffer_internal_1 (register struct buffer *b)
/* Get the undo list from the base buffer, so that it appears
that an indirect buffer shares the undo list of its base. */
if (b->base_buffer)
BSET (b, undo_list, BVAR (b->base_buffer, undo_list));
bset_undo_list (b, BVAR (b->base_buffer, undo_list));
/* If the new current buffer has markers to record PT, BEGV and ZV
when it is not current, fetch them now. */
@ -2118,8 +2356,8 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
#define swapfield_(field, type) \
do { \
type tmp##field = BVAR (other_buffer, field); \
BSET (other_buffer, field, BVAR (current_buffer, field)); \
BSET (current_buffer, field, tmp##field); \
bset_##field (other_buffer, BVAR (current_buffer, field)); \
bset_##field (current_buffer, tmp##field); \
} while (0)
swapfield (own_text, struct buffer_text);
@ -2159,8 +2397,8 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
swapfield_ (pt_marker, Lisp_Object);
swapfield_ (begv_marker, Lisp_Object);
swapfield_ (zv_marker, Lisp_Object);
BSET (current_buffer, point_before_scroll, Qnil);
BSET (other_buffer, point_before_scroll, Qnil);
bset_point_before_scroll (current_buffer, Qnil);
bset_point_before_scroll (other_buffer, Qnil);
current_buffer->text->modiff++; other_buffer->text->modiff++;
current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
@ -2249,7 +2487,7 @@ current buffer is cleared. */)
/* Don't record these buffer changes. We will put a special undo entry
instead. */
BSET (current_buffer, undo_list, Qt);
bset_undo_list (current_buffer, Qt);
/* If the cached position is for this buffer, clear it out. */
clear_charpos_cache (current_buffer);
@ -2271,7 +2509,7 @@ current buffer is cleared. */)
to calculate the old correspondences. */
set_intervals_multibyte (0);
BSET (current_buffer, enable_multibyte_characters, Qnil);
bset_enable_multibyte_characters (current_buffer, Qnil);
Z = Z_BYTE;
BEGV = BEGV_BYTE;
@ -2409,7 +2647,7 @@ current buffer is cleared. */)
/* Do this first, so that chars_in_text asks the right question.
set_intervals_multibyte needs it too. */
BSET (current_buffer, enable_multibyte_characters, Qt);
bset_enable_multibyte_characters (current_buffer, Qt);
GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
@ -2467,11 +2705,11 @@ current buffer is cleared. */)
if (!EQ (old_undo, Qt))
{
/* Represent all the above changes by a special undo entry. */
BSET (current_buffer, undo_list,
Fcons (list3 (Qapply,
intern ("set-buffer-multibyte"),
NILP (flag) ? Qt : Qnil),
old_undo));
bset_undo_list (current_buffer,
Fcons (list3 (Qapply,
intern ("set-buffer-multibyte"),
NILP (flag) ? Qt : Qnil),
old_undo));
}
UNGCPRO;
@ -3238,7 +3476,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
if (prev)
prev->next = next;
else
buffer_set_overlays_before (buf, next);
set_buffer_overlays_before (buf, next);
/* Search thru overlays_after for where to put it. */
other_prev = NULL;
@ -3260,7 +3498,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
if (other_prev)
other_prev->next = tail;
else
buffer_set_overlays_after (buf, tail);
set_buffer_overlays_after (buf, tail);
tail = prev;
}
else
@ -3296,7 +3534,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
if (prev)
prev->next = next;
else
buffer_set_overlays_after (buf, next);
set_buffer_overlays_after (buf, next);
/* Search thru overlays_before for where to put it. */
other_prev = NULL;
@ -3318,7 +3556,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
if (other_prev)
other_prev->next = tail;
else
buffer_set_overlays_before (buf, tail);
set_buffer_overlays_before (buf, tail);
tail = prev;
}
}
@ -3423,7 +3661,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
beforep = tail;
}
if (!parent)
buffer_set_overlays_before (current_buffer, tail->next);
set_buffer_overlays_before (current_buffer, tail->next);
else
parent->next = tail->next;
tail = tail->next;
@ -3469,7 +3707,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
beforep = tail;
}
if (!parent)
buffer_set_overlays_after (current_buffer, tail->next);
set_buffer_overlays_after (current_buffer, tail->next);
else
parent->next = tail->next;
tail = tail->next;
@ -3483,14 +3721,14 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
if (beforep)
{
beforep->next = current_buffer->overlays_before;
buffer_set_overlays_before (current_buffer, before_list);
set_buffer_overlays_before (current_buffer, before_list);
}
recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
if (afterp)
{
afterp->next = current_buffer->overlays_after;
buffer_set_overlays_after (current_buffer, after_list);
set_buffer_overlays_after (current_buffer, after_list);
}
recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
}
@ -3567,7 +3805,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
if (!right_pair)
{
found->next = bp->overlays_before;
buffer_set_overlays_before (bp, found);
set_buffer_overlays_before (bp, found);
}
else
{
@ -3645,13 +3883,13 @@ for the rear of the overlay advance when text is inserted there
{
if (b->overlays_after)
XOVERLAY (overlay)->next = b->overlays_after;
buffer_set_overlays_after (b, XOVERLAY (overlay));
set_buffer_overlays_after (b, XOVERLAY (overlay));
}
else
{
if (b->overlays_before)
XOVERLAY (overlay)->next = b->overlays_before;
buffer_set_overlays_before (b, XOVERLAY (overlay));
set_buffer_overlays_before (b, XOVERLAY (overlay));
}
/* This puts it in the right list, and in the right order. */
@ -3716,8 +3954,8 @@ unchain_both (struct buffer *b, Lisp_Object overlay)
{
struct Lisp_Overlay *ov = XOVERLAY (overlay);
buffer_set_overlays_before (b, unchain_overlay (b->overlays_before, ov));
buffer_set_overlays_after (b, unchain_overlay (b->overlays_after, ov));
set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
eassert (XOVERLAY (overlay)->next == NULL);
}
@ -3812,12 +4050,12 @@ buffer. */)
if (n_end < b->overlay_center)
{
XOVERLAY (overlay)->next = b->overlays_after;
buffer_set_overlays_after (b, XOVERLAY (overlay));
set_buffer_overlays_after (b, XOVERLAY (overlay));
}
else
{
XOVERLAY (overlay)->next = b->overlays_before;
buffer_set_overlays_before (b, XOVERLAY (overlay));
set_buffer_overlays_before (b, XOVERLAY (overlay));
}
/* This puts it in the right list, and in the right order. */
@ -4913,8 +5151,8 @@ init_buffer_once (void)
/* No one will share the text with these buffers, but let's play it safe. */
buffer_defaults.indirections = 0;
buffer_local_symbols.indirections = 0;
buffer_set_intervals (&buffer_defaults, NULL);
buffer_set_intervals (&buffer_local_symbols, NULL);
set_buffer_intervals (&buffer_defaults, NULL);
set_buffer_intervals (&buffer_local_symbols, NULL);
XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, pvecsize);
XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, pvecsize);
@ -4924,55 +5162,55 @@ init_buffer_once (void)
/* Must do these before making the first buffer! */
/* real setup is done in bindings.el */
BSET (&buffer_defaults, mode_line_format, build_pure_c_string ("%-"));
BSET (&buffer_defaults, header_line_format, Qnil);
BSET (&buffer_defaults, abbrev_mode, Qnil);
BSET (&buffer_defaults, overwrite_mode, Qnil);
BSET (&buffer_defaults, case_fold_search, Qt);
BSET (&buffer_defaults, auto_fill_function, Qnil);
BSET (&buffer_defaults, selective_display, Qnil);
BSET (&buffer_defaults, selective_display_ellipses, Qt);
BSET (&buffer_defaults, abbrev_table, Qnil);
BSET (&buffer_defaults, display_table, Qnil);
BSET (&buffer_defaults, undo_list, Qnil);
BSET (&buffer_defaults, mark_active, Qnil);
BSET (&buffer_defaults, file_format, Qnil);
BSET (&buffer_defaults, auto_save_file_format, Qt);
buffer_set_overlays_before (&buffer_defaults, NULL);
buffer_set_overlays_after (&buffer_defaults, NULL);
bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
bset_header_line_format (&buffer_defaults, Qnil);
bset_abbrev_mode (&buffer_defaults, Qnil);
bset_overwrite_mode (&buffer_defaults, Qnil);
bset_case_fold_search (&buffer_defaults, Qt);
bset_auto_fill_function (&buffer_defaults, Qnil);
bset_selective_display (&buffer_defaults, Qnil);
bset_selective_display_ellipses (&buffer_defaults, Qt);
bset_abbrev_table (&buffer_defaults, Qnil);
bset_display_table (&buffer_defaults, Qnil);
bset_undo_list (&buffer_defaults, Qnil);
bset_mark_active (&buffer_defaults, Qnil);
bset_file_format (&buffer_defaults, Qnil);
bset_auto_save_file_format (&buffer_defaults, Qt);
set_buffer_overlays_before (&buffer_defaults, NULL);
set_buffer_overlays_after (&buffer_defaults, NULL);
buffer_defaults.overlay_center = BEG;
XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
BSET (&buffer_defaults, truncate_lines, Qnil);
BSET (&buffer_defaults, word_wrap, Qnil);
BSET (&buffer_defaults, ctl_arrow, Qt);
BSET (&buffer_defaults, bidi_display_reordering, Qt);
BSET (&buffer_defaults, bidi_paragraph_direction, Qnil);
BSET (&buffer_defaults, cursor_type, Qt);
BSET (&buffer_defaults, extra_line_spacing, Qnil);
BSET (&buffer_defaults, cursor_in_non_selected_windows, Qt);
bset_truncate_lines (&buffer_defaults, Qnil);
bset_word_wrap (&buffer_defaults, Qnil);
bset_ctl_arrow (&buffer_defaults, Qt);
bset_bidi_display_reordering (&buffer_defaults, Qt);
bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
bset_cursor_type (&buffer_defaults, Qt);
bset_extra_line_spacing (&buffer_defaults, Qnil);
bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
BSET (&buffer_defaults, enable_multibyte_characters, Qt);
BSET (&buffer_defaults, buffer_file_coding_system, Qnil);
bset_enable_multibyte_characters (&buffer_defaults, Qt);
bset_buffer_file_coding_system (&buffer_defaults, Qnil);
XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
BSET (&buffer_defaults, cache_long_line_scans, Qnil);
BSET (&buffer_defaults, file_truename, Qnil);
bset_cache_long_line_scans (&buffer_defaults, Qnil);
bset_file_truename (&buffer_defaults, Qnil);
XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
BSET (&buffer_defaults, left_fringe_width, Qnil);
BSET (&buffer_defaults, right_fringe_width, Qnil);
BSET (&buffer_defaults, fringes_outside_margins, Qnil);
BSET (&buffer_defaults, scroll_bar_width, Qnil);
BSET (&buffer_defaults, vertical_scroll_bar_type, Qt);
BSET (&buffer_defaults, indicate_empty_lines, Qnil);
BSET (&buffer_defaults, indicate_buffer_boundaries, Qnil);
BSET (&buffer_defaults, fringe_indicator_alist, Qnil);
BSET (&buffer_defaults, fringe_cursor_alist, Qnil);
BSET (&buffer_defaults, scroll_up_aggressively, Qnil);
BSET (&buffer_defaults, scroll_down_aggressively, Qnil);
BSET (&buffer_defaults, display_time, Qnil);
bset_left_fringe_width (&buffer_defaults, Qnil);
bset_right_fringe_width (&buffer_defaults, Qnil);
bset_fringes_outside_margins (&buffer_defaults, Qnil);
bset_scroll_bar_width (&buffer_defaults, Qnil);
bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
bset_indicate_empty_lines (&buffer_defaults, Qnil);
bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
bset_fringe_indicator_alist (&buffer_defaults, Qnil);
bset_fringe_cursor_alist (&buffer_defaults, Qnil);
bset_scroll_up_aggressively (&buffer_defaults, Qnil);
bset_scroll_down_aggressively (&buffer_defaults, Qnil);
bset_display_time (&buffer_defaults, Qnil);
/* Assign the local-flags to the slots that have default values.
The local flag is a bit that is used in the buffer
@ -4984,24 +5222,24 @@ init_buffer_once (void)
/* 0 means not a lisp var, -1 means always local, else mask */
memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
BSET (&buffer_local_flags, filename, make_number (-1));
BSET (&buffer_local_flags, directory, make_number (-1));
BSET (&buffer_local_flags, backed_up, make_number (-1));
BSET (&buffer_local_flags, save_length, make_number (-1));
BSET (&buffer_local_flags, auto_save_file_name, make_number (-1));
BSET (&buffer_local_flags, read_only, make_number (-1));
BSET (&buffer_local_flags, major_mode, make_number (-1));
BSET (&buffer_local_flags, mode_name, make_number (-1));
BSET (&buffer_local_flags, undo_list, make_number (-1));
BSET (&buffer_local_flags, mark_active, make_number (-1));
BSET (&buffer_local_flags, point_before_scroll, make_number (-1));
BSET (&buffer_local_flags, file_truename, make_number (-1));
BSET (&buffer_local_flags, invisibility_spec, make_number (-1));
BSET (&buffer_local_flags, file_format, make_number (-1));
BSET (&buffer_local_flags, auto_save_file_format, make_number (-1));
BSET (&buffer_local_flags, display_count, make_number (-1));
BSET (&buffer_local_flags, display_time, make_number (-1));
BSET (&buffer_local_flags, enable_multibyte_characters, make_number (-1));
bset_filename (&buffer_local_flags, make_number (-1));
bset_directory (&buffer_local_flags, make_number (-1));
bset_backed_up (&buffer_local_flags, make_number (-1));
bset_save_length (&buffer_local_flags, make_number (-1));
bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
bset_read_only (&buffer_local_flags, make_number (-1));
bset_major_mode (&buffer_local_flags, make_number (-1));
bset_mode_name (&buffer_local_flags, make_number (-1));
bset_undo_list (&buffer_local_flags, make_number (-1));
bset_mark_active (&buffer_local_flags, make_number (-1));
bset_point_before_scroll (&buffer_local_flags, make_number (-1));
bset_file_truename (&buffer_local_flags, make_number (-1));
bset_invisibility_spec (&buffer_local_flags, make_number (-1));
bset_file_format (&buffer_local_flags, make_number (-1));
bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
bset_display_count (&buffer_local_flags, make_number (-1));
bset_display_time (&buffer_local_flags, make_number (-1));
bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
idx = 1;
XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
@ -5057,7 +5295,7 @@ init_buffer_once (void)
QSFundamental = build_pure_c_string ("Fundamental");
Qfundamental_mode = intern_c_string ("fundamental-mode");
BSET (&buffer_defaults, major_mode, Qfundamental_mode);
bset_major_mode (&buffer_defaults, Qfundamental_mode);
Qmode_class = intern_c_string ("mode-class");
@ -5120,13 +5358,13 @@ init_buffer (void)
len++;
}
BSET (current_buffer, directory, make_unibyte_string (pwd, len));
bset_directory (current_buffer, make_unibyte_string (pwd, len));
if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
/* At this moment, we still don't know how to decode the
directory name. So, we keep the bytes in multibyte form so
that ENCODE_FILE correctly gets the original bytes. */
BSET (current_buffer, directory,
string_to_multibyte (BVAR (current_buffer, directory)));
bset_directory
(current_buffer, string_to_multibyte (BVAR (current_buffer, directory)));
/* Add /: to the front of the name
if it would otherwise be treated as magic. */
@ -5137,11 +5375,12 @@ init_buffer (void)
However, it is not necessary to turn / into /:/.
So avoid doing that. */
&& strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
BSET (current_buffer, directory,
concat2 (build_string ("/:"), BVAR (current_buffer, directory)));
bset_directory
(current_buffer,
concat2 (build_string ("/:"), BVAR (current_buffer, directory)));
temp = get_minibuffer (0);
BSET (XBUFFER (temp), directory, BVAR (current_buffer, directory));
bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
free (pwd);
}

153
src/buffer.h
View File

@ -477,7 +477,6 @@ struct buffer_text
/* Most code should use this macro to access Lisp fields in struct buffer. */
#define BVAR(buf, field) ((buf)->INTERNAL_FIELD (field))
#define BSET(buf, field, value) ((buf)->INTERNAL_FIELD (field) = (value))
/* This is the structure that the buffer Lisp object points to. */
@ -862,6 +861,104 @@ struct buffer
Lisp_Object INTERNAL_FIELD (undo_list);
};
/* Most code should use these functions to set Lisp fields in struct
buffer. */
BUFFER_INLINE void
bset_bidi_paragraph_direction (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (bidi_paragraph_direction) = val;
}
BUFFER_INLINE void
bset_case_canon_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (case_canon_table) = val;
}
BUFFER_INLINE void
bset_case_eqv_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (case_eqv_table) = val;
}
BUFFER_INLINE void
bset_directory (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (directory) = val;
}
BUFFER_INLINE void
bset_display_count (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (display_count) = val;
}
BUFFER_INLINE void
bset_display_time (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (display_time) = val;
}
BUFFER_INLINE void
bset_downcase_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (downcase_table) = val;
}
BUFFER_INLINE void
bset_enable_multibyte_characters (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (enable_multibyte_characters) = val;
}
BUFFER_INLINE void
bset_filename (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (filename) = val;
}
BUFFER_INLINE void
bset_keymap (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (keymap) = val;
}
BUFFER_INLINE void
bset_last_selected_window (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (last_selected_window) = val;
}
BUFFER_INLINE void
bset_local_var_alist (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (local_var_alist) = val;
}
BUFFER_INLINE void
bset_mark_active (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (mark_active) = val;
}
BUFFER_INLINE void
bset_point_before_scroll (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (point_before_scroll) = val;
}
BUFFER_INLINE void
bset_read_only (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (read_only) = val;
}
BUFFER_INLINE void
bset_truncate_lines (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (truncate_lines) = val;
}
BUFFER_INLINE void
bset_undo_list (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (undo_list) = val;
}
BUFFER_INLINE void
bset_upcase_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (upcase_table) = val;
}
BUFFER_INLINE void
bset_width_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (width_table) = val;
}
/* Chain of all buffers, including killed ones. */
@ -953,7 +1050,7 @@ extern Lisp_Object Qfirst_change_hook;
/* Get text properties of B. */
BUFFER_INLINE INTERVAL
buffer_get_intervals (struct buffer *b)
buffer_intervals (struct buffer *b)
{
eassert (b->text != NULL);
return b->text->intervals;
@ -962,26 +1059,12 @@ buffer_get_intervals (struct buffer *b)
/* Set text properties of B to I. */
BUFFER_INLINE void
buffer_set_intervals (struct buffer *b, INTERVAL i)
set_buffer_intervals (struct buffer *b, INTERVAL i)
{
eassert (b->text != NULL);
b->text->intervals = i;
}
/* Set an appropriate overlay of B. */
BUFFER_INLINE void
buffer_set_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
{
b->overlays_before = o;
}
BUFFER_INLINE void
buffer_set_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
{
b->overlays_after = o;
}
/* Non-zero if current buffer has overlays. */
BUFFER_INLINE int
@ -1120,18 +1203,36 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_IDX(OFFSET) \
XINT (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags))
/* Return the default value of the per-buffer variable at offset
OFFSET in the buffer structure. */
/* Functions to get and set default value of the per-buffer
variable at offset OFFSET in the buffer structure. */
#define PER_BUFFER_DEFAULT(OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) &buffer_defaults))
BUFFER_INLINE Lisp_Object
per_buffer_default (int offset)
{
return *(Lisp_Object *)(offset + (char *) &buffer_defaults);
}
/* Return the buffer-local value of the per-buffer variable at offset
OFFSET in the buffer structure. */
BUFFER_INLINE void
set_per_buffer_default (int offset, Lisp_Object value)
{
*(Lisp_Object *)(offset + (char *) &buffer_defaults) = value;
}
/* Functions to get and set buffer-local value of the per-buffer
variable at offset OFFSET in the buffer structure. */
BUFFER_INLINE Lisp_Object
per_buffer_value (struct buffer *b, int offset)
{
return *(Lisp_Object *)(offset + (char *) b);
}
BUFFER_INLINE void
set_per_buffer_value (struct buffer *b, int offset, Lisp_Object value)
{
*(Lisp_Object *)(offset + (char *) b) = value;
}
#define PER_BUFFER_VALUE(BUFFER, OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) (BUFFER)))
/* Downcase a character C, or make no change if that cannot be done. */
BUFFER_INLINE int
downcase (int c)

4
src/callint.c
View File

@ -372,7 +372,7 @@ invoke it. If KEYS is omitted or nil, the return value of
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
Vreal_this_command = save_real_this_command;
KSET (current_kboard, Vlast_command, save_last_command);
kset_last_command (current_kboard, save_last_command);
temporarily_switch_to_single_kboard (NULL);
return unbind_to (speccount, apply1 (function, specs));
@ -843,7 +843,7 @@ invoke it. If KEYS is omitted or nil, the return value of
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
Vreal_this_command = save_real_this_command;
KSET (current_kboard, Vlast_command, save_last_command);
kset_last_command (current_kboard, save_last_command);
{
Lisp_Object val;

4
src/callproc.c
View File

@ -65,10 +65,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "nsterm.h"
#endif
#ifndef USE_CRT_DLL
extern char **environ;
#endif
#ifdef HAVE_SETPGID
#if !defined (USG)
#undef setpgrp

24
src/casetab.c
View File

@ -128,13 +128,13 @@ set_case_table (Lisp_Object table, int standard)
up = Fmake_char_table (Qcase_table, Qnil);
map_char_table (set_identity, Qnil, table, up);
map_char_table (shuffle, Qnil, table, up);
char_table_set_extras (table, 0, up);
set_char_table_extras (table, 0, up);
}
if (NILP (canon))
{
canon = Fmake_char_table (Qcase_table, Qnil);
char_table_set_extras (table, 1, canon);
set_char_table_extras (table, 1, canon);
map_char_table (set_canon, Qnil, table, table);
}
@ -143,11 +143,11 @@ set_case_table (Lisp_Object table, int standard)
eqv = Fmake_char_table (Qcase_table, Qnil);
map_char_table (set_identity, Qnil, canon, eqv);
map_char_table (shuffle, Qnil, canon, eqv);
char_table_set_extras (table, 2, eqv);
set_char_table_extras (table, 2, eqv);
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
char_table_set_extras (canon, 2, eqv);
set_char_table_extras (canon, 2, eqv);
if (standard)
{
@ -158,10 +158,10 @@ set_case_table (Lisp_Object table, int standard)
}
else
{
BSET (current_buffer, downcase_table, table);
BSET (current_buffer, upcase_table, up);
BSET (current_buffer, case_canon_table, canon);
BSET (current_buffer, case_eqv_table, eqv);
bset_downcase_table (current_buffer, table);
bset_upcase_table (current_buffer, up);
bset_case_canon_table (current_buffer, canon);
bset_case_eqv_table (current_buffer, eqv);
}
return table;
@ -260,7 +260,7 @@ init_casetab_once (void)
down = Fmake_char_table (Qcase_table, Qnil);
Vascii_downcase_table = down;
CSET (XCHAR_TABLE (down), purpose, Qcase_table);
set_char_table_purpose (down, Qcase_table);
for (i = 0; i < 128; i++)
{
@ -268,10 +268,10 @@ init_casetab_once (void)
CHAR_TABLE_SET (down, i, make_number (c));
}
char_table_set_extras (down, 1, Fcopy_sequence (down));
set_char_table_extras (down, 1, Fcopy_sequence (down));
up = Fmake_char_table (Qcase_table, Qnil);
char_table_set_extras (down, 0, up);
set_char_table_extras (down, 0, up);
for (i = 0; i < 128; i++)
{
@ -281,7 +281,7 @@ init_casetab_once (void)
CHAR_TABLE_SET (up, i, make_number (c));
}
char_table_set_extras (down, 2, Fcopy_sequence (up));
set_char_table_extras (down, 2, Fcopy_sequence (up));
/* Fill in what isn't filled in. */
set_case_table (down, 1);

25
src/category.c
View File

@ -40,6 +40,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "category.h"
#include "keymap.h"
/* This setter is used only in this file, so it can be private. */
static inline void
bset_category_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (category_table) = val;
}
/* The version number of the latest category table. Each category
table has a unique version number. It is assigned a new number
also when it is modified. When a regular expression is compiled
@ -70,7 +77,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
EMACS_UINT hash;
if (NILP (XCHAR_TABLE (table)->extras[1]))
char_table_set_extras
set_char_table_extras
(table, 1,
make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE),
@ -136,7 +143,7 @@ the current buffer's category table. */)
error ("Category `%c' is already defined", (int) XFASTINT (category));
if (!NILP (Vpurify_flag))
docstring = Fpurecopy (docstring);
CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
SET_CATEGORY_DOCSTRING (table, XFASTINT (category), docstring);
return Qnil;
}
@ -238,9 +245,9 @@ copy_category_table (Lisp_Object table)
table = copy_char_table (table);
if (! NILP (XCHAR_TABLE (table)->defalt))
CSET (XCHAR_TABLE (table), defalt,
Fcopy_sequence (XCHAR_TABLE (table)->defalt));
char_table_set_extras
set_char_table_defalt (table,
Fcopy_sequence (XCHAR_TABLE (table)->defalt));
set_char_table_extras
(table, 0, Fcopy_sequence (XCHAR_TABLE (table)->extras[0]));
map_char_table (copy_category_entry, Qnil, table, table);
@ -270,9 +277,9 @@ DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
int i;
val = Fmake_char_table (Qcategory_table, Qnil);
CSET (XCHAR_TABLE (val), defalt, MAKE_CATEGORY_SET);
set_char_table_defalt (val, MAKE_CATEGORY_SET);
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
char_table_set_contents (val, i, MAKE_CATEGORY_SET);
set_char_table_contents (val, i, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (val, make_number (0),
Fmake_vector (make_number (95), Qnil));
return val;
@ -285,7 +292,7 @@ Return TABLE. */)
{
int idx;
table = check_category_table (table);
BSET (current_buffer, category_table, table);
bset_category_table (current_buffer, table);
/* Indicate that this buffer now has a specified category table. */
idx = PER_BUFFER_VAR_IDX (category_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
@ -466,7 +473,7 @@ init_category_once (void)
Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
/* Set a category set which contains nothing to the default. */
CSET (XCHAR_TABLE (Vstandard_category_table), defalt, MAKE_CATEGORY_SET);
set_char_table_defalt (Vstandard_category_table, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
Fmake_vector (make_number (95), Qnil));
}

8
src/category.h
View File

@ -96,8 +96,12 @@ CHAR_HAS_CATEGORY (int ch, int category)
#define Vstandard_category_table BVAR (&buffer_defaults, category_table)
/* Return the doc string of CATEGORY in category table TABLE. */
#define CATEGORY_DOCSTRING(table, category) \
XVECTOR (Fchar_table_extra_slot (table, make_number (0)))->contents[(category) - ' ']
#define CATEGORY_DOCSTRING(table, category) \
AREF (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '))
/* Set the doc string of CATEGORY to VALUE in category table TABLE. */
#define SET_CATEGORY_DOCSTRING(table, category, value) \
ASET (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '), value)
/* Return the version number of category table TABLE. Not used for
the moment. */

2
src/charset.c
View File

@ -1131,7 +1131,7 @@ usage: (define-charset-internal ...) */)
{
new_definition_p = 0;
id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
set_hash_value (hash_table, charset.hash_index, attrs);
set_hash_value_slot (hash_table, charset.hash_index, attrs);
}
else
{

92
src/chartab.c
View File

@ -115,8 +115,8 @@ the char-table has no extra slot. */)
size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
vector = Fmake_vector (make_number (size), init);
XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
CSET (XCHAR_TABLE (vector), parent, Qnil);
CSET (XCHAR_TABLE (vector), purpose, purpose);
set_char_table_parent (vector, Qnil);
set_char_table_purpose (vector, purpose);
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
return vector;
}
@ -155,21 +155,17 @@ char_table_ascii (Lisp_Object table)
static Lisp_Object
copy_sub_char_table (Lisp_Object table)
{
Lisp_Object copy;
int depth = XINT (XSUB_CHAR_TABLE (table)->depth);
int min_char = XINT (XSUB_CHAR_TABLE (table)->min_char);
Lisp_Object val;
Lisp_Object copy = make_sub_char_table (depth, min_char, Qnil);
int i;
copy = make_sub_char_table (depth, min_char, Qnil);
/* Recursively copy any sub char-tables. */
for (i = 0; i < chartab_size[depth]; i++)
{
val = XSUB_CHAR_TABLE (table)->contents[i];
if (SUB_CHAR_TABLE_P (val))
sub_char_table_set_contents (copy, i, copy_sub_char_table (val));
else
sub_char_table_set_contents (copy, i, val);
Lisp_Object val = XSUB_CHAR_TABLE (table)->contents[i];
set_sub_char_table_contents
(copy, i, SUB_CHAR_TABLE_P (val) ? copy_sub_char_table (val) : val);
}
return copy;
@ -185,19 +181,19 @@ copy_char_table (Lisp_Object table)
copy = Fmake_vector (make_number (size), Qnil);
XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE);
CSET (XCHAR_TABLE (copy), defalt, XCHAR_TABLE (table)->defalt);
CSET (XCHAR_TABLE (copy), parent, XCHAR_TABLE (table)->parent);
CSET (XCHAR_TABLE (copy), purpose, XCHAR_TABLE (table)->purpose);
set_char_table_defalt (copy, XCHAR_TABLE (table)->defalt);
set_char_table_parent (copy, XCHAR_TABLE (table)->parent);
set_char_table_purpose (copy, XCHAR_TABLE (table)->purpose);
for (i = 0; i < chartab_size[0]; i++)
char_table_set_contents
(copy, i,
set_char_table_contents
(copy, i,
(SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
: XCHAR_TABLE (table)->contents[i]));
CSET (XCHAR_TABLE (copy), ascii, char_table_ascii (copy));
set_char_table_ascii (copy, char_table_ascii (copy));
size -= VECSIZE (struct Lisp_Char_Table) - 1;
for (i = 0; i < size; i++)
char_table_set_extras (copy, i, XCHAR_TABLE (table)->extras[i]);
set_char_table_extras (copy, i, XCHAR_TABLE (table)->extras[i]);
XSETCHAR_TABLE (copy, XCHAR_TABLE (copy));
return copy;
@ -395,7 +391,7 @@ sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
Lisp_Object sub;
if (depth == 3)
sub_char_table_set_contents (table, i, val);
set_sub_char_table_contents (table, i, val);
else
{
sub = tbl->contents[i];
@ -408,21 +404,21 @@ sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
sub = make_sub_char_table (depth + 1,
min_char + i * chartab_chars[depth],
sub);
sub_char_table_set_contents (table, i, sub);
set_sub_char_table_contents (table, i, sub);
}
}
sub_char_table_set (sub, c, val, is_uniprop);
}
}
Lisp_Object
void
char_table_set (Lisp_Object table, int c, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
if (ASCII_CHAR_P (c)
&& SUB_CHAR_TABLE_P (tbl->ascii))
sub_char_table_set_contents (tbl->ascii, c, val);
set_sub_char_table_contents (tbl->ascii, c, val);
else
{
int i = CHARTAB_IDX (c, 0, 0);
@ -432,13 +428,12 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val)
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
char_table_set_contents (table, i, sub);
set_char_table_contents (table, i, sub);
}
sub_char_table_set (sub, c, val, UNIPROP_TABLE_P (table));
if (ASCII_CHAR_P (c))
CSET (tbl, ascii, char_table_ascii (table));
set_char_table_ascii (table, char_table_ascii (table));
}
return val;
}
static void
@ -460,7 +455,7 @@ sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
if (c > to)
break;
if (from <= c && c + chars_in_block - 1 <= to)
sub_char_table_set_contents (table, i, val);
set_sub_char_table_contents (table, i, val);
else
{
Lisp_Object sub = tbl->contents[i];
@ -471,7 +466,7 @@ sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
else
{
sub = make_sub_char_table (depth + 1, c, sub);
sub_char_table_set_contents (table, i, sub);
set_sub_char_table_contents (table, i, sub);
}
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
@ -480,7 +475,7 @@ sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
}
Lisp_Object
void
char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
@ -499,22 +494,21 @@ char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
if (c > to)
break;
if (from <= c && c + chartab_chars[0] - 1 <= to)
char_table_set_contents (table, i, val);
set_char_table_contents (table, i, val);
else
{
Lisp_Object sub = tbl->contents[i];
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
char_table_set_contents (table, i, sub);
set_char_table_contents (table, i, sub);
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
}
}
if (ASCII_CHAR_P (from))
CSET (tbl, ascii, char_table_ascii (table));
set_char_table_ascii (table, char_table_ascii (table));
}
return val;
}
@ -562,7 +556,7 @@ Return PARENT. PARENT must be either nil or another char-table. */)
error ("Attempt to make a chartable be its own parent");
}
CSET (XCHAR_TABLE (char_table), parent, parent);
set_char_table_parent (char_table, parent);
return parent;
}
@ -593,7 +587,7 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
args_out_of_range (char_table, n);
char_table_set_extras (char_table, XINT (n), value);
set_char_table_extras (char_table, XINT (n), value);
return value;
}
@ -640,12 +634,12 @@ or a character code. Return VALUE. */)
{
int i;
CSET (XCHAR_TABLE (char_table), ascii, value);
set_char_table_ascii (char_table, value);
for (i = 0; i < chartab_size[0]; i++)
char_table_set_contents (char_table, i, value);
set_char_table_contents (char_table, i, value);
}
else if (EQ (range, Qnil))
CSET (XCHAR_TABLE (char_table), defalt, value);
set_char_table_defalt (char_table, value);
else if (CHARACTERP (range))
char_table_set (char_table, XINT (range), value);
else if (CONSP (range))
@ -695,7 +689,7 @@ optimize_sub_char_table (Lisp_Object table, Lisp_Object test)
if (SUB_CHAR_TABLE_P (elt))
{
elt = optimize_sub_char_table (elt, test);
sub_char_table_set_contents (table, 0, elt);
set_sub_char_table_contents (table, 0, elt);
}
optimizable = SUB_CHAR_TABLE_P (elt) ? 0 : 1;
for (i = 1; i < chartab_size[depth]; i++)
@ -704,7 +698,7 @@ optimize_sub_char_table (Lisp_Object table, Lisp_Object test)
if (SUB_CHAR_TABLE_P (this))
{
this = optimize_sub_char_table (this, test);
sub_char_table_set_contents (table, i, this);
set_sub_char_table_contents (table, i, this);
}
if (optimizable
&& (NILP (test) ? NILP (Fequal (this, elt)) /* defaults to `equal'. */
@ -732,11 +726,11 @@ equivalent and can be merged. It defaults to `equal'. */)
{
elt = XCHAR_TABLE (char_table)->contents[i];
if (SUB_CHAR_TABLE_P (elt))
char_table_set_contents
set_char_table_contents
(char_table, i, optimize_sub_char_table (elt, test));
}
/* Reset the `ascii' cache, in case it got optimized away. */
CSET (XCHAR_TABLE (char_table), ascii, char_table_ascii (char_table));
set_char_table_ascii (char_table, char_table_ascii (char_table));
return Qnil;
}
@ -828,9 +822,9 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
/* This is to get a value of FROM in PARENT
without checking the parent of PARENT. */
CSET (XCHAR_TABLE (parent), parent, Qnil);
set_char_table_parent (parent, Qnil);
val = CHAR_TABLE_REF (parent, from);
CSET (XCHAR_TABLE (parent), parent, temp);
set_char_table_parent (parent, temp);
XSETCDR (range, make_number (c - 1));
val = map_sub_char_table (c_function, function,
parent, arg, val, range,
@ -910,9 +904,9 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
temp = XCHAR_TABLE (parent)->parent;
/* This is to get a value of FROM in PARENT without checking the
parent of PARENT. */
CSET (XCHAR_TABLE (parent), parent, Qnil);
set_char_table_parent (parent, Qnil);
val = CHAR_TABLE_REF (parent, from);
CSET (XCHAR_TABLE (parent), parent, temp);
set_char_table_parent (parent, temp);
val = map_sub_char_table (c_function, function, parent, arg, val, range,
parent);
table = parent;
@ -1149,7 +1143,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
Lisp_Object sub = make_sub_char_table (3, min_char, Qnil);
const unsigned char *p, *pend;
sub_char_table_set_contents (table, idx, sub);
set_sub_char_table_contents (table, idx, sub);
p = SDATA (val), pend = p + SBYTES (val);
if (*p == 1)
{
@ -1159,7 +1153,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
while (p < pend && idx < chartab_chars[2])
{
int v = STRING_CHAR_ADVANCE (p);
sub_char_table_set_contents
set_sub_char_table_contents
(sub, idx++, v > 0 ? make_number (v) : Qnil);
}
}
@ -1185,7 +1179,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
}
}
while (count-- > 0)
sub_char_table_set_contents (sub, idx++, make_number (v));
set_sub_char_table_contents (sub, idx++, make_number (v));
}
}
/* It seems that we don't need this function because C code won't need
@ -1288,7 +1282,7 @@ uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value)
args[0] = XCHAR_TABLE (table)->extras[4];
args[1] = Fmake_vector (make_number (1), value);
char_table_set_extras (table, 4, Fvconcat (2, args));
set_char_table_extras (table, 4, Fvconcat (2, args));
}
return make_number (i);
}
@ -1350,7 +1344,7 @@ uniprop_table (Lisp_Object prop)
: ! NILP (val))
return Qnil;
/* Prepare ASCII values in advance for CHAR_TABLE_REF. */
CSET (XCHAR_TABLE (table), ascii, char_table_ascii (table));
set_char_table_ascii (table, char_table_ascii (table));
return table;
}

2
src/cmds.c
View File

@ -301,7 +301,7 @@ At the end, it runs `post-self-insert-hook'. */)
added be explicit calls to undo-boundary. */
&& EQ (BVAR (current_buffer, undo_list), last_undo_boundary))
/* Remove the undo_boundary that was just pushed. */
BSET (current_buffer, undo_list, XCDR (BVAR (current_buffer, undo_list)));
bset_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list)));
/* Barf if the key that invoked this was not a character. */
if (!CHARACTERP (last_command_event))

16
src/coding.c
View File

@ -7112,7 +7112,7 @@ decode_coding (struct coding_system *coding)
record_first_change ();
undo_list = BVAR (current_buffer, undo_list);
BSET (current_buffer, undo_list, Qt);
bset_undo_list (current_buffer, Qt);
}
coding->consumed = coding->consumed_char = 0;
@ -7209,7 +7209,7 @@ decode_coding (struct coding_system *coding)
decode_eol (coding);
if (BUFFERP (coding->dst_object))
{
BSET (current_buffer, undo_list, undo_list);
bset_undo_list (current_buffer, undo_list);
record_insert (coding->dst_pos, coding->produced_char);
}
return coding->result;
@ -7577,8 +7577,8 @@ make_conversion_work_buffer (int multibyte)
doesn't compile new regexps. */
Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt);
Ferase_buffer ();
BSET (current_buffer, undo_list, Qt);
BSET (current_buffer, enable_multibyte_characters, multibyte ? Qt : Qnil);
bset_undo_list (current_buffer, Qt);
bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
set_buffer_internal (current);
return workbuf;
}
@ -9302,10 +9302,10 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern
terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
terminal_coding->src_multibyte = 1;
terminal_coding->dst_multibyte = 0;
if (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK)
TSET (term, charset_list, coding_charset_list (terminal_coding));
else
TSET (term, charset_list, Fcons (make_number (charset_ascii), Qnil));
tset_charset_list
(term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK
? coding_charset_list (terminal_coding)
: Fcons (make_number (charset_ascii), Qnil)));
return Qnil;
}

3
src/conf_post.h
View File

@ -178,6 +178,9 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */
#endif
#include <string.h>
/* If you think about removing the line below, note that the
MS-Windows build relies on it for declaration of 'environ' needed
by a few source files. */
#include <stdlib.h>
#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */

85
src/data.c
View File

@ -543,7 +543,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
else
{
swap_in_symval_forwarding (sym, blv);
valcontents = BLV_VALUE (blv);
valcontents = blv_value (blv);
}
break;
}
@ -847,7 +847,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
return *XOBJFWD (valcontents)->objvar;
case Lisp_Fwd_Buffer_Obj:
return PER_BUFFER_VALUE (current_buffer,
return per_buffer_value (current_buffer,
XBUFFER_OBJFWD (valcontents)->offset);
case Lisp_Fwd_Kboard_Obj:
@ -919,7 +919,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
b = XBUFFER (lbuf);
if (! PER_BUFFER_VALUE_P (b, idx))
PER_BUFFER_VALUE (b, offset) = newval;
set_per_buffer_value (b, offset, newval);
}
}
break;
@ -937,7 +937,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
if (buf == NULL)
buf = current_buffer;
PER_BUFFER_VALUE (buf, offset) = newval;
set_per_buffer_value (buf, offset, newval);
}
break;
@ -964,16 +964,16 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
/* Unload the previously loaded binding. */
if (blv->fwd)
SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Select the global binding in the symbol. */
blv->valcell = blv->defcell;
set_blv_valcell (blv, blv->defcell);
if (blv->fwd)
store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
/* Indicate that the global binding is set up now. */
blv->where = Qnil;
SET_BLV_FOUND (blv, 0);
set_blv_where (blv, Qnil);
set_blv_found (blv, 0);
}
/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
@ -1001,7 +1001,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
/* Unload the previously loaded binding. */
tem1 = blv->valcell;
if (blv->fwd)
SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Choose the new binding. */
{
Lisp_Object var;
@ -1009,7 +1009,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
if (blv->frame_local)
{
tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
blv->where = selected_frame;
set_blv_where (blv, selected_frame);
}
else
{
@ -1021,9 +1021,9 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
tem1 = blv->defcell;
/* Load the new binding. */
blv->valcell = tem1;
set_blv_valcell (blv, tem1);
if (blv->fwd)
store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL);
store_symval_forwarding (blv->fwd, blv_value (blv), NULL);
}
}
@ -1050,7 +1050,7 @@ find_symbol_value (Lisp_Object symbol)
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
swap_in_symval_forwarding (sym, blv);
return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv);
return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv);
}
/* FALLTHROUGH */
case SYMBOL_FORWARDED:
@ -1175,7 +1175,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
/* Write out `realvalue' to the old loaded binding. */
if (blv->fwd)
SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Find the new binding. */
XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
@ -1183,7 +1183,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
(blv->frame_local
? XFRAME (where)->param_alist
: BVAR (XBUFFER (where), local_var_alist)));
blv->where = where;
set_blv_where (blv, where);
blv->found = 1;
if (NILP (tem1))
@ -1213,17 +1213,18 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
bindings, not for frame-local bindings. */
eassert (!blv->frame_local);
tem1 = Fcons (symbol, XCDR (blv->defcell));
BSET (XBUFFER (where), local_var_alist,
Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
bset_local_var_alist
(XBUFFER (where),
Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
}
}
/* Record which binding is now loaded. */
blv->valcell = tem1;
set_blv_valcell (blv, tem1);
}
/* Store the new value in the cons cell. */
SET_BLV_VALUE (blv, newval);
set_blv_value (blv, newval);
if (blv->fwd)
{
@ -1308,7 +1309,7 @@ default_value (Lisp_Object symbol)
{
int offset = XBUFFER_OBJFWD (valcontents)->offset;
if (PER_BUFFER_IDX (offset) != 0)
return PER_BUFFER_DEFAULT (offset);
return per_buffer_default (offset);
}
/* For other variables, get the current value. */
@ -1395,7 +1396,7 @@ for this variable. */)
int offset = XBUFFER_OBJFWD (valcontents)->offset;
int idx = PER_BUFFER_IDX (offset);
PER_BUFFER_DEFAULT (offset) = value;
set_per_buffer_default (offset, value);
/* If this variable is not always local in all buffers,
set it in the buffers that don't nominally have a local value. */
@ -1405,7 +1406,7 @@ for this variable. */)
FOR_EACH_BUFFER (b)
if (!PER_BUFFER_VALUE_P (b, idx))
PER_BUFFER_VALUE (b, offset) = value;
set_per_buffer_value (b, offset, value);
}
return value;
}
@ -1479,12 +1480,12 @@ make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents
eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
blv->fwd = forwarded ? valcontents.fwd : NULL;
blv->where = Qnil;
set_blv_where (blv, Qnil);
blv->frame_local = 0;
blv->local_if_set = 0;
blv->defcell = tem;
blv->valcell = tem;
SET_BLV_FOUND (blv, 0);
set_blv_defcell (blv, tem);
set_blv_valcell (blv, tem);
set_blv_found (blv, 0);
return blv;
}
@ -1653,17 +1654,16 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
default value. */
find_symbol_value (variable);
BSET (current_buffer, local_var_alist,
Fcons (Fcons (variable, XCDR (blv->defcell)),
BVAR (current_buffer, local_var_alist)));
bset_local_var_alist
(current_buffer,
Fcons (Fcons (variable, XCDR (blv->defcell)),
BVAR (current_buffer, local_var_alist)));
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value. */
if (current_buffer == XBUFFER (blv->where))
blv->where = Qnil;
/* blv->valcell = blv->defcell;
* SET_BLV_FOUND (blv, 0); */
blv->found = 0;
set_blv_where (blv, Qnil);
set_blv_found (blv, 0);
}
/* If the symbol forwards into a C variable, then load the binding
@ -1705,8 +1705,8 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
if (idx > 0)
{
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
PER_BUFFER_VALUE (current_buffer, offset)
= PER_BUFFER_DEFAULT (offset);
set_per_buffer_value (current_buffer, offset,
per_buffer_default (offset));
}
}
return variable;
@ -1723,8 +1723,9 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
if (!NILP (tem))
BSET (current_buffer, local_var_alist,
Fdelq (tem, BVAR (current_buffer, local_var_alist)));
bset_local_var_alist
(current_buffer,
Fdelq (tem, BVAR (current_buffer, local_var_alist)));
/* If the symbol is set up with the current buffer's binding
loaded, recompute its value. We have to do it now, or else
@ -1733,9 +1734,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
Lisp_Object buf; XSETBUFFER (buf, current_buffer);
if (EQ (buf, blv->where))
{
blv->where = Qnil;
/* blv->valcell = blv->defcell;
* SET_BLV_FOUND (blv, 0); */
set_blv_where (blv, Qnil);
blv->found = 0;
find_symbol_value (variable);
}
@ -1857,11 +1856,11 @@ BUFFER defaults to the current buffer. */)
if (EQ (variable, XCAR (elt)))
{
eassert (!blv->frame_local);
eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp));
eassert (blv_found (blv) || !EQ (blv->where, tmp));
return Qt;
}
}
eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp));
eassert (!blv_found (blv) || !EQ (blv->where, tmp));
return Qnil;
}
case SYMBOL_FORWARDED:
@ -1951,7 +1950,7 @@ If the current binding is global (the default), the value is nil. */)
if (!NILP (Flocal_variable_p (variable, Qnil)))
return Fcurrent_buffer ();
else if (sym->redirect == SYMBOL_LOCALIZED
&& BLV_FOUND (SYMBOL_BLV (sym)))
&& blv_found (SYMBOL_BLV (sym)))
return SYMBOL_BLV (sym)->where;
else
return Qnil;

6
src/dbusbind.c
View File

@ -1039,11 +1039,13 @@ xd_remove_watch (DBusWatch *watch, void *data)
return;
/* Unset session environment. */
#if 0
if (XSYMBOL (QCdbus_session_bus) == data)
{
// XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
// unsetenv ("DBUS_SESSION_BUS_ADDRESS");
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
}
#endif
if (flags & DBUS_WATCH_WRITABLE)
delete_write_fd (fd);

113
src/dispnew.c
View File

@ -621,7 +621,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
are invalidated below. */
if (INTEGERP (w->window_end_vpos)
&& XFASTINT (w->window_end_vpos) >= i)
WSET (w, window_end_valid, Qnil);
wset_window_end_valid (w, Qnil);
while (i < matrix->nrows)
matrix->rows[i++].enabled_p = 0;
@ -878,7 +878,7 @@ clear_window_matrices (struct window *w, int desired_p)
else
{
clear_glyph_matrix (w->current_matrix);
WSET (w, window_end_valid, Qnil);
wset_window_end_valid (w, Qnil);
}
}
@ -1887,14 +1887,14 @@ adjust_frame_glyphs_initially (void)
int top_margin = FRAME_TOP_MARGIN (sf);
/* Do it for the root window. */
WSET (root, top_line, make_number (top_margin));
WSET (root, total_lines, make_number (frame_lines - 1 - top_margin));
WSET (root, total_cols, make_number (frame_cols));
wset_top_line (root, make_number (top_margin));
wset_total_lines (root, make_number (frame_lines - 1 - top_margin));
wset_total_cols (root, make_number (frame_cols));
/* Do it for the mini-buffer window. */
WSET (mini, top_line, make_number (frame_lines - 1));
WSET (mini, total_lines, make_number (1));
WSET (mini, total_cols, make_number (frame_cols));
wset_top_line (mini, make_number (frame_lines - 1));
wset_total_lines (mini, make_number (1));
wset_total_cols (mini, make_number (frame_cols));
adjust_frame_glyphs (sf);
glyphs_initialized_initially_p = 1;
@ -2166,10 +2166,10 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
if (NILP (f->menu_bar_window))
{
Lisp_Object frame;
FSET (f, menu_bar_window, make_window ());
fset_menu_bar_window (f, make_window ());
w = XWINDOW (f->menu_bar_window);
XSETFRAME (frame, f);
WSET (w, frame, frame);
wset_frame (w, frame);
w->pseudo_window_p = 1;
}
else
@ -2177,10 +2177,10 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
/* Set window dimensions to frame dimensions and allocate or
adjust glyph matrices of W. */
WSET (w, top_line, make_number (0));
WSET (w, left_col, make_number (0));
WSET (w, total_lines, make_number (FRAME_MENU_BAR_LINES (f)));
WSET (w, total_cols, make_number (FRAME_TOTAL_COLS (f)));
wset_top_line (w, make_number (0));
wset_left_col (w, make_number (0));
wset_total_lines (w, make_number (FRAME_MENU_BAR_LINES (f)));
wset_total_cols (w, make_number (FRAME_TOTAL_COLS (f)));
allocate_matrices_for_window_redisplay (w);
}
#endif /* not USE_X_TOOLKIT && not USE_GTK */
@ -2194,19 +2194,19 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
if (NILP (f->tool_bar_window))
{
Lisp_Object frame;
FSET (f, tool_bar_window, make_window ());
fset_tool_bar_window (f, make_window ());
w = XWINDOW (f->tool_bar_window);
XSETFRAME (frame, f);
WSET (w, frame, frame);
wset_frame (w, frame);
w->pseudo_window_p = 1;
}
else
w = XWINDOW (f->tool_bar_window);
WSET (w, top_line, make_number (FRAME_MENU_BAR_LINES (f)));
WSET (w, left_col, make_number (0));
WSET (w, total_lines, make_number (FRAME_TOOL_BAR_LINES (f)));
WSET (w, total_cols, make_number (FRAME_TOTAL_COLS (f)));
wset_top_line (w, make_number (FRAME_MENU_BAR_LINES (f)));
wset_left_col (w, make_number (0));
wset_total_lines (w, make_number (FRAME_TOOL_BAR_LINES (f)));
wset_total_cols (w, make_number (FRAME_TOTAL_COLS (f)));
allocate_matrices_for_window_redisplay (w);
}
#endif
@ -2272,7 +2272,7 @@ free_glyphs (struct frame *f)
free_glyph_matrix (w->desired_matrix);
free_glyph_matrix (w->current_matrix);
w->desired_matrix = w->current_matrix = NULL;
FSET (f, menu_bar_window, Qnil);
fset_menu_bar_window (f, Qnil);
}
/* Free the tool bar window and its glyph matrices. */
@ -2282,7 +2282,7 @@ free_glyphs (struct frame *f)
free_glyph_matrix (w->desired_matrix);
free_glyph_matrix (w->current_matrix);
w->desired_matrix = w->current_matrix = NULL;
FSET (f, tool_bar_window, Qnil);
fset_tool_bar_window (f, Qnil);
}
/* Release frame glyph matrices. Reset fields to zero in
@ -3220,8 +3220,8 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p)
/* Swap tool-bar strings. We swap because we want to
reuse strings. */
tem = f->current_tool_bar_string;
FSET (f, current_tool_bar_string, f->desired_tool_bar_string);
FSET (f, desired_tool_bar_string, tem);
fset_current_tool_bar_string (f, f->desired_tool_bar_string);
fset_desired_tool_bar_string (f, tem);
}
}
@ -5744,7 +5744,7 @@ change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int
FrameCols (FRAME_TTY (f)) = newwidth;
if (WINDOWP (f->tool_bar_window))
WSET (XWINDOW (f->tool_bar_window), total_cols, make_number (newwidth));
wset_total_cols (XWINDOW (f->tool_bar_window), make_number (newwidth));
}
FRAME_LINES (f) = newheight;
@ -6044,8 +6044,7 @@ pass nil for VARIABLE. */)
(Lisp_Object variable)
{
Lisp_Object state, tail, frame, buf;
Lisp_Object *vecp, *end;
ptrdiff_t n;
ptrdiff_t n, idx;
if (! NILP (variable))
{
@ -6057,18 +6056,16 @@ pass nil for VARIABLE. */)
else
state = frame_and_buffer_state;
vecp = XVECTOR (state)->contents;
end = vecp + ASIZE (state);
idx = 0;
FOR_EACH_FRAME (tail, frame)
{
if (vecp == end)
if (idx == ASIZE (state))
goto changed;
if (!EQ (*vecp++, frame))
if (!EQ (AREF (state, idx++), frame))
goto changed;
if (vecp == end)
if (idx == ASIZE (state))
goto changed;
if (!EQ (*vecp++, XFRAME (frame)->name))
if (!EQ (AREF (state, idx++), XFRAME (frame)->name))
goto changed;
}
/* Check that the buffer info matches. */
@ -6078,23 +6075,23 @@ pass nil for VARIABLE. */)
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ')
continue;
if (vecp == end)
if (idx == ASIZE (state))
goto changed;
if (!EQ (*vecp++, buf))
if (!EQ (AREF (state, idx++), buf))
goto changed;
if (vecp == end)
if (idx == ASIZE (state))
goto changed;
if (!EQ (*vecp++, BVAR (XBUFFER (buf), read_only)))
if (!EQ (AREF (state, idx++), BVAR (XBUFFER (buf), read_only)))
goto changed;
if (vecp == end)
if (idx == ASIZE (state))
goto changed;
if (!EQ (*vecp++, Fbuffer_modified_p (buf)))
if (!EQ (AREF (state, idx++), Fbuffer_modified_p (buf)))
goto changed;
}
if (vecp == end)
if (idx == ASIZE (state))
goto changed;
/* Detect deletion of a buffer at the end of the list. */
if (EQ (*vecp, Qlambda))
if (EQ (AREF (state, idx), Qlambda))
return Qnil;
/* Come here if we decide the data has changed. */
@ -6121,11 +6118,13 @@ pass nil for VARIABLE. */)
}
/* Record the new data in the (possibly reallocated) vector. */
vecp = XVECTOR (state)->contents;
idx = 0;
FOR_EACH_FRAME (tail, frame)
{
*vecp++ = frame;
*vecp++ = XFRAME (frame)->name;
ASET (state, idx, frame);
idx++;
ASET (state, idx, XFRAME (frame)->name);
idx++;
}
for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
@ -6133,19 +6132,23 @@ pass nil for VARIABLE. */)
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ')
continue;
*vecp++ = buf;
*vecp++ = BVAR (XBUFFER (buf), read_only);
*vecp++ = Fbuffer_modified_p (buf);
ASET (state, idx, buf);
idx++;
ASET (state, idx, BVAR (XBUFFER (buf), read_only));
idx++;
ASET (state, idx, Fbuffer_modified_p (buf));
idx++;
}
/* Fill up the vector with lambdas (always at least one). */
*vecp++ = Qlambda;
while (vecp - XVECTOR (state)->contents
< ASIZE (state))
*vecp++ = Qlambda;
ASET (state, idx, Qlambda);
idx++;
while (idx < ASIZE (state))
{
ASET (state, idx, Qlambda);
idx++;
}
/* Make sure we didn't overflow the vector. */
if (vecp - XVECTOR (state)->contents
> ASIZE (state))
abort ();
eassert (idx <= ASIZE (state));
return Qt;
}

2
src/dosfns.c
View File

@ -473,7 +473,7 @@ x_set_title (struct frame *f, Lisp_Object name)
update_mode_lines = 1;
FSET (f, title, name);
fset_title (f, name);
if (NILP (name))
name = f->name;

34
src/editfns.c
View File

@ -58,10 +58,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "window.h"
#include "blockinput.h"
#ifndef USE_CRT_DLL
extern char **environ;
#endif
#define TM_YEAR_BASE 1900
#ifdef WINDOWSNT
@ -881,7 +877,7 @@ save_excursion_restore (Lisp_Object info)
info = XCDR (info);
tem = XCAR (info);
tem1 = BVAR (current_buffer, mark_active);
BSET (current_buffer, mark_active, tem);
bset_mark_active (current_buffer, tem);
/* If mark is active now, and either was not active
or was at a different place, run the activate hook. */
@ -2815,13 +2811,15 @@ determines whether case is significant or ignored. */)
static Lisp_Object
subst_char_in_region_unwind (Lisp_Object arg)
{
return BSET (current_buffer, undo_list, arg);
bset_undo_list (current_buffer, arg);
return arg;
}
static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object arg)
{
return BSET (current_buffer, filename, arg);
bset_filename (current_buffer, arg);
return arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
@ -2895,11 +2893,11 @@ Both characters must have the same length of multi-byte form. */)
{
record_unwind_protect (subst_char_in_region_unwind,
BVAR (current_buffer, undo_list));
BSET (current_buffer, undo_list, Qt);
bset_undo_list (current_buffer, Qt);
/* Don't do file-locking. */
record_unwind_protect (subst_char_in_region_unwind_1,
BVAR (current_buffer, filename));
BSET (current_buffer, filename, Qnil);
bset_filename (current_buffer, Qnil);
}
if (pos_byte < GPT_BYTE)
@ -2981,7 +2979,7 @@ Both characters must have the same length of multi-byte form. */)
INC_POS (pos_byte_next);
if (! NILP (noundo))
BSET (current_buffer, undo_list, tem);
bset_undo_list (current_buffer, tem);
UNGCPRO;
}
@ -3644,13 +3642,13 @@ usage: (format STRING &rest OBJECTS) */)
ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
char *p;
Lisp_Object buf_save_value IF_LINT (= {0});
register char *format, *end, *format_start;
char *format, *end, *format_start;
ptrdiff_t formatlen, nchars;
/* Nonzero if the format is multibyte. */
int multibyte_format = 0;
/* Nonzero if the output should be a multibyte string,
/* True if the format is multibyte. */
bool multibyte_format = 0;
/* True if the output should be a multibyte string,
which is true if any of the inputs is one. */
int multibyte = 0;
bool multibyte = 0;
/* When we make a multibyte string, we must pay attention to the
byte combining problem, i.e., a byte may be combined with a
multibyte character of the previous string. This flag tells if we
@ -3936,7 +3934,7 @@ usage: (format STRING &rest OBJECTS) */)
/* If this argument has text properties, record where
in the result string it appears. */
if (string_get_intervals (args[n]))
if (string_intervals (args[n]))
info[n].intervals = arg_intervals = 1;
continue;
@ -4280,7 +4278,7 @@ usage: (format STRING &rest OBJECTS) */)
arguments has text properties, set up text properties of the
result string. */
if (string_get_intervals (args[0]) || arg_intervals)
if (string_intervals (args[0]) || arg_intervals)
{
Lisp_Object len, new_len, props;
struct gcpro gcpro1;
@ -4530,7 +4528,7 @@ Transposing beyond buffer boundaries is an error. */)
Lisp_Object buf;
XSETBUFFER (buf, current_buffer);
cur_intv = buffer_get_intervals (current_buffer);
cur_intv = buffer_intervals (current_buffer);
validate_region (&startr1, &endr1);
validate_region (&startr2, &endr2);

4
src/emacs.c
View File

@ -642,10 +642,6 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr,
static void
malloc_initialize_hook (void)
{
#ifndef USE_CRT_DLL
extern char **environ;
#endif
if (initialized)
{
if (!malloc_using_checking)

34
src/eval.c
View File

@ -133,7 +133,21 @@ Lisp_Object inhibit_lisp_code;
static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
static int interactive_p (int);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
/* Functions to set Lisp_Object slots of struct specbinding. */
static inline void
set_specpdl_symbol (Lisp_Object symbol)
{
specpdl_ptr->symbol = symbol;
}
static inline void
set_specpdl_old_value (Lisp_Object oldval)
{
specpdl_ptr->old_value = oldval;
}
void
init_eval_once (void)
{
@ -3136,8 +3150,8 @@ specbind (Lisp_Object symbol, Lisp_Object value)
case SYMBOL_PLAINVAL:
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
specpdl_ptr->symbol = symbol;
specpdl_ptr->old_value = SYMBOL_VAL (sym);
set_specpdl_symbol (symbol);
set_specpdl_old_value (SYMBOL_VAL (sym));
specpdl_ptr->func = NULL;
++specpdl_ptr;
if (!sym->constant)
@ -3152,7 +3166,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
specpdl_ptr->old_value = ovalue;
set_specpdl_old_value (ovalue);
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where,
@ -3169,12 +3183,12 @@ specbind (Lisp_Object symbol, Lisp_Object value)
if (!NILP (Flocal_variable_p (symbol, Qnil)))
{
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (BLV_FOUND (SYMBOL_BLV (sym))
|| (blv_found (SYMBOL_BLV (sym))
&& EQ (cur_buf, SYMBOL_BLV (sym)->where)));
where = cur_buf;
}
else if (sym->redirect == SYMBOL_LOCALIZED
&& BLV_FOUND (SYMBOL_BLV (sym)))
&& blv_found (SYMBOL_BLV (sym)))
where = SYMBOL_BLV (sym)->where;
else
where = Qnil;
@ -3186,7 +3200,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
let_shadows_buffer_binding_p which is itself only used
in set_internal for local_if_set. */
eassert (NILP (where) || EQ (where, cur_buf));
specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
/* If SYMBOL is a per-buffer variable which doesn't have a
buffer-local value here, make the `let' change the global
@ -3203,7 +3217,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
}
}
else
specpdl_ptr->symbol = symbol;
set_specpdl_symbol (symbol);
specpdl_ptr++;
set_internal (symbol, value, Qnil, 1);
@ -3221,8 +3235,8 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
specpdl_ptr->symbol = Qnil;
specpdl_ptr->old_value = arg;
set_specpdl_symbol (Qnil);
set_specpdl_old_value (arg);
specpdl_ptr++;
}

42
src/fileio.c
View File

@ -766,7 +766,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
#endif /* DOS_NT */
ptrdiff_t length;
Lisp_Object handler, result, handled_name;
int multibyte;
bool multibyte;
Lisp_Object hdir;
CHECK_STRING (name);
@ -1566,7 +1566,7 @@ those `/' is discarded. */)
char *target = NULL;
int total = 0;
int substituted = 0;
int multibyte;
bool multibyte;
char *xnm;
Lisp_Object handler;
@ -3146,12 +3146,12 @@ decide_coding_unwind (Lisp_Object unwind_data)
set_buffer_internal (XBUFFER (buffer));
adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
adjust_overlays_for_delete (BEG, Z - BEG);
buffer_set_intervals (current_buffer, NULL);
set_buffer_intervals (current_buffer, NULL);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
/* Now we are safe to change the buffer's multibyteness directly. */
BSET (current_buffer, enable_multibyte_characters, multibyte);
BSET (current_buffer, undo_list, undo_list);
bset_enable_multibyte_characters (current_buffer, multibyte);
bset_undo_list (current_buffer, undo_list);
return Qnil;
}
@ -3487,16 +3487,16 @@ variable `last-coding-system-used' to the coding system actually used. */)
buf = XBUFFER (workbuf);
delete_all_overlays (buf);
BSET (buf, directory, BVAR (current_buffer, directory));
BSET (buf, read_only, Qnil);
BSET (buf, filename, Qnil);
BSET (buf, undo_list, Qt);
bset_directory (buf, BVAR (current_buffer, directory));
bset_read_only (buf, Qnil);
bset_filename (buf, Qnil);
bset_undo_list (buf, Qt);
eassert (buf->overlays_before == NULL);
eassert (buf->overlays_after == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
BSET (buf, enable_multibyte_characters, Qnil);
bset_enable_multibyte_characters (buf, Qnil);
insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
@ -4105,8 +4105,8 @@ variable `last-coding-system-used' to the coding system actually used. */)
unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
Fcons (BVAR (current_buffer, undo_list),
Fcurrent_buffer ()));
BSET (current_buffer, enable_multibyte_characters, Qnil);
BSET (current_buffer, undo_list, Qt);
bset_enable_multibyte_characters (current_buffer, Qnil);
bset_undo_list (current_buffer, Qt);
record_unwind_protect (decide_coding_unwind, unwind_data);
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
@ -4154,7 +4154,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
&& NILP (replace))
/* Visiting a file with these coding system makes the buffer
unibyte. */
BSET (current_buffer, enable_multibyte_characters, Qnil);
bset_enable_multibyte_characters (current_buffer, Qnil);
}
coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
@ -4197,13 +4197,13 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (!NILP (visit))
{
if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange)
BSET (current_buffer, undo_list, Qnil);
bset_undo_list (current_buffer, Qnil);
if (NILP (handler))
{
current_buffer->modtime = mtime;
current_buffer->modtime_size = st.st_size;
BSET (current_buffer, filename, orig_filename);
bset_filename (current_buffer, orig_filename);
}
SAVE_MODIFF = MODIFF;
@ -4248,7 +4248,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* Save old undo list and don't record undo for decoding. */
old_undo = BVAR (current_buffer, undo_list);
BSET (current_buffer, undo_list, Qt);
bset_undo_list (current_buffer, Qt);
if (NILP (replace))
{
@ -4340,7 +4340,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (NILP (visit))
{
BSET (current_buffer, undo_list, old_undo);
bset_undo_list (current_buffer, old_undo);
if (CONSP (old_undo) && inserted != old_inserted)
{
/* Adjust the last undo record for the size change during
@ -4355,7 +4355,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
else
/* If undo_list was Qt before, keep it that way.
Otherwise start with an empty undo_list. */
BSET (current_buffer, undo_list, EQ (old_undo, Qt) ? Qt : Qnil);
bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
unbind_to (count1, Qnil);
}
@ -4595,7 +4595,7 @@ This calls `write-region-annotate-functions' at the start, and
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
BSET (current_buffer, filename, visit_file);
bset_filename (current_buffer, visit_file);
}
UNGCPRO;
return val;
@ -4811,7 +4811,7 @@ This calls `write-region-annotate-functions' at the start, and
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
BSET (current_buffer, filename, visit_file);
bset_filename (current_buffer, visit_file);
update_mode_lines++;
}
else if (quietly)
@ -5306,7 +5306,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
FILE *stream = NULL;
ptrdiff_t count = SPECPDL_INDEX ();
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
int old_message_p = 0;
bool old_message_p = 0;
struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)

86
src/fns.c
View File

@ -628,7 +628,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
ptrdiff_t thislen_byte = SBYTES (this);
memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
if (string_get_intervals (this))
if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
@ -640,7 +640,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
/* Copy a single-byte string to a multibyte string. */
else if (STRINGP (this) && STRINGP (val))
{
if (string_get_intervals (this))
if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
@ -1060,7 +1060,7 @@ If you're not sure, whether to use `string-as-multibyte' or
str_as_multibyte (SDATA (new_string), nbytes,
SBYTES (string), NULL);
string = new_string;
string_set_intervals (string, NULL);
set_string_intervals (string, NULL);
}
return string;
}
@ -2139,19 +2139,15 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
register ptrdiff_t size, idx;
if (VECTORP (array))
{
register Lisp_Object *p = XVECTOR (array)->contents;
size = ASIZE (array);
for (idx = 0; idx < size; idx++)
p[idx] = item;
}
for (idx = 0, size = ASIZE (array); idx < size; idx++)
ASET (array, idx, item);
else if (CHAR_TABLE_P (array))
{
int i;
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
char_table_set_contents (array, i, item);
CSET (XCHAR_TABLE (array), defalt, item);
set_char_table_contents (array, i, item);
set_char_table_defalt (array, item);
}
else if (STRINGP (array))
{
@ -3663,7 +3659,7 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
/* Set up the free list. */
for (i = 0; i < sz - 1; ++i)
set_hash_next (h, i, make_number (i + 1));
set_hash_next_slot (h, i, make_number (i + 1));
h->next_free = make_number (0);
XSET_HASH_TABLE (table, h);
@ -3760,17 +3756,17 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
}
#endif
h->key_and_value = larger_vector (h->key_and_value,
2 * (new_size - old_size), -1);
h->next = larger_vector (h->next, new_size - old_size, -1);
h->hash = larger_vector (h->hash, new_size - old_size, -1);
h->index = Fmake_vector (make_number (index_size), Qnil);
set_hash_key_and_value (h, larger_vector (h->key_and_value,
2 * (new_size - old_size), -1));
set_hash_next (h, larger_vector (h->next, new_size - old_size, -1));
set_hash_hash (h, larger_vector (h->hash, new_size - old_size, -1));
set_hash_index (h, Fmake_vector (make_number (index_size), Qnil));
/* Update the free list. Do it so that new entries are added at
the end of the free list. This makes some operations like
maphash faster. */
for (i = old_size; i < new_size - 1; ++i)
set_hash_next (h, i, make_number (i + 1));
set_hash_next_slot (h, i, make_number (i + 1));
if (!NILP (h->next_free))
{
@ -3781,7 +3777,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
!NILP (next))
last = next;
set_hash_next (h, XFASTINT (last), make_number (old_size));
set_hash_next_slot (h, XFASTINT (last), make_number (old_size));
}
else
XSETFASTINT (h->next_free, old_size);
@ -3792,8 +3788,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
{
EMACS_UINT hash_code = XUINT (HASH_HASH (h, i));
ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
set_hash_next (h, i, HASH_INDEX (h, start_of_bucket));
set_hash_index (h, start_of_bucket, make_number (i));
set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
set_hash_index_slot (h, start_of_bucket, make_number (i));
}
}
}
@ -3852,16 +3848,16 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
/* Store key/value in the key_and_value vector. */
i = XFASTINT (h->next_free);
h->next_free = HASH_NEXT (h, i);
set_hash_key (h, i, key);
set_hash_value (h, i, value);
set_hash_key_slot (h, i, key);
set_hash_value_slot (h, i, value);
/* Remember its hash code. */
set_hash_hash (h, i, make_number (hash));
set_hash_hash_slot (h, i, make_number (hash));
/* Add new entry to its collision chain. */
start_of_bucket = hash % ASIZE (h->index);
set_hash_next (h, i, HASH_INDEX (h, start_of_bucket));
set_hash_index (h, start_of_bucket, make_number (i));
set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
set_hash_index_slot (h, start_of_bucket, make_number (i));
return i;
}
@ -3892,16 +3888,16 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
/* Take entry out of collision chain. */
if (NILP (prev))
set_hash_index (h, start_of_bucket, HASH_NEXT (h, i));
set_hash_index_slot (h, start_of_bucket, HASH_NEXT (h, i));
else
set_hash_next (h, XFASTINT (prev), HASH_NEXT (h, i));
set_hash_next_slot (h, XFASTINT (prev), HASH_NEXT (h, i));
/* Clear slots in key_and_value and add the slots to
the free list. */
set_hash_key (h, i, Qnil);
set_hash_value (h, i, Qnil);
set_hash_hash (h, i, Qnil);
set_hash_next (h, i, h->next_free);
set_hash_key_slot (h, i, Qnil);
set_hash_value_slot (h, i, Qnil);
set_hash_hash_slot (h, i, Qnil);
set_hash_next_slot (h, i, h->next_free);
h->next_free = make_number (i);
h->count--;
eassert (h->count >= 0);
@ -3927,10 +3923,10 @@ hash_clear (struct Lisp_Hash_Table *h)
for (i = 0; i < size; ++i)
{
set_hash_next (h, i, i < size - 1 ? make_number (i + 1) : Qnil);
set_hash_key (h, i, Qnil);
set_hash_value (h, i, Qnil);
set_hash_hash (h, i, Qnil);
set_hash_next_slot (h, i, i < size - 1 ? make_number (i + 1) : Qnil);
set_hash_key_slot (h, i, Qnil);
set_hash_value_slot (h, i, Qnil);
set_hash_hash_slot (h, i, Qnil);
}
for (i = 0; i < ASIZE (h->index); ++i)
@ -3971,8 +3967,8 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
{
ptrdiff_t i = XFASTINT (idx);
int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
int remove_p;
if (EQ (h->weak, Qkey))
@ -3994,18 +3990,18 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
{
/* Take out of collision chain. */
if (NILP (prev))
set_hash_index (h, bucket, next);
set_hash_index_slot (h, bucket, next);
else
set_hash_next (h, XFASTINT (prev), next);
set_hash_next_slot (h, XFASTINT (prev), next);
/* Add to free list. */
set_hash_next (h, i, h->next_free);
set_hash_next_slot (h, i, h->next_free);
h->next_free = idx;
/* Clear key, value, and hash. */
set_hash_key (h, i, Qnil);
set_hash_value (h, i, Qnil);
set_hash_hash (h, i, Qnil);
set_hash_key_slot (h, i, Qnil);
set_hash_value_slot (h, i, Qnil);
set_hash_hash_slot (h, i, Qnil);
h->count--;
}
@ -4512,7 +4508,7 @@ VALUE. In any case, return VALUE. */)
i = hash_lookup (h, key, &hash);
if (i >= 0)
set_hash_value (h, i, value);
set_hash_value_slot (h, i, value);
else
hash_put (h, key, value, hash);

138
src/fontset.c
View File

@ -185,8 +185,7 @@ void (*check_window_system_func) (void);
/* Prototype declarations for static functions. */
static Lisp_Object fontset_add (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
static void fontset_add (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object fontset_find_font (Lisp_Object, int, struct face *,
int, int);
static void reorder_font_vector (Lisp_Object, struct font *);
@ -213,27 +212,71 @@ fontset_id_valid_p (int id)
/* Return the fontset with ID. No check of ID's validness. */
#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
/* Macros to access special values of FONTSET. */
#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
/* Access special values of FONTSET. */
/* Macros to access special values of (base) FONTSET. */
#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
/* #define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5] */
#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
static void
set_fontset_id (Lisp_Object fontset, Lisp_Object id)
{
set_char_table_extras (fontset, 0, id);
}
/* Macros to access special values of (realized) FONTSET. */
#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
/* #define FONTSET_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4] */
#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
/* #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6] */
#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
/* Access special values of (base) FONTSET. */
#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
static void
set_fontset_name (Lisp_Object fontset, Lisp_Object name)
{
set_char_table_extras (fontset, 1, name);
}
#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
static void
set_fontset_ascii (Lisp_Object fontset, Lisp_Object ascii)
{
set_char_table_extras (fontset, 4, ascii);
}
/* Access special values of (realized) FONTSET. */
#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
static void
set_fontset_base (Lisp_Object fontset, Lisp_Object base)
{
set_char_table_extras (fontset, 2, base);
}
#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
static void
set_fontset_frame (Lisp_Object fontset, Lisp_Object frame)
{
set_char_table_extras (fontset, 3, frame);
}
#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
static void
set_fontset_nofont_face (Lisp_Object fontset, Lisp_Object face)
{
set_char_table_extras (fontset, 5, face);
}
#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
static void
set_fontset_default (Lisp_Object fontset, Lisp_Object def)
{
set_char_table_extras (fontset, 7, def);
}
/* For both base and realized fontset. */
#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
static void
set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
{
set_char_table_extras (fontset, 8, fallback);
}
#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
/* Macros for FONT-DEF and RFONT-DEF of fontset. */
#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
@ -265,7 +308,7 @@ fontset_id_valid_p (int id)
#define RFONT_DEF_NEW(rfont_def, font_def) \
do { \
(rfont_def) = Fmake_vector (make_number (4), Qnil); \
ASET ((rfont_def), 1, (font_def)); \
ASET ((rfont_def), 1, (font_def)); \
RFONT_DEF_SET_SCORE ((rfont_def), 0); \
} while (0)
@ -307,15 +350,17 @@ fontset_ref (Lisp_Object fontset, int c)
replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
append ELT. */
#define FONTSET_ADD(fontset, range, elt, add) \
(NILP (add) \
? (NILP (range) \
? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
: Fset_char_table_range ((fontset), (range), \
Fmake_vector (make_number (1), (elt)))) \
#define FONTSET_ADD(fontset, range, elt, add) \
(NILP (add) \
? (NILP (range) \
? (set_fontset_fallback \
(fontset, Fmake_vector (make_number (1), (elt)))) \
: ((void) \
Fset_char_table_range (fontset, range, \
Fmake_vector (make_number (1), elt)))) \
: fontset_add ((fontset), (range), (elt), (add)))
static Lisp_Object
static void
fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
{
Lisp_Object args[2];
@ -341,10 +386,9 @@ fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Objec
else
{
args[idx] = FONTSET_FALLBACK (fontset);
FONTSET_FALLBACK (fontset)
= NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
set_fontset_fallback
(fontset, NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args));
}
return Qnil;
}
static int
@ -485,7 +529,7 @@ fontset_get_font_group (Lisp_Object fontset, int c)
if (c >= 0)
char_table_set_range (fontset, from, to, font_group);
else
FONTSET_FALLBACK (fontset) = font_group;
set_fontset_fallback (fontset, font_group);
return font_group;
}
@ -720,8 +764,9 @@ fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
if (! EQ (base_fontset, Vdefault_fontset))
{
if (NILP (FONTSET_DEFAULT (fontset)))
FONTSET_DEFAULT (fontset)
= make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
set_fontset_default
(fontset,
make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
default_rfont_def
= fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
@ -781,16 +826,14 @@ make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
fontset = Fmake_char_table (Qfontset, Qnil);
FONTSET_ID (fontset) = make_number (id);
set_fontset_id (fontset, make_number (id));
if (NILP (base))
{
FONTSET_NAME (fontset) = name;
}
set_fontset_name (fontset, name);
else
{
FONTSET_NAME (fontset) = Qnil;
FONTSET_FRAME (fontset) = frame;
FONTSET_BASE (fontset) = base;
set_fontset_name (fontset, Qnil);
set_fontset_frame (fontset, frame);
set_fontset_base (fontset, base);
}
ASET (Vfontset_table, id, fontset);
@ -958,7 +1001,7 @@ face_for_char (FRAME_PTR f, struct face *face, int c, int pos, Lisp_Object objec
else
{
face_id = face_for_font (f, Qnil, face);
FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
set_fontset_nofont_face (fontset, make_number (face_id));
}
}
eassert (face_id >= 0);
@ -1580,7 +1623,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
Lisp_Object tail, fr, alist;
int fontset_id = XINT (FONTSET_ID (fontset));
FONTSET_ASCII (fontset) = fontname;
set_fontset_ascii (fontset, fontname);
name = FONTSET_NAME (fontset);
FOR_EACH_FRAME (tail, fr)
{
@ -1658,7 +1701,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
if (len < 0)
error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
}
else
{
@ -1744,7 +1787,7 @@ fontset_from_font (Lisp_Object font_object)
Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
}
FONTSET_ASCII (fontset) = font_name;
set_fontset_ascii (fontset, font_name);
return XINT (FONTSET_ID (fontset));
}
@ -1916,7 +1959,7 @@ format is the same as above. */)
if (!EQ (fontset, Vdefault_fontset))
{
tables[1] = Fmake_char_table (Qnil, Qnil);
char_table_set_extras (tables[0], 0, tables[1]);
set_char_table_extras (tables[0], 0, tables[1]);
fontsets[1] = Vdefault_fontset;
}
@ -1979,7 +2022,7 @@ format is the same as above. */)
if (c <= MAX_5_BYTE_CHAR)
char_table_set_range (tables[k], c, to, alist);
else
CSET (XCHAR_TABLE (tables[k]), defalt, alist);
set_char_table_defalt (tables[k], alist);
/* At last, change each elements to font names. */
for (; CONSP (alist); alist = XCDR (alist))
@ -2161,9 +2204,10 @@ syms_of_fontset (void)
Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
staticpro (&Vdefault_fontset);
FONTSET_ID (Vdefault_fontset) = make_number (0);
FONTSET_NAME (Vdefault_fontset)
= build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
set_fontset_id (Vdefault_fontset, make_number (0));
set_fontset_name
(Vdefault_fontset,
build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
ASET (Vfontset_table, 0, Vdefault_fontset);
next_fontset_id = 1;

111
src/frame.c
View File

@ -19,6 +19,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#define FRAME_INLINE EXTERN_INLINE
#include <stdio.h>
#include <errno.h>
#include <limits.h>
@ -127,6 +129,18 @@ static Lisp_Object Qdelete_frame_functions;
static void x_report_frame_params (struct frame *, Lisp_Object *);
#endif
/* These setters are used only in this file, so they can be private. */
static inline void
fset_buffer_predicate (struct frame *f, Lisp_Object val)
{
f->buffer_predicate = val;
}
static inline void
fset_minibuffer_window (struct frame *f, Lisp_Object val)
{
f->minibuffer_window = val;
}
static void
set_menu_bar_lines_1 (Lisp_Object window, int n)
@ -134,8 +148,8 @@ set_menu_bar_lines_1 (Lisp_Object window, int n)
struct window *w = XWINDOW (window);
w->last_modified = 0;
WSET (w, top_line, make_number (XFASTINT (w->top_line) + n));
WSET (w, total_lines, make_number (XFASTINT (w->total_lines) - n));
wset_top_line (w, make_number (XFASTINT (w->top_line) + n));
wset_total_lines (w, make_number (XFASTINT (w->total_lines) - n));
/* Handle just the top child in a vertical split. */
if (!NILP (w->vchild))
@ -271,7 +285,7 @@ make_frame (int mini_p)
/* Initialize Lisp data. Note that allocate_frame initializes all
Lisp data to nil, so do it only for slots which should not be nil. */
FSET (f, tool_bar_position, Qtop);
fset_tool_bar_position (f, Qtop);
/* Initialize non-Lisp data. Note that allocate_frame zeroes out all
non-Lisp data, so do it only for slots which should not be zero.
@ -291,20 +305,20 @@ make_frame (int mini_p)
if (mini_p)
{
mini_window = make_window ();
WSET (XWINDOW (root_window), next, mini_window);
WSET (XWINDOW (mini_window), prev, root_window);
wset_next (XWINDOW (root_window), mini_window);
wset_prev (XWINDOW (mini_window), root_window);
XWINDOW (mini_window)->mini = 1;
WSET (XWINDOW (mini_window), frame, frame);
FSET (f, minibuffer_window, mini_window);
wset_frame (XWINDOW (mini_window), frame);
fset_minibuffer_window (f, mini_window);
}
else
{
mini_window = Qnil;
WSET (XWINDOW (root_window), next, Qnil);
FSET (f, minibuffer_window, Qnil);
wset_next (XWINDOW (root_window), Qnil);
fset_minibuffer_window (f, Qnil);
}
WSET (XWINDOW (root_window), frame, frame);
wset_frame (XWINDOW (root_window), frame);
/* 10 is arbitrary,
just so that there is "something there."
@ -313,21 +327,21 @@ make_frame (int mini_p)
SET_FRAME_COLS (f, 10);
FRAME_LINES (f) = 10;
WSET (XWINDOW (root_window), total_cols, make_number (10));
WSET (XWINDOW (root_window), total_lines, make_number (mini_p ? 9 : 10));
wset_total_cols (XWINDOW (root_window), make_number (10));
wset_total_lines (XWINDOW (root_window), make_number (mini_p ? 9 : 10));
if (mini_p)
{
WSET (XWINDOW (mini_window), total_cols, make_number (10));
WSET (XWINDOW (mini_window), top_line, make_number (9));
WSET (XWINDOW (mini_window), total_lines, make_number (1));
wset_total_cols (XWINDOW (mini_window), make_number (10));
wset_top_line (XWINDOW (mini_window), make_number (9));
wset_total_lines (XWINDOW (mini_window), make_number (1));
}
/* Choose a buffer for the frame's root window. */
{
Lisp_Object buf;
WSET (XWINDOW (root_window), buffer, Qt);
wset_buffer (XWINDOW (root_window), Qt);
buf = Fcurrent_buffer ();
/* If buf is a 'hidden' buffer (i.e. one whose name starts with
a space), try to find another one. */
@ -341,12 +355,12 @@ make_frame (int mini_p)
etc. Running Lisp functions at this point surely ends in a
SEGV. */
set_window_buffer (root_window, buf, 0, 0);
FSET (f, buffer_list, Fcons (buf, Qnil));
fset_buffer_list (f, Fcons (buf, Qnil));
}
if (mini_p)
{
WSET (XWINDOW (mini_window), buffer, Qt);
wset_buffer (XWINDOW (mini_window), Qt);
set_window_buffer (mini_window,
(NILP (Vminibuffer_list)
? get_minibuffer (0)
@ -354,8 +368,8 @@ make_frame (int mini_p)
0, 0);
}
FSET (f, root_window, root_window);
FSET (f, selected_window, root_window);
fset_root_window (f, root_window);
fset_selected_window (f, root_window);
/* Make sure this window seems more recently used than
a newly-created, never-selected window. */
XWINDOW (f->selected_window)->use_time = ++window_select_count;
@ -395,8 +409,8 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis
XSETFRAME (frame_dummy, f);
GCPRO1 (frame_dummy);
/* If there's no minibuffer frame to use, create one. */
KSET (kb, Vdefault_minibuffer_frame,
call1 (intern ("make-initial-minibuffer-frame"), display));
kset_default_minibuffer_frame
(kb, call1 (intern ("make-initial-minibuffer-frame"), display));
UNGCPRO;
}
@ -404,7 +418,7 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis
= XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
}
FSET (f, minibuffer_window, mini_window);
fset_minibuffer_window (f, mini_window);
/* Make the chosen minibuffer window display the proper minibuffer,
unless it is already showing a minibuffer. */
@ -441,11 +455,12 @@ make_minibuffer_frame (void)
Avoid infinite looping on the window chain by marking next pointer
as nil. */
mini_window = FSET (f, minibuffer_window, f->root_window);
mini_window = f->root_window;
fset_minibuffer_window (f, mini_window);
XWINDOW (mini_window)->mini = 1;
WSET (XWINDOW (mini_window), next, Qnil);
WSET (XWINDOW (mini_window), prev, Qnil);
WSET (XWINDOW (mini_window), frame, frame);
wset_next (XWINDOW (mini_window), Qnil);
wset_prev (XWINDOW (mini_window), Qnil);
wset_frame (XWINDOW (mini_window), frame);
/* Put the proper buffer in that window. */
@ -484,7 +499,7 @@ make_initial_frame (void)
Vframe_list = Fcons (frame, Vframe_list);
tty_frame_count = 1;
FSET (f, name, build_pure_c_string ("F1"));
fset_name (f, build_pure_c_string ("F1"));
f->visible = 1;
f->async_visible = 1;
@ -525,7 +540,7 @@ make_terminal_frame (struct terminal *terminal)
XSETFRAME (frame, f);
Vframe_list = Fcons (frame, Vframe_list);
FSET (f, name, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
f->async_visible = 1; /* Don't let visible be cleared later. */
@ -695,7 +710,7 @@ affects all frames on the same terminal device. */)
/* Make the frame face alist be frame-specific, so that each
frame could change its face definitions independently. */
FSET (f, face_alist, Fcopy_alist (sf->face_alist));
fset_face_alist (f, Fcopy_alist (sf->face_alist));
/* Simple Fcopy_alist isn't enough, because we need the contents of
the vectors which are the CDRs of associations in face_alist to
be copied as well. */
@ -849,7 +864,7 @@ to that frame. */)
(Lisp_Object event)
{
/* Preserve prefix arg that the command loop just cleared. */
KSET (current_kboard, Vprefix_arg, Vcurrent_prefix_arg);
kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
Frun_hooks (1, &Qmouse_leave_buffer_hook);
return do_switch_frame (event, 0, 0, Qnil);
}
@ -1282,7 +1297,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
/* Mark all the windows that used to be on FRAME as deleted, and then
remove the reference to them. */
delete_all_child_windows (f->root_window);
FSET (f, root_window, Qnil);
fset_root_window (f, Qnil);
Vframe_list = Fdelq (frame, Vframe_list);
FRAME_SET_VISIBLE (f, 0);
@ -1291,7 +1306,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
garbage collection. The frame object itself may not be garbage
collected until much later, because recent_keys and other data
structures can still refer to it. */
FSET (f, menu_bar_vector, Qnil);
fset_menu_bar_vector (f, Qnil);
free_font_driver_list (f);
xfree (f->namebuf);
@ -1443,11 +1458,11 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
if (NILP (frame_with_minibuf))
abort ();
KSET (kb, Vdefault_minibuffer_frame, frame_with_minibuf);
kset_default_minibuffer_frame (kb, frame_with_minibuf);
}
else
/* No frames left on this kboard--say no minibuffer either. */
KSET (kb, Vdefault_minibuffer_frame, Qnil);
kset_default_minibuffer_frame (kb, Qnil);
}
/* Cause frame titles to update--necessary if we now have just one frame. */
@ -1685,7 +1700,7 @@ make_frame_visible_1 (Lisp_Object window)
w = XWINDOW (window);
if (!NILP (w->buffer))
BSET (XBUFFER (w->buffer), display_time, Fcurrent_time ());
bset_display_time (XBUFFER (w->buffer), Fcurrent_time ());
if (!NILP (w->vchild))
make_frame_visible_1 (w->vchild);
@ -1919,7 +1934,7 @@ The redirection lasts until `redirect-frame-focus' is called to change it. */)
f = XFRAME (frame);
FSET (f, focus_frame, focus_frame);
fset_focus_frame (f, focus_frame);
if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
(*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
@ -1984,10 +1999,10 @@ frames_discard_buffer (Lisp_Object buffer)
FOR_EACH_FRAME (tail, frame)
{
FSET (XFRAME (frame), buffer_list,
Fdelq (buffer, XFRAME (frame)->buffer_list));
FSET (XFRAME (frame), buried_buffer_list,
Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
fset_buffer_list
(XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
fset_buried_buffer_list
(XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
}
}
@ -2054,7 +2069,7 @@ set_term_frame_name (struct frame *f, Lisp_Object name)
error ("Frame names of the form F<num> are usurped by Emacs");
}
FSET (f, name, name);
fset_name (f, name);
update_mode_lines = 1;
}
@ -2071,7 +2086,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
for (; CONSP (val); val = XCDR (val))
if (!NILP (Fbuffer_live_p (XCAR (val))))
list = Fcons (XCAR (val), list);
FSET (f, buffer_list, Fnreverse (list));
fset_buffer_list (f, Fnreverse (list));
return;
}
if (EQ (prop, Qburied_buffer_list))
@ -2080,7 +2095,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
for (; CONSP (val); val = XCDR (val))
if (!NILP (Fbuffer_live_p (XCAR (val))))
list = Fcons (XCAR (val), list);
FSET (f, buried_buffer_list, Fnreverse (list));
fset_buried_buffer_list (f, Fnreverse (list));
return;
}
@ -2098,7 +2113,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
case SYMBOL_LOCALIZED:
{ struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
swap_in_global_binding (sym);
break;
}
@ -2117,7 +2132,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
/* Update the frame parameter alist. */
old_alist_elt = Fassq (prop, f->param_alist);
if (EQ (old_alist_elt, Qnil))
FSET (f, param_alist, Fcons (Fcons (prop, val), f->param_alist));
fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
else
Fsetcdr (old_alist_elt, val);
@ -2125,7 +2140,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
in addition to the alist. */
if (EQ (prop, Qbuffer_predicate))
FSET (f, buffer_predicate, val);
fset_buffer_predicate (f, val);
if (! FRAME_WINDOW_P (f))
{
@ -2145,7 +2160,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
/* Install the chosen minibuffer window, with proper buffer. */
FSET (f, minibuffer_window, val);
fset_minibuffer_window (f, val);
}
}

114
src/frame.h
View File

@ -25,6 +25,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
INLINE_HEADER_BEGIN
#ifndef FRAME_INLINE
# define FRAME_INLINE INLINE
#endif
/* Miscellanea. */
@ -80,10 +85,6 @@ struct terminal;
struct font_driver_list;
/* Most code should use this macro to set Lisp field in struct frame. */
#define FSET(f, field, value) ((f)->field = (value))
struct frame
{
struct vectorlike_header header;
@ -499,6 +500,109 @@ struct frame
unsigned long foreground_pixel;
};
/* Most code should use these functions to set Lisp fields in struct frame. */
FRAME_INLINE void
fset_buffer_list (struct frame *f, Lisp_Object val)
{
f->buffer_list = val;
}
FRAME_INLINE void
fset_buried_buffer_list (struct frame *f, Lisp_Object val)
{
f->buried_buffer_list = val;
}
FRAME_INLINE void
fset_condemned_scroll_bars (struct frame *f, Lisp_Object val)
{
f->condemned_scroll_bars = val;
}
FRAME_INLINE void
fset_current_tool_bar_string (struct frame *f, Lisp_Object val)
{
f->current_tool_bar_string = val;
}
FRAME_INLINE void
fset_desired_tool_bar_string (struct frame *f, Lisp_Object val)
{
f->desired_tool_bar_string = val;
}
FRAME_INLINE void
fset_face_alist (struct frame *f, Lisp_Object val)
{
f->face_alist = val;
}
FRAME_INLINE void
fset_focus_frame (struct frame *f, Lisp_Object val)
{
f->focus_frame = val;
}
FRAME_INLINE void
fset_icon_name (struct frame *f, Lisp_Object val)
{
f->icon_name = val;
}
FRAME_INLINE void
fset_menu_bar_items (struct frame *f, Lisp_Object val)
{
f->menu_bar_items = val;
}
FRAME_INLINE void
fset_menu_bar_vector (struct frame *f, Lisp_Object val)
{
f->menu_bar_vector = val;
}
FRAME_INLINE void
fset_menu_bar_window (struct frame *f, Lisp_Object val)
{
f->menu_bar_window = val;
}
FRAME_INLINE void
fset_name (struct frame *f, Lisp_Object val)
{
f->name = val;
}
FRAME_INLINE void
fset_param_alist (struct frame *f, Lisp_Object val)
{
f->param_alist = val;
}
FRAME_INLINE void
fset_root_window (struct frame *f, Lisp_Object val)
{
f->root_window = val;
}
FRAME_INLINE void
fset_scroll_bars (struct frame *f, Lisp_Object val)
{
f->scroll_bars = val;
}
FRAME_INLINE void
fset_selected_window (struct frame *f, Lisp_Object val)
{
f->selected_window = val;
}
FRAME_INLINE void
fset_title (struct frame *f, Lisp_Object val)
{
f->title = val;
}
FRAME_INLINE void
fset_tool_bar_items (struct frame *f, Lisp_Object val)
{
f->tool_bar_items = val;
}
FRAME_INLINE void
fset_tool_bar_position (struct frame *f, Lisp_Object val)
{
f->tool_bar_position = val;
}
FRAME_INLINE void
fset_tool_bar_window (struct frame *f, Lisp_Object val)
{
f->tool_bar_window = val;
}
#define FRAME_KBOARD(f) ((f)->terminal->kboard)
/* Return a pointer to the image cache of frame F. */
@ -1146,4 +1250,6 @@ extern void set_frame_menubar (FRAME_PTR, int, int);
#endif /* HAVE_WINDOW_SYSTEM */
INLINE_HEADER_END
#endif /* not EMACS_FRAME_H */

2
src/gnutls.c
View File

@ -830,7 +830,7 @@ one trustfile (usually a CA bundle). */)
XPROCESS (proc)->gnutls_state = NULL;
XPROCESS (proc)->gnutls_x509_cred = NULL;
XPROCESS (proc)->gnutls_anon_cred = NULL;
PSET (XPROCESS (proc), gnutls_cred_type, type);
pset_gnutls_cred_type (XPROCESS (proc), type);
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
GNUTLS_LOG (1, max_log_level, "allocating credentials");

10
src/indent.c
View File

@ -141,7 +141,7 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab)
struct Lisp_Vector *widthtab;
if (!VECTORP (BVAR (buf, width_table)))
BSET (buf, width_table, Fmake_vector (make_number (256), make_number (0)));
bset_width_table (buf, Fmake_vector (make_number (256), make_number (0)));
widthtab = XVECTOR (BVAR (buf, width_table));
if (widthtab->header.size != 256)
abort ();
@ -166,7 +166,7 @@ width_run_cache_on_off (void)
{
free_region_cache (current_buffer->width_run_cache);
current_buffer->width_run_cache = 0;
BSET (current_buffer, width_table, Qnil);
bset_width_table (current_buffer, Qnil);
}
}
else
@ -336,7 +336,7 @@ current_column (void)
/* If the buffer has overlays, text properties,
or multibyte characters, use a more general algorithm. */
if (buffer_get_intervals (current_buffer)
if (buffer_intervals (current_buffer)
|| buffer_has_overlays ()
|| Z != Z_BYTE)
return current_column_1 ();
@ -2003,7 +2003,7 @@ whether or not it is currently displayed in some window. */)
old_buffer = w->buffer;
old_charpos = XMARKER (w->pointm)->charpos;
old_bytepos = XMARKER (w->pointm)->bytepos;
WSET (w, buffer, Fcurrent_buffer ());
wset_buffer (w, Fcurrent_buffer ());
set_marker_both (w->pointm, w->buffer,
BUF_PT (current_buffer), BUF_PT_BYTE (current_buffer));
}
@ -2146,7 +2146,7 @@ whether or not it is currently displayed in some window. */)
if (BUFFERP (old_buffer))
{
WSET (w, buffer, old_buffer);
wset_buffer (w, old_buffer);
set_marker_both (w->pointm, w->buffer,
old_charpos, old_bytepos);
}

20
src/insdel.c
View File

@ -844,10 +844,10 @@ insert_1_both (const char *string,
PT + nchars, PT_BYTE + nbytes,
before_markers);
if (buffer_get_intervals (current_buffer))
if (buffer_intervals (current_buffer))
offset_intervals (current_buffer, PT, nchars);
if (!inherit && buffer_get_intervals (current_buffer))
if (!inherit && buffer_intervals (current_buffer))
set_text_properties (make_number (PT), make_number (PT + nchars),
Qnil, Qnil, Qnil);
@ -976,7 +976,7 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
offset_intervals (current_buffer, PT, nchars);
intervals = string_get_intervals (string);
intervals = string_intervals (string);
/* Get the intervals for the part of the string we are inserting. */
if (nbytes < SBYTES (string))
intervals = copy_intervals (intervals, pos, nchars);
@ -1017,7 +1017,7 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes)
adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes,
GPT, GPT_BYTE, 0);
if (buffer_get_intervals (current_buffer))
if (buffer_intervals (current_buffer))
{
offset_intervals (current_buffer, GPT - nchars, nchars);
graft_intervals_into_buffer (NULL, GPT - nchars, nchars,
@ -1157,11 +1157,11 @@ insert_from_buffer_1 (struct buffer *buf,
PT_BYTE + outgoing_nbytes,
0);
if (buffer_get_intervals (current_buffer))
if (buffer_intervals (current_buffer))
offset_intervals (current_buffer, PT, nchars);
/* Get the intervals for the part of the string we are inserting. */
intervals = buffer_get_intervals (buf);
intervals = buffer_intervals (buf);
if (nchars < BUF_Z (buf) - BUF_BEG (buf))
{
if (buf == current_buffer && PT <= from)
@ -1226,7 +1226,7 @@ adjust_after_replace (ptrdiff_t from, ptrdiff_t from_byte,
else if (len < nchars_del)
adjust_overlays_for_delete (from, nchars_del - len);
if (buffer_get_intervals (current_buffer))
if (buffer_intervals (current_buffer))
offset_intervals (current_buffer, from, len - nchars_del);
if (from < PT)
@ -1412,7 +1412,7 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
/* Get the intervals for the part of the string we are inserting--
not including the combined-before bytes. */
intervals = string_get_intervals (new);
intervals = string_intervals (new);
/* Insert those intervals. */
graft_intervals_into_buffer (intervals, from, inschars,
current_buffer, inherit);
@ -1792,7 +1792,7 @@ modify_region (struct buffer *buffer, ptrdiff_t start, ptrdiff_t end,
if (! preserve_chars_modiff)
CHARS_MODIFF = MODIFF;
BSET (buffer, point_before_scroll, Qnil);
bset_point_before_scroll (buffer, Qnil);
if (buffer != old_buffer)
set_buffer_internal (old_buffer);
@ -1822,7 +1822,7 @@ prepare_to_modify_buffer (ptrdiff_t start, ptrdiff_t end,
if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
++windows_or_buffers_changed;
if (buffer_get_intervals (current_buffer))
if (buffer_intervals (current_buffer))
{
if (preserve_ptr)
{

194
src/intervals.c
View File

@ -62,6 +62,38 @@ static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
/* Utility functions for intervals. */
/* Use these functions to set Lisp_Object
or pointer slots of struct interval. */
static inline void
set_interval_object (INTERVAL i, Lisp_Object obj)
{
eassert (BUFFERP (obj) || STRINGP (obj));
i->up_obj = 1;
i->up.obj = obj;
}
static inline void
set_interval_left (INTERVAL i, INTERVAL left)
{
i->left = left;
}
static inline void
set_interval_right (INTERVAL i, INTERVAL right)
{
i->right = right;
}
/* Make the parent of D be whatever the parent of S is, regardless
of the type. This is used when balancing an interval tree. */
static inline void
copy_interval_parent (INTERVAL d, INTERVAL s)
{
d->up = s->up;
d->up_obj = s->up_obj;
}
/* Create the root interval of some object, a buffer or string. */
@ -79,18 +111,18 @@ create_root_interval (Lisp_Object parent)
new->total_length = (BUF_Z (XBUFFER (parent))
- BUF_BEG (XBUFFER (parent)));
eassert (0 <= TOTAL_LENGTH (new));
buffer_set_intervals (XBUFFER (parent), new);
set_buffer_intervals (XBUFFER (parent), new);
new->position = BEG;
}
else if (STRINGP (parent))
{
new->total_length = SCHARS (parent);
eassert (0 <= TOTAL_LENGTH (new));
string_set_intervals (parent, new);
set_string_intervals (parent, new);
new->position = 0;
}
interval_set_object (new, parent);
set_interval_object (new, parent);
return new;
}
@ -104,7 +136,7 @@ copy_properties (register INTERVAL source, register INTERVAL target)
return;
COPY_INTERVAL_CACHE (source, target);
interval_set_plist (target, Fcopy_sequence (source->plist));
set_interval_plist (target, Fcopy_sequence (source->plist));
}
/* Merge the properties of interval SOURCE into the properties
@ -140,7 +172,7 @@ merge_properties (register INTERVAL source, register INTERVAL target)
if (NILP (val))
{
val = XCAR (o);
interval_set_plist (target, Fcons (sym, Fcons (val, target->plist)));
set_interval_plist (target, Fcons (sym, Fcons (val, target->plist)));
}
o = XCDR (o);
}
@ -322,21 +354,21 @@ rotate_right (INTERVAL interval)
if (! ROOT_INTERVAL_P (interval))
{
if (AM_LEFT_CHILD (interval))
interval_set_left (INTERVAL_PARENT (interval), B);
set_interval_left (INTERVAL_PARENT (interval), B);
else
interval_set_right (INTERVAL_PARENT (interval), B);
set_interval_right (INTERVAL_PARENT (interval), B);
}
interval_copy_parent (B, interval);
copy_interval_parent (B, interval);
/* Make B the parent of A */
i = B->right;
interval_set_right (B, interval);
interval_set_parent (interval, B);
set_interval_right (B, interval);
set_interval_parent (interval, B);
/* Make A point to c */
interval_set_left (interval, i);
set_interval_left (interval, i);
if (i)
interval_set_parent (i, interval);
set_interval_parent (i, interval);
/* A's total length is decreased by the length of B and its left child. */
interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
@ -369,21 +401,21 @@ rotate_left (INTERVAL interval)
if (! ROOT_INTERVAL_P (interval))
{
if (AM_LEFT_CHILD (interval))
interval_set_left (INTERVAL_PARENT (interval), B);
set_interval_left (INTERVAL_PARENT (interval), B);
else
interval_set_right (INTERVAL_PARENT (interval), B);
set_interval_right (INTERVAL_PARENT (interval), B);
}
interval_copy_parent (B, interval);
copy_interval_parent (B, interval);
/* Make B the parent of A */
i = B->left;
interval_set_left (B, interval);
interval_set_parent (interval, B);
set_interval_left (B, interval);
set_interval_parent (interval, B);
/* Make A point to c */
interval_set_right (interval, i);
set_interval_right (interval, i);
if (i)
interval_set_parent (i, interval);
set_interval_parent (i, interval);
/* A's total length is decreased by the length of B and its right child. */
interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
@ -455,9 +487,9 @@ balance_possible_root_interval (register INTERVAL interval)
if (have_parent)
{
if (BUFFERP (parent))
buffer_set_intervals (XBUFFER (parent), interval);
set_buffer_intervals (XBUFFER (parent), interval);
else if (STRINGP (parent))
string_set_intervals (parent, interval);
set_string_intervals (parent, interval);
}
return interval;
@ -493,9 +525,9 @@ buffer_balance_intervals (struct buffer *b)
INTERVAL i;
eassert (b != NULL);
i = buffer_get_intervals (b);
i = buffer_intervals (b);
if (i)
buffer_set_intervals (b, balance_an_interval (i));
set_buffer_intervals (b, balance_an_interval (i));
}
/* Split INTERVAL into two pieces, starting the second piece at
@ -519,20 +551,20 @@ split_interval_right (INTERVAL interval, ptrdiff_t offset)
ptrdiff_t new_length = LENGTH (interval) - offset;
new->position = position + offset;
interval_set_parent (new, interval);
set_interval_parent (new, interval);
if (NULL_RIGHT_CHILD (interval))
{
interval_set_right (interval, new);
set_interval_right (interval, new);
new->total_length = new_length;
eassert (0 <= TOTAL_LENGTH (new));
}
else
{
/* Insert the new node between INTERVAL and its right child. */
interval_set_right (new, interval->right);
interval_set_parent (interval->right, new);
interval_set_right (interval, new);
set_interval_right (new, interval->right);
set_interval_parent (interval->right, new);
set_interval_right (interval, new);
new->total_length = new_length + new->right->total_length;
eassert (0 <= TOTAL_LENGTH (new));
balance_an_interval (new);
@ -564,20 +596,20 @@ split_interval_left (INTERVAL interval, ptrdiff_t offset)
new->position = interval->position;
interval->position = interval->position + offset;
interval_set_parent (new, interval);
set_interval_parent (new, interval);
if (NULL_LEFT_CHILD (interval))
{
interval_set_left (interval, new);
set_interval_left (interval, new);
new->total_length = new_length;
eassert (0 <= TOTAL_LENGTH (new));
}
else
{
/* Insert the new node between INTERVAL and its left child. */
interval_set_left (new, interval->left);
interval_set_parent (new->left, new);
interval_set_left (interval, new);
set_interval_left (new, interval->left);
set_interval_parent (new->left, new);
set_interval_left (interval, new);
new->total_length = new_length + new->left->total_length;
eassert (0 <= TOTAL_LENGTH (new));
balance_an_interval (new);
@ -952,20 +984,20 @@ adjust_intervals_for_insertion (INTERVAL tree,
RESET_INTERVAL (&newi);
pleft = prev ? prev->plist : Qnil;
pright = i ? i->plist : Qnil;
interval_set_plist (&newi, merge_properties_sticky (pleft, pright));
set_interval_plist (&newi, merge_properties_sticky (pleft, pright));
if (! prev) /* i.e. position == BEG */
{
if (! intervals_equal (i, &newi))
{
i = split_interval_left (i, length);
interval_set_plist (i, newi.plist);
set_interval_plist (i, newi.plist);
}
}
else if (! intervals_equal (prev, &newi))
{
prev = split_interval_right (prev, position - prev->position);
interval_set_plist (prev, newi.plist);
set_interval_plist (prev, newi.plist);
if (i && intervals_equal (prev, i))
merge_interval_right (prev);
}
@ -1190,8 +1222,8 @@ delete_node (register INTERVAL i)
this->total_length += migrate_amt;
}
eassert (0 <= TOTAL_LENGTH (this));
interval_set_left (this, migrate);
interval_set_parent (migrate, this);
set_interval_left (this, migrate);
set_interval_parent (migrate, this);
return i->right;
}
@ -1216,12 +1248,12 @@ delete_interval (register INTERVAL i)
GET_INTERVAL_OBJECT (owner, i);
parent = delete_node (i);
if (parent)
interval_set_object (parent, owner);
set_interval_object (parent, owner);
if (BUFFERP (owner))
buffer_set_intervals (XBUFFER (owner), parent);
set_buffer_intervals (XBUFFER (owner), parent);
else if (STRINGP (owner))
string_set_intervals (owner, parent);
set_string_intervals (owner, parent);
else
abort ();
@ -1231,15 +1263,15 @@ delete_interval (register INTERVAL i)
parent = INTERVAL_PARENT (i);
if (AM_LEFT_CHILD (i))
{
interval_set_left (parent, delete_node (i));
set_interval_left (parent, delete_node (i));
if (parent->left)
interval_set_parent (parent->left, parent);
set_interval_parent (parent->left, parent);
}
else
{
interval_set_right (parent, delete_node (i));
set_interval_right (parent, delete_node (i));
if (parent->right)
interval_set_parent (parent->right, parent);
set_interval_parent (parent->right, parent);
}
}
@ -1320,8 +1352,8 @@ static void
adjust_intervals_for_deletion (struct buffer *buffer,
ptrdiff_t start, ptrdiff_t length)
{
register ptrdiff_t left_to_delete = length;
register INTERVAL tree = buffer_get_intervals (buffer);
ptrdiff_t left_to_delete = length;
INTERVAL tree = buffer_intervals (buffer);
Lisp_Object parent;
ptrdiff_t offset;
@ -1336,7 +1368,7 @@ adjust_intervals_for_deletion (struct buffer *buffer,
if (length == TOTAL_LENGTH (tree))
{
buffer_set_intervals (buffer, NULL);
set_buffer_intervals (buffer, NULL);
return;
}
@ -1353,10 +1385,10 @@ adjust_intervals_for_deletion (struct buffer *buffer,
{
left_to_delete -= interval_deletion_adjustment (tree, start - offset,
left_to_delete);
tree = buffer_get_intervals (buffer);
tree = buffer_intervals (buffer);
if (left_to_delete == tree->total_length)
{
buffer_set_intervals (buffer, NULL);
set_buffer_intervals (buffer, NULL);
return;
}
}
@ -1370,11 +1402,11 @@ adjust_intervals_for_deletion (struct buffer *buffer,
void
offset_intervals (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length)
{
if (!buffer_get_intervals (buffer) || length == 0)
if (!buffer_intervals (buffer) || length == 0)
return;
if (length > 0)
adjust_intervals_for_insertion (buffer_get_intervals (buffer),
adjust_intervals_for_insertion (buffer_intervals (buffer),
start, length);
else
{
@ -1510,9 +1542,9 @@ reproduce_interval (INTERVAL source)
copy_properties (source, target);
if (! NULL_LEFT_CHILD (source))
interval_set_left (target, reproduce_tree (source->left, target));
set_interval_left (target, reproduce_tree (source->left, target));
if (! NULL_RIGHT_CHILD (source))
interval_set_right (target, reproduce_tree (source->right, target));
set_interval_right (target, reproduce_tree (source->right, target));
return target;
}
@ -1525,18 +1557,16 @@ reproduce_interval (INTERVAL source)
static INTERVAL
reproduce_tree (INTERVAL source, INTERVAL parent)
{
register INTERVAL target = reproduce_interval (source);
interval_set_parent (target, parent);
INTERVAL target = reproduce_interval (source);
set_interval_parent (target, parent);
return target;
}
static INTERVAL
reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
{
register INTERVAL target = reproduce_interval (source);
interval_set_object (target, parent);
INTERVAL target = reproduce_interval (source);
set_interval_object (target, parent);
return target;
}
@ -1582,12 +1612,10 @@ graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position,
ptrdiff_t length, struct buffer *buffer,
int inherit)
{
register INTERVAL under, over, this;
register INTERVAL tree;
INTERVAL tree = buffer_intervals (buffer);
INTERVAL under, over, this;
ptrdiff_t over_used;
tree = buffer_get_intervals (buffer);
/* If the new text has no properties, then with inheritance it
becomes part of whatever interval it was inserted into.
To prevent inheritance, we must clear out the properties
@ -1616,9 +1644,9 @@ graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position,
Lisp_Object buf;
XSETBUFFER (buf, buffer);
buffer_set_intervals (buffer, reproduce_tree_obj (source, buf));
buffer_get_intervals (buffer)->position = BUF_BEG (buffer);
eassert (buffer_get_intervals (buffer)->up_obj == 1);
set_buffer_intervals (buffer, reproduce_tree_obj (source, buf));
buffer_intervals (buffer)->position = BUF_BEG (buffer);
eassert (buffer_intervals (buffer)->up_obj == 1);
return;
}
else if (!tree)
@ -1859,7 +1887,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
int have_overlays;
ptrdiff_t original_position;
BSET (current_buffer, point_before_scroll, Qnil);
bset_point_before_scroll (current_buffer, Qnil);
if (charpos == PT)
return;
@ -1876,7 +1904,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
/* If we have no text properties and overlays,
then we can do it quickly. */
if (!buffer_get_intervals (current_buffer) && ! have_overlays)
if (!buffer_intervals (current_buffer) && ! have_overlays)
{
temp_set_point_both (current_buffer, charpos, bytepos);
return;
@ -1885,7 +1913,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
/* Set TO to the interval containing the char after CHARPOS,
and TOPREV to the interval containing the char before CHARPOS.
Either one may be null. They may be equal. */
to = find_interval (buffer_get_intervals (current_buffer), charpos);
to = find_interval (buffer_intervals (current_buffer), charpos);
if (charpos == BEGV)
toprev = 0;
else if (to && to->position == charpos)
@ -1899,7 +1927,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
and FROMPREV to the interval containing the char before PT.
Either one may be null. They may be equal. */
/* We could cache this and save time. */
from = find_interval (buffer_get_intervals (current_buffer), buffer_point);
from = find_interval (buffer_intervals (current_buffer), buffer_point);
if (buffer_point == BEGV)
fromprev = 0;
else if (from && from->position == PT)
@ -2005,7 +2033,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
/* Set TO to the interval containing the char after CHARPOS,
and TOPREV to the interval containing the char before CHARPOS.
Either one may be null. They may be equal. */
to = find_interval (buffer_get_intervals (current_buffer), charpos);
to = find_interval (buffer_intervals (current_buffer), charpos);
if (charpos == BEGV)
toprev = 0;
else if (to && to->position == charpos)
@ -2138,11 +2166,11 @@ get_property_and_range (ptrdiff_t pos, Lisp_Object prop, Lisp_Object *val,
INTERVAL i, prev, next;
if (NILP (object))
i = find_interval (buffer_get_intervals (current_buffer), pos);
i = find_interval (buffer_intervals (current_buffer), pos);
else if (BUFFERP (object))
i = find_interval (buffer_get_intervals (XBUFFER (object)), pos);
i = find_interval (buffer_intervals (XBUFFER (object)), pos);
else if (STRINGP (object))
i = find_interval (string_get_intervals (object), pos);
i = find_interval (string_intervals (object), pos);
else
abort ();
@ -2269,13 +2297,13 @@ void
copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
ptrdiff_t position, ptrdiff_t length)
{
INTERVAL interval_copy = copy_intervals (buffer_get_intervals (buffer),
INTERVAL interval_copy = copy_intervals (buffer_intervals (buffer),
position, length);
if (!interval_copy)
return;
interval_set_object (interval_copy, string);
string_set_intervals (string, interval_copy);
set_interval_object (interval_copy, string);
set_string_intervals (string, interval_copy);
}
/* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
@ -2288,8 +2316,8 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
ptrdiff_t pos = 0;
ptrdiff_t end = SCHARS (s1);
i1 = find_interval (string_get_intervals (s1), 0);
i2 = find_interval (string_get_intervals (s2), 0);
i1 = find_interval (string_intervals (s1), 0);
i2 = find_interval (string_intervals (s2), 0);
while (pos < end)
{
@ -2414,13 +2442,13 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
{
if ((i)->left)
{
interval_set_plist (i, i->left->plist);
set_interval_plist (i, i->left->plist);
(i)->left->total_length = 0;
delete_interval ((i)->left);
}
else
{
interval_set_plist (i, i->right->plist);
set_interval_plist (i, i->right->plist);
(i)->right->total_length = 0;
delete_interval ((i)->right);
}
@ -2434,7 +2462,7 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
void
set_intervals_multibyte (int multi_flag)
{
INTERVAL i = buffer_get_intervals (current_buffer);
INTERVAL i = buffer_intervals (current_buffer);
if (i)
set_intervals_multibyte_1 (i, multi_flag, BEG, BEG_BYTE, Z, Z_BYTE);

39
src/intervals.h
View File

@ -137,47 +137,16 @@ struct interval
or pointer slots of struct interval. */
INTERVALS_INLINE void
interval_set_parent (INTERVAL i, INTERVAL parent)
set_interval_parent (INTERVAL i, INTERVAL parent)
{
i->up_obj = 0;
i->up.interval = parent;
}
INTERVALS_INLINE void
interval_set_object (INTERVAL i, Lisp_Object obj)
{
eassert (BUFFERP (obj) || STRINGP (obj));
i->up_obj = 1;
i->up.obj = obj;
}
INTERVALS_INLINE void
interval_set_left (INTERVAL i, INTERVAL left)
{
i->left = left;
}
INTERVALS_INLINE void
interval_set_right (INTERVAL i, INTERVAL right)
{
i->right = right;
}
INTERVALS_INLINE Lisp_Object
interval_set_plist (INTERVAL i, Lisp_Object plist)
set_interval_plist (INTERVAL i, Lisp_Object plist)
{
i->plist = plist;
return plist;
}
/* Make the parent of D be whatever the parent of S is, regardless
of the type. This is used when balancing an interval tree. */
INTERVALS_INLINE void
interval_copy_parent (INTERVAL d, INTERVAL s)
{
d->up = s->up;
d->up_obj = s->up_obj;
}
/* Get the parent interval, if any, otherwise a null pointer. Useful
@ -191,11 +160,11 @@ interval_copy_parent (INTERVAL d, INTERVAL s)
{ \
(i)->total_length = (i)->position = 0; \
(i)->left = (i)->right = NULL; \
interval_set_parent (i, NULL); \
set_interval_parent (i, NULL); \
(i)->write_protect = 0; \
(i)->visible = 0; \
(i)->front_sticky = (i)->rear_sticky = 0; \
interval_set_plist (i, Qnil); \
set_interval_plist (i, Qnil); \
}
/* Copy the cached property values of interval FROM to interval TO. */

197
src/keyboard.c
View File

@ -18,6 +18,9 @@ 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>
#define KEYBOARD_INLINE EXTERN_INLINE
#include <signal.h>
#include <stdio.h>
#include <setjmp.h>
@ -469,6 +472,53 @@ static void handle_user_signal (int);
static char *find_user_signal_name (int);
static int store_user_signal_events (void);
/* These setters are used only in this file, so they can be private. */
static inline void
kset_echo_string (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (echo_string) = val;
}
static inline void
kset_kbd_queue (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (kbd_queue) = val;
}
static inline void
kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vkeyboard_translate_table) = val;
}
static inline void
kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vlast_prefix_arg) = val;
}
static inline void
kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vlast_repeatable_command) = val;
}
static inline void
kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vlocal_function_key_map) = val;
}
static inline void
kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Voverriding_terminal_local_map) = val;
}
static inline void
kset_real_last_command (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vreal_last_command) = val;
}
static inline void
kset_system_key_syms (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (system_key_syms) = val;
}
/* Add C to the echo string, if echoing is going on.
C can be a character, which is printed prettily ("M-C-x" and all that
@ -551,8 +601,9 @@ echo_char (Lisp_Object c)
else if (STRINGP (echo_string))
echo_string = concat2 (echo_string, build_string (" "));
KSET (current_kboard, echo_string,
concat2 (echo_string, make_string (buffer, ptr - buffer)));
kset_echo_string
(current_kboard,
concat2 (echo_string, make_string (buffer, ptr - buffer)));
echo_now ();
}
@ -597,8 +648,9 @@ echo_dash (void)
/* Put a dash at the end of the buffer temporarily,
but make it go away when the next character is added. */
KSET (current_kboard, echo_string,
concat2 (KVAR (current_kboard, echo_string), build_string ("-")));
kset_echo_string
(current_kboard,
concat2 (KVAR (current_kboard, echo_string), build_string ("-")));
echo_now ();
}
@ -660,7 +712,7 @@ cancel_echoing (void)
{
current_kboard->immediate_echo = 0;
current_kboard->echo_after_prompt = -1;
KSET (current_kboard, echo_string, Qnil);
kset_echo_string (current_kboard, Qnil);
ok_to_echo_at_next_pause = NULL;
echo_kboard = NULL;
echo_message_buffer = Qnil;
@ -684,9 +736,9 @@ static void
echo_truncate (ptrdiff_t nchars)
{
if (STRINGP (KVAR (current_kboard, echo_string)))
KSET (current_kboard, echo_string,
Fsubstring (KVAR (current_kboard, echo_string),
make_number (0), make_number (nchars)));
kset_echo_string (current_kboard,
Fsubstring (KVAR (current_kboard, echo_string),
make_number (0), make_number (nchars)));
truncate_echo_area (nchars);
}
@ -1016,8 +1068,8 @@ cmd_error (Lisp_Object data)
Vstandard_input = Qt;
Vexecuting_kbd_macro = Qnil;
executing_kbd_macro = Qnil;
KSET (current_kboard, Vprefix_arg, Qnil);
KSET (current_kboard, Vlast_prefix_arg, Qnil);
kset_prefix_arg (current_kboard, Qnil);
kset_last_prefix_arg (current_kboard, Qnil);
cancel_echoing ();
/* Avoid unquittable loop if data contains a circular list. */
@ -1338,8 +1390,8 @@ command_loop_1 (void)
#endif
int already_adjusted = 0;
KSET (current_kboard, Vprefix_arg, Qnil);
KSET (current_kboard, Vlast_prefix_arg, Qnil);
kset_prefix_arg (current_kboard, Qnil);
kset_last_prefix_arg (current_kboard, Qnil);
Vdeactivate_mark = Qnil;
waiting_for_input = 0;
cancel_echoing ();
@ -1371,10 +1423,10 @@ command_loop_1 (void)
}
/* Do this after running Vpost_command_hook, for consistency. */
KSET (current_kboard, Vlast_command, Vthis_command);
KSET (current_kboard, Vreal_last_command, Vreal_this_command);
kset_last_command (current_kboard, Vthis_command);
kset_real_last_command (current_kboard, Vreal_this_command);
if (!CONSP (last_command_event))
KSET (current_kboard, Vlast_repeatable_command, Vreal_this_command);
kset_last_repeatable_command (current_kboard, Vreal_this_command);
while (1)
{
@ -1546,7 +1598,7 @@ command_loop_1 (void)
keys = Fkey_description (keys, Qnil);
bitch_at_user ();
message_with_string ("%s is undefined", keys, 0);
KSET (current_kboard, defining_kbd_macro, Qnil);
kset_defining_kbd_macro (current_kboard, Qnil);
update_mode_lines = 1;
/* If this is a down-mouse event, don't reset prefix-arg;
pass it to the command run by the up event. */
@ -1556,10 +1608,10 @@ command_loop_1 (void)
= parse_modifiers (EVENT_HEAD (last_command_event));
int modifiers = XINT (XCAR (XCDR (breakdown)));
if (!(modifiers & down_modifier))
KSET (current_kboard, Vprefix_arg, Qnil);
kset_prefix_arg (current_kboard, Qnil);
}
else
KSET (current_kboard, Vprefix_arg, Qnil);
kset_prefix_arg (current_kboard, Qnil);
}
else
{
@ -1596,7 +1648,7 @@ command_loop_1 (void)
unbind_to (scount, Qnil);
#endif
}
KSET (current_kboard, Vlast_prefix_arg, Vcurrent_prefix_arg);
kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
safe_run_hooks (Qpost_command_hook);
@ -1627,10 +1679,10 @@ command_loop_1 (void)
if (NILP (KVAR (current_kboard, Vprefix_arg))
|| CONSP (last_command_event))
{
KSET (current_kboard, Vlast_command, Vthis_command);
KSET (current_kboard, Vreal_last_command, Vreal_this_command);
kset_last_command (current_kboard, Vthis_command);
kset_real_last_command (current_kboard, Vreal_this_command);
if (!CONSP (last_command_event))
KSET (current_kboard, Vlast_repeatable_command, Vreal_this_command);
kset_last_repeatable_command (current_kboard, Vreal_this_command);
cancel_echoing ();
this_command_key_count = 0;
this_command_key_count_reset = 0;
@ -2573,7 +2625,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
abort ();
}
if (!CONSP (last))
KSET (kb, kbd_queue, Fcons (c, Qnil));
kset_kbd_queue (kb, Fcons (c, Qnil));
else
XSETCDR (last, Fcons (c, Qnil));
kb->kbd_queue_has_data = 1;
@ -2745,8 +2797,8 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
if (!CONSP (KVAR (current_kboard, kbd_queue)))
abort ();
c = XCAR (KVAR (current_kboard, kbd_queue));
KSET (current_kboard, kbd_queue,
XCDR (KVAR (current_kboard, kbd_queue)));
kset_kbd_queue (current_kboard,
XCDR (KVAR (current_kboard, kbd_queue)));
if (NILP (KVAR (current_kboard, kbd_queue)))
current_kboard->kbd_queue_has_data = 0;
input_pending = readable_events (0);
@ -2813,7 +2865,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
abort ();
}
if (!CONSP (last))
KSET (kb, kbd_queue, Fcons (c, Qnil));
kset_kbd_queue (kb, Fcons (c, Qnil));
else
XSETCDR (last, Fcons (c, Qnil));
kb->kbd_queue_has_data = 1;
@ -3071,7 +3123,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
cancel_echoing ();
ok_to_echo_at_next_pause = saved_ok_to_echo;
KSET (current_kboard, echo_string, saved_echo_string);
kset_echo_string (current_kboard, saved_echo_string);
current_kboard->echo_after_prompt = saved_echo_after_prompt;
if (saved_immediate_echo)
echo_now ();
@ -3542,9 +3594,9 @@ kbd_buffer_store_event_hold (register struct input_event *event,
if (single_kboard && kb != current_kboard)
{
KSET (kb, kbd_queue,
Fcons (make_lispy_switch_frame (event->frame_or_window),
Fcons (make_number (c), Qnil)));
kset_kbd_queue
(kb, Fcons (make_lispy_switch_frame (event->frame_or_window),
Fcons (make_number (c), Qnil)));
kb->kbd_queue_has_data = 1;
for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
{
@ -4367,7 +4419,6 @@ timer_check_2 (void)
while (CONSP (timers) || CONSP (idle_timers))
{
Lisp_Object *vector;
Lisp_Object timer = Qnil, idle_timer = Qnil;
EMACS_TIME timer_time, idle_timer_time;
EMACS_TIME difference;
@ -4443,15 +4494,14 @@ timer_check_2 (void)
/* If timer is ripe, run it if it hasn't been run. */
if (ripe)
{
vector = XVECTOR (chosen_timer)->contents;
if (NILP (vector[0]))
if (NILP (AREF (chosen_timer, 0)))
{
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object old_deactivate_mark = Vdeactivate_mark;
/* Mark the timer as triggered to prevent problems if the lisp
code fails to reschedule it right. */
vector[0] = Qt;
ASET (chosen_timer, 0, Qt);
specbind (Qinhibit_quit, Qt);
@ -5416,7 +5466,7 @@ make_lispy_event (struct input_event *event)
/* We need to use an alist rather than a vector as the cache
since we can't make a vector long enough. */
if (NILP (KVAR (current_kboard, system_key_syms)))
KSET (current_kboard, system_key_syms, Fcons (Qnil, Qnil));
kset_system_key_syms (current_kboard, Fcons (Qnil, Qnil));
return modify_event_symbol (event->code,
event->modifiers,
Qfunction_key,
@ -8395,7 +8445,6 @@ init_tool_bar_items (Lisp_Object reuse)
static void
append_tool_bar_item (void)
{
Lisp_Object *to, *from;
ptrdiff_t incr =
(ntool_bar_items
- (ASIZE (tool_bar_items_vector) - TOOL_BAR_ITEM_NSLOTS));
@ -8407,9 +8456,8 @@ append_tool_bar_item (void)
/* Append entries from tool_bar_item_properties to the end of
tool_bar_items_vector. */
to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
from = XVECTOR (tool_bar_item_properties)->contents;
memcpy (to, from, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
vcopy (tool_bar_items_vector, ntool_bar_items,
XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
}
@ -8739,11 +8787,11 @@ read_char_minibuf_menu_prompt (int commandflag,
is not used on replay.
*/
orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
KSET (current_kboard, defining_kbd_macro, Qnil);
kset_defining_kbd_macro (current_kboard, Qnil);
do
obj = read_char (commandflag, 0, 0, Qt, 0, NULL);
while (BUFFERP (obj));
KSET (current_kboard, defining_kbd_macro, orig_defn_macro);
kset_defining_kbd_macro (current_kboard, orig_defn_macro);
if (!INTEGERP (obj))
return obj;
@ -9099,7 +9147,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* Install the string STR as the beginning of the string of
echoing, so that it serves as a prompt for the next
character. */
KSET (current_kboard, echo_string, prompt);
kset_echo_string (current_kboard, prompt);
current_kboard->echo_after_prompt = SCHARS (prompt);
echo_now ();
}
@ -9345,15 +9393,17 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
if (!NILP (delayed_switch_frame))
{
KSET (interrupted_kboard, kbd_queue,
Fcons (delayed_switch_frame,
KVAR (interrupted_kboard, kbd_queue)));
kset_kbd_queue
(interrupted_kboard,
Fcons (delayed_switch_frame,
KVAR (interrupted_kboard, kbd_queue)));
delayed_switch_frame = Qnil;
}
while (t > 0)
KSET (interrupted_kboard, kbd_queue,
Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)));
kset_kbd_queue
(interrupted_kboard,
Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)));
/* If the side queue is non-empty, ensure it begins with a
switch-frame, so we'll replay it in the right context. */
@ -9365,9 +9415,10 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
{
Lisp_Object frame;
XSETFRAME (frame, interrupted_frame);
KSET (interrupted_kboard, kbd_queue,
Fcons (make_lispy_switch_frame (frame),
KVAR (interrupted_kboard, kbd_queue)));
kset_kbd_queue
(interrupted_kboard,
Fcons (make_lispy_switch_frame (frame),
KVAR (interrupted_kboard, kbd_queue)));
}
mock_input = 0;
orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
@ -10261,7 +10312,7 @@ a special event, so ignore the prefix argument and don't clear it. */)
{
prefixarg = KVAR (current_kboard, Vprefix_arg);
Vcurrent_prefix_arg = prefixarg;
KSET (current_kboard, Vprefix_arg, Qnil);
kset_prefix_arg (current_kboard, Qnil);
}
else
prefixarg = Qnil;
@ -10435,10 +10486,10 @@ DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
else
{
val = Fvector (NUM_RECENT_KEYS, keys);
memcpy (XVECTOR (val)->contents, keys + recent_keys_index,
(NUM_RECENT_KEYS - recent_keys_index) * word_size);
memcpy (XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
keys, recent_keys_index * word_size);
vcopy (val, 0, keys + recent_keys_index,
NUM_RECENT_KEYS - recent_keys_index);
vcopy (val, NUM_RECENT_KEYS - recent_keys_index,
keys, recent_keys_index);
return val;
}
}
@ -11256,30 +11307,30 @@ The `posn-' functions access elements of such lists. */)
void
init_kboard (KBOARD *kb)
{
KSET (kb, Voverriding_terminal_local_map, Qnil);
KSET (kb, Vlast_command, Qnil);
KSET (kb, Vreal_last_command, Qnil);
KSET (kb, Vkeyboard_translate_table, Qnil);
KSET (kb, Vlast_repeatable_command, Qnil);
KSET (kb, Vprefix_arg, Qnil);
KSET (kb, Vlast_prefix_arg, Qnil);
KSET (kb, kbd_queue, Qnil);
kset_overriding_terminal_local_map (kb, Qnil);
kset_last_command (kb, Qnil);
kset_real_last_command (kb, Qnil);
kset_keyboard_translate_table (kb, Qnil);
kset_last_repeatable_command (kb, Qnil);
kset_prefix_arg (kb, Qnil);
kset_last_prefix_arg (kb, Qnil);
kset_kbd_queue (kb, Qnil);
kb->kbd_queue_has_data = 0;
kb->immediate_echo = 0;
KSET (kb, echo_string, Qnil);
kset_echo_string (kb, Qnil);
kb->echo_after_prompt = -1;
kb->kbd_macro_buffer = 0;
kb->kbd_macro_bufsize = 0;
KSET (kb, defining_kbd_macro, Qnil);
KSET (kb, Vlast_kbd_macro, Qnil);
kset_defining_kbd_macro (kb, Qnil);
kset_last_kbd_macro (kb, Qnil);
kb->reference_count = 0;
KSET (kb, Vsystem_key_alist, Qnil);
KSET (kb, system_key_syms, Qnil);
KSET (kb, Vwindow_system, Qt); /* Unset. */
KSET (kb, Vinput_decode_map, Fmake_sparse_keymap (Qnil));
KSET (kb, Vlocal_function_key_map, Fmake_sparse_keymap (Qnil));
kset_system_key_alist (kb, Qnil);
kset_system_key_syms (kb, Qnil);
kset_window_system (kb, Qt); /* Unset. */
kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil));
kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil));
Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
KSET (kb, Vdefault_minibuffer_frame, Qnil);
kset_default_minibuffer_frame (kb, Qnil);
}
/*
@ -11355,7 +11406,7 @@ init_keyboard (void)
init_kboard (current_kboard);
/* A value of nil for Vwindow_system normally means a tty, but we also use
it for the initial terminal since there is no window system there. */
KSET (current_kboard, Vwindow_system, Qnil);
kset_window_system (current_kboard, Qnil);
if (!noninteractive)
{

49
src/keyboard.h
View File

@ -19,10 +19,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "systime.h" /* for EMACS_TIME, Time */
#include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */
INLINE_HEADER_BEGIN
#ifndef KEYBOARD_INLINE
# define KEYBOARD_INLINE INLINE
#endif
/* Most code should use this macro to access Lisp fields in struct kboard. */
#define KVAR(kboard, field) ((kboard)->INTERNAL_FIELD (field))
#define KSET(kboard, field, value) ((kboard)->INTERNAL_FIELD (field) = (value))
/* Each KBOARD represents one logical input stream from which Emacs
gets input. If we are using ordinary terminals, it has one KBOARD
@ -173,6 +177,47 @@ struct kboard
char echo_after_prompt;
};
KEYBOARD_INLINE void
kset_default_minibuffer_frame (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vdefault_minibuffer_frame) = val;
}
KEYBOARD_INLINE void
kset_defining_kbd_macro (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (defining_kbd_macro) = val;
}
KEYBOARD_INLINE void
kset_input_decode_map (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vinput_decode_map) = val;
}
KEYBOARD_INLINE void
kset_last_command (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vlast_command) = val;
}
KEYBOARD_INLINE void
kset_last_kbd_macro (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vlast_kbd_macro) = val;
}
KEYBOARD_INLINE void
kset_prefix_arg (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vprefix_arg) = val;
}
KEYBOARD_INLINE void
kset_system_key_alist (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vsystem_key_alist) = val;
}
KEYBOARD_INLINE void
kset_window_system (struct kboard *kb, Lisp_Object val)
{
kb->INTERNAL_FIELD (Vwindow_system) = val;
}
/* Temporarily used before a frame has been opened. */
extern KBOARD *initial_kboard;
@ -510,3 +555,5 @@ extern void mark_kboards (void);
#ifdef WINDOWSNT
extern const char *const lispy_function_keys[];
#endif
INLINE_HEADER_END

2
src/keymap.c
View File

@ -1854,7 +1854,7 @@ If KEYMAP is nil, that means no local keymap. */)
if (!NILP (keymap))
keymap = get_keymap (keymap, 1, 1);
BSET (current_buffer, keymap, keymap);
bset_keymap (current_buffer, keymap);
return Qnil;
}

164
src/lisp.h
View File

@ -124,7 +124,7 @@ extern _Noreturn void die (const char *, const char *, int);
eassert macro altogether, e.g., if XSTRING (x) uses eassert to test
STRINGP (x), but a particular use of XSTRING is invoked only after
testing that STRINGP (x) is true, making the test redundant. */
extern int suppress_checking EXTERNALLY_VISIBLE;
extern bool suppress_checking EXTERNALLY_VISIBLE;
# define eassert(cond) \
((cond) || suppress_checking \
@ -702,7 +702,7 @@ struct Lisp_Cons
#define CDR_SAFE(c) \
(CONSP ((c)) ? XCDR ((c)) : Qnil)
/* Nonzero if STR is a multibyte string. */
/* True if STR is a multibyte string. */
#define STRING_MULTIBYTE(STR) \
(XSTRING (STR)->size_byte >= 0)
@ -923,7 +923,7 @@ enum
8-bit European characters. Do not check validity of CT. */
#define CHAR_TABLE_SET(CT, IDX, VAL) \
(ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
? sub_char_table_set_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \
? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \
: char_table_set (CT, IDX, VAL))
enum CHARTAB_SIZE_BITS
@ -936,12 +936,6 @@ enum CHARTAB_SIZE_BITS
extern const int chartab_size[4];
/* Most code should use this macro to set non-array Lisp fields in struct
Lisp_Char_Table. For CONTENTS and EXTRAS, use char_table_set_contents
and char_table_set_extras, respectively. */
#define CSET(c, field, value) ((c)->field = (value))
struct Lisp_Char_Table
{
/* HEADER.SIZE is the vector's size field, which also holds the
@ -990,7 +984,7 @@ struct Lisp_Sub_Char_Table
/* Minimum character covered by the sub char-table. */
Lisp_Object min_char;
/* Use sub_char_table_set_contents to set this. */
/* Use set_sub_char_table_contents to set this. */
Lisp_Object contents[1];
};
@ -1472,14 +1466,6 @@ struct Lisp_Buffer_Local_Value
Lisp_Object valcell;
};
#define BLV_FOUND(blv) \
(eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
#define SET_BLV_FOUND(blv, v) \
(eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
#define BLV_VALUE(blv) (XCDR ((blv)->valcell))
#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
/* Like Lisp_Objfwd except that value lives in a slot in the
current kboard. */
struct Lisp_Kboard_Objfwd
@ -2358,32 +2344,67 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
XVECTOR (array)->contents[idx] = val;
}
/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
LISP_INLINE void
set_hash_key (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
{
eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
}
/* Functions to modify hash tables. */
LISP_INLINE void
set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
{
h->key_and_value = key_and_value;
}
LISP_INLINE void
set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
gc_aset (h->key_and_value, 2 * idx, val);
}
LISP_INLINE void
set_hash_value (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
gc_aset (h->key_and_value, 2 * idx + 1, val);
}
LISP_INLINE void
set_hash_next (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
{
h->next = next;
}
LISP_INLINE void
set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
gc_aset (h->next, idx, val);
}
LISP_INLINE void
set_hash_hash (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
{
h->hash = hash;
}
LISP_INLINE void
set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
gc_aset (h->hash, idx, val);
}
LISP_INLINE void
set_hash_index (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
{
h->index = index;
}
LISP_INLINE void
set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
gc_aset (h->index, idx, val);
}
@ -2415,6 +2436,52 @@ set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
XSYMBOL (sym)->next = next;
}
/* Buffer-local (also frame-local) variable access functions. */
LISP_INLINE int
blv_found (struct Lisp_Buffer_Local_Value *blv)
{
eassert (blv->found == !EQ (blv->defcell, blv->valcell));
return blv->found;
}
LISP_INLINE void
set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
{
eassert (found == !EQ (blv->defcell, blv->valcell));
blv->found = found;
}
LISP_INLINE Lisp_Object
blv_value (struct Lisp_Buffer_Local_Value *blv)
{
return XCDR (blv->valcell);
}
LISP_INLINE void
set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
{
XSETCDR (blv->valcell, val);
}
LISP_INLINE void
set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
{
blv->where = val;
}
LISP_INLINE void
set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
{
blv->defcell = val;
}
LISP_INLINE void
set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
{
blv->valcell = val;
}
/* Set overlay's property list. */
LISP_INLINE void
@ -2426,7 +2493,7 @@ set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
/* Get text properties of S. */
LISP_INLINE INTERVAL
string_get_intervals (Lisp_Object s)
string_intervals (Lisp_Object s)
{
return XSTRING (s)->intervals;
}
@ -2434,29 +2501,53 @@ string_get_intervals (Lisp_Object s)
/* Set text properties of S to I. */
LISP_INLINE void
string_set_intervals (Lisp_Object s, INTERVAL i)
set_string_intervals (Lisp_Object s, INTERVAL i)
{
XSTRING (s)->intervals = i;
}
/* Set a Lisp slot in TABLE to VAL. Most code should use this instead
of setting slots directly. */
LISP_INLINE void
set_char_table_ascii (Lisp_Object table, Lisp_Object val)
{
XCHAR_TABLE (table)->ascii = val;
}
LISP_INLINE void
set_char_table_defalt (Lisp_Object table, Lisp_Object val)
{
XCHAR_TABLE (table)->defalt = val;
}
LISP_INLINE void
set_char_table_parent (Lisp_Object table, Lisp_Object val)
{
XCHAR_TABLE (table)->parent = val;
}
LISP_INLINE void
set_char_table_purpose (Lisp_Object table, Lisp_Object val)
{
XCHAR_TABLE (table)->purpose = val;
}
/* Set different slots in (sub)character tables. */
LISP_INLINE void
char_table_set_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
{
eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
XCHAR_TABLE (table)->extras[idx] = val;
}
LISP_INLINE void
char_table_set_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
{
eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
XCHAR_TABLE (table)->contents[idx] = val;
}
LISP_INLINE void
sub_char_table_set_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
{
XSUB_CHAR_TABLE (table)->contents[idx] = val;
}
@ -2708,7 +2799,7 @@ extern Lisp_Object echo_area_buffer[2];
extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void check_message_stack (void);
extern void setup_echo_area_for_printing (int);
extern int push_message (void);
extern bool push_message (void);
extern Lisp_Object pop_message_unwind (Lisp_Object);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void restore_message (void);
@ -2751,7 +2842,7 @@ extern void uninterrupt_malloc (void);
extern void malloc_warning (const char *);
extern _Noreturn void memory_full (size_t);
extern _Noreturn void buffer_memory_full (ptrdiff_t);
extern int survives_gc_p (Lisp_Object);
extern bool survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC
extern void refill_memory_reserve (void);
@ -2790,8 +2881,8 @@ extern Lisp_Object make_uninit_string (EMACS_INT);
extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_specified_string (const char *,
ptrdiff_t, ptrdiff_t, int);
extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, int);
ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
/* Make a string allocated in pure space, use STR as string data. */
@ -2825,8 +2916,8 @@ extern struct window *allocate_window (void);
extern struct frame *allocate_frame (void);
extern struct Lisp_Process *allocate_process (void);
extern struct terminal *allocate_terminal (void);
extern int gc_in_progress;
extern int abort_on_gc;
extern bool gc_in_progress;
extern bool abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
@ -2859,9 +2950,8 @@ extern Lisp_Object copy_char_table (Lisp_Object);
extern Lisp_Object char_table_ref (Lisp_Object, int);
extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
int *, int *);
extern Lisp_Object char_table_set (Lisp_Object, int, Lisp_Object);
extern Lisp_Object char_table_set_range (Lisp_Object, int, int,
Lisp_Object);
extern void char_table_set (Lisp_Object, int, Lisp_Object);
extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
extern int char_table_translate (Lisp_Object, int);
extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
Lisp_Object),

20
src/lread.c
View File

@ -189,7 +189,7 @@ static int readbyte_from_string (int, Lisp_Object);
static int unread_char;
static int
readchar (Lisp_Object readcharfun, int *multibyte)
readchar (Lisp_Object readcharfun, bool *multibyte)
{
Lisp_Object tem;
register int c;
@ -2354,9 +2354,9 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
static Lisp_Object
read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
register int c;
unsigned uninterned_symbol = 0;
int multibyte;
int c;
bool uninterned_symbol = 0;
bool multibyte;
*pch = 0;
load_each_byte = 0;
@ -3189,8 +3189,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
/* Check for text properties in each interval.
substitute_in_interval contains part of the logic. */
INTERVAL root_interval = string_get_intervals (subtree);
Lisp_Object arg = Fcons (object, placeholder);
INTERVAL root_interval = string_intervals (subtree);
Lisp_Object arg = Fcons (object, placeholder);
traverse_intervals_noorder (root_interval,
&substitute_in_interval, arg);
@ -3211,7 +3211,7 @@ substitute_in_interval (INTERVAL interval, Lisp_Object arg)
Lisp_Object object = Fcar (arg);
Lisp_Object placeholder = Fcdr (arg);
SUBSTITUTE (interval->plist, interval_set_plist (interval, true_value));
SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
}
@ -3406,7 +3406,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
/* Delay handling the bytecode slot until we know whether
it is lazily-loaded (we can tell by whether the
constants slot is nil). */
ptr[COMPILED_CONSTANTS] = item;
ASET (vector, COMPILED_CONSTANTS, item);
item = Qnil;
}
else if (i == COMPILED_CONSTANTS)
@ -3432,7 +3432,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
}
/* Now handle the bytecode slot. */
ptr[COMPILED_BYTECODE] = bytestr;
ASET (vector, COMPILED_BYTECODE, bytestr);
}
else if (i == COMPILED_DOC_STRING
&& STRINGP (item)
@ -3444,7 +3444,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
item = Fstring_as_multibyte (item);
}
}
ptr[i] = item;
ASET (vector, i, item);
otem = XCONS (tem);
tem = Fcdr (tem);
free_cons (otem);

15
src/macros.c
View File

@ -127,7 +127,7 @@ macro before appending to it. */)
message ("Appending to kbd macro...");
}
KSET (current_kboard, defining_kbd_macro, Qt);
kset_defining_kbd_macro (current_kboard, Qt);
return Qnil;
}
@ -137,12 +137,13 @@ macro before appending to it. */)
void
end_kbd_macro (void)
{
KSET (current_kboard, defining_kbd_macro, Qnil);
kset_defining_kbd_macro (current_kboard, Qnil);
update_mode_lines++;
KSET (current_kboard, Vlast_kbd_macro,
make_event_array ((current_kboard->kbd_macro_end
- current_kboard->kbd_macro_buffer),
current_kboard->kbd_macro_buffer));
kset_last_kbd_macro
(current_kboard,
make_event_array ((current_kboard->kbd_macro_end
- current_kboard->kbd_macro_buffer),
current_kboard->kbd_macro_buffer));
}
DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p",
@ -330,7 +331,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
executing_kbd_macro = final;
executing_kbd_macro_index = 0;
KSET (current_kboard, Vprefix_arg, Qnil);
kset_prefix_arg (current_kboard, Qnil);
if (!NILP (loopfunc))
{

1
src/makefile.w32-in
View File

@ -1448,6 +1448,7 @@ $(BLD)/unexw32.$(O) : \
$(BLD)/vm-limit.$(O) : \
$(SRC)/vm-limit.c \
$(SRC)/mem-limits.h \
$(NT_INC)/unistd.h \
$(CONFIG_H) \
$(LISP_H)

14
src/minibuf.c
View File

@ -565,11 +565,11 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Defeat (setq-default truncate-lines t), since truncated lines do
not work correctly in minibuffers. (Bug#5715, etc) */
BSET (current_buffer, truncate_lines, Qnil);
bset_truncate_lines (current_buffer, Qnil);
/* If appropriate, copy enable-multibyte-characters into the minibuffer. */
if (inherit_input_method)
BSET (current_buffer, enable_multibyte_characters, enable_multibyte);
bset_enable_multibyte_characters (current_buffer, enable_multibyte);
/* The current buffer's default directory is usually the right thing
for our minibuffer here. However, if you're typing a command at
@ -580,7 +580,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
you think of something better to do? Find another buffer with a
better directory, and use that one instead. */
if (STRINGP (ambient_dir))
BSET (current_buffer, directory, ambient_dir);
bset_directory (current_buffer, ambient_dir);
else
{
Lisp_Object buf_list;
@ -594,8 +594,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
other_buf = XCDR (XCAR (buf_list));
if (STRINGP (BVAR (XBUFFER (other_buf), directory)))
{
BSET (current_buffer, directory,
BVAR (XBUFFER (other_buf), directory));
bset_directory (current_buffer,
BVAR (XBUFFER (other_buf), directory));
break;
}
}
@ -672,7 +672,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
}
clear_message (1, 1);
BSET (current_buffer, keymap, map);
bset_keymap (current_buffer, map);
/* Turn on an input method stored in INPUT_METHOD if any. */
if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
@ -681,7 +681,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Frun_hooks (1, &Qminibuffer_setup_hook);
/* Don't allow the user to undo past this point. */
BSET (current_buffer, undo_list, Qnil);
bset_undo_list (current_buffer, Qnil);
recursive_edit_1 ();

14
src/msdos.c
View File

@ -520,8 +520,8 @@ dos_set_window_size (int *rows, int *cols)
/* If the user specified a special video mode for these dimensions,
use that mode. */
video_mode
= Fsymbol_value (Fintern_soft (make_formatted_string
video_mode
= Fsymbol_value (Fintern_soft (make_formatted_string
(video_name, "screen-dimensions-%dx%d",
*rows, *cols), Qnil));
@ -1801,7 +1801,7 @@ internal_terminal_init (void)
}
tty = FRAME_TTY (sf);
KSET (current_kboard, Vwindow_system, Qpc);
kset_window_system (current_kboard, Qpc);
sf->output_method = output_msdos_raw;
if (init_needed)
{
@ -2434,10 +2434,10 @@ and then the scan code. */)
else
{
val = Fvector (NUM_RECENT_DOSKEYS, keys);
memcpy (XVECTOR (val)->contents, keys + recent_doskeys_index,
(NUM_RECENT_DOSKEYS - recent_doskeys_index) * word_size);
memcpy (XVECTOR (val)->contents + NUM_RECENT_DOSKEYS - recent_doskeys_index,
keys, recent_doskeys_index * word_size);
vcopy (val, 0, keys + recent_doskeys_index,
NUM_RECENT_DOSKEYS - recent_doskeys_index);
vcopy (val, NUM_RECENT_DOSKEYS - recent_doskeys_index,
keys, recent_doskeys_index);
return val;
}
}

24
src/nsfns.m
View File

@ -447,7 +447,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
return;
FSET (f, icon_name, arg);
fset_icon_name (f, arg);
if (NILP (arg))
{
@ -539,7 +539,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
if (! NILP (Fstring_equal (name, f->name)))
return;
FSET (f, name, name);
fset_name (f, name);
/* title overrides explicit name */
if (! NILP (f->title))
@ -590,7 +590,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
update_mode_lines = 1;
FSET (f, title, name);
fset_title (f, name);
if (NILP (name))
name = f->name;
@ -676,7 +676,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
[[view window] setRepresentedFilename: fstr];
[[view window] setTitle: str];
FSET (f, name, name);
fset_name (f, name);
}
[pool release];
@ -1204,11 +1204,11 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
FRAME_FONTSET (f) = -1;
FSET (f, icon_name, x_get_arg (dpyinfo, parms, Qicon_name,
"iconName", "Title",
RES_TYPE_STRING));
fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
"iconName", "Title",
RES_TYPE_STRING));
if (! STRINGP (f->icon_name))
FSET (f, icon_name, Qnil);
fset_icon_name (f, Qnil);
FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
@ -1231,12 +1231,12 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
be set. */
if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
{
FSET (f, name, build_string ([ns_app_name UTF8String]));
fset_name (f, build_string ([ns_app_name UTF8String]));
f->explicit_name = 0;
}
else
{
FSET (f, name, name);
fset_name (f, name);
f->explicit_name = 1;
specbind (Qx_resource_name, name);
}
@ -1391,13 +1391,13 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
if (FRAME_HAS_MINIBUF_P (f)
&& (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
|| !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
KSET (kb, Vdefault_minibuffer_frame, frame);
kset_default_minibuffer_frame (kb, frame);
/* All remaining specified parameters, which have not been "used"
by x_get_arg and friends, now go in the misc. alist of the frame. */
for (tem = parms; CONSP (tem); tem = XCDR (tem))
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
FSET (f, param_alist, Fcons (XCAR (tem), f->param_alist));
fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
UNGCPRO;

3
src/nsfont.m
View File

@ -270,10 +270,11 @@ static void ns_glyph_metrics (struct nsfont_info *font_info,
if (!ascii_printable)
{
char chars[95];
char chars[96];
int ch;
for (ch = 0; ch < 95; ch++)
chars[ch] = ' ' + ch;
chars[95] = '\0';
ascii_printable = [[NSString alloc] initWithFormat: @"%s", chars];
}

4
src/nsmenu.m
View File

@ -214,7 +214,7 @@
if (! NILP (Vlucid_menu_bar_dirty_flag))
call0 (Qrecompute_lucid_menubar);
safe_run_hooks (Qmenu_bar_update_hook);
FSET (f, menu_bar_items, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
/* Now ready to go */
items = FRAME_MENU_BAR_ITEMS (f);
@ -340,7 +340,7 @@
}
/* The menu items are different, so store them in the frame */
/* FIXME: this is not correct for single-submenu case */
FSET (f, menu_bar_vector, menu_items);
fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* Calls restore_menu_items, etc., as they were outside */

14
src/nsterm.m
View File

@ -1032,7 +1032,7 @@ Free a pool and temporary objects it refers to (callable from C)
: dpyinfo->x_focus_frame);
if (!FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
FSET (dpyinfo->x_focus_frame, focus_frame, Qnil);
fset_focus_frame (dpyinfo->x_focus_frame, Qnil);
dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame;
}
}
@ -3698,7 +3698,7 @@ overwriting cursor (usually when cursor on a tab) */
{
bar = XNS_SCROLL_BAR (window->vertical_scroll_bar);
[bar removeFromSuperview];
WSET (window, vertical_scroll_bar, Qnil);
wset_vertical_scroll_bar (window, Qnil);
}
ns_clear_frame_area (f, sb_left, top, width, height);
UNBLOCK_INPUT;
@ -3709,7 +3709,7 @@ overwriting cursor (usually when cursor on a tab) */
{
ns_clear_frame_area (f, sb_left, top, width, height);
bar = [[EmacsScroller alloc] initFrame: r window: win];
WSET (window, vertical_scroll_bar, make_save_value (bar, 0));
wset_vertical_scroll_bar (window, make_save_value (bar, 0));
}
else
{
@ -4093,7 +4093,7 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes.
terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
KSET (terminal->kboard, Vwindow_system, Qns);
kset_window_system (terminal->kboard, Qns);
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
/* Don't let the initial kboard remain current longer than necessary.
@ -4600,11 +4600,15 @@ - (void)fd_handler:(id)unused
SELECT_TYPE readfds, writefds, *wfds;
EMACS_TIME timeout, *tmo;
NSAutoreleasePool *pool = nil;
/* NSTRACE (fd_handler); */
for (;;)
{
[pool release];
pool = [[NSAutoreleasePool alloc] init];
if (waiting)
{
SELECT_TYPE fds;
@ -6388,7 +6392,7 @@ - (void)dealloc
{
NSTRACE (EmacsScroller_dealloc);
if (!NILP (win))
WSET (XWINDOW (win), vertical_scroll_bar, Qnil);
wset_vertical_scroll_bar (XWINDOW (win), Qnil);
[super dealloc];
}

28
src/print.c
View File

@ -494,14 +494,14 @@ temp_output_buffer_setup (const char *bufname)
Fkill_all_local_variables ();
delete_all_overlays (current_buffer);
BSET (current_buffer, directory, BVAR (old, directory));
BSET (current_buffer, read_only, Qnil);
BSET (current_buffer, filename, Qnil);
BSET (current_buffer, undo_list, Qt);
bset_directory (current_buffer, BVAR (old, directory));
bset_read_only (current_buffer, Qnil);
bset_filename (current_buffer, Qnil);
bset_undo_list (current_buffer, Qt);
eassert (current_buffer->overlays_before == NULL);
eassert (current_buffer->overlays_after == NULL);
BSET (current_buffer, enable_multibyte_characters,
BVAR (&buffer_defaults, enable_multibyte_characters));
bset_enable_multibyte_characters
(current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
@ -586,6 +586,7 @@ A printed representation of an object is text which describes that object. */)
(Lisp_Object object, Lisp_Object noescape)
{
Lisp_Object printcharfun;
bool prev_abort_on_gc;
/* struct gcpro gcpro1, gcpro2; */
Lisp_Object save_deactivate_mark;
ptrdiff_t count = SPECPDL_INDEX ();
@ -601,7 +602,8 @@ A printed representation of an object is text which describes that object. */)
No need for specbind, since errors deactivate the mark. */
save_deactivate_mark = Vdeactivate_mark;
/* GCPRO2 (object, save_deactivate_mark); */
abort_on_gc++;
prev_abort_on_gc = abort_on_gc;
abort_on_gc = 1;
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
@ -625,7 +627,7 @@ A printed representation of an object is text which describes that object. */)
Vdeactivate_mark = save_deactivate_mark;
/* UNGCPRO; */
abort_on_gc--;
abort_on_gc = prev_abort_on_gc;
return unbind_to (count, object);
}
@ -1194,7 +1196,7 @@ print_preprocess (Lisp_Object obj)
{
case Lisp_String:
/* A string may have text properties, which can be circular. */
traverse_intervals_noorder (string_get_intervals (obj),
traverse_intervals_noorder (string_intervals (obj),
print_preprocess_string, Qnil);
break;
@ -1297,7 +1299,7 @@ static Lisp_Object
print_prune_string_charset (Lisp_Object string)
{
print_check_string_result = 0;
traverse_intervals (string_get_intervals (string), 0,
traverse_intervals (string_intervals (string), 0,
print_check_string_charset_prop, string);
if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
@ -1408,7 +1410,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
if (! EQ (Vprint_charset_text_property, Qt))
obj = print_prune_string_charset (obj);
if (string_get_intervals (obj))
if (string_intervals (obj))
{
PRINTCHAR ('#');
PRINTCHAR ('(');
@ -1499,9 +1501,9 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
}
PRINTCHAR ('\"');
if (string_get_intervals (obj))
if (string_intervals (obj))
{
traverse_intervals (string_get_intervals (obj),
traverse_intervals (string_intervals (obj),
0, print_interval, printcharfun);
PRINTCHAR (')');
}

293
src/process.c
View File

@ -20,6 +20,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#define PROCESS_INLINE EXTERN_INLINE
#include <signal.h>
#include <stdio.h>
#include <errno.h>
@ -334,6 +337,88 @@ static struct sockaddr_and_len {
/* Maximum number of bytes to send to a pty without an eof. */
static int pty_max_bytes;
/* These setters are used only in this file, so they can be private. */
static inline void
pset_buffer (struct Lisp_Process *p, Lisp_Object val)
{
p->buffer = val;
}
static inline void
pset_command (struct Lisp_Process *p, Lisp_Object val)
{
p->command = val;
}
static inline void
pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
{
p->decode_coding_system = val;
}
static inline void
pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
{
p->decoding_buf = val;
}
static inline void
pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
{
p->encode_coding_system = val;
}
static inline void
pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
{
p->encoding_buf = val;
}
static inline void
pset_filter (struct Lisp_Process *p, Lisp_Object val)
{
p->filter = val;
}
static inline void
pset_log (struct Lisp_Process *p, Lisp_Object val)
{
p->log = val;
}
static inline void
pset_mark (struct Lisp_Process *p, Lisp_Object val)
{
p->mark = val;
}
static inline void
pset_name (struct Lisp_Process *p, Lisp_Object val)
{
p->name = val;
}
static inline void
pset_plist (struct Lisp_Process *p, Lisp_Object val)
{
p->plist = val;
}
static inline void
pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
{
p->sentinel = val;
}
static inline void
pset_status (struct Lisp_Process *p, Lisp_Object val)
{
p->status = val;
}
static inline void
pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
{
p->tty_name = val;
}
static inline void
pset_type (struct Lisp_Process *p, Lisp_Object val)
{
p->type = val;
}
static inline void
pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
{
p->write_queue = val;
}
static struct fd_callback_data
@ -428,7 +513,7 @@ static void
update_status (struct Lisp_Process *p)
{
eassert (p->raw_status_new);
PSET (p, status, status_convert (p->raw_status));
pset_status (p, status_convert (p->raw_status));
p->raw_status_new = 0;
}
@ -626,8 +711,8 @@ make_process (Lisp_Object name)
p = allocate_process ();
/* Initialize Lisp data. Note that allocate_process initializes all
Lisp data to nil, so do it only for slots which should not be nil. */
PSET (p, status, Qrun);
PSET (p, mark, Fmake_marker ());
pset_status (p, Qrun);
pset_mark (p, Fmake_marker ());
/* Initialize non-Lisp data. Note that allocate_process zeroes out all
non-Lisp data, so do it only for slots which should not be zero. */
@ -648,7 +733,7 @@ make_process (Lisp_Object name)
name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i));
}
name = name1;
PSET (p, name, name);
pset_name (p, name);
XSETPROCESS (val, p);
Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
return val;
@ -745,7 +830,7 @@ nil, indicating the current buffer's process. */)
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
PSET (p, status, Fcons (Qexit, Fcons (make_number (0), Qnil)));
pset_status (p, Fcons (Qexit, Fcons (make_number (0), Qnil)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
@ -774,7 +859,7 @@ nil, indicating the current buffer's process. */)
{
Fkill_process (process, Qnil);
/* Do this now, since remove_process will make sigchld_handler do nothing. */
PSET (p, status, Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)));
pset_status (p, Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
@ -901,9 +986,9 @@ Return BUFFER. */)
if (!NILP (buffer))
CHECK_BUFFER (buffer);
p = XPROCESS (process);
PSET (p, buffer, buffer);
pset_buffer (p, buffer);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
PSET (p, childp, Fplist_put (p->childp, QCbuffer, buffer));
pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
setup_process_coding_systems (process);
return buffer;
}
@ -974,9 +1059,9 @@ The string argument is normally a multibyte string, except:
}
}
PSET (p, filter, filter);
pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
PSET (p, childp, Fplist_put (p->childp, QCfilter, filter));
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
return filter;
}
@ -1003,9 +1088,9 @@ It gets two arguments: the process, and a string describing the change. */)
CHECK_PROCESS (process);
p = XPROCESS (process);
PSET (p, sentinel, sentinel);
pset_sentinel (p, sentinel);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
PSET (p, childp, Fplist_put (p->childp, QCsentinel, sentinel));
pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
return sentinel;
}
@ -1138,7 +1223,7 @@ DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
CHECK_PROCESS (process);
CHECK_LIST (plist);
PSET (XPROCESS (process), plist, plist);
pset_plist (XPROCESS (process), plist);
return plist;
}
@ -1324,18 +1409,18 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
itself; it's all taken care of here. */
record_unwind_protect (start_process_unwind, proc);
PSET (XPROCESS (proc), childp, Qt);
PSET (XPROCESS (proc), plist, Qnil);
PSET (XPROCESS (proc), type, Qreal);
PSET (XPROCESS (proc), buffer, buffer);
PSET (XPROCESS (proc), sentinel, Qnil);
PSET (XPROCESS (proc), filter, Qnil);
PSET (XPROCESS (proc), command, Flist (nargs - 2, args + 2));
pset_childp (XPROCESS (proc), Qt);
pset_plist (XPROCESS (proc), Qnil);
pset_type (XPROCESS (proc), Qreal);
pset_buffer (XPROCESS (proc), buffer);
pset_sentinel (XPROCESS (proc), Qnil);
pset_filter (XPROCESS (proc), Qnil);
pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2));
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
PSET (XPROCESS (proc), gnutls_cred_type, Qnil);
pset_gnutls_cred_type (XPROCESS (proc), Qnil);
#endif
#ifdef ADAPTIVE_READ_BUFFERING
@ -1375,7 +1460,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
else if (CONSP (Vdefault_process_coding_system))
val = XCAR (Vdefault_process_coding_system);
}
PSET (XPROCESS (proc), decode_coding_system, val);
pset_decode_coding_system (XPROCESS (proc), val);
val = Vcoding_system_for_write;
if (NILP (val))
@ -1395,7 +1480,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
else if (CONSP (Vdefault_process_coding_system))
val = XCDR (Vdefault_process_coding_system);
}
PSET (XPROCESS (proc), encode_coding_system, val);
pset_encode_coding_system (XPROCESS (proc), val);
/* Note: At this moment, the above coding system may leave
text-conversion or eol-conversion unspecified. They will be
decided after we read output from the process and decode it by
@ -1404,9 +1489,9 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
}
PSET (XPROCESS (proc), decoding_buf, empty_unibyte_string);
pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
XPROCESS (proc)->decoding_carryover = 0;
PSET (XPROCESS (proc), encoding_buf, empty_unibyte_string);
pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
XPROCESS (proc)->inherit_coding_system_flag
= !(NILP (buffer) || !inherit_process_coding_system);
@ -1538,9 +1623,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
/* Use volatile to protect variables from being clobbered by longjmp. */
volatile int forkin, forkout;
volatile int pty_flag = 0;
#ifndef USE_CRT_DLL
extern char **environ;
#endif
inchannel = outchannel = -1;
@ -1628,7 +1710,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
more portable (see USG_SUBTTY_WORKS above). */
XPROCESS (process)->pty_flag = pty_flag;
PSET (XPROCESS (process), status, Qrun);
pset_status (XPROCESS (process), Qrun);
/* Delay interrupts until we have a chance to store
the new fork's pid in its process structure */
@ -1867,10 +1949,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
#ifdef HAVE_PTYS
if (pty_flag)
PSET (XPROCESS (process), tty_name, build_string (pty_name));
pset_tty_name (XPROCESS (process), build_string (pty_name));
else
#endif
PSET (XPROCESS (process), tty_name, Qnil);
pset_tty_name (XPROCESS (process), Qnil);
#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
/* Wait for child_setup to complete in case that vfork is
@ -1965,7 +2047,7 @@ create_pty (Lisp_Object process)
more portable (see USG_SUBTTY_WORKS above). */
XPROCESS (process)->pty_flag = pty_flag;
PSET (XPROCESS (process), status, Qrun);
pset_status (XPROCESS (process), Qrun);
setup_process_coding_systems (process);
FD_SET (inchannel, &input_wait_mask);
@ -1976,10 +2058,10 @@ create_pty (Lisp_Object process)
XPROCESS (process)->pid = -2;
#ifdef HAVE_PTYS
if (pty_flag)
PSET (XPROCESS (process), tty_name, build_string (pty_name));
pset_tty_name (XPROCESS (process), build_string (pty_name));
else
#endif
PSET (XPROCESS (process), tty_name, Qnil);
pset_tty_name (XPROCESS (process), Qnil);
}
@ -2368,7 +2450,7 @@ OPTION is not a supported option, return nil instead; otherwise return t. */)
if (set_socket_option (s, option, value))
{
PSET (p, childp, Fplist_put (p->childp, option, value));
pset_childp (p, Fplist_put (p->childp, option, value));
return Qt;
}
@ -2601,18 +2683,18 @@ usage: (make-serial-process &rest ARGS) */)
if (NILP (buffer))
buffer = name;
buffer = Fget_buffer_create (buffer);
PSET (p, buffer, buffer);
pset_buffer (p, buffer);
PSET (p, childp, contact);
PSET (p, plist, Fcopy_sequence (Fplist_get (contact, QCplist)));
PSET (p, type, Qserial);
PSET (p, sentinel, Fplist_get (contact, QCsentinel));
PSET (p, filter, Fplist_get (contact, QCfilter));
PSET (p, log, Qnil);
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_type (p, Qserial);
pset_sentinel (p, Fplist_get (contact, QCsentinel));
pset_filter (p, Fplist_get (contact, QCfilter));
pset_log (p, Qnil);
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
PSET (p, command, Qt);
pset_command (p, Qt);
p->pty_flag = 0;
if (!EQ (p->command, Qt))
@ -2644,7 +2726,7 @@ usage: (make-serial-process &rest ARGS) */)
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
val = Qnil;
PSET (p, decode_coding_system, val);
pset_decode_coding_system (p, val);
val = Qnil;
if (!NILP (tem))
@ -2658,12 +2740,12 @@ usage: (make-serial-process &rest ARGS) */)
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
val = Qnil;
PSET (p, encode_coding_system, val);
pset_encode_coding_system (p, val);
setup_process_coding_systems (proc);
PSET (p, decoding_buf, empty_unibyte_string);
pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
PSET (p, encoding_buf, empty_unibyte_string);
pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
@ -3400,23 +3482,23 @@ usage: (make-network-process &rest ARGS) */)
p = XPROCESS (proc);
PSET (p, childp, contact);
PSET (p, plist, Fcopy_sequence (Fplist_get (contact, QCplist)));
PSET (p, type, Qnetwork);
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_type (p, Qnetwork);
PSET (p, buffer, buffer);
PSET (p, sentinel, sentinel);
PSET (p, filter, filter);
PSET (p, log, Fplist_get (contact, QClog));
pset_buffer (p, buffer);
pset_sentinel (p, sentinel);
pset_filter (p, filter);
pset_log (p, Fplist_get (contact, QClog));
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
PSET (p, command, Qt);
pset_command (p, Qt);
p->pid = 0;
p->infd = inch;
p->outfd = outch;
if (is_server && socktype != SOCK_DGRAM)
PSET (p, status, Qlisten);
pset_status (p, Qlisten);
/* Make the process marker point into the process buffer (if any). */
if (BUFFERP (buffer))
@ -3430,7 +3512,7 @@ usage: (make-network-process &rest ARGS) */)
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
connection. */
PSET (p, status, Qconnect);
pset_status (p, Qconnect);
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
@ -3497,7 +3579,7 @@ usage: (make-network-process &rest ARGS) */)
else
val = Qnil;
}
PSET (p, decode_coding_system, val);
pset_decode_coding_system (p, val);
if (!NILP (tem))
{
@ -3531,13 +3613,13 @@ usage: (make-network-process &rest ARGS) */)
else
val = Qnil;
}
PSET (p, encode_coding_system, val);
pset_encode_coding_system (p, val);
}
setup_process_coding_systems (proc);
PSET (p, decoding_buf, empty_unibyte_string);
pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
PSET (p, encoding_buf, empty_unibyte_string);
pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
@ -4150,18 +4232,18 @@ server_accept_connection (Lisp_Object server, int channel)
conv_sockaddr_to_lisp (&saddr.sa, len));
#endif
PSET (p, childp, contact);
PSET (p, plist, Fcopy_sequence (ps->plist));
PSET (p, type, Qnetwork);
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (ps->plist));
pset_type (p, Qnetwork);
PSET (p, buffer, buffer);
PSET (p, sentinel, ps->sentinel);
PSET (p, filter, ps->filter);
PSET (p, command, Qnil);
pset_buffer (p, buffer);
pset_sentinel (p, ps->sentinel);
pset_filter (p, ps->filter);
pset_command (p, Qnil);
p->pid = 0;
p->infd = s;
p->outfd = s;
PSET (p, status, Qrun);
pset_status (p, Qrun);
/* Client processes for accepted connections are not stopped initially. */
if (!EQ (p->filter, Qt))
@ -4178,13 +4260,13 @@ server_accept_connection (Lisp_Object server, int channel)
of the new process should reflect the settings at the time the
server socket was opened; not the current settings. */
PSET (p, decode_coding_system, ps->decode_coding_system);
PSET (p, encode_coding_system, ps->encode_coding_system);
pset_decode_coding_system (p, ps->decode_coding_system);
pset_encode_coding_system (p, ps->encode_coding_system);
setup_process_coding_systems (proc);
PSET (p, decoding_buf, empty_unibyte_string);
pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
PSET (p, encoding_buf, empty_unibyte_string);
pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
@ -4889,7 +4971,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
waitpid() will not find the process object to
delete. Do it here. */
p->tick = ++process_tick;
PSET (p, status, Qfailed);
pset_status (p, Qfailed);
}
else
kill (getpid (), SIGCHLD);
@ -4909,8 +4991,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (XPROCESS (proc)->raw_status_new)
update_status (XPROCESS (proc));
if (EQ (XPROCESS (proc)->status, Qrun))
PSET (XPROCESS (proc), status,
Fcons (Qexit, Fcons (make_number (256), Qnil)));
pset_status (XPROCESS (proc),
list2 (Qexit, make_number (256)));
}
}
#ifdef NON_BLOCKING_CONNECT
@ -4958,13 +5040,12 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (xerrno)
{
p->tick = ++process_tick;
PSET (p, status,
Fcons (Qfailed, Fcons (make_number (xerrno), Qnil)));
pset_status (p, list2 (Qfailed, make_number (xerrno)));
deactivate_process (proc);
}
else
{
PSET (p, status, Qrun);
pset_status (p, Qrun);
/* Execute the sentinel here. If we had relied on
status_notify to do it later, it will read input
from the process before calling the sentinel. */
@ -5164,7 +5245,7 @@ read_process_output (Lisp_Object proc, register int channel)
/* A new coding system might be found. */
if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
PSET (p, decode_coding_system, Vlast_coding_system_used);
pset_decode_coding_system (p, Vlast_coding_system_used);
/* Don't call setup_coding_system for
proc_decode_coding_system[channel] here. It is done in
@ -5180,8 +5261,8 @@ read_process_output (Lisp_Object proc, register int channel)
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
PSET (p, encode_coding_system,
coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
pset_encode_coding_system
(p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[p->outfd]);
}
@ -5190,7 +5271,7 @@ read_process_output (Lisp_Object proc, register int channel)
if (coding->carryover_bytes > 0)
{
if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
PSET (p, decoding_buf, make_uninit_string (coding->carryover_bytes));
pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
memcpy (SDATA (p->decoding_buf), coding->carryover,
coding->carryover_bytes);
p->decoding_carryover = coding->carryover_bytes;
@ -5246,7 +5327,7 @@ read_process_output (Lisp_Object proc, register int channel)
old_begv_byte = BEGV_BYTE;
old_zv_byte = ZV_BYTE;
BSET (current_buffer, read_only, Qnil);
bset_read_only (current_buffer, Qnil);
/* Insert new output into buffer
at the current end-of-output marker,
@ -5274,12 +5355,12 @@ read_process_output (Lisp_Object proc, register int channel)
similar code in the previous `if' block. */
if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
PSET (p, decode_coding_system, Vlast_coding_system_used);
pset_decode_coding_system (p, Vlast_coding_system_used);
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
PSET (p, encode_coding_system,
coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
pset_encode_coding_system
(p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[p->outfd]);
}
@ -5287,7 +5368,7 @@ read_process_output (Lisp_Object proc, register int channel)
if (coding->carryover_bytes > 0)
{
if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
PSET (p, decoding_buf, make_uninit_string (coding->carryover_bytes));
pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
memcpy (SDATA (p->decoding_buf), coding->carryover,
coding->carryover_bytes);
p->decoding_carryover = coding->carryover_bytes;
@ -5337,7 +5418,7 @@ read_process_output (Lisp_Object proc, register int channel)
Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
BSET (current_buffer, read_only, old_read_only);
bset_read_only (current_buffer, old_read_only);
SET_PT_BOTH (opoint, opoint_byte);
}
/* Handling the process output should not deactivate the mark. */
@ -5404,9 +5485,9 @@ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
if (front)
PSET (p, write_queue, Fcons (entry, p->write_queue));
pset_write_queue (p, Fcons (entry, p->write_queue));
else
PSET (p, write_queue, nconc2 (p->write_queue, Fcons (entry, Qnil)));
pset_write_queue (p, nconc2 (p->write_queue, Fcons (entry, Qnil)));
}
/* Remove the first element in the write_queue of process P, put its
@ -5424,7 +5505,7 @@ write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
return 0;
entry = XCAR (p->write_queue);
PSET (p, write_queue, XCDR (p->write_queue));
pset_write_queue (p, XCDR (p->write_queue));
*obj = XCAR (entry);
offset_length = XCDR (entry);
@ -5471,8 +5552,8 @@ send_process (volatile Lisp_Object proc, const char *volatile buf,
&& !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
|| EQ (object, Qt))
{
PSET (p, encode_coding_system,
complement_process_encoding_system (p->encode_coding_system));
pset_encode_coding_system
(p, complement_process_encoding_system (p->encode_coding_system));
if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
{
/* The coding system for encoding was changed to raw-text
@ -5693,7 +5774,7 @@ send_process (volatile Lisp_Object proc, const char *volatile buf,
proc = process_sent_to;
p = XPROCESS (proc);
p->raw_status_new = 0;
PSET (p, status, Fcons (Qexit, Fcons (make_number (256), Qnil)));
pset_status (p, Fcons (Qexit, Fcons (make_number (256), Qnil)));
p->tick = ++process_tick;
deactivate_process (proc);
error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
@ -5922,7 +6003,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
#ifdef SIGCONT
case SIGCONT:
p->raw_status_new = 0;
PSET (p, status, Qrun);
pset_status (p, Qrun);
p->tick = ++process_tick;
if (!nomsg)
{
@ -6018,7 +6099,7 @@ traffic. */)
FD_CLR (p->infd, &input_wait_mask);
FD_CLR (p->infd, &non_keyboard_wait_mask);
}
PSET (p, command, Qt);
pset_command (p, Qt);
return process;
}
#ifndef SIGTSTP
@ -6054,7 +6135,7 @@ traffic. */)
tcflush (p->infd, TCIFLUSH);
#endif /* not WINDOWSNT */
}
PSET (p, command, Qnil);
pset_command (p, Qnil);
return process;
}
#ifdef SIGCONT
@ -6470,7 +6551,7 @@ sigchld_handler (int signo)
static Lisp_Object
exec_sentinel_unwind (Lisp_Object data)
{
PSET (XPROCESS (XCAR (data)), sentinel, XCDR (data));
pset_sentinel (XPROCESS (XCAR (data)), XCDR (data));
return Qnil;
}
@ -6516,7 +6597,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
/* Zilch the sentinel while it's running, to avoid recursive invocations;
assure that it gets restored no matter how the sentinel exits. */
PSET (p, sentinel, Qnil);
pset_sentinel (p, Qnil);
record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
/* Inhibit quit so that random quits don't screw up a running filter. */
specbind (Qinhibit_quit, Qt);
@ -6671,13 +6752,13 @@ status_notify (struct Lisp_Process *deleting_process)
before_byte = PT_BYTE;
tem = BVAR (current_buffer, read_only);
BSET (current_buffer, read_only, Qnil);
bset_read_only (current_buffer, Qnil);
insert_string ("\nProcess ");
{ /* FIXME: temporary kludge */
Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
insert_string (" ");
Finsert (1, &msg);
BSET (current_buffer, read_only, tem);
bset_read_only (current_buffer, tem);
set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
if (opoint >= before)
@ -6714,8 +6795,8 @@ encode subprocess input. */)
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
encoding = coding_inherit_eol_type (encoding, Qnil);
PSET (p, decode_coding_system, decoding);
PSET (p, encode_coding_system, encoding);
pset_decode_coding_system (p, decoding);
pset_encode_coding_system (p, encoding);
setup_process_coding_systems (process);
return Qnil;
@ -6745,8 +6826,8 @@ suppressed. */)
CHECK_PROCESS (process);
p = XPROCESS (process);
if (NILP (flag))
PSET (p, decode_coding_system,
raw_text_coding_system (p->decode_coding_system));
pset_decode_coding_system
(p, raw_text_coding_system (p->decode_coding_system));
setup_process_coding_systems (process);
return Qnil;

27
src/process.h
View File

@ -26,10 +26,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "gnutls.h"
#endif
/* Most code should use these macros to set
Lisp fields in struct Lisp_Process. */
#define PSET(p, field, value) ((p)->field = (value))
INLINE_HEADER_BEGIN
#ifndef PROCESS_INLINE
# define PROCESS_INLINE INLINE
#endif
/* This structure records information about a subprocess
or network connection. */
@ -165,6 +165,23 @@ struct Lisp_Process
#define ChannelMask(n) (1 << (n))
/* Most code should use these functions to set Lisp fields in struct
process. */
PROCESS_INLINE void
pset_childp (struct Lisp_Process *p, Lisp_Object val)
{
p->childp = val;
}
#ifdef HAVE_GNUTLS
PROCESS_INLINE void
pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)
{
p->gnutls_cred_type = val;
}
#endif
/* True if we are about to fork off a synchronous process or if we
are waiting for it. */
extern int synch_process_alive;
@ -208,3 +225,5 @@ extern void add_read_fd (int fd, fd_callback func, void *data);
extern void delete_read_fd (int fd);
extern void add_write_fd (int fd, fd_callback func, void *data);
extern void delete_write_fd (int fd);
INLINE_HEADER_END

6
src/search.c
View File

@ -278,7 +278,7 @@ looking_at_1 (Lisp_Object string, int posix)
save_search_regs ();
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
char_table_set_extras (BVAR (current_buffer, case_canon_table), 2,
set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
BVAR (current_buffer, case_eqv_table));
CHECK_STRING (string);
@ -393,7 +393,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int p
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
char_table_set_extras (BVAR (current_buffer, case_canon_table), 2,
set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
BVAR (current_buffer, case_eqv_table));
bufp = compile_pattern (regexp,
@ -990,7 +990,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
char_table_set_extras (BVAR (current_buffer, case_canon_table), 2,
set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
BVAR (current_buffer, case_eqv_table));
np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,

11
src/syntax.c
View File

@ -149,6 +149,13 @@ static void scan_sexps_forward (struct lisp_parse_state *,
ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
int, Lisp_Object, int);
static int in_classes (int, Lisp_Object);
/* This setter is used only in this file, so it can be private. */
static inline void
bset_syntax_table (struct buffer *b, Lisp_Object val)
{
b->INTERNAL_FIELD (syntax_table) = val;
}
/* Whether the syntax of the character C has the prefix flag set. */
int syntax_prefix_flag_p (int c)
@ -818,7 +825,7 @@ It is a copy of the TABLE, which defaults to the standard syntax table. */)
/* Only the standard syntax table should have a default element.
Other syntax tables should inherit from parents instead. */
CSET (XCHAR_TABLE (copy), defalt, Qnil);
set_char_table_defalt (copy, Qnil);
/* Copied syntax tables should all have parents.
If we copied one with no parent, such as the standard syntax table,
@ -835,7 +842,7 @@ One argument, a syntax table. */)
{
int idx;
check_syntax_table (table);
BSET (current_buffer, syntax_table, table);
bset_syntax_table (current_buffer, table);
/* Indicate that this buffer now has a specified syntax table. */
idx = PER_BUFFER_VAR_IDX (syntax_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);

3
src/sysdep.c
View File

@ -2307,8 +2307,7 @@ serial_configure (struct Lisp_Process *p,
error ("tcsetattr() failed: %s", emacs_strerror (errno));
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
PSET (p, childp, childp2);
pset_childp (p, childp2);
}
#endif /* not DOS_NT */

4
src/term.c
View File

@ -1332,7 +1332,7 @@ term_get_fkeys_1 (void)
/* This can happen if CANNOT_DUMP or with strange options. */
if (!KEYMAPP (KVAR (kboard, Vinput_decode_map)))
KSET (kboard, Vinput_decode_map, Fmake_sparse_keymap (Qnil));
kset_input_decode_map (kboard, Fmake_sparse_keymap (Qnil));
for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++)
{
@ -3280,7 +3280,7 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\
terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
KSET (terminal->kboard, Vwindow_system, Qnil);
kset_window_system (terminal->kboard, Qnil);
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
terminal->kboard->reference_count++;

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