+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * configure.ac: Do not check for fcntl.h.
+ * lib/gnulib.mk: Regenerate.
+
+2012-11-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used pty_max_bytes variable.
+ * configure.ac (fpathconf): Remove unnecessary check.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ * .bzrignore: Add lib/fcntl.h.
+ * configure.ac (euidaccess): Remove check; gnulib does this for us now.
+ (gl_FCNTL_O_FLAGS): Define a dummy version.
+ * lib/at-func.c, lib/euidaccess.c, lib/faccessat.c, lib/fcntl.in.h:
+ * lib/getgroups.c, lib/group-member.c, lib/root-uid.h:
+ * lib/xalloc-oversized.h, m4/euidaccess.m4, m4/faccessat.m4:
+ * m4/fcntl_h.m4, m4/getgroups.m4, m4/group-member.m4:
+ New files, from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+2012-11-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800).
+ * configure.ac (setpgid, setsid): Assume their existence.
+ (AC_FUNC_GETPGRP, SETPGRP_RELEASES_CTTY): Remove; obsolete.
+
+ Simplify by assuming __fpending.
+ Now that Emacs is using the gnulib fpending module,
+ there's no need for Emacs to have a separate implementation.
+ * configure.ac (stdio_ext.h, __fpending): Remove now-duplicate checks.
+ (PENDING_OUTPUT_COUNT, DISPNEW_NEEDS_STDIO_EXT): Remove.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/fpending.$(O) and
+ $(BLD)/close-stream.$(O).
+ ($(BLD)/close-stream.$(O)):
+ ($(BLD)/fpending.$(O)): New dependencies.
+
+2012-11-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix data-loss with --batch (Bug#9574).
+ * lib/close-stream.c, lib/close-stream.h, lib/fpending.c
+ * lib/fpending.h, m4/close-stream.m4, m4/fpending.m4:
+ New files, from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
2012-11-03 Eli Zaretskii <eliz@gnu.org>
* config.bat: Copy lib/execinfo.in.h to lib/execinfo.in-h if needed.
+2012-11-02 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (EMACS_ICON): New variable.
+ (install-etc): Use EMACS_ICON to allow choice of icon.
+
2012-10-26 Glenn Morris <rgm@gnu.org>
* Makefile.in (EMACS_NAME): New variable.
done
## Install those items from etc/ that need to end up elsewhere.
+
+## If you prefer, choose "emacs22" at installation time.
+## Note: emacs22 does not have all the resolutions.
+EMACS_ICON=emacs
+
install-etc:
umask 022; ${MKDIR_P} $(DESTDIR)${desktopdir}
tmp=etc/emacs.tmpdesktop; rm -f $${tmp}; \
for dir in */*/apps */*/mimetypes; do \
[ -d $${dir} ] || continue ; \
( cd $${thisdir}; ${MKDIR_P} $(DESTDIR)${icondir}/$${dir} ) ; \
- for icon in $${dir}/emacs[.-]*; do \
+ for icon in $${dir}/${EMACS_ICON}[.-]*; do \
[ -r $${icon} ] || continue ; \
ext=`echo "$${icon}" | sed -e 's|.*\.||'`; \
- dest=`echo "$${icon}" | sed -e 's|.*/||' -e "s|\.$${ext}$$||" -e '$(TRANSFORM)'`.$${ext} ; \
+ dest=`echo "$${icon}" | sed -e 's|.*/||' -e "s|\.$${ext}$$||" -e 's/$(EMACS_ICON)/emacs/' -e '$(TRANSFORM)'`.$${ext} ; \
( cd $${thisdir}; \
${INSTALL_DATA} ${iconsrcdir}/$${icon} $(DESTDIR)${icondir}/$${dir}/$${dest} ) \
|| exit 1; \
See the end of the file for license conditions.
-This directory tree holds version 24.2.50 of GNU Emacs, the extensible,
+This directory tree holds version 24.3.50 of GNU Emacs, the extensible,
customizable, self-documenting real-time display editor.
The file INSTALL in this directory says how to build and install GNU
HAVE_ENDPWENT
HAVE_ENVIRON_DECL
HAVE_EUIDACCESS
-HAVE_FCNTL_H
HAVE_FORK
-HAVE_FPATHCONF
HAVE_FREEIFADDRS
HAVE_FREETYPE
HAVE_FSEEKO
HAVE_SEQPACKET
HAVE_SETITIMER
HAVE_SETLOCALE
-HAVE_SETPGID
HAVE_SETRLIMIT
-HAVE_SETSID
HAVE_SHARED_GAME_DIR
HAVE_SHUTDOWN
HAVE_SIGNED_${GLTYPE}
NSIG_MINIMUM
NULL_DEVICE
ORDINARY_LINK
-O_RDONLY
-O_RDWR
PAGESIZE
-PENDING_OUTPUT_COUNT
PREFER_VSUSP
PTY_ITERATION
PTY_NAME_SPRINTF
PTY_TTY_NAME_SPRINTF
PURESIZE
RUN_TIME_REMAP
-SETPGRP_RELEASES_CTTY
SETUP_SLAVE_PTY
SIGALRM
SIGCHLD
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * CPP-DEFINES (O_RDONLY, O_RDWR, HAVE_FCNTL_H): Remove.
+ * merge-gnulib (GNULIB_MODULES): Add fcntl-h.
+
+2012-11-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used pty_max_bytes variable.
+ * CPP-DEFINES (HAVE_FPATHCONF): Remove.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ * merge-gnulib (GNULIB_MODULES): Add faccessat.
+ (GNULIB_TOOL_FLAGS): Avoid at-internal, fchdir, malloc-posix,
+ openat-die, openat-h, save-cwd. Do not avoid fcntl-h.
+ Omit gnulib's m4/fcntl-o.m4.
+
+2012-11-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800).
+ * CPP-DEFINES (HAVE_SETPGID, HAVE_SETSID, SETPGRP_RELEASES_CTTY):
+ Remove; obsolete.
+
+ Simplify by assuming __fpending.
+ * CPP-DEFINES (PENDING_OUTPUT_COUNT): Remove.
+
+2012-11-03 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (set-copyright): Add msdos/sed2v2.inp.
+
+2012-11-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix data-loss with --batch (Bug#9574).
+ * merge-gnulib (GNULIB_MODULES): Add close-stream.
+
2012-10-12 Kenichi Handa <handa@gnu.org>
* charsets/Makefile (JISC6226.map): Add missing mappings.
(set-version-in-file root "configure.ac" copyright
(rx (and bol "copyright" (0+ (not (in ?\")))
?\" (submatch (1+ (not (in ?\")))) ?\")))
+ (set-version-in-file root "msdos/sed2v2.inp" copyright
+ (rx (and bol "/^#undef " (1+ not-newline)
+ "define COPYRIGHT" (1+ space)
+ ?\" (submatch (1+ (not (in ?\")))) ?\")))
(set-version-in-file root "nt/config.nt" copyright
(rx (and bol "#" (0+ blank) "define" (1+ blank)
"COPYRIGHT" (1+ blank)
GNULIB_MODULES='
alloca-opt c-ctype c-strcase
- careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512
- dtoastr dtotimespec dup2 environ execinfo
- filemode getloadavg getopt-gnu gettime gettimeofday
+ careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512
+ dtoastr dtotimespec dup2 environ execinfo faccessat
+ fcntl-h filemode getloadavg getopt-gnu gettime gettimeofday
ignore-value intprops largefile lstat
manywarnings mktime pselect pthread_sigmask readlink
socklen stat-time stdalign stdarg stdbool stdio
'
GNULIB_TOOL_FLAGS='
- --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=at-internal
+ --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat
+ --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow
+ --avoid=openat-die --avoid=openat-h
+ --avoid=raise
+ --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types
--avoid=threadlib
--conditional-dependencies --import --no-changelog --no-vc-files
--makefile-name=gnulib.mk
}
"$gnulib_srcdir"/gnulib-tool --dir="$src" $GNULIB_TOOL_FLAGS $GNULIB_MODULES &&
-rm -- "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 &&
+rm -- "$src"m4/fcntl-o.m4 "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 &&
cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc &&
cp -- "$gnulib_srcdir"/build-aux/move-if-change "$src"build-aux &&
autoreconf -i -I m4 -- ${src:+"$src"}
# 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-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo 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 timer-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=at-internal --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=openat-h --avoid=raise --avoid=save-cwd --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 close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat 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 timer-time timespec-add timespec-sub utimens warnings
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \
$(top_srcdir)/m4/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \
- $(top_srcdir)/m4/clock_time.m4 $(top_srcdir)/m4/dup2.m4 \
- $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/execinfo.m4 \
- $(top_srcdir)/m4/extensions.m4 \
- $(top_srcdir)/m4/extern-inline.m4 $(top_srcdir)/m4/filemode.m4 \
- $(top_srcdir)/m4/getloadavg.m4 $(top_srcdir)/m4/getopt.m4 \
- $(top_srcdir)/m4/gettime.m4 $(top_srcdir)/m4/gettimeofday.m4 \
+ $(top_srcdir)/m4/clock_time.m4 \
+ $(top_srcdir)/m4/close-stream.m4 $(top_srcdir)/m4/dup2.m4 \
+ $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/euidaccess.m4 \
+ $(top_srcdir)/m4/execinfo.m4 $(top_srcdir)/m4/extensions.m4 \
+ $(top_srcdir)/m4/extern-inline.m4 \
+ $(top_srcdir)/m4/faccessat.m4 $(top_srcdir)/m4/fcntl_h.m4 \
+ $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/fpending.m4 \
+ $(top_srcdir)/m4/getgroups.m4 $(top_srcdir)/m4/getloadavg.m4 \
+ $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gettime.m4 \
+ $(top_srcdir)/m4/gettimeofday.m4 \
$(top_srcdir)/m4/gnulib-common.m4 \
$(top_srcdir)/m4/gnulib-comp.m4 \
+ $(top_srcdir)/m4/group-member.m4 \
$(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.m4 \
$(top_srcdir)/m4/largefile.m4 $(top_srcdir)/m4/longlong.m4 \
$(top_srcdir)/m4/lstat.m4 $(top_srcdir)/m4/manywarnings.m4 \
am__DEPENDENCIES_1 =
am__libgnu_a_SOURCES_DIST = allocator.c c-ctype.h c-ctype.c \
c-strcase.h c-strcasecmp.c c-strncasecmp.c careadlinkat.c \
- md5.c sha1.c sha256.c sha512.c dtoastr.c dtotimespec.c \
- filemode.c gettext.h gettime.c stat-time.c strftime.c \
- timespec.c timespec-add.c timespec-sub.c u64.c utimens.c
+ close-stream.c md5.c sha1.c sha256.c sha512.c dtoastr.c \
+ dtotimespec.c filemode.c gettext.h gettime.c stat-time.c \
+ strftime.c timespec.c timespec-add.c timespec-sub.c u64.c \
+ utimens.c
am__objects_1 =
am_libgnu_a_OBJECTS = allocator.$(OBJEXT) c-ctype.$(OBJEXT) \
c-strcasecmp.$(OBJEXT) c-strncasecmp.$(OBJEXT) \
- careadlinkat.$(OBJEXT) md5.$(OBJEXT) sha1.$(OBJEXT) \
- sha256.$(OBJEXT) sha512.$(OBJEXT) dtoastr.$(OBJEXT) \
- dtotimespec.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \
- gettime.$(OBJEXT) stat-time.$(OBJEXT) strftime.$(OBJEXT) \
- timespec.$(OBJEXT) timespec-add.$(OBJEXT) \
+ careadlinkat.$(OBJEXT) close-stream.$(OBJEXT) md5.$(OBJEXT) \
+ sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \
+ dtoastr.$(OBJEXT) dtotimespec.$(OBJEXT) filemode.$(OBJEXT) \
+ $(am__objects_1) gettime.$(OBJEXT) stat-time.$(OBJEXT) \
+ strftime.$(OBJEXT) timespec.$(OBJEXT) timespec-add.$(OBJEXT) \
timespec-sub.$(OBJEXT) u64.$(OBJEXT) utimens.$(OBJEXT)
libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS)
depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp
GNULIB_FCHMODAT = @GNULIB_FCHMODAT@
GNULIB_FCHOWNAT = @GNULIB_FCHOWNAT@
GNULIB_FCLOSE = @GNULIB_FCLOSE@
+GNULIB_FCNTL = @GNULIB_FCNTL@
GNULIB_FDATASYNC = @GNULIB_FDATASYNC@
GNULIB_FDOPEN = @GNULIB_FDOPEN@
GNULIB_FFLUSH = @GNULIB_FFLUSH@
GNULIB_MKSTEMPS = @GNULIB_MKSTEMPS@
GNULIB_MKTIME = @GNULIB_MKTIME@
GNULIB_NANOSLEEP = @GNULIB_NANOSLEEP@
+GNULIB_NONBLOCKING = @GNULIB_NONBLOCKING@
GNULIB_OBSTACK_PRINTF = @GNULIB_OBSTACK_PRINTF@
GNULIB_OBSTACK_PRINTF_POSIX = @GNULIB_OBSTACK_PRINTF_POSIX@
+GNULIB_OPEN = @GNULIB_OPEN@
+GNULIB_OPENAT = @GNULIB_OPENAT@
GNULIB_PCLOSE = @GNULIB_PCLOSE@
GNULIB_PERROR = @GNULIB_PERROR@
GNULIB_PIPE = @GNULIB_PIPE@
HAVE_FCHDIR = @HAVE_FCHDIR@
HAVE_FCHMODAT = @HAVE_FCHMODAT@
HAVE_FCHOWNAT = @HAVE_FCHOWNAT@
+HAVE_FCNTL = @HAVE_FCNTL@
HAVE_FDATASYNC = @HAVE_FDATASYNC@
HAVE_FSEEKO = @HAVE_FSEEKO@
HAVE_FSTATAT = @HAVE_FSTATAT@
HAVE_MKSTEMP = @HAVE_MKSTEMP@
HAVE_MKSTEMPS = @HAVE_MKSTEMPS@
HAVE_NANOSLEEP = @HAVE_NANOSLEEP@
+HAVE_OPENAT = @HAVE_OPENAT@
HAVE_OS_H = @HAVE_OS_H@
HAVE_PCLOSE = @HAVE_PCLOSE@
HAVE_PIPE = @HAVE_PIPE@
LIBXT_OTHER = @LIBXT_OTHER@
LIBX_OTHER = @LIBX_OTHER@
LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
+LIB_EACCESS = @LIB_EACCESS@
LIB_EXECINFO = @LIB_EXECINFO@
LIB_GCC = @LIB_GCC@
LIB_MATH = @LIB_MATH@
MAKEINFO = @MAKEINFO@
MKDEPDIR = @MKDEPDIR@
MKDIR_P = @MKDIR_P@
+NEXT_AS_FIRST_DIRECTIVE_FCNTL_H = @NEXT_AS_FIRST_DIRECTIVE_FCNTL_H@
NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@
NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@
NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@
NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H@
NEXT_AS_FIRST_DIRECTIVE_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_TIME_H@
NEXT_AS_FIRST_DIRECTIVE_UNISTD_H = @NEXT_AS_FIRST_DIRECTIVE_UNISTD_H@
+NEXT_FCNTL_H = @NEXT_FCNTL_H@
NEXT_GETOPT_H = @NEXT_GETOPT_H@
NEXT_INTTYPES_H = @NEXT_INTTYPES_H@
NEXT_SIGNAL_H = @NEXT_SIGNAL_H@
REPLACE_DUP2 = @REPLACE_DUP2@
REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@
REPLACE_FCLOSE = @REPLACE_FCLOSE@
+REPLACE_FCNTL = @REPLACE_FCNTL@
REPLACE_FDOPEN = @REPLACE_FDOPEN@
REPLACE_FFLUSH = @REPLACE_FFLUSH@
REPLACE_FOPEN = @REPLACE_FOPEN@
REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@
REPLACE_NULL = @REPLACE_NULL@
REPLACE_OBSTACK_PRINTF = @REPLACE_OBSTACK_PRINTF@
+REPLACE_OPEN = @REPLACE_OPEN@
+REPLACE_OPENAT = @REPLACE_OPENAT@
REPLACE_PERROR = @REPLACE_PERROR@
REPLACE_POPEN = @REPLACE_POPEN@
REPLACE_PREAD = @REPLACE_PREAD@
# statements but through direct file reference. Therefore this snippet must be
# present in all Makefile.am that need it. This is ensured by the applicability
# 'all' defined above.
-BUILT_SOURCES = $(ALLOCA_H) $(EXECINFO_H) $(GETOPT_H) inttypes.h \
- signal.h arg-nonnull.h c++defs.h warn-on-use.h $(STDALIGN_H) \
- $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \
- stdlib.h sys/select.h sys/stat.h sys/time.h time.h unistd.h
-EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h md5.h sha1.h \
- sha256.h sha512.h dosname.h ftoastr.c ftoastr.h dup2.c \
- execinfo.c execinfo.in.h filemode.h getloadavg.c getopt.c \
- getopt.in.h getopt1.c getopt_int.h gettimeofday.c \
- ignore-value.h intprops.h inttypes.in.h lstat.c \
- mktime-internal.h mktime.c pathmax.h pselect.c \
- pthread_sigmask.c readlink.c signal.in.h \
- $(top_srcdir)/build-aux/snippet/_Noreturn.h \
+BUILT_SOURCES = $(ALLOCA_H) $(EXECINFO_H) fcntl.h $(GETOPT_H) \
+ inttypes.h signal.h arg-nonnull.h c++defs.h warn-on-use.h \
+ $(STDALIGN_H) $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) \
+ stdio.h stdlib.h sys/select.h sys/stat.h sys/time.h time.h \
+ unistd.h
+EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h close-stream.h \
+ md5.h sha1.h sha256.h sha512.h dosname.h ftoastr.c ftoastr.h \
+ dup2.c euidaccess.c execinfo.c execinfo.in.h at-func.c \
+ faccessat.c fcntl.in.h filemode.h fpending.c fpending.h \
+ getgroups.c getloadavg.c getopt.c getopt.in.h getopt1.c \
+ getopt_int.h gettimeofday.c group-member.c ignore-value.h \
+ intprops.h inttypes.in.h lstat.c mktime-internal.h mktime.c \
+ pathmax.h pselect.c pthread_sigmask.c readlink.c root-uid.h \
+ signal.in.h $(top_srcdir)/build-aux/snippet/_Noreturn.h \
$(top_srcdir)/build-aux/snippet/arg-nonnull.h \
$(top_srcdir)/build-aux/snippet/c++defs.h \
$(top_srcdir)/build-aux/snippet/warn-on-use.h stat.c \
strtol.c strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \
strtoumax.c symlink.c sys_select.in.h sys_stat.in.h \
sys_time.in.h time.in.h time_r.c timespec.h u64.h unistd.in.h \
- utimens.h verify.h
+ utimens.h verify.h xalloc-oversized.h
MOSTLYCLEANDIRS = sys sys
MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t execinfo.h \
- execinfo.h-t getopt.h getopt.h-t inttypes.h inttypes.h-t \
- signal.h signal.h-t arg-nonnull.h arg-nonnull.h-t c++defs.h \
- c++defs.h-t warn-on-use.h warn-on-use.h-t stdalign.h \
+ execinfo.h-t fcntl.h fcntl.h-t getopt.h getopt.h-t inttypes.h \
+ inttypes.h-t signal.h signal.h-t arg-nonnull.h arg-nonnull.h-t \
+ c++defs.h c++defs.h-t warn-on-use.h warn-on-use.h-t stdalign.h \
stdalign.h-t stdarg.h stdarg.h-t stdbool.h stdbool.h-t \
stddef.h stddef.h-t stdint.h stdint.h-t stdio.h stdio.h-t \
stdlib.h stdlib.h-t sys/select.h sys/select.h-t sys/stat.h \
AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src
libgnu_a_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \
- c-strcasecmp.c c-strncasecmp.c careadlinkat.c md5.c sha1.c \
- sha256.c sha512.c dtoastr.c dtotimespec.c filemode.c \
- $(am__append_1) gettime.c stat-time.c strftime.c timespec.c \
- timespec-add.c timespec-sub.c u64.c utimens.c
+ c-strcasecmp.c c-strncasecmp.c careadlinkat.c close-stream.c \
+ md5.c sha1.c sha256.c sha512.c dtoastr.c dtotimespec.c \
+ filemode.c $(am__append_1) gettime.c stat-time.c strftime.c \
+ timespec.c timespec-add.c timespec-sub.c u64.c utimens.c
libgnu_a_LIBADD = $(gl_LIBOBJS)
libgnu_a_DEPENDENCIES = $(gl_LIBOBJS)
-EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c execinfo.c getloadavg.c \
- getopt.c getopt1.c gettimeofday.c lstat.c mktime.c pselect.c \
- pthread_sigmask.c readlink.c stat.c strtoimax.c strtol.c \
- strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \
- strtoumax.c symlink.c time_r.c
+EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c euidaccess.c execinfo.c \
+ at-func.c faccessat.c fpending.c getgroups.c getloadavg.c \
+ getopt.c getopt1.c gettimeofday.c group-member.c lstat.c \
+ mktime.c pselect.c pthread_sigmask.c readlink.c stat.c \
+ strtoimax.c strtol.c strtoll.c strtol.c strtoul.c strtoull.c \
+ strtoimax.c strtoumax.c symlink.c time_r.c
# Because this Makefile snippet defines a variable used by other
# gnulib Makefile snippets, it must be present in all Makefile.am that
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/at-func.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-ctype.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strcasecmp.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strncasecmp.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/careadlinkat.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close-stream.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtotimespec.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/euidaccess.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/execinfo.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/faccessat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fpending.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getgroups.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt1.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettime.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettimeofday.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/group-member.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lstat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@
@GL_GENERATE_EXECINFO_H_FALSE@execinfo.h: $(top_builddir)/config.status
@GL_GENERATE_EXECINFO_H_FALSE@ rm -f $@
+# We need the following in order to create <fcntl.h> when the system
+# doesn't have one that works with the given compiler.
+fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_FCNTL_H''@|$(NEXT_FCNTL_H)|g' \
+ -e 's/@''GNULIB_FCNTL''@/$(GNULIB_FCNTL)/g' \
+ -e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \
+ -e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \
+ -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \
+ -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \
+ -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \
+ -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \
+ -e 's|@''REPLACE_OPENAT''@|$(REPLACE_OPENAT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/fcntl.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+
# We need the following in order to create <getopt.h> when the system
# doesn't have one that works with the given compiler.
getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H)
m4_include([m4/alloca.m4])
m4_include([m4/c-strtod.m4])
m4_include([m4/clock_time.m4])
+m4_include([m4/close-stream.m4])
m4_include([m4/dup2.m4])
m4_include([m4/environ.m4])
+m4_include([m4/euidaccess.m4])
m4_include([m4/execinfo.m4])
m4_include([m4/extensions.m4])
m4_include([m4/extern-inline.m4])
+m4_include([m4/faccessat.m4])
+m4_include([m4/fcntl_h.m4])
m4_include([m4/filemode.m4])
+m4_include([m4/fpending.m4])
+m4_include([m4/getgroups.m4])
m4_include([m4/getloadavg.m4])
m4_include([m4/getopt.m4])
m4_include([m4/gettime.m4])
m4_include([m4/gettimeofday.m4])
m4_include([m4/gnulib-common.m4])
m4_include([m4/gnulib-comp.m4])
+m4_include([m4/group-member.m4])
m4_include([m4/include_next.m4])
m4_include([m4/inttypes.m4])
m4_include([m4/largefile.m4])
/* Character that separates directories in a file name. */
#undef DIRECTORY_SEP
-/* Define if dispnew.c should include stdio_ext.h. */
-#undef DISPNEW_NEEDS_STDIO_EXT
-
/* Define if process.c does not need to close a pty to make it a controlling
terminal (it is already a controlling terminal of the subprocess, because
we did ioctl TIOCSCTTY). */
garbage collection in the jmp_buf. */
#undef GC_SETJMP_WORKS
-/* Define to 1 if the `getpgrp' function requires zero arguments. */
-#undef GETPGRP_VOID
+/* Define to the type of elements in the array set by `getgroups'. Usually
+ this is either `int' or `gid_t'. */
+#undef GETGROUPS_T
+
+/* Define this to 1 if getgroups(0,NULL) does not return the number of groups.
+ */
+#undef GETGROUPS_ZERO_BUG
/* Define if gettimeofday clobbers the localtime buffer. */
#undef GETTIMEOFDAY_CLOBBERS_LOCALTIME
/* Define this to enable glyphs debugging code. */
#undef GLYPH_DEBUG
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module close-stream shall be considered present. */
+#undef GNULIB_CLOSE_STREAM
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module faccessat shall be considered present. */
+#undef GNULIB_FACCESSAT
+
/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
whether the gnulib module fscanf shall be considered present. */
#undef GNULIB_FSCANF
startup, if using GTK. */
#undef G_SLICE_ALWAYS_MALLOC
+/* Define to 1 if you have the `access' function. */
+#undef HAVE_ACCESS
+
/* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */
#undef HAVE_AIX_SMT_EXP
*/
#undef HAVE_DECL_TZNAME
+/* Define to 1 if you have the declaration of `__fpending', and to 0 if you
+ don't. */
+#undef HAVE_DECL___FPENDING
+
/* Define to 1 if you have the declaration of `__sys_siglist', and to 0 if you
don't. */
#undef HAVE_DECL___SYS_SIGLIST
/* Define to 1 if you have the 'dup2' function. */
#undef HAVE_DUP2
+/* Define to 1 if you have the `eaccess' function. */
+#undef HAVE_EACCESS
+
/* Define to 1 if you have the `endgrent' function. */
#undef HAVE_ENDGRENT
/* Define to 1 if you have the <execinfo.h> header file. */
#undef HAVE_EXECINFO_H
+/* Define to 1 if you have the `faccessat' function. */
+#undef HAVE_FACCESSAT
+
/* Define to 1 if you have the <fcntl.h> header file. */
#undef HAVE_FCNTL_H
/* Define to 1 if you have the `fork' function. */
#undef HAVE_FORK
-/* Define to 1 if you have the `fpathconf' function. */
-#undef HAVE_FPATHCONF
-
/* Define to 1 if you have the `freeifaddrs' function. */
#undef HAVE_FREEIFADDRS
/* Define to 1 if you have the `getgrent' function. */
#undef HAVE_GETGRENT
+/* Define to 1 if your system has a working `getgroups' function. */
+#undef HAVE_GETGROUPS
+
/* Define to 1 if you have the `gethostname' function. */
#undef HAVE_GETHOSTNAME
/* Define to 1 if you have the `dnet' library (-ldnet). */
#undef HAVE_LIBDNET
+/* Define to 1 if you have the <libgen.h> header file. */
+#undef HAVE_LIBGEN_H
+
/* Define to 1 if you have the hesiod library (-lhesiod). */
#undef HAVE_LIBHESIOD
/* Define to 1 if you have the `setlocale' function. */
#undef HAVE_SETLOCALE
-/* Define to 1 if you have the `setpgid' function. */
-#undef HAVE_SETPGID
-
/* Define to 1 if you have the `setrlimit' function. */
#undef HAVE_SETRLIMIT
-/* Define to 1 if you have the `setsid' function. */
-#undef HAVE_SETSID
-
/* Define to 1 if you have the `shutdown' function. */
#undef HAVE_SHUTDOWN
/* Define to the version of this package. */
#undef PACKAGE_VERSION
-/* Number of chars of output in the buffer of a stdio stream. */
-#undef PENDING_OUTPUT_COUNT
+/* the number of pending output bytes on stream 'fp' */
+#undef PENDING_OUTPUT_N_BYTES
/* Define to empty to suppress deprecation warnings when building with
--enable-gcc-warnings and with libpng versions before 1.5, which lack
/* Character that separates PATH elements. */
#undef SEPCHAR
-/* Define if process.c:child_setup should not call setpgrp. */
-#undef SETPGRP_RELEASES_CTTY
-
/* How to set up a slave PTY, if needed. */
#undef SETUP_SLAVE_PTY
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.65 for emacs 24.2.50.
+# Generated by GNU Autoconf 2.65 for emacs 24.3.50.
#
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# Identity of this package.
PACKAGE_NAME='emacs'
PACKAGE_TARNAME='emacs'
-PACKAGE_VERSION='24.2.50'
-PACKAGE_STRING='emacs 24.2.50'
+PACKAGE_VERSION='24.3.50'
+PACKAGE_STRING='emacs 24.3.50'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
LIBGNU_LTLIBDEPS
LIBGNU_LIBDEPS
gltests_WITNESS
+gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE
+gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE
gl_GNULIB_ENABLED_verify_FALSE
gl_GNULIB_ENABLED_verify_TRUE
gl_GNULIB_ENABLED_strtoull_FALSE
gl_GNULIB_ENABLED_strtoll_TRUE
gl_GNULIB_ENABLED_stat_FALSE
gl_GNULIB_ENABLED_stat_TRUE
+gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE
+gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE
gl_GNULIB_ENABLED_pathmax_FALSE
gl_GNULIB_ENABLED_pathmax_TRUE
+gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE
+gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE
+gl_GNULIB_ENABLED_getgroups_FALSE
+gl_GNULIB_ENABLED_getgroups_TRUE
+gl_GNULIB_ENABLED_euidaccess_FALSE
+gl_GNULIB_ENABLED_euidaccess_TRUE
gl_GNULIB_ENABLED_dosname_FALSE
gl_GNULIB_ENABLED_dosname_TRUE
LTLIBINTL
LIBINTL
+LIB_EACCESS
WINDOWS_64_BIT_OFF_T
HAVE_UNISTD_H
NEXT_AS_FIRST_DIRECTIVE_UNISTD_H
HAVE_GETOPT_H
NEXT_AS_FIRST_DIRECTIVE_GETOPT_H
NEXT_GETOPT_H
-PRAGMA_COLUMNS
-PRAGMA_SYSTEM_HEADER
-INCLUDE_NEXT_AS_FIRST_DIRECTIVE
-INCLUDE_NEXT
GETLOADAVG_LIBS
REPLACE_WCTOMB
REPLACE_UNSETENV
GNULIB_CALLOC_POSIX
GNULIB_ATOLL
GNULIB__EXIT
+NEXT_AS_FIRST_DIRECTIVE_FCNTL_H
+NEXT_FCNTL_H
+PRAGMA_COLUMNS
+PRAGMA_SYSTEM_HEADER
+INCLUDE_NEXT_AS_FIRST_DIRECTIVE
+INCLUDE_NEXT
+REPLACE_OPENAT
+REPLACE_OPEN
+REPLACE_FCNTL
+HAVE_OPENAT
+HAVE_FCNTL
+GNULIB_OPENAT
+GNULIB_OPEN
+GNULIB_NONBLOCKING
+GNULIB_FCNTL
GL_GENERATE_EXECINFO_H_FALSE
GL_GENERATE_EXECINFO_H_TRUE
LIB_EXECINFO
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures emacs 24.2.50 to adapt to many kinds of systems.
+\`configure' configures emacs 24.3.50 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of emacs 24.2.50:";;
+ short | recursive ) echo "Configuration of emacs 24.3.50:";;
esac
cat <<\_ACEOF
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-emacs configure 24.2.50
+emacs configure 24.3.50
generated by GNU Autoconf 2.65
Copyright (C) 2009 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by emacs $as_me 24.2.50, which was
+It was created by emacs $as_me 24.3.50, which was
generated by GNU Autoconf 2.65. Invocation command line was
$ $0 $@
as_fn_append ac_header_list " linux/version.h"
as_fn_append ac_header_list " sys/systeminfo.h"
-as_fn_append ac_header_list " stdio_ext.h"
as_fn_append ac_header_list " fcntl.h"
as_fn_append ac_header_list " coff.h"
as_fn_append ac_header_list " pty.h"
as_fn_append ac_func_list " tzset"
as_fn_append ac_func_list " readlinkat"
as_fn_append ac_header_list " execinfo.h"
+as_fn_append ac_func_list " faccessat"
+as_fn_append ac_header_list " stdio_ext.h"
+as_fn_append ac_func_list " __fpending"
gl_getopt_required=GNU
as_fn_append ac_header_list " getopt.h"
as_fn_append ac_func_list " gettimeofday"
# Define the identity of the package.
PACKAGE='emacs'
- VERSION='24.2.50'
+ VERSION='24.3.50'
cat >>confdefs.h <<_ACEOF
test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
fi
+# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them.
+
# Avoid gnulib's threadlib module, as we do threads our own way.
# Code from module c-strcase:
# Code from module careadlinkat:
# Code from module clock-time:
+ # Code from module close-stream:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module dtotimespec:
# Code from module dup2:
# Code from module environ:
+ # Code from module euidaccess:
# Code from module execinfo:
# Code from module extensions:
# Code from module extern-inline:
+ # Code from module faccessat:
+ # Code from module fcntl-h:
# Code from module filemode:
+ # Code from module fpending:
+ # Code from module getgroups:
# Code from module getloadavg:
# Code from module getopt-gnu:
# Code from module getopt-posix:
# Code from module gettext-h:
# Code from module gettime:
# Code from module gettimeofday:
+ # Code from module group-member:
# Code from module ignore-value:
# Code from module include_next:
# Code from module intprops:
# Code from module pselect:
# Code from module pthread_sigmask:
# Code from module readlink:
+ # Code from module root-uid:
# Code from module signal-h:
# Code from module snippet/_Noreturn:
# Code from module snippet/arg-nonnull:
# Code from module utimens:
# Code from module verify:
# Code from module warnings:
+ # Code from module xalloc-oversized:
# It's helpful to have C macros available to GDB, so prefer -g3 to -g
-
-
for ac_func in gethostname \
closedir getrusage get_current_dir_name \
-lrand48 setsid \
-fpathconf select euidaccess getpagesize setlocale \
-utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \
-__fpending strsignal setitimer \
+lrand48 \
+select getpagesize setlocale \
+utimes getrlimit setrlimit getcwd shutdown getaddrinfo \
+strsignal setitimer \
sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
gai_strerror mkstemp getline getdelim fsync sync \
difftime posix_memalign \
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5
-$as_echo_n "checking whether getpgrp requires zero arguments... " >&6; }
-if test "${ac_cv_func_getpgrp_void+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- # Use it with a single arg.
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-getpgrp (0);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_func_getpgrp_void=no
-else
- ac_cv_func_getpgrp_void=yes
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getpgrp_void" >&5
-$as_echo "$ac_cv_func_getpgrp_void" >&6; }
-if test $ac_cv_func_getpgrp_void = yes; then
-
-$as_echo "#define GETPGRP_VOID 1" >>confdefs.h
-
-fi
-
-
# UNIX98 PTYs.
for ac_func in grantpt
do :
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C library" >&5
-$as_echo_n "checking whether we are using the GNU C library... " >&6; }
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-#include <features.h>
-#ifndef __GNU_LIBRARY__
-# error "this is not the GNU C library"
-#endif
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- emacs_glibc=yes
-else
- emacs_glibc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_glibc" >&5
-$as_echo "$emacs_glibc" >&6; }
-
-if test $emacs_glibc = yes; then
-
- emacs_pending_output=unknown
-
- case $opsys in
- gnu | gnu-linux | gnu-kfreebsd )
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of pending output formalism" >&5
-$as_echo_n "checking for style of pending output formalism... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-#include <stdio.h>
-#if !defined (_IO_STDIO_H) && !defined (_STDIO_USES_IOSTREAM)
-# error "stdio definitions not found"
-#endif
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- emacs_pending_output=new
-fi
-rm -f conftest.err conftest.$ac_ext
-
- if test $emacs_pending_output = unknown; then
- case $opsys in
- gnu-linux | gnu-kfreebsd)
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-#include <stdio.h>
-#ifndef __UCLIBC__
-# error "not using uclibc"
-#endif
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- emacs_pending_output=uclibc
-else
- emacs_pending_output=old
-fi
-rm -f conftest.err conftest.$ac_ext
- ;;
- esac
- fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_pending_output" >&5
-$as_echo "$emacs_pending_output" >&6; }
-
- case $emacs_pending_output in
- new)
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)" >>confdefs.h
-
- ;;
- uclibc)
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufpos - (FILE)->__bufstart)" >>confdefs.h
-
- ;;
- old)
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_pptr - (FILE)->_pbase)" >>confdefs.h
-
- ;;
- esac
- ;;
- esac
- if test $emacs_pending_output = unknown; then
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer)" >>confdefs.h
-
- fi
-
-else
- case $opsys in
- cygwin | darwin | freebsd | netbsd | openbsd )
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)" >>confdefs.h
-
- ;;
-
- unixware)
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base)" >>confdefs.h
-
- ;;
-
- *)
- if test x$ac_cv_header_stdio_ext_h = xyes && \
- test x$ac_cv_func___fpending = xyes; then
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) __fpending (FILE)" >>confdefs.h
-
-
-$as_echo "#define DISPNEW_NEEDS_STDIO_EXT 1" >>confdefs.h
-
- else
- $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)" >>confdefs.h
-
- fi
- ;;
- esac
-fi
-
-
-
case $opsys in
gnu)
$as_echo "#define PREFER_VSUSP 1" >>confdefs.h
-
-$as_echo "#define SETPGRP_RELEASES_CTTY 1" >>confdefs.h
-
;;
sol2-10)
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5
-$as_echo_n "checking for st_dm_mode in struct stat... " >&6; }
-if test "${ac_cv_struct_st_dm_mode+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-#include <sys/types.h>
-#include <sys/stat.h>
-int
-main ()
-{
-struct stat s; s.st_dm_mode;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_struct_st_dm_mode=yes
-else
- ac_cv_struct_st_dm_mode=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_st_dm_mode" >&5
-$as_echo "$ac_cv_struct_st_dm_mode" >&6; }
-
- if test $ac_cv_struct_st_dm_mode = yes; then
-
-$as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h
-
- fi
-
-ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default"
-if test "x$ac_cv_have_decl_strmode" = x""yes; then :
- ac_have_decl=1
-else
- ac_have_decl=0
-fi
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_STRMODE $ac_have_decl
-_ACEOF
+ GNULIB_FCNTL=0;
+ GNULIB_NONBLOCKING=0;
+ GNULIB_OPEN=0;
+ GNULIB_OPENAT=0;
+ HAVE_FCNTL=1;
+ HAVE_OPENAT=1;
+ REPLACE_FCNTL=0;
+ REPLACE_OPEN=0;
+ REPLACE_OPENAT=0;
- GNULIB__EXIT=0;
- GNULIB_ATOLL=0;
- GNULIB_CALLOC_POSIX=0;
- GNULIB_CANONICALIZE_FILE_NAME=0;
- GNULIB_GETLOADAVG=0;
- GNULIB_GETSUBOPT=0;
- GNULIB_GRANTPT=0;
- GNULIB_MALLOC_POSIX=0;
- GNULIB_MBTOWC=0;
- GNULIB_MKDTEMP=0;
- GNULIB_MKOSTEMP=0;
- GNULIB_MKOSTEMPS=0;
- GNULIB_MKSTEMP=0;
- GNULIB_MKSTEMPS=0;
- GNULIB_POSIX_OPENPT=0;
- GNULIB_PTSNAME=0;
- GNULIB_PTSNAME_R=0;
- GNULIB_PUTENV=0;
- GNULIB_RANDOM=0;
- GNULIB_RANDOM_R=0;
- GNULIB_REALLOC_POSIX=0;
- GNULIB_REALPATH=0;
- GNULIB_RPMATCH=0;
- GNULIB_SETENV=0;
- GNULIB_STRTOD=0;
- GNULIB_STRTOLL=0;
- GNULIB_STRTOULL=0;
- GNULIB_SYSTEM_POSIX=0;
- GNULIB_UNLOCKPT=0;
- GNULIB_UNSETENV=0;
- GNULIB_WCTOMB=0;
- HAVE__EXIT=1;
- HAVE_ATOLL=1;
- HAVE_CANONICALIZE_FILE_NAME=1;
- HAVE_DECL_GETLOADAVG=1;
- HAVE_GETSUBOPT=1;
- HAVE_GRANTPT=1;
- HAVE_MKDTEMP=1;
- HAVE_MKOSTEMP=1;
- HAVE_MKOSTEMPS=1;
- HAVE_MKSTEMP=1;
- HAVE_MKSTEMPS=1;
- HAVE_POSIX_OPENPT=1;
- HAVE_PTSNAME=1;
- HAVE_PTSNAME_R=1;
- HAVE_RANDOM=1;
- HAVE_RANDOM_H=1;
- HAVE_RANDOM_R=1;
- HAVE_REALPATH=1;
- HAVE_RPMATCH=1;
- HAVE_SETENV=1;
- HAVE_DECL_SETENV=1;
- HAVE_STRTOD=1;
- HAVE_STRTOLL=1;
- HAVE_STRTOULL=1;
- HAVE_STRUCT_RANDOM_DATA=1;
- HAVE_SYS_LOADAVG_H=0;
- HAVE_UNLOCKPT=1;
- HAVE_DECL_UNSETENV=1;
- REPLACE_CALLOC=0;
- REPLACE_CANONICALIZE_FILE_NAME=0;
- REPLACE_MALLOC=0;
- REPLACE_MBTOWC=0;
- REPLACE_MKSTEMP=0;
- REPLACE_PTSNAME=0;
- REPLACE_PTSNAME_R=0;
- REPLACE_PUTENV=0;
- REPLACE_RANDOM_R=0;
- REPLACE_REALLOC=0;
- REPLACE_REALPATH=0;
- REPLACE_SETENV=0;
- REPLACE_STRTOD=0;
- REPLACE_UNSETENV=0;
- REPLACE_WCTOMB=0;
fi
+ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
+if test "x$ac_cv_type_mode_t" = x""yes; then :
+
+else
+
+cat >>confdefs.h <<_ACEOF
+#define mode_t int
+_ACEOF
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5
+$as_echo_n "checking for st_dm_mode in struct stat... " >&6; }
+if test "${ac_cv_struct_st_dm_mode+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+int
+main ()
+{
+struct stat s; s.st_dm_mode;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_struct_st_dm_mode=yes
+else
+ ac_cv_struct_st_dm_mode=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_st_dm_mode" >&5
+$as_echo "$ac_cv_struct_st_dm_mode" >&6; }
+
+ if test $ac_cv_struct_st_dm_mode = yes; then
+
+$as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h
+
+ fi
+
+
+ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default"
+if test "x$ac_cv_have_decl_strmode" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_STRMODE $ac_have_decl
+_ACEOF
+
+
+
+
+
+
+ GNULIB__EXIT=0;
+ GNULIB_ATOLL=0;
+ GNULIB_CALLOC_POSIX=0;
+ GNULIB_CANONICALIZE_FILE_NAME=0;
+ GNULIB_GETLOADAVG=0;
+ GNULIB_GETSUBOPT=0;
+ GNULIB_GRANTPT=0;
+ GNULIB_MALLOC_POSIX=0;
+ GNULIB_MBTOWC=0;
+ GNULIB_MKDTEMP=0;
+ GNULIB_MKOSTEMP=0;
+ GNULIB_MKOSTEMPS=0;
+ GNULIB_MKSTEMP=0;
+ GNULIB_MKSTEMPS=0;
+ GNULIB_POSIX_OPENPT=0;
+ GNULIB_PTSNAME=0;
+ GNULIB_PTSNAME_R=0;
+ GNULIB_PUTENV=0;
+ GNULIB_RANDOM=0;
+ GNULIB_RANDOM_R=0;
+ GNULIB_REALLOC_POSIX=0;
+ GNULIB_REALPATH=0;
+ GNULIB_RPMATCH=0;
+ GNULIB_SETENV=0;
+ GNULIB_STRTOD=0;
+ GNULIB_STRTOLL=0;
+ GNULIB_STRTOULL=0;
+ GNULIB_SYSTEM_POSIX=0;
+ GNULIB_UNLOCKPT=0;
+ GNULIB_UNSETENV=0;
+ GNULIB_WCTOMB=0;
+ HAVE__EXIT=1;
+ HAVE_ATOLL=1;
+ HAVE_CANONICALIZE_FILE_NAME=1;
+ HAVE_DECL_GETLOADAVG=1;
+ HAVE_GETSUBOPT=1;
+ HAVE_GRANTPT=1;
+ HAVE_MKDTEMP=1;
+ HAVE_MKOSTEMP=1;
+ HAVE_MKOSTEMPS=1;
+ HAVE_MKSTEMP=1;
+ HAVE_MKSTEMPS=1;
+ HAVE_POSIX_OPENPT=1;
+ HAVE_PTSNAME=1;
+ HAVE_PTSNAME_R=1;
+ HAVE_RANDOM=1;
+ HAVE_RANDOM_H=1;
+ HAVE_RANDOM_R=1;
+ HAVE_REALPATH=1;
+ HAVE_RPMATCH=1;
+ HAVE_SETENV=1;
+ HAVE_DECL_SETENV=1;
+ HAVE_STRTOD=1;
+ HAVE_STRTOLL=1;
+ HAVE_STRTOULL=1;
+ HAVE_STRUCT_RANDOM_DATA=1;
+ HAVE_SYS_LOADAVG_H=0;
+ HAVE_UNLOCKPT=1;
+ HAVE_DECL_UNSETENV=1;
+ REPLACE_CALLOC=0;
+ REPLACE_CANONICALIZE_FILE_NAME=0;
+ REPLACE_MALLOC=0;
+ REPLACE_MBTOWC=0;
+ REPLACE_MKSTEMP=0;
+ REPLACE_PTSNAME=0;
+ REPLACE_PTSNAME_R=0;
+ REPLACE_PUTENV=0;
+ REPLACE_RANDOM_R=0;
+ REPLACE_REALLOC=0;
+ REPLACE_REALPATH=0;
+ REPLACE_SETENV=0;
+ REPLACE_STRTOD=0;
+ REPLACE_UNSETENV=0;
+ REPLACE_WCTOMB=0;
+
-ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
-if test "x$ac_cv_type_mode_t" = x""yes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define mode_t int
-_ACEOF
-
-fi
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in <time.h>" >&5
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking type of array argument to getgroups" >&5
+$as_echo_n "checking type of array argument to getgroups... " >&6; }
+if test "${ac_cv_type_getgroups+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ ac_cv_type_getgroups=cross
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Thanks to Mike Rendell for this test. */
+$ac_includes_default
+#define NGID 256
+#undef MAX
+#define MAX(x, y) ((x) > (y) ? (x) : (y))
+
+int
+main ()
+{
+ gid_t gidset[NGID];
+ int i, n;
+ union { gid_t gval; long int lval; } val;
+
+ val.lval = -1;
+ for (i = 0; i < NGID; i++)
+ gidset[i] = val.gval;
+ n = getgroups (sizeof (gidset) / MAX (sizeof (int), sizeof (gid_t)) - 1,
+ gidset);
+ /* Exit non-zero if getgroups seems to require an array of ints. This
+ happens when gid_t is short int but getgroups modifies an array
+ of ints. */
+ return n > 0 && gidset[n] != val.gval;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_type_getgroups=gid_t
+else
+ ac_cv_type_getgroups=int
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+if test $ac_cv_type_getgroups = cross; then
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <unistd.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "getgroups.*int.*gid_t" >/dev/null 2>&1; then :
+ ac_cv_type_getgroups=gid_t
+else
+ ac_cv_type_getgroups=int
+fi
+rm -f conftest*
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_getgroups" >&5
+$as_echo "$ac_cv_type_getgroups" >&6; }
+
+cat >>confdefs.h <<_ACEOF
+#define GETGROUPS_T $ac_cv_type_getgroups
+_ACEOF
+
+
+
if false; then
GL_COND_LIBTOOL_TRUE=
LIBS=$gl_saved_libs
+ :
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_CLOSE_STREAM 1
+_ACEOF
+
+
+
:
-# Persuade glibc <stdlib.h> to declare getloadavg().
+ if test $ac_cv_func_faccessat = no; then
+ HAVE_FACCESSAT=0
+ fi
+ if test $HAVE_FACCESSAT = 0; then
-gl_save_LIBS=$LIBS
-# getloadvg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0,
-# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
-HAVE_GETLOADAVG=1
-ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg"
-if test "x$ac_cv_func_getloadavg" = x""yes; then :
-else
- gl_func_getloadavg_done=no
- # Some systems with -lutil have (and need) -lkvm as well, some do not.
- # On Solaris, -lkvm requires nlist from -lelf, so check that first
- # to get the right answer into the cache.
- # For kstat on solaris, we need to test for libelf and libkvm to force the
- # definition of SVR4 below.
- if test $gl_func_getloadavg_done = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5
-$as_echo_n "checking for elf_begin in -lelf... " >&6; }
-if test "${ac_cv_lib_elf_elf_begin+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lelf $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char elf_begin ();
-int
-main ()
-{
-return elf_begin ();
- ;
- return 0;
-}
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS faccessat.$ac_objext"
+
+
+ for ac_func in access
+do :
+ ac_fn_c_check_func "$LINENO" "access" "ac_cv_func_access"
+if test "x$ac_cv_func_access" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_ACCESS 1
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_elf_elf_begin=yes
-else
- ac_cv_lib_elf_elf_begin=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5
-$as_echo "$ac_cv_lib_elf_elf_begin" >&6; }
-if test "x$ac_cv_lib_elf_elf_begin" = x""yes; then :
- LIBS="-lelf $LIBS"
+
fi
+done
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5
-$as_echo_n "checking for kvm_open in -lkvm... " >&6; }
-if test "${ac_cv_lib_kvm_kvm_open+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lkvm $LIBS"
+
+ fi
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_FACCESSAT 1
+_ACEOF
+
+
+
+
+
+
+
+ GNULIB_FACCESSAT=1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_fcntl_h='<'fcntl.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <fcntl.h>" >&5
+$as_echo_n "checking absolute name of <fcntl.h>... " >&6; }
+if test "${gl_cv_next_fcntl_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <fcntl.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
+
+ gl_header_literal_regex=`echo 'fcntl.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_fcntl_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_fcntl_h" >&5
+$as_echo "$gl_cv_next_fcntl_h" >&6; }
+ fi
+ NEXT_FCNTL_H=$gl_cv_next_fcntl_h
+
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'fcntl.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_fcntl_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_FCNTL_H=$gl_next_as_first_directive
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ fp_headers='
+# include <stdio.h>
+# if HAVE_STDIO_EXT_H
+# include <stdio_ext.h>
+# endif
+'
+ ac_fn_c_check_decl "$LINENO" "__fpending" "ac_cv_have_decl___fpending" "$fp_headers
+"
+if test "x$ac_cv_have_decl___fpending" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL___FPENDING $ac_have_decl
+_ACEOF
+
+
+ if test $ac_cv_func___fpending = no; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS fpending.$ac_objext"
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to determine the number of pending output bytes on a stream" >&5
+$as_echo_n "checking how to determine the number of pending output bytes on a stream... " >&6; }
+if test "${ac_cv_sys_pending_output_n_bytes+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ for ac_expr in \
+ \
+ '# glibc2' \
+ 'fp->_IO_write_ptr - fp->_IO_write_base' \
+ \
+ '# traditional Unix' \
+ 'fp->_ptr - fp->_base' \
+ \
+ '# BSD' \
+ 'fp->_p - fp->_bf._base' \
+ \
+ '# SCO, Unixware' \
+ '(fp->__ptr ? fp->__ptr - fp->__base : 0)' \
+ \
+ '# QNX' \
+ '(fp->_Mode & 0x2000 /*_MWRITE*/ ? fp->_Next - fp->_Buf : 0)' \
+ \
+ '# old glibc?' \
+ 'fp->__bufp - fp->__buffer' \
+ \
+ '# old glibc iostream?' \
+ 'fp->_pptr - fp->_pbase' \
+ \
+ '# emx+gcc' \
+ 'fp->_ptr - fp->_buffer' \
+ \
+ '# Minix' \
+ 'fp->_ptr - fp->_buf' \
+ \
+ '# Plan9' \
+ 'fp->wp - fp->buf' \
+ \
+ '# VMS' \
+ '(*fp)->_ptr - (*fp)->_base' \
+ \
+ '# e.g., DGUX R4.11; the info is not available' \
+ 1 \
+ ; do
+
+ # Skip each embedded comment.
+ case "$ac_expr" in '#'*) continue;; esac
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <stdio.h>
+int
+main ()
+{
+FILE *fp = stdin; (void) ($ac_expr);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ fp_done=yes
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$fp_done" = yes && break
+ done
+
+ ac_cv_sys_pending_output_n_bytes=$ac_expr
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_pending_output_n_bytes" >&5
+$as_echo "$ac_cv_sys_pending_output_n_bytes" >&6; }
+
+cat >>confdefs.h <<_ACEOF
+#define PENDING_OUTPUT_N_BYTES $ac_cv_sys_pending_output_n_bytes
+_ACEOF
+
+
+ fi
+
+
+# Persuade glibc <stdlib.h> to declare getloadavg().
+
+
+gl_save_LIBS=$LIBS
+
+# getloadvg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0,
+# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
+HAVE_GETLOADAVG=1
+ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg"
+if test "x$ac_cv_func_getloadavg" = x""yes; then :
+
+else
+ gl_func_getloadavg_done=no
+
+ # Some systems with -lutil have (and need) -lkvm as well, some do not.
+ # On Solaris, -lkvm requires nlist from -lelf, so check that first
+ # to get the right answer into the cache.
+ # For kstat on solaris, we need to test for libelf and libkvm to force the
+ # definition of SVR4 below.
+ if test $gl_func_getloadavg_done = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5
+$as_echo_n "checking for elf_begin in -lelf... " >&6; }
+if test "${ac_cv_lib_elf_elf_begin+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lelf $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char elf_begin ();
+int
+main ()
+{
+return elf_begin ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_elf_elf_begin=yes
+else
+ ac_cv_lib_elf_elf_begin=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5
+$as_echo "$ac_cv_lib_elf_elf_begin" >&6; }
+if test "x$ac_cv_lib_elf_elf_begin" = x""yes; then :
+ LIBS="-lelf $LIBS"
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5
+$as_echo_n "checking for kvm_open in -lkvm... " >&6; }
+if test "${ac_cv_lib_kvm_kvm_open+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lkvm $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
fi
gl_gnulib_enabled_dosname=false
+ gl_gnulib_enabled_euidaccess=false
+ gl_gnulib_enabled_getgroups=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false
gl_gnulib_enabled_pathmax=false
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
gl_gnulib_enabled_stat=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
gl_gnulib_enabled_verify=false
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
func_gl_gnulib_m4code_dosname ()
{
if ! $gl_gnulib_enabled_dosname; then
gl_gnulib_enabled_dosname=true
fi
}
- func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
+ func_gl_gnulib_m4code_euidaccess ()
{
- if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
+ if ! $gl_gnulib_enabled_euidaccess; then
- gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
- fi
- }
- func_gl_gnulib_m4code_pathmax ()
- {
- if ! $gl_gnulib_enabled_pathmax; then
- gl_gnulib_enabled_pathmax=true
- fi
- }
- func_gl_gnulib_m4code_stat ()
- {
- if ! $gl_gnulib_enabled_stat; then
+ for ac_func in euidaccess
+do :
+ ac_fn_c_check_func "$LINENO" "euidaccess" "ac_cv_func_euidaccess"
+if test "x$ac_cv_func_euidaccess" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_EUIDACCESS 1
+_ACEOF
+fi
+done
+ if test $ac_cv_func_euidaccess = no; then
+ HAVE_EUIDACCESS=0
+ fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on directories" >&5
-$as_echo_n "checking whether stat handles trailing slashes on directories... " >&6; }
-if test "${gl_cv_func_stat_dir_slash+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test "$cross_compiling" = yes; then :
- case $host_os in
- mingw*) gl_cv_func_stat_dir_slash="guessing no";;
- *) gl_cv_func_stat_dir_slash="guessing yes";;
- esac
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/stat.h>
+ if test $HAVE_EUIDACCESS = 0; then
-int
-main ()
-{
-struct stat st; return stat (".", &st) != stat ("./", &st);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- gl_cv_func_stat_dir_slash=yes
-else
- gl_cv_func_stat_dir_slash=no
-fi
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS euidaccess.$ac_objext"
+
+
+
+ for ac_header in libgen.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "libgen.h" "ac_cv_header_libgen_h" "$ac_includes_default"
+if test "x$ac_cv_header_libgen_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBGEN_H 1
+_ACEOF
+
+fi
+
+done
+
+
+ ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups"
+if test "x$ac_cv_func_getgroups" = x""yes; then :
+
+fi
+
+
+ # If we don't yet have getgroups, see if it's in -lbsd.
+ # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1.
+ ac_save_LIBS=$LIBS
+ if test $ac_cv_func_getgroups = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5
+$as_echo_n "checking for getgroups in -lbsd... " >&6; }
+if test "${ac_cv_lib_bsd_getgroups+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbsd $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getgroups ();
+int
+main ()
+{
+return getgroups ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_bsd_getgroups=yes
+else
+ ac_cv_lib_bsd_getgroups=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_getgroups" >&5
+$as_echo "$ac_cv_lib_bsd_getgroups" >&6; }
+if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then :
+ GETGROUPS_LIB=-lbsd
+fi
+
+ fi
+
+ # Run the program to test the functionality of the system-supplied
+ # getgroups function only if there is such a function.
+ if test $ac_cv_func_getgroups = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5
+$as_echo_n "checking for working getgroups... " >&6; }
+if test "${ac_cv_func_getgroups_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in # ((
+ # Guess yes on glibc systems.
+ *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) ac_cv_func_getgroups_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+/* On Ultrix 4.3, getgroups (0, 0) always fails. */
+ return getgroups (0, 0) == -1;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_getgroups_works=yes
+else
+ ac_cv_func_getgroups_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5
+$as_echo "$ac_cv_func_getgroups_works" >&6; }
+ else
+ ac_cv_func_getgroups_works=no
+ fi
+ case "$ac_cv_func_getgroups_works" in
+ *yes)
+
+$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h
+
+ ;;
+ esac
+ LIBS=$ac_save_LIBS
+
+
+ # Solaris 9 and 10 need -lgen to get the eaccess function.
+ # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_EACCESS=
+
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing eaccess" >&5
+$as_echo_n "checking for library containing eaccess... " >&6; }
+if test "${ac_cv_search_eaccess+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char eaccess ();
+int
+main ()
+{
+return eaccess ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' gen; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_eaccess=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_eaccess+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_eaccess+set}" = set; then :
+
+else
+ ac_cv_search_eaccess=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_eaccess" >&5
+$as_echo "$ac_cv_search_eaccess" >&6; }
+ac_res=$ac_cv_search_eaccess
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_eaccess" = "none required" ||
+ LIB_EACCESS=$ac_cv_search_eaccess
+fi
+
+ for ac_func in eaccess
+do :
+ ac_fn_c_check_func "$LINENO" "eaccess" "ac_cv_func_eaccess"
+if test "x$ac_cv_func_eaccess" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_EACCESS 1
+_ACEOF
+
+fi
+done
+
+ LIBS=$gl_saved_libs
+
+ fi
+
+
+
+
+
+ GNULIB_EUIDACCESS=1
+
+
+
+
+
+ gl_gnulib_enabled_euidaccess=true
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1
+ fi
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_stat
+ fi
+ fi
+ }
+ func_gl_gnulib_m4code_getgroups ()
+ {
+ if ! $gl_gnulib_enabled_getgroups; then
+
+
+
+
+
+ ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups"
+if test "x$ac_cv_func_getgroups" = x""yes; then :
+
+fi
+
+
+ # If we don't yet have getgroups, see if it's in -lbsd.
+ # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1.
+ ac_save_LIBS=$LIBS
+ if test $ac_cv_func_getgroups = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5
+$as_echo_n "checking for getgroups in -lbsd... " >&6; }
+if test "${ac_cv_lib_bsd_getgroups+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbsd $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getgroups ();
+int
+main ()
+{
+return getgroups ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_bsd_getgroups=yes
+else
+ ac_cv_lib_bsd_getgroups=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_getgroups" >&5
+$as_echo "$ac_cv_lib_bsd_getgroups" >&6; }
+if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then :
+ GETGROUPS_LIB=-lbsd
+fi
+
+ fi
+
+ # Run the program to test the functionality of the system-supplied
+ # getgroups function only if there is such a function.
+ if test $ac_cv_func_getgroups = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5
+$as_echo_n "checking for working getgroups... " >&6; }
+if test "${ac_cv_func_getgroups_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in # ((
+ # Guess yes on glibc systems.
+ *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) ac_cv_func_getgroups_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+/* On Ultrix 4.3, getgroups (0, 0) always fails. */
+ return getgroups (0, 0) == -1;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_getgroups_works=yes
+else
+ ac_cv_func_getgroups_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5
+$as_echo "$ac_cv_func_getgroups_works" >&6; }
+ else
+ ac_cv_func_getgroups_works=no
+ fi
+ case "$ac_cv_func_getgroups_works" in
+ *yes)
+
+$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h
+
+ ;;
+ esac
+ LIBS=$ac_save_LIBS
+
+ if test $ac_cv_func_getgroups != yes; then
+ HAVE_GETGROUPS=0
+ else
+ if test "$ac_cv_type_getgroups" != gid_t \
+ || { case "$ac_cv_func_getgroups_works" in
+ *yes) false;;
+ *) true;;
+ esac
+ }; then
+ REPLACE_GETGROUPS=1
+
+$as_echo "#define GETGROUPS_ZERO_BUG 1" >>confdefs.h
+
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getgroups handles negative values" >&5
+$as_echo_n "checking whether getgroups handles negative values... " >&6; }
+if test "${gl_cv_func_getgroups_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_getgroups_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+int size = getgroups (0, 0);
+ gid_t *list = malloc (size * sizeof *list);
+ return getgroups (-1, list) != -1;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getgroups_works=yes
+else
+ gl_cv_func_getgroups_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getgroups_works" >&5
+$as_echo "$gl_cv_func_getgroups_works" >&6; }
+ case "$gl_cv_func_getgroups_works" in
+ *yes) ;;
+ *) REPLACE_GETGROUPS=1 ;;
+ esac
+ fi
+ fi
+ test -n "$GETGROUPS_LIB" && LIBS="$GETGROUPS_LIB $LIBS"
+
+ if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS getgroups.$ac_objext"
+
+ fi
+
+
+
+
+
+ GNULIB_GETGROUPS=1
+
+
+
+
+
+ gl_gnulib_enabled_getgroups=true
+ fi
+ }
+ func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
+ {
+ if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
+
+
+ gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
+ fi
+ }
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 ()
+ {
+ if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then
+
+
+
+
+
+ ac_fn_c_check_func "$LINENO" "group_member" "ac_cv_func_group_member"
+if test "x$ac_cv_func_group_member" = x""yes; then :
+
+else
+
+ HAVE_GROUP_MEMBER=0
+
+fi
+
+
+ if test $HAVE_GROUP_MEMBER = 0; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS group-member.$ac_objext"
+
+
+
+
+ fi
+
+
+
+
+
+ GNULIB_GROUP_MEMBER=1
+
+
+
+
+
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_getgroups
+ fi
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec
+ fi
+ fi
+ }
+ func_gl_gnulib_m4code_pathmax ()
+ {
+ if ! $gl_gnulib_enabled_pathmax; then
+
+
+
+ gl_gnulib_enabled_pathmax=true
+ fi
+ }
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c ()
+ {
+ if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true
+ fi
+ }
+ func_gl_gnulib_m4code_stat ()
+ {
+ if ! $gl_gnulib_enabled_stat; then
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on directories" >&5
+$as_echo_n "checking whether stat handles trailing slashes on directories... " >&6; }
+if test "${gl_cv_func_stat_dir_slash+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case $host_os in
+ mingw*) gl_cv_func_stat_dir_slash="guessing no";;
+ *) gl_cv_func_stat_dir_slash="guessing yes";;
+ esac
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/stat.h>
+
+int
+main ()
+{
+struct stat st; return stat (".", &st) != stat ("./", &st);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_stat_dir_slash=yes
+else
+ gl_cv_func_stat_dir_slash=no
+fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
gl_gnulib_enabled_verify=true
fi
}
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec ()
+ {
+ if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true
+ fi
+ }
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_dosname
+ fi
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_euidaccess
+ fi
if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
gl_GNULIB_ENABLED_dosname_FALSE=
fi
+ if $gl_gnulib_enabled_euidaccess; then
+ gl_GNULIB_ENABLED_euidaccess_TRUE=
+ gl_GNULIB_ENABLED_euidaccess_FALSE='#'
+else
+ gl_GNULIB_ENABLED_euidaccess_TRUE='#'
+ gl_GNULIB_ENABLED_euidaccess_FALSE=
+fi
+
+ if $gl_gnulib_enabled_getgroups; then
+ gl_GNULIB_ENABLED_getgroups_TRUE=
+ gl_GNULIB_ENABLED_getgroups_FALSE='#'
+else
+ gl_GNULIB_ENABLED_getgroups_TRUE='#'
+ gl_GNULIB_ENABLED_getgroups_FALSE=
+fi
+
if $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE=
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE='#'
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE=
fi
+ if $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE=
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE='#'
+else
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE='#'
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE=
+fi
+
if $gl_gnulib_enabled_pathmax; then
gl_GNULIB_ENABLED_pathmax_TRUE=
gl_GNULIB_ENABLED_pathmax_FALSE='#'
gl_GNULIB_ENABLED_pathmax_FALSE=
fi
+ if $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE=
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE='#'
+else
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE='#'
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE=
+fi
+
if $gl_gnulib_enabled_stat; then
gl_GNULIB_ENABLED_stat_TRUE=
gl_GNULIB_ENABLED_stat_FALSE='#'
gl_GNULIB_ENABLED_verify_FALSE=
fi
+ if $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE=
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE='#'
+else
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE='#'
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE=
+fi
+
# End of code from modules
as_fn_error "conditional \"gl_GNULIB_ENABLED_dosname\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${gl_GNULIB_ENABLED_euidaccess_TRUE}" && test -z "${gl_GNULIB_ENABLED_euidaccess_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_euidaccess\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${gl_GNULIB_ENABLED_getgroups_TRUE}" && test -z "${gl_GNULIB_ENABLED_getgroups_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_getgroups\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE}" && test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE}" && test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${gl_GNULIB_ENABLED_pathmax_TRUE}" && test -z "${gl_GNULIB_ENABLED_pathmax_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_pathmax\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE}" && test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${gl_GNULIB_ENABLED_stat_TRUE}" && test -z "${gl_GNULIB_ENABLED_stat_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_stat\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
if test -z "${gl_GNULIB_ENABLED_verify_TRUE}" && test -z "${gl_GNULIB_ENABLED_verify_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_verify\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE}" && test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
gl_libobjs=
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by emacs $as_me 24.2.50, which was
+This file was extended by emacs $as_me 24.3.50, which was
generated by GNU Autoconf 2.65. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-emacs config.status 24.2.50
+emacs config.status 24.3.50
configured by $0, generated by GNU Autoconf 2.65,
with options \\"\$ac_cs_config\\"
dnl along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
AC_PREREQ(2.65)
-AC_INIT(emacs, 24.2.50)
+AC_INIT(emacs, 24.3.50)
AC_CONFIG_HEADER(src/config.h:src/config.in)
AC_CONFIG_SRCDIR(src/lisp.h)
AC_CONFIG_AUX_DIR(build-aux)
test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
fi
+# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them.
+AC_DEFUN([gl_FCNTL_O_FLAGS])
# Avoid gnulib's threadlib module, as we do threads our own way.
AC_DEFUN([gl_THREADLIB])
dnl checks for header files
AC_CHECK_HEADERS_ONCE(
linux/version.h sys/systeminfo.h
- stdio_ext.h fcntl.h coff.h pty.h
+ coff.h pty.h
sys/vlimit.h sys/resource.h
sys/utsname.h pwd.h utmp.h dirent.h util.h)
AC_CHECK_FUNCS(gethostname \
closedir getrusage get_current_dir_name \
-lrand48 setsid \
-fpathconf select euidaccess getpagesize setlocale \
-utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \
-__fpending strsignal setitimer \
+lrand48 \
+select getpagesize setlocale \
+utimes getrlimit setrlimit getcwd shutdown getaddrinfo \
+strsignal setitimer \
sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
gai_strerror mkstemp getline getdelim fsync sync \
difftime posix_memalign \
AC_FUNC_FSEEKO
-AC_FUNC_GETPGRP
-
# UNIX98 PTYs.
AC_CHECK_FUNCS(grantpt)
esac
-dnl Used in dispnew.c
-AH_TEMPLATE(PENDING_OUTPUT_COUNT, [Number of chars of output in the
- buffer of a stdio stream.])
-
-AC_MSG_CHECKING([whether we are using the GNU C library])
-AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
-#include <features.h>
-#ifndef __GNU_LIBRARY__
-# error "this is not the GNU C library"
-#endif
- ]], [[]])], emacs_glibc=yes, emacs_glibc=no)
-AC_MSG_RESULT([$emacs_glibc])
-
-if test $emacs_glibc = yes; then
-
- emacs_pending_output=unknown
-
- case $opsys in
- gnu | gnu-linux | gnu-kfreebsd )
- AC_MSG_CHECKING([for style of pending output formalism])
- dnl In autoconf 2.67 and later, we could use a single test
- dnl since the preprocessed output is accessible in "conftest.i".
- AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
-#include <stdio.h>
-#if !defined (_IO_STDIO_H) && !defined (_STDIO_USES_IOSTREAM)
-# error "stdio definitions not found"
-#endif
- ]], [[]])], emacs_pending_output=new, [])
-
- if test $emacs_pending_output = unknown; then
- case $opsys in
- gnu-linux | gnu-kfreebsd)
- AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
-#include <stdio.h>
-#ifndef __UCLIBC__
-# error "not using uclibc"
-#endif
- ]], [[]])], emacs_pending_output=uclibc, emacs_pending_output=old)
- ;;
- esac
- fi
-
- AC_MSG_RESULT([$emacs_pending_output])
-
- case $emacs_pending_output in
- new)
- dnl New C libio names.
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE),
- [((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)])
- ;;
- uclibc)
- dnl Using the uClibc library.
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE),
- [((FILE)->__bufpos - (FILE)->__bufstart)])
- ;;
- old)
- dnl Old C++ iostream names.
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE),
- [((FILE)->_pptr - (FILE)->_pbase)])
- ;;
- esac
- ;;
- esac dnl opsys
-
- if test $emacs_pending_output = unknown; then
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__bufp - (FILE)->__buffer)])
- fi
-
-else dnl !emacs_glibc
-
- case $opsys in
- cygwin | darwin | freebsd | netbsd | openbsd )
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_p - (FILE)->_bf._base)])
- ;;
-
- unixware)
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__ptr - (FILE)->__base)])
- ;;
-
- *)
- dnl HAVE_STDIO_EXT_H && HAVE___FPENDING
- if test x$ac_cv_header_stdio_ext_h = xyes && \
- test x$ac_cv_func___fpending = xyes; then
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [__fpending (FILE)])
- AC_DEFINE(DISPNEW_NEEDS_STDIO_EXT, 1,
- [Define if dispnew.c should include stdio_ext.h.])
- else
- AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_ptr - (FILE)->_base)])
- fi
- ;;
- esac
-fi dnl emacs_glibc
-
-
dnl Used in vm-limit.c
AH_TEMPLATE(DATA_START, [Address of the start of the data segment.])
dnl Used in lisp.h, emacs.c, mem-limits.h
irix6-5)
AC_DEFINE(PREFER_VSUSP, 1, [Define if process_send_signal should
use VSUSP instead of VSWTCH.])
- AC_DEFINE(SETPGRP_RELEASES_CTTY, 1, [Define if process.c:child_setup
- should not call setpgrp.])
;;
sol2-10)
-2012-11-17 Dani Moncayo <dmoncayo@gmail.com>
+2012-11-18 Dani Moncayo <dmoncayo@gmail.com>
* mark.texi (Disabled Transient Mark): Doc fixes (Bug#12746).
-2012-11-12 Chong Yidong <cyd@gnu.org>
+2012-11-16 Eli Zaretskii <eliz@gnu.org>
+
+ * trouble.texi (Crashing): Add information about MS-Windows and
+ the emacs_backtrace.txt file. (Bug#12908)
+
+2012-11-13 Chong Yidong <cyd@gnu.org>
* building.texi (Multithreaded Debugging): gdb-stopped-hooks is
actually named gdb-stopped-functions.
-2012-11-12 Glenn Morris <rgm@gnu.org>
+2012-11-13 Glenn Morris <rgm@gnu.org>
* misc.texi (Single Shell): Mention async-shell-command-buffer.
* misc.texi (Terminal emulator): Rename `term-face' to `term'.
-2012-11-09 Glenn Morris <rgm@gnu.org>
-
* emacs.texi (Acknowledgments): Add profiler author.
* ack.texi (Acknowledgments): Add some recent contributions.
-2012-11-08 Chong Yidong <cyd@gnu.org>
+2012-11-10 Chong Yidong <cyd@gnu.org>
* files.texi (Diff Mode): Doc fixes for
diff-delete-trailing-whitespace (Bug#12831).
* trouble.texi (Crashing): Copyedits.
-2012-11-08 Glenn Morris <rgm@gnu.org>
+2012-11-10 Glenn Morris <rgm@gnu.org>
* files.texi (Diff Mode): Trailing whitespace updates.
-2012-11-07 Chong Yidong <cyd@gnu.org>
+2012-11-10 Chong Yidong <cyd@gnu.org>
* misc.texi (Terminal emulator): Document Term mode faces.
* trouble.texi (Memory Full): Capitalize Buffer Menu.
-2012-11-05 Eli Zaretskii <eliz@gnu.org>
+2012-11-10 Eli Zaretskii <eliz@gnu.org>
* display.texi (Auto Scrolling): Clarify that scroll-step is
ignored when scroll-conservatively is set to a non-zero value.
(Bug#12801)
-2012-11-05 Chong Yidong <cyd@gnu.org>
+2012-11-10 Chong Yidong <cyd@gnu.org>
* dired.texi (Dired Updating): Doc fix (Bug#11744).
@c It would be nicer to generate this using configure and @version@.
@c However, that would mean emacsver.texi would always be newer
@c then the info files in release tarfiles.
-@set EMACSVER 24.2.50
+@set EMACSVER 24.3.50
@subsection When Emacs Crashes
@cindex crash report
+@cindex backtrace
+@cindex @file{emacs_backtrace.txt} file, MS-Windows
Emacs is not supposed to crash, but if it does, it produces a
@dfn{crash report} prior to exiting. The crash report is printed to
the standard error stream. If Emacs was started from a graphical
-desktop, the standard error stream is commonly redirected to a file
-such as @file{~/.xsession-errors}, so you can look for the crash
-report there.
+desktop on a GNU or Unix system, the standard error stream is commonly
+redirected to a file such as @file{~/.xsession-errors}, so you can
+look for the crash report there. On MS-Windows, the crash report is
+written to a file named @file{emacs_backtrace.txt} in the current
+directory of the Emacs process, in addition to the standard error
+stream.
The format of the crash report depends on the platform. On some
platforms, such as those using the GNU C Library, the crash report
includes a @dfn{backtrace} describing the execution state prior to
crashing, which can be used to help debug the crash. Here is an
-example:
+example for a GNU system:
@example
Fatal error 11: Segmentation fault
@example
sed -n 's/.*\[\(.*\)]$/\1/p' @var{backtrace} |
- addr2line -Cfip -e @var{bindir}/emacs
+ addr2line -Cfip -e @var{bindir}/@var{emacs-binary}
@end example
@noindent
Here, @var{backtrace} is the name of a text file containing a copy of
-the backtrace, and @var{bindir} is the name of the directory that
-contains the Emacs executable.
+the backtrace, @var{bindir} is the name of the directory that
+contains the Emacs executable, and @var{emacs-binary} is the name of
+the Emacs executable file, normally @file{emacs} on GNU and Unix
+systems and @file{emacs.exe} on MS-Windows and MS-DOS.
@cindex core dump
- Optionally, Emacs can generate a @dfn{core dump} when it crashes. A
-core dump is a file containing voluminous data about the state of the
-program prior to the crash, usually examined by loading it into a
-debugger such as GDB. On many platforms, core dumps are disabled by
-default, and you must explicitly enable them by running the shell
-command @samp{ulimit -c unlimited} (e.g.@: in your shell startup
-script).
+ Optionally, Emacs can generate a @dfn{core dump} when it crashes, on
+systems that support core files. A core dump is a file containing
+voluminous data about the state of the program prior to the crash,
+usually examined by loading it into a debugger such as GDB. On many
+platforms, core dumps are disabled by default, and you must explicitly
+enable them by running the shell command @samp{ulimit -c unlimited}
+(e.g.@: in your shell startup script).
@node After a Crash
@subsection Recovery After a Crash
* loading.texi (How Programs Do Loading): Add eager macro expansion.
* macros.texi (Expansion): Mention eager macro expansion.
-2012-11-17 Glenn Morris <rgm@gnu.org>
-
* minibuf.texi (Basic Completion): Mention misc completion-table funcs.
-2012-11-17 Leo Liu <sdl.web@gmail.com>
+2012-11-18 Leo Liu <sdl.web@gmail.com>
* minibuf.texi (Programmed Completion): Doc fix for metadata
request (Bug#12850).
-2012-11-17 Glenn Morris <rgm@gnu.org>
+2012-11-18 Glenn Morris <rgm@gnu.org>
* display.texi (Temporary Displays): Document with-temp-buffer-window.
description of display-buffer-below-selected. Reorder actions.
Add example (Bug#12848).
-2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * keymaps.texi (Translation Keymaps): Add a subsection "Interaction
- with normal keymaps" (bug#12868).
-
-2012-11-15 Glenn Morris <rgm@gnu.org>
+2012-11-16 Glenn Morris <rgm@gnu.org>
* display.texi (Face Attributes): Fix :underline COLOR description.
(Attribute Functions): Update for set-face-underline rename.
Tweak descriptions of face-underline-p, face-inverse-video-p.
-2012-11-14 Glenn Morris <rgm@gnu.org>
-
* keymaps.texi (Searching Keymaps, Tool Bar): Untabify examples,
so they align better in info.
(Active Keymaps, Searching Keymaps, Controlling Active Maps):
Document set-temporary-overlay-map.
-2012-11-12 Glenn Morris <rgm@gnu.org>
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keymaps.texi (Translation Keymaps): Add a subsection "Interaction
+ with normal keymaps".
+
+2012-11-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * internals.texi (Garbage Collection): Update descriptions
+ of vectorlike_header, garbage-collect and gc-cons-threshold.
+ (Object Internals): Explain Lisp_Object layout and the basics
+ of an internal type system.
+ (Buffer Internals): Update description of struct buffer.
+
+2012-11-13 Glenn Morris <rgm@gnu.org>
* variables.texi (Adding Generalized Variables):
At least mention gv-define-expander and gv-letplace.
-2012-11-11 Glenn Morris <rgm@gnu.org>
-
* debugging.texi (Error Debugging): Mention debug-on-message.
(Using Debugger): Mention debugger-bury-or-kill.
* variables.texi (Adding Generalized Variables):
Use standard formatting for common lisp note about setf functions.
-2012-11-07 Martin Rudalics <rudalics@gmx.at>
+2012-11-10 Martin Rudalics <rudalics@gmx.at>
* elisp.texi (Top): Add Recombining Windows to menu.
* windows.texi (Recombining Windows): New subsection.
(Splitting Windows): Rewrite text on handling of window
combinations and move it to new subsection.
-2012-11-07 Chong Yidong <cyd@gnu.org>
+2012-11-10 Chong Yidong <cyd@gnu.org>
* searching.texi (Replacing Match): Document \? in replace-match.
* edebug.texi (Specification List): setf is no longer CL-only.
-2012-11-07 Glenn Morris <rgm@gnu.org>
+2012-11-10 Glenn Morris <rgm@gnu.org>
* variables.texi (Adding Generalized Variables):
Update description of FIX-RETURN expansion.
-2012-11-06 Glenn Morris <rgm@gnu.org>
-
* variables.texi (Setting Generalized Variables):
Split most of previous contents into this subsection.
(Adding Generalized Variables): New subsection.
* elisp.texi: Add Generalized Variables subsections to detailed menu.
-2012-11-05 Chong Yidong <cyd@gnu.org>
+2012-11-10 Chong Yidong <cyd@gnu.org>
* frames.texi (Initial Parameters): Doc fix (Bug#12144).
+2012-11-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * os.texi (Notifications): Update descriptions of
+ notifications-notify, notifications-close-notification and
+ notifications-get-capabilities according to latest code changes.
+ Add notifications-get-server-information.
+
2012-11-03 Chong Yidong <cyd@gnu.org>
* objects.texi (General Escape Syntax): Clarify the explanation of
Beyond the basic vector, a lot of objects like window, buffer, and
frame are managed as if they were vectors. The corresponding C data
structures include the @code{struct vectorlike_header} field whose
-@code{next} field points to the next object in the chain:
-@code{header.next.buffer} points to the next buffer (which could be
-a killed buffer), and @code{header.next.vector} points to the next
-vector in a free list. If a vector is small (smaller than or equal to
-@code{VBLOCK_BYTES_MAX} bytes, see @file{alloc.c}), then
-@code{header.next.nbytes} contains the vector size in bytes.
+@code{size} member contains the subtype enumerated by @code{enum pvec_type}
+and an information about how many @code{Lisp_Object} fields this structure
+contains and what the size of the rest data is. This information is
+needed to calculate the memory footprint of an object, and used
+by the vector allocation code while iterating over the vector blocks.
@cindex garbage collection
It is quite common to use some storage for a while, then release it
spontaneously if you use more than @code{gc-cons-threshold} bytes of
Lisp data since the previous garbage collection.)
-@code{garbage-collect} returns a list containing the following
-information:
+@code{garbage-collect} returns a list with information on amount of space in
+use, where each entry has the form @samp{(@var{name} @var{size} @var{used})}
+or @samp{(@var{name} @var{size} @var{used} @var{free})}. In the entry,
+@var{name} is a symbol describing the kind of objects this entry represents,
+@var{size} is the number of bytes used by each one, @var{used} is the number
+of those objects that were found live in the heap, and optional @var{free} is
+the number of those objects that are not live but that Emacs keeps around for
+future allocations. So an overall result is:
@example
-@group
-((@var{used-conses} . @var{free-conses})
- (@var{used-syms} . @var{free-syms})
-@end group
- (@var{used-miscs} . @var{free-miscs})
- @var{used-string-chars}
- @var{used-vector-slots}
- (@var{used-floats} . @var{free-floats})
- (@var{used-intervals} . @var{free-intervals})
- (@var{used-strings} . @var{free-strings}))
+((@code{conses} @var{cons-size} @var{used-conse} @var{free-conses})
+ (@code{symbols} @var{symbol-size} @var{used-symbols} @var{free-symbols})
+ (@code{miscs} @var{misc-size} @var{used-miscs} @var{free-miscs})
+ (@code{strings} @var{string-size} @var{used-strings} @var{free-strings})
+ (@code{string-bytes} @var{byte-size} @var{used-bytes})
+ (@code{vectors} @var{vector-size} @var{used-vectors})
+ (@code{vector-slots} @var{slot-size} @var{used-slots} @var{free-slots})
+ (@code{floats} @var{float-size} @var{used-floats} @var{free-floats})
+ (@code{intervals} @var{interval-size} @var{used-intervals} @var{free-intervals})
+ (@code{buffers} @var{buffer-size} @var{used-buffers})
+ (@code{heap} @var{unit-size} @var{total-size} @var{free-size}))
@end example
Here is an example:
@example
-@group
(garbage-collect)
- @result{} ((106886 . 13184) (9769 . 0)
- (7731 . 4651) 347543 121628
- (31 . 94) (1273 . 168)
- (25474 . 3569))
-@end group
+ @result{} ((conses 16 49126 8058) (symbols 48 14607 0)
+ (miscs 40 34 56) (strings 32 2942 2607)
+ (string-bytes 1 78607) (vectors 16 7247)
+ (vector-slots 8 341609 29474) (floats 8 71 102)
+ (intervals 56 27 26) (buffers 944 8)
+ (heap 1024 11715 2678))
@end example
-Here is a table explaining each element:
+Below is a table explaining each element. Note that last @code{heap} entry
+is optional and present only if an underlying @code{malloc} implementation
+provides @code{mallinfo} function.
@table @var
+@item cons-size
+Internal size of a cons cell, i.e.@: @code{sizeof (struct Lisp_Cons)}.
+
@item used-conses
The number of cons cells in use.
@item free-conses
-The number of cons cells for which space has been obtained from the
-operating system, but that are not currently being used.
+The number of cons cells for which space has been obtained from
+the operating system, but that are not currently being used.
-@item used-syms
+@item symbol-size
+Internal size of a symbol, i.e.@: @code{sizeof (struct Lisp_Symbol)}.
+
+@item used-symbols
The number of symbols in use.
-@item free-syms
-The number of symbols for which space has been obtained from the
-operating system, but that are not currently being used.
+@item free-symbols
+The number of symbols for which space has been obtained from
+the operating system, but that are not currently being used.
+
+@item misc-size
+Internal size of a miscellaneous entity, i.e.@:
+@code{sizeof (union Lisp_Misc)}, which is a size of the
+largest type enumerated in @code{enum Lisp_Misc_Type}.
@item used-miscs
-The number of miscellaneous objects in use. These include markers and
-overlays, plus certain objects not visible to users.
+The number of miscellaneous objects in use. These include markers
+and overlays, plus certain objects not visible to users.
@item free-miscs
The number of miscellaneous objects for which space has been obtained
from the operating system, but that are not currently being used.
-@item used-string-chars
-The total size of all strings, in characters.
+@item string-size
+Internal size of a string header, i.e.@: @code{sizeof (struct Lisp_String)}.
+
+@item used-strings
+The number of string headers in use.
+
+@item free-strings
+The number of string headers for which space has been obtained
+from the operating system, but that are not currently being used.
+
+@item byte-size
+This is used for convenience and equals to @code{sizeof (char)}.
+
+@item used-bytes
+The total size of all string data in bytes.
+
+@item vector-size
+Internal size of a vector header, i.e.@: @code{sizeof (struct Lisp_Vector)}.
-@item used-vector-slots
-The total number of elements of existing vectors.
+@item used-vectors
+The number of vector headers allocated from the vector blocks.
+
+@item slot-size
+Internal size of a vector slot, always equal to @code{sizeof (Lisp_Object)}.
+
+@item used-slots
+The number of slots in all used vectors.
+
+@item free-slots
+The number of free slots in all vector blocks.
+
+@item float-size
+Internal size of a float object, i.e.@: @code{sizeof (struct Lisp_Float)}.
+(Do not confuse it with the native platform @code{float} or @code{double}.)
@item used-floats
The number of floats in use.
@item free-floats
-The number of floats for which space has been obtained from the
-operating system, but that are not currently being used.
+The number of floats for which space has been obtained from
+the operating system, but that are not currently being used.
+
+@item interval-size
+Internal size of an interval object, i.e.@: @code{sizeof (struct interval)}.
@item used-intervals
-The number of intervals in use. Intervals are an internal
-data structure used for representing text properties.
+The number of intervals in use.
@item free-intervals
-The number of intervals for which space has been obtained
-from the operating system, but that are not currently being used.
+The number of intervals for which space has been obtained from
+the operating system, but that are not currently being used.
-@item used-strings
-The number of strings in use.
+@item buffer-size
+Internal size of a buffer, i.e.@: @code{sizeof (struct buffer)}.
+(Do not confuse with the value returned by @code{buffer-size} function.)
-@item free-strings
-The number of string headers for which the space was obtained from the
-operating system, but which are currently not in use. (A string
-object consists of a header and the storage for the string text
-itself; the latter is only allocated when the string is created.)
+@item used-buffers
+The number of buffer objects in use. This includes killed buffers
+invisible to users, i.e.@: all buffers in @code{all_buffers} list.
+
+@item unit-size
+The unit of heap space measurement, always equal to 1024 bytes.
+
+@item total-size
+Total heap size, in @var{unit-size} units.
+
+@item free-size
+Heap space which is not currently used, in @var{unit-size} units.
@end table
If there was overflow in pure space (@pxref{Pure Storage}),
@defopt gc-cons-threshold
The value of this variable is the number of bytes of storage that must
be allocated for Lisp objects after one garbage collection in order to
-trigger another garbage collection. A cons cell counts as eight bytes,
-a string as one byte per character plus a few bytes of overhead, and so
-on; space allocated to the contents of buffers does not count. Note
-that the subsequent garbage collection does not happen immediately when
-the threshold is exhausted, but only the next time the Lisp evaluator is
-called.
-
-The initial threshold value is 800,000. If you specify a larger
-value, garbage collection will happen less often. This reduces the
-amount of time spent garbage collecting, but increases total memory use.
-You may want to do this when running a program that creates lots of
-Lisp data.
-
-You can make collections more frequent by specifying a smaller value,
-down to 10,000. A value less than 10,000 will remain in effect only
-until the subsequent garbage collection, at which time
-@code{garbage-collect} will set the threshold back to 10,000.
+trigger another garbage collection. You can use the result returned by
+@code{garbage-collect} to get an information about size of the particular
+object type; space allocated to the contents of buffers does not count.
+Note that the subsequent garbage collection does not happen immediately
+when the threshold is exhausted, but only the next time the Lisp interpreter
+is called.
+
+The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in
+@file{alloc.c}. Since it's defined in @code{word_size} units, the value
+is 400,000 for the default 32-bit configuration and 800,000 for the 64-bit
+one. If you specify a larger value, garbage collection will happen less
+often. This reduces the amount of time spent garbage collecting, but
+increases total memory use. You may want to do this when running a program
+that creates lots of Lisp data.
+
+You can make collections more frequent by specifying a smaller value, down
+to 1/10th of @code{GC_DEFAULT_THRESHOLD}. A value less than this minimum
+will remain in effect only until the subsequent garbage collection, at which
+time @code{garbage-collect} will set the threshold back to the minimum.
@end defopt
@defopt gc-cons-percentage
the number of Lisp arguments, it must have exactly two C arguments:
the first is the number of Lisp arguments, and the second is the
address of a block containing their values. These have types
-@code{int} and @w{@code{Lisp_Object *}} respectively.
+@code{int} and @w{@code{Lisp_Object *}} respectively. Since
+@code{Lisp_Object} can hold any Lisp object of any data type, you
+can determine the actual data type only at run time; so if you want
+a primitive to accept only a certain type of argument, you must check
+the type explicitly using a suitable predicate (@pxref{Type Predicates}).
+@cindex type checking internals
@cindex @code{GCPRO} and @code{UNGCPRO}
@cindex protect C variables from garbage collection
@section Object Internals
@cindex object internals
-@c FIXME Is this still true? Does --with-wide-int affect anything?
- GNU Emacs Lisp manipulates many different types of data. The actual
-data are stored in a heap and the only access that programs have to it
-is through pointers. Each pointer is 32 bits wide on 32-bit machines,
-and 64 bits wide on 64-bit machines; three of these bits are used for
-the tag that identifies the object's type, and the remainder are used
-to address the object.
-
- Because Lisp objects are represented as tagged pointers, it is always
-possible to determine the Lisp data type of any object. The C data type
-@code{Lisp_Object} can hold any Lisp object of any data type. Ordinary
-variables have type @code{Lisp_Object}, which means they can hold any
-type of Lisp value; you can determine the actual data type only at run
-time. The same is true for function arguments; if you want a function
-to accept only a certain type of argument, you must check the type
-explicitly using a suitable predicate (@pxref{Type Predicates}).
-@cindex type checking internals
+ Emacs Lisp provides a rich set of the data types. Some of them, like cons
+cells, integers and stirngs, are common to nearly all Lisp dialects. Some
+others, like markers and buffers, are quite special and needed to provide
+the basic support to write editor commands in Lisp. To implement such
+a variety of object types and provide an efficient way to pass objects between
+the subsystems of an interpreter, there is a set of C data structures and
+a special type to represent the pointers to all of them, which is known as
+@dfn{tagged pointer}.
+
+ In C, the tagged pointer is an object of type @code{Lisp_Object}. Any
+initialized variable of such a type always holds the value of one of the
+following basic data types: integer, symbol, string, cons cell, float,
+vectorlike or miscellaneous object. Each of these data types has the
+corresponding tag value. All tags are enumerated by @code{enum Lisp_Type}
+and placed into a 3-bit bitfield of the @code{Lisp_Object}. The rest of the
+bits is the value itself. Integer values are immediate, i.e.@: directly
+represented by those @dfn{value bits}, and all other objects are represented
+by the C pointers to a corresponding object allocated from the heap. Width
+of the @code{Lisp_Object} is platform- and configuration-dependent: usually
+it's equal to the width of an underlying platform pointer (i.e.@: 32-bit on
+a 32-bit machine and 64-bit on a 64-bit one), but also there is a special
+configuration where @code{Lisp_Object} is 64-bit but all pointers are 32-bit.
+The latter trick was designed to overcome the limited range of values for
+Lisp integers on a 32-bit system by using 64-bit @code{long long} type for
+@code{Lisp_Object}.
+
+ The following C data structures are defined in @file{lisp.h} to represent
+the basic data types beyond integers:
+
+@table @code
+@item struct Lisp_Cons
+Cons cell, an object used to construct lists.
+
+@item struct Lisp_String
+String, the basic object to represent a sequence of characters.
+
+@item struct Lisp_Vector
+Array, a fixed-size set of Lisp objects which may be accessed by an index.
+
+@item struct Lisp_Symbol
+Symbol, the unique-named entity commonly used as an identifier.
+
+@item struct Lisp_Float
+Floating point value.
+
+@item union Lisp_Misc
+Miscellaneous kinds of objects which don't fit into any of the above.
+@end table
+
+ These types are the first-class citizens of an internal type system.
+Since the tag space is limited, all other types are the subtypes of either
+@code{Lisp_Vectorlike} or @code{Lisp_Misc}. Vector subtypes are enumerated
+by @code{enum pvec_type}, and nearly all complex objects like windows, buffers,
+frames, and processes fall into this category. The rest of special types,
+including markers and overlays, are enumerated by @code{enum Lisp_Misc_Type}
+and form the set of subtypes of @code{Lisp_Misc}.
+
+ Below there is a description of a few subtypes of @code{Lisp_Vectorlike}.
+Buffer object represents the text to display and edit. Window is the part
+of display structure which shows the buffer or used as a container to
+recursively place other windows on the same frame. (Do not confuse Emacs Lisp
+window object with the window as an entity managed by the user interface
+system like X; in Emacs terminology, the latter is called frame.) Finally,
+process object is used to manage the subprocesses.
@menu
* Buffer Internals:: Components of a buffer structure.
@table @code
@item header
-A @code{struct vectorlike_header} structure where @code{header.next}
-points to the next buffer, in the chain of all buffers (including
-killed buffers). This chain is used only for garbage collection, in
-order to collect killed buffers properly. Note that vectors, and most
-kinds of objects allocated as vectors, are all on one chain, but
-buffers are on a separate chain of their own.
+A header of type @code{struct vectorlike_header} is common to all
+vectorlike objects.
@item own_text
A @code{struct buffer_text} structure that ordinarily holds the buffer
ordinary buffer, this is the @code{own_text} field above. In an
indirect buffer, this is the @code{own_text} field of the base buffer.
+@item next
+A pointer to the next buffer, in the chain of all buffers, including
+killed buffers. This chain is used only for allocation and garbage
+collection, in order to collect killed buffers properly.
+
@item pt
@itemx pt_byte
The character and byte positions of point in a buffer.
The supported keywords and values are as follows:
@table @code
+@item :bus @var{bus}
+The D-Bus bus. This argument is needed only if a bus other than
+@code{:session} shall be used.
+
@item :title @var{title}
The notification title.
@item :body @var{text}
The notification body text. Depending on the implementation of the
notification server, the text could contain HTML markups, like
-@samp{"<b>bold text</b>"}, hyperlinks, or images.
+@samp{"<b>bold text</b>"}, hyperlinks, or images. Special HTML
+characters must be encoded, as @samp{"Contact
+<postmaster@@localhost>!"}.
@item :app-name @var{name}
The name of the application sending the notification. The default is
interpreted as icon name.
@item :category @var{category}
-The type of notification this is, a string.
+The type of notification this is, a string. See the
+@uref{http://developer.gnome.org/notification-spec/#categories,
+Desktop Notifications Specification} for a list of standard
+categories.
@item :desktop-entry @var{filename}
This specifies the name of the desktop filename representing the
@end example
@end defun
-@defun notifications-close-notification id
+@defun notifications-close-notification id &optional bus
This function closes a notification with identifier @var{id}.
+@var{bus} can be a string denoting a D-Bus connection, the default is
+@code{:session}.
@end defun
-@defun notifications-get-capabilities
-Returns the capabilities of the notification server, a list of strings.
-The following capabilities can be expected:
+@defun notifications-get-capabilities &optional bus
+Returns the capabilities of the notification server, a list of
+symbols. @var{bus} can be a string denoting a D-Bus connection, the
+default is @code{:session}. The following capabilities can be
+expected:
@table @code
@item :actions
@code{:x-gnome-foo-cap}.
@end defun
+@defun notifications-get-server-information &optional bus
+Return information on the notification server, a list of strings.
+@var{bus} can be a string denoting a D-Bus connection, the default is
+@code{:session}. The returned list is @code{(@var{name} @var{vendor}
+@var{version} @var{spec-version})}.
+
+@table @var
+@item name
+The product name of the server.
+
+@item vendor
+The vendor name. For example, @samp{"KDE"}, @samp{"GNOME"}.
+
+@item version
+The server's version number.
+
+@item spec-version
+The specification version the server is compliant with.
+@end table
+
+If @var{SPEC_VERSION} is @code{nil}, the server supports a
+specification prior to @samp{"1.0"}.
+@end defun
+
@node Dynamic Libraries
@section Dynamically Loaded Libraries
@end smallexample
@noindent
-This can be counterintutive, in particular if @code{W4} were used for
+This can be counterintuitive, in particular if @code{W4} were used for
displaying a buffer only temporarily (@pxref{Temporary Displays}), and
you want to continue working with the initial layout.
@code{switch-to-prev-buffer} (@pxref{Window History}) to show some other
buffer instead.
-The optional argument @var{bury-or-kill} specifes how to deal with
+The optional argument @var{bury-or-kill} specifies how to deal with
@var{window}'s buffer. The following values are handled:
@table @code
.\" See section COPYING for copyright and redistribution information.
-.TH EMACS 1 "2007 April 13" "GNU Emacs 24.2.50"
+.TH EMACS 1 "2007 April 13" "GNU Emacs 24.3.50"
.
.
.SH NAME
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Calc now uses the Gregorian calendar for all dates,
+ and uses January 1, 1 AD as its day number 1.
+ * calc.texi (Date Forms): Document this.
+
2012-11-16 Glenn Morris <rgm@gnu.org>
* cl.texi (Function Bindings): Clarify that cl-flet is lexical.
(Obsolete Macros): Move example here from Function Bindings.
-2012-11-13 Glenn Morris <rgm@gnu.org>
-
* erc.texi: Use @code{nil} rather than just "nil".
(Modules): Undocument obsolete "hecomplete".
Add "notifications".
(Connecting): Add brief section on passwords.
(Options): Make a start by adding erc-hide-list, erc-lurker-hide-list.
-2012-11-12 Glenn Morris <rgm@gnu.org>
+2012-11-13 Glenn Morris <rgm@gnu.org>
* flymake.texi (Customizable variables)
(Highlighting erroneous lines): Mention flymake-error-bitmap,
flymake-warning-bitmap, and flymake-fringe-indicator-position.
-2012-11-09 Chong Yidong <cyd@gnu.org>
+2012-11-12 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.texi: Doc for ses-rename-cell, ses-repair-cell-reference-all & ses-range.
+ In all file place SES into @acronym{...}.
+ (Advanced Features): Add key index and function index for
+ ses-set-header-row. Add description for function
+ ses-rename-cell. Add description for function
+ ses-repair-cell-reference-all.
+ (Ranges in formulas): Add description for ses-range flags.
+
+2012-11-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
* url.texi (Introduction): Move url-configuration-directory to
Customization node.
Improve docs for url-queue-*.
(Supported URL Types): Copyedits. Delete empty subnodes.
-2012-11-08 Chong Yidong <cyd@gnu.org>
-
* url.texi (Introduction): Rename from Getting Started. Rewrite
the introduction.
(URI Parsing): Rewrite. Omit the obsolete attributes slot.
-2012-11-07 Glenn Morris <rgm@gnu.org>
+2012-11-10 Glenn Morris <rgm@gnu.org>
* cl.texi (Obsolete Setf Customization):
Revert defsetf example to the more correct let rather than prog1.
Give define-modify-macro, defsetf, and define-setf-method
gv.el replacements.
-2012-11-06 Glenn Morris <rgm@gnu.org>
-
* cl.texi (Overview): Mention EIEIO here, as well as the appendix.
(Setf Extensions): Remove obsolete reference.
(Obsolete Setf Customization):
(Compiler Optimizations): Rename from "Optimizing Compiler"; reword.
(Creating Symbols, Random Numbers): De-emphasize internal
variables cl--gensym-counter and cl--random-state. (Bug#12788)
+ (Naming Conventions, Type Predicates, Macros)
+ (Predicates on Numbers): No longer mention cl-floatp-safe.
-2012-11-02 Glenn Morris <rgm@gnu.org>
+2012-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
- * cl.texi (Naming Conventions, Type Predicates, Macros)
- (Predicates on Numbers): No longer mention cl-floatp-safe.
+ * gnus.texi (Mail Source Specifiers):
+ Document :leave keyword used for pop mail source.
2012-11-01 Glenn Morris <rgm@gnu.org>
of a date form. @xref{Packing and Unpacking}.
Date forms can go arbitrarily far into the future or past. Negative
-year numbers represent years BC. Calc uses a combination of the
-Gregorian and Julian calendars, following the history of Great
-Britain and the British colonies. This is the same calendar that
-is used by the @code{cal} program in most Unix implementations.
+year numbers represent years BC. There is no ``year 0''; the day
+before @samp{<Mon Jan 1, +1>} is @samp{<Sun Dec 31, -1>}. These are
+days 1 and 0 respectively in Calc's internal numbering scheme. The
+Gregorian calendar is used for all dates, including dates before the
+Gregorian calendar was invented. Thus Calc's use of the day number
+@mathit{-10000} to represent August 15, 28 BC should be taken with a
+grain of salt.
@cindex Julian calendar
@cindex Gregorian calendar
Some historical background: The Julian calendar was created by
-Julius Caesar in the year 46 BC as an attempt to fix the gradual
-drift caused by the lack of leap years in the calendar used
-until that time. The Julian calendar introduced an extra day in
+Julius Caesar in the year 46 BC as an attempt to fix the confusion
+caused by the irregular Roman calendar that was used before that time.
+The Julian calendar introduced an extra day in
all years divisible by four. After some initial confusion, the
-calendar was adopted around the year we call 8 AD. Some centuries
+calendar was adopted around the year we call 8 AD, although the years were
+numbered differently and did not necessarily begin on January 1. Some centuries
later it became apparent that the Julian year of 365.25 days was
itself not quite right. In 1582 Pope Gregory XIII introduced the
Gregorian calendar, which added the new rule that years divisible
by 100, but not by 400, were not to be considered leap years
despite being divisible by four. Many countries delayed adoption
-of the Gregorian calendar because of religious differences;
-in Britain it was put off until the year 1752, by which time
-the Julian calendar had fallen eleven days behind the true
-seasons. So the switch to the Gregorian calendar in early
-September 1752 introduced a discontinuity: The day after
-Sep 2, 1752 is Sep 14, 1752. Calc follows this convention.
-To take another example, Russia waited until 1918 before
-adopting the new calendar, and thus needed to remove thirteen
-days (between Feb 1, 1918 and Feb 14, 1918). This means that
-Calc's reckoning will be inconsistent with Russian history between
-1752 and 1918, and similarly for various other countries.
+of the Gregorian calendar because of religious differences, and
+used differing year numbers and start-of-year for other reasons;
+for example, in early 1752 England changed the start of its year from
+March 25 to January 1, and in September it switched to the Gregorian
+calendar: in England, the day after December 31, 1750 was January 1,
+1750 and the day after March 24, 1750 was March 25, 1751, but the day
+after December 31, 1751 was January 1, 1752 and the day after
+September 2, 1752 was September 14, 1752. To take another example,
+Russia switched both year numbering and start-of-year in 1700, but did
+not adopt the Gregorian calendar until 1918. Calc's reckoning
+therefore matches English practice starting in 1752 and Russian
+practice starting in 1918, but disagrees with earlier dates in both
+countries.
Today's timekeepers introduce an occasional ``leap second'' as
well, but Calc does not take these minor effects into account.
between, say, @samp{<12:00am Mon Jan 1, 1900>} and
@samp{<12:00am Sat Jan 1, 2000>}.)
-Calc uses the Julian calendar for all dates before the year 1752,
-including dates BC when the Julian calendar technically had not
-yet been invented. Thus the claim that day number @mathit{-10000} is
-called ``August 16, 28 BC'' should be taken with a grain of salt.
-
-Please note that there is no ``year 0''; the day before
-@samp{<Sat Jan 1, +1>} is @samp{<Fri Dec 31, -1>}. These are
-days 0 and @mathit{-1} respectively in Calc's internal numbering scheme.
-
@cindex Julian day counting
Another day counting system in common use is, confusingly, also called
``Julian.'' The Julian day number is the numbers of days since
and says what authentication scheme to use. The default is
@code{password}.
+@item :leave
+Non-@code{nil} if the mail is to be left on the @acronym{POP} server
+after fetching. Mails once fetched will never be fetched again by the
+@acronym{UIDL} control. Only the built-in @code{pop3-movemail} program
+(the default) supports this keyword.
+
+If this is neither @code{nil} nor a number, all mails will be left on
+the server. If this is a number, leave mails on the server for this
+many days since you first checked new mails. If this is @code{nil}
+(the default), mails will be deleted on the server right after fetching.
+
+@vindex pop3-uidl-file
+The @code{pop3-uidl-file} variable specifies the file to which the
+@acronym{UIDL} data are locally stored. The default value is
+@file{~/.pop3-uidl}.
+
+Note that @acronym{POP} servers maintain no state information between
+sessions, so what the client believes is there and what is actually
+there may not match up. If they do not, then you may get duplicate
+mails or the whole thing can fall apart and leave you with a corrupt
+mailbox.
+
@end table
-@vindex pop3-movemail
+@findex pop3-movemail
@vindex pop3-leave-mail-on-server
If the @code{:program} and @code{:function} keywords aren't specified,
-@code{pop3-movemail} will be used. If @code{pop3-leave-mail-on-server}
-is non-@code{nil} the mail is to be left on the @acronym{POP} server
-after fetching when using @code{pop3-movemail}. Note that POP servers
-maintain no state information between sessions, so what the client
-believes is there and what is actually there may not match up. If they
-do not, then you may get duplicate mails or the whole thing can fall
-apart and leave you with a corrupt mailbox.
+@code{pop3-movemail} will be used.
Here are some examples for getting mail from a @acronym{POP} server.
+
Fetch from the default @acronym{POP} server, using the default user
name, and default fetcher:
:user "user-name" :password "secret")
@end lisp
+Leave mails on the server for 14 days:
+
+@lisp
+(pop :server "my.pop.server"
+ :user "user-name" :password "secret"
+ :leave 14)
+@end lisp
+
Use @samp{movemail} to move the mail:
@lisp
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename ../../info/ses
-@settitle SES: Simple Emacs Spreadsheet
+@settitle @acronym{SES}: Simple Emacs Spreadsheet
@setchapternewpage off
@syncodeindex fn cp
@syncodeindex vr cp
@c %**end of header
@copying
-This file documents SES: the Simple Emacs Spreadsheet.
+This file documents @acronym{SES}: the Simple Emacs Spreadsheet.
Copyright @copyright{} 2002-2012 Free Software Foundation, Inc.
@dircategory Emacs misc features
@direntry
-* SES: (ses). Simple Emacs Spreadsheet.
+* @acronym{SES}: (ses). Simple Emacs Spreadsheet.
@end direntry
@finalout
@titlepage
-@title SES
+@title @acronym{SES}
@subtitle Simple Emacs Spreadsheet
@author Jonathan A. Yavner
@author @email{jyavner@@member.fsf.org}
@ifnottex
@node Top, Sales Pitch, (dir), (dir)
@comment node-name, next, previous, up
-@top SES: Simple Emacs Spreadsheet
+@top @acronym{SES}: Simple Emacs Spreadsheet
@display
-SES is a major mode for GNU Emacs to edit spreadsheet files, which
+@acronym{SES} is a major mode for GNU Emacs to edit spreadsheet files, which
contain a rectangular grid of cells. The cells' values are specified
by formulas that can refer to the values of other cells.
@end display
@insertcopying
@menu
-* Sales Pitch:: Why use SES?
+* Sales Pitch:: Why use @acronym{SES}?
* The Basics:: Basic spreadsheet commands
* Advanced Features:: Want to know more?
* For Gurus:: Want to know @emph{even more}?
Point is always at the left edge of a cell, or at the empty endline.
When mark is inactive, the current cell is underlined. When mark is
-active, the range is the highlighted rectangle of cells (SES always
+active, the range is the highlighted rectangle of cells (@acronym{SES} always
uses transient mark mode). Drag the mouse from A1 to A3 to create the
-range A1-A2. Many SES commands operate only on single cells, not
+range A1-A2. Many @acronym{SES} commands operate only on single cells, not
ranges.
@table @kbd
* Printer functions::
* Clearing cells::
* Copy/cut/paste::
-* Customizing SES::
+* Customizing @acronym{SES}::
@end menu
@node Formulas, Resizing, The Basics, The Basics
expression, you can use @kbd{M-@key{TAB}} to complete symbol names.
@item ' @r{(apostrophe)}
-Enter a symbol (ses-read-symbol). SES remembers all symbols that have
+Enter a symbol (ses-read-symbol). @acronym{SES} remembers all symbols that have
been used as formulas, so you can type just the beginning of a symbol
and use @kbd{@key{SPC}}, @kbd{@key{TAB}}, and @kbd{?} to complete it.
@end table
@end table
-@node Copy/cut/paste, Customizing SES, Clearing cells, The Basics
+@node Copy/cut/paste, Customizing @acronym{SES}, Clearing cells, The Basics
@section Copy, cut, and paste
@cindex copy
@cindex cut
@findex ses-yank-pop
The copy functions work on rectangular regions of cells. You can paste the
-copies into non-SES buffers to export the print text.
+copies into non-@acronym{SES} buffers to export the print text.
@table @kbd
@item M-w
differently depending on the format of the text being inserted:
@itemize @bullet
@item
-When pasting cells that were cut from a SES buffer, the print text is
+When pasting cells that were cut from a @acronym{SES} buffer, the print text is
ignored and only the attached formula and printer are inserted; cell
references in the formula are relocated unless you use @kbd{C-u}.
@item
is the current cell. If part of the rectangle is beyond the edges of
the spreadsheet, you must confirm the increase in spreadsheet size.
@item
-Non-SES text is usually inserted as a replacement formula for the
+Non-@acronym{SES} text is usually inserted as a replacement formula for the
current cell. If the formula would be a symbol, it's treated as a
string unless you use @kbd{C-u}. Pasted formulas with syntax errors
are always treated as strings.
@item M-y
Immediately after a paste, you can replace the text with a preceding
element from the kill ring (@code{ses-yank-pop}). Unlike the standard
-Emacs yank-pop, the SES version uses @code{undo} to delete the old
+Emacs yank-pop, the @acronym{SES} version uses @code{undo} to delete the old
yank. This doesn't make any difference?
@end table
-@node Customizing SES, , Copy/cut/paste, The Basics
-@section Customizing SES
+@node Customizing @acronym{SES}, , Copy/cut/paste, The Basics
+@section Customizing @acronym{SES}
@cindex customizing
@vindex enable-local-eval
@vindex ses-mode-hook
list.
@code{ses-mode-hook} is a normal mode hook (list of functions to
-execute when starting SES mode for a buffer).
+execute when starting @acronym{SES} mode for a buffer).
The variable @code{safe-functions} is a list of possibly-unsafe
functions to be treated as safe when analyzing formulas and printers.
@table @kbd
@item C-c M-C-h
-(@code{ses-set-header-row}). The header line at the top of the SES
+(@code{ses-set-header-row}).
+@findex ses-set-header-row
+@kindex C-c M-C-h
+The header line at the top of the @acronym{SES}
window normally shows the column letter for each column. You can set
it to show a copy of some row, such as a row of column titles, so that
row will always be visible. Default is to set the current row as the
@item [header-line mouse-3]
Pops up a menu to set the current row as the header, or revert to
column letters.
+@item M-x ses-rename-cell
+@findex ses-rename-cell
+Rename a cell from a standard A1-like name to any
+string.
+@item M-x ses-repair-cell-reference-all
+@findex ses-repair-cell-reference-all
+When you interrupt a cell formula update by clicking @kbd{C-g}, then
+the cell reference link may be broken, which will jeopardize automatic
+cell update when any other cell on which it depends is changed. To
+repair that use function @code{ses-repair-cell-reference-all}
@end table
@menu
@findex ses-renarrow-buffer
@findex ses-reprint-all
-A SES file consists of a print area and a data area. Normally the
+A @acronym{SES} file consists of a print area and a data area. Normally the
buffer is narrowed to show only the print area. The print area is
-read-only except for special SES commands; it contains cell values
+read-only except for special @acronym{SES} commands; it contains cell values
formatted by printer functions. The data area records the formula and
printer functions, etc.
a new column just beyond a one-row range, the new cell is included in
the range. New cells inserted just before a range are not included.
+Flags can be added to @code{ses-range} immediately after the @var{to}
+cell.
+@table @code
+@item !
+Empty cells in range can be removed by adding the @code{!} flag. An
+empty cell is a cell the value of which is one of symbols @code{nil}
+or @code{*skip*}. For instance @code{(ses-range A1 A4 !)} will do the
+same as @code{(list A1 A3)} when cells @code{A2} and @code{A4} are
+empty.
+@item _
+Empty cell values are replaced by the argument following flag
+@code{_}, or @code{0} when flag @code{_} is last in argument list. For
+instance @code{(ses-range A1 A4 _ "empty")} will do the same as
+@code{(list A1 "empty" A3 "empty")} when cells @code{A2} and @code{A4}
+are empty. Similarly, @code{(ses-range A1 A4 _ )} will do the same as
+@code{(list A1 0 A3 0)}.
+@item >v
+When order matters, list cells by reading cells row-wise from top left
+to bottom right. This flag is provided for completeness only as it is
+the default reading order.
+@item <v
+List cells by reading cells row-wise from top right to bottom left.
+@item v>
+List cells by reading cells column-wise from top left to bottom right.
+@item v<
+List cells by reading cells column-wise from top right to bottom left.
+@item v
+A short hand for @code{v>}.
+@item ^
+A short hand for @code{^>}.
+@item >
+A short hand for @code{>v}.
+@item <
+A short hand for @code{>^}.
+@item *
+Instead of listing cells, it makes a Calc vector or matrix of it
+(@pxref{Top,,,calc,GNU Emacs Calc Manual}). If the range contains only
+one row or one column a vector is made, otherwise a matrix is made.
+@item *2
+Same as @code{*} except that a matrix is always made even when there
+is only one row or column in the range.
+@item *1
+Same as @code{*} except that a vector is always made even when there
+is only one row or column in the range, that is to say the
+corresponding matrix is flattened.
+@end table
@node Sorting by column, Standard formula functions, Ranges in formulas, Advanced Features
@section Sorting by column
row or the next non-@code{nil} cell), the result is truncated if the cell's
value is a string, or replaced with hash marks otherwise.
-SES could get confused by printer results that contain newlines or
+@acronym{SES} could get confused by printer results that contain newlines or
tabs, so these are replaced with question marks.
@table @kbd
A common organization for spreadsheets is to have a bunch of ``detail''
rows, each perhaps describing a transaction, and then a set of
``summary'' rows that each show reduced data for some subset of the
-details. SES supports this organization via the @code{ses-select}
+details. @acronym{SES} supports this organization via the @code{ses-select}
function.
@table @code
* Nonrelocatable references::
* The data area::
* Buffer-local variables in spreadsheets::
-* Uses of defadvice in SES::
+* Uses of defadvice in @acronym{SES}::
@end menu
@node Deferred updates, Nonrelocatable references, For Gurus, For Gurus
These deferred cell-writes cannot be interrupted by @kbd{C-g}, so
you'll just have to wait.
-SES uses @code{run-with-idle-timer} to move the cell underline when
+@acronym{SES} uses @code{run-with-idle-timer} to move the cell underline when
Emacs will be scrolling the buffer after the end of a command, and
also to narrow and underline after @kbd{C-x C-v}. This is visible as
a momentary glitch after C-x C-v and certain scrolling commands. You
macros for each row, followed by column-widths, column-printers,
default-printer, and header-row. Then there's the global parameters
(file-format ID, numrows, numcols) and the local variables (specifying
-SES mode for the buffer, etc.)
+@acronym{SES} mode for the buffer, etc.)
-When a SES file is loaded, first the numrows and numcols values are
+When a @acronym{SES} file is loaded, first the numrows and numcols values are
loaded, then the entire data area is @code{eval}ed, and finally the local
variables are processed.
You can edit the data area, but don't insert or delete any newlines
-except in the local-variables part, since SES locates things by
+except in the local-variables part, since @acronym{SES} locates things by
counting newlines. Use @kbd{C-x C-e} at the end of a line to install
your edits into the spreadsheet data structures (this does not update
the print area, use e.g. @kbd{C-c C-l} for that).
@end table
-@node Buffer-local variables in spreadsheets, Uses of defadvice in SES, The data area, For Gurus
+@node Buffer-local variables in spreadsheets, Uses of defadvice in @acronym{SES}, The data area, For Gurus
@section Buffer-local variables in spreadsheets
@cindex buffer-local variables
@cindex variables, buffer-local
(put 'your-function-name 'safe-function t)
@end lisp
-@node Uses of defadvice in SES, , Buffer-local variables in spreadsheets, For Gurus
-@section Uses of defadvice in SES
+@node Uses of defadvice in @acronym{SES}, , Buffer-local variables in spreadsheets, For Gurus
+@section Uses of defadvice in @acronym{SES}
@cindex defadvice
@cindex undo-more
@cindex copy-region-as-kill
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2012-09-12.16}
+\def\texinfoversion{2012-11-08.11}
%
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
\makedispenvdef{quotation}{\quotationstart}
%
\def\quotationstart{%
- {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
- \parindent=0pt
- %
- % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+ \indentedblockstart % same as \indentedblock, but increase right margin too.
\ifx\nonarrowing\relax
- \advance\leftskip by \lispnarrowing
\advance\rightskip by \lispnarrowing
- \exdentamount = \lispnarrowing
- \else
- \let\nonarrowing = \relax
\fi
\parsearg\quotationlabel
}
\fi
}
+% @indentedblock is like @quotation, but indents only on the left and
+% has no optional argument.
+%
+\makedispenvdef{indentedblock}{\indentedblockstart}
+%
+\def\indentedblockstart{%
+ {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
+ \parindent=0pt
+ %
+ % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+ \ifx\nonarrowing\relax
+ \advance\leftskip by \lispnarrowing
+ \exdentamount = \lispnarrowing
+ \else
+ \let\nonarrowing = \relax
+ \fi
+}
+
+% Keep a nonzero parskip for the environment, since we're doing normal filling.
+%
+\def\Eindentedblock{%
+ \par
+ {\parskip=0pt \afterenvbreak}%
+}
+\def\Esmallindentedblock{\Eindentedblock}
+
% LaTeX-like @verbatim...@end verbatim and @verb{<char>...<char>}
% If we want to allow any <char> as delimiter,
The value of this option is an integer specifying the maximum number
of concurrent @code{url-queue-retrieve} network processes. If the
number of @code{url-queue-retrieve} calls is larger than this number,
-later ones are queued until ealier ones are finished.
+later ones are queued until earlier ones are finished.
@end defopt
@vindex url-queue-timeout
so we will look at it and add it to the manual.
\f
+* Installation Changes in Emacs 24.4
+* Startup Changes in Emacs 24.4
+* Changes in Emacs 24.4
+* Editing Changes in Emacs 24.4
+
+\f
+* Changes in Specialized Modes and Packages in Emacs 24.4
+
++++
+** New function `ses-rename-cell' to give SES cells arbitrary names.
+
+\f
+* New Modes and Packages in Emacs 24.4
+** New nadvice.el package offering lighter-weight advice facilities.
+It is layered as:
+- add-function/remove-function which can be used to add/remove code on any
+ function-carrying place, such as process-filters or `<foo>-function' hooks.
+- advice-add/advice-remove to add/remove a piece of advice on a named function,
+ much like `defadvice' does.
+
+* Incompatible Lisp Changes in Emacs 24.4
+
+** `defadvice' does not honor the `freeze' flag and cannot advise
+special-forms any more.
+
+** `dolist' in lexical-binding mode does not bind VAR in RESULT any more.
+VAR was bound to nil which was not tremendously useful and just lead to
+spurious warnings about an unused var.
+
+* Lisp changes in Emacs 24.4
+
+** New function special-form-p.
+** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
+text-property on the first char.
+
+** The `defalias-fset-function' property lets you catch calls to defalias
+and redirect them to your own function instead of `fset'.
+
+* Changes in Emacs 24.4 on non-free operating systems
+
++++
+** The "generate a backtrace on fatal error" feature now works on MS Windows.
+The backtrace is written to the 'emacs_backtrace.txt' file in the
+directory where Emacs was running.
+
+\f
* Installation Changes in Emacs 24.3
---
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (SYSWAIT_H): New macro.
+ ($(BLD)/movemail.$(O)): Update dependencies.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * movemail.c, update-game-score.c: Assume <fcntl.h> exists.
+
2012-10-26 Glenn Morris <rgm@gnu.org>
* Makefile.in (uninstall): No INSTALLABLES live in archlibdir.
SYSTIME_H = $(SRC)/systime.h \
$(NT_INC)/sys/time.h \
$(GNU_LIB)/timespec.h
+SYSWAIT_H = $(SRC)/syswait.h \
+ $(NT_INC)/sys/wait.h
$(BLD)/ctags.$(O) : \
$(LIB_SRC)/ctags.c \
$(BLD)/movemail.$(O) : \
$(LIB_SRC)/movemail.c \
$(LIB_SRC)/pop.h \
- $(SRC)/syswait.h \
$(NT_INC)/pwd.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/getopt.h \
$(CONFIG_H) \
- $(NTLIB_H)
+ $(NTLIB_H) \
+ $(SYSWAIT_H)
$(BLD)/ntlib.$(O) : \
$(LIB_SRC)/ntlib.c \
#include <getopt.h>
#include <unistd.h>
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
#include <string.h>
#include "syswait.h"
#ifdef MAIL_USE_POP
#include <time.h>
#include <pwd.h>
#include <ctype.h>
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
#include <sys/stat.h>
#include <getopt.h>
--- /dev/null
+/* Define at-style functions like fstatat, unlinkat, fchownat, etc.
+ Copyright (C) 2006, 2009-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Jim Meyering */
+
+#include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */
+
+#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD
+# include <errno.h>
+# ifndef ENOTSUP
+# define ENOTSUP EINVAL
+# endif
+#else
+# include "openat.h"
+# include "openat-priv.h"
+# include "save-cwd.h"
+#endif
+
+#ifdef AT_FUNC_USE_F1_COND
+# define CALL_FUNC(F) \
+ (flag == AT_FUNC_USE_F1_COND \
+ ? AT_FUNC_F1 (F AT_FUNC_POST_FILE_ARGS) \
+ : AT_FUNC_F2 (F AT_FUNC_POST_FILE_ARGS))
+# define VALIDATE_FLAG(F) \
+ if (flag & ~AT_FUNC_USE_F1_COND) \
+ { \
+ errno = EINVAL; \
+ return FUNC_FAIL; \
+ }
+#else
+# define CALL_FUNC(F) (AT_FUNC_F1 (F AT_FUNC_POST_FILE_ARGS))
+# define VALIDATE_FLAG(F) /* empty */
+#endif
+
+#ifdef AT_FUNC_RESULT
+# define FUNC_RESULT AT_FUNC_RESULT
+#else
+# define FUNC_RESULT int
+#endif
+
+#ifdef AT_FUNC_FAIL
+# define FUNC_FAIL AT_FUNC_FAIL
+#else
+# define FUNC_FAIL -1
+#endif
+
+/* Call AT_FUNC_F1 to operate on FILE, which is in the directory
+ open on descriptor FD. If AT_FUNC_USE_F1_COND is defined to a value,
+ AT_FUNC_POST_FILE_PARAM_DECLS must include a parameter named flag;
+ call AT_FUNC_F2 if FLAG is 0 or fail if FLAG contains more bits than
+ AT_FUNC_USE_F1_COND. Return int and fail with -1 unless AT_FUNC_RESULT
+ or AT_FUNC_FAIL are defined. If possible, do it without changing the
+ working directory. Otherwise, resort to using save_cwd/fchdir,
+ then AT_FUNC_F?/restore_cwd. If either the save_cwd or the restore_cwd
+ fails, then give a diagnostic and exit nonzero. */
+FUNC_RESULT
+AT_FUNC_NAME (int fd, char const *file AT_FUNC_POST_FILE_PARAM_DECLS)
+{
+ VALIDATE_FLAG (flag);
+
+ if (fd == AT_FDCWD || IS_ABSOLUTE_FILE_NAME (file))
+ return CALL_FUNC (file);
+
+#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD
+ errno = ENOTSUP;
+ return FUNC_FAIL;
+#else
+ {
+ /* Be careful to choose names unlikely to conflict with
+ AT_FUNC_POST_FILE_PARAM_DECLS. */
+ struct saved_cwd saved_cwd;
+ int saved_errno;
+ FUNC_RESULT err;
+
+ {
+ char proc_buf[OPENAT_BUFFER_SIZE];
+ char *proc_file = openat_proc_name (proc_buf, fd, file);
+ if (proc_file)
+ {
+ FUNC_RESULT proc_result = CALL_FUNC (proc_file);
+ int proc_errno = errno;
+ if (proc_file != proc_buf)
+ free (proc_file);
+ /* If the syscall succeeds, or if it fails with an unexpected
+ errno value, then return right away. Otherwise, fall through
+ and resort to using save_cwd/restore_cwd. */
+ if (FUNC_FAIL != proc_result)
+ return proc_result;
+ if (! EXPECTED_ERRNO (proc_errno))
+ {
+ errno = proc_errno;
+ return proc_result;
+ }
+ }
+ }
+
+ if (save_cwd (&saved_cwd) != 0)
+ openat_save_fail (errno);
+ if (0 <= fd && fd == saved_cwd.desc)
+ {
+ /* If saving the working directory collides with the user's
+ requested fd, then the user's fd must have been closed to
+ begin with. */
+ free_cwd (&saved_cwd);
+ errno = EBADF;
+ return FUNC_FAIL;
+ }
+
+ if (fchdir (fd) != 0)
+ {
+ saved_errno = errno;
+ free_cwd (&saved_cwd);
+ errno = saved_errno;
+ return FUNC_FAIL;
+ }
+
+ err = CALL_FUNC (file);
+ saved_errno = (err == FUNC_FAIL ? errno : 0);
+
+ if (restore_cwd (&saved_cwd) != 0)
+ openat_restore_fail (errno);
+
+ free_cwd (&saved_cwd);
+
+ if (saved_errno)
+ errno = saved_errno;
+ return err;
+ }
+#endif
+}
+#undef CALL_FUNC
+#undef FUNC_RESULT
+#undef FUNC_FAIL
--- /dev/null
+/* Close a stream, with nicer error checking than fclose's.
+
+ Copyright (C) 1998-2002, 2004, 2006-2012 Free Software Foundation, Inc.
+
+ 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>
+
+#include "close-stream.h"
+
+#include <errno.h>
+#include <stdbool.h>
+
+#include "fpending.h"
+
+#if USE_UNLOCKED_IO
+# include "unlocked-io.h"
+#endif
+
+/* Close STREAM. Return 0 if successful, EOF (setting errno)
+ otherwise. A failure might set errno to 0 if the error number
+ cannot be determined.
+
+ A failure with errno set to EPIPE may or may not indicate an error
+ situation worth signaling to the user. See the documentation of the
+ close_stdout_set_ignore_EPIPE function for details.
+
+ If a program writes *anything* to STREAM, that program should close
+ STREAM and make sure that it succeeds before exiting. Otherwise,
+ suppose that you go to the extreme of checking the return status
+ of every function that does an explicit write to STREAM. The last
+ printf can succeed in writing to the internal stream buffer, and yet
+ the fclose(STREAM) could still fail (due e.g., to a disk full error)
+ when it tries to write out that buffered data. Thus, you would be
+ left with an incomplete output file and the offending program would
+ exit successfully. Even calling fflush is not always sufficient,
+ since some file systems (NFS and CODA) buffer written/flushed data
+ until an actual close call.
+
+ Besides, it's wasteful to check the return value from every call
+ that writes to STREAM -- just let the internal stream state record
+ the failure. That's what the ferror test is checking below. */
+
+int
+close_stream (FILE *stream)
+{
+ const bool some_pending = (__fpending (stream) != 0);
+ const bool prev_fail = (ferror (stream) != 0);
+ const bool fclose_fail = (fclose (stream) != 0);
+
+ /* Return an error indication if there was a previous failure or if
+ fclose failed, with one exception: ignore an fclose failure if
+ there was no previous error, no data remains to be flushed, and
+ fclose failed with EBADF. That can happen when a program like cp
+ is invoked like this 'cp a b >&-' (i.e., with standard output
+ closed) and doesn't generate any output (hence no previous error
+ and nothing to be flushed). */
+
+ if (prev_fail || (fclose_fail && (some_pending || errno != EBADF)))
+ {
+ if (! fclose_fail)
+ errno = 0;
+ return EOF;
+ }
+
+ return 0;
+}
--- /dev/null
+#include <stdio.h>
+int close_stream (FILE *stream);
--- /dev/null
+/* euidaccess -- check if effective user id can access file
+
+ Copyright (C) 1990-1991, 1995, 1998, 2000, 2003-2006, 2008-2012 Free
+ Software Foundation, Inc.
+
+ This file is part of the GNU C Library.
+
+ 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/>. */
+
+/* Written by David MacKenzie and Torbjorn Granlund.
+ Adapted for GNU C library by Roland McGrath. */
+
+#ifndef _LIBC
+# include <config.h>
+#endif
+
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+#include "root-uid.h"
+
+#if HAVE_LIBGEN_H
+# include <libgen.h>
+#endif
+
+#include <errno.h>
+#ifndef __set_errno
+# define __set_errno(val) errno = (val)
+#endif
+
+#if defined EACCES && !defined EACCESS
+# define EACCESS EACCES
+#endif
+
+#ifndef F_OK
+# define F_OK 0
+# define X_OK 1
+# define W_OK 2
+# define R_OK 4
+#endif
+
+
+#ifdef _LIBC
+
+# define access __access
+# define getuid __getuid
+# define getgid __getgid
+# define geteuid __geteuid
+# define getegid __getegid
+# define group_member __group_member
+# define euidaccess __euidaccess
+# undef stat
+# define stat stat64
+
+#endif
+
+/* Return 0 if the user has permission of type MODE on FILE;
+ otherwise, return -1 and set 'errno'.
+ Like access, except that it uses the effective user and group
+ id's instead of the real ones, and it does not always check for read-only
+ file system, text busy, etc. */
+
+int
+euidaccess (const char *file, int mode)
+{
+#if HAVE_FACCESSAT /* glibc, AIX 7, Solaris 11, Cygwin 1.7 */
+ return faccessat (AT_FDCWD, file, mode, AT_EACCESS);
+#elif defined EFF_ONLY_OK /* IRIX, OSF/1, Interix */
+ return access (file, mode | EFF_ONLY_OK);
+#elif defined ACC_SELF /* AIX */
+ return accessx (file, mode, ACC_SELF);
+#elif HAVE_EACCESS /* FreeBSD */
+ return eaccess (file, mode);
+#else /* Mac OS X, NetBSD, OpenBSD, HP-UX, Solaris, Cygwin, mingw, BeOS */
+
+ uid_t uid = getuid ();
+ gid_t gid = getgid ();
+ uid_t euid = geteuid ();
+ gid_t egid = getegid ();
+ struct stat stats;
+
+# if HAVE_DECL_SETREGID && PREFER_NONREENTRANT_EUIDACCESS
+
+ /* Define PREFER_NONREENTRANT_EUIDACCESS if you prefer euidaccess to
+ return the correct result even if this would make it
+ nonreentrant. Define this only if your entire application is
+ safe even if the uid or gid might temporarily change. If your
+ application uses signal handlers or threads it is probably not
+ safe. */
+
+ if (mode == F_OK)
+ return stat (file, &stats);
+ else
+ {
+ int result;
+ int saved_errno;
+
+ if (uid != euid)
+ setreuid (euid, uid);
+ if (gid != egid)
+ setregid (egid, gid);
+
+ result = access (file, mode);
+ saved_errno = errno;
+
+ /* Restore them. */
+ if (uid != euid)
+ setreuid (uid, euid);
+ if (gid != egid)
+ setregid (gid, egid);
+
+ errno = saved_errno;
+ return result;
+ }
+
+# else
+
+ /* The following code assumes the traditional Unix model, and is not
+ correct on systems that have ACLs or the like. However, it's
+ better than nothing, and it is reentrant. */
+
+ unsigned int granted;
+ if (uid == euid && gid == egid)
+ /* If we are not set-uid or set-gid, access does the same. */
+ return access (file, mode);
+
+ if (stat (file, &stats) != 0)
+ return -1;
+
+ /* The super-user can read and write any file, and execute any file
+ that anyone can execute. */
+ if (euid == ROOT_UID
+ && ((mode & X_OK) == 0
+ || (stats.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH))))
+ return 0;
+
+ /* Convert the mode to traditional form, clearing any bogus bits. */
+ if (R_OK == 4 && W_OK == 2 && X_OK == 1 && F_OK == 0)
+ mode &= 7;
+ else
+ mode = ((mode & R_OK ? 4 : 0)
+ + (mode & W_OK ? 2 : 0)
+ + (mode & X_OK ? 1 : 0));
+
+ if (mode == 0)
+ return 0; /* The file exists. */
+
+ /* Convert the file's permission bits to traditional form. */
+ if (S_IRUSR == (4 << 6) && S_IWUSR == (2 << 6) && S_IXUSR == (1 << 6)
+ && S_IRGRP == (4 << 3) && S_IWGRP == (2 << 3) && S_IXGRP == (1 << 3)
+ && S_IROTH == (4 << 0) && S_IWOTH == (2 << 0) && S_IXOTH == (1 << 0))
+ granted = stats.st_mode;
+ else
+ granted = ((stats.st_mode & S_IRUSR ? 4 << 6 : 0)
+ + (stats.st_mode & S_IWUSR ? 2 << 6 : 0)
+ + (stats.st_mode & S_IXUSR ? 1 << 6 : 0)
+ + (stats.st_mode & S_IRGRP ? 4 << 3 : 0)
+ + (stats.st_mode & S_IWGRP ? 2 << 3 : 0)
+ + (stats.st_mode & S_IXGRP ? 1 << 3 : 0)
+ + (stats.st_mode & S_IROTH ? 4 << 0 : 0)
+ + (stats.st_mode & S_IWOTH ? 2 << 0 : 0)
+ + (stats.st_mode & S_IXOTH ? 1 << 0 : 0));
+
+ if (euid == stats.st_uid)
+ granted >>= 6;
+ else if (egid == stats.st_gid || group_member (stats.st_gid))
+ granted >>= 3;
+
+ if ((mode & ~granted) == 0)
+ return 0;
+ __set_errno (EACCESS);
+ return -1;
+
+# endif
+#endif
+}
+#undef euidaccess
+#ifdef weak_alias
+weak_alias (__euidaccess, euidaccess)
+#endif
+\f
+#ifdef TEST
+# include <error.h>
+# include <stdio.h>
+# include <stdlib.h>
+
+char *program_name;
+
+int
+main (int argc, char **argv)
+{
+ char *file;
+ int mode;
+ int err;
+
+ program_name = argv[0];
+ if (argc < 3)
+ abort ();
+ file = argv[1];
+ mode = atoi (argv[2]);
+
+ err = euidaccess (file, mode);
+ printf ("%d\n", err);
+ if (err != 0)
+ error (0, errno, "%s", file);
+ exit (0);
+}
+#endif
--- /dev/null
+/* Check the access rights of a file relative to an open directory.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Eric Blake */
+
+#include <config.h>
+
+#include <unistd.h>
+#include <fcntl.h>
+
+#ifndef HAVE_ACCESS
+/* Mingw lacks access, but it also lacks real vs. effective ids, so
+ the gnulib euidaccess module is good enough. */
+# undef access
+# define access euidaccess
+#endif
+
+/* Invoke access or euidaccess on file, FILE, using mode MODE, in the directory
+ open on descriptor FD. If possible, do it without changing the
+ working directory. Otherwise, resort to using save_cwd/fchdir, then
+ (access|euidaccess)/restore_cwd. If either the save_cwd or the
+ restore_cwd fails, then give a diagnostic and exit nonzero.
+ Note that this implementation only supports AT_EACCESS, although some
+ native versions also support AT_SYMLINK_NOFOLLOW. */
+
+#define AT_FUNC_NAME faccessat
+#define AT_FUNC_F1 euidaccess
+#define AT_FUNC_F2 access
+#define AT_FUNC_USE_F1_COND AT_EACCESS
+#define AT_FUNC_POST_FILE_PARAM_DECLS , int mode, int flag
+#define AT_FUNC_POST_FILE_ARGS , mode
+#include "at-func.c"
--- /dev/null
+/* Like <fcntl.h>, but with non-working flags defined to 0.
+
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Paul Eggert */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#if defined __need_system_fcntl_h
+/* Special invocation convention. */
+
+/* Needed before <sys/stat.h>.
+ May also define off_t to a 64-bit type on native Windows. */
+#include <sys/types.h>
+/* On some systems other than glibc, <sys/stat.h> is a prerequisite of
+ <fcntl.h>. On glibc systems, we would like to avoid namespace pollution.
+ But on glibc systems, <fcntl.h> includes <sys/stat.h> inside an
+ extern "C" { ... } block, which leads to errors in C++ mode with the
+ overridden <sys/stat.h> from gnulib. These errors are known to be gone
+ with g++ version >= 4.3. */
+#if !(defined __GLIBC__ || defined __UCLIBC__) || (defined __cplusplus && defined GNULIB_NAMESPACE && !(__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
+# include <sys/stat.h>
+#endif
+#@INCLUDE_NEXT@ @NEXT_FCNTL_H@
+
+#else
+/* Normal invocation convention. */
+
+#ifndef _@GUARD_PREFIX@_FCNTL_H
+
+/* Needed before <sys/stat.h>.
+ May also define off_t to a 64-bit type on native Windows. */
+#include <sys/types.h>
+/* On some systems other than glibc, <sys/stat.h> is a prerequisite of
+ <fcntl.h>. On glibc systems, we would like to avoid namespace pollution.
+ But on glibc systems, <fcntl.h> includes <sys/stat.h> inside an
+ extern "C" { ... } block, which leads to errors in C++ mode with the
+ overridden <sys/stat.h> from gnulib. These errors are known to be gone
+ with g++ version >= 4.3. */
+#if !(defined __GLIBC__ || defined __UCLIBC__) || (defined __cplusplus && defined GNULIB_NAMESPACE && !(__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
+# include <sys/stat.h>
+#endif
+/* The include_next requires a split double-inclusion guard. */
+#@INCLUDE_NEXT@ @NEXT_FCNTL_H@
+
+#ifndef _@GUARD_PREFIX@_FCNTL_H
+#define _@GUARD_PREFIX@_FCNTL_H
+
+#ifndef __GLIBC__ /* Avoid namespace pollution on glibc systems. */
+# include <unistd.h>
+#endif
+
+/* Native Windows platforms declare open(), creat() in <io.h>. */
+#if (@GNULIB_OPEN@ || defined GNULIB_POSIXCHECK) \
+ && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
+#endif
+
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+
+/* Declare overridden functions. */
+
+#if @GNULIB_FCNTL@
+# if @REPLACE_FCNTL@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fcntl
+# define fcntl rpl_fcntl
+# endif
+_GL_FUNCDECL_RPL (fcntl, int, (int fd, int action, ...));
+_GL_CXXALIAS_RPL (fcntl, int, (int fd, int action, ...));
+# else
+# if !@HAVE_FCNTL@
+_GL_FUNCDECL_SYS (fcntl, int, (int fd, int action, ...));
+# endif
+_GL_CXXALIAS_SYS (fcntl, int, (int fd, int action, ...));
+# endif
+_GL_CXXALIASWARN (fcntl);
+#elif defined GNULIB_POSIXCHECK
+# undef fcntl
+# if HAVE_RAW_DECL_FCNTL
+_GL_WARN_ON_USE (fcntl, "fcntl is not always POSIX compliant - "
+ "use gnulib module fcntl for portability");
+# endif
+#endif
+
+#if @GNULIB_OPEN@
+# if @REPLACE_OPEN@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef open
+# define open rpl_open
+# endif
+_GL_FUNCDECL_RPL (open, int, (const char *filename, int flags, ...)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (open, int, (const char *filename, int flags, ...));
+# else
+_GL_CXXALIAS_SYS (open, int, (const char *filename, int flags, ...));
+# endif
+/* On HP-UX 11, in C++ mode, open() is defined as an inline function with a
+ default argument. _GL_CXXALIASWARN does not work in this case. */
+# if !defined __hpux
+_GL_CXXALIASWARN (open);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef open
+/* Assume open is always declared. */
+_GL_WARN_ON_USE (open, "open is not always POSIX compliant - "
+ "use gnulib module open for portability");
+#endif
+
+#if @GNULIB_OPENAT@
+# if @REPLACE_OPENAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef openat
+# define openat rpl_openat
+# endif
+_GL_FUNCDECL_RPL (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...));
+# else
+# if !@HAVE_OPENAT@
+_GL_FUNCDECL_SYS (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...)
+ _GL_ARG_NONNULL ((2)));
+# endif
+_GL_CXXALIAS_SYS (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...));
+# endif
+_GL_CXXALIASWARN (openat);
+#elif defined GNULIB_POSIXCHECK
+# undef openat
+# if HAVE_RAW_DECL_OPENAT
+_GL_WARN_ON_USE (openat, "openat is not portable - "
+ "use gnulib module openat for portability");
+# endif
+#endif
+
+
+/* Fix up the FD_* macros, only known to be missing on mingw. */
+
+#ifndef FD_CLOEXEC
+# define FD_CLOEXEC 1
+#endif
+
+/* Fix up the supported F_* macros. Intentionally leave other F_*
+ macros undefined. Only known to be missing on mingw. */
+
+#ifndef F_DUPFD_CLOEXEC
+# define F_DUPFD_CLOEXEC 0x40000000
+/* Witness variable: 1 if gnulib defined F_DUPFD_CLOEXEC, 0 otherwise. */
+# define GNULIB_defined_F_DUPFD_CLOEXEC 1
+#else
+# define GNULIB_defined_F_DUPFD_CLOEXEC 0
+#endif
+
+#ifndef F_DUPFD
+# define F_DUPFD 1
+#endif
+
+#ifndef F_GETFD
+# define F_GETFD 2
+#endif
+
+/* Fix up the O_* macros. */
+
+#if !defined O_DIRECT && defined O_DIRECTIO
+/* Tru64 spells it 'O_DIRECTIO'. */
+# define O_DIRECT O_DIRECTIO
+#endif
+
+#if !defined O_CLOEXEC && defined O_NOINHERIT
+/* Mingw spells it 'O_NOINHERIT'. */
+# define O_CLOEXEC O_NOINHERIT
+#endif
+
+#ifndef O_CLOEXEC
+# define O_CLOEXEC 0
+#endif
+
+#ifndef O_DIRECT
+# define O_DIRECT 0
+#endif
+
+#ifndef O_DIRECTORY
+# define O_DIRECTORY 0
+#endif
+
+#ifndef O_DSYNC
+# define O_DSYNC 0
+#endif
+
+#ifndef O_EXEC
+# define O_EXEC O_RDONLY /* This is often close enough in older systems. */
+#endif
+
+#ifndef O_IGNORE_CTTY
+# define O_IGNORE_CTTY 0
+#endif
+
+#ifndef O_NDELAY
+# define O_NDELAY 0
+#endif
+
+#ifndef O_NOATIME
+# define O_NOATIME 0
+#endif
+
+#ifndef O_NONBLOCK
+# define O_NONBLOCK O_NDELAY
+#endif
+
+/* If the gnulib module 'nonblocking' is in use, guarantee a working non-zero
+ value of O_NONBLOCK. Otherwise, O_NONBLOCK is defined (above) to O_NDELAY
+ or to 0 as fallback. */
+#if @GNULIB_NONBLOCKING@
+# if O_NONBLOCK
+# define GNULIB_defined_O_NONBLOCK 0
+# else
+# define GNULIB_defined_O_NONBLOCK 1
+# undef O_NONBLOCK
+# define O_NONBLOCK 0x40000000
+# endif
+#endif
+
+#ifndef O_NOCTTY
+# define O_NOCTTY 0
+#endif
+
+#ifndef O_NOFOLLOW
+# define O_NOFOLLOW 0
+#endif
+
+#ifndef O_NOLINK
+# define O_NOLINK 0
+#endif
+
+#ifndef O_NOLINKS
+# define O_NOLINKS 0
+#endif
+
+#ifndef O_NOTRANS
+# define O_NOTRANS 0
+#endif
+
+#ifndef O_RSYNC
+# define O_RSYNC 0
+#endif
+
+#ifndef O_SEARCH
+# define O_SEARCH O_RDONLY /* This is often close enough in older systems. */
+#endif
+
+#ifndef O_SYNC
+# define O_SYNC 0
+#endif
+
+#ifndef O_TTY_INIT
+# define O_TTY_INIT 0
+#endif
+
+#if ~O_ACCMODE & (O_RDONLY | O_WRONLY | O_RDWR | O_EXEC | O_SEARCH)
+# undef O_ACCMODE
+# define O_ACCMODE (O_RDONLY | O_WRONLY | O_RDWR | O_EXEC | O_SEARCH)
+#endif
+
+/* For systems that distinguish between text and binary I/O.
+ O_BINARY is usually declared in fcntl.h */
+#if !defined O_BINARY && defined _O_BINARY
+ /* For MSC-compatible compilers. */
+# define O_BINARY _O_BINARY
+# define O_TEXT _O_TEXT
+#endif
+
+#if defined __BEOS__ || defined __HAIKU__
+ /* BeOS 5 and Haiku have O_BINARY and O_TEXT, but they have no effect. */
+# undef O_BINARY
+# undef O_TEXT
+#endif
+
+#ifndef O_BINARY
+# define O_BINARY 0
+# define O_TEXT 0
+#endif
+
+/* Fix up the AT_* macros. */
+
+/* Work around a bug in Solaris 9 and 10: AT_FDCWD is positive. Its
+ value exceeds INT_MAX, so its use as an int doesn't conform to the
+ C standard, and GCC and Sun C complain in some cases. If the bug
+ is present, undef AT_FDCWD here, so it can be redefined below. */
+#if 0 < AT_FDCWD && AT_FDCWD == 0xffd19553
+# undef AT_FDCWD
+#endif
+
+/* Use the same bit pattern as Solaris 9, but with the proper
+ signedness. The bit pattern is important, in case this actually is
+ Solaris with the above workaround. */
+#ifndef AT_FDCWD
+# define AT_FDCWD (-3041965)
+#endif
+
+/* Use the same values as Solaris 9. This shouldn't matter, but
+ there's no real reason to differ. */
+#ifndef AT_SYMLINK_NOFOLLOW
+# define AT_SYMLINK_NOFOLLOW 4096
+#endif
+
+#ifndef AT_REMOVEDIR
+# define AT_REMOVEDIR 1
+#endif
+
+/* Solaris 9 lacks these two, so just pick unique values. */
+#ifndef AT_SYMLINK_FOLLOW
+# define AT_SYMLINK_FOLLOW 2
+#endif
+
+#ifndef AT_EACCESS
+# define AT_EACCESS 4
+#endif
+
+
+#endif /* _@GUARD_PREFIX@_FCNTL_H */
+#endif /* _@GUARD_PREFIX@_FCNTL_H */
+#endif
--- /dev/null
+/* fpending.c -- return the number of pending output bytes on a stream
+ Copyright (C) 2000, 2004, 2006-2007, 2009-2012 Free Software Foundation,
+ Inc.
+
+ 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/>. */
+
+/* Written by Jim Meyering. */
+
+#include <config.h>
+
+#include "fpending.h"
+
+/* Return the number of pending (aka buffered, unflushed)
+ bytes on the stream, FP, that is open for writing. */
+size_t
+__fpending (FILE *fp)
+{
+ return PENDING_OUTPUT_N_BYTES;
+}
--- /dev/null
+/* Declare __fpending.
+
+ Copyright (C) 2000, 2003, 2005-2006, 2009-2012 Free Software Foundation,
+ Inc.
+
+ 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/>.
+
+ Written by Jim Meyering. */
+
+#include <stddef.h>
+#include <stdio.h>
+
+#if HAVE_DECL___FPENDING
+# if HAVE_STDIO_EXT_H
+# include <stdio_ext.h>
+# endif
+#else
+size_t __fpending (FILE *);
+#endif
--- /dev/null
+/* provide consistent interface to getgroups for systems that don't allow N==0
+
+ Copyright (C) 1996, 1999, 2003, 2006-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Jim Meyering */
+
+#include <config.h>
+
+#include <unistd.h>
+
+#include <errno.h>
+#include <stdlib.h>
+#include <stdint.h>
+
+#if !HAVE_GETGROUPS
+
+/* Provide a stub that fails with ENOSYS, since there is no group
+ information available on mingw. */
+int
+getgroups (int n _GL_UNUSED, GETGROUPS_T *groups _GL_UNUSED)
+{
+ errno = ENOSYS;
+ return -1;
+}
+
+#else /* HAVE_GETGROUPS */
+
+# undef getgroups
+# ifndef GETGROUPS_ZERO_BUG
+# define GETGROUPS_ZERO_BUG 0
+# endif
+
+/* On at least Ultrix 4.3 and NextStep 3.2, getgroups (0, NULL) always
+ fails. On other systems, it returns the number of supplemental
+ groups for the process. This function handles that special case
+ and lets the system-provided function handle all others. However,
+ it can fail with ENOMEM if memory is tight. It is unspecified
+ whether the effective group id is included in the list. */
+
+int
+rpl_getgroups (int n, gid_t *group)
+{
+ int n_groups;
+ GETGROUPS_T *gbuf;
+ int saved_errno;
+
+ if (n < 0)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ if (n != 0 || !GETGROUPS_ZERO_BUG)
+ {
+ int result;
+ if (sizeof *group == sizeof *gbuf)
+ return getgroups (n, (GETGROUPS_T *) group);
+
+ if (SIZE_MAX / sizeof *gbuf <= n)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ gbuf = malloc (n * sizeof *gbuf);
+ if (!gbuf)
+ return -1;
+ result = getgroups (n, gbuf);
+ if (0 <= result)
+ {
+ n = result;
+ while (n--)
+ group[n] = gbuf[n];
+ }
+ saved_errno = errno;
+ free (gbuf);
+ errno == saved_errno;
+ return result;
+ }
+
+ n = 20;
+ while (1)
+ {
+ /* No need to worry about address arithmetic overflow here,
+ since the ancient systems that we're running on have low
+ limits on the number of secondary groups. */
+ gbuf = malloc (n * sizeof *gbuf);
+ if (!gbuf)
+ return -1;
+ n_groups = getgroups (n, gbuf);
+ if (n_groups == -1 ? errno != EINVAL : n_groups < n)
+ break;
+ free (gbuf);
+ n *= 2;
+ }
+
+ saved_errno = errno;
+ free (gbuf);
+ errno = saved_errno;
+
+ return n_groups;
+}
+
+#endif /* HAVE_GETGROUPS */
# 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-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo 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 timer-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=at-internal --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=openat-h --avoid=raise --avoid=save-cwd --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 close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl-h 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 timer-time timespec-add timespec-sub utimens warnings
MOSTLYCLEANFILES += core *.stackdump
## end gnulib module careadlinkat
+## begin gnulib module close-stream
+
+libgnu_a_SOURCES += close-stream.c
+
+EXTRA_DIST += close-stream.h
+
+## end gnulib module close-stream
+
## begin gnulib module crypto/md5
libgnu_a_SOURCES += md5.c
## end gnulib module dup2
+## begin gnulib module euidaccess
+
+if gl_GNULIB_ENABLED_euidaccess
+
+endif
+EXTRA_DIST += euidaccess.c
+
+EXTRA_libgnu_a_SOURCES += euidaccess.c
+
+## end gnulib module euidaccess
+
## begin gnulib module execinfo
BUILT_SOURCES += $(EXECINFO_H)
## end gnulib module execinfo
+## begin gnulib module faccessat
+
+
+EXTRA_DIST += at-func.c faccessat.c
+
+EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c
+
+## end gnulib module faccessat
+
+## begin gnulib module fcntl-h
+
+BUILT_SOURCES += fcntl.h
+
+# We need the following in order to create <fcntl.h> when the system
+# doesn't have one that works with the given compiler.
+fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_FCNTL_H''@|$(NEXT_FCNTL_H)|g' \
+ -e 's/@''GNULIB_FCNTL''@/$(GNULIB_FCNTL)/g' \
+ -e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \
+ -e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \
+ -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \
+ -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \
+ -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \
+ -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \
+ -e 's|@''REPLACE_OPENAT''@|$(REPLACE_OPENAT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/fcntl.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+MOSTLYCLEANFILES += fcntl.h fcntl.h-t
+
+EXTRA_DIST += fcntl.in.h
+
+## end gnulib module fcntl-h
+
## begin gnulib module filemode
libgnu_a_SOURCES += filemode.c
## end gnulib module filemode
+## begin gnulib module fpending
+
+
+EXTRA_DIST += fpending.c fpending.h
+
+EXTRA_libgnu_a_SOURCES += fpending.c
+
+## end gnulib module fpending
+
+## begin gnulib module getgroups
+
+if gl_GNULIB_ENABLED_getgroups
+
+endif
+EXTRA_DIST += getgroups.c
+
+EXTRA_libgnu_a_SOURCES += getgroups.c
+
+## end gnulib module getgroups
+
## begin gnulib module getloadavg
## end gnulib module gettimeofday
+## begin gnulib module group-member
+
+if gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1
+
+endif
+EXTRA_DIST += group-member.c
+
+EXTRA_libgnu_a_SOURCES += group-member.c
+
+## end gnulib module group-member
+
## begin gnulib module ignore-value
## end gnulib module readlink
+## begin gnulib module root-uid
+
+if gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c
+
+endif
+EXTRA_DIST += root-uid.h
+
+## end gnulib module root-uid
+
## begin gnulib module signal-h
BUILT_SOURCES += signal.h
## end gnulib module verify
+## begin gnulib module xalloc-oversized
+
+if gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec
+
+endif
+EXTRA_DIST += xalloc-oversized.h
+
+## end gnulib module xalloc-oversized
+
mostlyclean-local: mostlyclean-generic
@for dir in '' $(MOSTLYCLEANDIRS); do \
--- /dev/null
+/* group-member.c -- determine whether group id is in calling user's group list
+
+ Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2012 Free Software
+ Foundation, Inc.
+
+ 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 <unistd.h>
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <stdlib.h>
+
+#include "xalloc-oversized.h"
+
+/* Most processes have no more than this many groups, and for these
+ processes we can avoid using malloc. */
+enum { GROUPBUF_SIZE = 100 };
+
+struct group_info
+ {
+ gid_t *group;
+ gid_t groupbuf[GROUPBUF_SIZE];
+ };
+
+static void
+free_group_info (struct group_info const *g)
+{
+ if (g->group != g->groupbuf)
+ free (g->group);
+}
+
+static int
+get_group_info (struct group_info *gi)
+{
+ int n_groups = getgroups (GROUPBUF_SIZE, gi->groupbuf);
+ gi->group = gi->groupbuf;
+
+ if (n_groups < 0)
+ {
+ int n_group_slots = getgroups (0, NULL);
+ if (0 <= n_group_slots
+ && ! xalloc_oversized (n_group_slots, sizeof *gi->group))
+ {
+ gi->group = malloc (n_group_slots * sizeof *gi->group);
+ if (gi->group)
+ n_groups = getgroups (n_group_slots, gi->group);
+ }
+ }
+
+ /* In case of error, the user loses. */
+ return n_groups;
+}
+
+/* Return non-zero if GID is one that we have in our groups list.
+ Note that the groups list is not guaranteed to contain the current
+ or effective group ID, so they should generally be checked
+ separately. */
+
+int
+group_member (gid_t gid)
+{
+ int i;
+ int found;
+ struct group_info gi;
+ int n_groups = get_group_info (&gi);
+
+ /* Search through the list looking for GID. */
+ found = 0;
+ for (i = 0; i < n_groups; i++)
+ {
+ if (gid == gi.group[i])
+ {
+ found = 1;
+ break;
+ }
+ }
+
+ free_group_info (&gi);
+
+ return found;
+}
+
+#ifdef TEST
+
+char *program_name;
+
+int
+main (int argc, char **argv)
+{
+ int i;
+
+ program_name = argv[0];
+
+ for (i = 1; i < argc; i++)
+ {
+ gid_t gid;
+
+ gid = atoi (argv[i]);
+ printf ("%d: %s\n", gid, group_member (gid) ? "yes" : "no");
+ }
+ exit (0);
+}
+
+#endif /* TEST */
GNULIBOBJS = $(BLD)/c-ctype.$(O) \
$(BLD)/c-strcasecmp.$(O) \
$(BLD)/c-strncasecmp.$(O) \
+ $(BLD)/close-stream.$(O) \
$(BLD)/dtoastr.$(O) \
$(BLD)/dtotimespec.$(O) \
$(BLD)/execinfo.$(O) \
+ $(BLD)/fpending.$(O) \
$(BLD)/getopt.$(O) \
$(BLD)/getopt1.$(O) \
$(BLD)/gettime.$(O) \
$(CONFIG_H) \
$(C_CTYPE_H)
+$(BLD)/close-stream.$(O) : \
+ $(GNU_LIB)/close-stream.c \
+ $(GNU_LIB)/close-stream.h \
+ $(GNU_LIB)/fpending.h \
+ $(NT_INC)/stdbool.h \
+ $(CONFIG_H)
+
$(BLD)/dtoastr.$(O) : \
$(GNU_LIB)/dtoastr.c \
$(FTOASTR_C)
$(GNU_LIB)/execinfo.h \
$(CONFIG_H)
+$(BLD)/fpending.$(O) : \
+ $(GNU_LIB)/fpending.c \
+ $(GNU_LIB)/fpending.h \
+ $(CONFIG_H)
+
$(BLD)/getopt.$(O) : \
$(GNU_LIB)/getopt.c \
$(GNU_LIB)/getopt.h \
--- /dev/null
+/* The user ID that always has appropriate privileges in the POSIX sense.
+
+ Copyright 2012 Free Software Foundation, Inc.
+
+ 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/>.
+
+ Written by Paul Eggert. */
+
+#ifndef ROOT_UID_H_
+#define ROOT_UID_H_
+
+/* The user ID that always has appropriate privileges in the POSIX sense. */
+#ifdef __TANDEM
+# define ROOT_UID 65535
+#else
+# define ROOT_UID 0
+#endif
+
+#endif
--- /dev/null
+/* xalloc-oversized.h -- memory allocation size checking
+
+ Copyright (C) 1990-2000, 2003-2004, 2006-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+#ifndef XALLOC_OVERSIZED_H_
+# define XALLOC_OVERSIZED_H_
+
+# include <stddef.h>
+
+/* Return 1 if an array of N objects, each of size S, cannot exist due
+ to size arithmetic overflow. S must be positive and N must be
+ nonnegative. This is a macro, not a function, so that it
+ works correctly even when SIZE_MAX < N.
+
+ By gnulib convention, SIZE_MAX represents overflow in size
+ calculations, so the conservative dividend to use here is
+ SIZE_MAX - 1, since SIZE_MAX might represent an overflowed value.
+ However, malloc (SIZE_MAX) fails on all known hosts where
+ sizeof (ptrdiff_t) <= sizeof (size_t), so do not bother to test for
+ exactly-SIZE_MAX allocations on such hosts; this avoids a test and
+ branch when S is known to be 1. */
+# define xalloc_oversized(n, s) \
+ ((size_t) (sizeof (ptrdiff_t) <= sizeof (size_t) ? -1 : -2) / (s) < (n))
+
+#endif /* !XALLOC_OVERSIZED_H_ */
* image.el (insert-image, insert-sliced-image): Doc fix.
-2012-11-17 Chong Yidong <cyd@gnu.org>
+2012-11-18 Chong Yidong <cyd@gnu.org>
* emacs-lisp/syntax.el (syntax-propertize-function): Doc fix
(Bug#12810).
-2012-11-17 OKAZAKI Tetsurou <okazaki.tetsurou@gmail.com> (tiny change)
+2012-11-18 OKAZAKI Tetsurou <okazaki.tetsurou@gmail.com> (tiny change)
* vc/vc-svn.el (vc-svn-merge-news): Properly parse the merge
response when the target file is in a subdirectory (Bug#12757).
-2012-11-17 Chong Yidong <cyd@gnu.org>
+2012-11-18 Chong Yidong <cyd@gnu.org>
* filecache.el (file-cache-add-file-list): Doc fix (Bug#12694).
-2012-11-17 Glenn Morris <rgm@gnu.org>
+2012-11-18 Glenn Morris <rgm@gnu.org>
* woman.el (woman-non-underline-faces):
* emacs-lisp/cl-lib.el (face-underline-p):
* subr.el (with-output-to-temp-buffer):
Add doc xref to with-temp-buffer-window.
+2012-11-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * woman.el (woman-non-underline-faces): Use `set-face-underline'.
+ * calc/calc.el (math-format-date-cache): Declare.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * calc/calc-forms.el (math-julian-date-beginning)
+ (math-julian-date-beginning-int): Implement [new date numbering].
+
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * descr-text.el (quail-find-key):
+ * dired.el (desktop-file-name):
+ * dirtrack.el (shell-prefixed-directory-name, shell-process-cd):
+ * generic-x.el (comint-mode, comint-exec):
+ * image-dired.el (widget-forward):
+ * info.el (speedbar-add-expansion-list, speedbar-center-buffer-smartly)
+ (speedbar-change-expand-button-char)
+ (speedbar-change-initial-expansion-list, speedbar-delete-subblock)
+ (speedbar-make-specialized-keymap, speedbar-make-tag-line):
+ * printing.el (easy-menu-add-item, easy-menu-remove-item)
+ (widget-field-action, widget-value-set):
+ * speedbar.el (imenu--make-index-alist):
+ * term.el (ring-empty-p, ring-ref, ring-insert-at-beginning)
+ (ring-length, ring-insert):
+ * vcursor.el (compare-windows-skip-whitespace):
+ * woman.el (dired-get-filename):
+ Declare functions.
+
+ * term/w32-win.el (cygwin-convert-path-from-windows): Fix declaration.
+
+2012-11-17 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-gregorian-switch): New variable.
+
+ * calc/calc-forms.el (math-day-in-year, math-dt-before-p)
+ (math-absolute-from-gregorian-dt, math-absolute-from-julian-dt)
+ (math-date-to-julian-dt, math-date-to-gregorian-dt): New functions.
+ (math-leap-year-p): Add option to distinguish between Julian
+ and Gregorian calendars.
+ (math-day-number): Use `math-day-in-year' to do the computations.
+ (math-absolute-from-dt): Rename from `math-absolute-from-date'.
+ Use `math-absolute-from-gregorian' and `math-absolute-from-julian'
+ to do the computations.
+ (math-date-to-dt): Use `math-date-to-julian-dt' and
+ `math-date-to-gregorian-dt' to do the computations.
+ (calcFunc-weekday, math-format-date-part): Use the new version of
+ the DATE to determine the weekday.
+ (calcFunc-newmonth, calcFunc-newyear): Use `calc-gregorian-switch'
+ when necessary.
+
+2012-11-17 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (w32-handle-dropped-file): Use 'file://' only on
+ Cygwin; otherwise use 'file:'. (Bug#12914)
+ (cygwin-convert-path-from-windows): Declare, to avoid
+ byte-compiler warnings.
+
+2012-11-17 Andreas Politz <politza@fh-trier.de>
+
+ * ibuffer.el (ibuffer-mark-forward, ibuffer-unmark-forward)
+ (ibuffer-unmark-backward, ibuffer-mark-interactive): Support plain
+ prefix and negative numeric prefix args (Bug#12795).
+
+2012-11-17 Stephen Berman <stephen.berman@gmx.net>
+
+ * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1):
+ Don't signal an error with a score that is too low to add to the
+ list of top scores. (Bug#12779)
+
+2012-11-17 Chong Yidong <cyd@gnu.org>
+
+ * help-mode.el (help-xref-interned): End on point-min (Bug#12737).
+
+ * filecache.el (file-cache-add-file): Handle relative file name in
+ the argument (Bug#12694).
+
+2012-11-16 Jürgen Hötzel <juergen@archlinux.org> (tiny change)
+
+ * eshell/em-unix.el (eshell/mkdir): Handle "--parents" (bug#12897).
+
2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+ * emacs-lisp/advice.el (ad-make-advised-definition): Improve last fix.
+
* emacs-lisp/cl-lib.el: Set more meaningful version number.
2012-11-16 Martin Rudalics <rudalics@gmx.at>
* faces.el (face-underline-p): Use face-attribute-specified-or.
-2012-11-15 Juanma Barranquero <lekktu@gmail.com>
+2012-11-16 Juanma Barranquero <lekktu@gmail.com>
* emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes.
-2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring (bug#12895).
-2012-11-15 Glenn Morris <rgm@gnu.org>
+2012-11-16 Glenn Morris <rgm@gnu.org>
* eshell/em-cmpl.el (eshell-pcomplete): New command. (Bug#12838)
(eshell-cmpl-initialize): Bind eshell-pcomplete to TAB, C-i.
* term.el (ansi-term): Don't let C-x escape-char binding
clobber the more standard C-c binding. (Bug#12842)
-2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments
- (bug#12879).
-
-2012-11-14 Glenn Morris <rgm@gnu.org>
-
* subr.el (set-temporary-overlay-map): Doc fix.
-2012-11-13 Martin Rudalics <rudalics@gmx.at>
+2012-11-16 Martin Rudalics <rudalics@gmx.at>
* window.el (record-window-buffer)
(display-buffer-record-window): When copying the markers to
window-point preserve window-point-insertion-type. (Bug#12588)
-2012-11-13 Glenn Morris <rgm@gnu.org>
+2012-11-16 Glenn Morris <rgm@gnu.org>
* emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke):
* net/tramp-gvfs.el (tramp-gvfs-dbus-event-error):
Use new names for hooks rather than obsolete aliases.
-2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-11-15 Daniel Colascione <dancol@dancol.org>
+
+ * term/w32-win.el (w32-handle-dropped-file): Use a "file://"
+ prefix instead of "file:" so that when FILE-NAME begins with "//",
+ as it does when the target file is on a network share, url-handler
+ isn't confused.
+
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-definition-type): Make sure we don't use
+ a preactivated advice from an old advice.el; they're not compatible!
+
+2012-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/nadvice.el (advice--make-interactive-form):
+ Fix string-spec case.
+
+ * emacs-lisp/advice.el (ad-make-advised-definition): Fix undefined case.
+
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: Add buffer-local support to add-function.
+ (advice--buffer-local-function-sample): New var.
+ (advice--set-buffer-local, advice--buffer-local): New functions.
+ (add-function, remove-function): Use them.
+
+2012-11-15 Drew Adams <drew.adams@oracle.com>
+
+ * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717).
+
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against
+ potential binding of print-gensym to t, and prettify (back)quotes in
+ case they appear in args's default values (bug#12884).
+
+2012-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: Add around advice for interactive specs.
+ (advice-eval-interactive-spec): New function.
+ (advice--make-interactive-form): Support around advice (bug#12844).
+
+2012-11-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection
+ more strict. Add docstring.
+ (ruby-expression-expansion-re): Extract from
+ `ruby-match-expression-expansion'.
+ (ruby-syntax-propertize-function): After everything else, search
+ for expansions in string literals, mark their insides as
+ whitespace syntax and save match data for font-lock.
+ (ruby-font-lock-keywords): Use the 2nd group from expression
+ expansion matches.
+ (ruby-match-expression-expansion): Use the match data saved to the
+ text property in ruby-syntax-propertize-function.
+
+2012-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments
+ (bug#12879).
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-move-to-block): Looks for a block
+ start/end keyword a bit harder. Works with different values of N.
+ Add more comments.
+ (ruby-end-of-block): Update accordingly.
+
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * woman.el (woman-file-name): Don't mess with unread-command-events
+ (bug#12861).
+
+ * emacs-lisp/advice.el: Layer on top of nadvice.el.
+ Remove out of date self-require hack.
+ (ad-do-advised-functions): Use simple `dolist'.
+ (ad-advice-name, ad-advice-protected, ad-advice-enabled)
+ (ad-advice-definition): Redefine as functions.
+ (ad-advice-classes): Move before first use.
+ (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition)
+ (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring)
+ (ad--defalias-fset): Remove functions.
+ (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs.
+ (ad-get-orig-definition): Rewrite.
+ (ad-make-advised-definition-docstring): Change base docstring.
+ (ad-real-orig-definition): Rewrite.
+ (ad-map-arglists): Change name of called function.
+ (ad--make-advised-docstring): Redirect `function' from ad-Advice-...
+ (ad-make-advised-definition): Simplify.
+ (ad-assemble-advised-definition): Tweak for new calling context.
+ (ad-activate-advised-definition): Setup ad-Advice-* i.s.o ad-Orig-*.
+ (ad--defalias-fset): Rename from ad-handle-definition. Make it set the
+ function and call ad-activate if needed.
+ (ad-activate, ad-deactivate): Don't call ad-handle-definition any more.
+ (ad-recover): Clear ad-Advice-* instead of ad-Orig-*.
+ (ad-compile-function): Compile ad-Advice-*.
+ (ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove.
+ (ad-start-advice, ad-stop-advice): Remove.
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the
+ period before class method names, not after. Remove handling of
+ one impossible case. Add comments.
+
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el: Remove support for freezing.
+ (ad-make-freeze-docstring, ad-make-freeze-definition): Remove functions.
+ (ad-make-single-advice-docstring, ad-defadvice-flags, defadvice):
+ Remove support for `freeze'.
+
+ * emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to
+ override the default.
+ * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using
+ cl--dotimes/dolist.
+ * subr.el (dolist, dotimes, declare): Redefine them normally, even when
+ `cl' is loaded.
+
+ * emacs-lisp/nadvice.el (advice--normalize): New function, extracted
+ from add-advice.
+ (advice--strip-macro): New function.
+ (advice--defalias-fset): Use them to handle macros.
+ (advice-add): Use them.
+ (advice-member-p): Correctly handle macros.
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Never font-lock the beginning of singleton class as heredoc.
+
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871).
-2012-11-12 Wolfgang Jenkner <wjenkner@inode.at>
+2012-11-13 Wolfgang Jenkner <wjenkner@inode.at>
* ansi-color.el (ansi-color-apply-sequence): Implement SGR codes
- 39 and 49. This fixes bug#12792. Also, treat unimplemented
- parameters as 0, thereby restoring the behavior of revisions prior
- to 2012-08-15T03:33:55Z!monnier@iro.umontreal.ca.
+ 39 and 49 (bug#12792). Also, treat unimplemented parameters as 0,
+ thereby restoring the behavior of revisions prior to 2012-08-15T03:33:55Z!monnier@iro.umontreal.ca.
-2012-11-12 Fabián Ezequiel Gallina <fgallina@cuca>
+2012-11-13 Fabián Ezequiel Gallina <fgallina@cuca>
Fix end-of-defun misbehavior.
* progmodes/python.el (python-nav-beginning-of-defun): Rename from
with new fixed python-nav-{end,beginning}-of-defun. Stop scanning
parent defuns as soon as possible.
-2012-11-12 Glenn Morris <rgm@gnu.org>
+2012-11-13 Glenn Morris <rgm@gnu.org>
* progmodes/flymake.el (flymake-error-bitmap)
(flymake-warning-bitmap, flymake-fringe-indicator-position): Doc fixes.
(flymake-error-bitmap, flymake-warning-bitmap): Fix :types.
-2012-11-12 Dmitry Gutov <dgutov@yandex.ru>
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-move-to-block): When moving
backward, always stop at indentation. Reverts the change from
2012-08-12T22:06:56Z!monnier@iro.umontreal.ca (Bug#12851).
-2012-11-11 Glenn Morris <rgm@gnu.org>
+2012-11-13 Glenn Morris <rgm@gnu.org>
* ibuffer.el (ibuffer-mode-map, ibuffer-mode):
Add ibuffer-filter-by-derived-mode.
* window.el (fit-frame-to-buffer, fit-frame-to-buffer-bottom-margin):
* emacs-lisp/debug.el (debugger-bury-or-kill): Fix :version.
-2012-11-10 Leo Liu <sdl.web@gmail.com>
+2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
- * ido.el (ido-set-matches-1): Fix split-string args to avoid
- performance issue. (Bug#12796)
+ * emacs-lisp/nadvice.el: New package.
+ * subr.el (special-form-p): New function.
+ * emacs-lisp/elp.el: Use lexical-binding and advice-add.
+ (elp-all-instrumented-list): Remove var.
+ (elp-not-profilable): Remove elp-wrapper.
+ (elp-profilable-p): Use autoloadp and special-form-p.
+ (elp--advice-name): New const.
+ (elp-instrument-function): Use advice-add.
+ (elp--instrumented-p): New predicate.
+ (elp-restore-function): Use advice-remove.
+ (elp-restore-all, elp-reset-all): Use mapatoms.
+ (elp-set-master): Use elp--instrumented-p.
+ (elp--make-wrapper): Rename from elp-wrapper, return a function
+ suitable for advice-add. Use cl-inf.
+ (elp-results): Use mapatoms+elp--instrumented-p.
+ * emacs-lisp/debug.el: Use lexical-binding and advice-add.
+ (debug-function-list): Remove var.
+ (debug): Rename arg, and then let-bind it explicitly inside.
+ (debugger-setup-buffer): Rename arg.
+ (debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
+ (debugger-frame-number): Adjust to new debug-on-entry setup.
+ (debug--implement-debug-on-entry): Rename from
+ implement-debug-on-entry, add argument.
+ (debugger-special-form-p): Remove, use special-form-p instead.
+ (debug-on-entry): Use advice-add.
+ (debug--function-list): New function.
+ (cancel-debug-on-entry): Use it, along with advice-remove.
+ (debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
+ (debugger-list-functions): Use debug--function-list instead of
+ debug-function-list.
+ * emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
+ (ad-special-form-p): Remove, use special-form-p instead.
+ (ad-set-advice-info): Use add-function and remove-function.
+ (ad--defalias-fset): Adjust accordingly.
2012-11-10 Glenn Morris <rgm@gnu.org>
+ * mail/emacsbug.el (report-emacs-bug-tracker-url)
+ (report-emacs-bug-bug-alist, report-emacs-bug-choice-widget)
+ (report-emacs-bug-create-existing-bugs-buffer)
+ (report-emacs-bug-parse-query-results)
+ (report-emacs-bug-query-existing-bugs): Remove. (Bug#7449)
+
* term.el (term-default-fg-color, term-default-bg-color):
Make obsolete, rather than just saying "deprecated" in the doc.
(term-default-fg-color, term-default-bg-color, term-ansi-reset):
Update all users.
-2012-11-09 Jan Djärv <jan.h.d@swipnet.se>
-
- * server.el (server-create-window-system-frame): Improve comment.
-
-2012-11-08 Jan Djärv <jan.h.d@swipnet.se>
+2012-11-10 Jan Djärv <jan.h.d@swipnet.se>
* server.el (server-create-window-system-frame): Handle Nextstep
specially (Bug#12780).
-2012-11-08 Glenn Morris <rgm@gnu.org>
+2012-11-10 Glenn Morris <rgm@gnu.org>
* mail/emacsbug.el (report-emacs-bug-query-existing-bugs):
Unautoload, and make obsolete. (Bug#7449)
-2012-11-08 Chong Yidong <cyd@gnu.org>
+2012-11-10 Chong Yidong <cyd@gnu.org>
* vc/diff-mode.el (diff-delete-trailing-whitespace): Rewrite, and
rename from diff-remove-trailing-whitespace (Bug#12831).
-2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/advice.el: Require `cl-lib' at run-time to fix
miscompilation of trace.el.
-2012-11-08 Glenn Morris <rgm@gnu.org>
+2012-11-10 Glenn Morris <rgm@gnu.org>
* vc/diff-mode.el (diff-remove-trailing-whitespace): Doc fix.
-2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/gv.el (gv-define-simple-setter): Fix last change
(bug#12812).
-2012-11-07 Chong Yidong <cyd@gnu.org>
+2012-11-10 Chong Yidong <cyd@gnu.org>
* minibuf-eldef.el (minibuffer-eldef-shorten-default): Convert to
a defcustom with an appropriate :set function.
(minibuffer-default--in-prompt-regexps): New function.
-2012-11-07 Glenn Morris <rgm@gnu.org>
+2012-11-10 Glenn Morris <rgm@gnu.org>
* emacs-lisp/cl.el (define-setf-expander, defsetf)
(define-modify-macro): Doc fixes.
* emacs-lisp/gv.el (gv-letplace): Fix doc typo.
(gv-define-simple-setter): Update doc of `fix-return'.
-2012-11-07 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/gv.el (gv-define-simple-setter): Don't evaluate `val'
twice when `fix-return' is set (bug#12813).
* emacs-lisp/cl.el (defsetf): Pass the third arg to
gv-define-simple-setter (bug#12812).
-2012-11-06 Stefan Monnier <monnier@iro.umontreal.ca>
-
* woman.el (woman-decode-region): Disable adaptive-fill when rendering
(bug#12756).
-2012-11-06 Glenn Morris <rgm@gnu.org>
+2012-11-10 Glenn Morris <rgm@gnu.org>
* emacs-lisp/gv.el (gv-define-setter): Fix doc typo.
-2012-11-05 Glenn Morris <rgm@gnu.org>
-
* emacs-lisp/cl-extra.el (cl-prettyexpand):
* emacs-lisp/cl-lib.el (cl-proclaim, cl-declaim):
* emacs-lisp/cl-macs.el (cl-destructuring-bind, cl-locally)
* emacs-lisp/cl-extra.el (cl-maplist, cl-mapcan): Doc fix.
+2012-11-10 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-set-matches-1): Improve flex matching performance by
+ removing backtracking in the regexp (suggested by Stefan). (Bug#12796)
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function.
+ (ad--defalias-fset): New function.
+ (ad-safe-fset): Remove.
+ (ad-make-freeze-definition): Use cl-letf*.
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (dolist): Don't bind VAR in RESULT.
+
+ * emacs-lisp/advice.el: Miscellaneous cleanup. Use lexical-binding.
+ (fset, documentation): Don't save real def since we don't advise.
+ (ad-do-advised-functions): Remove problematic `result-form'.
+ (ad-safe-fset): `ad-real-fset' => `fset'.
+ (ad-read-advised-function): Don't assume that ad-do-advised-functions
+ uses CL's dolist internally.
+ (ad-arglist): Remove unused arg `name'.
+ (ad-docstring, ad-make-advised-docstring):
+ `ad-real-documentation' => `documentation'.
+ (warning-suppress-types): Declare.
+ (ad-set-arguments): Simple CSE.
+ (ad-recover-normality): Sanity check.
+
+ * emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Don't turn
+ (funcall '(lambda ..) ..) into ((lambda ..) ..).
+
+2012-11-09 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el: symbol to coordinate mapping is made by symbol property
+ `ses-cell'. This means that the same mapping is done for all SES
+ sheets. That is good enough for cells with standard A1 names, but
+ not for named cell. So a hash map is added for the latter.
+ (defconst ses-localvars): Add local variable ses--named-cell-hashmap
+ (ses-sym-rowcol): Use hashmap for named cell.
+ (ses-is-cell-sym-p): New defun.
+ (ses-decode-cell-symbol): New defun.
+ (ses-create-cell-variable): Add cell to hashmap when name is not
+ A1-like.
+ (ses-rename-cell): Check that cell new name is not already in
+ spreadsheet with the use of ses-is-cell-sym-p
+ (ses-rename-cell): Use hash map for named cells, but accept also
+ renaming back to A1-like.
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el: Use new dynamic docstrings.
+ (ad-make-advised-definition-docstring, ad-advised-definition-p):
+ Use dynamic-docstring-function instead of ad-advice-info.
+ (ad--make-advised-docstring): New function extracted from
+ ad-make-advised-docstring.
+ (ad-make-advised-docstring): Use it.
+ * progmodes/sql.el (sql--make-help-docstring): New function, extracted
+ from sql-help.
+ (sql-help): Use it with dynamic-docstring-function.
+
+ * env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap).
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (hack-one-local-variable--obsolete): New function.
+ (hack-one-local-variable): Use it for obsolete settings.
+
+ * subr.el (locate-user-emacs-file): If both old and new name exist, use
+ the new name.
+
+ * progmodes/js.el (js--filling-paragraph): New var.
+ (c-forward-sws, c-backward-sws, c-beginning-of-macro): Advise.
+ (js-c-fill-paragraph): Prefer advice to cl-letf so the rebinding is
+ less sneaky.
+
+2012-11-08 Julien Danjou <julien@danjou.info>
+
+ * progmodes/ruby-mode.el (auto-mode-alist): Add Rakefile in
+ `auto-mode-alist' (Bug#12835).
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl-prettify-symbols): New defcustom.
+ (perl--prettify-symbols-alist): New const.
+ (perl--font-lock-compose-symbol, perl--font-lock-symbols-keywords):
+ New functions.
+ (perl-font-lock-keywords-2): Use them.
+ (perl-electric-noindent-p): New function.
+ (perl-mode): Use it to set up electric-indent-mode.
+ (perl-electric-terminator, perl-indent-command): Mark obsolete.
+ (perl-mode-map): Remove bindings for them.
+ (perl-imenu-generic-expression, perl-outline-level):
+ Match functions&packages in column>0.
+
+ * env.el (env--substitute-vars-regexp): New const.
+ (substitute-env-vars): Use it. Add `only-defined' arg.
+ * net/tramp.el (tramp-replace-environment-variables): Use it.
+
+ * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
+ Byte-compile *before* eval in eval-and-compile.
+ (byte-compile-log-warning): Remove redundant inhibit-read-only.
+ (byte-compile-file-form-autoload): Don't hide actual definition.
+ (byte-compile-maybe-guarded): Accept `functionp' as well.
+
+ * emacs-lisp/gv.el (gv-ref, gv-deref): New function and macro.
+
+2012-11-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (notifications-get-server-information-method):
+ New defconst.
+ (notifications-get-capabilities): Fix docstring.
+ (notifications-get-server-information): New defun.
+
+2012-11-06 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-region): Standard re-indent for better
+ readability.
+
+ * textmodes/ispell.el: Experimental support for support debugging.
+ (ispell-create-debug-buffer): Create a `ispell-debug-buffer' debug
+ buffer for ispell.
+ (ispell-print-if-debug): New function to print stuff to
+ `ispell-debug-buffer' if debugging is enabled.
+ (ispell-region, ispell-process-line): Use `ispell-print-if-debug' to
+ show some debugging info.
+ (ispell-buffer-with-debug): New function that creates a debugging
+ buffer and calls `ispell-buffer' with debugging enabled.
+
+ * textmodes/ispell.el (ispell-region): Do not prefix sent string by
+ comment in autoconf mode. (Bug#12768)
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * emacs-lisp/byte-opt.el (toplevel): Add compare-window-configurations,
+ frame-first-window, frame-root-window, frame-selected-window,
+ minibuffer-selected-window, minibuffer-window,
+ window-absolute-pixel-edges, window-at, window-body-height,
+ window-body-width, window-display-table, window-combination-limit,
+ window-frame, window-fringes, window-inside-absolute-pixel-edges,
+ window-inside-edges, window-inside-pixel-edges, window-left-child,
+ window-left-column, window-margins, window-next-buffers,
+ window-next-sibling, window-new-normal, window-new-total,
+ window-normal-size, window-parameter, window-parameters, window-parent,
+ window-pixel-edges, window-point, window-prev-buffers,
+ window-prev-sibling, window-redisplay-end-trigger, window-scroll-bars,
+ window-start, window-text-height, window-top-child, window-top-line,
+ window-total-height, window-total-width and window-use-time to the list
+ of functions without side-effects.
+ (toplevel): Add window-valid-p to the list of error-free functions
+ without side-effects.
+
+2012-11-05 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-program-name):
+ Update spellchecker parameters when customized.
+
+2012-11-04 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-svn.el (vc-svn-state-heuristic): Avoid calling svn. (Bug#7850)
+
+2012-11-04 Chong Yidong <cyd@gnu.org>
+
+ * bookmark.el (bookmark-bmenu-switch-other-window): Avoid binding
+ same-window-* variables.
+
+2012-11-04 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-help-for-help, isearch-describe-bindings)
+ (isearch-describe-key, isearch-describe-mode): Use a display
+ action instead of binding same-window-* variables (Bug#10040).
+
2012-11-03 Glenn Morris <rgm@gnu.org>
* emacs-lisp/cl-macs.el (cl-parse-loop-clause):
* window.el (switch-to-visible-buffer)
(switch-to-buffer-preserve-window-point): Fix doc-strings.
+2012-11-03 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-lib.el (cl--random-time):
+ Rename from cl-random-time. (Bug#12773)
+ (cl--gensym-counter, cl--random-state): Update callers.
+ * emacs-lisp/cl-extra.el (cl-make-random-state): Update callers.
+
+2012-11-03 Chong Yidong <cyd@gnu.org>
+
+ * cus-start.el: Make cursor-type customizable (Bug#11633).
+
+2012-11-02 Glenn Morris <rgm@gnu.org>
+
+ * filecache.el: No need to load find-lisp when compiling.
+ (find-lisp-find-files): Autoload it.
+ (file-cache-add-directory-recursively): Don't require find-lisp.
+
+ * image.el (image-type-from-file-name): Trivial simplification.
+
+ * emacs-lisp/bytecomp.el (byte-compile-eval):
+ Decouple "noruntime" and "cl-functions" warnings.
+
2012-11-01 Stephen Berman <stephen.berman@gmx.net>
* play/gomoku.el (gomoku-display-statistics): Update mode line
2012-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuffer.el (minibuffer-force-complete): Make the next completion use
- the same completion-field (bug@12221).
+ the same completion-field (bug#12221).
2012-10-19 Martin Rudalics <rudalics@gmx.at>
The current window remains selected."
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark))
- (pop-up-windows t)
- same-window-buffer-names
- same-window-regexps)
- (bookmark--jump-via bookmark 'display-buffer)))
+ (fun (lambda (b) (display-buffer b t))))
+ (bookmark--jump-via bookmark fun)))
(defun bookmark-bmenu-other-window-with-mouse (event)
"Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
;;; Some of these functions are adapted from Edward Reingold's "calendar.el".
;;; These versions are rewritten to use arbitrary-size integers.
-;;; The Julian calendar is used up to 9/2/1752, after which the Gregorian
-;;; calendar is used; the first day after 9/2/1752 is 9/14/1752.
;;; A numerical date is the number of days since midnight on
-;;; the morning of January 1, 1 A.D. If the date is a non-integer,
-;;; it represents a specific date and time.
+;;; the morning of December 31, 1 B.C. Emacs's calendar refers to such
+;;; a date as an absolute date, some function names also use that
+;;; terminology. If the date is a non-integer, it represents a specific date and time.
;;; A "dt" is a list of the form, (year month day), corresponding to
;;; an integer code, or (year month day hour minute second), corresponding
;;; to a non-integer code.
+(defun math-date-to-gregorian-dt (date)
+ "Return the day (YEAR MONTH DAY) in the Gregorian calendar.
+DATE is the number of days since December 31, -1 in the Gregorian calendar."
+ (let* ((month 1)
+ day
+ (year (math-quotient (math-add date (if (Math-lessp date 711859)
+ 365 ; for speed, we take
+ -108)) ; >1950 as a special case
+ (if (math-negp date) 366 365)))
+ ; this result may be an overestimate
+ temp)
+ (while (Math-lessp date (setq temp (math-absolute-from-gregorian-dt year 1 1)))
+ (setq year (math-add year -1)))
+ (if (eq year 0) (setq year -1))
+ (setq date (1+ (math-sub date temp)))
+ (setq temp
+ (if (math-leap-year-p year)
+ [1 32 61 92 122 153 183 214 245 275 306 336 999]
+ [1 32 60 91 121 152 182 213 244 274 305 335 999]))
+ (while (>= date (aref temp month))
+ (setq month (1+ month)))
+ (setq day (1+ (- date (aref temp (1- month)))))
+ (list year month day)))
+
+(defun math-date-to-julian-dt (date)
+ "Return the day (YEAR MONTH DAY) in the Julian calendar.
+DATE is the number of days since December 31, -1 in the Gregorian calendar."
+ (let* ((month 1)
+ day
+ (year (math-quotient (math-add date (if (Math-lessp date 711859)
+ 365 ; for speed, we take
+ -108)) ; >1950 as a special case
+ (if (math-negp date) 366 365)))
+ ; this result may be an overestimate
+ temp)
+ (while (Math-lessp date (setq temp (math-absolute-from-julian-dt year 1 1)))
+ (setq year (math-add year -1)))
+ (if (eq year 0) (setq year -1))
+ (setq date (1+ (math-sub date temp)))
+ (setq temp
+ (if (math-leap-year-p year t)
+ [1 32 61 92 122 153 183 214 245 275 306 336 999]
+ [1 32 60 91 121 152 182 213 244 274 305 335 999]))
+ (while (>= date (aref temp month))
+ (setq month (1+ month)))
+ (setq day (1+ (- date (aref temp (1- month)))))
+ (list year month day)))
+
(defun math-date-to-dt (value)
+ "Return the day and time of VALUE.
+The integer part of VALUE is the number of days since Dec 31, -1
+in the Gregorian calendar and the remaining part determines the time."
(if (eq (car-safe value) 'date)
(setq value (nth 1 value)))
(or (math-realp value)
(let* ((parts (math-date-parts value))
(date (car parts))
(time (nth 1 parts))
- (month 1)
- day
- (year (math-quotient (math-add date (if (Math-lessp date 711859)
- 365 ; for speed, we take
- -108)) ; >1950 as a special case
- (if (math-negp value) 366 365)))
- ; this result may be an overestimate
- temp)
- (while (Math-lessp date (setq temp (math-absolute-from-date year 1 1)))
- (setq year (math-add year -1)))
- (if (eq year 0) (setq year -1))
- (setq date (1+ (math-sub date temp)))
- (and (eq year 1752) (>= date 247)
- (setq date (+ date 11)))
- (setq temp (if (math-leap-year-p year)
- [1 32 61 92 122 153 183 214 245 275 306 336 999]
- [1 32 60 91 121 152 182 213 244 274 305 335 999]))
- (while (>= date (aref temp month))
- (setq month (1+ month)))
- (setq day (1+ (- date (aref temp (1- month)))))
+ (dt (if (and calc-gregorian-switch
+ (Math-lessp value
+ (or
+ (nth 3 calc-gregorian-switch)
+ (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))
+))
+ (math-date-to-julian-dt value)
+ (math-date-to-gregorian-dt value))))
(if (math-integerp value)
- (list year month day)
- (list year month day
- (/ time 3600)
- (% (/ time 60) 60)
- (math-add (% time 60) (nth 2 parts))))))
+ dt
+ (append dt
+ (list
+ (/ time 3600)
+ (% (/ time 60) 60)
+ (math-add (% time 60) (nth 2 parts)))))))
(defun math-dt-to-date (dt)
(or (integerp (nth 1 dt))
(math-reject-arg (nth 2 dt) 'fixnump))
(if (or (< (nth 2 dt) 1) (> (nth 2 dt) 31))
(math-reject-arg (nth 2 dt) "Day value is out of range"))
- (let ((date (math-absolute-from-date (car dt) (nth 1 dt) (nth 2 dt))))
+ (let ((date (math-absolute-from-dt (car dt) (nth 1 dt) (nth 2 dt))))
(if (nth 3 dt)
(math-add (math-float date)
(math-div (math-add (+ (* (nth 3 dt) 3600)
(defun math-this-year ()
(nth 5 (decode-time)))
-(defun math-leap-year-p (year)
- (if (Math-lessp year 1752)
+(defun math-leap-year-p (year &optional julian)
+ "Non-nil if YEAR is a leap year.
+If JULIAN is non-nil, then use the criterion for leap years
+in the Julian calendar, otherwise use the criterion in the
+Gregorian calendar."
+ (if julian
(if (math-negp year)
(= (math-imod (math-neg year) 4) 1)
(= (math-imod year 4) 0))
29
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
-(defun math-day-number (year month day)
+(defun math-day-in-year (year month day &optional julian)
+ "Return the number of days of the year up to YEAR MONTH DAY.
+The count includes the given date.
+If JULIAN is non-nil, use the Julian calendar, otherwise
+use the Gregorian calendar."
(let ((day-of-year (+ day (* 31 (1- month)))))
(if (> month 2)
(progn
(setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
- (if (math-leap-year-p year)
+ (if (math-leap-year-p year julian)
(setq day-of-year (1+ day-of-year)))))
- (and (eq year 1752)
- (or (> month 9)
- (and (= month 9) (>= day 14)))
- (setq day-of-year (- day-of-year 11)))
day-of-year))
-(defun math-absolute-from-date (year month day)
+(defun math-day-number (year month day)
+ "Return the number of days of the year up to YEAR MONTH DAY.
+The count includes the given date."
+ (if calc-gregorian-switch
+ (cond ((eq year (nth 0 calc-gregorian-switch))
+ (1+
+ (- (math-absolute-from-dt year month day)
+ (math-absolute-from-dt year 1 1))))
+ ((Math-lessp year (nth 0 calc-gregorian-switch))
+ (math-day-in-year year month day t))
+ (t
+ (math-day-in-year year month day)))
+ (math-day-in-year year month day)))
+
+(defun math-dt-before-p (dt1 dt2)
+ "Non-nil if DT1 occurs before DT2.
+A DT is a list of the form (YEAR MONTH DAY)."
+ (or (Math-lessp (nth 0 dt1) (nth 0 dt2))
+ (and (equal (nth 0 dt1) (nth 0 dt2))
+ (or (< (nth 1 dt1) (nth 1 dt2))
+ (and (= (nth 1 dt1) (nth 1 dt2))
+ (< (nth 2 dt1) (nth 2 dt2)))))))
+
+(defun math-absolute-from-gregorian-dt (year month day)
+ "Return the DATE of the day given by the Gregorian day YEAR MONTH DAY.
+Recall that DATE is the number of days since December 31, -1
+in the Gregorian calendar."
(if (eq year 0) (setq year -1))
(let ((yearm1 (math-sub year 1)))
- (math-sub (math-add (math-day-number year month day)
- (math-add (math-mul 365 yearm1)
- (if (math-posp year)
- (math-quotient yearm1 4)
- (math-sub 365
- (math-quotient (math-sub 3 year)
- 4)))))
- (if (or (Math-lessp year 1753)
- (and (eq year 1752) (<= month 9)))
- 1
- (let ((correction (math-mul (math-quotient yearm1 100) 3)))
- (let ((res (math-idivmod correction 4)))
- (math-add (if (= (cdr res) 0)
- -1
- 0)
- (car res))))))))
-
+ (math-sub
+ ;; Add the number of days of the year and the numbers of days
+ ;; in the previous years (leap year days to be added separately)
+ (math-add (math-day-in-year year month day)
+ (math-add (math-mul 365 yearm1)
+ ;; Add the number of Julian leap years
+ (if (math-posp year)
+ (math-quotient yearm1 4)
+ (math-sub 365
+ (math-quotient (math-sub 3 year)
+ 4)))))
+ ;; Subtract the number of Julian leap years which are not
+ ;; Gregorian leap years. In C=4N+r centuries, there will
+ ;; be 3N+r of these days. The following will compute
+ ;; 3N+r.
+ (let* ((correction (math-mul (math-quotient yearm1 100) 3))
+ (res (math-idivmod correction 4)))
+ (math-add (if (= (cdr res) 0)
+ 0
+ 1)
+ (car res))))))
+
+(defun math-absolute-from-julian-dt (year month day)
+ "Return the DATE of the day given by the Julian day YEAR MONTH DAY.
+Recall that DATE is the number of days since December 31, -1
+in the Gregorian calendar."
+ (if (eq year 0) (setq year -1))
+ (let ((yearm1 (math-sub year 1)))
+ (math-sub
+ ;; Add the number of days of the year and the numbers of days
+ ;; in the previous years (leap year days to be added separately)
+ (math-add (math-day-in-year year month day)
+ (math-add (math-mul 365 yearm1)
+ ;; Add the number of Julian leap years
+ (if (math-posp year)
+ (math-quotient yearm1 4)
+ (math-sub 365
+ (math-quotient (math-sub 3 year)
+ 4)))))
+ ;; Adjustment, since January 1, 1 (Julian) is absolute day -1
+ 2)))
+
+;; calc-gregorian-switch is a customizable variable defined in calc.el
+(defvar calc-gregorian-switch)
+
+
+(defun math-absolute-from-dt (year month day)
+ "Return the DATE of the day given by the day YEAR MONTH DAY.
+Recall that DATE is the number of days since December 31, -1
+in the Gregorian calendar."
+ (if (and calc-gregorian-switch
+ ;; The next few lines determine if the given date
+ ;; occurs before the switch to the Gregorian calendar.
+ (math-dt-before-p (list year month day) calc-gregorian-switch))
+ (math-absolute-from-julian-dt year month day)
+ (math-absolute-from-gregorian-dt year month day)))
;;; It is safe to redefine these in your init file to use a different
;;; language.
(setcdr math-fd-dt nil))
fmt))))
-(defconst math-julian-date-beginning '(float 17214235 -1)
- "The beginning of the Julian calendar,
-as measured in the number of days before January 1 of the year 1AD.")
+(defconst math-julian-date-beginning '(float 17214225 -1)
+ "The beginning of the Julian date calendar,
+as measured in the number of days before December 31, 1 BC (Gregorian).")
-(defconst math-julian-date-beginning-int 1721424
- "The beginning of the Julian calendar,
-as measured in the integer number of days before January 1 of the year 1AD.")
+(defconst math-julian-date-beginning-int 1721423
+ "The beginning of the Julian date calendar,
+as measured in the integer number of days before December 31, 1 BC (Gregorian).")
(defun math-format-date-part (x)
(cond ((stringp x)
math-fd-year (car math-fd-dt)
math-fd-month (nth 1 math-fd-dt)
math-fd-day (nth 2 math-fd-dt)
- math-fd-weekday (math-mod
- (math-add (math-floor math-fd-date) 6) 7)
+ math-fd-weekday (math-mod (math-floor math-fd-date) 7)
math-fd-hour (nth 3 math-fd-dt)
math-fd-minute (nth 4 math-fd-dt)
math-fd-second (nth 5 math-fd-dt))
(setq date (nth 1 date)))
(or (math-realp date)
(math-reject-arg date 'datep))
- (math-mod (math-add (math-floor date) 6) 7))
+ (math-mod (math-floor date) 7))
(defun calcFunc-yearday (date)
(let ((dt (math-date-to-dt date)))
0)))
(rounded-abs-date
(+
- (calendar-absolute-from-gregorian
+ (calendar-absolute-from-gregorian
(list (nth 1 dt) (nth 2 dt) (nth 0 dt)))
(/ (round (* 60 time)) 60.0 24.0))))
(if (dst-in-effect rounded-abs-date)
(and (math-messy-integerp day) (setq day (math-trunc day)))
(or (integerp day) (math-reject-arg day 'fixnump))
(and (or (< day 0) (> day 31)) (math-reject-arg day 'range))
- (let ((dt (math-date-to-dt date)))
- (if (or (= day 0) (> day (math-days-in-month (car dt) (nth 1 dt))))
- (setq day (math-days-in-month (car dt) (nth 1 dt))))
- (and (eq (car dt) 1752) (= (nth 1 dt) 9)
- (if (>= day 14) (setq day (- day 11))))
- (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1))
- (1- day)))))
+ (let* ((dt (math-date-to-dt date))
+ (dim (math-days-in-month (car dt) (nth 1 dt)))
+ (julian (if calc-gregorian-switch
+ (math-date-to-dt (math-sub
+ (or (nth 3 calc-gregorian-switch)
+ (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))
+ 1)))))
+ (if (or (= day 0) (> day dim))
+ (setq day (1- dim))
+ (setq day (1- day)))
+ ;; Adjust if this occurs near the switch to the Gregorian calendar
+ (if calc-gregorian-switch
+ (cond
+ ((and (math-dt-before-p (list (car dt) (nth 1 dt) 1) calc-gregorian-switch)
+ (math-dt-before-p julian (list (car dt) (nth 1 dt) 1)))
+ ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the month
+ (list 'date
+ (math-dt-to-date (list (car calc-gregorian-switch)
+ (nth 1 calc-gregorian-switch)
+ (if (> (+ (nth 2 calc-gregorian-switch) day) dim)
+ dim
+ (+ (nth 2 calc-gregorian-switch) day))))))
+ ((and (eq (car dt) (car calc-gregorian-switch))
+ (= (nth 1 dt) (nth 1 calc-gregorian-switch)))
+ ;; In this case, the switch to the Gregorian calendar occurs in the given month
+ (if (< (+ (nth 2 julian) day) (nth 2 calc-gregorian-switch))
+ ;; If the DAYth day occurs before the switch, use it
+ (list 'date (math-dt-to-date (list (car dt) (nth 1 dt) (1+ day))))
+ ;; Otherwise do some computations
+ (let ((tm (+ day (- (nth 2 calc-gregorian-switch) (nth 2 julian)))))
+ (list 'date (math-dt-to-date
+ (list (car dt)
+ (nth 1 dt)
+ ;;
+ (if (> tm dim) dim tm)))))))
+ ((and (eq (car dt) (car julian))
+ (= (nth 1 dt) (nth 1 julian)))
+ ;; In this case, the current month is truncated because of the switch
+ ;; to the Gregorian calendar
+ (list 'date (math-dt-to-date
+ (list (car dt)
+ (nth 1 dt)
+ (if (>= day (nth 2 julian))
+ (nth 2 julian)
+ (1+ day))))))
+ (t
+ ;; The default
+ (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day))))
+ (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day)))))
(defun calcFunc-newyear (date &optional day)
+ (if (eq (car-safe date) 'date) (setq date (nth 1 date)))
(or day (setq day 1))
(and (math-messy-integerp day) (setq day (math-trunc day)))
(or (integerp day) (math-reject-arg day 'fixnump))
- (let ((dt (math-date-to-dt date)))
+ (let* ((dt (math-date-to-dt date))
+ (gregbeg (if calc-gregorian-switch
+ (or (nth 3 calc-gregorian-switch)
+ (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))))
+ (julianend (if calc-gregorian-switch (math-sub gregbeg 1)))
+ (julian (if calc-gregorian-switch
+ (math-date-to-dt julianend))))
(if (and (>= day 0) (<= day 366))
- (let ((max (if (eq (car dt) 1752) 355
- (if (math-leap-year-p (car dt)) 366 365))))
+ (let ((max (if (math-leap-year-p (car dt)) 366 365)))
(if (or (= day 0) (> day max)) (setq day max))
- (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
- (1- day))))
+ (if calc-gregorian-switch
+ ;; Now to break this down into cases
+ (cond
+ ((and (math-dt-before-p (list (car dt) 1 1) calc-gregorian-switch)
+ (math-dt-before-p julian (list (car dt) 1 1)))
+ ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the year
+ (list 'date (math-min (math-add gregbeg (1- day))
+ (math-dt-to-date (list (car calc-gregorian-switch) 12 31)))))
+ ((eq (car dt) (car julian))
+ ;; In this case, the switch to the Gregorian calendar occurs in the given year
+ (if (Math-lessp (car julian) (car calc-gregorian-switch))
+ ;; Here, the last Julian day is the last day of the year.
+ (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))
+ julianend))
+ ;; Otherwise, just make sure the date doesn't go past the end of the year
+ (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))
+ (math-dt-to-date (list (car dt) 12 31))))))
+ (t
+ (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
+ (1- day)))))
+ (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
+ (1- day)))))
(if (and (>= day -12) (<= day -1))
- (list 'date (math-dt-to-date (list (car dt) (- day) 1)))
- (math-reject-arg day 'range)))))
+ (if (and calc-gregorian-switch
+ (math-dt-before-p (list (car dt) (- day) 1) calc-gregorian-switch)
+ (math-dt-before-p julian (list (car dt) (- day) 1)))
+ (list 'date gregbeg)
+ (list 'date (math-dt-to-date (list (car dt) (- day) 1))))
+ (math-reject-arg day 'range)))))
(defun calcFunc-incmonth (date &optional step)
(or step (setq step 1))
:type 'string
:group 'calc)
+(defvar math-format-date-cache) ; calc-forms.el
+
+;; Dates that are built-in options for `calc-gregorian-switch' should be
+;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed.
+(defcustom calc-gregorian-switch nil
+ "The first day the Gregorian calendar is used by Calc's date forms.
+This is `nil' (the default) if the Gregorian calendar is the only one used.
+Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use
+the Gregorian calendar; Calc will use the Julian calendar for earlier dates.
+The dates in which different regions of the world began to use the
+Gregorian calendar vary quite a bit, even within a single country.
+If you want Calc's date forms to switch between the Julian and
+Gregorian calendar, you can specify the date or choose from several
+common choices. Some of these choices should be taken with a grain
+of salt; for example different parts of France changed calendars at
+different times, and Sweden's change to the Gregorian calendar was
+complicated. Also, the boundaries of the countries were different at
+the times of the calendar changes than they are now.
+The Vatican decided that the Gregorian calendar should take effect
+on 15 October 1582 (Gregorian), and many Catholic countries made
+the change then. Great Britian and its colonies had the Gregorian
+calendar take effect on 14 September 1752 (Gregorian); this includes
+the United States."
+ :group 'calc
+ :version "24.4"
+ :type '(choice (const :tag "Always use the Gregorian calendar" nil)
+ (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797))
+ (const :tag "Vatican (1582 10 15)" (1582 10 15 577736))
+ (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195))
+ (const :tag "Denmark (1700 3 1)" (1700 3 1 620607))
+ (const :tag "France (1582 12 20)" (1582 12 20 577802))
+ (const :tag "Hungary (1587 11 1)" (1587 11 1 579579))
+ (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807))
+ (const :tag "Romania (1919 4 14)" (1919 4 14 700638))
+ (const :tag "Russia (1918 2 14)" (1918 2 14 700214))
+ (const :tag "Sweden (1753 3 1)" (1753 3 1 639965))
+ (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200))
+ (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924))
+ (list :tag "(YEAR MONTH DAY)"
+ (integer :tag "Year")
+ (integer :tag "Month (integer)")
+ (integer :tag "Day")))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (setq math-format-date-cache nil)))
+
(defface calc-nonselected-face
'((t :inherit shadow
:slant italic))
-2012-11-14 David Engster <deng@randomsample.de>
+2012-11-16 David Engster <deng@randomsample.de>
* semantic/symref/list.el (semantic-symref-symbol): Use
`semantic-complete-read-tag-project' instead of
* semantic/fw.el (semantic-find-file-noselect): Always set
`enable-local-variables' to `:safe' when loading files.
-2012-11-13 Glenn Morris <rgm@gnu.org>
+2012-11-16 Glenn Morris <rgm@gnu.org>
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
* semantic/util.el (semantic-describe-buffer):
(semantic-default-c-setup):
Use new names for hooks rather than obsolete aliases.
-2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
* semantic/mru-bookmark.el (semantic-mru-bookmark-mode):
* semantic/grammar.el (semantic-grammar-mode):
(semantic-show-parser-state-mode): Avoid obsolete name
semantic-edits-new-change-hooks (bug#12869).
-2012-11-10 Glenn Morris <rgm@gnu.org>
+2012-11-13 Glenn Morris <rgm@gnu.org>
* srecode/srt-mode.el (srecode-template-mode):
Don't change global values of comment-start, comment-end. (Bug#12781)
(gc-cons-percentage alloc float)
(garbage-collection-messages alloc boolean)
;; buffer.c
+ (cursor-type
+ display
+ (choice
+ (const :tag "Frame default" t)
+ (const :tag "Filled box" box)
+ (const :tag "Hollow cursor" hollow)
+ (const :tag "Vertical bar" bar)
+ (cons :tag "Vertical bar with specified width"
+ (const bar) integer)
+ (const :tag "Horizontal bar" hbar)
+ (cons :tag "Horizontal bar with specified width"
+ (const hbar) integer)
+ (const :tag "None "nil)))
(mode-line-format mode-line sexp) ;Hard to do right.
(major-mode internal function)
(case-fold-search matching boolean)
(format "%c:%s" x doc)))
mnemonics ", ")))))
+(declare-function quail-find-key "quail" (char))
+
;;;###autoload
(defun describe-char (pos &optional buffer)
"Describe position POS (interactively, point) and the char after POS.
;;;; Desktop support
(eval-when-compile (require 'desktop))
+(declare-function desktop-file-name "desktop" (filename dirname))
(defun dired-desktop-buffer-misc-data (dirname)
"Auxiliary information to be saved in desktop file."
(goto-char (point-max))
(insert msg1 msg2 "\n"))))
+(declare-function shell-prefixed-directory-name "shell" (dir))
+(declare-function shell-process-cd "shell" (arg))
+
;;;###autoload
(defun dirtrack (input)
"Determine the current directory from the process output for a prompt.
-;;; advice.el --- An overloading mechanism for Emacs Lisp functions
+;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*-
;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
;; @ Highlights:
;; =============
;; - Clean definition of multiple, named before/around/after advices
-;; for functions, macros, subrs and special forms
+;; for functions and macros.
;; - Full control over the arguments an advised function will receive,
;; the binding environment in which it will be executed, as well as the
;; value it will return.
-;; - Allows re/definition of interactive behavior for functions and subrs
-;; - Every piece of advice can have its documentation string which will be
-;; combined with the original documentation of the advised function at
-;; call-time of `documentation' for proper command-key substitution.
+;; - Allows re/definition of interactive behavior for commands.
+;; - Every piece of advice can have its documentation string.
;; - The execution of every piece of advice can be protected against error
;; and non-local exits in preceding code or advices.
;; - Simple argument access either by name, or, more portable but as
;; version of a function.
;; - Advised functions can be byte-compiled either at file-compile time
;; (see preactivation) or activation time.
-;; - Separation of advice definition and activation
+;; - Separation of advice definition and activation.
;; - Forward advice is possible, that is
;; as yet undefined or autoload functions can be advised without having to
;; preload the file in which they are defined.
;; - En/disablement mechanism allows the use of different "views" of advised
;; functions depending on what pieces of advice are currently en/disabled
;; - Provides manipulation mechanisms for sets of advised functions via
-;; regular expressions that match advice names
+;; regular expressions that match advice names.
;; @ Overview, or how to read this file:
;; =====================================
;; others come from the various Lisp advice mechanisms I've come across
;; so far, and a few are simply mine.
-;; @ Comments, suggestions, bug reports:
-;; =====================================
-;; If you find any bugs, have suggestions for new advice features, find the
-;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory,
-;; have any questions about Advice, or have otherwise enlightening
-;; comments feel free to send me email at <hans@cs.buffalo.edu>.
-
;; @ Safety Rules and Emergency Exits:
;; ===================================
;; Before we begin: CAUTION!!
;; Advice provides you with a lot of rope to hang yourself on very
;; easily accessible trees, so, here are a few important things you
-;; should know: Once Advice has been started with `ad-start-advice'
-;; (which happens automatically when you load this file), it
-;; generates an advised definition of the `documentation' function, and
-;; it will enable automatic advice activation when functions get defined.
-;; All of this can be undone at any time with `M-x ad-stop-advice'.
+;; should know:
;;
;; If you experience any strange behavior/errors etc. that you attribute to
;; Advice or to some ill-advised function do one of the following:
;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
;; function gives you problems)
;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong)
-;; - M-x ad-stop-advice (if you think the problem is related to the
-;; advised functions used by Advice itself)
;; - M-x ad-recover-normality (for real emergencies)
;; - If none of the above solves your Advice-related problem go to another
;; terminal, kill your Emacs process and send me some hate mail.
-;; The first three measures have restarts, i.e., once you've figured out
+;; The first two measures have restarts, i.e., once you've figured out
;; the problem you can reactivate advised functions with either `ad-activate',
-;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises
+;; or `ad-activate-all'. `ad-recover-normality' unadvises
;; everything so you won't be able to reactivate any advised functions, you'll
;; have to stick with their standard incarnations for the rest of the session.
-;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
-;; you byte-compile a file, because advised special forms and macros can lead
-;; to unwanted compilation results. When you are done compiling use
-;; `M-x ad-activate-all' to go back to the advised state of all your
-;; advised functions.
-
;; RELAX: Advice is pretty safe even if you are oblivious to the above.
;; I use it extensively and haven't run into any serious trouble in a long
-;; time. Just wanted you to be warned.
+;; time. Just wanted you to be warned.
;; @ Customization:
;; ================
;; Look at the documentation of `ad-redefinition-action' for possible values
-;; of this variable. Its default value is `warn' which will print a warning
+;; of this variable. Its default value is `warn' which will print a warning
;; message when an already defined advised function gets redefined with a
;; new original definition and de/activated.
;; Look at the documentation of `ad-default-compilation-action' for possible
-;; values of this variable. Its default value is `maybe' which will compile
+;; values of this variable. Its default value is `maybe' which will compile
;; advised definitions during activation in case the byte-compiler is already
-;; loaded. Otherwise, it will leave them uncompiled.
+;; loaded. Otherwise, it will leave them uncompiled.
;; @ Motivation:
;; =============
;; Before I go on explaining how advice works, here are four simple examples
-;; how this package can be used. The first three are very useful, the last one
+;; how this package can be used. The first three are very useful, the last one
;; is just a joke:
;;(defadvice switch-to-buffer (before existing-buffers-only activate)
;; @ Advice documentation:
;; =======================
-;; Below is general documentation of the various features of advice. For more
+;; Below is general documentation of the various features of advice. For more
;; concrete examples check the corresponding sections in the tutorial part.
;; @@ Terminology:
;; ===============
;; - Emacs: Emacs as released by the GNU Project
-;; - jwz: Jamie Zawinski - creator of the byte-compiler used in v19s.
;; - Advice: The name of this package.
;; - advices: Short for "pieces of advice".
;; <name> is the name of the advice which has to be a non-nil symbol.
;; Names uniquely identify a piece of advice in a certain advice class,
;; hence, advices can be redefined by defining an advice with the same class
-;; and name. Advice names are global symbols, hence, the same name space
+;; and name. Advice names are global symbols, hence, the same name space
;; conventions used for function names should be applied.
;; An optional <position> specifies where in the current list of advices of
-;; the specified <class> this new advice will be placed. <position> has to
+;; the specified <class> this new advice will be placed.
<position> has to
;; be either `first', `last' or a number that specifies a zero-based
-;; position (`first' is equivalent to 0). If no position is specified
-;; `first' will be used as a default. If this call to `defadvice' redefines
+;; position (`first' is equivalent to 0). If no position is specified
+;; `first' will be used as a default. If this call to `defadvice' redefines
;; an already existing advice (see above) then the position argument will
;; be ignored and the position of the already existing advice will be used.
;; An optional <arglist> which has to be a list can be used to define the
-;; argument list of the advised function. This argument list should of
+;; argument list of the advised function. This argument list should of
;; course be compatible with the argument list of the original function,
;; otherwise functions that call the advised function with the original
-;; argument list in mind will break. If more than one advice specify an
+;; argument list in mind will break. If more than one advice specify an
;; argument list then the first one (the one with the smallest position)
;; found in the list of before/around/after advices will be used.
;; `disable': Specifies that the defined advice should be disabled, hence,
;; it will not be used in an activation until somebody enables it.
;; `preactivate': Specifies that the advised function should get preactivated
-;; at macro-expansion/compile time of this `defadvice'. This
+;; at macro-expansion/compile time of this `defadvice'. This
;; generates a compiled advised definition according to the
;; current advice state which will be used during activation
-;; if appropriate. Only use this if the `defadvice' gets
+;; if appropriate. Only use this if the `defadvice' gets
;; actually compiled.
;; An optional <documentation-string> can be supplied to document the advice.
;; documentation strings of the original function and other advices.
;; An optional <interactive-form> form can be supplied to change/add
-;; interactive behavior of the original function. If more than one advice
+;; interactive behavior of the original function. If more than one advice
;; has an `(interactive ...)' specification then the first one (the one
;; with the smallest position) found in the list of before/around/after
;; advices will be used.
;; A possibly empty list of <body-forms> specifies the body of the advice in
-;; an implicit progn. The body of an advice can access/change arguments,
+;; an implicit progn. The body of an advice can access/change arguments,
;; the return value, the binding environment, and can have all sorts of
;; other side effects.
;; @@ Assembling advised definitions:
;; ==================================
;; Suppose a function/macro/subr/special-form has N pieces of before advice,
-;; M pieces of around advice and K pieces of after advice. Assuming none of
+;; M pieces of around advice and K pieces of after advice. Assuming none of
;; the advices is protected, its advised definition will look like this
;; (body-form indices correspond to the position of the respective advice in
;; that advice class):
;; be expanded into a proper documentation string upon call of `documentation'.
;; (interactive ...) is an optional interactive form either taken from the
-;; original function or from a before/around/after advice. For advised
+;; original function or from a before/around/after advice. For advised
;; interactive subrs that do not have an interactive form specified in any
;; advice we have to use (interactive) and then call the subr interactively
;; if the advised function was called interactively, because the
-;; interactive specification of subrs is not accessible. This is the only
+;; interactive specification of subrs is not accessible. This is the only
;; case where changing the values of arguments will not have an affect
;; because they will be reset by the interactive specification of the subr.
;; If this is a problem one can always specify an interactive form in a
;;
;; Then the body forms of the various advices in the various classes of advice
;; are assembled in order. The forms of around advice L are normally part of
-;; one of the forms of around advice L-1. An around advice can specify where
+;; one of the forms of around advice L-1. An around advice can specify where
;; the forms of the wrapped or surrounded forms should go with the special
-;; keyword `ad-do-it', which will be substituted with a `progn' containing the
-;; forms of the surrounded code.
+;; keyword `ad-do-it', which will run the forms of the surrounded code.
;; The innermost part of the around advice onion is
;; <apply original definition to <arglist>>
-;; whose form depends on the type of the original function. The variable
-;; `ad-return-value' will be set to its result. This variable is visible to
+;; whose form depends on the type of the original function. The variable
+;; `ad-return-value' will be set to its result. This variable is visible to
;; all pieces of advice which can access and modify it before it gets returned.
;;
;; The semantic structure of advised functions that contain protected pieces
-;; of advice is the same. The only difference is that `unwind-protect' forms
+;; of advice is the same. The only difference is that `unwind-protect' forms
;; make sure that the protected advice gets executed even if some previous
-;; piece of advice had an error or a non-local exit. If any around advice is
+;; piece of advice had an error or a non-local exit. If any around advice is
;; protected then the whole around advice onion will be protected.
;; @@ Argument access in advised functions:
;; ========================================
;; As already mentioned, the simplest way to access the arguments of an
-;; advised function in the body of an advice is to refer to them by name. To
-;; do that, the advice programmer needs to know either the names of the
+;; advised function in the body of an advice is to refer to them by name.
+;; To do that, the advice programmer needs to know either the names of the
;; argument variables of the original function, or the names used in the
-;; argument list redefinition given in a piece of advice. While this simple
+;; argument list redefinition given in a piece of advice. While this simple
;; method might be sufficient in many cases, it has the disadvantage that it
;; is not very portable because it hardcodes the argument names into the
;; advice. If the definition of the original function changes the advice
-;; might break even though the code might still be correct. Situations like
+;; might break even though the code might still be correct. Situations like
;; that arise, for example, if one advises a subr like `eval-region' which
;; gets redefined in a non-advice style into a function by the edebug
-;; package. If the advice assumes `eval-region' to be a subr it might break
-;; once edebug is loaded. Similar situations arise when one wants to use the
+;; package. If the advice assumes `eval-region' to be a subr it might break
+;; once edebug is loaded. Similar situations arise when one wants to use the
;; same piece of advice across different versions of Emacs.
;; As a solution to that advice provides argument list access macros that get
;; translated into the proper access forms at activation time, i.e., when the
-;; advised definition gets constructed. Access macros access actual arguments
+;; advised definition gets constructed. Access macros access actual arguments
;; by position regardless of how these actual argument get distributed onto
-;; the argument variables of a function. The rational behind this is that in
+;; the argument variables of a function. The rational behind this is that in
;; Emacs Lisp the semantics of an argument is strictly determined by its
;; position (there are no keyword arguments).
;;
;; (foo 0 1 2 3 4 5 6)
-;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
-;; the semantics of an actual argument is determined by its position. It is
-;; this semantics that has to be known by the advice programmer. Then s/he
+;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
+;; the semantics of an actual argument is determined by its position. It is
+;; this semantics that has to be known by the advice programmer. Then s/he
;; can access these arguments in a piece of advice with some of the
;; following macros (the arrows indicate what value they will return):
;; `(ad-get-arg <position>)' will return the actual argument that was supplied
;; at <position>, `(ad-get-args <position>)' will return the list of actual
-;; arguments supplied starting at <position>. Note that these macros can be
+;; arguments supplied starting at <position>. Note that these macros can be
;; used without any knowledge about the form of the actual argument list of
;; the original function.
;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the
-;; value of the actual argument at <position> to <value-form>. For example,
+;; value of the actual argument at <position> to <value-form>. For example,
;;
;; (ad-set-arg 5 "five")
;;
;; will have the effect that R=(3 4 "five" 6) once the original function is
-;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
+;; called.
`(ad-set-args <position> <value-list-form>)' can be used to set
;; the list of actual arguments starting at <position> to <value-list-form>.
;; For example,
;;
;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original
;; function is called.
-;; All these access macros are text macros rather than real Lisp macros. When
+;; All these access macros are text macros rather than real Lisp macros. When
;; the advised definition gets constructed they get replaced with actual access
;; forms depending on the argument list of the advised function, i.e., after
;; that argument access is in most cases as efficient as using the argument
;; =======================================================
;; Some functions (such as `trace-function' defined in trace.el) need a
;; method of accessing the names and bindings of the arguments of an
-;; arbitrary advised function. To do that within an advice one can use the
+;; arbitrary advised function. To do that within an advice one can use the
;; special keyword `ad-arg-bindings' which is a text macro that will be
;; substituted with a form that will evaluate to a list of binding
;; specifications, one for every argument variable. These binding
;; ==========================
;; Because `defadvice' allows the specification of the argument list
;; of the advised function we need a mapping mechanism that maps this
-;; argument list onto that of the original function. Hence SYM and
+;; argument list onto that of the original function. Hence SYM and
;; NEWDEF have to be properly mapped onto the &rest variable when the
;; original definition is called. Advice automatically takes care of
;; that mapping, hence, the advice programmer can specify an argument
;; @@ Activation and deactivation:
;; ===============================
;; The definition of an advised function does not change until all its advice
-;; gets actually activated. Activation can either happen with the `activate'
+;; gets actually activated. Activation can either happen with the `activate'
;; flag specified in the `defadvice', with an explicit call or interactive
-;; invocation of `ad-activate', or if forward advice is enabled (i.e., the
-;; value of `ad-activate-on-definition' is t) at the time an already advised
-;; function gets defined.
+;; invocation of `ad-activate', or at the time an already advised function
+;; gets defined.
;; When a function gets first activated its original definition gets saved,
;; all defined and enabled pieces of advice will get combined with the
;; the file that contained the `defadvice' with the `preactivate' flag.
;; `ad-deactivate' can be used to back-define an advised function to its
-;; original definition. It can be called interactively or directly. Because
+;; original definition. It can be called interactively or directly. Because
;; `ad-activate' caches the advised definition the function can be
;; reactivated via `ad-activate' with only minor overhead (it is checked
;; whether the current advice state is consistent with the cached
;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
;; all currently advised function that have a piece of advice with a name that
-;; contains a match for a regular expression. These functions can be used to
+;; contains a match for a regular expression. These functions can be used to
;; de/activate sets of functions depending on certain advice naming
;; conventions.
;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
-;; de/activate all currently advised functions. These are useful to
+;; de/activate all currently advised functions. These are useful to
;; (temporarily) return to an un/advised state.
;; @@@ Reasons for the separation of advice definition and activation:
;; The advantage of this is that various pieces of advice can be defined
;; before they get combined into an advised definition which avoids
-;; unnecessary constructions of intermediate advised definitions. The more
+;; unnecessary constructions of intermediate advised definitions. The more
;; important advantage is that it allows the implementation of forward advice.
;; Advice information for a certain function accumulates as the value of the
-;; `advice-info' property of the function symbol. This accumulation is
+;; `advice-info' property of the function symbol. This accumulation is
;; completely independent of the fact that that function might not yet be
-;; defined. The special forms `defun' and `defmacro' have been advised to
-;; check whether the function/macro they defined had advice information
-;; associated with it. If so and forward advice is enabled, the original
+;; defined. The macros `defun' and `defmacro' check whether the
+;; function/macro they defined had advice information
+;; associated with it. If so and forward advice is enabled, the original
;; definition will be saved, and then the advice will be activated.
;; @@ Enabling/disabling pieces or sets of advice:
;; ===============================================
;; A major motivation for the development of this advice package was to bring
;; a little bit more structure into the function overloading chaos in Emacs
-;; Lisp. Many packages achieve some of their functionality by adding a little
+;; Lisp. Many packages achieve some of their functionality by adding a little
;; bit (or a lot) to the standard functionality of some Emacs Lisp function.
-;; ange-ftp is a very popular package that achieves its magic by overloading
-;; most Emacs Lisp functions that deal with files. A popular function that's
-;; overloaded by many packages is `expand-file-name'. The situation that one
-;; function is multiply overloaded can arise easily.
+;; ange-ftp is a very popular package that used to achieve its magic by
+;; overloading most Emacs Lisp functions that deal with files. A popular
+;; function that's overloaded by many packages is `expand-file-name'.
+;; The situation that one function is multiply overloaded can arise easily.
;; Once in a while it would be desirable to be able to disable some/all
;; overloads of a particular package while keeping all the rest. Ideally -
;; I know I am dreaming right now... In that ideal case the enable/disable
;; mechanism of advice could be used to achieve just that.
-;; Every piece of advice is associated with an enablement flag. When the
+;; Every piece of advice is associated with an enablement flag. When the
;; advised definition of a particular function gets constructed (e.g., during
;; activation) only the currently enabled pieces of advice will be considered.
;; This mechanism allows one to have different "views" of an advised function
;; Another motivation for this mechanism is that it allows one to define a
;; piece of advice for some function yet keep it dormant until a certain
-;; condition is met. Until then activation of the function will not make use
-;; of that piece of advice. Once the condition is met the advice can be
+;; condition is met. Until then activation of the function will not make use
+;; of that piece of advice. Once the condition is met the advice can be
;; enabled and a reactivation of the function will add its functionality as
-;; part of the new advised definition. For example, the advices of `defun'
-;; etc. used by advice itself will stay disabled until `ad-start-advice' is
-;; called and some variables have the proper values. Hence, if somebody
+;; part of the new advised definition. Hence, if somebody
;; else advised these functions too and activates them the advices defined
;; by advice will get used only if they are intended to be used.
;; The main interface to this mechanism are the interactive functions
-;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
+;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
;; would disable a particular advice of the function `foo':
;;
;; (ad-disable-advice 'foo 'before 'my-advice)
;;
;; (ad-activate 'foo)
;;
-;; or interactively. To disable whole sets of advices one can use a regular
-;; expression mechanism. For example, let us assume that ange-ftp actually
+;; or interactively. To disable whole sets of advices one can use a regular
+;; expression mechanism. For example, let us assume that ange-ftp actually
;; used advice to overload all its functions, and that it used the
;; "ange-ftp-" prefix for all its advice names, then we could temporarily
;; disable all its advices with
;;
-;; (ad-disable-regexp "^ange-ftp-")
+;; (ad-disable-regexp "\\`ange-ftp-")
;;
;; and the following call would put that actually into effect:
;;
-;; (ad-activate-regexp "^ange-ftp-")
+;; (ad-activate-regexp "\\`ange-ftp-")
;;
;; A safer way would have been to use
;;
-;; (ad-update-regexp "^ange-ftp-")
+;; (ad-update-regexp "\\`ange-ftp-")
;;
;; instead which would have only reactivated currently actively advised
-;; functions, but not functions that were currently inactive. All these
+;; functions, but not functions that were currently inactive. All these
;; functions can also be called interactively.
;; A certain piece of advice is considered a match if its name contains a
-;; match for the regular expression. To enable ange-ftp again we would use
+;; match for the regular expression. To enable ange-ftp again we would use
;; `ad-enable-regexp' and then activate or update again.
;; @@ Forward advice, automatic advice activation:
;; of advice definition and activation that makes it possible to accumulate
;; advice information without having the original function already defined,
;; 2) special versions of the built-in functions `fset/defalias' which check
-;; for advice information whenever they define a function. If advice
+;; for advice information whenever they define a function. If advice
;; information was found then the advice will immediately get activated when
;; the function gets defined.
;; file, and the function has some advice-info stored with it then that
;; advice will get activated right away.
-;; @@@ Enabling automatic advice activation:
-;; =========================================
-;; Automatic advice activation is enabled by default. It can be disabled with
-;; `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
-
;; @@ Caching of advised definitions:
;; ==================================
;; After an advised definition got constructed it gets cached as part of the
;; advised function's advice-info so it can be reused, for example, after an
-;; intermediate deactivation. Because the advice-info of a function might
+;; intermediate deactivation. Because the advice-info of a function might
;; change between the time of caching and reuse a cached definition gets
;; a cache-id associated with it so it can be verified whether the cached
;; definition is still valid (the main application of this is preactivation
;; When an advised function gets activated and a verifiable cached definition
;; is available, then that definition will be used instead of creating a new
-;; advised definition from scratch. If you want to make sure that a new
+;; advised definition from scratch. If you want to make sure that a new
;; definition gets constructed then you should use `ad-clear-cache' before you
;; activate the advised function.
;; @@ Preactivation:
;; =================
-;; Constructing an advised definition is moderately expensive. In a situation
+;; Constructing an advised definition is moderately expensive. In a situation
;; where one package defines a lot of advised functions it might be
;; prohibitively expensive to do all the advised definition construction at
-;; runtime. Preactivation is a mechanism that allows compile-time construction
+;; runtime. Preactivation is a mechanism that allows compile-time construction
;; of compiled advised definitions that can be activated cheaply during
-;; runtime. Preactivation uses the caching mechanism to do that. Here's how it
-;; works:
+;; runtime. Preactivation uses the caching mechanism to do that. Here's how
+;; it works:
;; When the byte-compiler compiles a `defadvice' that has the `preactivate'
;; flag specified, it uses the current original definition of the advised
;; byte-compiler.
;; When the file with the compiled, preactivating `defadvice' gets loaded the
;; precompiled advised definition will be cached on the advised function's
-;; advice-info. When it gets activated (can be immediately on execution of the
+;; advice-info. When it gets activated (can be immediately on execution of the
;; `defadvice' or any time later) the cache-id gets checked against the
;; current state of advice and if it is verified the precompiled definition
-;; will be used directly (the verification is pretty cheap). If it couldn't get
-;; verified a new advised definition for that function will be built from
-;; scratch, hence, the efficiency added by the preactivation mechanism does
-;; not at all impair the flexibility of the advice mechanism.
+;; will be used directly (the verification is pretty cheap). If it couldn't
+;; get verified a new advised definition for that function will be built from
+;; scratch, hence, the efficiency added by the preactivation mechanism does not
+;; at all impair the flexibility of the advice mechanism.
;; MORAL: In order get all the efficiency out of preactivation the advice
;; state of an advised function at the time the file with the
;; preactivating `defadvice' gets byte-compiled should be exactly
;; the same as it will be when the advice of that function gets
-;; actually activated. If it is not there is a high chance that the
+;; actually activated. If it is not there is a high chance that the
;; cache-id will not match and hence a new advised definition will
;; have to be constructed at runtime.
-;; Preactivation and forward advice do not contradict each other. It is
+;; Preactivation and forward advice do not contradict each other. It is
;; perfectly ok to load a file with a preactivating `defadvice' before the
-;; original definition of the advised function is available. The constructed
+;; original definition of the advised function is available. The constructed
;; advised definition will be used once the original function gets defined and
-;; its advice gets activated. The only constraint is that at the time the
+;; its advice gets activated. The only constraint is that at the time the
;; file with the preactivating `defadvice' got compiled the original function
;; definition was available.
;; - `byte-compile' is part of the `features' variable even though you
;; did not use the byte-compiler
;; Right now advice does not provide an elegant way to find out whether
-;; and why a preactivation failed. What you can do is to trace the
+;; and why a preactivation failed. What you can do is to trace the
;; function `ad-cache-id-verification-code' (with the function
;; `trace-function-background' defined in my trace.el package) before
-;; any of your advised functions get activated. After they got
+;; any of your advised functions get activated. After they got
;; activated check whether all calls to `ad-cache-id-verification-code'
-;; returned `verified' as a result. Other values indicate why the
+;; returned `verified' as a result. Other values indicate why the
;; verification failed which should give you enough information to
;; fix your preactivation/compile/load/activation sequence.
;; IMPORTANT: There is one case (that I am aware of) that can make
;; preactivation fail, i.e., a preconstructed advised definition that does
-;; NOT match the current state of advice gets used nevertheless. That case
+;; NOT match the current state of advice gets used nevertheless. That case
;; arises if one package defines a certain piece of advice which gets used
;; during preactivation, and another package incompatibly redefines that
;; very advice (i.e., same function/class/name), and it is the second advice
;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
;; George Walker Bush), and why would you redefine your own advice anyway?
;; Advice is a mechanism to facilitate function redefinition, not advice
-;; redefinition (wait until I write Meta-Advice :-). If you really have
-;; to undo somebody else's advice try to write a "neutralizing" advice.
+;; redefinition (wait until I write Meta-Advice :-). If you really have
+;; to undo somebody else's advice, try to write a "neutralizing" advice.
-;; @@ Advising macros and special forms and other dangerous things:
-;; ================================================================
+;; @@ Advising macros and other dangerous things:
+;; ==============================================
;; Look at the corresponding tutorial sections for more information on
-;; these topics. Here it suffices to point out that the special treatment
-;; of macros and special forms by the byte-compiler can lead to problems
-;; when they get advised. Macros can create problems because they get
-;; expanded at compile time, hence, they might not have all the necessary
-;; runtime support and such advice cannot be de/activated or changed as
-;; it is possible for functions. Special forms create problems because they
-;; have to be advised "into" macros, i.e., an advised special form is a
-;; implemented as a macro, hence, in most cases the byte-compiler will
-;; not recognize it as a special form anymore which can lead to very strange
-;; results.
-;;
-;; MORAL: - Only advise macros or special forms when you are absolutely sure
-;; what you are doing.
-;; - As a safety measure, always do `ad-deactivate-all' before you
-;; byte-compile a file to make sure that even if some inconsiderate
-;; person advised some special forms you'll get proper compilation
-;; results. After compilation do `ad-activate-all' to get back to
-;; the previous state.
+;; these topics. Here it suffices to point out that the special treatment
+;; of macros can lead to problems when they get advised. Macros can create
+;; problems because they get expanded at compile or load time, hence, they
+;; might not have all the necessary runtime support and such advice cannot be
+;; de/activated or changed as it is possible for functions.
+;; Special forms cannot be advised.
+;;
+;; MORAL: - Only advise macros when you are absolutely sure what you are doing.
;; @@ Adding a piece of advice with `ad-add-advice':
;; =================================================
;; @@ Activation/deactivation advices, file load hooks:
;; ====================================================
;; There are two special classes of advice called `activation' and
-;; `deactivation'. The body forms of these advices are not included into the
+;; `deactivation'. The body forms of these advices are not included into the
;; advised definition of a function, rather they are assembled into a hook
;; form which will be evaluated whenever the advice-info of the advised
-;; function gets activated or deactivated. One application of this mechanism
+;; function gets activated or deactivated. One application of this mechanism
;; is to define file load hooks for files that do not provide such hooks.
;; For example, suppose you want to print a message whenever `file-x' gets
;; loaded, and suppose the last function defined in `file-x' is
;;
;; This will constitute a forward advice for function `file-x-last-fn' which
;; will get activated when `file-x' is loaded (only if forward advice is
-;; enabled of course). Because there are no "real" pieces of advice
+;; enabled of course). Because there are no "real" pieces of advice
;; available for it, its definition will not be changed, but the activation
;; advice will be run during its activation which is equivalent to having a
;; file load hook for `file-x'.
;; enabled advices are considered during construction of an advised
;; definition.
;; - Activation:
-;; Redefine an advised function with its advised definition. Constructs
+;; Redefine an advised function with its advised definition. Constructs
;; an advised definition from scratch if no verifiable cached advised
;; definition is available and caches it.
;; - Deactivation:
;; Back-define an advised function to its original definition.
;; - Update:
;; Reactivate an advised function but only if its advice is currently
-;; active. This can be used to bring all currently advised function up
+;; active. This can be used to bring all currently advised function up
;; to date with the current state of advice without also activating
;; currently inactive functions.
;; - Caching:
;; - Preactivation:
;; Is the construction of an advised definition according to the current
;; state of advice during byte-compilation of a file with a preactivating
-;; `defadvice'. That advised definition can then rather cheaply be used
+;; `defadvice'. That advised definition can then rather cheaply be used
;; during activation without having to construct an advised definition
;; from scratch at runtime.
;; @ Foo games: An advice tutorial
;; ===============================
-;; The following tutorial was created in Emacs 18.59. Left-justified
+;; The following tutorial was created in Emacs 18.59. Left-justified
;; s-expressions are input forms followed by one or more result forms.
-;; First we have to start the advice magic:
-;;
-;; (ad-start-advice)
-;; nil
;;
;; We start by defining an innocent looking function `foo' that simply
;; adds 1 to its argument X:
;; (call-interactively 'foo)
;; 6
;;
-;; Let's have a look at what the definition of `foo' looks like now
-;; (indentation added by hand for legibility):
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (list 5))
-;; (let (ad-return-value)
-;; (setq x (1- x))
-;; (setq x (1+ x))
-;; (setq ad-return-value (ad-Orig-foo x))
-;; ad-return-value))
-;;
;; @@ Around advices:
;; ==================
;; Now we'll try some `around' advices. An around advice is a wrapper around
;; (foo 3)
;; 8
;;
-;; Again, let's see what the definition of `foo' looks like so far:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (list 5))
-;; (let (ad-return-value)
-;; (setq x (1- x))
-;; (setq x (1+ x))
-;; (let ((x (* x 2)))
-;; (let ((x (1+ x)))
-;; (setq ad-return-value (ad-Orig-foo x))))
-;; ad-return-value))
-;;
;; @@ Controlling advice activation:
;; =================================
;; In every `defadvice' so far we have used the flag `activate' to activate
;; 8
;;
;; Now we define another advice and activate which will also activate the
-;; previous advice `fg-times-x'. Note the use of the special variable
+;; previous advice `fg-times-x'. Note the use of the special variable
;; `ad-return-value' in the body of the advice which is set to the result of
-;; the original function. If we change its value then the value returned by
+;; the original function. If we change its value then the value returned by
;; the advised function will be changed accordingly:
;;
;; (defadvice foo (after fg-times-x-again act)
;; "Let's clean up now!"
;; error-in-foo
;;
-;; Again, let's see what `foo' looks like:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (list 5))
-;; (let (ad-return-value)
-;; (unwind-protect
-;; (progn (setq x (1- x))
-;; (setq x (1+ x))
-;; (let ((x (* x 2)))
-;; (let ((x (1+ x)))
-;; (setq ad-return-value (ad-Orig-foo x))))
-;; (setq ad-return-value (* ad-return-value x))
-;; (setq ad-return-value (* ad-return-value x)))
-;; (print "Let's clean up now!"))
-;; ad-return-value))
-;;
;; @@ Compilation of advised definitions:
;; ======================================
;; Finally, we can specify the `compile' keyword in a `defadvice' to say
;; (print "Let's clean up now!"))
;; foo
;;
-;; Now `foo' is byte-compiled:
+;; Now `foo's advice is byte-compiled:
;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (byte-code "....." [5] 1))
-;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
+;; (byte-code-function-p 'ad-Advice-foo)
+;; t
;;
;; (foo 3)
;; "Let's clean up now!"
;; deactivate functions that have a piece of advice defined by a certain
;; package (we save the old definition to check out caching):
;;
-;; (setq old-definition (symbol-function 'foo))
+;; (setq old-definition (symbol-function 'ad-Advice-foo))
;; (lambda (x) ....)
;;
;; (ad-deactivate-regexp "^fg-")
;; (ad-activate-regexp "^fg-")
;; nil
;;
-;; (eq old-definition (symbol-function 'foo))
+;; (eq old-definition (symbol-function 'ad-Advice-foo))
;; t
;;
;; (foo 3)
;;
;; @@ Forward advice:
;; ==================
-;; To enable automatic activation of forward advice we first have to set
-;; `ad-activate-on-definition' to t and restart advice:
-;;
-;; (setq ad-activate-on-definition t)
-;; t
-;;
-;; (ad-start-advice)
-;; (ad-activate-defined-function)
;;
;; Let's define a piece of advice for an undefined function:
;;
;; (fboundp 'bar)
;; nil
;;
-;; Now we define it and the forward advice will get activated (only because
-;; `ad-activate-on-definition' was t when we started advice above with
-;; `ad-start-advice'):
+;; Now we define it and the forward advice will get activated:
;;
;; (defun bar (x)
;; "Subtract 1 from X."
;; (ad-activate 'fie)
;; fie
;;
-;; (eq cached-definition (symbol-function 'fie))
+;; (eq cached-definition (symbol-function 'ad-Advice-fie))
;; t
;;
;; (fie 2)
;;
;; If you put a preactivating `defadvice' into a Lisp file that gets byte-
;; compiled then the constructed advised definition will get compiled by
-;; the byte-compiler. For that to occur in a v18 Emacs you had to put the
+;; the byte-compiler. For that to occur in a v18 Emacs you had to put the
;; `defadvice' inside a `defun' because the v18 compiler did not compile
;; top-level forms other than `defun' or `defmacro', for example,
;;
;; constructed during preactivation was used, even though we did not specify
;; the `compile' flag:
;;
-;; (symbol-function 'fum)
-;; (lambda (x)
-;; "$ad-doc: fum$"
-;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
+;; (byte-code-function-p 'ad-Advice-fum)
+;; t
;;
;; (fum 2)
;; 8
;;
;; A preactivated definition will only be used if it matches the current
-;; function definition and advice information. If it does not match it
+;; function definition and advice information. If it does not match it
;; will simply be discarded and a new advised definition will be constructed
-;; from scratch. For example, let's first remove all advice-info for `fum':
+;; from scratch. For example, let's first remove all advice-info for `fum':
;;
;; (ad-unadvise 'fum)
;; (("fie") ("bar") ("foo") ...)
;; fum
;;
;; When we now try to use a preactivation it will not be used because the
-;; current advice state is different from the one at preactivation time. This
+;; current advice state is different from the one at preactivation time. This
;; is no tragedy, everything will work as expected just not as efficient,
;; because a new advised definition has to be constructed from scratch:
;;
;;
;; A new uncompiled advised definition got constructed:
;;
-;; (ad-compiled-p (symbol-function 'fum))
+;; (byte-code-function-p 'ad-Advice-fum)
;; nil
;;
;; (fum 2)
;;
;; MORAL: To get all the efficiency out of preactivation the function
;; definition and advice state at preactivation time must be the same as the
-;; state at activation time. Preactivation does work with forward advice, all
+;; state at activation time. Preactivation does work with forward advice, all
;; that's necessary is that the definition of the forward advised function is
;; available when the `defadvice' with the preactivation gets compiled.
;;
;; @@ Compilation idiosyncrasies:
;; ==============================
-;; `defadvice' expansion needs quite a few advice functions and variables,
-;; hence, I need to preload the file before it can be compiled. To avoid
-;; interference of bogus compiled files I always preload the source file:
-(provide 'advice-preload)
-;; During a normal load this is a noop:
-(require 'advice-preload "advice.el")
(require 'macroexp)
;; At run-time also, since ad-do-advised-functions returns code that uses it.
-(require 'cl-lib)
+(eval-when-compile (require 'cl-lib))
;; @@ Variable definitions:
;; ========================
(funcall fUnCtIoN tReE))
(t tReE)))
-;; @@ Save real definitions of subrs used by Advice:
-;; =================================================
-;; Advice depends on the real, unmodified functionality of various subrs,
-;; we save them here so advised versions will not interfere (eventually,
-;; we will save all subrs used in code generated by Advice):
-
-(defmacro ad-save-real-definition (function)
- (let ((saved-function (intern (format "ad-real-%s" function))))
- ;; Make sure the compiler is loaded during macro expansion:
- (require 'byte-compile "bytecomp")
- `(if (not (fboundp ',saved-function))
- (progn (fset ',saved-function (symbol-function ',function))
- ;; Copy byte-compiler properties:
- ,@(if (get function 'byte-compile)
- `((put ',saved-function 'byte-compile
- ',(get function 'byte-compile))))
- ,@(if (get function 'byte-opcode)
- `((put ',saved-function 'byte-opcode
- ',(get function 'byte-opcode))))))))
-
-(defun ad-save-real-definitions ()
- ;; Macro expansion will hardcode the values of the various byte-compiler
- ;; properties into the compiled version of this function such that the
- ;; proper values will be available at runtime without loading the compiler:
- (ad-save-real-definition fset)
- (ad-save-real-definition documentation))
-
-(ad-save-real-definitions)
-
-
;; @@ Advice info access fns:
;; ==========================
;; (after adv1 adv2 ...)
;; (activation adv1 adv2 ...)
;; (deactivation adv1 adv2 ...)
-;; (origname . <symbol fbound to origdef>)
+;; (advicefunname . <symbol fbound to assembled advice function>)
;; (cache . (<advised-definition> . <id>)))
;; List of currently advised though not necessarily activated functions
ad-advised-functions)))
(defmacro ad-do-advised-functions (varform &rest body)
- "`dolist'-style iterator that maps over `ad-advised-functions'.
-\(ad-do-advised-functions (VAR [RESULT-FORM])
+ "`dolist'-style iterator that maps over advised functions.
+\(ad-do-advised-functions (VAR)
BODY-FORM...)
On each iteration VAR will be bound to the name of an advised function
\(a symbol)."
(declare (indent 1))
- `(cl-dolist (,(car varform)
- ad-advised-functions
- ,(car (cdr varform)))
+ `(dolist (,(car varform) ad-advised-functions)
(setq ,(car varform) (intern (car ,(car varform))))
,@body))
(defmacro ad-get-advice-info-macro (function)
`(get ,function 'ad-advice-info))
-(defmacro ad-set-advice-info (function advice-info)
- `(put ,function 'ad-advice-info ,advice-info))
+(defsubst ad-set-advice-info (function advice-info)
+ (cond
+ (advice-info
+ (add-function :around (get function 'defalias-fset-function)
+ #'ad--defalias-fset))
+ ((get function 'defalias-fset-function)
+ (remove-function (get function 'defalias-fset-function)
+ #'ad--defalias-fset)))
+ (put function 'ad-advice-info advice-info))
(defmacro ad-copy-advice-info (function)
`(copy-tree (get ,function 'ad-advice-info)))
(defmacro ad-is-advised (function)
"Return non-nil if FUNCTION has any advice info associated with it.
This does not mean that the advice is also active."
- (list 'ad-get-advice-info-macro function))
+ `(ad-get-advice-info-macro ,function))
(defun ad-initialize-advice-info (function)
"Initialize the advice info for FUNCTION.
;; ad-find-advice uses the alist structure directly ->
;; change if this data structure changes!!
-(defmacro ad-advice-name (advice)
- (list 'car advice))
-(defmacro ad-advice-protected (advice)
- (list 'nth 1 advice))
-(defmacro ad-advice-enabled (advice)
- (list 'nth 2 advice))
-(defmacro ad-advice-definition (advice)
- (list 'nth 3 advice))
+(defsubst ad-advice-name (advice) (car advice))
+(defsubst ad-advice-protected (advice) (nth 1 advice))
+(defsubst ad-advice-enabled (advice) (nth 2 advice))
+(defsubst ad-advice-definition (advice) (nth 3 advice))
(defun ad-advice-set-enabled (advice flag)
(rplaca (cdr (cdr advice)) flag))
+(defvar ad-advice-classes '(before around after activation deactivation)
+ "List of defined advice classes.")
+
(defun ad-class-p (thing)
(memq thing ad-advice-classes))
(defun ad-name-p (thing)
;; @@ Advice access functions:
;; ===========================
-;; List of defined advice classes:
-(defvar ad-advice-classes '(before around after activation deactivation))
-
(defun ad-has-enabled-advice (function class)
"True if at least one of FUNCTION's advices in CLASS is enabled."
(cl-dolist (advice (ad-get-advice-info-field function class))
(defun ad-has-any-advice (function)
"True if the advice info of FUNCTION defines at least one advice."
(and (ad-is-advised function)
- (cl-dolist (class ad-advice-classes nil)
+ (cl-dolist (class ad-advice-classes)
(if (ad-get-advice-info-field function class)
(cl-return t)))))
;; @@ Dealing with automatic advice activation via `fset/defalias':
;; ================================================================
-;; Since Emacs 19.26 the built-in versions of `fset' and `defalias'
-;; take care of automatic advice activation, hence, we don't have to
-;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'.
+;; Automatic activation happens when a function gets defined via `defalias',
+;; which calls the `defalias-fset-function' (which we set to
+;; `ad--defalias-fset') instead of `fset', if non-nil.
-;; The functionality of the new `fset' is as follows:
-;;
-;; fset(sym,newdef)
-;; assign NEWDEF to SYM
-;; if (get SYM 'ad-advice-info)
-;; ad-activate-internal(SYM, nil)
-;; return (symbol-function SYM)
-;;
;; Whether advised definitions created by automatic activations will be
;; compiled depends on the value of `ad-default-compilation-action'.
-;; Since calling `ad-activate-internal' in the built-in definition of `fset' can
-;; create major disasters we have to be a bit careful. One precaution is
-;; to provide a dummy definition for `ad-activate-internal' which can be used to
-;; turn off automatic advice activation (e.g., when `ad-stop-advice' or
-;; `ad-recover-normality' are called). Another is to avoid recursive calls
-;; to `ad-activate' by using `ad-with-auto-activation-disabled' where
-;; appropriate, especially in a safe version of `fset'.
-
-;; For now define `ad-activate-internal' to the dummy definition:
-(defun ad-activate-internal (function &optional compile)
- "Automatic advice activation is disabled. `ad-start-advice' enables it."
- nil)
-
-;; This is just a copy of the above:
-(defun ad-activate-internal-off (function &optional compile)
- "Automatic advice activation is disabled. `ad-start-advice' enables it."
- nil)
-
-;; This will be t for top-level calls to `ad-activate-internal-on':
-(defvar ad-activate-on-top-level t)
-
-(defmacro ad-with-auto-activation-disabled (&rest body)
- `(let ((ad-activate-on-top-level nil))
- ,@body))
-
-(defun ad-safe-fset (symbol definition)
- "A safe `fset' which will never call `ad-activate-internal' recursively."
- (ad-with-auto-activation-disabled
- (ad-real-fset symbol definition)))
-
+(defalias 'ad-activate-internal 'ad-activate)
-;; @@ Access functions for original definitions:
-;; ============================================
-;; The advice-info of an advised function contains its `origname' which is
-;; a symbol that is fbound to the original definition available at the first
-;; proper activation of the function after a valid re/definition. If the
-;; original was defined via fcell indirection then `origname' will be defined
-;; just so. Hence, to get hold of the actual original definition of a function
-;; we need to use `ad-real-orig-definition'.
+(defun ad-make-advicefunname (function)
+ "Make name to be used to call the assembled advice function."
+ (intern (format "ad-Advice-%s" function)))
-(defun ad-make-origname (function)
- "Make name to be used to call the original FUNCTION."
- (intern (format "ad-Orig-%s" function)))
+(defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-".
+ (if (symbolp function)
+ (setq function (if (fboundp function)
+ (advice--strip-macro (symbol-function function)))))
+ (while (advice--p function) (setq function (advice--cdr function)))
+ function)
-(defmacro ad-get-orig-definition (function)
- `(let ((origname (ad-get-advice-info-field ,function 'origname)))
- (if (fboundp origname)
- (symbol-function origname))))
-
-(defmacro ad-set-orig-definition (function definition)
- `(ad-safe-fset
- (ad-get-advice-info-field ,function 'origname) ,definition))
-
-(defmacro ad-clear-orig-definition (function)
- `(fmakunbound (ad-get-advice-info-field ,function 'origname)))
+(defun ad-clear-advicefunname-definition (function)
+ (let ((advicefunname (ad-get-advice-info-field function 'advicefunname)))
+ (advice-remove function advicefunname)
+ (fmakunbound advicefunname)))
;; @@ Interactive input functions:
(error "ad-read-advised-function: There are no advised functions"))
(setq default
(or default
- ;; Prefer func name at point, if it's in ad-advised-functions etc.
+ ;; Prefer func name at point, if it's an advised function etc.
(let ((function (progn
(require 'help)
(function-called-at-point))))
(or (null predicate)
(funcall predicate function))
function))
- (ad-do-advised-functions (function)
- (if (or (null predicate)
- (funcall predicate function))
- (cl-return function)))
+ (cl-block nil
+ (ad-do-advised-functions (function)
+ (if (or (null predicate)
+ (funcall predicate function))
+ (cl-return function))))
(error "ad-read-advised-function: %s"
"There are no qualifying advised functions")))
- (let* ((ad-pReDiCaTe predicate)
- (function
+ (let* ((function
(completing-read
(format "%s (default %s): " (or prompt "Function") default)
ad-advised-functions
(if predicate
- (function
- (lambda (function)
- ;; Oops, no closures - the joys of dynamic scoping:
- ;; `predicate' clashed with the `predicate' argument
- ;; of `completing-read'.....
- (funcall ad-pReDiCaTe (intern (car function))))))
+ (lambda (function)
+ (funcall predicate (intern (car function)))))
t)))
(if (equal function "")
(if (ad-is-advised default)
(cond ((not (ad-is-advised function))
(ad-initialize-advice-info function)
(ad-set-advice-info-field
- function 'origname (ad-make-origname function))))
+ function 'advicefunname (ad-make-advicefunname function))))
(let* ((previous-position
(ad-advice-position function class (ad-advice-name advice)))
(advices (ad-get-advice-info-field function class))
"Take a macro function DEFINITION and make a lambda out of it."
`(cdr ,definition))
-(defun ad-special-form-p (definition)
- "Non-nil if and only if DEFINITION is a special form."
- (if (and (symbolp definition) (fboundp definition))
- (setq definition (indirect-function definition)))
- (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled)))
-
(defmacro ad-subr-p (definition)
;;"non-nil if DEFINITION is a subr."
(list 'subrp definition))
(cdr definition))
(t nil)))
-(defun ad-arglist (definition &optional name)
- "Return the argument list of DEFINITION.
-If DEFINITION could be from a subr then its NAME should be
-supplied to make subr arglist lookup more efficient."
+(defun ad-arglist (definition)
+ "Return the argument list of DEFINITION."
(require 'help-fns)
(help-function-arglist
(if (or (ad-macro-p definition) (ad-advice-p definition))
"Return the unexpanded docstring of DEFINITION."
(let ((docstring
(if (ad-compiled-p definition)
- (ad-real-documentation definition t)
+ (documentation definition t)
(car (cdr (cdr (ad-lambda-expression definition)))))))
(if (or (stringp docstring)
(natnump docstring))
(if (ad-interactive-form definition) 1 0))
(cdr (cdr (ad-lambda-expression definition)))))))
-(defun ad-make-advised-definition-docstring (function)
+(defun ad-make-advised-definition-docstring (_function)
"Make an identifying docstring for the advised definition of FUNCTION.
Put function name into the documentation string so we can infer
the name of the advised function from the docstring. This is needed
to generate a proper advised docstring even if we are just given a
definition (see the code for `documentation')."
- (propertize "Advice doc string" 'ad-advice-info function))
+ (eval-when-compile
+ (propertize "Advice function assembled by advice.el."
+ 'dynamic-docstring-function
+ #'ad--make-advised-docstring)))
(defun ad-advised-definition-p (definition)
"Return non-nil if DEFINITION was generated from advice information."
(ad-compiled-p definition))
(let ((docstring (ad-docstring definition)))
(and (stringp docstring)
- (get-text-property 0 'ad-advice-info docstring)))))
+ (get-text-property 0 'dynamic-docstring-function docstring)))))
(defun ad-definition-type (definition)
"Return symbol that describes the type of DEFINITION."
+ ;; These symbols are only ever used to check a cache entry's validity.
+ ;; The suffix `2' reflects the fact that we're using version 2 of advice
+ ;; representations, so cache entries preactivated with version
+ ;; 1 can't be used.
(cond
- ((ad-macro-p definition) 'macro)
- ((ad-subr-p definition)
- (if (ad-special-form-p definition)
- 'special-form
- 'subr))
- ((or (ad-lambda-p definition)
- (ad-compiled-p definition))
- 'function)
- ((ad-advice-p definition) 'advice)))
+ ((ad-macro-p definition) 'macro2)
+ ((ad-subr-p definition) 'subr2)
+ ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2)
+ ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen?
(defun ad-has-proper-definition (function)
"True if FUNCTION is a symbol with a proper definition.
definition))))
(defun ad-real-orig-definition (function)
- "Find FUNCTION's real original definition starting from its `origname'."
- (if (ad-is-advised function)
- (ad-real-definition (ad-get-advice-info-field function 'origname))))
+ (let* ((fun1 (ad-get-orig-definition function))
+ (fun2 (indirect-function fun1)))
+ (unless (autoloadp fun2) fun2)))
(defun ad-is-compilable (function)
"True if FUNCTION has an interpreted definition that can be compiled."
(ad-macro-p (symbol-function function)))
(not (ad-compiled-p (symbol-function function)))))
+(defvar warning-suppress-types) ;From warnings.el.
(defun ad-compile-function (function)
- "Byte-compiles FUNCTION (or macro) if it is not yet compiled."
- (interactive "aByte-compile function: ")
- (if (ad-is-compilable function)
- ;; Need to turn off auto-activation
- ;; because `byte-compile' uses `fset':
- (ad-with-auto-activation-disabled
- (require 'bytecomp)
- (require 'warnings) ;To define warning-suppress-types
- ;before we let-bind it.
- (let ((symbol (make-symbol "advice-compilation"))
- (byte-compile-warnings byte-compile-warnings)
- ;; Don't pop up windows showing byte-compiler warnings.
- (warning-suppress-types '((bytecomp))))
- (if (featurep 'cl)
- (byte-compile-disable-warning 'cl-functions))
- (fset symbol (symbol-function function))
- (byte-compile symbol)
- (fset function (symbol-function symbol))))))
+ "Byte-compile the assembled advice function."
+ (require 'bytecomp)
+ (require 'warnings) ;To define warning-suppress-types before we let-bind it.
+ (let ((byte-compile-warnings byte-compile-warnings)
+ ;; Don't pop up windows showing byte-compiler warnings.
+ (warning-suppress-types '((bytecomp))))
+ (if (featurep 'cl)
+ (byte-compile-disable-warning 'cl-functions))
+ (byte-compile (ad-get-advice-info-field function 'advicefunname))))
;; @@@ Accessing argument lists:
;; =============================
(let ((values-index 0)
argument-access set-forms)
(while (setq argument-access (ad-access-argument arglist index))
- (if (symbolp argument-access)
- (setq set-forms
- (cons (ad-set-argument
- arglist index
- (ad-element-access values-index 'ad-vAlUeS))
- set-forms))
- (setq set-forms
- (cons (if (= (car argument-access) 0)
- (list 'setq
- (car (cdr argument-access))
- (ad-list-access values-index 'ad-vAlUeS))
- (list 'setcdr
- (ad-list-access (1- (car argument-access))
- (car (cdr argument-access)))
- (ad-list-access values-index 'ad-vAlUeS)))
- set-forms))
- ;; terminate loop
- (setq arglist nil))
+ (push (if (symbolp argument-access)
+ (ad-set-argument
+ arglist index
+ (ad-element-access values-index 'ad-vAlUeS))
+ (setq arglist nil) ;; Terminate loop.
+ (if (= (car argument-access) 0)
+ `(setq
+ ,(car (cdr argument-access))
+ ,(ad-list-access values-index 'ad-vAlUeS))
+ `(setcdr
+ ,(ad-list-access (1- (car argument-access))
+ (car (cdr argument-access)))
+ ,(ad-list-access values-index 'ad-vAlUeS))))
+ set-forms)
(setq index (1+ index))
(setq values-index (1+ values-index)))
(if (null set-forms)
(if (= (length set-forms) 1)
;; For exactly one set-form we can use values-form directly,...
(ad-substitute-tree
- (function (lambda (form) (eq form 'ad-vAlUeS)))
- (function (lambda (form) values-form))
+ (lambda (form) (eq form 'ad-vAlUeS))
+ (lambda (_form) values-form)
(car set-forms))
;; ...if we have more we have to bind it to a variable:
`(let ((ad-vAlUeS ,values-form))
supplied as nil. Returns a `funcall' or `apply' form with the second element
being `function' which has to be replaced by an actual function argument.
Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
- `(funcall function a (car args) (car (cdr args)) (nth 2 args))'."
+ `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'."
(let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
(source-reqopt-args (append (nth 0 parsed-source-arglist)
(nth 1 parsed-source-arglist)))
;; This produces ``error-proof'' target function calls with the exception
;; of a case like (&rest a) mapped onto (x &rest y) where the actual args
;; supplied to A might not be enough to supply the required target arg X
- (append (list (if need-apply 'apply 'funcall) 'function)
+ (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function)
(cond (need-apply
;; `apply' can take care of that directly:
(append source-reqopt-args (list source-rest-arg)))
- (t (mapcar (function
- (lambda (arg)
- (setq target-arg-index (1+ target-arg-index))
- (ad-get-argument
- source-arglist target-arg-index)))
+ (t (mapcar (lambda (_arg)
+ (setq target-arg-index (1+ target-arg-index))
+ (ad-get-argument
+ source-arglist target-arg-index))
(append target-reqopt-args
(and target-rest-arg
;; If we have a rest arg gobble up
(nthcdr (length target-reqopt-args)
source-reqopt-args)))))))))
-(defun ad-make-mapped-call (source-arglist target-arglist target-function)
- "Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
- (let ((mapped-form (ad-map-arglists source-arglist target-arglist)))
- (if (eq (car mapped-form) 'funcall)
- (cons target-function (cdr (cdr mapped-form)))
- (prog1 mapped-form
- (setcar (cdr mapped-form) (list 'quote target-function))))))
;; @@@ Making an advised documentation string:
;; ===========================================
(let ((advice-docstring (ad-docstring (ad-advice-definition advice))))
(cond ((eq style 'plain)
advice-docstring)
- ((eq style 'freeze)
- (format "Permanent %s-advice `%s':%s%s"
- class (ad-advice-name advice)
- (if advice-docstring "\n" "")
- (or advice-docstring "")))
(t (if advice-docstring
(format "%s-advice `%s':\n%s"
(capitalize (symbol-name class))
(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage.
-(defun ad-make-advised-docstring (function &optional style)
+(defun ad--make-advised-docstring (origdoc function &optional style)
"Construct a documentation string for the advised FUNCTION.
It concatenates the original documentation with the documentation
strings of the individual pieces of advice which will be formatted
-according to STYLE. STYLE can be `plain' or `freeze', everything else
+according to STYLE. STYLE can be `plain', everything else
will be interpreted as `default'. The order of the advice documentation
strings corresponds to before/around/after and the individual ordering
in any of these classes."
- (let* ((origdef (ad-real-orig-definition function))
- (origtype (symbol-name (ad-definition-type origdef)))
- (origdoc
- ;; Retrieve raw doc, key substitution will be taken care of later:
- (ad-real-documentation origdef t))
- (usage (help-split-fundoc origdoc function))
- paragraphs advice-docstring ad-usage)
+ (if (and (symbolp function)
+ (string-match "\\`ad-+Advice-" (symbol-name function)))
+ (setq function
+ (intern (substring (symbol-name function) (match-end 0)))))
+ (let* ((usage (help-split-fundoc origdoc function))
+ paragraphs advice-docstring)
(setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
(if origdoc (setq paragraphs (list origdoc)))
- (unless (eq style 'plain)
- (push (concat "This " origtype " is advised.") paragraphs))
(dolist (class ad-advice-classes)
(dolist (advice (ad-get-enabled-advices function class))
(setq advice-docstring
(propertize
;; separate paragraphs with blank lines:
(mapconcat 'identity (nreverse paragraphs) "\n\n")
- 'ad-advice-info function)))
+ ;; FIXME: what is this for?
+ 'dynamic-docstring-function
+ #'ad--make-advised-docstring)))
(help-add-fundoc-usage origdoc usage)))
-(defun ad-make-plain-docstring (function)
- (ad-make-advised-docstring function 'plain))
-(defun ad-make-freeze-docstring (function)
- (ad-make-advised-docstring function 'freeze))
;; @@@ Accessing overriding arglists and interactive forms:
;; ========================================================
(if (and (ad-is-advised function)
(ad-has-redefining-advice function))
(let* ((origdef (ad-real-orig-definition function))
- (origname (ad-get-advice-info-field function 'origname))
- (orig-interactive-p (commandp origdef))
- (orig-subr-p (ad-subr-p origdef))
- (orig-special-form-p (ad-special-form-p origdef))
- (orig-macro-p (ad-macro-p origdef))
;; Construct the individual pieces that we need for assembly:
- (orig-arglist (ad-arglist origdef function))
+ (orig-arglist (let ((args (ad-arglist origdef)))
+ ;; The arglist may still be unknown.
+ (if (listp args) args '(&rest args))))
(advised-arglist (or (ad-advised-arglist function)
orig-arglist))
- (advised-interactive-form (ad-advised-interactive-form function))
- (interactive-form
- (cond (orig-macro-p nil)
- (advised-interactive-form)
- ((interactive-form origdef)
- (interactive-form
- (if (and (symbolp function) (get function 'elp-info))
- (aref (get function 'elp-info) 2)
- origdef)))))
+ (interactive-form (ad-advised-interactive-form function))
(orig-form
- (cond ((or orig-special-form-p orig-macro-p)
- ;; Special forms and macros will be advised into macros.
- ;; The trick is to construct an expansion for the advised
- ;; macro that does the correct thing when it gets eval'ed.
- ;; For macros we'll just use the expansion of the original
- ;; macro and return that. This way compiled advised macros
- ;; will be expanded into something useful. Note that after
- ;; advices have full control over whether they want to
- ;; evaluate the expansion (the value of `ad-return-value')
- ;; at macro expansion time or not. For special forms there
- ;; is no solution that interacts reasonably with the
- ;; compiler, hence we just evaluate the original at macro
- ;; expansion time and return the result. The moral of that
- ;; is that one should always deactivate advised special
- ;; forms before one byte-compiles a file.
- `(,(if orig-macro-p 'macroexpand 'eval)
- (cons ',origname
- ,(ad-get-arguments advised-arglist 0))))
- ((and orig-subr-p
- orig-interactive-p
- (not interactive-form)
- (not advised-interactive-form))
- ;; Check whether we were called interactively
- ;; in order to do proper prompting:
- `(if (called-interactively-p 'any)
- (call-interactively ',origname)
- ,(ad-make-mapped-call advised-arglist
- orig-arglist
- origname)))
- ;; And now for normal functions and non-interactive subrs
- ;; (or subrs whose interactive behavior was advised):
- (t (ad-make-mapped-call
- advised-arglist orig-arglist origname)))))
+ (ad-map-arglists advised-arglist orig-arglist)))
;; Finally, build the sucker:
(ad-assemble-advised-definition
- (cond (orig-macro-p 'macro)
- (orig-special-form-p 'special-form)
- (t 'function))
advised-arglist
(ad-make-advised-definition-docstring function)
interactive-form
(ad-get-enabled-advices function 'after)))))
(defun ad-assemble-advised-definition
- (type args docstring interactive orig &optional befores arounds afters)
-
- "Assembles an original and its advices into an advised function.
-It constructs a function or macro definition according to TYPE which has to
-be either `macro', `function' or `special-form'. ARGS is the argument list
-that has to be used, DOCSTRING if non-nil defines the documentation of the
-definition, INTERACTIVE if non-nil is the interactive form to be used,
+ (args docstring interactive orig &optional befores arounds afters)
+ "Assemble the advices into an overall advice function.
+ARGS is the argument list that has to be used,
+DOCSTRING if non-nil defines the documentation of the definition,
+INTERACTIVE if non-nil is the interactive form to be used,
ORIG is a form that calls the body of the original unadvised function,
and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
should be modified. The assembled function will be returned."
(setq around-form-protected t))
(setq around-form
(ad-substitute-tree
- (function (lambda (form) (eq form 'ad-do-it)))
- (function (lambda (form) around-form))
+ (lambda (form) (eq form 'ad-do-it))
+ (lambda (_form) around-form)
(macroexp-progn (ad-body-forms (ad-advice-definition advice))))))
(setq after-forms
(ad-body-forms (ad-advice-definition advice)))))))
(setq definition
- `(,@(if (memq type '(macro special-form)) '(macro))
- lambda
- ,args
+ `(lambda (ad--addoit-function ,@args)
,@(if docstring (list docstring))
,@(if interactive (list interactive))
(let (ad-return-value)
,@after-forms
- ,(if (eq type 'special-form)
- '(list 'quote ad-return-value)
- 'ad-return-value))))
+ ad-return-value)))
(ad-insert-argument-access-forms definition args)))
"Generate an identifying image of the current advices of FUNCTION."
(let ((original-definition (ad-real-orig-definition function))
(cached-definition (ad-get-cache-definition function)))
- (list (mapcar (function (lambda (advice) (ad-advice-name advice)))
+ (list (mapcar #'ad-advice-name
(ad-get-enabled-advices function 'before))
- (mapcar (function (lambda (advice) (ad-advice-name advice)))
+ (mapcar #'ad-advice-name
(ad-get-enabled-advices function 'around))
- (mapcar (function (lambda (advice) (ad-advice-name advice)))
+ (mapcar #'ad-advice-name
(ad-get-enabled-advices function 'after))
(ad-definition-type original-definition)
- (if (equal (ad-arglist original-definition function)
+ (if (equal (ad-arglist original-definition)
(ad-arglist cached-definition))
t
- (ad-arglist original-definition function))
+ (ad-arglist original-definition))
(if (eq (ad-definition-type original-definition) 'function)
(equal (interactive-form original-definition)
(interactive-form cached-definition))))))
(and (eq (nth 3 cache-id) (ad-definition-type original-definition))
(setq code 'arglist-mismatch)
(equal (if (eq (nth 4 cache-id) t)
- (ad-arglist original-definition function)
+ (ad-arglist original-definition)
(nth 4 cache-id) )
(ad-arglist cached-definition))
(setq code 'interactive-form-mismatch)
(ad-set-advice-info function old-advice-info)
;; Don't `fset' function to nil if it was previously unbound:
(if function-defined-p
- (ad-safe-fset function old-definition)
+ (fset function old-definition)
(fmakunbound function)))))
-;; @@ Freezing:
-;; ============
-;; Freezing transforms a `defadvice' into a redefining `defun/defmacro'
-;; for the advised function without keeping any advice information. This
-;; feature was jwz's idea: It generates a dumpable function definition
-;; whose documentation can be written to the DOC file, and the generated
-;; code does not need any Advice runtime support. Of course, frozen advices
-;; cannot be undone.
-
-;; Freezing only considers the advice of the particular `defadvice', other
-;; already existing advices for the same function will be ignored. To ensure
-;; proper interaction when an already advised function gets redefined with
-;; a frozen advice, frozen advices always use the actual original definition
-;; of the function, i.e., they are always at the core of the onion. E.g., if
-;; an already advised function gets redefined with a frozen advice and then
-;; unadvised, the frozen advice remains as the new definition of the function.
-
-;; While multiple freeze advices for a single function or freeze-advising
-;; of an already advised function are possible, they are better avoided,
-;; because definition/compile/load ordering is relevant, and it becomes
-;; incomprehensible pretty quickly.
-
-(defun ad-make-freeze-definition (function advice class position)
- (if (not (ad-has-proper-definition function))
- (error
- "ad-make-freeze-definition: `%s' is not yet defined"
- function))
- (let* ((name (ad-advice-name advice))
- ;; With a unique origname we can have multiple freeze advices
- ;; for the same function, each overloading the previous one:
- (unique-origname
- (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
- (orig-definition
- ;; If FUNCTION is already advised, we'll use its current origdef
- ;; as the original definition of the frozen advice:
- (or (ad-get-orig-definition function)
- (symbol-function function)))
- (old-advice-info
- (if (ad-is-advised function)
- (ad-copy-advice-info function)))
- (real-docstring-fn
- (symbol-function 'ad-make-advised-definition-docstring))
- (real-origname-fn
- (symbol-function 'ad-make-origname))
- (frozen-definition
- (unwind-protect
- (progn
- ;; Make sure we construct a proper docstring:
- (ad-safe-fset 'ad-make-advised-definition-docstring
- 'ad-make-freeze-docstring)
- ;; Make sure `unique-origname' is used as the origname:
- (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname))
- ;; No we reset all current advice information to nil and
- ;; generate an advised definition that's solely determined
- ;; by ADVICE and the current origdef of FUNCTION:
- (ad-set-advice-info function nil)
- (ad-add-advice function advice class position)
- ;; The following will provide proper real docstrings as
- ;; well as a definition that will make the compiler happy:
- (ad-set-orig-definition function orig-definition)
- (ad-make-advised-definition function))
- ;; Restore the old advice state:
- (ad-set-advice-info function old-advice-info)
- ;; Restore functions:
- (ad-safe-fset
- 'ad-make-advised-definition-docstring real-docstring-fn)
- (ad-safe-fset 'ad-make-origname real-origname-fn))))
- (if frozen-definition
- (let* ((macro-p (ad-macro-p frozen-definition))
- (body (cdr (if macro-p
- (ad-lambdafy frozen-definition)
- frozen-definition))))
- `(progn
- (if (not (fboundp ',unique-origname))
- (fset ',unique-origname
- ;; avoid infinite recursion in case the function
- ;; we want to freeze is already advised:
- (or (ad-get-orig-definition ',function)
- (symbol-function ',function))))
- (,(if macro-p 'defmacro 'defun)
- ,function
- ,@body))))))
-
-
;; @@ Activation and definition handling:
;; ======================================
The current definition and its cache-id will be put into the cache."
(let ((verified-cached-definition
(if (ad-verify-cache-id function)
- (ad-get-cache-definition function))))
- (ad-safe-fset function
- (or verified-cached-definition
- (ad-make-advised-definition function)))
+ (ad-get-cache-definition function)))
+ (advicefunname (ad-get-advice-info-field function 'advicefunname)))
+ (fset advicefunname
+ (or verified-cached-definition
+ (ad-make-advised-definition function)))
+ (advice-add function :around advicefunname)
(if (ad-should-compile function compile)
- (ad-compile-function function))
+ (byte-compile advicefunname))
(if verified-cached-definition
- (if (not (eq verified-cached-definition (symbol-function function)))
+ (if (not (eq verified-cached-definition
+ (symbol-function advicefunname)))
;; we must have compiled, cache the compiled definition:
- (ad-set-cache
- function (symbol-function function) (ad-get-cache-id function)))
+ (ad-set-cache function (symbol-function advicefunname)
+ (ad-get-cache-id function)))
;; We created a new advised definition, cache it with a proper id:
(ad-clear-cache function)
;; ad-make-cache-id needs the new cached definition:
- (ad-set-cache function (symbol-function function) nil)
+ (ad-set-cache function (symbol-function advicefunname) nil)
(ad-set-cache
- function (symbol-function function) (ad-make-cache-id function)))))
+ function (symbol-function advicefunname) (ad-make-cache-id function)))))
-(defun ad-handle-definition (function)
+(defun ad--defalias-fset (fsetfun function newdef)
+ ;; Besides ad-redefinition-action we use this defalias-fset-function hook
+ ;; for two other reasons:
+ ;; - for `activation/deactivation' advices.
+ ;; - to rebuild the ad-Advice-* function with the right argument names.
"Handle re/definition of an advised FUNCTION during de/activation.
If FUNCTION does not have an original definition associated with it and
the current definition is usable, then it will be stored as FUNCTION's
de/activated. If you do not like the current redefinition action change
the value of `ad-redefinition-action' and de/activate again."
(let ((original-definition (ad-get-orig-definition function))
- (current-definition (if (ad-real-definition function)
- (symbol-function function))))
+ (current-definition (ad-get-orig-definition newdef)))
(if original-definition
(if current-definition
- (if (and (not (eq current-definition original-definition))
- ;; Redefinition with an advised definition from a
- ;; different function won't count as such:
- (not (ad-advised-definition-p current-definition)))
- ;; we have a redefinition:
+ (if (not (eq current-definition original-definition))
+ ;; We have a redefinition:
(if (not (memq ad-redefinition-action '(accept discard warn)))
- (error "ad-handle-definition (see its doc): `%s' %s"
+ (error "ad-redefinition-action: `%s' %s"
function "invalidly redefined")
(if (eq ad-redefinition-action 'discard)
- (ad-safe-fset function original-definition)
- (ad-set-orig-definition function current-definition)
+ nil ;; Just drop it!
+ (funcall (or fsetfun #'fset) function newdef)
+ (ad-activate-internal function)
(if (eq ad-redefinition-action 'warn)
(message "ad-handle-definition: `%s' got redefined"
function))))
;; either advised def or correct original is in place:
nil)
- ;; we have an undefinition, ignore it:
- nil)
- (if current-definition
- ;; we have a first definition, save it as original:
- (ad-set-orig-definition function current-definition)
- ;; we don't have anything noteworthy:
- nil))))
+ ;; We have an undefinition, ignore it:
+ (funcall (or fsetfun #'fset) function newdef))
+ (funcall (or fsetfun #'fset) function newdef)
+ (when current-definition (ad-activate-internal function)))))
;; @@ The top-level advice interface:
(interactive
(list (ad-read-advised-function "Activate advice of")
current-prefix-arg))
- (if ad-activate-on-top-level
- ;; avoid recursive calls to `ad-activate':
- (ad-with-auto-activation-disabled
- (if (not (ad-is-advised function))
- (error "ad-activate: `%s' is not advised" function)
- (ad-handle-definition function)
- ;; Just return for forward advised and not yet defined functions:
- (if (ad-get-orig-definition function)
- (if (not (ad-has-any-advice function))
- (ad-unadvise function)
- ;; Otherwise activate the advice:
- (cond ((ad-has-redefining-advice function)
- (ad-activate-advised-definition function compile)
- (ad-set-advice-info-field function 'active t)
- (eval (ad-make-hook-form function 'activation))
- function)
- ;; Here we are if we have all disabled advices:
- (t (ad-deactivate function)))))))))
+ (if (not (ad-is-advised function))
+ (error "ad-activate: `%s' is not advised" function)
+ ;; Just return for forward advised and not yet defined functions:
+ (if (ad-get-orig-definition function)
+ (if (not (ad-has-any-advice function))
+ (ad-unadvise function)
+ ;; Otherwise activate the advice:
+ (cond ((ad-has-redefining-advice function)
+ (ad-activate-advised-definition function compile)
+ (ad-set-advice-info-field function 'active t)
+ (eval (ad-make-hook-form function 'activation))
+ function)
+ ;; Here we are if we have all disabled advices:
+ (t (ad-deactivate function)))))))
(defalias 'ad-activate-on 'ad-activate)
(if (not (ad-is-advised function))
(error "ad-deactivate: `%s' is not advised" function)
(cond ((ad-is-active function)
- (ad-handle-definition function)
(if (not (ad-get-orig-definition function))
(error "ad-deactivate: `%s' has no original definition"
function)
- (ad-safe-fset function (ad-get-orig-definition function))
+ (ad-clear-advicefunname-definition function)
(ad-set-advice-info-field function 'active nil)
(eval (ad-make-hook-form function 'deactivation))
function)))))
(cond ((ad-is-advised function)
(if (ad-is-active function)
(ad-deactivate function))
- (ad-clear-orig-definition function)
+ (ad-clear-advicefunname-definition function)
(ad-set-advice-info function nil)
(ad-pop-advised-function function))))
(list (intern
(completing-read "Recover advised function: " obarray nil t))))
(cond ((ad-is-advised function)
- (cond ((ad-get-orig-definition function)
- (ad-safe-fset function (ad-get-orig-definition function))
- (ad-clear-orig-definition function)))
+ (ad-clear-advicefunname-definition function)
(ad-set-advice-info function nil)
(ad-pop-advised-function function))))
;; Completion alist of valid `defadvice' flags
(defvar ad-defadvice-flags
'(("protect") ("disable") ("activate")
- ("compile") ("preactivate") ("freeze")))
+ ("compile") ("preactivate")))
;;;###autoload
(defmacro defadvice (function args &rest body)
ARGLIST ::= An optional argument list to be used for the advised function
instead of the argument list of the original. The first one found in
before/around/after-advices will be used.
-FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'.
+FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'.
All flags can be specified with unambiguous initial substrings.
DOCSTRING ::= Optional documentation for this piece of advice.
INTERACTIVE-FORM ::= Optional interactive form to be used for the advised
advice state that will be used during activation if appropriate. Only use
this if the `defadvice' gets actually compiled.
-`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according
-to this particular single advice. No other advice information will be saved.
-Frozen advices cannot be undone, they behave like a hard redefinition of
-the advised function. `freeze' implies `activate' and `preactivate'. The
-documentation of the advised function can be dumped onto the `DOC' file
-during preloading.
-
See Info node `(elisp)Advising Functions' for comprehensive documentation.
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
(ad-preactivate-advice
function advice class position))))
;; Now for the things to be done at evaluation time:
- (if (memq 'freeze flags)
- ;; jwz's idea: Freeze the advised definition into a dumpable
- ;; defun/defmacro whose docs can be written to the DOC file:
- (ad-make-freeze-definition function advice class position)
- ;; the normal case:
- `(progn
- (ad-add-advice ',function ',advice ',class ',position)
- ,@(if preactivation
- `((ad-set-cache
- ',function
- ;; the function will get compiled:
- ,(cond ((ad-macro-p (car preactivation))
- `(ad-macrofy
- (function
- ,(ad-lambdafy
- (car preactivation)))))
- (t `(function
- ,(car preactivation))))
- ',(car (cdr preactivation)))))
- ,@(if (memq 'activate flags)
- `((ad-activate ',function
- ,(if (memq 'compile flags) t))))
- ',function))))
+ `(progn
+ (ad-add-advice ',function ',advice ',class ',position)
+ ,@(if preactivation
+ `((ad-set-cache
+ ',function
+ ;; the function will get compiled:
+ ,(cond ((ad-macro-p (car preactivation))
+ `(ad-macrofy
+ (function
+ ,(ad-lambdafy
+ (car preactivation)))))
+ (t `(function
+ ,(car preactivation))))
+ ',(car (cdr preactivation)))))
+ ,@(if (memq 'activate flags)
+ `((ad-activate ',function
+ ,(if (memq 'compile flags) t))))
+ ',function)))
;; @@ Tools:
;; Make forms to redefine functions to their
;; original definitions if they are advised:
(setq index -1)
- (mapcar
- (function
- (lambda (function)
- (setq index (1+ index))
- `(ad-safe-fset
- ',function
- (or (ad-get-orig-definition ',function)
- ,(car (nth index current-bindings))))))
- functions))
+ (mapcar (lambda (function)
+ (setq index (1+ index))
+ `(fset ',function
+ (or (ad-get-orig-definition ',function)
+ ,(car (nth index current-bindings)))))
+ functions))
,@body)
,@(progn
;; Make forms to back-define functions to the definitions
;; they had outside this macro call:
(setq index -1)
- (mapcar
- (function
- (lambda (function)
- (setq index (1+ index))
- `(ad-safe-fset
- ',function
- ,(car (nth index current-bindings)))))
- functions))))))
+ (mapcar (lambda (function)
+ (setq index (1+ index))
+ `(fset ',function
+ ,(car (nth index current-bindings))))
+ functions))))))
;; @@ Starting, stopping and recovering from the advice package magic:
;; ===================================================================
-(defun ad-start-advice ()
- "Start the automatic advice handling magic."
- (interactive)
- ;; Advising `ad-activate-internal' means death!!
- (ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate))
-
-(defun ad-stop-advice ()
- "Stop the automatic advice handling magic.
-You should only need this in case of Advice-related emergencies."
- (interactive)
- ;; Advising `ad-activate-internal' means death!!
- (ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off))
-
(defun ad-recover-normality ()
"Undo all advice related redefinitions and unadvises everything.
Use only in REAL emergencies."
(interactive)
- ;; Advising `ad-activate-internal' means death!!
- (ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)
(ad-recover-all)
- (setq ad-advised-functions nil))
-
-(ad-start-advice)
+ (ad-do-advised-functions (function)
+ (message "Oops! Left over advised function %S" function)
+ (ad-pop-advised-function function)))
(provide 'advice)
boundp buffer-file-name buffer-local-variables buffer-modified-p
buffer-substring byte-code-function-p
capitalize car-less-than-car car cdr ceiling char-after char-before
- char-equal char-to-string char-width
- compare-strings concat coordinates-in-window-p
+ char-equal char-to-string char-width compare-strings
+ compare-window-configurations concat coordinates-in-window-p
copy-alist copy-sequence copy-marker cos count-lines
decode-char
decode-time default-boundp default-value documentation downcase
fboundp fceiling featurep ffloor
file-directory-p file-exists-p file-locked-p file-name-absolute-p
file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
- float float-time floor format format-time-string frame-visible-p
- fround ftruncate
+ float float-time floor format format-time-string frame-first-window
+ frame-root-window frame-selected-window
+ frame-visible-p fround ftruncate
get gethash get-buffer get-buffer-window getenv get-file-buffer
hash-table-count
int-to-string intern-soft
keymap-parent
length local-variable-if-set-p local-variable-p log log10 logand
logb logior lognot logxor lsh langinfo
- make-list make-string make-symbol
- marker-buffer max member memq min mod multibyte-char-to-unibyte
- next-window nth nthcdr number-to-string
+ make-list make-string make-symbol marker-buffer max member memq min
+ minibuffer-selected-window minibuffer-window
+ mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
prefix-numeric-value previous-window prin1-to-string propertize
degrees-to-radians
unibyte-char-to-multibyte upcase user-full-name
user-login-name user-original-login-name custom-variable-p
vconcat
- window-buffer window-dedicated-p window-edges window-height
- window-hscroll window-minibuffer-p window-width
- zerop))
+ window-absolute-pixel-edges window-at window-body-height
+ window-body-width window-buffer window-dedicated-p window-display-table
+ window-combination-limit window-edges window-frame window-fringes
+ window-height window-hscroll window-inside-edges
+ window-inside-absolute-pixel-edges window-inside-pixel-edges
+ window-left-child window-left-column window-margins window-minibuffer-p
+ window-next-buffers window-next-sibling window-new-normal
+ window-new-total window-normal-size window-parameter window-parameters
+ window-parent window-pixel-edges window-point window-prev-buffers
+ window-prev-sibling window-redisplay-end-trigger window-scroll-bars
+ window-start window-text-height window-top-child window-top-line
+ window-total-height window-total-width window-use-time window-vscroll
+ window-width zerop))
(side-effect-and-error-free-fns
'(arrayp atom
bobp bolp bool-vector-p
this-single-command-raw-keys
user-real-login-name user-real-uid user-uid
vector vectorp visible-frame-list
- wholenump window-configuration-p window-live-p windowp)))
+ wholenump window-configuration-p window-live-p
+ window-valid-p windowp)))
(while side-effect-free-fns
(put (car side-effect-free-fns) 'side-effect-free t)
(setq side-effect-free-fns (cdr side-effect-free-fns)))
(defconst byte-compile-initial-macro-environment
'(
-;; (byte-compiler-options . (lambda (&rest forms)
-;; (apply 'byte-compiler-options-handler forms)))
+ ;; (byte-compiler-options . (lambda (&rest forms)
+ ;; (apply 'byte-compiler-options-handler forms)))
(declare-function . byte-compile-macroexpand-declare-function)
(eval-when-compile . (lambda (&rest body)
(list
(byte-compile-top-level
(byte-compile-preprocess (cons 'progn body)))))))
(eval-and-compile . (lambda (&rest body)
- (byte-compile-eval-before-compile (cons 'progn body))
- (cons 'progn body))))
+ ;; Byte compile before running it. Do it piece by
+ ;; piece, in case further expressions need earlier
+ ;; ones to be evaluated already, as is the case in
+ ;; eieio.el.
+ `(progn
+ ,@(mapcar (lambda (exp)
+ (let ((cexp
+ (byte-compile-top-level
+ (byte-compile-preprocess
+ exp))))
+ (eval cexp)
+ cexp))
+ body)))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")
;; Also, this lets us notice references to free variables.
(defmacro byte-compile-push-bytecodes (&rest args)
- "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed.
-ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names.
-BYTES and PC are updated after evaluating all the arguments."
+ "Push bytes onto BVAR, and increment CVAR by the number of bytes pushed.
+BVAR and CVAR are variables which are updated after evaluating
+all the arguments.
+
+\(fn BYTE1 BYTE2 ... BYTEn BVAR CVAR)"
(let ((byte-exprs (butlast args 2))
(bytes-var (car (last args 2)))
(pc-var (car (last args))))
(let ((xs (pop hist-new))
old-autoloads)
;; Make sure the file was not already loaded before.
- (unless (or (assoc (car xs) hist-orig)
- ;; Don't give both the "noruntime" and
- ;; "cl-functions" warning for the same function.
- ;; FIXME This seems incorrect - these are two
- ;; independent warnings. For example, you may be
- ;; choosing to see the cl warnings but ignore them.
- ;; You probably don't want to ignore noruntime in the
- ;; same way.
- (and (byte-compile-warning-enabled-p 'cl-functions)
- (byte-compile-cl-file-p (car xs))))
+ (unless (assoc (car xs) hist-orig)
(dolist (s xs)
(cond
((and (consp s) (eq t (car s)))
(defun byte-compile-log-warning (string &optional fill level)
(let ((warning-prefix-function 'byte-compile-warning-prefix)
(warning-type-format "")
- (warning-fill-prefix (if fill " "))
- (inhibit-read-only t))
+ (warning-fill-prefix (if fill " ")))
(display-warning 'bytecomp string level byte-compile-log-buffer)))
(defun byte-compile-warn (format &rest args)
(when (and (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
(consp (cdr (nth 1 form)))
- (symbolp (nth 1 (nth 1 form))))
+ (symbolp (nth 1 (nth 1 form)))
+ ;; Don't add it if it's already defined. Otherwise, it might
+ ;; hide the actual definition.
+ (not (fboundp (nth 1 (nth 1 form)))))
(push (cons (nth 1 (nth 1 form))
(cons 'autoload (cdr (cdr form))))
byte-compile-function-environment)
(setq body (nreverse body))
(setq body (list
(if (and (eq tmp 'funcall)
- (eq (car-safe (car body)) 'quote))
+ (eq (car-safe (car body)) 'quote)
+ (symbolp (nth 1 (car body))))
(cons (nth 1 (car body)) (cdr body))
(cons tmp body))))
(or (eq output-type 'file)
that suppresses all warnings during execution of BODY."
(declare (indent 1) (debug t))
`(let* ((fbound-list (byte-compile-find-bound-condition
- ,condition (list 'fboundp)
+ ,condition '(fboundp functionp)
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
- ,condition (list 'boundp 'default-boundp)))
+ ,condition '(boundp default-boundp)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
(append bound-list byte-compile-bound-variables)))
(cond ((null state) (cl-make-random-state cl--random-state))
((vectorp state) (copy-tree state t))
((integerp state) (vector 'cl-random-state-tag -1 30 state))
- (t (cl-make-random-state (cl-random-time)))))
+ (t (cl-make-random-state (cl--random-time)))))
;;;###autoload
(defun cl-random-state-p (object)
;;; Symbols.
-(defun cl-random-time ()
+(defun cl--random-time ()
(let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
(while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
v))
-(defvar cl--gensym-counter (* (logand (cl-random-time) 1023) 100))
+(defvar cl--gensym-counter (* (logand (cl--random-time) 1023) 100))
;;; Numbers.
"Return t if INTEGER is even."
(eq (logand integer 1) 0))
-(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl-random-time)))
+(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl--random-time)))
(defconst cl-most-positive-float nil
"The largest value that a Lisp float can hold.
;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively
;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan
;;;;;; cl-mapl cl-mapc cl-maplist cl-map cl--mapcar-many cl-equalp
-;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "b7d4e24fe58609eaf4fb319c81eb829e")
+;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "8e9fee941c465ac0fee9b92a92d64154")
;;; Generated autoloads from cl-extra.el
(autoload 'cl-coerce "cl-extra" "\
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
-;;;;;; "cl-macs" "cl-macs.el" "f254af8368e40df51f8b6440ec764a6a")
+;;;;;; "cl-macs" "cl-macs.el" "a7d9b56ea588b869813de8ed7ec1fbcd")
;;; Generated autoloads from cl-macs.el
(autoload 'cl--compiler-macro-list* "cl-macs" "\
(require 'help-fns)
(cons (help-add-fundoc-usage
(if (stringp (car hdr)) (pop hdr))
- (format "%S"
- (cons 'fn
- (cl--make-usage-args orig-args))))
+ ;; Be careful with make-symbol and (back)quote,
+ ;; see bug#12884.
+ (let ((print-gensym nil) (print-quoted t))
+ (format "%S" (cons 'fn (cl--make-usage-args
+ orig-args)))))
hdr)))
(list `(let* ,cl--bind-lets
,@(nreverse cl--bind-forms)
\(fn (VAR LIST [RESULT]) BODY...)"
(declare (debug ((symbolp form &optional form) cl-declarations body))
(indent 1))
- `(cl-block nil
- (,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist)
- ,spec ,@body)))
+ (let ((loop `(dolist ,spec ,@body)))
+ (if (advice-member-p #'cl--wrap-in-nil-block 'dolist)
+ loop `(cl-block nil ,loop))))
;;;###autoload
(defmacro cl-dotimes (spec &rest body)
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (debug cl-dolist) (indent 1))
- `(cl-block nil
- (,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes)
- ,spec ,@body)))
+ (let ((loop `(dotimes ,spec ,@body)))
+ (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes)
+ loop `(cl-block nil ,loop))))
;;;###autoload
(defmacro cl-do-symbols (spec &rest body)
))
(defvaralias var (intern (format "cl-%s" var))))
-;; Before overwriting subr.el's `dotimes' and `dolist', let's remember
-;; them under a different name, so we can use them in our implementation
-;; of `dotimes' and `dolist'.
-(unless (fboundp 'cl--dotimes)
- (defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'."))
-(unless (fboundp 'cl--dolist)
- (defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'."))
-
(dolist (fun '(
(get* . cl-get)
(random* . cl-random)
remf
psetf
(define-setf-method . define-setf-expander)
- declare
the
locally
multiple-value-setq
psetq
do-all-symbols
do-symbols
- dotimes
- dolist
do*
do
loop
(intern (format "cl-%s" fun)))))
(defalias fun new)))
+(defun cl--wrap-in-nil-block (fun &rest args)
+ `(cl-block nil ,(apply fun args)))
+(advice-add 'dolist :around #'cl--wrap-in-nil-block)
+(advice-add 'dotimes :around #'cl--wrap-in-nil-block)
+
+(defun cl--pass-args-to-cl-declare (&rest specs)
+ (macroexpand `(cl-declare ,@specs)))
+(advice-add 'declare :after #'cl--pass-args-to-cl-declare)
+
;;; Features provided a bit differently in Elisp.
;; First, the old lexical-let is now better served by `lexical-binding', tho
-;;; debug.el --- debuggers and related commands for Emacs
+;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc.
:group 'debugger
:version "24.3")
-(defvar debug-function-list nil
- "List of functions currently set for debug on entry.")
-
(defvar debugger-step-after-exit nil
"Non-nil means \"single-step\" after the debugger exits.")
;;;###autoload
(setq debugger 'debug)
;;;###autoload
-(defun debug (&rest debugger-args)
+(defun debug (&rest args)
"Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger.
Arguments are mainly for use when this is called from the internals
of the evaluator.
(if (get-buffer "*Backtrace*")
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
+ (debugger-args args)
(debugger-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
(debugger-window nil)
(save-excursion
(when (eq (car debugger-args) 'debug)
;; Skip the frames for backtrace-debug, byte-code,
- ;; and implement-debug-on-entry.
+ ;; debug--implement-debug-on-entry and the advice's `apply'.
(backtrace-debug 4 t)
;; Place an extra debug-on-exit for macro's.
(when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
\f
-(defun debugger-setup-buffer (debugger-args)
+(defun debugger-setup-buffer (args)
"Initialize the `*Backtrace*' buffer for entry to the debugger.
That buffer should be current already."
(setq buffer-read-only nil)
(delete-region (point)
(progn
(search-forward "\n debug(")
- (forward-line (if (eq (car debugger-args) 'debug)
- 2 ; Remove implement-debug-on-entry frame.
+ (forward-line (if (eq (car args) 'debug)
+ ;; Remove debug--implement-debug-on-entry
+ ;; and the advice's `apply' frame.
+ 3
1))
(point)))
(insert "Debugger entered")
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
- (pcase (car debugger-args)
+ (pcase (car args)
((or `lambda `debug)
(insert "--entering a function:\n"))
;; Exiting a function.
(`exit
(insert "--returning value: ")
- (setq debugger-value (nth 1 debugger-args))
+ (setq debugger-value (nth 1 args))
(prin1 debugger-value (current-buffer))
(insert ?\n)
(delete-char 1)
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
- (prin1 (nth 1 debugger-args) (current-buffer))
+ (prin1 (nth 1 args) (current-buffer))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
;; User calls debug directly.
(_
(insert ": ")
- (prin1 (if (eq (car debugger-args) 'nil)
- (cdr debugger-args) debugger-args)
+ (prin1 (if (eq (car args) 'nil)
+ (cdr args) args)
(current-buffer))
(insert ?\n)))
;; After any frame that uses eval-buffer,
(count 0))
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
- ;; Skip implement-debug-on-entry frame.
- (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count))))
- (setq count (1+ count)))
+ ;; Skip debug--implement-debug-on-entry frame.
+ (when (eq 'debug--implement-debug-on-entry
+ (cadr (backtrace-frame (1+ count))))
+ (setq count (+ 2 count)))
(goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
(goto-char (match-end 0))
:help "Continue to exit from this frame, with all debug-on-entry suspended"))
(define-key menu-map [deb-cont]
'(menu-item "Continue" debugger-continue
- :help "Continue, evaluating this expression without stopping"))
+ :help "Continue, evaluating this expression without stopping"))
(define-key menu-map [deb-step]
'(menu-item "Step through" debugger-step-through
- :help "Proceed, stepping through subexpressions of this expression"))
+ :help "Proceed, stepping through subexpressions of this expression"))
map))
(put 'debugger-mode 'mode-class 'special)
\f
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
-(defun implement-debug-on-entry ()
+(defun debug--implement-debug-on-entry (&rest _ignore)
"Conditionally call the debugger.
A call to this function is inserted by `debug-on-entry' to cause
functions to break on entry."
nil
(funcall debugger 'debug)))
-(defun debugger-special-form-p (symbol)
- "Return whether SYMBOL is a special form."
- (and (fboundp symbol)
- (subrp (symbol-function symbol))
- (eq (cdr (subr-arity (symbol-function symbol))) 'unevalled)))
-
;;;###autoload
(defun debug-on-entry (function)
"Request FUNCTION to invoke debugger each time it is called.
Redefining FUNCTION also cancels it."
(interactive
(let ((fn (function-called-at-point)) val)
- (when (debugger-special-form-p fn)
+ (when (special-form-p fn)
(setq fn nil))
(setq val (completing-read
(if fn
obarray
#'(lambda (symbol)
(and (fboundp symbol)
- (not (debugger-special-form-p symbol))))
+ (not (special-form-p symbol))))
t nil nil (symbol-name fn)))
(list (if (equal val "") fn (intern val)))))
- ;; FIXME: Use advice.el.
- (when (debugger-special-form-p function)
- (error "Function %s is a special form" function))
- (if (or (symbolp (symbol-function function))
- (subrp (symbol-function function)))
- ;; The function is built-in or aliased to another function.
- ;; Create a wrapper in which we can add the debug call.
- (fset function `(lambda (&rest debug-on-entry-args)
- ,(interactive-form (symbol-function function))
- (apply ',(symbol-function function)
- debug-on-entry-args)))
- (when (autoloadp (symbol-function function))
- ;; The function is autoloaded. Load its real definition.
- (autoload-do-load (symbol-function function) function))
- (when (or (not (consp (symbol-function function)))
- (and (eq (car (symbol-function function)) 'macro)
- (not (consp (cdr (symbol-function function))))))
- ;; The function is byte-compiled. Create a wrapper in which
- ;; we can add the debug call.
- (debug-convert-byte-code function)))
- (unless (consp (symbol-function function))
- (error "Definition of %s is not a list" function))
- (fset function (debug-on-entry-1 function t))
- (unless (memq function debug-function-list)
- (push function debug-function-list))
+ (advice-add function :before #'debug--implement-debug-on-entry)
function)
+(defun debug--function-list ()
+ "List of functions currently set for debug on entry."
+ (let ((funs '()))
+ (mapatoms
+ (lambda (s)
+ (when (advice-member-p #'debug--implement-debug-on-entry s)
+ (push s funs))))
+ funs))
+
;;;###autoload
(defun cancel-debug-on-entry (&optional function)
"Undo effect of \\[debug-on-entry] on FUNCTION.
(list (let ((name
(completing-read
"Cancel debug on entry to function (default all functions): "
- (mapcar 'symbol-name debug-function-list) nil t)))
+ (mapcar #'symbol-name (debug--function-list)) nil t)))
(when name
(unless (string= name "")
(intern name))))))
- (if (and function
- (not (string= function ""))) ; Pre 22.1 compatibility test.
+ (if function
(progn
- (let ((defn (debug-on-entry-1 function nil)))
- (condition-case nil
- (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args))
- (eq (car (nth 3 defn)) 'apply))
- ;; `defn' is a wrapper introduced in debug-on-entry.
- ;; Get rid of it since we don't need it any more.
- (setq defn (nth 1 (nth 1 (nth 3 defn)))))
- (error nil))
- (fset function defn))
- (setq debug-function-list (delq function debug-function-list))
+ (advice-remove function #'debug--implement-debug-on-entry)
function)
(message "Cancelling debug-on-entry for all functions")
- (mapcar 'cancel-debug-on-entry debug-function-list)))
-
-(defun debug-arglist (definition)
- ;; FIXME: copied from ad-arglist.
- "Return the argument list of DEFINITION."
- (require 'help-fns)
- (help-function-arglist definition 'preserve-names))
-
-(defun debug-convert-byte-code (function)
- (let* ((defn (symbol-function function))
- (macro (eq (car-safe defn) 'macro)))
- (when macro (setq defn (cdr defn)))
- (when (byte-code-function-p defn)
- (let* ((args (debug-arglist defn))
- (body
- `((,(if (memq '&rest args) #'apply #'funcall)
- ,defn
- ,@(remq '&rest (remq '&optional args))))))
- (if (> (length defn) 5)
- ;; The mere presence of field 5 is sufficient to make
- ;; it interactive.
- (push `(interactive ,(aref defn 5)) body))
- (if (and (> (length defn) 4) (aref defn 4))
- ;; Use `documentation' here, to get the actual string,
- ;; in case the compiled function has a reference
- ;; to the .elc file.
- (setq body (cons (documentation function) body)))
- (setq defn `(closure (t) ,args ,@body)))
- (when macro (setq defn (cons 'macro defn)))
- (fset function defn))))
-
-(defun debug-on-entry-1 (function flag)
- (let* ((defn (symbol-function function))
- (tail defn))
- (when (eq (car-safe tail) 'macro)
- (setq tail (cdr tail)))
- (if (not (memq (car-safe tail) '(closure lambda)))
- ;; Only signal an error when we try to set debug-on-entry.
- ;; When we try to clear debug-on-entry, we are now done.
- (when flag
- (error "%s is not a user-defined Lisp function" function))
- (if (eq (car tail) 'closure) (setq tail (cdr tail)))
- (setq tail (cdr tail))
- ;; Skip the docstring.
- (when (and (stringp (cadr tail)) (cddr tail))
- (setq tail (cdr tail)))
- ;; Skip the interactive form.
- (when (eq 'interactive (car-safe (cadr tail)))
- (setq tail (cdr tail)))
- (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry)))
- ;; Add/remove debug statement as needed.
- (setcdr tail (if flag
- (cons '(implement-debug-on-entry) (cdr tail))
- (cddr tail)))))
- defn))
+ (mapcar #'cancel-debug-on-entry (debug--function-list))))
(defun debugger-list-functions ()
"Display a list of all the functions now set to debug on entry."
(called-interactively-p 'interactive))
(with-output-to-temp-buffer (help-buffer)
(with-current-buffer standard-output
- (if (null debug-function-list)
- (princ "No debug-on-entry functions now\n")
- (princ "Functions set to debug on entry:\n\n")
- (dolist (fun debug-function-list)
- (make-text-button (point) (progn (prin1 fun) (point))
- 'type 'help-function
- 'help-args (list fun))
- (terpri))
- (terpri)
- (princ "Note: if you have redefined a function, then it may no longer\n")
- (princ "be set to debug on entry, even if it is in the list.")))))
+ (let ((funs (debug--function-list)))
+ (if (null funs)
+ (princ "No debug-on-entry functions now\n")
+ (princ "Functions set to debug on entry:\n\n")
+ (dolist (fun funs)
+ (make-text-button (point) (progn (prin1 fun) (point))
+ 'type 'help-function
+ 'help-args (list fun))
+ (terpri))
+ (terpri)
+ (princ "Note: if you have redefined a function, then it may no longer\n")
+ (princ "be set to debug on entry, even if it is in the list."))))))
(provide 'debug)
-;;; elp.el --- Emacs Lisp Profiler
+;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*-
;; Copyright (C) 1994-1995, 1997-1998, 2001-2012
;; Free Software Foundation, Inc.
;;; Code:
+(eval-when-compile (require 'cl-lib))
\f
;; start of user configuration variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
"Non-nil specifies ELP results sorting function.
These functions are currently available:
- elp-sort-by-call-count -- sort by the highest call count
- elp-sort-by-total-time -- sort by the highest total time
- elp-sort-by-average-time -- sort by the highest average times
+ `elp-sort-by-call-count' -- sort by the highest call count
+ `elp-sort-by-total-time' -- sort by the highest total time
+ `elp-sort-by-average-time' -- sort by the highest average times
You can write your own sort function. It should adhere to the
interface specified by the PREDICATE argument for `sort'.
of times will be displayed in the output buffer. If nil, all
functions will be displayed."
:type '(choice integer
- (const :tag "Show All" nil))
+ (const :tag "Show All" nil))
:group 'elp)
(defcustom elp-use-standard-output nil
(defconst elp-timer-info-property 'elp-info
"ELP information property name.")
-(defvar elp-all-instrumented-list nil
- "List of all functions currently being instrumented.")
-
(defvar elp-record-p t
"Controls whether functions should record times or not.
This variable is set by the master function.")
(defvar elp-not-profilable
;; First, the functions used inside each instrumented function:
- '(elp-wrapper called-interactively-p
+ '(called-interactively-p
;; Then the functions used by the above functions. I used
;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
;; (aref (symbol-function 'elp-wrapper) 2)))
(fboundp fun)
(not (or (memq fun elp-not-profilable)
(keymapp fun)
- (memq (car-safe (symbol-function fun)) '(autoload macro))
- (condition-case nil
- (when (subrp (indirect-function fun))
- (eq 'unevalled
- (cdr (subr-arity (indirect-function fun)))))
- (error nil))))))
+ (autoloadp (symbol-function fun)) ;FIXME: Why not just load it?
+ (special-form-p fun)))))
+(defconst elp--advice-name 'ELP-instrumentation\ )
\f
;;;###autoload
(defun elp-instrument-function (funsym)
"Instrument FUNSYM for profiling.
FUNSYM must be a symbol of a defined function."
(interactive "aFunction to instrument: ")
- ;; restore the function. this is necessary to avoid infinite
- ;; recursion of already instrumented functions (i.e. elp-wrapper
- ;; calling elp-wrapper ad infinitum). it is better to simply
- ;; restore the function than to throw an error. this will work
- ;; properly in the face of eval-defun because if the function was
- ;; redefined, only the timer info will be nil'd out since
- ;; elp-restore-function is smart enough not to trash the new
- ;; definition.
- (elp-restore-function funsym)
- (let* ((funguts (symbol-function funsym))
- (infovec (vector 0 0 funguts))
- (newguts '(lambda (&rest args))))
- ;; we cannot profile macros
- (and (eq (car-safe funguts) 'macro)
- (error "ELP cannot profile macro: %s" funsym))
- ;; TBD: at some point it might be better to load the autoloaded
- ;; function instead of throwing an error. if we do this, then we
- ;; probably want elp-instrument-package to be updated with the
- ;; newly loaded list of functions. i'm not sure it's smart to do
- ;; the autoload here, since that could have side effects, and
- ;; elp-instrument-function is similar (in my mind) to defun-ish
- ;; type functionality (i.e. it shouldn't execute the function).
- (and (autoloadp funguts)
- (error "ELP cannot profile autoloaded function: %s" funsym))
+ (let* ((infovec (vector 0 0)))
;; We cannot profile functions used internally during profiling.
(unless (elp-profilable-p funsym)
(error "ELP cannot profile the function: %s" funsym))
- ;; put rest of newguts together
- (if (commandp funsym)
- (setq newguts (append newguts '((interactive)))))
- (setq newguts (append newguts `((elp-wrapper
- (quote ,funsym)
- ,(when (commandp funsym)
- '(called-interactively-p 'any))
- args))))
- ;; to record profiling times, we set the symbol's function
- ;; definition so that it runs the elp-wrapper function with the
- ;; function symbol as an argument. We place the old function
- ;; definition on the info vector.
- ;;
- ;; The info vector data structure is a 3 element vector. The 0th
+ ;; The info vector data structure is a 2 element vector. The 0th
;; element is the call-count, i.e. the total number of times this
;; function has been entered. This value is bumped up on entry to
;; the function so that non-local exists are still recorded. TBD:
;; The 1st element is the total amount of time in seconds that has
;; been spent inside this function. This number is added to on
;; function exit.
- ;;
- ;; The 2nd element is the old function definition list. This gets
- ;; funcall'd in between start/end time retrievals. I believe that
- ;; this lets us profile even byte-compiled functions.
- ;; put the info vector on the property list
+ ;; Put the info vector on the property list.
(put funsym elp-timer-info-property infovec)
;; Set the symbol's new profiling function definition to run
- ;; elp-wrapper.
- (let ((advice-info (get funsym 'ad-advice-info)))
- (if advice-info
- (progn
- ;; If function is advised, don't let Advice change
- ;; its definition from under us during the `fset'.
- (put funsym 'ad-advice-info nil)
- (fset funsym newguts)
- (put funsym 'ad-advice-info advice-info))
- (fset funsym newguts)))
-
- ;; add this function to the instrumentation list
- (unless (memq funsym elp-all-instrumented-list)
- (push funsym elp-all-instrumented-list))))
+ ;; ELP wrapper.
+ (advice-add funsym :around (elp--make-wrapper funsym)
+ `((name . ,elp--advice-name)))))
+
+(defun elp--instrumented-p (sym)
+ (advice-member-p elp--advice-name sym))
(defun elp-restore-function (funsym)
"Restore an instrumented function to its original definition.
Argument FUNSYM is the symbol of a defined function."
- (interactive "aFunction to restore: ")
- (let ((info (get funsym elp-timer-info-property)))
- ;; delete the function from the all instrumented list
- (setq elp-all-instrumented-list
- (delq funsym elp-all-instrumented-list))
-
- ;; if the function was the master, reset the master
- (if (eq funsym elp-master)
- (setq elp-master nil
- elp-record-p t))
-
- ;; zap the properties
- (put funsym elp-timer-info-property nil)
-
- ;; restore the original function definition, but if the function
- ;; wasn't instrumented do nothing. we do this after the above
- ;; because its possible the function got un-instrumented due to
- ;; circumstances beyond our control. Also, check to make sure
- ;; that the current function symbol points to elp-wrapper. If
- ;; not, then the user probably did an eval-defun, or loaded a
- ;; byte-compiled version, while the function was instrumented and
- ;; we don't want to destroy the new definition. can it ever be
- ;; the case that a lisp function can be compiled instrumented?
- (and info
- (functionp funsym)
- (not (byte-code-function-p (symbol-function funsym)))
- (assq 'elp-wrapper (symbol-function funsym))
- (fset funsym (aref info 2)))))
+ (interactive
+ (list
+ (intern
+ (completing-read "Function to restore: " obarray
+ #'elp--instrumented-p t))))
+ ;; If the function was the master, reset the master.
+ (if (eq funsym elp-master)
+ (setq elp-master nil
+ elp-record-p t))
+
+ ;; Zap the properties.
+ (put funsym elp-timer-info-property nil)
+
+ (advice-remove funsym elp--advice-name))
;;;###autoload
(defun elp-instrument-list (&optional list)
"Instrument, for profiling, all functions in `elp-function-list'.
Use optional LIST if provided instead.
If called interactively, read LIST using the minibuffer."
- (interactive "PList of functions to instrument: ")
+ (interactive "PList of functions to instrument: ") ;FIXME: Doesn't work?!
(unless (listp list)
(signal 'wrong-type-argument (list 'listp list)))
- (let ((list (or list elp-function-list)))
- (mapcar 'elp-instrument-function list)))
+ (mapcar #'elp-instrument-function (or list elp-function-list)))
;;;###autoload
(defun elp-instrument-package (prefix)
(defun elp-restore-list (&optional list)
"Restore the original definitions for all functions in `elp-function-list'.
Use optional LIST if provided instead."
- (interactive "PList of functions to restore: ")
- (let ((list (or list elp-function-list)))
- (mapcar 'elp-restore-function list)))
+ (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!?
+ (mapcar #'elp-restore-function (or list elp-function-list)))
(defun elp-restore-all ()
"Restore the original definitions of all functions being profiled."
(interactive)
- (elp-restore-list elp-all-instrumented-list))
-
+ (mapatoms #'elp-restore-function))
\f
(defun elp-reset-function (funsym)
"Reset the profiling information for FUNSYM."
(defun elp-reset-list (&optional list)
"Reset the profiling information for all functions in `elp-function-list'.
Use optional LIST if provided instead."
- (interactive "PList of functions to reset: ")
+ (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!?
(let ((list (or list elp-function-list)))
(mapcar 'elp-reset-function list)))
(defun elp-reset-all ()
"Reset the profiling information for all functions being profiled."
(interactive)
- (elp-reset-list elp-all-instrumented-list))
+ (mapatoms (lambda (sym)
+ (if (get sym elp-timer-info-property)
+ (elp-reset-function sym)))))
(defun elp-set-master (funsym)
"Set the master function for profiling."
- (interactive "aMaster function: ")
- ;; when there's a master function, recording is turned off by
- ;; default
+ (interactive
+ (list
+ (intern
+ (completing-read "Master function: " obarray
+ #'elp--instrumented-p
+ t nil nil (if elp-master (symbol-name elp-master))))))
+ ;; When there's a master function, recording is turned off by default.
(setq elp-master funsym
elp-record-p nil)
- ;; make sure master function is instrumented
- (or (memq funsym elp-all-instrumented-list)
+ ;; Make sure master function is instrumented.
+ (or (elp--instrumented-p funsym)
(elp-instrument-function funsym)))
(defun elp-unset-master ()
"Unset the master function."
(interactive)
- ;; when there's no master function, recording is turned on by default.
+ ;; When there's no master function, recording is turned on by default.
(setq elp-master nil
elp-record-p t))
(defsubst elp-elapsed-time (start end)
(float-time (time-subtract end start)))
-(defun elp-wrapper (funsym interactive-p args)
- "This function has been instrumented for profiling by the ELP.
+(defun elp--make-wrapper (funsym)
+ "Make the piece of advice that instruments FUNSYM."
+ (lambda (func &rest args)
+ "This function has been instrumented for profiling by the ELP.
ELP is the Emacs Lisp Profiler. To restore the function to its
original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
- ;; turn on recording if this is the master function
- (if (and elp-master
- (eq funsym elp-master))
- (setq elp-record-p t))
- ;; get info vector and original function symbol
- (let* ((info (get funsym elp-timer-info-property))
- (func (aref info 2))
- result)
- (or func
- (error "%s is not instrumented for profiling" funsym))
- (if (not elp-record-p)
- ;; when not recording, just call the original function symbol
- ;; and return the results.
- (setq result
- (if interactive-p
- (call-interactively func)
- (apply func args)))
- ;; we are recording times
- (let (enter-time exit-time)
- ;; increment the call-counter
- (aset info 0 (1+ (aref info 0)))
- ;; now call the old symbol function, checking to see if it
- ;; should be called interactively. make sure we return the
- ;; correct value
- (if interactive-p
- (setq enter-time (current-time)
- result (call-interactively func)
- exit-time (current-time))
+ ;; turn on recording if this is the master function
+ (if (and elp-master
+ (eq funsym elp-master))
+ (setq elp-record-p t))
+ ;; get info vector and original function symbol
+ (let* ((info (get funsym elp-timer-info-property))
+ result)
+ (or func
+ (error "%s is not instrumented for profiling" funsym))
+ (if (not elp-record-p)
+ ;; when not recording, just call the original function symbol
+ ;; and return the results.
+ (setq result (apply func args))
+ ;; we are recording times
+ (let (enter-time exit-time)
+ ;; increment the call-counter
+ (cl-incf (aref info 0))
(setq enter-time (current-time)
result (apply func args)
- exit-time (current-time)))
- ;; calculate total time in function
- (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time)))
- ))
- ;; turn off recording if this is the master function
- (if (and elp-master
- (eq funsym elp-master))
- (setq elp-record-p nil))
- result))
+ exit-time (current-time))
+ ;; calculate total time in function
+ (cl-incf (aref info 1) (elp-elapsed-time enter-time exit-time))
+ ))
+ ;; turn off recording if this is the master function
+ (if (and elp-master
+ (eq funsym elp-master))
+ (setq elp-record-p nil))
+ result)))
\f
;; shut the byte-compiler up
(elp-et-len (length et-header))
(at-header "Average Time")
(elp-at-len (length at-header))
- (resvec
- (mapcar
- (function
- (lambda (funsym)
- (let* ((info (get funsym elp-timer-info-property))
- (symname (format "%s" funsym))
- (cc (aref info 0))
- (tt (aref info 1)))
- (if (not info)
- (insert "No profiling information found for: "
- symname)
- (setq longest (max longest (length symname)))
- (vector cc tt (if (zerop cc)
- 0.0 ;avoid arithmetic div-by-zero errors
- (/ (float tt) (float cc)))
- symname)))))
- elp-all-instrumented-list))
+ (resvec '())
) ; end let*
+ (mapatoms
+ (lambda (funsym)
+ (when (elp--instrumented-p funsym)
+ (let* ((info (get funsym elp-timer-info-property))
+ (symname (format "%s" funsym))
+ (cc (aref info 0))
+ (tt (aref info 1)))
+ (if (not info)
+ (insert "No profiling information found for: "
+ symname)
+ (setq longest (max longest (length symname)))
+ (push
+ (vector cc tt (if (zerop cc)
+ 0.0 ;avoid arithmetic div-by-zero errors
+ (/ (float tt) (float cc)))
+ symname)
+ resvec))))))
;; If printing to stdout, insert the header so it will print.
;; Otherwise use header-line-format.
(setq elp-field-len (max titlelen longest))
(if (or elp-use-standard-output noninteractive)
- (progn
- (insert title)
- (if (> longest titlelen)
- (progn
- (insert-char 32 (- longest titlelen))))
- (insert " " cc-header " " et-header " " at-header "\n")
- (insert-char ?= elp-field-len)
- (insert " ")
- (insert-char ?= elp-cc-len)
- (insert " ")
- (insert-char ?= elp-et-len)
- (insert " ")
- (insert-char ?= elp-at-len)
- (insert "\n"))
- (let ((column 0))
- (setq header-line-format
- (mapconcat
- (lambda (title)
- (prog1
- (concat
- (propertize " "
- 'display (list 'space :align-to column)
- 'face 'fixed-pitch)
- title)
- (setq column (+ column 2
- (if (= column 0)
- elp-field-len
- (length title))))))
- (list title cc-header et-header at-header) ""))))
+ (progn
+ (insert title)
+ (if (> longest titlelen)
+ (progn
+ (insert-char 32 (- longest titlelen))))
+ (insert " " cc-header " " et-header " " at-header "\n")
+ (insert-char ?= elp-field-len)
+ (insert " ")
+ (insert-char ?= elp-cc-len)
+ (insert " ")
+ (insert-char ?= elp-et-len)
+ (insert " ")
+ (insert-char ?= elp-at-len)
+ (insert "\n"))
+ (let ((column 0))
+ (setq header-line-format
+ (mapconcat
+ (lambda (title)
+ (prog1
+ (concat
+ (propertize " "
+ 'display (list 'space :align-to column)
+ 'face 'fixed-pitch)
+ title)
+ (setq column (+ column 2
+ (if (= column 0)
+ elp-field-len
+ (length title))))))
+ (list title cc-header et-header at-header) ""))))
;; if sorting is enabled, then sort the results list. in either
;; case, call elp-output-result to output the result in the
;; buffer
(pop-to-buffer resultsbuf)
;; copy results to standard-output?
(if (or elp-use-standard-output noninteractive)
- (princ (buffer-substring (point-min) (point-max)))
+ (princ (buffer-substring (point-min) (point-max)))
(goto-char (point-min)))
;; reset profiling info if desired
(and elp-reset-after-results
`(logior (logand ,v ,mask)
(logand ,getter (lognot ,mask))))))))))
+;;; References
+
+;;;###autoload
+(defmacro gv-ref (place)
+ "Return a reference to PLACE.
+This is like the `&' operator of the C language."
+ (gv-letplace (getter setter) place
+ `(cons (lambda () ,getter)
+ (lambda (gv--val) ,(funcall setter 'gv--val)))))
+
+(defsubst gv-deref (ref)
+ "Dereference REF, returning the referenced value.
+This is like the `*' operator of the C language.
+REF must have been previously obtained with `gv-ref'."
+ (funcall (car ref)))
+;; Don't use `declare' because it seems to introduce circularity problems:
+;; Warning: Eager macro-expansion skipped due to cycle:
+;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
+(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
+
;;; Vaguely related definitions that should be moved elsewhere.
;; (defun alist-get (key alist)
--- /dev/null
+;;; nadvice.el --- Light-weight advice primitives for Elisp functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords: extensions, lisp, tools
+;; Package: emacs
+
+;; 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/>.
+
+;;; Commentary:
+
+;; This package lets you add behavior (which we call "piece of advice") to
+;; existing functions, like the old `advice.el' package, but with much fewer
+;; bells ans whistles. It comes in 2 parts:
+;;
+;; - The first part lets you add/remove functions, similarly to
+;; add/remove-hook, from any "place" (i.e. as accepted by `setf') that
+;; holds a function.
+;; This part provides mainly 2 macros: `add-function' and `remove-function'.
+;;
+;; - The second part provides `advice-add' and `advice-remove' which are
+;; refined version of the previous macros specially tailored for the case
+;; where the place that we want to modify is a `symbol-function'.
+
+;;; Code:
+
+;;;; Lightweight advice/hook
+(defvar advice--where-alist
+ '((:around "\300\301\302\003#\207" 5)
+ (:before "\300\301\002\"\210\300\302\002\"\207" 4)
+ (:after "\300\302\002\"\300\301\003\"\210\207" 5)
+ (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4)
+ (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4)
+ (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4)
+ (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4))
+ "List of descriptions of how to add a function.
+Each element has the form (WHERE BYTECODE STACK) where:
+ WHERE is a keyword indicating where the function is added.
+ BYTECODE is the corresponding byte-code that will be used.
+ STACK is the amount of stack space needed by the byte-code.")
+
+(defvar advice--bytecodes (mapcar #'cadr advice--where-alist))
+
+(defun advice--p (object)
+ (and (byte-code-function-p object)
+ (eq 128 (aref object 0))
+ (memq (length object) '(5 6))
+ (memq (aref object 1) advice--bytecodes)
+ (eq #'apply (aref (aref object 2) 0))))
+
+(defsubst advice--car (f) (aref (aref f 2) 1))
+(defsubst advice--cdr (f) (aref (aref f 2) 2))
+(defsubst advice--props (f) (aref (aref f 2) 3))
+
+(defun advice--make-docstring (_string function)
+ "Build the raw doc-string of SYMBOL, presumably advised."
+ (let ((flist (indirect-function function))
+ (docstring nil))
+ (if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
+ (while (advice--p flist)
+ (let ((bytecode (aref flist 1))
+ (where nil))
+ (dolist (elem advice--where-alist)
+ (if (eq bytecode (cadr elem)) (setq where (car elem))))
+ (setq docstring
+ (concat
+ docstring
+ (propertize (format "%s advice: " where)
+ 'face 'warning)
+ (let ((fun (advice--car flist)))
+ (if (symbolp fun) (format "`%S'" fun)
+ (let* ((name (cdr (assq 'name (advice--props flist))))
+ (doc (documentation fun t))
+ (usage (help-split-fundoc doc function)))
+ (if usage (setq doc (cdr usage)))
+ (if name
+ (if doc
+ (format "%s\n%s" name doc)
+ (format "%s" name))
+ (or doc "No documentation")))))
+ "\n")))
+ (setq flist (advice--cdr flist)))
+ (if docstring (setq docstring (concat docstring "\n")))
+ (let* ((origdoc (unless (eq function flist) ;Avoid inf-loops.
+ (documentation flist t)))
+ (usage (help-split-fundoc origdoc function)))
+ (setq usage (if (null usage)
+ (let ((arglist (help-function-arglist flist)))
+ (format "%S" (help-make-usage function arglist)))
+ (setq origdoc (cdr usage)) (car usage)))
+ (help-add-fundoc-usage (concat docstring origdoc) usage))))
+
+(defvar advice--docstring
+ ;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
+ ;; which drops the text-properties.
+ ;;(eval-when-compile
+ (propertize "Advised function"
+ 'dynamic-docstring-function #'advice--make-docstring)) ;; )
+
+(defun advice-eval-interactive-spec (spec)
+ "Evaluate the interactive spec SPEC."
+ (cond
+ ((stringp spec)
+ ;; There's no direct access to the C code (in call-interactively) that
+ ;; processes those specs, but that shouldn't stop us, should it?
+ ;; FIXME: Despite appearances, this is not faithful: SPEC and
+ ;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t
+ ;; command-history (and maybe a few other details).
+ (call-interactively `(lambda (&rest args) (interactive ,spec) args)))
+ ;; ((functionp spec) (funcall spec))
+ (t (eval spec))))
+
+(defun advice--make-interactive-form (function main)
+ ;; TODO: make it so that interactive spec can be a constant which
+ ;; dynamically checks the advice--car/cdr to do its job.
+ ;; For that, advice-eval-interactive-spec needs to be more faithful.
+ ;; FIXME: The calls to interactive-form below load autoloaded functions
+ ;; too eagerly.
+ (let ((fspec (cadr (interactive-form function))))
+ (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
+ (setq fspec (nth 1 fspec)))
+ (if (functionp fspec)
+ `(funcall ',fspec
+ ',(cadr (interactive-form main)))
+ (cadr (or (interactive-form function)
+ (interactive-form main))))))
+
+(defsubst advice--make-1 (byte-code stack-depth function main props)
+ "Build a function value that adds FUNCTION to MAIN."
+ (let ((adv-sig (gethash main advertised-signature-table))
+ (advice
+ (apply #'make-byte-code 128 byte-code
+ (vector #'apply function main props) stack-depth
+ advice--docstring
+ (when (or (commandp function) (commandp main))
+ (list (advice--make-interactive-form
+ function main))))))
+ (when adv-sig (puthash advice adv-sig advertised-signature-table))
+ advice))
+
+(defun advice--make (where function main props)
+ "Build a function value that adds FUNCTION to MAIN at WHERE.
+WHERE is a symbol to select an entry in `advice--where-alist'."
+ (let ((desc (assq where advice--where-alist)))
+ (unless desc (error "Unknown add-function location `%S'" where))
+ (advice--make-1 (nth 1 desc) (nth 2 desc)
+ function main props)))
+
+(defun advice--member-p (function definition)
+ (let ((found nil))
+ (while (and (not found) (advice--p definition))
+ (if (or (equal function (advice--car definition))
+ (equal function (cdr (assq 'name (advice--props definition)))))
+ (setq found t)
+ (setq definition (advice--cdr definition))))
+ found))
+
+;;;###autoload
+(defun advice--remove-function (flist function)
+ (if (not (advice--p flist))
+ flist
+ (let ((first (advice--car flist))
+ (props (advice--props flist)))
+ (if (or (equal function first)
+ (equal function (cdr (assq 'name props))))
+ (advice--cdr flist)
+ (let* ((rest (advice--cdr flist))
+ (nrest (advice--remove-function rest function)))
+ (if (eq rest nrest) flist
+ (advice--make-1 (aref flist 1) (aref flist 3)
+ first nrest props)))))))
+
+(defvar advice--buffer-local-function-sample nil)
+
+(defun advice--set-buffer-local (var val)
+ (if (function-equal val advice--buffer-local-function-sample)
+ (kill-local-variable var)
+ (set (make-local-variable var) val)))
+
+;;;###autoload
+(defun advice--buffer-local (var)
+ "Buffer-local value of VAR, presumed to contain a function."
+ (declare (gv-setter advice--set-buffer-local))
+ (if (local-variable-p var) (symbol-value var)
+ (setq advice--buffer-local-function-sample
+ (lambda (&rest args) (apply (default-value var) args)))))
+
+;;;###autoload
+(defmacro add-function (where place function &optional props)
+ ;; TODO:
+ ;; - obsolete with-wrapper-hook (mostly requires buffer-local support).
+ ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP
+ ;; and tracing want to stay first.
+ ;; - maybe let `where' specify some kind of predicate and use it
+ ;; to implement things like mode-local or eieio-defmethod.
+ ;; Of course, that only makes sense if the predicates of all advices can
+ ;; be combined and made more efficient.
+ ;; :before is like a normal add-hook on a normal hook.
+ ;; :before-while is like add-hook on run-hook-with-args-until-failure.
+ ;; :before-until is like add-hook on run-hook-with-args-until-success.
+ ;; Same with :after-* but for (add-hook ... 'append).
+ "Add a piece of advice on the function stored at PLACE.
+FUNCTION describes the code to add. WHERE describes where to add it.
+WHERE can be explained by showing the resulting new function, as the
+result of combining FUNCTION and the previous value of PLACE, which we
+call OLDFUN here:
+`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
+`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
+`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r))
+`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
+`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r)))
+`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
+`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r)))
+If FUNCTION was already added, do nothing.
+PROPS is an alist of additional properties, among which the following have
+a special meaning:
+- `name': a string or symbol. It can be used to refer to this piece of advice.
+
+PLACE cannot be a simple variable. Instead it should either be
+\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION
+should be applied to VAR buffer-locally or globally.
+
+If one of FUNCTION or OLDFUN is interactive, then the resulting function
+is also interactive. There are 3 cases:
+- FUNCTION is not interactive: the interactive spec of OLDFUN is used.
+- The interactive spec of FUNCTION is itself a function: it should take one
+ argument (the interactive spec of OLDFUN, which it can pass to
+ `advice-eval-interactive-spec') and return the list of arguments to use.
+- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
+ (declare (debug t)) ;;(indent 2)
+ (cond ((eq 'local (car-safe place))
+ (setq place `(advice--buffer-local ,@(cdr place))))
+ ((symbolp place)
+ (error "Use (default-value '%S) or (local '%S)" place place)))
+ `(advice--add-function ,where (gv-ref ,place) ,function ,props))
+
+;;;###autoload
+(defun advice--add-function (where ref function props)
+ (unless (advice--member-p function (gv-deref ref))
+ (setf (gv-deref ref)
+ (advice--make where function (gv-deref ref) props))))
+
+(defmacro remove-function (place function)
+ "Remove the FUNCTION piece of advice from PLACE.
+If FUNCTION was not added to PLACE, do nothing.
+Instead of FUNCTION being the actual function, it can also be the `name'
+of the piece of advice."
+ (declare (debug t))
+ (cond ((eq 'local (car-safe place))
+ (setq place `(advice--buffer-local ,@(cdr place))))
+ ((symbolp place)
+ (error "Use (default-value '%S) or (local '%S)" place place)))
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
+ `(unless (eq ,new ,getter) ,(funcall setter new)))))
+
+;;;; Specific application of add-function to `symbol-function' for advice.
+
+(defun advice--subst-main (old new)
+ (if (not (advice--p old))
+ new
+ (let* ((first (advice--car old))
+ (rest (advice--cdr old))
+ (props (advice--props old))
+ (nrest (advice--subst-main rest new)))
+ (if (equal rest nrest) old
+ (advice--make-1 (aref old 1) (aref old 3)
+ first nrest props)))))
+
+(defun advice--normalize (symbol def)
+ (cond
+ ((special-form-p def)
+ ;; Not worth the trouble trying to handle this, I think.
+ (error "advice-add failure: %S is a special form" symbol))
+ ((and (symbolp def)
+ (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
+ (let ((newval (cons 'macro (cdr (indirect-function def)))))
+ (put symbol 'advice--saved-rewrite (cons def newval))
+ newval))
+ ;; `f' might be a pure (hence read-only) cons!
+ ((and (eq 'macro (car-safe def))
+ (not (ignore-errors (setcdr def (cdr def)) t)))
+ (cons 'macro (cdr def)))
+ (t def)))
+
+(defsubst advice--strip-macro (x)
+ (if (eq 'macro (car-safe x)) (cdr x) x))
+
+(defun advice--defalias-fset (fsetfun symbol newdef)
+ (when (get symbol 'advice--saved-rewrite)
+ (put symbol 'advice--saved-rewrite nil))
+ (setq newdef (advice--normalize symbol newdef))
+ (let* ((olddef (advice--strip-macro
+ (if (fboundp symbol) (symbol-function symbol))))
+ (oldadv
+ (cond
+ ((null (get symbol 'advice--pending))
+ (or olddef
+ (progn
+ (message "Delayed advice activation failed for %s: no data"
+ symbol)
+ nil)))
+ ((or (not olddef) (autoloadp olddef))
+ (prog1 (get symbol 'advice--pending)
+ (put symbol 'advice--pending nil)))
+ (t (message "Dropping left-over advice--pending for %s" symbol)
+ (put symbol 'advice--pending nil)
+ olddef))))
+ (let* ((snewdef (advice--strip-macro newdef))
+ (snewadv (advice--subst-main oldadv snewdef)))
+ (funcall (or fsetfun #'fset) symbol
+ (if (eq snewdef newdef) snewadv (cons 'macro snewadv))))))
+
+
+;;;###autoload
+(defun advice-add (symbol where function &optional props)
+ "Like `add-function' but for the function named SYMBOL.
+Contrary to `add-function', this will properly handle the cases where SYMBOL
+is defined as a macro, alias, command, ..."
+ ;; TODO:
+ ;; - record the advice location, to display in describe-function.
+ ;; - change all defadvice in lisp/**/*.el.
+ ;; - rewrite advice.el on top of this.
+ ;; - obsolete advice.el.
+ (let* ((f (and (fboundp symbol) (symbol-function symbol)))
+ (nf (advice--normalize symbol f)))
+ (unless (eq f nf) ;; Most importantly, if nf == nil!
+ (fset symbol nf))
+ (add-function where (cond
+ ((eq (car-safe nf) 'macro) (cdr nf))
+ ;; Reasons to delay installation of the advice:
+ ;; - If the function is not yet defined, installing
+ ;; the advice would affect `fboundp'ness.
+ ;; - If it's an autoloaded command,
+ ;; advice--make-interactive-form would end up
+ ;; loading the command eagerly.
+ ;; - `autoload' does nothing if the function is
+ ;; not an autoload or undefined.
+ ((or (not nf) (autoloadp nf))
+ (get symbol 'advice--pending))
+ (t (symbol-function symbol)))
+ function props)
+ (add-function :around (get symbol 'defalias-fset-function)
+ #'advice--defalias-fset))
+ nil)
+
+;;;###autoload
+(defun advice-remove (symbol function)
+ "Like `remove-function' but for the function named SYMBOL.
+Contrary to `remove-function', this will work also when SYMBOL is a macro
+and it will not signal an error if SYMBOL is not `fboundp'.
+Instead of the actual function to remove, FUNCTION can also be the `name'
+of the piece of advice."
+ (when (fboundp symbol)
+ (let ((f (symbol-function symbol)))
+ ;; Can't use the `if' place here, because the body is too large,
+ ;; resulting in use of code that only works with lexical-scoping.
+ (remove-function (if (eq (car-safe f) 'macro)
+ (cdr f)
+ (symbol-function symbol))
+ function)
+ (unless (advice--p
+ (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
+ ;; Not advised any more.
+ (remove-function (get symbol 'defalias-fset-function)
+ #'advice--defalias-fset)
+ (if (eq (symbol-function symbol)
+ (cdr (get symbol 'advice--saved-rewrite)))
+ (fset symbol (car (get symbol 'advice--saved-rewrite))))))
+ nil))
+
+;; (defun advice-mapc (fun symbol)
+;; "Apply FUN to every function added as advice to SYMBOL.
+;; FUN is called with a two arguments: the function that was added, and the
+;; properties alist that was specified when it was added."
+;; (let ((def (or (get symbol 'advice--pending)
+;; (if (fboundp symbol) (symbol-function symbol)))))
+;; (while (advice--p def)
+;; (funcall fun (advice--car def) (advice--props def))
+;; (setq def (advice--cdr def)))))
+
+;;;###autoload
+(defun advice-member-p (advice function-name)
+ "Return non-nil if ADVICE has been added to FUNCTION-NAME.
+Instead of ADVICE being the actual function, it can also be the `name'
+of the piece of advice."
+ (advice--member-p advice
+ (or (get function-name 'advice--pending)
+ (advice--strip-macro
+ (if (fboundp function-name)
+ (symbol-function function-name))))))
+
+
+(provide 'nadvice)
+;;; nadvice.el ends here
;; History list for VALUE argument to setenv.
(defvar setenv-history nil)
+(defconst env--substitute-vars-regexp
+ "\\$\\(?:\\(?1:[[:alnum:]_]+\\)\\|{\\(?1:[^{}]+\\)}\\|\\$\\)")
-(defun substitute-env-vars (string)
+(defun substitute-env-vars (string &optional only-defined)
"Substitute environment variables referred to in STRING.
`$FOO' where FOO is an environment variable name means to substitute
the value of that variable. The variable name should be terminated
with a character not a letter, digit or underscore; otherwise, enclose
the entire variable name in braces. For instance, in `ab$cd-x',
`$cd' is treated as an environment variable.
+If ONLY-DEFINED is nil, references to undefined environment variables
+are replaced by the empty string; if it is non-nil, they are left unchanged.
Use `$$' to insert a single dollar sign."
(let ((start 0))
- (while (string-match
- (eval-when-compile
- (rx (or (and "$" (submatch (1+ (regexp "[[:alnum:]_]"))))
- (and "${" (submatch (minimal-match (0+ anything))) "}")
- "$$")))
- string start)
+ (while (string-match env--substitute-vars-regexp string start)
(cond ((match-beginning 1)
(let ((value (getenv (match-string 1 string))))
+ (if (and (null value) only-defined)
+ (setq start (match-end 0))
(setq string (replace-match (or value "") t t string)
- start (+ (match-beginning 0) (length value)))))
- ((match-beginning 2)
- (let ((value (getenv (match-string 2 string))))
- (setq string (replace-match (or value "") t t string)
- start (+ (match-beginning 0) (length value)))))
+ start (+ (match-beginning 0) (length value))))))
(t
(setq string (replace-match "$" t t string)
start (+ (match-beginning 0) 1)))))
the environment. Otherwise, value is a string.
If optional parameter FRAME is non-nil, then it should be a
-frame. This function will look up VARIABLE in its 'environment
+frame. This function will look up VARIABLE in its `environment'
parameter.
Otherwise, this function searches `process-environment' for
-2012-11-13 Glenn Morris <rgm@gnu.org>
+2012-11-16 Glenn Morris <rgm@gnu.org>
* erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc.
(eshell-eval-using-options
"mkdir" args
'((?h "help" nil nil "show this usage screen")
+ (?p "parents" nil em-parents "make parent directories as needed")
:external "mkdir"
:show-usage
:usage "[OPTION] DIRECTORY...
Create the DIRECTORY(ies), if they do not already exist.")
(while args
- (eshell-funcalln 'make-directory (car args))
+ (eshell-funcalln 'make-directory (car args) em-parents)
(setq args (cdr args)))
nil))
;;; Code:
-(eval-when-compile
- (require 'find-lisp))
-
(defgroup file-cache nil
"Find files using a pre-loaded cache."
:group 'files
(defun file-cache-add-file (file)
"Add FILE to the file cache."
(interactive "fAdd File: ")
- (if (not (file-exists-p file))
- (message "Filecache: file %s does not exist" file)
- (let* ((file-name (file-name-nondirectory file))
- (dir-name (file-name-directory file))
- (the-entry (assoc-string
- file-name file-cache-alist
- file-cache-ignore-case)))
- ;; Does the entry exist already?
- (if the-entry
- (if (or (and (stringp (cdr the-entry))
- (string= dir-name (cdr the-entry)))
- (and (listp (cdr the-entry))
- (member dir-name (cdr the-entry))))
- nil
- (setcdr the-entry (cons dir-name (cdr the-entry))))
- ;; If not, add it to the cache
- (push (list file-name dir-name) file-cache-alist)))))
+ (setq file (file-truename file))
+ (unless (file-exists-p file)
+ (error "Filecache: file %s does not exist" file))
+ (let* ((file-name (file-name-nondirectory file))
+ (dir-name (file-name-directory file))
+ (the-entry (assoc-string file-name file-cache-alist
+ file-cache-ignore-case)))
+ ;; Does the entry exist already?
+ (if the-entry
+ (unless (or (and (stringp (cdr the-entry))
+ (string= dir-name (cdr the-entry)))
+ (and (listp (cdr the-entry))
+ (member dir-name (cdr the-entry))))
+ (setcdr the-entry (cons dir-name (cdr the-entry))))
+ ;; If not, add it to the cache
+ (push (list file-name dir-name) file-cache-alist))))
;;;###autoload
(defun file-cache-add-directory-using-find (directory)
string)
(file-cache-add-from-file-cache-buffer))
+(autoload 'find-lisp-find-files "find-lisp")
+
;;;###autoload
(defun file-cache-add-directory-recursively (dir &optional regexp)
"Adds DIR and any subdirectories to the file-cache.
will be added to the cache. Note that the REGEXP is applied to the
files in each directory, not to the directory list itself."
(interactive "DAdd directory: ")
- (require 'find-lisp)
(mapcar
- (function
- (lambda (file)
- (or (file-directory-p file)
- (let (filtered)
- (dolist (regexp file-cache-filter-regexps)
- (and (string-match regexp file)
- (setq filtered t)))
- filtered)
- (file-cache-add-file file))))
- (find-lisp-find-files dir (if regexp regexp "^"))))
+ (lambda (file)
+ (or (file-directory-p file)
+ (let (filtered)
+ (dolist (regexp file-cache-filter-regexps)
+ (and (string-match regexp file)
+ (setq filtered t)))
+ filtered)
+ (file-cache-add-file file)))
+ (find-lisp-find-files dir (or regexp "^"))))
(defun file-cache-add-from-file-cache-buffer (&optional regexp)
"Add any entries found in the file cache buffer.
(setq ok t)))
ok))))))))
+(defun hack-one-local-variable--obsolete (var)
+ (let ((o (get var 'byte-obsolete-variable)))
+ (when o
+ (let ((instead (nth 0 o))
+ (since (nth 2 o)))
+ (message "%s is obsolete%s; %s"
+ var (if since (format " (since %s)" since))
+ (if (stringp instead) instead
+ (format "use `%s' instead" instead)))))))
+
(defun hack-one-local-variable (var val)
"Set local variable VAR with value VAL.
If VAR is `mode', call `VAL-mode' as a function unless it's
already the major mode."
- (cond ((eq var 'mode)
- (let ((mode (intern (concat (downcase (symbol-name val))
- "-mode"))))
- (unless (eq (indirect-function mode)
- (indirect-function major-mode))
- (if (memq mode minor-mode-list)
- ;; A minor mode must be passed an argument.
- ;; Otherwise, if the user enables the minor mode in a
- ;; major mode hook, this would toggle it off.
- (funcall mode 1)
- (funcall mode)))))
- ((eq var 'eval)
- (save-excursion (eval val)))
- (t
- ;; Make sure the string has no text properties.
- ;; Some text properties can get evaluated in various ways,
- ;; so it is risky to put them on with a local variable list.
- (if (stringp val)
- (set-text-properties 0 (length val) nil val))
- (set (make-local-variable var) val))))
+ (pcase var
+ (`mode
+ (let ((mode (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ (unless (eq (indirect-function mode)
+ (indirect-function major-mode))
+ (funcall mode))))
+ (`eval
+ (pcase val
+ (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
+ (save-excursion (eval val)))
+ (_
+ (hack-one-local-variable--obsolete var)
+ ;; Make sure the string has no text properties.
+ ;; Some text properties can get evaluated in various ways,
+ ;; so it is risky to put them on with a local variable list.
+ (if (stringp val)
+ (set-text-properties 0 (length val) nil val))
+ (set (make-local-variable var) val))))
\f
;;; Handling directory-local variables, aka project settings.
(concat (w32-shell-name) " -c " (buffer-file-name)))))
(eval-when-compile (require 'comint))
+(declare-function comint-mode "comint" ())
+(declare-function comint-exec "comint" (buffer name command startfile switches))
+
(defun bat-generic-mode-run-as-comint ()
"Run the current BAT file in a comint buffer."
(interactive)
* gnus-logic.el (gnus-advanced-body): Don't score by headers when
scoring by body.
-2012-11-13 Glenn Morris <rgm@gnu.org>
+2012-11-16 Glenn Morris <rgm@gnu.org>
* gnus-diary.el (nndiary-request-create-group-functions)
(nndiary-request-update-info-functions)
(nndiary-request-accept-article-functions):
Use new names for hooks rather than obsolete aliases.
+2012-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-parts): Always replace charset
+ in meta tag with the one the part specifies in its header.
+
+2012-11-02 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk>
+
+ * gnus-dired.el (gnus-dired-attach): Attach to last used message buffer
+ by default.
+
+2012-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ New UIDL implementation.
+
+ * mail-source.el (mail-sources, mail-source-keyword-map):
+ Add :leave as a pop3 keyword.
+ (mail-source-fetch-pop): Bind pop3-leave-mail-on-server.
+
+ * pop3.el (pop3-leave-mail-on-server): Allow number.
+ (pop3-uidl-file, pop3-uidl-file-backup): New user options.
+ (pop3-movemail): Add UIDL support.
+ (pop3-send-streaming-command): Take a list of mail numbers instead of
+ the number of mails.
+ (pop3-write-to-file): Add X-UIDL header.
+ (pop3-uidl-stat, pop3-uidl-dele, pop3-uidl-load, pop3-uidl-save)
+ (pop3-uidl-add-xheader): New functions.
+
+ * message.el (message-ignored-resent-headers):
+ Add X-Content-Length and X-UIDL headers.
+
2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
* nndiary.el (nndiary-request-create-group-functions)
;; Add a meta html tag to specify charset and a header.
(cond
(header
- (let (title eheader body hcharset coding force-charset)
+ (let (title eheader body hcharset coding)
(with-temp-buffer
(mm-enable-multibyte)
(setq case-fold-search t)
charset)
title (when title
(mm-encode-coding-string title charset))
- body (mm-encode-coding-string content charset)
- force-charset t)
+ body (mm-encode-coding-string content charset))
(setq hcharset (mm-find-mime-charset-region (point-min)
(point-max)))
(cond ((= (length hcharset) 1)
body (mm-encode-coding-string
(mm-decode-coding-string
content body)
- charset)
- force-charset t)))
+ charset))))
(setq charset hcharset
eheader (mm-encode-coding-string
(buffer-string) coding)
(mm-disable-multibyte)
(insert body)
(when charset
- (mm-add-meta-html-tag handle charset force-charset))
+ (mm-add-meta-html-tag handle charset t))
(when title
(goto-char (point-min))
(unless (search-forward "<title>" nil t)
(setq destination
(if (= (length bufs) 1)
(get-buffer (car bufs))
- (gnus-completing-read "Attach to which mail composition buffer"
- bufs t)))
+ (gnus-completing-read "Attach to buffer"
+ bufs t nil nil (car bufs))))
;; setup a new mail composition buffer
(let ((mail-user-agent gnus-dired-mail-mode)
;; A workaround to prevent Gnus from displaying the Gnus
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
- :version "23.1" ;; No Gnus
+ :version "24.4"
:link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(choice
(const :tag "None" nil)
:value nil
(const :tag "Clear" nil)
(const starttls)
- (const :tag "SSL/TLS" ssl)))))
+ (const :tag "SSL/TLS" ssl)))
+ (group :inline t
+ (const :format "" :value :leave)
+ (choice :format "\
+%{Leave mail on server%}:\n\t\t%[Value Menu%] %v"
+ :value nil
+ (const :tag "\
+Don't leave mails" nil)
+ (const :tag "\
+Leave all mails" t)
+ (number :tag "\
+Leave mails for this many days" :value 14)))))
(cons :tag "Maildir (qmail, postfix...)"
(const :format "" maildir)
(checklist :tag "Options" :greedy t
(:function)
(:password)
(:authentication password)
- (:stream nil))
+ (:stream nil)
+ (:leave))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
(:subdirs ("cur" "new"))
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass))
- (pop3-stream-type stream))
+ (pop3-stream-type stream)
+ (pop3-leave-mail-on-server leave))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-movemail mail-source-crash-box))
(condition-case err
;; comes back to you (e.g. a mailing-list to which you subscribe, in which
;; case you may be removed from the list on the grounds that mail to you
;; bounced with a "mailing loop" error).
- "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:"
+ "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\
+\\|^X-Content-Length:\\|^X-UIDL:"
"*All headers that match this regexp will be deleted when resending a message."
+ :version "24.4"
:group 'message-interface
:link '(custom-manual "(message)Resending")
:type '(repeat :value-to-internal (lambda (widget value)
:group 'pop3)
(defcustom pop3-leave-mail-on-server nil
- "*Non-nil if the mail is to be left on the POP server after fetching.
-
-If `pop3-leave-mail-on-server' is non-nil the mail is to be left
-on the POP server after fetching. Note that POP servers maintain
-no state information between sessions, so what the client
-believes is there and what is actually there may not match up.
-If they do not, then you may get duplicate mails or the whole
-thing can fall apart and leave you with a corrupt mailbox."
- ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org:
- ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de
- ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org
- ;; Any volunteer to re-implement this?
- :version "22.1" ;; Oort Gnus
- :type 'boolean
+ "Non-nil if the mail is to be left on the POP server after fetching.
+Mails once fetched will never be fetched again by the UIDL control.
+
+If this is neither nil nor a number, all mails will be left on the
+server. If this is a number, leave mails on the server for this many
+days since you first checked new mails. If this is nil, mails will be
+deleted on the server right after fetching.
+
+Gnus users should use the `:leave' keyword in a mail source to direct
+the behaviour per server, rather than directly modifying this value.
+
+Note that POP servers maintain no state information between sessions,
+so what the client believes is there and what is actually there may
+not match up. If they do not, then you may get duplicate mails or
+the whole thing can fall apart and leave you with a corrupt mailbox."
+ :version "24.4"
+ :type '(choice (const :tag "Don't leave mails" nil)
+ (const :tag "Leave all mails" t)
+ (number :tag "Leave mails for this many days" :value 14))
+ :group 'pop3)
+
+(defcustom pop3-uidl-file "~/.pop3-uidl"
+ "File used to save UIDL."
+ :version "24.4"
+ :type 'file
+ :group 'pop3)
+
+(defcustom pop3-uidl-file-backup '(0 9)
+ "How to backup the UIDL file `pop3-uidl-file' when updating.
+If it is a list of numbers, the first one binds `kept-old-versions' and
+the other binds `kept-new-versions' to keep number of oldest and newest
+versions. Otherwise, the value binds `version-control' (which see).
+
+Note: Backup will take place whenever you check new mails on a server.
+So, you may lose the backup files having been saved before a trouble
+if you set it so as to make too few backups whereas you have access to
+many servers."
+ :version "24.4"
+ :type '(choice (group :tag "Keep versions" :format "\n%v" :indent 3
+ (number :tag "oldest")
+ (number :tag "newest"))
+ (sexp :format "%v"
+ :match (lambda (widget value)
+ (condition-case nil
+ (not (and (numberp (car value))
+ (numberp (car (cdr value)))))
+ (error t)))))
:group 'pop3)
(defvar pop3-timestamp nil
(truncate pop3-read-timeout))
1000))))))
+(defvar pop3-uidl)
+;; List of UIDLs of existing messages at present in the server:
+;; ("UIDL1" "UIDL2" "UIDL3"...)
+
+(defvar pop3-uidl-saved)
+;; Locally saved UIDL data; an alist of the server, the user, and the UIDL
+;; and timestamp pairs:
+;; (("SERVER_A" ("USER_A1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ("USER_A2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ...)
+;; ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ...))
+;; Where TIMESTAMP is the most significant two digits of an Emacs time,
+;; i.e. the return value of `current-time'.
+
;;;###autoload
(defun pop3-movemail (file)
"Transfer contents of a maildrop to the specified FILE.
Use streaming commands."
- (let* ((process (pop3-open-server pop3-mailhost pop3-port))
- message-count message-total-size)
+ (let ((process (pop3-open-server pop3-mailhost pop3-port))
+ messages total-size
+ pop3-uidl
+ pop3-uidl-saved)
(pop3-logon process)
- (with-current-buffer (process-buffer process)
+ (if pop3-leave-mail-on-server
+ (setq messages (pop3-uidl-stat process)
+ total-size (cadr messages)
+ messages (car messages))
(let ((size (pop3-stat process)))
- (setq message-count (car size)
- message-total-size (cadr size)))
- (when (> message-count 0)
- (pop3-send-streaming-command
- process "RETR" message-count message-total-size)
- (pop3-write-to-file file)
+ (dotimes (i (car size)) (push (1+ i) messages))
+ (setq messages (nreverse messages)
+ total-size (cadr size))))
+ (when messages
+ (with-current-buffer (process-buffer process)
+ (pop3-send-streaming-command process "RETR" messages total-size)
+ (pop3-write-to-file file messages)
(unless pop3-leave-mail-on-server
- (pop3-send-streaming-command
- process "DELE" message-count nil))))
- (pop3-quit process)
+ (pop3-send-streaming-command process "DELE" messages nil))))
+ (if pop3-leave-mail-on-server
+ (when (prog1 (pop3-uidl-dele process) (pop3-quit process))
+ (pop3-uidl-save))
+ (pop3-quit process)
+ ;; Remove UIDL data for the account that got not to leave mails.
+ (setq pop3-uidl-saved (pop3-uidl-load))
+ (let ((elt (assoc pop3-maildrop
+ (cdr (assoc pop3-mailhost pop3-uidl-saved)))))
+ (when elt
+ (setcdr elt nil)
+ (pop3-uidl-save))))
t))
-(defun pop3-send-streaming-command (process command count total-size)
+(defun pop3-send-streaming-command (process command messages total-size)
(erase-buffer)
- (let ((i 1)
+ (let ((count (length messages))
+ (i 1)
(start-point (point-min))
(waited-for 0))
- (while (>= count i)
- (process-send-string process (format "%s %d\r\n" command i))
+ (while messages
+ (process-send-string process (format "%s %d\r\n" command (pop messages)))
;; Only do 100 messages at a time to avoid pipe stalls.
(when (zerop (% i pop3-stream-length))
(setq start-point
(pop3-accept-process-output process))
start-point)
-(defun pop3-write-to-file (file)
+(defun pop3-write-to-file (file messages)
(let ((pop-buffer (current-buffer))
(start (point-min))
beg end
(pop3-clean-region hstart (point))
(goto-char (point-max))
(pop3-munge-message-separator hstart (point))
+ (when pop3-leave-mail-on-server
+ (pop3-uidl-add-xheader hstart (pop messages)))
(goto-char (point-max))))))
(let ((coding-system-for-write 'binary))
(goto-char (point-min))
(pop3-quit process)
message-count))
+(defun pop3-uidl-stat (process)
+ "Return a list of unread message numbers and total size."
+ (pop3-send-command process "UIDL")
+ (let (err messages size)
+ (if (condition-case code
+ (progn
+ (pop3-read-response process)
+ t)
+ (error (setq err (error-message-string code))
+ nil))
+ (let ((start pop3-read-point)
+ saved list)
+ (with-current-buffer (process-buffer process)
+ (while (not (re-search-forward "^\\.\r\n" nil t))
+ (unless (memq (process-status process) '(open run))
+ (error "pop3 server closed the connection"))
+ (pop3-accept-process-output process)
+ (goto-char start))
+ (setq pop3-read-point (point-marker)
+ pop3-uidl nil)
+ (while (progn (forward-line -1) (>= (point) start))
+ (when (looking-at "[0-9]+ \\([^\n\r ]+\\)")
+ (push (match-string 1) pop3-uidl)))
+ (when pop3-uidl
+ (setq pop3-uidl-saved (pop3-uidl-load)
+ saved (cdr (assoc pop3-maildrop
+ (cdr (assoc pop3-mailhost
+ pop3-uidl-saved)))))
+ (let ((i (length pop3-uidl)))
+ (while (> i 0)
+ (unless (member (nth (1- i) pop3-uidl) saved)
+ (push i messages))
+ (decf i)))
+ (when messages
+ (setq list (pop3-list process)
+ size 0)
+ (dolist (msg messages)
+ (setq size (+ size (cdr (assq msg list)))))
+ (list messages size)))))
+ (message "%s doesn't support UIDL (%s), so we try a regressive way..."
+ pop3-mailhost err)
+ (sit-for 1)
+ (setq size (pop3-stat process))
+ (dotimes (i (car size)) (push (1+ i) messages))
+ (setcar size (nreverse messages))
+ size)))
+
+(defun pop3-uidl-dele (process)
+ "Delete messages according to `pop3-leave-mail-on-server'.
+Return non-nil if it is necessary to update the local UIDL file."
+ (let* ((ctime (current-time))
+ (srvr (assoc pop3-mailhost pop3-uidl-saved))
+ (saved (assoc pop3-maildrop (cdr srvr)))
+ i uidl mod new tstamp dele)
+ (setcdr (cdr ctime) nil)
+ ;; Add new messages to the data to be saved.
+ (cond ((and pop3-uidl saved)
+ (setq i (1- (length pop3-uidl)))
+ (while (>= i 0)
+ (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved))
+ (push ctime new)
+ (push uidl new))
+ (decf i)))
+ (pop3-uidl
+ (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime))
+ pop3-uidl)))))
+ (when new (setq mod t))
+ ;; List expirable messages and delete them from the data to be saved.
+ (setq ctime (when (numberp pop3-leave-mail-on-server)
+ (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400))
+ i (1- (length saved)))
+ (while (> i 0)
+ (if (member (setq uidl (nth (1- i) saved)) pop3-uidl)
+ (progn
+ (setq tstamp (nth i saved))
+ (if (and ctime
+ (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp))
+ 86400))
+ pop3-leave-mail-on-server))
+ ;; Mails to delete.
+ (progn
+ (setq mod t)
+ (push uidl dele))
+ ;; Mails to keep.
+ (push tstamp new)
+ (push uidl new)))
+ ;; Mails having been deleted in the server.
+ (setq mod t))
+ (decf i 2))
+ (cond (saved
+ (setcdr saved new))
+ (srvr
+ (setcdr (last srvr) (list (cons pop3-maildrop new))))
+ (t
+ (add-to-list 'pop3-uidl-saved
+ (list pop3-mailhost (cons pop3-maildrop new))
+ t)))
+ ;; Actually delete the messages in the server.
+ (when dele
+ (setq uidl nil
+ i (length pop3-uidl))
+ (while (> i 0)
+ (when (member (nth (1- i) pop3-uidl) dele)
+ (push i uidl))
+ (decf i))
+ (when uidl
+ (pop3-send-streaming-command process "DELE" uidl nil)))
+ mod))
+
+(defun pop3-uidl-load ()
+ "Load saved UIDL."
+ (when (file-exists-p pop3-uidl-file)
+ (with-temp-buffer
+ (condition-case code
+ (progn
+ (insert-file-contents pop3-uidl-file)
+ (goto-char (point-min))
+ (read (current-buffer)))
+ (error
+ (message "Error while loading %s (%s)"
+ pop3-uidl-file (error-message-string code))
+ (sit-for 1)
+ nil)))))
+
+(defun pop3-uidl-save ()
+ "Save UIDL."
+ (with-temp-buffer
+ (if pop3-uidl-saved
+ (progn
+ (insert "(")
+ (dolist (srvr pop3-uidl-saved)
+ (when (cdr srvr)
+ (insert "(\"" (pop srvr) "\"\n ")
+ (dolist (elt srvr)
+ (when (cdr elt)
+ (insert "(\"" (pop elt) "\"\n ")
+ (while elt
+ (insert (format "\"%s\" %s\n " (pop elt) (pop elt))))
+ (delete-char -4)
+ (insert ")\n ")))
+ (delete-char -3)
+ (if (eq (char-before) ?\))
+ (insert ")\n ")
+ (goto-char (1+ (point-at-bol)))
+ (delete-region (point) (point-max)))))
+ (when (eq (char-before) ? )
+ (delete-char -2))
+ (insert ")\n"))
+ (insert "()\n"))
+ (let ((buffer-file-name pop3-uidl-file)
+ (delete-old-versions t)
+ (kept-new-versions kept-new-versions)
+ (kept-old-versions kept-old-versions)
+ (version-control version-control))
+ (if (consp pop3-uidl-file-backup)
+ (setq kept-new-versions (cadr pop3-uidl-file-backup)
+ kept-old-versions (car pop3-uidl-file-backup)
+ version-control t)
+ (setq version-control pop3-uidl-file-backup))
+ (save-buffer))))
+
+(defun pop3-uidl-add-xheader (start msgno)
+ "Add X-UIDL header."
+ (let ((case-fold-search t))
+ (save-restriction
+ (narrow-to-region start (progn
+ (goto-char start)
+ (search-forward "\n\n" nil 'move)
+ (1- (point))))
+ (goto-char start)
+ (while (re-search-forward "^x-uidl:" nil t)
+ (while (progn
+ (forward-line 1)
+ (memq (char-after) '(?\t ? ))))
+ (delete-region (match-beginning 0) (point)))
+ (goto-char (point-max))
+ (insert "X-UIDL: " (nth (1- msgno) pop3-uidl) "\n"))))
+
(defcustom pop3-stream-type nil
"*Transport security type for POP3 connections.
This may be either nil (plain connection), `ssl' (use an
;; Possible responses:
;; +OK [all delete marks removed]
+;; UIDL [msg]
+;; Arguments: a message-id (optional)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [uidl listing follows]
+;; -ERR [no such message]
+
;;; UPDATE STATE
;; QUIT
" is also a " "face." "\n\n" facedoc))
;; Don't record the `describe-function' item in the stack.
(setq help-xref-stack-item nil)
- (help-setup-xref (list #'help-xref-interned symbol) nil)))))))
+ (help-setup-xref (list #'help-xref-interned symbol) nil))))
+ (goto-char (point-min)))))
\f
;; Navigation/hyperlinking with xrefs
(defun ibuffer-mark-forward (arg)
"Mark the buffer on this line, and move forward ARG lines.
If point is on a group name, this function operates on that group."
- (interactive "P")
- (ibuffer-mark-interactive arg ibuffer-marked-char 1))
+ (interactive "p")
+ (ibuffer-mark-interactive arg ibuffer-marked-char))
(defun ibuffer-unmark-forward (arg)
"Unmark the buffer on this line, and move forward ARG lines.
If point is on a group name, this function operates on that group."
- (interactive "P")
- (ibuffer-mark-interactive arg ?\s 1))
+ (interactive "p")
+ (ibuffer-mark-interactive arg ?\s))
(defun ibuffer-unmark-backward (arg)
"Unmark the buffer on this line, and move backward ARG lines.
If point is on a group name, this function operates on that group."
- (interactive "P")
- (ibuffer-mark-interactive arg ?\s -1))
+ (interactive "p")
+ (ibuffer-unmark-forward (- arg)))
-(defun ibuffer-mark-interactive (arg mark movement)
+(defun ibuffer-mark-interactive (arg mark &optional movement)
(ibuffer-assert-ibuffer-mode)
(or arg (setq arg 1))
+ ;; deprecated movement argument
+ (when (and movement (< movement 0))
+ (setq arg (- arg)))
(ibuffer-forward-line 0)
(ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
(progn
(let ((inhibit-read-only t))
(while (> arg 0)
(ibuffer-set-mark mark)
- (ibuffer-forward-line movement t)
- (setq arg (1- arg))))))
+ (ibuffer-forward-line 1 t)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (ibuffer-forward-line -1 t)
+ (ibuffer-set-mark mark)
+ (setq arg (1+ arg))))))
(defun ibuffer-set-mark (mark)
(ibuffer-assert-ibuffer-mode)
ido-enable-flex-matching
(> (length ido-text) 1)
(not ido-enable-regexp))
- (setq re (mapconcat #'regexp-quote (split-string ido-text "" t) ".*"))
+ (setq re (concat (regexp-quote (string (aref ido-text 0)))
+ (mapconcat (lambda (c)
+ (concat "[^" (string c) "]*"
+ (regexp-quote (string c))))
+ (substring ido-text 1) "")))
(if ido-enable-prefix
(setq re (concat "\\`" re)))
(mapc
(defvar image-dired-widget-list nil
"List to keep track of meta data in edit buffer.")
+(declare-function widget-forward "wid-edit" (arg))
+
;;;###autoload
(defun image-dired-dired-edit-comment-and-tags ()
"Edit comment and tags of current or marked image files.
Value is a symbol specifying the image type, or nil if type cannot
be determined."
(let (type first)
- (or
- (catch 'found
- (dolist (elem image-type-file-name-regexps)
- (when (string-match-p (car elem) file)
- (setq type (cdr elem))
- (or first (setq first type))
- (if (image-type-available-p type)
- (throw 'found type)))))
- ;; If nothing seems to be supported, return the first type that matched.
- first)))
+ (catch 'found
+ (dolist (elem image-type-file-name-regexps first)
+ (when (string-match-p (car elem) file)
+ (if (image-type-available-p (setq type (cdr elem)))
+ (throw 'found type)
+ ;; If nothing seems to be supported, return first type that matched.
+ (or first (setq first type))))))))
;;;###autoload
(defun image-type (source &optional type data-p)
Return a split and sorted copy of ALIST. The returned alist DOES
NOT share structure with ALIST."
(mapcar (lambda (elt)
- (if (and (consp elt)
- (stringp (car elt))
- (listp (cdr elt)))
+ (if (imenu--subalist-p elt)
(imenu--split-menu (cdr elt) (car elt))
elt))
alist))
;; current Info node.
(eval-when-compile (require 'speedbar))
+(declare-function speedbar-add-expansion-list "speedbar" (new-list))
+(declare-function speedbar-center-buffer-smartly "speedbar" ())
+(declare-function speedbar-change-expand-button-char "speedbar" (char))
+(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default))
+(declare-function speedbar-delete-subblock "speedbar" (indent))
+(declare-function speedbar-make-specialized-keymap "speedbar" ())
+(declare-function speedbar-make-tag-line "speedbar"
+ (exp-button-type exp-button-char exp-button-function
+ exp-button-data tag-button tag-button-function
+ tag-button-data tag-button-face depth))
+
(defvar Info-speedbar-key-map nil
"Keymap used when in the Info display mode.")
they exit Isearch mode before displaying global help."
isearch-help-map)
+(defvar isearch--display-help-action '(nil (inhibit-same-window . t)))
+
(defun isearch-help-for-help ()
"Display Isearch help menu."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(isearch-help-for-help-internal))
(isearch-update))
"Show a list of all keys defined in Isearch mode, and their definitions.
This is like `describe-bindings', but displays only Isearch keys."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(with-help-window "*Help*"
(with-current-buffer standard-output
(princ "Isearch Mode Bindings:\n")
(defun isearch-describe-key ()
"Display documentation of the function invoked by isearch key."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(call-interactively 'describe-key))
(isearch-update))
(defun isearch-describe-mode ()
"Display documentation of Isearch mode."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(describe-function 'isearch-forward))
(isearch-update))
;; User options end here.
-(defvar report-emacs-bug-tracker-url "http://debbugs.gnu.org/cgi/"
- "Base URL of the GNU bugtracker.
-Used for querying duplicates and linking to existing bugs.")
-
(defvar report-emacs-bug-orig-text nil
"The automatically-created initial text of the bug report.")
(delete-region pos (field-end (1+ pos)))))))
-;; Querying the bug database
-
-(defvar report-emacs-bug-bug-alist nil)
-(make-variable-buffer-local 'report-emacs-bug-bug-alist)
-(defvar report-emacs-bug-choice-widget nil)
-(make-variable-buffer-local 'report-emacs-bug-choice-widget)
-
-(defun report-emacs-bug-create-existing-bugs-buffer (bugs keywords)
- (switch-to-buffer (get-buffer-create "*Existing Emacs Bugs*"))
- (setq buffer-read-only t)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (setq report-emacs-bug-bug-alist bugs)
- (widget-insert (propertize (concat "Already known bugs ("
- keywords "):\n\n")
- 'face 'bold))
- (if bugs
- (setq report-emacs-bug-choice-widget
- (apply 'widget-create 'radio-button-choice
- :value (caar bugs)
- (let (items)
- (dolist (bug bugs)
- (push (list
- 'url-link
- :format (concat "Bug#" (number-to-string (nth 2 bug))
- ": " (cadr bug) "\n %[%v%]\n")
- ;; FIXME: Why is only the link of the
- ;; active item clickable?
- (car bug))
- items))
- (nreverse items))))
- (widget-insert "No bugs matching your keywords found.\n"))
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- ;; TODO: Do something!
- (message "Reporting new bug!"))
- "Report new bug")
- (when bugs
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let ((val (widget-value report-emacs-bug-choice-widget)))
- ;; TODO: Do something!
- (message "Appending to bug %s!"
- (nth 2 (assoc val report-emacs-bug-bug-alist)))))
- "Append to chosen bug"))
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (kill-buffer))
- "Quit reporting bug")
- (widget-insert "\n"))
- (use-local-map widget-keymap)
- (widget-setup)
- (goto-char (point-min)))
-
-(defun report-emacs-bug-parse-query-results (status keywords)
- (goto-char (point-min))
- (let (buglist)
- (while (re-search-forward "<a href=\"bugreport\\.cgi\\?bug=\\([[:digit:]]+\\)\">\\([^<]+\\)</a>" nil t)
- (let ((number (match-string 1))
- (subject (match-string 2)))
- (when (not (string-match "^#" subject))
- (push (list
- ;; first the bug URL
- (concat report-emacs-bug-tracker-url
- "bugreport.cgi?bug=" number)
- ;; then the subject and number
- subject (string-to-number number))
- buglist))))
- (report-emacs-bug-create-existing-bugs-buffer (nreverse buglist) keywords)))
-
-(defun report-emacs-bug-query-existing-bugs (keywords)
- "Query for KEYWORDS at `report-emacs-bug-tracker-url', and return the result.
-The result is an alist with items of the form (URL SUBJECT NO)."
- (interactive "sBug keywords (comma separated): ")
- (url-retrieve (concat report-emacs-bug-tracker-url
- "pkgreport.cgi?include=subject%3A"
- (replace-regexp-in-string "[[:space:]]+" "+" keywords)
- ";package=emacs")
- 'report-emacs-bug-parse-query-results (list keywords)))
-(make-obsolete 'report-emacs-bug-query-existing-bugs
- "use the `debbugs' package from GNU ELPA instead." "24.3")
-
(provide 'emacsbug)
;;; emacsbug.el ends here
;;; Todo:
+;; - Make *Completions* readable even if some of the completion
+;; entries have LF chars or spaces in them (including at
+;; beginning/end) or are very long.
;; - for M-x, cycle-sort commands that have no key binding first.
;; - Make things like icomplete-mode or lightning-completion work with
;; completion-in-region-mode.
;; - whether the user wants completion to pay attention to case.
;; e.g. we may want to make it possible for the user to say "first try
;; completion case-sensitively, and if that fails, try to ignore case".
+;; Maybe the trick is that we should distinguish completion-ignore-case in
+;; try/all-completions (obey user's preference) from its use in
+;; test-completion (obey the underlying object's semantics).
;; - add support for ** to pcm.
;; - Add vc-file-name-completion-table to read-file-name-internal.
process-environment))
(defconst completion--embedded-envvar-re
+ ;; We can't reuse env--substitute-vars-regexp because we need to match only
+ ;; potentially-unfinished envvars at end of string.
(concat "\\(?:^\\|[^$]\\(?:\\$\\$\\)*\\)"
"$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'"))
(or (file-modes filename)
(logand (default-file-modes) (tramp-compat-octal-to-decimal "0666"))))
-(defun tramp-replace-environment-variables (filename)
- "Replace environment variables in FILENAME.
+(defalias 'tramp-replace-environment-variables
+ (if (ignore-errors
+ (equal "${ tramp?}" (substitute-env-vars "${ tramp?}" 'only-defined)))
+ (lambda (filename)
+ "Like `substitute-env-vars' with `only-defined' non-nil."
+ (substitute-env-vars filename 'only-defined))
+ (lambda (filename)
+ "Replace environment variables in FILENAME.
Return the string with the replaced variables."
- (save-match-data
- (let ((idx (string-match "$\\(\\w+\\)" filename)))
- ;; `$' is coded as `$$'.
- (when (and idx
- (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
- (getenv (match-string 1 filename)))
- (setq filename
- (replace-match
- (substitute-in-file-name (match-string 0 filename))
- t nil filename)))
- filename)))
+ (save-match-data
+ (let ((idx (string-match "$\\(\\w+\\)" filename)))
+ ;; `$' is coded as `$$'.
+ (when (and idx
+ (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
+ (getenv (match-string 1 filename)))
+ (setq filename
+ (replace-match
+ (substitute-in-file-name (match-string 0 filename))
+ t nil filename)))
+ filename)))))
;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
;; which calls corresponding functions (see minibuf.el).
(defconst notifications-get-capabilities-method "GetCapabilities"
"D-Bus notifications get capabilities method.")
+(defconst notifications-get-server-information-method "GetServerInformation"
+ "D-Bus notifications get server information method.")
+
(defconst notifications-action-signal "ActionInvoked"
"D-Bus notifications action signal.")
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
(defun notifications-get-capabilities (&optional bus)
- "Return the capabilities of the notification server, a list of strings.
+ "Return the capabilities of the notification server, a list of symbols.
BUS can be a string denoting a D-Bus connection, the default is `:session'.
The following capabilities can be expected:
Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
(dbus-ignore-errors
- (mapcar
- (lambda (x) (intern (concat ":" x)))
+ (mapcar
+ (lambda (x) (intern (concat ":" x)))
+ (dbus-call-method (or bus :session)
+ notifications-service
+ notifications-path
+ notifications-interface
+ notifications-get-capabilities-method))))
+
+(defun notifications-get-server-information (&optional bus)
+ "Return information on the notification server, a list of strings.
+BUS can be a string denoting a D-Bus connection, the default is `:session'.
+The returned list is (NAME VENDOR VERSION SPEC-VERSION).
+
+ NAME The product name of the server.
+ VENDOR The vendor name. For example, \"KDE\", \"GNOME\".
+ VERSION The server's version number.
+ SPEC-VERSION The specification version the server is compliant with.
+
+If SPEC_VERSION is missing, the server supports a specification
+prior to \"1.0\".
+
+See `notifications-specification-version' for the specification
+version this library is compliant with."
+ (dbus-ignore-errors
(dbus-call-method (or bus :session)
notifications-service
notifications-path
notifications-interface
- notifications-get-capabilities-method))))
+ notifications-get-server-information-method)))
(provide 'notifications)
(goto-char (point-min))
(search-forward (concat (int-to-string score)
" " (user-login-name) " "
- marker-string))
+ marker-string) nil t)
(beginning-of-line)))))
(defun gamegrid-add-score-insecure (file score &optional directory)
(eval-when-compile
(require 'easymenu)) ; to avoid compilation gripes
+ (declare-function easy-menu-add-item "easymenu"
+ (map path item &optional before))
+ (declare-function easy-menu-remove-item "easymenu" (map path name))
+
(eval-and-compile
(defun pr-global-menubar (pr-menu-spec)
(require 'easymenu)
(and pr-i-region ; let region activated
(pr-keep-region-active)))
+(declare-function widget-field-action "wid-edit" (widget &optional _event))
+(declare-function widget-value-set "wid-edit" (widget value))
(defun pr-insert-section-1 ()
;; 1. Print:
;;; Filling
+(defvar js--filling-paragraph nil)
+
+;; FIXME: Such redefinitions are bad style. We should try and use some other
+;; way to get the same result.
+(defadvice c-forward-sws (around js-fill-paragraph activate)
+ (if js--filling-paragraph
+ (setq ad-return-value (js--forward-syntactic-ws (ad-get-arg 0)))
+ ad-do-it))
+
+(defadvice c-backward-sws (around js-fill-paragraph activate)
+ (if js--filling-paragraph
+ (setq ad-return-value (js--backward-syntactic-ws (ad-get-arg 0)))
+ ad-do-it))
+
+(defadvice c-beginning-of-macro (around js-fill-paragraph activate)
+ (if js--filling-paragraph
+ (setq ad-return-value (js--beginning-of-macro (ad-get-arg 0)))
+ ad-do-it))
+
(defun js-c-fill-paragraph (&optional justify)
"Fill the paragraph with `c-fill-paragraph'."
(interactive "*P")
- ;; FIXME: Such redefinitions are bad style. We should try and use some other
- ;; way to get the same result.
- (cl-letf (((symbol-function 'c-forward-sws)
- (lambda (&optional limit)
- (js--forward-syntactic-ws limit)))
- ((symbol-function 'c-backward-sws)
- (lambda (&optional limit)
- (js--backward-syntactic-ws limit)))
- ((symbol-function 'c-beginning-of-macro)
- (lambda (&optional limit)
- (js--beginning-of-macro limit))))
- (let ((fill-paragraph-function 'c-fill-paragraph))
- (c-fill-paragraph justify))))
+ (let ((js--filling-paragraph t)
+ (fill-paragraph-function 'c-fill-paragraph))
+ (c-fill-paragraph justify)))
;;; Type database and Imenu
-;;; perl-mode.el --- Perl code editing commands for GNU Emacs
+;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*-
;; Copyright (C) 1990, 1994, 2001-2012 Free Software Foundation, Inc.
;;; Code:
-
-(defvar font-lock-comment-face)
-(defvar font-lock-doc-face)
-(defvar font-lock-string-face)
-
(defgroup perl nil
"Major mode for editing Perl code."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
(defvar perl-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "{" 'perl-electric-terminator)
- (define-key map "}" 'perl-electric-terminator)
- (define-key map ";" 'perl-electric-terminator)
- (define-key map ":" 'perl-electric-terminator)
(define-key map "\e\C-a" 'perl-beginning-of-function)
(define-key map "\e\C-e" 'perl-end-of-function)
(define-key map "\e\C-h" 'perl-mark-function)
(define-key map "\e\C-q" 'perl-indent-exp)
(define-key map "\177" 'backward-delete-char-untabify)
- (define-key map "\t" 'perl-indent-command)
map)
"Keymap used in Perl mode.")
(defvar perl-imenu-generic-expression
'(;; Functions
- (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1)
+ (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1)
;;Variables
("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1)
- ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1)
+ ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1)
("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
"Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
;; Jim Campbell <jec@murzim.ca.boeing.com>.
+(defcustom perl-prettify-symbols t
+ "If non-nil, some symbols will be displayed using Unicode chars."
+ :type 'boolean)
+
+(defconst perl--prettify-symbols-alist
+ '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬)
+ ;;("div" . ?÷) ("*" . ?×) ("o" . ?○)
+ ("->" . ?→)
+ ("=>" . ?⇒)
+ ;;("<-" . ?←) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯)
+ ("::" . ?∷)
+ ))
+
+(defun perl--font-lock-compose-symbol ()
+ "Compose a sequence of ascii chars into a symbol.
+Regexp match data 0 points to the chars."
+ ;; Check that the chars should really be composed into a symbol.
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (syntaxes (if (eq (char-syntax (char-after start)) ?w)
+ '(?w) '(?. ?\\))))
+ (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
+ (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
+ (nth 8 (syntax-ppss)))
+ ;; No composition for you. Let's actually remove any composition
+ ;; we may have added earlier and which is now incorrect.
+ (remove-text-properties start end '(composition))
+ ;; That's a symbol alright, so add the composition.
+ (compose-region start end (cdr (assoc (match-string 0)
+ perl--prettify-symbols-alist)))))
+ ;; Return nil because we're not adding any face property.
+ nil)
+
+(defun perl--font-lock-symbols-keywords ()
+ (when perl-prettify-symbols
+ `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t)
+ (0 (perl--font-lock-compose-symbol))))))
+
(defconst perl-font-lock-keywords-1
'(;; What is this for?
;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face)
"Subdued level highlighting for Perl mode.")
(defconst perl-font-lock-keywords-2
- (append perl-font-lock-keywords-1
- (list
- ;;
- ;; Fontify keywords, except those fontified otherwise.
- (concat "\\<"
- (regexp-opt '("if" "until" "while" "elsif" "else" "unless"
- "do" "dump" "for" "foreach" "exit" "die"
- "BEGIN" "END" "return" "exec" "eval") t)
- "\\>")
- ;;
- ;; Fontify local and my keywords as types.
- '("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
- ;;
- ;; Fontify function, variable and file name references.
- '("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
- ;; Additionally underline non-scalar variables. Maybe this is a bad idea.
- ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
- '("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
- '("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
+ (append
+ perl-font-lock-keywords-1
+ `( ;; Fontify keywords, except those fontified otherwise.
+ ,(concat "\\<"
+ (regexp-opt '("if" "until" "while" "elsif" "else" "unless"
+ "do" "dump" "for" "foreach" "exit" "die"
+ "BEGIN" "END" "return" "exec" "eval") t)
+ "\\>")
+ ;;
+ ;; Fontify local and my keywords as types.
+ ("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
+ ;;
+ ;; Fontify function, variable and file name references.
+ ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
+ ;; Additionally underline non-scalar variables. Maybe this is a bad idea.
+ ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
+ ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
+ ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
(2 (cons font-lock-variable-name-face '(underline))))
- '("<\\(\\sw+\\)>" 1 font-lock-constant-face)
- ;;
- ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
- '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
+ ("<\\(\\sw+\\)>" 1 font-lock-constant-face)
+ ;;
+ ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
+ ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
- '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)))
+ ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)
+ ,@(perl--font-lock-symbols-keywords)))
"Gaudy level highlighting for Perl mode.")
(defvar perl-font-lock-keywords perl-font-lock-keywords-1
(defun perl-outline-level ()
(cond
- ((looking-at "package\\s-") 0)
- ((looking-at "sub\\s-") 1)
+ ((looking-at "[ \t]*\\(package\\)\\s-")
+ (- (match-beginning 1) (match-beginning 0)))
+ ((looking-at "[ \t]*s\\(ub\\)\\s-")
+ (- (match-beginning 1) (match-beginning 0)))
((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0))
((looking-at "=cut") 1)
(t 3)))
#'perl-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
+ ;; Electricity.
+ ;; FIXME: setup electric-layout-rules.
+ (set (make-local-variable 'electric-indent-chars)
+ (append '(?\{ ?\} ?\; ?\:) electric-indent-chars))
+ (add-hook 'electric-indent-functions #'perl-electric-noindent-p nil t)
;; Tell imenu how to handle Perl.
(set (make-local-variable 'imenu-generic-expression)
perl-imenu-generic-expression)
0 ;Existing comment at bol stays there.
comment-column))
-(defalias 'electric-perl-terminator 'perl-electric-terminator)
+(define-obsolete-function-alias 'electric-perl-terminator
+ 'perl-electric-terminator "22.1")
+(defun perl-electric-noindent-p (char)
+ (unless (eolp) 'no-indent))
+
(defun perl-electric-terminator (arg)
"Insert character and maybe adjust indentation.
If at end-of-line, and not in a comment or a quote, correct the indentation."
(perl-indent-line)
(delete-char -1))))
(self-insert-command (prefix-numeric-value arg)))
+(make-obsolete 'perl-electric-terminator 'electric-indent-mode "24.4")
;; not used anymore, but may be useful someday:
;;(defun perl-inside-parens-p ()
(t
(message "Use backslash to quote # characters.")
(ding t)))))))))
+(make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4")
(defun perl-indent-line (&optional nochange parse-start)
"Indent current line as Perl code.
(eval-and-compile
(defconst ruby-here-doc-beg-re
"\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
- "Regexp to match the beginning of a heredoc."))
+ "Regexp to match the beginning of a heredoc.")
+
+ (defconst ruby-expression-expansion-re
+ "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)"))
(defun ruby-here-doc-end-match ()
"Return a regexp to find the end of a heredoc.
(looking-at "class\\s *<<"))))
(defun ruby-expr-beg (&optional option)
- "TODO: document."
+ "Check if point is possibly at the beginning of an expression.
+OPTION specifies the type of the expression.
+Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(save-excursion
(store-match-data nil)
(let ((space (skip-chars-backward " \t"))
(or (eq (char-syntax (char-before (point))) ?w)
(ruby-special-char-p))))
nil)
- ((and (eq option 'heredoc) (< space 0))
- (not (progn (goto-char start) (ruby-singleton-class-p))))
- ((or (looking-at ruby-operator-re)
- (looking-at "[\\[({,;]")
+ ((looking-at ruby-operator-re))
+ ((eq option 'heredoc)
+ (and (< space 0) (not (ruby-singleton-class-p start))))
+ ((or (looking-at "[\\[({,;]")
(and (looking-at "[!?]")
(or (not (eq option 'modifier))
(bolp)
(beginning-of-line)))))
(defun ruby-move-to-block (n)
- "Move to the beginning (N < 0) or the end (N > 0) of the current block
-or blocks containing the current block."
- ;; TODO: Make this work for n > 1,
- ;; make it not loop for n = 0,
- ;; document body
+ "Move to the beginning (N < 0) or the end (N > 0) of the
+current block, a sibling block, or an outer block. Do that (abs N) times."
(let ((orig (point))
(start (ruby-calculate-indent))
- (down (looking-at (if (< n 0) ruby-block-end-re
- (concat "\\<\\(" ruby-block-beg-re "\\)\\>"))))
- pos done)
- (while (and (not done) (not (if (< n 0) (bobp) (eobp))))
- (forward-line n)
- (cond
- ((looking-at "^\\s *$"))
- ((looking-at "^\\s *#"))
- ((and (> n 0) (looking-at "^=begin\\>"))
- (re-search-forward "^=end\\>"))
- ((and (< n 0) (looking-at "^=end\\>"))
- (re-search-backward "^=begin\\>"))
- (t
- (setq pos (current-indentation))
+ (signum (if (> n 0) 1 -1))
+ (backward (< n 0))
+ down pos done)
+ (dotimes (_ (abs n))
+ (setq done nil)
+ (setq down (save-excursion
+ (back-to-indentation)
+ ;; There is a block start or block end keyword on this
+ ;; line, don't need to look for another block.
+ (and (re-search-forward
+ (if backward ruby-block-end-re
+ (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>"))
+ (line-end-position) t)
+ (not (nth 8 (syntax-ppss))))))
+ (while (and (not done) (not (if backward (bobp) (eobp))))
+ (forward-line signum)
(cond
- ((< start pos)
- (setq down t))
- ((and down (= pos start))
- (setq done t))
- ((> start pos)
- (setq done t)))))
- (if done
- (save-excursion
- (back-to-indentation)
- (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>"))
- (setq done nil)))))
+ ;; Skip empty and commented out lines.
+ ((looking-at "^\\s *$"))
+ ((looking-at "^\\s *#"))
+ ;; Skip block comments;
+ ((and (not backward) (looking-at "^=begin\\>"))
+ (re-search-forward "^=end\\>"))
+ ((and backward (looking-at "^=end\\>"))
+ (re-search-backward "^=begin\\>"))
+ (t
+ (setq pos (current-indentation))
+ (cond
+ ;; Deeper indentation, we found a block.
+ ;; FIXME: We can't recognize empty blocks this way.
+ ((< start pos)
+ (setq down t))
+ ;; Block found, and same indentation as when started, stop.
+ ((and down (= pos start))
+ (setq done t))
+ ;; Shallower indentation, means outer block, can stop now.
+ ((> start pos)
+ (setq done t)))))
+ (if done
+ (save-excursion
+ (back-to-indentation)
+ ;; Not really at the first or last line of the block, move on.
+ (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>"))
+ (setq done nil))))))
(back-to-indentation)))
(defun ruby-beginning-of-block (&optional arg)
(defun ruby-end-of-block (&optional arg)
"Move forward to the end of the current block.
With ARG, move out of multiple blocks."
- ;; Passing a value > 1 to ruby-move-to-block currently doesn't work.
- (interactive)
+ (interactive "p")
(ruby-move-to-block (or arg 1)))
(defun ruby-forward-sexp (&optional arg)
#exit
String#gsub
Net::HTTP#active?
- File::open.
+ File.open
See `add-log-current-defun-function'."
- ;; TODO: Document body
- ;; Why does this append a period to class methods?
(condition-case nil
(save-excursion
(let (mname mlist (indent 0))
- ;; get current method (or class/module)
+ ;; Get the current method definition (or class/module).
(if (re-search-backward
(concat "^[ \t]*" ruby-defun-beg-re "[ \t]+"
"\\("
- ;; \\. and :: for class method
- "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
- "+\\)")
+ ;; \\. and :: for class methods
+ "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
+ "+\\)")
nil t)
(progn
(setq mname (match-string 2))
(goto-char (match-beginning 1))
(setq indent (current-column))
(beginning-of-line)))
- ;; nest class/module
+ ;; Walk up the class/module nesting.
(while (and (> indent 0)
(re-search-backward
(concat
(setq mlist (cons (match-string 2) mlist))
(setq indent (current-column))
(beginning-of-line))))
+ ;; Process the method name.
(when mname
(let ((mn (split-string mname "\\.\\|::")))
(if (cdr mn)
(progn
- (cond
- ((string-equal "" (car mn))
- (setq mn (cdr mn) mlist nil))
- ((string-equal "self" (car mn))
- (setq mn (cdr mn)))
- ((let ((ml (nreverse mlist)))
+ (unless (string-equal "self" (car mn)) ; def self.foo
+ ;; def C.foo
+ (let ((ml (nreverse mlist)))
+ ;; If the method name references one of the
+ ;; containing modules, drop the more nested ones.
(while ml
(if (string-equal (car ml) (car mn))
(setq mlist (nreverse (cdr ml)) ml nil))
- (or (setq ml (cdr ml)) (nreverse mlist))))))
- (if mlist
- (setcdr (last mlist) mn)
- (setq mlist mn))
- (setq mn (last mn 2))
- (setq mname (concat "." (cadr mn)))
- (setcdr mn nil))
+ (or (setq ml (cdr ml)) (nreverse mlist))))
+ (if mlist
+ (setcdr (last mlist) (butlast mn))
+ (setq mlist (butlast mn))))
+ (setq mname (concat "." (car (last mn)))))
(setq mname (concat "#" mname)))))
- ;; generate string
+ ;; Generate the string.
(if (consp mlist)
(setq mlist (mapconcat (function identity) mlist "::")))
(if mname
;; Handle percent literals: %w(), %q{}, etc.
((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re)
(1 (prog1 "|" (ruby-syntax-propertize-percent-literal end)))))
- (point) end))
+ (point) end)
+ (remove-text-properties start end '(ruby-expansion-match-data))
+ (goto-char start)
+ ;; Find all expression expansions and
+ ;; - set the syntax of all text inside to whitespace,
+ ;; - save the match data to a text property, for font-locking later.
+ (while (re-search-forward ruby-expression-expansion-re end 'move)
+ (when (ruby-in-ppss-context-p 'string)
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'syntax-table (string-to-syntax "-"))
+ (put-text-property (match-beginning 2) (1+ (match-beginning 2))
+ 'ruby-expansion-match-data
+ (match-data)))))
(defun ruby-syntax-propertize-heredoc (limit)
(let ((ppss (syntax-ppss))
ruby-keyword-end-re)
2)
;; here-doc beginnings
- (list ruby-here-doc-beg-re 0 'font-lock-string-face)
+ `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0))
+ 'font-lock-string-face))
;; variables
'("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>"
2 font-lock-variable-name-face)
'("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
;; expression expansion
'(ruby-match-expression-expansion
- 0 font-lock-variable-name-face t)
+ 2 font-lock-variable-name-face t)
;; warn lower camel case
;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)"
; 0 font-lock-warning-face)
"Additional expressions to highlight in Ruby mode.")
(defun ruby-match-expression-expansion (limit)
- (when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move)
- (or (ruby-in-ppss-context-p 'string)
- (ruby-match-expression-expansion limit))))
+ (let ((prop 'ruby-expansion-match-data) pos value)
+ (when (and (setq pos (next-single-char-property-change (point) prop
+ nil limit))
+ (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos prop))
+ (progn (set-match-data value) t))
+ (ruby-match-expression-expansion limit)))))
;;;###autoload
(define-derived-mode ruby-mode prog-mode "Ruby"
;;;###autoload
(add-to-list 'auto-mode-alist (cons (purecopy "\\.rb\\'") 'ruby-mode))
+;;;###autoload
+(add-to-list 'auto-mode-alist '("Rakefile\\'" . ruby-mode))
;;;###autoload
(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8"))
doc))
;;;###autoload
-(defun sql-help ()
- "Show short help for the SQL modes.
+(eval
+ ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
+ ;; functions, because of the lazy-loading of docstrings, which strips away
+ ;; text properties.
+ '(defun sql-help ()
+ #("Show short help for the SQL modes.
Use an entry function to open an interactive SQL buffer. This buffer is
usually named `*SQL*'. The name of the major mode is SQLi.
In this SQL buffer (SQL mode), you can send the region or the entire
buffer to the interactive SQL buffer (SQLi mode). The results are
appended to the SQLi buffer without disturbing your SQL buffer."
+ 0 1 (dynamic-docstring-function sql--make-help-docstring))
(interactive)
+ (describe-function 'sql-help)))
- ;; Insert references to loaded products into the help buffer string
- (let ((doc (documentation 'sql-help t))
- changedp)
- (setq changedp nil)
-
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)
- changedp t))
-
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)
- changedp t))
-
- ;; If we changed the help text, save the change so that the help
- ;; sub-system will see it
- (when changedp
- (put 'sql-help 'function-documentation doc)))
-
- ;; Call help on this function
- (describe-function 'sql-help))
+(defun sql--make-help-docstring (doc _fun)
+ "Insert references to loaded products into the help buffer string."
+
+ ;; Insert FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
+ t t doc 0)))
+
+ ;; Insert non-FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
+ t t doc 0)))
+ doc)
(defun sql-read-passwd (prompt &optional default)
"Read a password using PROMPT. Optional DEFAULT is password to start with."
ses--default-printer
ses--deferred-narrow ses--deferred-recalc
ses--deferred-write ses--file-format
+ ses--named-cell-hashmap
(ses--header-hscroll . -1) ; Flag for "initial recalc needed"
ses--header-row ses--header-string ses--linewidth
ses--numcols ses--numrows ses--symbolic-formulas
`(aref ses--col-printers ,col))
(defmacro ses-sym-rowcol (sym)
- "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0).
-Result is nil if SYM is not a symbol that names a cell."
- `(and (symbolp ,sym) (get ,sym 'ses-cell)))
+ "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result
+is nil if SYM is not a symbol that names a cell."
+ `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
+ (if (eq rc :ses-named)
+ (gethash ,sym ses--named-cell-hashmap)
+ rc)))
+
+(defun ses-is-cell-sym-p (sym)
+ "Check whether SYM point at a cell of this spread sheet."
+ (let ((rowcol (get sym 'ses-cell)))
+ (and rowcol
+ (if (eq rowcol :ses-named)
+ (and ses--named-cell-hashmap (gethash sym ses--named-cell-hashmap))
+ (and (< (car rowcol) ses--numrows)
+ (< (cdr rowcol) ses--numcols)
+ (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym))))))
(defmacro ses-cell (sym value formula printer references)
"Load a cell SYM from the spreadsheet file. Does not recompute VALUE from
"Produce a symbol that names the cell (ROW,COL). (0,0) => 'A1."
(intern (concat (ses-column-letter col) (number-to-string (1+ row)))))
+(defun ses-decode-cell-symbol (str)
+ "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a
+ canonical cell name. Does not save match data."
+ (let (case-fold-search)
+ (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str)
+ (let* ((col-str (match-string-no-properties 1 str))
+ (col 0)
+ (col-offset 0)
+ (col-base 1)
+ (col-idx (1- (length col-str)))
+ (row (1- (string-to-number (match-string-no-properties 2 str)))))
+ (and (>= row 0)
+ (progn
+ (while
+ (progn
+ (setq col (+ col (* (- (aref col-str col-idx) ?A) col-base))
+ col-base (* col-base 26)
+ col-idx (1- col-idx))
+ (and (>= col-idx 0)
+ (setq col (+ col col-base)))))
+ (cons row col)))))))
+
(defun ses-create-cell-variable-range (minrow maxrow mincol maxcol)
"Create buffer-local variables for cells. This is undoable."
(push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
Return nil in case of failure."
(unless (local-variable-p sym)
(make-local-variable sym)
- (put sym 'ses-cell (cons row col))))
+ (if (let (case-fold-search) (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name sym)))
+ (put sym 'ses-cell (cons row col))
+ (put sym 'ses-cell :ses-named)
+ (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq)))
+ (puthash sym (cons row col) ses--named-cell-hashmap))))
;; We do not delete the ses-cell properties for the cell-variables, in
;; case a formula that refers to this cell is in the kill-ring and is
(defun ses-rename-cell (new-name &optional cell)
"Rename current cell."
(interactive "*SEnter new name: ")
- (and (local-variable-p new-name)
- (ses-sym-rowcol new-name)
- ;; this test is needed because ses-cell property of deleted cells
- ;; is not deleted in case of subsequent undo
- (memq new-name ses--renamed-cell-symb-list)
- (error "Already a cell name"))
- (and (boundp new-name)
- (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? "
- new-name)))
- (error "Already a bound cell name"))
- (let* ((sym (if (ses-cell-p cell)
+ (or
+ (and (local-variable-p new-name)
+ (ses-is-cell-sym-p new-name)
+ (error "Already a cell name"))
+ (and (boundp new-name)
+ (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? "
+ new-name)))
+ (error "Already a bound cell name")))
+ (let* (curcell
+ (sym (if (ses-cell-p cell)
(ses-cell-symbol cell)
- (setq cell nil)
+ (setq cell nil
+ curcell t)
(ses-check-curcell)
ses--curcell))
(rowcol (ses-sym-rowcol sym))
(row (car rowcol))
- (col (cdr rowcol)))
- (setq cell (or cell (ses-get-cell row col)))
- (push `(ses-rename-cell ,(ses-cell-symbol cell) ,cell) buffer-undo-list)
- (put new-name 'ses-cell rowcol)
+ (col (cdr rowcol))
+ new-rowcol old-name)
+ (setq cell (or cell (ses-get-cell row col))
+ old-name (ses-cell-symbol cell)
+ new-rowcol (ses-decode-cell-symbol (symbol-name new-name)))
+ (if new-rowcol
+ (if (equal new-rowcol rowcol)
+ (put new-name 'ses-cell rowcol)
+ (error "Not a valid name for this cell location"))
+ (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq)))
+ (put new-name 'ses-cell :ses-named)
+ (puthash new-name rowcol ses--named-cell-hashmap))
+ (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
;; replace name by new name in formula of cells refering to renamed cell
(dolist (ref (ses-cell-references cell))
(let* ((x (ses-sym-rowcol ref))
(push new-name ses--renamed-cell-symb-list)
(set new-name (symbol-value sym))
(aset cell 0 new-name)
- (put sym 'ses-cell nil)
(makunbound sym)
- (setq sym new-name)
+ (and curcell (setq ses--curcell new-name))
(let* ((pos (point))
(inhibit-read-only t)
(col (current-column))
nil
(eval-when-compile (condition-case nil (require 'imenu) (error nil)))
+(declare-function imenu--make-index-alist "imenu" (&optional no-error))
(defun speedbar-fetch-dynamic-imenu (file)
"Load FILE into a buffer, and generate tags using Imenu.
(declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
-(if (null (featurep 'cl))
- (progn
- ;; If we reload subr.el after having loaded CL, be careful not to
- ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'.
-
(defmacro dolist (spec &rest body)
"Loop over a list.
Evaluate BODY with VAR bound to each car from LIST, in turn.
(let ((,(car spec) (car ,temp)))
,@body
(setq ,temp (cdr ,temp))))
- ,@(if (cdr (cdr spec))
- ;; FIXME: This let often leads to "unused var" warnings.
- `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
+ ,@(cdr (cdr spec)))
`(let ((,temp ,(nth 1 spec))
,(car spec))
(while ,temp
`defun-declarations-alist' and `macro-declarations-alist'."
;; FIXME: edebug spec should pay attention to defun-declarations-alist.
nil)
-))
(defmacro ignore-errors (&rest body)
"Execute BODY; if an error occurs, return nil.
(defun locate-user-emacs-file (new-name &optional old-name)
"Return an absolute per-user Emacs-specific file name.
-If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
+If NEW-NAME exists in `user-emacs-directory', return it.
+Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
Else return NEW-NAME in `user-emacs-directory', creating the
directory if it does not exist."
(convert-standard-filename
(let* ((home (concat "~" (or init-file-user "")))
- (at-home (and old-name (expand-file-name old-name home))))
- (if (and at-home (file-readable-p at-home))
+ (at-home (and old-name (expand-file-name old-name home)))
+ (bestname (abbreviate-file-name
+ (expand-file-name new-name user-emacs-directory))))
+ (if (and at-home (not (file-readable-p bestname))
+ (file-readable-p at-home))
at-home
;; Make sure `user-emacs-directory' exists,
;; unless we're in batch mode or dumping Emacs
(set-default-file-modes ?\700)
(make-directory user-emacs-directory))
(set-default-file-modes umask))))
- (abbreviate-file-name
- (expand-file-name new-name user-emacs-directory))))))
+ bestname))))
\f
;;;; Misc. useful functions.
Otherwise, return nil."
(and (memq object '(nil t)) t))
+(defun special-form-p (object)
+ "Non-nil if and only if OBJECT is a special form."
+ (if (and (symbolp object) (fboundp object))
+ (setq object (indirect-function object)))
+ (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
+
(defun field-at-pos (pos)
"Return the field at position POS, taking stickiness etc into account."
(let ((raw-field (get-char-property (field-beginning pos) 'field)))
(require 'ring)
(require 'ehelp)
+(declare-function ring-empty-p "ring" (ring))
+(declare-function ring-ref "ring" (ring index))
+(declare-function ring-insert-at-beginning "ring" (ring item))
+(declare-function ring-length "ring" (ring))
+(declare-function ring-insert "ring" (ring item))
+
(defgroup term nil
"General command interpreter in a window."
:group 'processes)
(declare-function w32-send-sys-command "w32fns.c")
(declare-function set-message-beep "w32fns.c")
+(declare-function cygwin-convert-path-from-windows "cygw32.c"
+ (path &optional absolute_p))
+
;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
(if (fboundp 'new-fontset)
(require 'fontset))
"/")
"/")))
(dnd-handle-one-url window 'private
- (concat "file:" file-name)))
+ (concat
+ (if (eq system-type 'cygwin)
+ "file://"
+ "file:")
+ file-name)))
(defun w32-drag-n-drop (event &optional new-frame)
"Edit the files listed in the drag-n-drop EVENT.
"ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (if (featurep 'ispell)
+ (ispell-set-spellchecker-params)))
:group 'ispell)
(defcustom ispell-alternate-dictionary
(setq default-directory (expand-file-name "~/")))
(apply 'call-process-region args)))
+(defun ispell-create-debug-buffer (&optional append)
+ "Create an ispell debug buffer for debugging output.
+Use APPEND to append the info to previous buffer if exists,
+otherwise is reset. Returns name of ispell debug buffer.
+See `ispell-buffer-with-debug' for an example of use."
+ (let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*")))
+ (with-current-buffer ispell-debug-buffer
+ (if append
+ (insert
+ (format "-----------------------------------------------\n"))
+ (erase-buffer)))
+ ispell-debug-buffer))
+
+(defsubst ispell-print-if-debug (string)
+ "Print STRING to `ispell-debug-buffer' buffer if enabled."
+ (if (boundp 'ispell-debug-buffer)
+ (with-current-buffer ispell-debug-buffer
+ (insert string))))
;; The preparation of the menu bar menu must be autoloaded
(if (not recheckp)
(ispell-accept-buffer-local-defs)) ; set up dictionary, local words, etc.
(let ((skip-region-start (make-marker))
- (rstart (make-marker)))
- (unwind-protect
- (save-excursion
- (message "Spell-checking %s using %s with %s dictionary..."
- (if (and (= reg-start (point-min)) (= reg-end (point-max)))
- (buffer-name) "region")
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default"))
- ;; Returns cursor to original location.
- (save-window-excursion
- (goto-char reg-start)
- (let ((transient-mark-mode)
- (case-fold-search case-fold-search)
- (query-fcc t)
- in-comment key)
- (let (message-log-max)
- (message "searching for regions to skip"))
- (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
- (progn
- (setq key (match-string-no-properties 0))
- (set-marker skip-region-start (- (point) (length key)))
- (goto-char reg-start)))
- (let (message-log-max)
- (message
- "Continuing spelling check using %s with %s dictionary..."
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default")))
- (set-marker rstart reg-start)
- (set-marker ispell-region-end reg-end)
- (while (and (not ispell-quit)
- (< (point) ispell-region-end))
- ;; spell-check region with skipping
- (if (and (marker-position skip-region-start)
- (<= skip-region-start (point)))
+ (rstart (make-marker))
+ (region-type (if (and (= reg-start (point-min)) (= reg-end (point-max)))
+ (buffer-name) "region"))
+ (program-basename (file-name-nondirectory ispell-program-name))
+ (dictionary (or ispell-current-dictionary "default")))
+ (unwind-protect
+ (save-excursion
+ (message "Spell-checking %s using %s with %s dictionary..."
+ region-type program-basename dictionary)
+ ;; Returns cursor to original location.
+ (save-window-excursion
+ (goto-char reg-start)
+ (let ((transient-mark-mode)
+ (case-fold-search case-fold-search)
+ (query-fcc t)
+ in-comment key)
+ (ispell-print-if-debug
+ (concat
+ (format
+ "ispell-region: (ispell-skip-region-list):\n%s\n"
+ (ispell-skip-region-list))
+ (format
+ "ispell-region: (ispell-begin-skip-region-regexp):\n%s\n"
+ (ispell-begin-skip-region-regexp))
+ "ispell-region: Search for first region to skip after (ispell-begin-skip-region-regexp)\n"))
+ (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
(progn
- ;; If region inside line comment, must keep comment start.
- (setq in-comment (point)
- in-comment
- (and comment-start
- (or (null comment-end) (string= "" comment-end))
- (save-excursion
- (beginning-of-line)
- (re-search-forward comment-start in-comment t))
- comment-start))
- ;; Can change skip-regexps (in ispell-message)
- (ispell-skip-region key) ; moves pt past region.
- (set-marker rstart (point))
- ;; check for saving large attachments...
- (setq query-fcc (and query-fcc
- (ispell-ignore-fcc skip-region-start
- rstart)))
- (if (and (< rstart ispell-region-end)
- (re-search-forward
- (ispell-begin-skip-region-regexp)
- ispell-region-end t))
- (progn
- (setq key (match-string-no-properties 0))
- (set-marker skip-region-start
- (- (point) (length key)))
- (goto-char rstart))
- (set-marker skip-region-start nil))))
- (setq reg-end (max (point)
- (if (marker-position skip-region-start)
- (min skip-region-start ispell-region-end)
- (marker-position ispell-region-end))))
- (let* ((ispell-start (point))
- (ispell-end (min (point-at-eol) reg-end))
- (string (ispell-get-line
- ispell-start ispell-end in-comment)))
- (if in-comment ; account for comment chars added
- (setq ispell-start (- ispell-start (length in-comment))
- in-comment nil))
- (setq ispell-end (point)) ; "end" tracks region retrieved.
- (if string ; there is something to spell check!
- ;; (special start end)
- (setq shift (ispell-process-line string
- (and recheckp shift))))
- (goto-char ispell-end)))))
- (if ispell-quit
- nil
- (or shift 0)))
- ;; protected
- (if (and (not (and recheckp ispell-keep-choices-win))
- (get-buffer ispell-choices-buffer))
- (kill-buffer ispell-choices-buffer))
- (set-marker skip-region-start nil)
- (set-marker rstart nil)
- (if ispell-quit
- (progn
- ;; preserve or clear the region for ispell-continue.
- (if (not (numberp ispell-quit))
- (set-marker ispell-region-end nil)
- ;; Ispell-continue enabled - ispell-region-end is set.
- (goto-char ispell-quit))
- ;; Check for aborting
- (if (and ispell-checking-message (numberp ispell-quit))
- (progn
- (setq ispell-quit nil)
- (error "Message send aborted")))
- (if (not recheckp) (setq ispell-quit nil)))
- (if (not recheckp) (set-marker ispell-region-end nil))
- ;; Only save if successful exit.
- (ispell-pdict-save ispell-silently-savep)
- (message "Spell-checking %s using %s with %s dictionary...done"
- (if (and (= reg-start (point-min)) (= reg-end (point-max)))
- (buffer-name) "region")
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default"))))))
+ (setq key (match-string-no-properties 0))
+ (set-marker skip-region-start (- (point) (length key)))
+ (goto-char reg-start)
+ (ispell-print-if-debug
+ (format "ispell-region: First skip: %s at (pos,line,column): (%s,%s,%s).\n"
+ key
+ (save-excursion (goto-char skip-region-start) (point))
+ (line-number-at-pos skip-region-start)
+ (save-excursion (goto-char skip-region-start) (current-column))))))
+ (ispell-print-if-debug
+ (format
+ "ispell-region: Continue spell-checking with %s and %s dictionary...\n"
+ program-basename dictionary))
+ (set-marker rstart reg-start)
+ (set-marker ispell-region-end reg-end)
+ (while (and (not ispell-quit)
+ (< (point) ispell-region-end))
+ ;; spell-check region with skipping
+ (if (and (marker-position skip-region-start)
+ (<= skip-region-start (point)))
+ (progn
+ ;; If region inside line comment, must keep comment start.
+ (setq in-comment (point)
+ in-comment
+ (and comment-start
+ (or (null comment-end) (string= "" comment-end))
+ (save-excursion
+ (beginning-of-line)
+ (re-search-forward comment-start in-comment t))
+ comment-start))
+ ;; Can change skip-regexps (in ispell-message)
+ (ispell-skip-region key) ; moves pt past region.
+ (set-marker rstart (point))
+ ;; check for saving large attachments...
+ (setq query-fcc (and query-fcc
+ (ispell-ignore-fcc skip-region-start
+ rstart)))
+ (if (and (< rstart ispell-region-end)
+ (re-search-forward
+ (ispell-begin-skip-region-regexp)
+ ispell-region-end t))
+ (progn
+ (setq key (match-string-no-properties 0))
+ (set-marker skip-region-start
+ (- (point) (length key)))
+ (goto-char rstart)
+ (ispell-print-if-debug
+ (format "ispell-region: Next skip: %s at (pos,line,column): (%s,%s,%s).\n"
+ key
+ (save-excursion (goto-char skip-region-start) (point))
+ (line-number-at-pos skip-region-start)
+ (save-excursion (goto-char skip-region-start) (current-column)))))
+ (set-marker skip-region-start nil))))
+ (setq reg-end (max (point)
+ (if (marker-position skip-region-start)
+ (min skip-region-start ispell-region-end)
+ (marker-position ispell-region-end))))
+ (let* ((ispell-start (point))
+ (ispell-end (min (point-at-eol) reg-end))
+ ;; See if line must be prefixed by comment string to let ispell know this is
+ ;; part of a comment string. This is only supported in some modes.
+ ;; In particular, this is not supported in autoconf mode where adding the
+ ;; comment string messes everything up because ispell tries to spellcheck the
+ ;; `dnl' string header causing misalignments in some cases (debbugs.gnu.org: #12768).
+ (add-comment (and in-comment
+ (not (string= in-comment "dnl "))
+ in-comment))
+ (string (ispell-get-line
+ ispell-start ispell-end add-comment)))
+ (ispell-print-if-debug
+ (format
+ "ispell-region: string pos (%s->%s), eol: %s, [in-comment]: [%s], [add-comment]: [%s], [string]: [%s]\n"
+ ispell-start ispell-end (point-at-eol) in-comment add-comment string))
+ (if add-comment ; account for comment chars added
+ (setq ispell-start (- ispell-start (length add-comment))
+ add-comment nil))
+ (setq ispell-end (point)) ; "end" tracks region retrieved.
+ (if string ; there is something to spell check!
+ ;; (special start end)
+ (setq shift (ispell-process-line string
+ (and recheckp shift))))
+ (goto-char ispell-end)))))
+ (if ispell-quit
+ nil
+ (or shift 0)))
+ ;; protected
+ (if (and (not (and recheckp ispell-keep-choices-win))
+ (get-buffer ispell-choices-buffer))
+ (kill-buffer ispell-choices-buffer))
+ (set-marker skip-region-start nil)
+ (set-marker rstart nil)
+ (if ispell-quit
+ (progn
+ ;; preserve or clear the region for ispell-continue.
+ (if (not (numberp ispell-quit))
+ (set-marker ispell-region-end nil)
+ ;; Ispell-continue enabled - ispell-region-end is set.
+ (goto-char ispell-quit))
+ ;; Check for aborting
+ (if (and ispell-checking-message (numberp ispell-quit))
+ (progn
+ (setq ispell-quit nil)
+ (error "Message send aborted")))
+ (if (not recheckp) (setq ispell-quit nil)))
+ (if (not recheckp) (set-marker ispell-region-end nil))
+ ;; Only save if successful exit.
+ (ispell-pdict-save ispell-silently-savep)
+ (message "Spell-checking %s using %s with %s dictionary...done"
+ region-type program-basename dictionary)))))
(defun ispell-begin-skip-region-regexp ()
;; Alignment cannot be tracked and this error will occur when
;; `query-replace' makes multiple corrections on the starting line.
(or (ispell-looking-at (car poss))
- ;; This occurs due to filter pipe problems
- (error (concat "Ispell misalignment: word "
- "`%s' point %d; probably incompatible versions")
- (car poss) (marker-position word-start)))
+ ;; This error occurs due to filter pipe problems
+ (let* ((ispell-pipe-word (car poss))
+ (actual-point (marker-position word-start))
+ (actual-line (line-number-at-pos actual-point))
+ (actual-column (save-excursion (goto-char actual-point) (current-column))))
+ (ispell-print-if-debug
+ (concat
+ "ispell-process-line: Ispell misalignment error:\n"
+ (format " [Word from ispell pipe]: [%s], actual (point,line,column): (%s,%s,%s)\n"
+ ispell-pipe-word actual-point actual-line actual-column)))
+ (error (concat "Ispell misalignment: word "
+ "`%s' point %d; probably incompatible versions")
+ ispell-pipe-word actual-point)))
;; ispell-cmd-loop can go recursive & change buffer
(if ispell-keep-choices-win
(setq replace (ispell-command-loop
(interactive)
(ispell-region (point-min) (point-max)))
+;;;###autoload
+(defun ispell-buffer-with-debug (&optional append)
+ "`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
+Use APPEND to append the info to previous buffer if exists."
+ (interactive)
+ (let ((ispell-debug-buffer (ispell-create-debug-buffer append)))
+ (ispell-buffer)))
;;;###autoload
(defun ispell-continue ()
(vc-svn-command t 0 file "status" (if localp "-v" "-u"))
(vc-svn-parse-status file))))
+;; NB this does not handle svn properties, which can be changed
+;; without changing the file timestamp.
+;; Note that unlike vc-cvs-state-heuristic, this is not called from
+;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via
+;; vc-after-save (bug#7850). Therefore the fact that it ignores
+;; properties is irrelevant. If you want to make vc-svn-state call
+;; this, it should be extended to handle svn properties.
(defun vc-svn-state-heuristic (file)
"SVN-specific state heuristic."
- (vc-svn-state file 'local))
+ ;; If the file has not changed since checkout, consider it `up-to-date'.
+ ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic.
+ (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
+ (lastmod (nth 5 (file-attributes file))))
+ (cond
+ ((equal checkout-time lastmod) 'up-to-date)
+ ((string= (vc-working-revision file) "0") 'added)
+ ((null checkout-time) 'unregistered)
+ (t 'edited))))
;; FIXME it would be better not to have the "remote" argument,
;; but to distinguish the two output formats based on content.
(vcursor-disable -1))))
)
+(declare-function compare-windows-skip-whitespace "compare-w" (start))
+
;; vcursor-compare-windows is copied from compare-w.el with only
;; minor modifications; these are too bound up with the function
;; to make it really useful to call compare-windows itself.
((null (cdr files)) (car (car files))) ; only 1 file for topic.
(t
;; Multiple files for topic, so must select 1.
- ;; Unread the command event (TAB = ?\t = 9) that runs the command
- ;; `minibuffer-complete' in order to automatically complete the
- ;; minibuffer contents as far as possible.
- (setq unread-command-events '(9)) ; and delete any type-ahead!
- (completing-read "Manual file: " files nil 1
- (try-completion "" files) 'woman-file-history))))))
+ ;; Run the command `minibuffer-complete' in order to automatically
+ ;; complete the minibuffer contents as far as possible.
+ (minibuffer-with-setup-hook
+ (lambda () (let ((this-command this-command)) (minibuffer-complete)))
+ (completing-read "Manual file: " files nil 1
+ (try-completion "" files) 'woman-file-history)))))))
(defun woman-select (predicate list)
"Select unique elements for which PREDICATE is true in LIST.
(woman-dired-define-keys)
(add-hook 'dired-mode-hook 'woman-dired-define-keys))
+(declare-function dired-get-filename "dired"
+ (&optional localp no-error-if-not-filep))
+
;;;###autoload
(defun woman-dired-find-file ()
"In dired, run the WoMan man-page browser on this file."
(interactive)
- ;; dired-get-filename is defined in dired.el
(woman-find-file (dired-get-filename)))
(message "Woman fill column set to %s."
(if woman-fill-frame "frame width" woman-fill-column)))
+(declare-function apropos-print "apropos"
+ (do-keys spacing &optional text nosubst))
+
(defun woman-mini-help ()
"Display WoMan commands and user options in an `apropos' buffer."
;; Based on apropos-command in apropos.el
--- /dev/null
+#serial 4
+dnl Copyright (C) 2006-2007, 2009-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.
+
+dnl Prerequisites of lib/close-stream.c.
+AC_DEFUN([gl_CLOSE_STREAM],
+[
+ :
+])
--- /dev/null
+# euidaccess.m4 serial 15
+dnl Copyright (C) 2002-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.
+
+AC_DEFUN([gl_FUNC_NONREENTRANT_EUIDACCESS],
+[
+ AC_REQUIRE([gl_FUNC_EUIDACCESS])
+ AC_CHECK_DECLS([setregid])
+ AC_DEFINE([PREFER_NONREENTRANT_EUIDACCESS], [1],
+ [Define this if you prefer euidaccess to return the correct result
+ even if this would make it nonreentrant. Define this only if your
+ entire application is safe even if the uid or gid might temporarily
+ change. If your application uses signal handlers or threads it
+ is probably not safe.])
+])
+
+AC_DEFUN([gl_FUNC_EUIDACCESS],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+
+ dnl Persuade glibc <unistd.h> to declare euidaccess().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_FUNCS([euidaccess])
+ if test $ac_cv_func_euidaccess = no; then
+ HAVE_EUIDACCESS=0
+ fi
+])
+
+# Prerequisites of lib/euidaccess.c.
+AC_DEFUN([gl_PREREQ_EUIDACCESS], [
+ dnl Prefer POSIX faccessat over non-standard euidaccess.
+ AC_CHECK_FUNCS_ONCE([faccessat])
+ dnl Try various other non-standard fallbacks.
+ AC_CHECK_HEADERS([libgen.h])
+ AC_FUNC_GETGROUPS
+
+ # Solaris 9 and 10 need -lgen to get the eaccess function.
+ # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_EACCESS=
+ AC_SUBST([LIB_EACCESS])
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([eaccess], [gen],
+ [test "$ac_cv_search_eaccess" = "none required" ||
+ LIB_EACCESS=$ac_cv_search_eaccess])
+ AC_CHECK_FUNCS([eaccess])
+ LIBS=$gl_saved_libs
+])
--- /dev/null
+# serial 6
+# See if we need to provide faccessat replacement.
+
+dnl Copyright (C) 2009-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.
+
+# Written by Eric Blake.
+
+AC_DEFUN([gl_FUNC_FACCESSAT],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+
+ dnl Persuade glibc <unistd.h> to declare faccessat().
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_FUNCS_ONCE([faccessat])
+ if test $ac_cv_func_faccessat = no; then
+ HAVE_FACCESSAT=0
+ fi
+])
+
+# Prerequisites of lib/faccessat.m4.
+AC_DEFUN([gl_PREREQ_FACCESSAT],
+[
+ AC_CHECK_FUNCS([access])
+])
--- /dev/null
+# serial 15
+# Configure fcntl.h.
+dnl Copyright (C) 2006-2007, 2009-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.
+
+dnl Written by Paul Eggert.
+
+AC_DEFUN([gl_FCNTL_H],
+[
+ AC_REQUIRE([gl_FCNTL_H_DEFAULTS])
+ AC_REQUIRE([gl_FCNTL_O_FLAGS])
+ gl_NEXT_HEADERS([fcntl.h])
+
+ dnl Ensure the type pid_t gets defined.
+ AC_REQUIRE([AC_TYPE_PID_T])
+
+ dnl Ensure the type mode_t gets defined.
+ AC_REQUIRE([AC_TYPE_MODE_T])
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use, if it is not common
+ dnl enough to be declared everywhere.
+ gl_WARN_ON_USE_PREPARE([[#include <fcntl.h>
+ ]], [fcntl openat])
+])
+
+AC_DEFUN([gl_FCNTL_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_FCNTL_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_FCNTL_H_DEFAULTS],
+[
+ GNULIB_FCNTL=0; AC_SUBST([GNULIB_FCNTL])
+ GNULIB_NONBLOCKING=0; AC_SUBST([GNULIB_NONBLOCKING])
+ GNULIB_OPEN=0; AC_SUBST([GNULIB_OPEN])
+ GNULIB_OPENAT=0; AC_SUBST([GNULIB_OPENAT])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_FCNTL=1; AC_SUBST([HAVE_FCNTL])
+ HAVE_OPENAT=1; AC_SUBST([HAVE_OPENAT])
+ REPLACE_FCNTL=0; AC_SUBST([REPLACE_FCNTL])
+ REPLACE_OPEN=0; AC_SUBST([REPLACE_OPEN])
+ REPLACE_OPENAT=0; AC_SUBST([REPLACE_OPENAT])
+])
--- /dev/null
+# serial 19
+
+# Copyright (C) 2000-2001, 2004-2012 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering
+dnl Using code from emacs, based on suggestions from Paul Eggert
+dnl and Ulrich Drepper.
+
+dnl Find out how to determine the number of pending output bytes on a stream.
+dnl glibc (2.1.93 and newer) and Solaris provide __fpending. On other systems,
+dnl we have to grub around in the FILE struct.
+
+AC_DEFUN([gl_FUNC_FPENDING],
+[
+ AC_CHECK_HEADERS_ONCE([stdio_ext.h])
+ AC_CHECK_FUNCS_ONCE([__fpending])
+ fp_headers='
+# include <stdio.h>
+# if HAVE_STDIO_EXT_H
+# include <stdio_ext.h>
+# endif
+'
+ AC_CHECK_DECLS([__fpending], , , $fp_headers)
+])
+
+AC_DEFUN([gl_PREREQ_FPENDING],
+[
+ AC_CACHE_CHECK(
+ [how to determine the number of pending output bytes on a stream],
+ ac_cv_sys_pending_output_n_bytes,
+ [
+ for ac_expr in \
+ \
+ '# glibc2' \
+ 'fp->_IO_write_ptr - fp->_IO_write_base' \
+ \
+ '# traditional Unix' \
+ 'fp->_ptr - fp->_base' \
+ \
+ '# BSD' \
+ 'fp->_p - fp->_bf._base' \
+ \
+ '# SCO, Unixware' \
+ '(fp->__ptr ? fp->__ptr - fp->__base : 0)' \
+ \
+ '# QNX' \
+ '(fp->_Mode & 0x2000 /*_MWRITE*/ ? fp->_Next - fp->_Buf : 0)' \
+ \
+ '# old glibc?' \
+ 'fp->__bufp - fp->__buffer' \
+ \
+ '# old glibc iostream?' \
+ 'fp->_pptr - fp->_pbase' \
+ \
+ '# emx+gcc' \
+ 'fp->_ptr - fp->_buffer' \
+ \
+ '# Minix' \
+ 'fp->_ptr - fp->_buf' \
+ \
+ '# Plan9' \
+ 'fp->wp - fp->buf' \
+ \
+ '# VMS' \
+ '(*fp)->_ptr - (*fp)->_base' \
+ \
+ '# e.g., DGUX R4.11; the info is not available' \
+ 1 \
+ ; do
+
+ # Skip each embedded comment.
+ case "$ac_expr" in '#'*) continue;; esac
+
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <stdio.h>]],
+ [[FILE *fp = stdin; (void) ($ac_expr);]])],
+ [fp_done=yes]
+ )
+ test "$fp_done" = yes && break
+ done
+
+ ac_cv_sys_pending_output_n_bytes=$ac_expr
+ ]
+ )
+ AC_DEFINE_UNQUOTED([PENDING_OUTPUT_N_BYTES],
+ $ac_cv_sys_pending_output_n_bytes,
+ [the number of pending output bytes on stream 'fp'])
+])
--- /dev/null
+# serial 18
+
+dnl From Jim Meyering.
+dnl A wrapper around AC_FUNC_GETGROUPS.
+
+# Copyright (C) 1996-1997, 1999-2004, 2008-2012 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+m4_version_prereq([2.70], [] ,[
+
+# This is taken from the following Autoconf patch:
+# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9
+AC_DEFUN([AC_FUNC_GETGROUPS],
+[
+ AC_REQUIRE([AC_TYPE_GETGROUPS])dnl
+ AC_REQUIRE([AC_TYPE_SIZE_T])dnl
+ AC_REQUIRE([AC_CANONICAL_HOST])dnl for cross-compiles
+ AC_CHECK_FUNC([getgroups])
+
+ # If we don't yet have getgroups, see if it's in -lbsd.
+ # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1.
+ ac_save_LIBS=$LIBS
+ if test $ac_cv_func_getgroups = no; then
+ AC_CHECK_LIB(bsd, getgroups, [GETGROUPS_LIB=-lbsd])
+ fi
+
+ # Run the program to test the functionality of the system-supplied
+ # getgroups function only if there is such a function.
+ if test $ac_cv_func_getgroups = yes; then
+ AC_CACHE_CHECK([for working getgroups], [ac_cv_func_getgroups_works],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [AC_INCLUDES_DEFAULT],
+ [[/* On Ultrix 4.3, getgroups (0, 0) always fails. */
+ return getgroups (0, 0) == -1;]])
+ ],
+ [ac_cv_func_getgroups_works=yes],
+ [ac_cv_func_getgroups_works=no],
+ [case "$host_os" in # ((
+ # Guess yes on glibc systems.
+ *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) ac_cv_func_getgroups_works="guessing no" ;;
+ esac
+ ])
+ ])
+ else
+ ac_cv_func_getgroups_works=no
+ fi
+ case "$ac_cv_func_getgroups_works" in
+ *yes)
+ AC_DEFINE([HAVE_GETGROUPS], [1],
+ [Define to 1 if your system has a working `getgroups' function.])
+ ;;
+ esac
+ LIBS=$ac_save_LIBS
+])# AC_FUNC_GETGROUPS
+
+])
+
+AC_DEFUN([gl_FUNC_GETGROUPS],
+[
+ AC_REQUIRE([AC_TYPE_GETGROUPS])
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+ AC_FUNC_GETGROUPS
+ if test $ac_cv_func_getgroups != yes; then
+ HAVE_GETGROUPS=0
+ else
+ if test "$ac_cv_type_getgroups" != gid_t \
+ || { case "$ac_cv_func_getgroups_works" in
+ *yes) false;;
+ *) true;;
+ esac
+ }; then
+ REPLACE_GETGROUPS=1
+ AC_DEFINE([GETGROUPS_ZERO_BUG], [1], [Define this to 1 if
+ getgroups(0,NULL) does not return the number of groups.])
+ else
+ dnl Detect FreeBSD bug; POSIX requires getgroups(-1,ptr) to fail.
+ AC_CACHE_CHECK([whether getgroups handles negative values],
+ [gl_cv_func_getgroups_works],
+ [AC_RUN_IFELSE([AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT],
+ [[int size = getgroups (0, 0);
+ gid_t *list = malloc (size * sizeof *list);
+ return getgroups (-1, list) != -1;]])],
+ [gl_cv_func_getgroups_works=yes],
+ [gl_cv_func_getgroups_works=no],
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_getgroups_works="guessing no" ;;
+ esac
+ ])])
+ case "$gl_cv_func_getgroups_works" in
+ *yes) ;;
+ *) REPLACE_GETGROUPS=1 ;;
+ esac
+ fi
+ fi
+ test -n "$GETGROUPS_LIB" && LIBS="$GETGROUPS_LIB $LIBS"
+])
# Code from module c-strcase:
# Code from module careadlinkat:
# Code from module clock-time:
+ # Code from module close-stream:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module dtotimespec:
# Code from module dup2:
# Code from module environ:
+ # Code from module euidaccess:
# Code from module execinfo:
# Code from module extensions:
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
# Code from module extern-inline:
+ # Code from module faccessat:
+ # Code from module fcntl-h:
# Code from module filemode:
+ # Code from module fpending:
+ # Code from module getgroups:
# Code from module getloadavg:
# Code from module getopt-gnu:
# Code from module getopt-posix:
# Code from module gettext-h:
# Code from module gettime:
# Code from module gettimeofday:
+ # Code from module group-member:
# Code from module ignore-value:
# Code from module include_next:
# Code from module intprops:
# Code from module pselect:
# Code from module pthread_sigmask:
# Code from module readlink:
+ # Code from module root-uid:
# Code from module signal-h:
# Code from module snippet/_Noreturn:
# Code from module snippet/arg-nonnull:
# Code from module utimens:
# Code from module verify:
# Code from module warnings:
+ # Code from module xalloc-oversized:
])
# This macro should be invoked from ./configure.ac, in the section
gl_FUNC_ALLOCA
AC_CHECK_FUNCS_ONCE([readlinkat])
gl_CLOCK_TIME
+ gl_CLOSE_STREAM
+ gl_MODULE_INDICATOR([close-stream])
gl_MD5
gl_SHA1
gl_SHA256
gl_UNISTD_MODULE_INDICATOR([environ])
gl_EXECINFO_H
AC_REQUIRE([gl_EXTERN_INLINE])
+ gl_FUNC_FACCESSAT
+ if test $HAVE_FACCESSAT = 0; then
+ AC_LIBOBJ([faccessat])
+ gl_PREREQ_FACCESSAT
+ fi
+ gl_MODULE_INDICATOR([faccessat])
+ gl_UNISTD_MODULE_INDICATOR([faccessat])
+ gl_FCNTL_H
gl_FILEMODE
+ gl_FUNC_FPENDING
+ if test $ac_cv_func___fpending = no; then
+ AC_LIBOBJ([fpending])
+ gl_PREREQ_FPENDING
+ fi
gl_GETLOADAVG
if test $HAVE_GETLOADAVG = 0; then
AC_LIBOBJ([getloadavg])
gl_UNISTD_H
gl_UTIMENS
gl_gnulib_enabled_dosname=false
+ gl_gnulib_enabled_euidaccess=false
+ gl_gnulib_enabled_getgroups=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false
gl_gnulib_enabled_pathmax=false
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
gl_gnulib_enabled_stat=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
gl_gnulib_enabled_verify=false
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
func_gl_gnulib_m4code_dosname ()
{
if ! $gl_gnulib_enabled_dosname; then
gl_gnulib_enabled_dosname=true
fi
}
+ func_gl_gnulib_m4code_euidaccess ()
+ {
+ if ! $gl_gnulib_enabled_euidaccess; then
+ gl_FUNC_EUIDACCESS
+ if test $HAVE_EUIDACCESS = 0; then
+ AC_LIBOBJ([euidaccess])
+ gl_PREREQ_EUIDACCESS
+ fi
+ gl_UNISTD_MODULE_INDICATOR([euidaccess])
+ gl_gnulib_enabled_euidaccess=true
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1
+ fi
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_stat
+ fi
+ fi
+ }
+ func_gl_gnulib_m4code_getgroups ()
+ {
+ if ! $gl_gnulib_enabled_getgroups; then
+ gl_FUNC_GETGROUPS
+ if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then
+ AC_LIBOBJ([getgroups])
+ fi
+ gl_UNISTD_MODULE_INDICATOR([getgroups])
+ gl_gnulib_enabled_getgroups=true
+ fi
+ }
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
{
if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
fi
}
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 ()
+ {
+ if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then
+ gl_FUNC_GROUP_MEMBER
+ if test $HAVE_GROUP_MEMBER = 0; then
+ AC_LIBOBJ([group-member])
+ gl_PREREQ_GROUP_MEMBER
+ fi
+ gl_UNISTD_MODULE_INDICATOR([group-member])
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_getgroups
+ fi
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec
+ fi
+ fi
+ }
func_gl_gnulib_m4code_pathmax ()
{
if ! $gl_gnulib_enabled_pathmax; then
gl_gnulib_enabled_pathmax=true
fi
}
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c ()
+ {
+ if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true
+ fi
+ }
func_gl_gnulib_m4code_stat ()
{
if ! $gl_gnulib_enabled_stat; then
gl_gnulib_enabled_verify=true
fi
}
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec ()
+ {
+ if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true
+ fi
+ }
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_dosname
+ fi
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_euidaccess
+ fi
if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
fi
m4_pattern_allow([^gl_GNULIB_ENABLED_])
AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups])
AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1])
AM_CONDITIONAL([gl_GNULIB_ENABLED_pathmax], [$gl_gnulib_enabled_pathmax])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c])
AM_CONDITIONAL([gl_GNULIB_ENABLED_stat], [$gl_gnulib_enabled_stat])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoull], [$gl_gnulib_enabled_strtoull])
AM_CONDITIONAL([gl_GNULIB_ENABLED_verify], [$gl_gnulib_enabled_verify])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec])
# End of code from modules
m4_ifval(gl_LIBSOURCES_LIST, [
m4_syscmd([test ! -d ]m4_defn([gl_LIBSOURCES_DIR])[ ||
lib/alloca.in.h
lib/allocator.c
lib/allocator.h
+ lib/at-func.c
lib/c-ctype.c
lib/c-ctype.h
lib/c-strcase.h
lib/c-strncasecmp.c
lib/careadlinkat.c
lib/careadlinkat.h
+ lib/close-stream.c
+ lib/close-stream.h
lib/dosname.h
lib/dtoastr.c
lib/dtotimespec.c
lib/dup2.c
+ lib/euidaccess.c
lib/execinfo.c
lib/execinfo.in.h
+ lib/faccessat.c
+ lib/fcntl.in.h
lib/filemode.c
lib/filemode.h
+ lib/fpending.c
+ lib/fpending.h
lib/ftoastr.c
lib/ftoastr.h
+ lib/getgroups.c
lib/getloadavg.c
lib/getopt.c
lib/getopt.in.h
lib/gettext.h
lib/gettime.c
lib/gettimeofday.c
+ lib/group-member.c
lib/ignore-value.h
lib/intprops.h
lib/inttypes.in.h
lib/pselect.c
lib/pthread_sigmask.c
lib/readlink.c
+ lib/root-uid.h
lib/sha1.c
lib/sha1.h
lib/sha256.c
lib/utimens.c
lib/utimens.h
lib/verify.h
+ lib/xalloc-oversized.h
m4/00gnulib.m4
m4/alloca.m4
m4/c-strtod.m4
m4/clock_time.m4
+ m4/close-stream.m4
m4/dup2.m4
m4/environ.m4
+ m4/euidaccess.m4
m4/execinfo.m4
m4/extensions.m4
m4/extern-inline.m4
+ m4/faccessat.m4
+ m4/fcntl-o.m4
+ m4/fcntl_h.m4
m4/filemode.m4
+ m4/fpending.m4
+ m4/getgroups.m4
m4/getloadavg.m4
m4/getopt.m4
m4/gettime.m4
m4/gettimeofday.m4
m4/gnulib-common.m4
+ m4/group-member.m4
m4/include_next.m4
m4/inttypes.m4
m4/largefile.m4
--- /dev/null
+# serial 14
+
+# Copyright (C) 1999-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
+
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl Written by Jim Meyering
+
+AC_DEFUN([gl_FUNC_GROUP_MEMBER],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+
+ dnl Persuade glibc <unistd.h> to declare group_member().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ dnl Do this replacement check manually because I want the hyphen
+ dnl (not the underscore) in the filename.
+ AC_CHECK_FUNC([group_member], , [
+ HAVE_GROUP_MEMBER=0
+ ])
+])
+
+# Prerequisites of lib/group-member.c.
+AC_DEFUN([gl_PREREQ_GROUP_MEMBER],
+[
+ AC_REQUIRE([AC_FUNC_GETGROUPS])
+])
/^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/
/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION ""/
/^#undef PENDING_OUTPUT_COUNT/s/^.*$/#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)/
-/^#undef VERSION/s/^.*$/#define VERSION "24.2.50"/
+/^#undef VERSION/s/^.*$/#define VERSION "24.3.50"/
/^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/
/^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/
/^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_FPATHCONF): Remove.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * inc/sys/socket.h (O_NONBLOCK): Rename from O_NDELAY, since the
+ POSIX name for this flag is O_NONBLOCK. All uses changed.
+ * inc/unistd.h (O_RDWR, O_NOCTTY): New macros. Like AT_FDCWD etc.
+ these really should be moved to a replacement <fcntl.h> if and
+ when that gets implemented. In the meantime, include <fcntl.h>
+ to make sure we don't override its definitions.
+
+2012-11-17 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/sys/wait.h: New file, with prototype of waitpid and
+ definitions of macros it needs.
+
+ * inc/ms-w32.h (wait): Don't define, 'wait' is not used anymore.
+ (sys_wait): Remove prototype.
+
+ * config.nt (HAVE_SYS_WAIT_H): Define to 1.
+
+2012-11-17 Dani Moncayo <dmoncayo@gmail.com>
+
+ * zipdist.bat (ZIP_CHECK): Remove unused label. When invoking 7z
+ to check if it's installed, redirect standard output and standard
+ error to the null device.
+ (ZIP_DIST): Don't build the "barebin" distribution.
+
+2012-11-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (GETGROUPS_T, GETGROUPS_ZERO_BUG, GNULIB_FACCESSAT, HAVE_ACCESS)
+ (HAVE_EACCESS, HAVE_FACCESSAT, HAVE_GETGROUPS, HAVE_LIBGEN_H):
+ New macros.
+
+2012-11-14 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/unistd.h (faccessat): Add prototype.
+ (AT_FDCWD, AT_EACCESS, AT_SYMLINK_NOFOLLOW): New macros; the first
+ 2 moved from ms-w32.h.
+
+ * inc/ms-w32.h (AT_FDCWD, AT_EACCESS, faccessat): Remove macros.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ * inc/ms-w32.h (AT_FDCWD, AT_EACCESS): New symbols.
+ (access): Remove.
+ (faccessat): New macro.
+
+2012-11-05 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/unistd.h (tcgetpgrp, setsid): Provide prototypes.
+
+2012-11-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (DISPNEW_NEEDS_STDIO_EXT, GETPGRP_VOID, HAVE_SETPGID, HAVE_SETSID)
+ (PENDING_OUTPUT_COUNT, SETPGRP_RELEASES_CTTY): Remove.
+
+2012-11-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (GNULIB_CLOSE_STREAM, HAVE_DECL___FPENDING): New macros.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt (PENDING_OUTPUT_N_BYTES): Define.
+
2012-11-01 Eli Zaretskii <eliz@gnu.org>
* inc/unistd.h (setpgid, getpgrp): Provide prototypes. (Bug#12776)
/* Character that separates directories in a file name. */
#define DIRECTORY_SEP '/'
-/* Define if dispnew.c should include stdio_ext.h. */
-#undef DISPNEW_NEEDS_STDIO_EXT
-
/* Define if process.c does not need to close a pty to make it a controlling
terminal (it is already a controlling terminal of the subprocess, because
we did ioctl TIOCSCTTY). */
setjmp does work. */
#define GC_SETJMP_WORKS 1
-/* Define to 1 if the `getpgrp' function requires zero arguments. */
-#define GETPGRP_VOID 1
+/* Define to the type of elements in the array set by `getgroups'. Usually
+ this is either `int' or `gid_t'. */
+#undef GETGROUPS_T
+
+/* Define this to 1 if getgroups(0,NULL) does not return the number of groups.
+ */
+#undef GETGROUPS_ZERO_BUG
/* Define if gettimeofday clobbers the localtime buffer. */
#undef GETTIMEOFDAY_CLOBBERS_LOCALTIME
/* Define this to enable glyphs debugging code. */
/* #undef GLYPH_DEBUG */
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module close-stream shall be considered present. */
+#undef GNULIB_CLOSE_STREAM
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module faccessat shall be considered present. */
+#undef GNULIB_FACCESSAT
+
/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
whether the gnulib module fscanf shall be considered present. */
#undef GNULIB_FSCANF
startup, if using GTK. */
#undef G_SLICE_ALWAYS_MALLOC
+/* Define to 1 if you have the `access' function. */
+#undef HAVE_ACCESS
+
/* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */
#undef HAVE_AIX_SMT_EXP
*/
#define HAVE_DECL_TZNAME 1
+/* Define to 1 if you have the declaration of `__fpending', and to 0 if you
+ don't. */
+#undef HAVE_DECL___FPENDING
+
/* Define to 1 if you have the declaration of `__sys_siglist', and to 0 if you
don't. */
#undef HAVE_DECL___SYS_SIGLIST
/* Define to 1 if you have the 'dup2' function. */
#define HAVE_DUP2 1
+/* Define to 1 if you have the `eaccess' function. */
+#undef HAVE_EACCESS
+
/* Define to 1 if you have the `endgrent' function. */
#undef HAVE_ENDGRENT
/* Define to 1 if you have the <execinfo.h> header file. */
#define HAVE_EXECINFO_H 1
+/* Define to 1 if you have the `faccessat' function. */
+#undef HAVE_FACCESSAT
+
/* Define to 1 if you have the <fcntl.h> header file. */
#undef HAVE_FCNTL_H
/* Define to 1 if you have the `fork' function. */
#undef HAVE_FORK
-/* Define to 1 if you have the `fpathconf' function. */
-#undef HAVE_FPATHCONF
-
/* Define to 1 if you have the `freeifaddrs' function. */
#undef HAVE_FREEIFADDRS
/* Define to 1 if you have the `getgrent' function. */
#undef HAVE_GETGRENT
+/* Define to 1 if your system has a working `getgroups' function. */
+#undef HAVE_GETGROUPS
+
/* Define to 1 if you have the `gethostname' function. */
#define HAVE_GETHOSTNAME 1
/* Define to 1 if you have the `dnet' library (-ldnet). */
#undef HAVE_LIBDNET
+/* Define to 1 if you have the <libgen.h> header file. */
+#undef HAVE_LIBGEN_H
+
/* Define to 1 if you have the hesiod library (-lhesiod). */
#undef HAVE_LIBHESIOD
/* Define to 1 if you have the `setlocale' function. */
#define HAVE_SETLOCALE 1
-/* Define to 1 if you have the `setpgid' function. */
-#undef HAVE_SETPGID
-
/* Define to 1 if you have the `setrlimit' function. */
#undef HAVE_SETRLIMIT
-/* Define to 1 if you have the `setsid' function. */
-#undef HAVE_SETSID
-
/* Define to 1 if you have the `shutdown' function. */
#define HAVE_SHUTDOWN 1
#undef HAVE_SYS_VLIMIT_H
/* Define to 1 if you have <sys/wait.h> that is POSIX.1 compatible. */
-#undef HAVE_SYS_WAIT_H
+#define HAVE_SYS_WAIT_H 1
/* Define to 1 if you have the <term.h> header file. */
#undef HAVE_TERM_H
/* Define to the version of this package. */
#undef PACKAGE_VERSION
-/* Number of chars of output in the buffer of a stdio stream. */
-#undef PENDING_OUTPUT_COUNT
+/* the number of pending output bytes on stream 'fp' */
+#define PENDING_OUTPUT_N_BYTES (fp->_ptr - fp->_base)
/* Define to empty to suppress deprecation warnings when building with
--enable-gcc-warnings and with libpng versions before 1.5, which lack
/* Character that separates PATH elements. */
#define SEPCHAR ';'
-/* Define if process.c:child_setup should not call setpgrp. */
-#undef SETPGRP_RELEASES_CTTY
-
/* How to set up a slave PTY, if needed. */
#undef SETUP_SLAVE_PTY
#undef USG_SUBTTY_WORKS
/* Version number of package */
-#define VERSION "24.2.50"
+#define VERSION "24.3.50"
/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
'wchar_t'. */
#endif
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 24,2,50,0
- PRODUCTVERSION 24,2,50,0
+ FILEVERSION 24,3,50,0
+ PRODUCTVERSION 24,3,50,0
FILEFLAGSMASK 0x3FL
#ifdef EMACSDEBUG
FILEFLAGS 0x1L
BEGIN
VALUE "CompanyName", "Free Software Foundation\0"
VALUE "FileDescription", "GNU Emacs: The extensible self-documenting text editor\0"
- VALUE "FileVersion", "24, 2, 50, 0\0"
+ VALUE "FileVersion", "24, 3, 50, 0\0"
VALUE "InternalName", "Emacs\0"
VALUE "LegalCopyright", "Copyright (C) 2001-2012\0"
VALUE "OriginalFilename", "emacs.exe"
VALUE "ProductName", "Emacs\0"
- VALUE "ProductVersion", "24, 2, 50, 0\0"
+ VALUE "ProductVersion", "24, 3, 50, 0\0"
VALUE "OLESelfRegister", "\0"
END
END
#endif
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 24,2,50,0
- PRODUCTVERSION 24,2,50,0
+ FILEVERSION 24,3,50,0
+ PRODUCTVERSION 24,3,50,0
FILEFLAGSMASK 0x3FL
#ifdef EMACSDEBUG
FILEFLAGS 0x1L
BEGIN
VALUE "CompanyName", "Free Software Foundation\0"
VALUE "FileDescription", "GNU EmacsClient: Client for the extensible self-documenting text editor\0"
- VALUE "FileVersion", "24, 2, 50, 0\0"
+ VALUE "FileVersion", "24, 3, 50, 0\0"
VALUE "InternalName", "EmacsClient\0"
VALUE "LegalCopyright", "Copyright (C) 2001-2012\0"
VALUE "OriginalFilename", "emacsclientw.exe"
VALUE "ProductName", "EmacsClient\0"
- VALUE "ProductVersion", "24, 2, 50, 0\0"
+ VALUE "ProductVersion", "24, 3, 50, 0\0"
VALUE "OLESelfRegister", "\0"
END
END
#endif
/* Calls that are emulated or shadowed. */
-#undef access
-#define access sys_access
#undef chdir
#define chdir sys_chdir
#undef chmod
/* Subprocess calls that are emulated. */
#define spawnve sys_spawnve
-#define wait sys_wait
#define kill sys_kill
#define signal sys_signal
/* Internal signals. */
#define emacs_raise(sig) emacs_abort()
-extern int sys_wait (int *);
-
/* termcap.c calls that are emulated. */
#define tputs sys_tputs
#define tgetstr sys_tgetstr
an fcntl function, for setting sockets to non-blocking mode. */
int fcntl (int s, int cmd, int options);
#define F_SETFL 4
-#define O_NDELAY 04000
+#define O_NONBLOCK 04000
/* we are providing a real h_errno variable */
#undef h_errno
--- /dev/null
+/* A limited emulation of sys/wait.h on Posix systems.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef INC_SYS_WAIT_H_
+#define INC_SYS_WAIT_H_
+
+#define WNOHANG 1
+#define WUNTRACED 2
+#define WSTOPPED 2 /* same as WUNTRACED */
+#define WEXITED 4
+#define WCONTINUED 8
+
+/* The various WIF* macros are defined in src/syswait.h. */
+
+extern pid_t waitpid (pid_t, int *, int);
+
+#endif /* INC_SYS_WAIT_H_ */
<unistd.h> also includes <stdlib.h>, so there's no need to declare
'environ' here. */
+/* Provide prototypes of library functions that are emulated on w32
+ and whose prototypes are usually found in unistd.h on POSIX
+ platforms. */
extern ssize_t readlink (const char *, char *, size_t);
extern int symlink (char const *, char const *);
extern int setpgid (pid_t, pid_t);
extern pid_t getpgrp (void);
+extern pid_t setsid (void);
+extern pid_t tcgetpgrp (int);
+
+extern int faccessat (int, char const *, int, int);
+
+/* These are normally on fcntl.h, but we don't override that header. */
+/* Use values compatible with gnulib, as there's no reason to differ. */
+#define AT_FDCWD (-3041965)
+#define AT_EACCESS 4
+#define AT_SYMLINK_NOFOLLOW 4096
+
+/* Here are some more fcntl.h macros that default to gnulib-compatible
+ values. Include <fcntl.h> first, to make sure we don't override
+ its values if any. FIXME: If we know <fcntl.h> does not define
+ O_NOCTTY and O_RDWR, this can be replaced with a simple "#define
+ O_NOCTTY 0" and "#define O_RDWR 2". */
+#include <fcntl.h>
+#ifndef O_NOCTTY
+#define O_NOCTTY 0
+#endif
+#ifndef O_RDWR
+#define O_RDWR 2
+#endif
#endif /* _UNISTD_H */
# FIXME: This file uses DOS EOLs. Convert to Unix after 22.1 is out
# (and remove or replace this comment).
-VERSION = 24.2.50
+VERSION = 24.3.50
TMP_DIST_DIR = emacs-$(VERSION)
set TMP_DIST_DIR=emacs-%EMACS_VER%\r
\r
rem Check, if 7zip is installed and available on path\r
-:ZIP_CHECK\r
-7z\r
-if %ERRORLEVEL% NEQ 0 goto :ZIP_ERROR\r
+7z 1>NUL 2>NUL\r
+if %ERRORLEVEL% NEQ 0 goto ZIP_ERROR\r
goto ZIP_DIST\r
\r
:ZIP_ERROR\r
echo ERROR: Make sure 7zip is installed and available on the Windows Path!\r
goto EXIT\r
\r
-rem Build distributions\r
+rem Build and verify the binary distribution\r
:ZIP_DIST\r
-rem Build and verify full distribution\r
7z a -bd -tZIP -mx=9 -x!.bzrignore -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-bin-i386.zip %TMP_DIST_DIR%\r
7z t emacs-%EMACS_VER%-bin-i386.zip\r
-rem Build and verify binary only distribution\r
-7z a -bd -tZIP -mx=9 -x!.bzrignore -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-barebin-i386.zip %TMP_DIST_DIR%/README.W32 %TMP_DIST_DIR%/bin %TMP_DIST_DIR%/etc/DOC-X %TMP_DIST_DIR%/COPYING\r
-7z t emacs-%EMACS_VER%-barebin-i386.zip\r
goto EXIT\r
\r
:EXIT\r
a second line gives the more precise type.
end
+define pvectype
+ set $size = ((struct Lisp_Vector *) $arg0)->header.size
+ if ($size & PSEUDOVECTOR_FLAG)
+ output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
+ else
+ output PVEC_NORMAL_VECTOR
+ end
+ echo \n
+end
+document pvectype
+Print the subtype of vectorlike object.
+Takes one argument, a pointer to an object.
+end
+
define xvectype
xgetptr $
- set $size = ((struct Lisp_Vector *) $ptr)->header.size
+ pvectype $ptr
+end
+document xvectype
+Print the subtype of vectorlike object.
+This command assumes that $ is a Lisp_Object.
+end
+
+define pvecsize
+ set $size = ((struct Lisp_Vector *) $arg0)->header.size
if ($size & PSEUDOVECTOR_FLAG)
- output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
+ output ($size & PSEUDOVECTOR_SIZE_MASK)
+ echo \n
+ output (($size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_SIZE_BITS)
else
- output $size & ~ARRAY_MARK_FLAG
+ output ($size & ~ARRAY_MARK_FLAG)
end
echo \n
end
-document xvectype
-Print the size or vector subtype of $.
-This command assumes that $ is a vector or pseudovector.
+document pvecsize
+Print the size of vectorlike object.
+Takes one argument, a pointer to an object.
+end
+
+define xvecsize
+ xgetptr $
+ pvecsize $ptr
+end
+document xvecsize
+Print the size of $
+This command assumes that $ is a Lisp_Object.
end
define xmisctype
if $type == Lisp_Vectorlike
set $size = ((struct Lisp_Vector *) $ptr)->header.size
if ($size & PSEUDOVECTOR_FLAG)
- set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
+ set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
if $vec == PVEC_NORMAL_VECTOR
xvector
end
xgetptr ($bt->function)
set $size = ((struct Lisp_Vector *) $ptr)->header.size
if ($size & PSEUDOVECTOR_FLAG)
- output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
+ output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
else
output $size & ~ARRAY_MARK_FLAG
end
-2012-11-17 Eli Zaretskii <eliz@gnu.org>
+2012-11-18 Eli Zaretskii <eliz@gnu.org>
* w32select.c: Include w32common.h before w32term.h, so that
windows.h gets included before w32term.h uses some of its
prototypes.
(EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878)
-2012-11-17 Jan Djärv <jan.h.d@swipnet.se>
+2012-11-18 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (hold_event): Set send_appdefined to YES (Bug#12834).
(ns_select): Return at once if events are held (Bug#12834).
-2012-11-16 enami tsugutomo <tsugutomo.enami@jp.sony.com>
+2012-11-18 enami tsugutomo <tsugutomo.enami@jp.sony.com>
* unexelf.c (ELFSIZE) [__NetBSD__ && _LP64]: Set to 64.
Needed following 2012-10-20 change. (Bug#12902)
+2012-11-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32proc.c (waitpid): Remove unused label get_result.
+
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (SYSWAIT_H): New macro.
+ ($(BLD)/callproc.$(O), $(BLD)/w32proc.$(O), $(BLD)/process.$(O))
+ ($(BLD)/sysdep.$(O)): Update dependencies.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * callproc.c (relocate_fd): Assume F_DUPFD.
+ * emacs.c, term.c (O_RDWR): Remove.
+ * keyboard.c (tty_read_avail_input): Use O_NONBLOCK rather than
+ O_NDELAY, since O_NONBLOCK is the standard name for this flag.
+ * nsterm.m: Assume <fcntl.h> exists.
+ * process.c (NON_BLOCKING_CONNECT, allocate_pty, create_process)
+ (create_pty, Fmake_network_process, server_accept_connection)
+ (wait_reading_process_output, init_process_emacs):
+ Assume O_NONBLOCK.
+ (wait_reading_process_output): Put in a special case for WINDOWSNT
+ to mimick the older behavior where it had O_NDELAY but not O_NONBLOCK.
+ It's not clear this is needed, but it's a more-conservative change.
+ (create_process): Assume FD_CLOEXEC.
+ (create_process, create_pty): Assume O_NOCTTY.
+ * sysdep.c (init_sys_modes, reset_sys_modes): Assume F_SETFL.
+ (reset_sys_modes): Use O_NONBLOCK rather than O_NDELAY.
+ Omit if not DOS_NT, since F_GETFL is not defined there.
+ (serial_open): Assume O_NONBLOCK and O_NOCTTY.
+ * term.c: Include <fcntl.h>, for flags like O_NOCTTY.
+ (O_NOCTTY): Remove.
+ (init_tty): Assume O_IGNORE_CTTY is defined to 0 on platforms that
+ lack it, since gnulib guarantees this.
+ * w32.c (fcntl): Test for O_NONBLOCK rather than O_NDELAY.
+
+2012-11-17 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (faccessat): Pretend that directories have the execute bit
+ set. Emacs expects that, e.g., in files.el:cd-absolute.
+
+ * w32proc.c (create_child): Don't clip the PID of the child
+ process to fit into an Emacs integer, as this is no longer a
+ restriction.
+ (waitpid): Rename from sys_wait. Emulate a Posix 'waitpid' by
+ reaping only the process specified by PID argument, if that is
+ positive. Use PID instead of dead_child to know which process to
+ reap. Wait for the child to die only if WNOHANG is not in
+ OPTIONS.
+ (sys_select): Don't set dead_child.
+
+ * sysdep.c (wait_for_termination_1): Remove the WINDOWSNT portion,
+ as it is no longer needed.
+
+ * process.c (waitpid, WUNTRACED) [!WNOHANG]: Remove definitions,
+ no longer needed.
+ (record_child_status_change): Remove the setting of
+ record_at_most_one_child for the !WNOHANG case.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix problems in ns port found by static checking.
+ * nsterm.m: Include <pthread.h>, for pthread_mutex_lock etc.
+ (hold_event, setPosition:portion:whole:): Send SIGIO only to self,
+ not to process group.
+ (ns_select): Use emacs_write, not write, as that's more robust
+ in the presence of signals.
+ (fd_handler:): Check for read errors.
+
2012-11-16 Glenn Morris <rgm@gnu.org>
* editfns.c (Fmessage): Mention message-log-max. (Bug#12849)
-2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
* eval.c (Finteractive_p): Revert lexbind-merge mishap.
-2012-11-14 Eli Zaretskii <eliz@gnu.org>
+2012-11-16 Eli Zaretskii <eliz@gnu.org>
* w32proc.c (timer_loop): Make sure SuspendThread and ResumeThread
use the same value of thread handle.
(getitimer): Don't duplicate the caller thread's handle here.
(Bug#12832)
-2012-11-13 Jan Djärv <jan.h.d@swipnet.se>
+2012-11-16 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (hold_event): Send SIGIO to make sure ns_read_socket is
called (Bug#12834).
-2012-11-12 Eli Zaretskii <eliz@gnu.org>
+2012-11-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used pty_max_bytes variable.
+ * process.c (pty_max_bytes): Remove; unused.
+ (send_process): Do not set it.
+
+2012-11-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/dispnew.$(O), $(BLD)/emacs.$(O)):
+ Update dependencies.
+
+2012-11-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * eval.c (mark_backtrace) [BYTE_MARK_STACK]: Remove stray '*'.
+ This follows up on the 2012-09-29 patch that removed indirection
+ for the 'function' field. Reported by Sergey Vinokurov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00263.html>.
+
+2012-11-14 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (faccessat): Rename from sys_faccessat. (No need to use a
+ different name, as the MS runtime does not have such a function,
+ and probably never will.) All callers changed. Ignore DIRFD
+ value if PATH is an absolute file name, to match Posix spec
+ better. If AT_SYMLINK_NOFOLLOW is set in FLAGS, don't resolve
+ symlinks.
+
+2012-11-14 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xdisp.c (echo_area_display, redisplay_internal):
+ Omit redundant check whether frame_garbaged is set.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ This fixes a bug that has been present in Emacs since its creation.
+ It was reported by Chris Torek in 1983 even before GNU Emacs existed,
+ which must set some sort of record. (Torek's bug report was against
+ a predecessor of GNU Emacs, but GNU Emacs happened to have the
+ same common flaw.) See Torek's Usenet posting
+ "setuid/setgid programs & Emacs" Article-I.D.: sri-arpa.858
+ Posted: Fri Apr 8 14:18:56 1983.
+ * Makefile.in (LIB_EACCESS): New macro.
+ (LIBES): Use it.
+ * callproc.c (init_callproc):
+ * charset.c (init_charset):
+ * fileio.c (check_existing, check_executable, check_writable)
+ (Ffile_readable_p):
+ * lread.c (openp, load_path_check):
+ * process.c (allocate_pty):
+ * xrdb.c (file_p):
+ Use effective UID when checking permissions, not real UID.
+ * callproc.c (init_callproc):
+ * charset.c (init_charset):
+ * lread.c (load_path_check, init_lread):
+ Test whether directories are accessible, not merely whether they exist.
+ * conf_post.h (GNULIB_SUPPORT_ONLY_AT_FDCWD): New macro.
+ * fileio.c (check_existing, check_executable, check_writable)
+ (Ffile_readable_p):
+ Use symbolic names instead of integers for the flags, as they're
+ portable now.
+ (check_writable): New arg AMODE. All uses changed.
+ Set errno on failure.
+ (Ffile_readable_p): Use faccessat, not stat + open + close.
+ (Ffile_writable_p): No need to call check_existing + check_writable.
+ Just call check_writable and then look at errno. This saves a syscall.
+ dir should never be nil; replace an unnecessary runtime check
+ with an eassert. When checking the parent directory of a nonexistent
+ file, check that the directory is searchable as well as writable, as
+ we can't create files in unsearchable directories.
+ (file_directory_p): New function, which uses 'stat' on most platforms
+ but faccessat with D_OK (for efficiency) if WINDOWSNT.
+ (Ffile_directory_p, Fset_file_times): Use it.
+ (file_accessible_directory_p): New function, which uses a single
+ syscall for efficiency.
+ (Ffile_accessible_directory_p): Use it.
+ * xrdb.c (file_p): Use file_directory_p.
+ * lisp.h (file_directory_p, file_accessible_directory_p): New decls.
+ * lread.c (openp): When opening a file, use fstat rather than
+ stat, as that avoids a permissions race. When not opening a file,
+ use file_directory_p rather than stat.
+ (dir_warning): First arg is now a usage string, not a format.
+ Use errno. All uses changed.
+ * nsterm.m (ns_term_init): Remove unnecessary call to file-readable
+ that merely introduced a race.
+ * process.c, sysdep.c, term.c: All uses of '#ifdef O_NONBLOCK'
+ changed to '#if O_NONBLOCK', to accommodate gnulib O_* style,
+ and similarly for the other O_* flags.
+ * w32.c (sys_faccessat): Rename from sys_access and switch to
+ faccessat's API. All uses changed.
+ * xrdb.c: Do not include <sys/stat.h>; no longer needed.
+ (magic_db): Rename from magic_file_p.
+ (magic_db, search_magic_path): Return an XrmDatabase rather than a
+ char *, so that we don't have to test for file existence
+ separately from opening the file for reading. This removes a race
+ fixes a permission-checking problem, and simplifies the code.
+ All uses changed.
+ (file_p): Remove; no longer needed.
+
+2012-11-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Omit glyphs initialization at startup.
+ * dispnew.c (glyphs_initialized_initially_p): Remove.
+ (adjust_frame_glyphs_initially): Likewise. Adjust users.
+ (Fredraw_frame): Move actual code from here...
+ (redraw_frame): ...to here. Add eassert. Adjust comment.
+ (Fredraw_display): Use redraw_frame.
+ * xdisp.c (clear_garbaged_frames): Likewise.
+
+2012-11-13 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (decode_mode_spec): Limit the value of WIDTH argument
passed to pint2str and pint2hrstr to be at most the size of the
large values of FIELD_WIDTH argument to decode_mode_spec.
(Bug#12867)
-2012-11-07 Martin Rudalics <rudalics@gmx.at>
+2012-11-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix a race with verify-visited-file-modtime (Bug#12863).
+ Since at least 1991 Emacs has ignored an mtime difference of no
+ more than one second, but my guess is that this was to work around
+ file system bugs that were fixed long ago. Since the race is
+ causing problems now, let's remove that code.
+ * fileio.c (Fverify_visited_file_modtime): Do not accept a file
+ whose time stamp is off by no more than a second. Insist that the
+ file time stamps match exactly.
+
+2012-11-12 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * frame.h (struct frame): Convert external_tool_bar member to
+ 1-bit unsigned bitfield.
+ * termhooks.h (struct terminal): Remove mouse_moved member since
+ all users are long dead. Adjust comment on mouse_position_hook.
+
+2012-11-12 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify by using FOR_EACH_FRAME here and there.
+ * frame.c (next_frame, prev_frame, other_visible_frames)
+ (delete_frame, visible-frame-list): Use FOR_EACH_FRAME.
+ * w32term.c (x_window_to_scroll_bar): Likewise.
+ * window.c (window_list): Likewise.
+ * xdisp.c (x_consider_frame_title): Likewise.
+ * xfaces.c ( Fdisplay_supports_face_attributes_p): Likewise.
+ * xfns.c (x_window_to_frame, x_any_window_to_frame)
+ (x_menubar_window_to_frame, x_top_window_to_frame): Likewise.
+ * xmenu.c (menubar_id_to_frame): Likewise.
+ * xselect.c (frame_for_x_selection): Likewise.
+ * xterm.c (x_frame_of_widget, x_window_to_scroll_bar)
+ (x_window_to_menu_bar): Likewise.
+ * w32fns.c (x_window_to_frame): Likewise. Adjust comment.
+
+2012-11-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * data.c (Qdefalias_fset_function): Now static.
+
+ Another tweak to vectorlike_header change.
+ * alloc.c (struct Lisp_Vectorlike_Free, NEXT_IN_FREE_LIST):
+ Remove, and replace all uses with ...
+ (next_in_free_list, set_next_in_free_list):
+ New functions, which respect C's aliasing rules better.
+
+2012-11-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * window.c (list4i): Rename from 'quad'. All uses changed.
+ Needed because <sys/types.h> defines 'quad' on Solaris 10.
+
+2012-11-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * xdisp.c (start_hourglass) [HAVE_NTGUI]: Add block to silence
+ warning about mixing declarations and code in ISO C90.
+
+2012-11-10 Martin Rudalics <rudalics@gmx.at>
* window.c (Fsplit_window_internal): Set combination limit of
new parent window to t iff Vwindow_combination_limit is t;
fixing a regression introduced with the change from 2012-09-22.
- (Fwindow_combination_limit, Fset_window_combination_limit):
- Fix doc-strings.
+ (Fset_window_combination_limit): Fix doc-string.
-2012-11-06 Eli Zaretskii <eliz@gnu.org>
+2012-11-10 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (try_scrolling): Fix correction of aggressive-scroll
amount when the scroll margins are too large. When scrolling
backwards in the buffer, give up if cannot reach point or the
- scroll margin within a reasonable number of screen lines.
- Fixes point position in window under scroll-up/down-aggressively when
+ scroll margin within a reasonable number of screen lines. Fixes
+ point position in window under scroll-up/down-aggressively when
point is positioned many lines beyond the window top/bottom.
(Bug#12811)
-2012-11-05 Eli Zaretskii <eliz@gnu.org>
-
* ralloc.c (relinquish): If real_morecore fails to return memory
to the system, don't crash; instead, leave the last heap
unchanged and return. (Bug#12774)
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (AUTOLOADP): New macro.
+ * eval.c (Fautoload): Don't attach to loadhist, call Fdefalias instead.
+ * data.c (Ffset): Remove special ad-advice-info handling.
+ (Fdefalias): Handle autoload definitions and new Qdefalias_fset_function.
+ (Fsubr_arity): CSE.
+ (Finteractive_form): Simplify.
+ (Fquo): Don't insist on having at least 2 arguments.
+ (Qdefalias_fset_function): New var.
+
+2012-11-09 Jan Djärv <jan.h.d@swipnet.se>
+
+ * image.c (xpm_make_color_table_h): Change to hashtest_equal.
+
+ * nsfont.m (Qcondensed, Qexpanded): New variables.
+ (ns_descriptor_to_entity): Restore Qcondensed, Qexpanded setting.
+ (syms_of_nsfont): Defsym Qcondensed, Qexpanded.
+
+2012-11-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix recently introduced crash on MS-Windows (Bug#12839).
+ * w32term.h (struct scroll_bar): Use convenient header.
+ (SCROLL_BAR_VEC_SIZE): Remove.
+ * w32term.c (x_scroll_bar_create): Use VECSIZE.
+
+2012-11-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Tweak last vectorlike_header change.
+ * alloc.c (struct Lisp_Vectorlike_Free): Special type to represent
+ vectorlike object on the free list. This is introduced to avoid
+ some (but not all) pointer casting and aliasing problems, see
+ http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00105.html.
+ * .gdbinit (pvectype, pvecsize): New commands to examine vectorlike
+ objects.
+ (xvectype, xvecsize): Use them to examine Lisp_Object values.
+
+2012-11-09 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfont.m (ns_descriptor_to_entity): Qcondensed and Qexpanded has
+ been removed, so remove them here also.
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc.c (Fdocumentation): Handle new property
+ dynamic-docstring-function to replace the old ad-advice-info.
+
+2012-11-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fns.c (Qeql, hashtest_eq): Now static.
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (XHASH): Redefine to be imperfect and fit in a Lisp int.
+ * fns.c (hashfn_eq, hashfn_eql, sxhash):
+ * profiler.c (hashfn_profiler): Don't use XUINT on non-integers.
+ * buffer.c (compare_overlays): Use XLI rather than XHASH.
+
+2012-11-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use same hash function for hashfn_profiler as for hash_string etc.
+ * fns.c (SXHASH_COMBINE): Remove. All uses replaced by sxhash_combine.
+ * lisp.h (sxhash_combine): New inline function, with the contents
+ of the old SXHASH_COMBINE.
+ * profiler.c (hashfn_profiler): Use it, instead of having a
+ special hash function containing a comparison that always yields 1.
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xfaces.c (Qultra_light, Qreverse_oblique, Qreverse_italic)
+ (Qultra_condensed, Qextra_condensed, Qcondensed, Qsemi_condensed)
+ (Qsemi_expanded, Qextra_expanded, Qexpanded, Qultra_expanded):
+ Remove unused vars.
+
+2012-11-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * image.c (xpm_make_color_table_h): Fix compiler error because
+ make_hash_table changed.
+
+2012-11-08 Thomas Kappler <tkappler@gmail.com> (tiny change)
+
+ * nsfont.m (ns_findfonts): Handle empty matchingDescs (Bug#11541).
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use ad-hoc comparison function for the profiler's hash-tables.
+ * profiler.c (Qprofiler_backtrace_equal, hashtest_profiler): New vars.
+ (make_log): Use them.
+ (handle_profiler_signal): Don't inhibit quit any longer since we don't
+ call Fequal any more.
+ (Ffunction_equal): New function.
+ (cmpfn_profiler, hashfn_profiler): New functions.
+ (syms_of_profiler): Initialize them.
+ * lisp.h (struct hash_table_test): New struct.
+ (struct Lisp_Hash_Table): Use it.
+ * alloc.c (mark_object): Mark hash_table_test fields of hash tables.
+ * fns.c (make_hash_table): Take a struct to describe the test.
+ (cmpfn_eql, cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql)
+ (hashfn_equal, hashfn_user_defined): Adjust to new calling convention.
+ (hash_lookup, hash_remove_from_table): Move assertion checking of
+ hashfn result here. Check hash-equality before calling cmpfn.
+ (Fmake_hash_table): Adjust call to make_hash_table.
+ (hashtest_eq, hashtest_eql, hashtest_equal): New structs.
+ (syms_of_fns): Initialize them.
+ * emacs.c (main): Move syms_of_fns earlier.
+ * xterm.c (syms_of_xterm):
+ * category.c (hash_get_category_set): Adjust call to make_hash_table.
+ * print.c (print_object): Adjust to new hash-table struct.
+ * composite.c (composition_gstring_put_cache): Adjust to new hashfn.
+
+2012-11-08 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (modifier_set): Fix handling of Scroll Lock when the
+ value of w32-scroll-lock-modifier is neither nil nor one of the
+ known key modifiers. (Bug#12806)
+
+2012-11-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Shrink struct vectorlike_header to the only size field.
+ * lisp.h (enum pvec_type): Avoid explicit enum member values.
+ Adjust comment.
+ (enum More_Lisp_Bits): Change PSEUDOVECTOR_SIZE_BITS and
+ PVEC_TYPE_MASK to arrange new bitfield in the vector header.
+ (PSEUDOVECTOR_REST_BITS, PSEUDOVECTOR_REST_MASK): New members.
+ (PSEUDOVECTOR_AREA_BITS): New member used to extract subtype
+ information from the vector header. Adjust comment.
+ (XSETPVECTYPE, XSETPVECTYPESIZE, XSETTYPED_PSEUDOVECTOR)
+ (PSEUDOVECTOR_TYPEP, DEFUN): Adjust to match new vector header
+ layout.
+ (XSETSUBR, SUBRP): Adjust to match new Lisp_Subr layout.
+ (struct vectorlike_header): Remove next member. Adjust comment.
+ (struct Lisp_Subr): Add convenient header. Adjust comment.
+ (allocate_pseudovector): Adjust prototype.
+ * alloc.c (mark_glyph_matrix, mark_face_cache, allocate_string)
+ (sweep_string, lisp_malloc): Remove useless prototypes.
+ (enum mem_type): Adjust comment.
+ (NEXT_IN_FREE_LIST): New macro.
+ (SETUP_ON_FREE_LIST): Adjust XSETPVECTYPESIZE usage.
+ (Fmake_bool_vector): Likewise.
+ (struct large_vector): New type to represent allocation unit for
+ the vectors with the memory footprint more than VBLOOCK_BYTES_MAX.
+ (large_vectors): Change type to struct large_vector.
+ (allocate_vector_from_block): Simplify.
+ (PSEUDOVECTOR_NBYTES): Replace with...
+ (vector_nbytes): ...new function. Adjust users.
+ (sweep_vectors): Adjust processing of large vectors.
+ (allocate_vectorlike): Likewise.
+ (allocate_pseudovector): Change type of 3rd arg to enum pvec_type.
+ Add easserts. Adjust XSETPVECTYPESIZE usage.
+ (allocate_buffer): Use BUFFER_PVEC_INIT.
+ (live_vector_p): Adjust to match large vector.
+ * buffer.c (init_buffer_once): Use BUFFER_PVEC_INIT.
+ * buffer.h (struct buffer): Add next member.
+ (BUFFER_LISP_SIZE, BUFFER_REST_SIZE, BUFFER_PVEC_INIT):
+ New macros.
+ (FOR_EACH_BUFFER): Adjust to match struct buffer change.
+ * fns.c (internal_equal): Adjust to match enum pvec_type change.
+ (copy_hash_table): Adjust to match vector header change.
+ * lread.c (defsubr): Use XSETPVECTYPE.
+ * .gdbinit (xpr, xbacktrace): Adjust to match vector header change.
+ (xvectype): Likewise. Print PVEC_NORMAL_VECTOR for regular vectors.
+ (xvecsize): New command.
+
+2012-11-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * keyboard.c (event_to_kboard): Do not dereference
+ frame_or_window field of SELECTION_REQUEST_EVENT
+ and SELECTION_CLEAR_EVENT events (Bug#12814).
+ * xterm.h (struct selection_input_event): Adjust comment.
+
+2012-11-07 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (modifier_set): Don't report modifiers from toggle key,
+ such as Scroll Lock, if the respective keys are treated as
+ function keys, not as modifiers. This avoids destroying non-ASCII
+ keyboard input when Scroll Lock is toggled ON. (Bug#12806)
+
+2012-11-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xfns.c (Fx_wm_set_size_hint): Use check_x_frame. Adjust docstring.
+
+2012-11-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Restore some duplicate definitions (Bug#12814).
+ This undoes part of the 2012-11-03 changes. Some people build
+ with plain -g rather than with -g3, and they need the duplicate
+ definitions for .gdbinit to work; see <http://bugs.gnu.org/12814#26>.
+ * lisp.h (GCTYPEBITS, ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK):
+ Define as macros, as well as as enums or as constants.
+
+2012-11-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (convert_ns_to_X_keysym, keyDown:): Add NSNumericPadKeyMask
+ to keypad keys (Bug#12816).
+
+2012-11-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor adjustments of recently-changed frame functions.
+ * buffer.c (Fbuffer_list): Omit CHECK_FRAME, since arg is already
+ known to be a frame (we're in the FRAMEP branch).
+ * lisp.h (Qframep): Remove decl. frame.h declares this.
+ * window.c (quad): Args are of type EMACS_INT, not ptrdiff_t,
+ since they're meant for Lisp fixnum values.
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.c (Fwindow_combination_limit): Revert to the only
+ required argument and adjust docstring as suggested in
+ http://lists.gnu.org/archive/html/emacs-diffs/2012-11/msg01082.html
+ by Martin Rudalics <rudalics@gmx.at>.
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Widely used frame validity and checking functions.
+ * frame.h (decode_live_frame, decode_any_frame): Add prototypes.
+ * frame.c (decode_live_frame, decode_any_frame): New functions.
+ (delete_frame, Fredirect_frame_focus, Fframe_parameters)
+ (Fframe_parameter, Fframe_char_height, Fframe_char_width)
+ (Fframe_pixel_height, Fframe_pixel_width, Ftool_bar_pixel_width)
+ (Fframe_pointer_visible_p): Use decode_any_frame.
+ (Fmake_frame_visible, Fmake_frame_invisible, Ficonify_frame)
+ (Fraise_frame, Flower_frame, Fmodify_frame_parameters)
+ (Fset_frame_height, Fset_frame_width): Use decode_live_frame.
+ (Fframe_focus): Likewise. Allow zero number of arguments.
+ Adjust docstring.
+ (frame_buffer_list, frame_buffer_predicate): Remove.
+ * lisp.h (frame_buffer_predicate): Remove prototype.
+ * buffer.c (Fother_buffer): Use decode_any_frame.
+ * xdisp.c (Ftool_bar_lines_needed): Likewise.
+ * xfaces.c (Fcolor_gray_p, Fcolor_supported_p): Likewise.
+ * font.c (Ffont_face_attributes, Ffont_family_list, Fopen_font)
+ (Fclose_font, Ffont_info): Use decode_live_frame.
+ * fontset.c (check_fontset_name): Likewise.
+ * terminal.c (Fframe_terminal): Likewise.
+ * w32fns.c (check_x_frame): Likewise.
+ * window.c (Fminibuffer_window, Fwindow_at)
+ (Fcurrent_window_configuration): Likewise.
+ (Frun_window_configuration_change_hook, Fwindow_resize_apply):
+ Likewise. Allow zero number of arguments. Adjust docstring.
+ * dispnew.c (Fredraw_frame): Likewise.
+ * xfaces.c (frame_or_selected_frame): Remove.
+ (Fx_list_fonts, Finternal_get_lisp_face_attribute, Fface_font)
+ (Finternal_lisp_face_equal_p, Finternal_lisp_face_empty_p)
+ (Fframe_face_alist): Use decode_live_frame.
+ * xfns.c (check_x_frame): Likewise.
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.c (quad): New function.
+ (Fwindow_edges, Fwindow_pixel_edges, Fwindow_inside_edges)
+ (Fwindow_absolute_pixel_edges, Fwindow_inside_absolute_pixel_edges)
+ (Fwindow_inside_pixel_edges, Fpos_visible_in_window_p)
+ (Fwindow_line_height): Use it.
+ (Fwindow_fringes): Use list3.
+ (Fwindow_scroll_bars): Use list4.
+ (Fwindow_frame, Fwindow_top_child, Fwindow_left_child)
+ (Fwindow_combination_limit): Allow zero number of arguments.
+
+2012-11-05 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/w32fns.$(O)): Depend on $(NT_INC)/unistd.h.
+
+ * w32fns.c: Include unistd.h, to avoid compiler warnings on Cygwin.
+ (emacs_abort) [CYGWIN]: Don't call _open_osfhandle; instead, use
+ file descriptor 2 for standard error. (Bug#12805)
+
+2012-11-05 Chong Yidong <cyd@gnu.org>
+
+ * process.c (wait_reading_process_output): Revert previous change.
+
+2012-11-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800).
+ This removes code that has been obsolete since around 1990.
+ * callproc.c (Fcall_process):
+ * emacs.c (main):
+ * process.c (create_process):
+ * term.c (dissociate_if_controlling_tty):
+ Assume setsid exists.
+ * callproc.c (child_setup): Assume setpgid exists and behaves as
+ per POSIX.1-1988 or later.
+ * conf_post.h (setpgid) [!HAVE_SETPGID]: Remove.
+ * emacs.c (shut_down_emacs):
+ * sysdep.c (sys_suspend, init_foreground_group):
+ Assume getpgrp behaves as per POSIX.1-1998 or later.
+ * msdos.c (setpgrp): Remove.
+ (tcgetpgrp, setpgid, setsid): New functions.
+ * systty.h (EMACS_GETPGRP): Remove. All callers now use getpgrp.
+ * term.c (no_controlling_tty): Remove; unused.
+ * w32proc.c (setpgrp): Remove.
+ (setsid, tcgetpgrp): New functions.
+
+ Simplify by assuming __fpending.
+ * dispnew.c: Include <fpending.h>, not <stdio_ext.h>.
+ (update_frame_1): Use __fpending, not PENDING_OUTPUT_COUNT.
+ Do not assume that __fpending's result fits in int.
+
+2012-11-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove EMACS_OUTQSIZE+sleep hack.
+ * dispnew.c (update_frame_1): Remove hack for terminals slower
+ than 2400 bps, which throttled Emacs by having it sleep.
+ This code hasn't worked since at least 2007, when the multi-tty stuff
+ was added, and anyway those old terminals are long dead.
+ * systty.h (EMACS_OUTQSIZE): Remove; unused. The macro isn't used even
+ without the dispnew.c change, as dispnew.c doesn't include systty.h.
+
+ Fix data-loss with --version (Bug#9574).
+ * emacs.c (close_output_streams): Use strerror, not emacs_strerror,
+ as we can't assume that emacs_strerror is initialized, and strerror
+ is good enough here.
+ (main): Invoke atexit earlier, to catch earlier instances of
+ sending data to stdout and exiting, e.g., "emacs --version >/dev/full".
+
+2012-11-04 Michael Marchionna <tralfaz@pacbell.net>
+
+ * nsterm.m: Add NSClearLineFunctionKey and keypad keys (Bug#8680).
+ (keyDown): Remap keypad keys to X11 virtual key codes.
+
+2012-11-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix data-loss with --batch (Bug#9574).
+ * emacs.c: Include <close-stream.h>.
+ (close_output_streams): New function.
+ (main): Pass it to atexit, so that Emacs closes stdout and stderr
+ and handles errors appropriately.
+ (Fkill_emacs): Don't worry about flushing, as close_output_stream
+ does that now.
+
+ Fix a race condition that causes Emacs to mess up glib (Bug#8855).
+ The symptom is a diagnostic "GLib-WARNING **: In call to
+ g_spawn_sync(), exit status of a child process was requested but
+ SIGCHLD action was set to SIG_IGN and ECHILD was received by
+ waitpid(), so exit status can't be returned." The diagnostic
+ is partly wrong, as the SIGCHLD action is not set to SIG_IGN.
+ The real bug is a race condition between Emacs and glib: Emacs
+ does a waitpid (-1, ...) and reaps glib's subprocess by mistake,
+ so that glib can't find it. Work around the bug by invoking
+ waitpid only on subprocesses that Emacs itself creates.
+ * process.c (create_process, record_child_status_change):
+ Don't use special value -1 in pid field, as the caller now must
+ know the pid rather than having the callee infer it.
+ The inference was sometimes incorrect anyway, due to another race.
+ (create_process): Set new 'alive' member if child is created.
+ (process_status_retrieved): New function.
+ (record_child_status_change): Use it.
+ Accept negative 1st argument, which means to wait for the
+ processes that Emacs already knows about. Move special-case code
+ for DOS_NT (which lacks WNOHANG) here, from caller. Keep track of
+ processes that have already been waited for, by testing and
+ clearing new 'alive' member.
+ (CAN_HANDLE_MULTIPLE_CHILDREN): Remove, as record_child_status_change
+ now does this internally.
+ (handle_child_signal): Let record_child_status_change do all
+ the work, since we do not want to reap all exited child processes,
+ only the child processes that Emacs itself created.
+ * process.h (Lisp_Process): New boolean member 'alive'.
+
+ Omit duplicate definitions no longer needed with gcc -g3.
+ * lisp.h (GCTYPEBITS, GCALIGNMENT, ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG)
+ (VALMASK, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM):
+ Define only as macros. There's no longer any need to also define
+ these symbols as enums or as constants, since we now assume
+ gcc -g3 when debugging.
+
2012-11-03 Eli Zaretskii <eliz@gnu.org>
* lisp.mk: Adjust comments to the fact that term/internal is now
iterator when starting in the middle of a display or overlay
string. (Bug#12745)
-2012-11-03 Jan Djärv <jan.h.d@swipnet.se>
+2012-11-03 Chong Yidong <cyd@gnu.org>
+
+ * process.c (wait_reading_process_output): Clean up the last
+ change.
+
+2012-11-03 Jim Paris <jim@jtan.com> (tiny change)
+
+ * process.c (wait_reading_process_output): Avoid a race condition
+ with SIGIO delivery (Bug#11536).
+
+2012-11-03 Chong Yidong <cyd@gnu.org>
+
+ * buffer.c (cursor_type): Untabify docstring.
+
+2012-11-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * frame.h (struct frame): Drop can_have_scroll_bars member
+ which is meaningless for a long time. Adjust comments.
+ (FRAME_CAN_HAVE_SCROLL_BARS): Remove.
+ * frame.c, nsfns.m, term.c, w32fns.c, xfns.c: Adjust users.
+
+2012-11-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.c (decode_next_window_args): Update window arg after
+ calling decode_live_window and so fix crash reported at
+ http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00035.html
+ by Juanma Barranquero <lekktu@gmail.com>.
+ (Fwindow_body_width, Fwindow_body_height): Simplify a bit.
+ * font.c (Ffont_at): Likewise.
+
+2012-11-01 Jan Djärv <jan.h.d@swipnet.se>
* widget.c (resize_cb): New function.
(EmacsFrameRealize): Add resize_cb as event handler (Bug#12733).
(EmacsFrameResize): Check if all is up to date before changing frame
size.
+2012-11-02 Eli Zaretskii <eliz@gnu.org>
+
+ Implement backtrace output for fatal errors on MS-Windows.
+ * w32fns.c (CaptureStackBackTrace_proc): New typedef.
+ (BACKTRACE_LIMIT_MAX): New macro.
+ (w32_backtrace): New function.
+ (emacs_abort): Use w32_backtrace when the user chooses not to
+ attach a debugger. Update the text of the abort dialog.
+
+2012-11-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Window-related stuff cleanup here and there.
+ * dispnew.c (Finternal_show_cursor, Finternal_show_cursor_p):
+ Use decode_any_window.
+ * fringe.c (Ffringe_bitmaps_at_pos): Likewise.
+ * xdisp.c (Fformat_mode_line): Likewise.
+ * font.c (Ffont_at): Use decode_live_window.
+ * indent.c (Fcompute_motion, Fvertical_motion): Likewise.
+ * window.c (decode_next_window_args): Likewise.
+ (decode_any_window): Remove static.
+ * window.h (decode_any_window): Add prototype.
+ * lisp.h (CHECK_VALID_WINDOW, CHECK_LIVE_WINDOW): Move from here...
+ * window.h: ...to here, redefine via WINDOW_VALID_P and WINDOW_LIVE_P,
+ respectively.
+
+2012-11-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove pad from struct input_event.
+ * termhooks.h (struct input_event): Remove padding field.
+ Adjust comment.
+ * keyboard.c (event_to_kboard): Simplify because frame_or_window
+ member is never cons for a long time. Adjust comment.
+ (mark_kboards): Adjust because SELECTION_REQUEST_EVENT and
+ SELECTION_CLEAR_EVENT has no Lisp_Objects to mark. Add comment.
+ * xterm.c (handle_one_xevent): Do not initialize frame_or_window
+ field of SELECTION_REQUEST_EVENT and SELECTION_CLEAR_EVENT.
+
2012-11-01 Eli Zaretskii <eliz@gnu.org>
* w32proc.c (getpgrp, setpgid): New functions. (Bug#12776)
now a supported configuration.
* Makefile.in: consolidate image variables into LIBIMAGE; add
- W32_OBJ and W32_LIBS. Compile new files.
+ W32_OBJ and W32_LIBS. Compile new files.
* conf_post.h:
(_DebPrint) declare tracing facility for W32 debugging. We need
M17N_FLT_LIBS = @M17N_FLT_LIBS@
LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@
+LIB_EACCESS=@LIB_EACCESS@
LIB_TIMER_TIME=@LIB_TIMER_TIME@
DBUS_CFLAGS = @DBUS_CFLAGS@
LIBES = $(LIBS) $(W32_LIBS) $(LIBX_BASE) $(LIBIMAGE) \
$(LIBX_OTHER) $(LIBSOUND) \
$(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_CLOCK_GETTIME) \
- $(LIB_TIMER_TIME) $(DBUS_LIBS) \
+ $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \
$(LIB_EXECINFO) \
$(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
static void mark_terminals (void);
static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
-static void mark_glyph_matrix (struct glyph_matrix *);
-static void mark_face_cache (struct face_cache *);
static void mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
#endif
-static struct Lisp_String *allocate_string (void);
static void compact_small_strings (void);
static void free_large_strings (void);
-static void sweep_strings (void);
static void free_misc (Lisp_Object);
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
-/* When scanning the C stack for live Lisp objects, Emacs keeps track
- of what memory allocated via lisp_malloc is intended for what
- purpose. This enumeration specifies the type of memory. */
+/* When scanning the C stack for live Lisp objects, Emacs keeps track of
+ what memory allocated via lisp_malloc and lisp_align_malloc is intended
+ for what purpose. This enumeration specifies the type of memory. */
enum mem_type
{
MEM_TYPE_MISC,
MEM_TYPE_SYMBOL,
MEM_TYPE_FLOAT,
- /* We used to keep separate mem_types for subtypes of vectors such as
- process, hash_table, frame, terminal, and window, but we never made
- use of the distinction, so it only caused source-code complexity
- and runtime slowdown. Minor but pointless. */
+ /* Since all non-bool pseudovectors are small enough to be
+ allocated from vector blocks, this memory type denotes
+ large regular vectors and large bool pseudovectors. */
MEM_TYPE_VECTORLIKE,
/* Special type to denote vector blocks. */
MEM_TYPE_VECTOR_BLOCK,
MEM_TYPE_SPARE
};
-static void *lisp_malloc (size_t, enum mem_type);
-
-
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
/* No Lisp_Object to trace in there. */
- XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0);
+ XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
+/* Get and set the next field in block-allocated vectorlike objects on
+ the free list. Doing it this way respects C's aliasing rules.
+ We could instead make 'contents' a union, but that would mean
+ changes everywhere that the code uses 'contents'. */
+static struct Lisp_Vector *
+next_in_free_list (struct Lisp_Vector *v)
+{
+ intptr_t i = XLI (v->contents[0]);
+ return (struct Lisp_Vector *) i;
+}
+static void
+set_next_in_free_list (struct Lisp_Vector *v, struct Lisp_Vector *next)
+{
+ v->contents[0] = XIL ((intptr_t) next);
+}
+
/* Common shortcut to setup vector on a free list. */
-#define SETUP_ON_FREE_LIST(v, nbytes, index) \
- do { \
- XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \
- eassert ((nbytes) % roundup_size == 0); \
- (index) = VINDEX (nbytes); \
- eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \
- (v)->header.next.vector = vector_free_lists[index]; \
- vector_free_lists[index] = (v); \
- total_free_vector_slots += (nbytes) / word_size; \
+#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \
+ do { \
+ (tmp) = ((nbytes - header_size) / word_size); \
+ XSETPVECTYPESIZE (v, PVEC_FREE, 0, (tmp)); \
+ eassert ((nbytes) % roundup_size == 0); \
+ (tmp) = VINDEX (nbytes); \
+ eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \
+ set_next_in_free_list (v, vector_free_lists[tmp]); \
+ vector_free_lists[tmp] = (v); \
+ total_free_vector_slots += (nbytes) / word_size; \
} while (0)
+/* This internal type is used to maintain the list of large vectors
+ which are allocated at their own, e.g. outside of vector blocks. */
+
+struct large_vector
+{
+ union {
+ struct large_vector *vector;
+#if USE_LSB_TAG
+ /* We need to maintain ROUNDUP_SIZE alignment for the vector member. */
+ unsigned char c[vroundup (sizeof (struct large_vector *))];
+#endif
+ } next;
+ struct Lisp_Vector v;
+};
+
+/* This internal type is used to maintain an underlying storage
+ for small vectors. */
+
struct vector_block
{
char data[VECTOR_BLOCK_BYTES];
/* Singly-linked list of large vectors. */
-static struct Lisp_Vector *large_vectors;
+static struct large_vector *large_vectors;
/* The only vector with 0 slots, allocated from pure space. */
static struct Lisp_Vector *
allocate_vector_from_block (size_t nbytes)
{
- struct Lisp_Vector *vector, *rest;
+ struct Lisp_Vector *vector;
struct vector_block *block;
size_t index, restbytes;
if (vector_free_lists[index])
{
vector = vector_free_lists[index];
- vector_free_lists[index] = vector->header.next.vector;
- vector->header.next.nbytes = nbytes;
+ vector_free_lists[index] = next_in_free_list (vector);
total_free_vector_slots -= nbytes / word_size;
return vector;
}
{
/* This vector is larger than requested. */
vector = vector_free_lists[index];
- vector_free_lists[index] = vector->header.next.vector;
- vector->header.next.nbytes = nbytes;
+ vector_free_lists[index] = next_in_free_list (vector);
total_free_vector_slots -= nbytes / word_size;
/* Excess bytes are used for the smaller vector,
which should be set on an appropriate free list. */
restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
eassert (restbytes % roundup_size == 0);
- rest = ADVANCE (vector, nbytes);
- SETUP_ON_FREE_LIST (rest, restbytes, index);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
return vector;
}
/* New vector will be at the beginning of this block. */
vector = (struct Lisp_Vector *) block->data;
- vector->header.next.nbytes = nbytes;
/* If the rest of space from this block is large enough
for one-slot vector at least, set up it on a free list. */
if (restbytes >= VBLOCK_BYTES_MIN)
{
eassert (restbytes % roundup_size == 0);
- rest = ADVANCE (vector, nbytes);
- SETUP_ON_FREE_LIST (rest, restbytes, index);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
}
return vector;
- }
+}
/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
((char *) (vector) <= (block)->data \
+ VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
-/* Number of bytes used by vector-block-allocated object. This is the only
- place where we actually use the `nbytes' field of the vector-header.
- I.e. we could get rid of the `nbytes' field by computing it based on the
- vector-type. */
+/* Return the memory footprint of V in bytes. */
-#define PSEUDOVECTOR_NBYTES(vector) \
- (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
- ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
- : vector->header.next.nbytes)
+static ptrdiff_t
+vector_nbytes (struct Lisp_Vector *v)
+{
+ ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
+
+ if (size & PSEUDOVECTOR_FLAG)
+ {
+ if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
+ size = (bool_header_size
+ + (((struct Lisp_Bool_Vector *) v)->size
+ + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
+ else
+ size = (header_size
+ + ((size & PSEUDOVECTOR_SIZE_MASK)
+ + ((size & PSEUDOVECTOR_REST_MASK)
+ >> PSEUDOVECTOR_SIZE_BITS)) * word_size);
+ }
+ else
+ size = header_size + size * word_size;
+ return vroundup (size);
+}
/* Reclaim space used by unmarked vectors. */
sweep_vectors (void)
{
struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
- struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
+ struct large_vector *lv, **lvprev = &large_vectors;
+ struct Lisp_Vector *vector, *next;
total_vectors = total_vector_slots = total_free_vector_slots = 0;
memset (vector_free_lists, 0, sizeof (vector_free_lists));
for (block = vector_blocks; block; block = *bprev)
{
bool free_this_block = 0;
+ ptrdiff_t nbytes;
for (vector = (struct Lisp_Vector *) block->data;
VECTOR_IN_BLOCK (vector, block); vector = next)
{
VECTOR_UNMARK (vector);
total_vectors++;
- total_vector_slots += vector->header.next.nbytes / word_size;
- next = ADVANCE (vector, vector->header.next.nbytes);
+ nbytes = vector_nbytes (vector);
+ total_vector_slots += nbytes / word_size;
+ next = ADVANCE (vector, nbytes);
}
else
{
- ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector);
- ptrdiff_t total_bytes = nbytes;
+ ptrdiff_t total_bytes;
+ nbytes = vector_nbytes (vector);
+ total_bytes = nbytes;
next = ADVANCE (vector, nbytes);
/* While NEXT is not marked, try to coalesce with VECTOR,
{
if (VECTOR_MARKED_P (next))
break;
- nbytes = PSEUDOVECTOR_NBYTES (next);
+ nbytes = vector_nbytes (next);
total_bytes += nbytes;
next = ADVANCE (next, nbytes);
}
/* Sweep large vectors. */
- for (vector = large_vectors; vector; vector = *vprev)
+ for (lv = large_vectors; lv; lv = *lvprev)
{
+ vector = &lv->v;
if (VECTOR_MARKED_P (vector))
{
VECTOR_UNMARK (vector);
else
total_vector_slots
+= header_size / word_size + vector->header.size;
- vprev = &vector->header.next.vector;
+ lvprev = &lv->next.vector;
}
else
{
- *vprev = vector->header.next.vector;
- lisp_free (vector);
+ *lvprev = lv->next.vector;
+ lisp_free (lv);
}
}
}
p = allocate_vector_from_block (vroundup (nbytes));
else
{
- p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
- p->header.next.vector = large_vectors;
- large_vectors = p;
+ struct large_vector *lv
+ = lisp_malloc (sizeof (*lv) + (len - 1) * word_size,
+ MEM_TYPE_VECTORLIKE);
+ lv->next.vector = large_vectors;
+ large_vectors = lv;
+ p = &lv->v;
}
#ifdef DOUG_LEA_MALLOC
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, int tag)
+allocate_pseudovector (int memlen, int lisplen, enum pvec_type tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
int i;
+ /* Catch bogus values. */
+ eassert (tag <= PVEC_FONT);
+ eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1);
+ eassert (lisplen <= (1 << PSEUDOVECTOR_SIZE_BITS) - 1);
+
/* Only the first lisplen slots will be traced normally by the GC. */
for (i = 0; i < lisplen; ++i)
v->contents[i] = Qnil;
- XSETPVECTYPESIZE (v, tag, lisplen);
+ XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
}
{
struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
- XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
- - header_size) / word_size);
+ BUFFER_PVEC_INIT (b);
/* Put B on the chain of all buffers including killed ones. */
- b->header.next.buffer = all_buffers;
+ b->next = all_buffers;
all_buffers = b;
/* Note that the rest fields of B are not initialized. */
return b;
while (VECTOR_IN_BLOCK (vector, block)
&& vector <= (struct Lisp_Vector *) p)
{
- if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
- vector = ADVANCE (vector, (vector->header.size
- & PSEUDOVECTOR_SIZE_MASK));
- else if (vector == p)
+ if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p)
return 1;
else
- vector = ADVANCE (vector, vector->header.next.nbytes);
+ vector = ADVANCE (vector, vector_nbytes (vector));
}
}
- else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start)
+ else if (m->type == MEM_TYPE_VECTORLIKE
+ && (char *) p == ((char *) m->start
+ + offsetof (struct large_vector, v)))
/* This memory node corresponds to a large vector. */
return 1;
return 0;
if (ptr->header.size & PSEUDOVECTOR_FLAG)
pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
- >> PSEUDOVECTOR_SIZE_BITS);
+ >> PSEUDOVECTOR_AREA_BITS);
else
pvectype = PVEC_NORMAL_VECTOR;
struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
mark_vectorlike (ptr);
+ mark_object (h->test.name);
+ mark_object (h->test.user_hash_function);
+ mark_object (h->test.user_cmp_function);
/* If hash table is not weak, mark all keys and values.
For weak tables, mark only the vector. */
if (NILP (h->weak))
for (buffer = all_buffers; buffer; buffer = *bprev)
if (!VECTOR_MARKED_P (buffer))
{
- *bprev = buffer->header.next.buffer;
+ *bprev = buffer->next;
lisp_free (buffer);
}
else
/* Do not use buffer_(set|get)_intervals here. */
buffer->text->intervals = balance_intervals (buffer->text->intervals);
total_buffers++;
- bprev = &buffer->header.next.buffer;
+ bprev = &buffer->next;
}
}
Lisp_Object framelist, prevlist, tail;
Lisp_Object args[3];
- CHECK_FRAME (frame);
framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
prevlist = Fnreverse (Fcopy_sequence
(XFRAME (frame)->buried_buffer_list));
exists, return the buffer `*scratch*' (creating it if necessary). */)
(register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
{
- Lisp_Object tail, buf, pred;
- Lisp_Object notsogood = Qnil;
+ struct frame *f = decode_any_frame (frame);
+ Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
+ Lisp_Object buf, notsogood = Qnil;
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_FRAME (frame);
-
- pred = frame_buffer_predicate (frame);
/* Consider buffers that have been seen in the frame first. */
- tail = XFRAME (frame)->buffer_list;
for (; CONSP (tail); tail = XCDR (tail))
{
buf = XCAR (tail);
return;
BUFFER_CHECK_INDIRECTION (b);
-
+
old_buf = current_buffer;
current_buffer = b;
last_known_column_point = -1; /* invalidate indentation cache */
between "equal" overlays. The result can still change between
invocations of Emacs, but it won't change in the middle of
`find_field' (bug#6830). */
- if (XHASH (s1->overlay) != XHASH (s2->overlay))
- return XHASH (s1->overlay) < XHASH (s2->overlay) ? -1 : 1;
+ if (!EQ (s1->overlay, s2->overlay))
+ return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
return 0;
}
init_buffer_once (void)
{
int idx;
- /* If you add, remove, or reorder Lisp_Objects in a struct buffer, make
- sure that this is still correct. Otherwise, mark_vectorlike may not
- trace all Lisp_Objects in buffer_defaults and buffer_local_symbols. */
- const int pvecsize
- = (offsetof (struct buffer, own_text) - header_size) / word_size;
memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
/* This is not strictly necessary, but let's make them initialized. */
bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
- XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, pvecsize);
- XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, pvecsize);
+ BUFFER_PVEC_INIT (&buffer_defaults);
+ BUFFER_PVEC_INIT (&buffer_local_symbols);
/* Set up the default values of various buffer slots. */
/* Must do these before making the first buffer! */
doc: /* Cursor to use when this buffer is in the selected window.
Values are interpreted as follows:
- t use the cursor specified for the frame
- nil don't display a cursor
- box display a filled box cursor
- hollow display a hollow box cursor
- bar display a vertical bar cursor with default width
- (bar . WIDTH) display a vertical bar cursor with width WIDTH
- hbar display a horizontal bar cursor with default height
+ t use the cursor specified for the frame
+ nil don't display a cursor
+ box display a filled box cursor
+ hollow display a hollow box cursor
+ bar display a vertical bar cursor with default width
+ (bar . WIDTH) display a vertical bar cursor with width WIDTH
+ hbar display a horizontal bar cursor with default height
(hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
- ANYTHING ELSE display a hollow box cursor
+ ANYTHING ELSE display a hollow box cursor
When the buffer is displayed in a non-selected window, the
cursor's appearance is instead controlled by the variable
struct buffer
{
- /* HEADER.NEXT is the next buffer, in chain of all buffers, including killed
- buffers. This chain, starting from all_buffers, is used only for garbage
- collection, in order to collect killed buffers properly. Note that large
- vectors and large pseudo-vector objects are all on another chain starting
- from large_vectors. */
struct vectorlike_header header;
/* The name of this buffer. */
In an indirect buffer, this is the own_text field of another buffer. */
struct buffer_text *text;
+ /* Next buffer, in chain of all buffers, including killed ones. */
+ struct buffer *next;
+
/* Char position of point in buffer. */
ptrdiff_t pt;
b->INTERNAL_FIELD (width_table) = val;
}
+/* Number of Lisp_Objects at the beginning of struct buffer.
+ If you add, remove, or reorder Lisp_Objects within buffer
+ structure, make sure that this is still correct. */
+
+#define BUFFER_LISP_SIZE \
+ ((offsetof (struct buffer, own_text) - header_size) / word_size)
+
+/* Size of the struct buffer part beyond leading Lisp_Objects, in word_size
+ units. Rounding is needed for --with-wide-int configuration. */
+
+#define BUFFER_REST_SIZE \
+ ((((sizeof (struct buffer) - offsetof (struct buffer, own_text)) \
+ + (word_size - 1)) & ~(word_size - 1)) / word_size)
+
+/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE
+ is required for GC, but BUFFER_REST_SIZE is set up just to be consistent
+ with other pseudovectors. */
+
+#define BUFFER_PVEC_INIT(b) \
+ XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE)
+
/* Convenient check whether buffer B is live. */
#define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name)))
/* Used to iterate over the chain above. */
#define FOR_EACH_BUFFER(b) \
- for ((b) = all_buffers; (b); (b) = (b)->header.next.buffer)
+ for ((b) = all_buffers; (b); (b) = (b)->next)
/* This points to the current buffer. */
if (fd[0] >= 0)
emacs_close (fd[0]);
-#ifdef HAVE_SETSID
setsid ();
-#else
- setpgid (0, 0);
-#endif
/* Emacs ignores SIGPIPE, but the child should not. */
signal (SIGPIPE, SIG_DFL);
if (err != in && err != out)
emacs_close (err);
-#if defined HAVE_SETPGID || ! (defined USG && defined SETPGRP_RELEASES_CTTY)
- setpgid (pid, pid);
-#endif
-
- /* setpgrp_of_tty is incorrect here; it uses input_fd. */
+ setpgid (0, 0);
tcsetpgrp (0, pid);
/* execvp does not accept an environment arg so the only way
return fd;
else
{
- int new;
-#ifdef F_DUPFD
- new = fcntl (fd, F_DUPFD, minfd);
-#else
- new = dup (fd);
- if (new != -1)
- /* Note that we hold the original FD open while we recurse,
- to guarantee we'll get a new FD if we need it. */
- new = relocate_fd (new, minfd);
-#endif
+ int new = fcntl (fd, F_DUPFD, minfd);
if (new == -1)
{
const char *message_1 = "Error while setting up child: ";
#endif
{
tempdir = Fdirectory_file_name (Vexec_directory);
- if (access (SSDATA (tempdir), 0) < 0)
- dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
- Vexec_directory);
+ if (! file_accessible_directory_p (SSDATA (tempdir)))
+ dir_warning ("arch-dependent data dir", Vexec_directory);
}
tempdir = Fdirectory_file_name (Vdata_directory);
- if (access (SSDATA (tempdir), 0) < 0)
- dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
- Vdata_directory);
+ if (! file_accessible_directory_p (SSDATA (tempdir)))
+ dir_warning ("arch-independent data dir", Vdata_directory);
sh = (char *) getenv ("SHELL");
Vshell_file_name = build_string (sh ? sh : "/bin/sh");
Vshared_game_score_directory = Qnil;
#else
Vshared_game_score_directory = build_string (PATH_GAME);
- if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
+ if (NILP (Ffile_accessible_directory_p (Vshared_game_score_directory)))
Vshared_game_score_directory = Qnil;
#endif
}
if (NILP (XCHAR_TABLE (table)->extras[1]))
set_char_table_extras
(table, 1,
- make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+ make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil));
+ Qnil));
h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
i = hash_lookup (h, category_set, &hash);
if (i >= 0)
{
Lisp_Object tempdir;
tempdir = Fexpand_file_name (build_string ("charsets"), Vdata_directory);
- if (access (SSDATA (tempdir), 0) < 0)
+ if (! file_accessible_directory_p (SSDATA (tempdir)))
{
/* This used to be non-fatal (dir_warning), but it should not
happen, and if it does sooner or later it will cause some
ptrdiff_t i;
header = LGSTRING_HEADER (gstring);
- hash = h->hashfn (h, header);
+ hash = h->test.hashfn (&h->test, header);
if (len < 0)
{
ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
}
else
{
- /* automatic composition */
+ /* Automatic composition. */
Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
Lisp_Object glyph;
ptrdiff_t from;
#define emacs_raise(sig) msdos_fatal_signal (sig)
-#ifndef HAVE_SETPGID
-# ifdef USG
-# define setpgid(pid, pgid) setpgrp ()
-# else
-# define setpgid(pid, pgid) setpgrp (pid, pgid)
-# endif
-#endif
-
/* Define one of these for easier conditionals. */
#ifdef HAVE_X_WINDOWS
/* We need a little extra space, see ../../lisp/loadup.el and the
#endif
#endif
+/* Tell gnulib to omit support for openat-related functions having a
+ first argument other than AT_FDCWD. */
+#define GNULIB_SUPPORT_ONLY_AT_FDCWD
+
#include <string.h>
#include <stdlib.h>
static Lisp_Object Qdefun;
Lisp_Object Qinteractive_form;
+static Lisp_Object Qdefalias_fset_function;
static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
}
\f
-/* Extract and set components of lists */
+/* Extract and set components of lists. */
DEFUN ("car", Fcar, Scar, 1, 1, 0,
doc: /* Return the car of LIST. If arg is nil, return nil.
(register Lisp_Object symbol, Lisp_Object definition)
{
register Lisp_Object function;
-
CHECK_SYMBOL (symbol);
- if (NILP (symbol) || EQ (symbol, Qt))
- xsignal1 (Qsetting_constant, symbol);
function = XSYMBOL (symbol)->function;
if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
- if (CONSP (function) && EQ (XCAR (function), Qautoload))
+ if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
set_symbol_function (symbol, definition);
- /* Handle automatic advice activation. */
- if (CONSP (XSYMBOL (symbol)->plist)
- && !NILP (Fget (symbol, Qad_advice_info)))
- {
- call2 (Qad_activate_internal, symbol, Qnil);
- definition = XSYMBOL (symbol)->function;
- }
+
return definition;
}
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{
CHECK_SYMBOL (symbol);
- if (CONSP (XSYMBOL (symbol)->function)
- && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, symbol));
if (!NILP (Vpurify_flag)
/* If `definition' is a keymap, immutable (and copying) is wrong. */
&& !KEYMAPP (definition))
definition = Fpurecopy (definition);
- definition = Ffset (symbol, definition);
- LOADHIST_ATTACH (Fcons (Qdefun, symbol));
+
+ {
+ bool autoload = AUTOLOADP (definition);
+ if (NILP (Vpurify_flag) || !autoload)
+ { /* Only add autoload entries after dumping, because the ones before are
+ not useful and else we get loads of them from the loaddefs.el. */
+
+ if (AUTOLOADP (XSYMBOL (symbol)->function))
+ /* Remember that the function was already an autoload. */
+ LOADHIST_ATTACH (Fcons (Qt, symbol));
+ LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
+ }
+ }
+
+ { /* Handle automatic advice activation. */
+ Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
+ if (!NILP (hook))
+ call2 (hook, symbol, definition);
+ else
+ Ffset (symbol, definition);
+ }
+
if (!NILP (docstring))
Fput (symbol, Qfunction_documentation, docstring);
/* We used to return `definition', but now that `defun' and `defmacro' expand
CHECK_SUBR (subr);
minargs = XSUBR (subr)->min_args;
maxargs = XSUBR (subr)->max_args;
- if (maxargs == MANY)
- return Fcons (make_number (minargs), Qmany);
- else if (maxargs == UNEVALLED)
- return Fcons (make_number (minargs), Qunevalled);
- else
- return Fcons (make_number (minargs), make_number (maxargs));
+ return Fcons (make_number (minargs),
+ maxargs == MANY ? Qmany
+ : maxargs == UNEVALLED ? Qunevalled
+ : make_number (maxargs));
}
DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
return Qnil;
/* Use an `interactive-form' property if present, analogous to the
- function-documentation property. */
+ function-documentation property. */
fun = cmd;
while (SYMBOLP (fun))
{
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
}
+ else if (AUTOLOADP (fun))
+ return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
else if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun)));
- else if (EQ (funcar, Qautoload))
- {
- struct gcpro gcpro1;
- GCPRO1 (cmd);
- Fautoload_do_load (fun, cmd, Qnil);
- UNGCPRO;
- return Finteractive_form (cmd);
- }
}
return Qnil;
}
return arith_driver (Amult, nargs, args);
}
-DEFUN ("/", Fquo, Squo, 2, MANY, 0,
+DEFUN ("/", Fquo, Squo, 1, MANY, 0,
doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers.
-usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
+usage: (/ DIVIDEND &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t argnum;
DEFSYM (Qfont_object, "font-object");
DEFSYM (Qinteractive_form, "interactive-form");
+ DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
#include "systime.h"
#include <errno.h>
-#ifdef DISPNEW_NEEDS_STDIO_EXT
-#include <stdio_ext.h>
-#endif
+#include <fpending.h>
#if defined (HAVE_TERM_H) && defined (GNU_LINUX)
#include <term.h> /* for tgetent */
static bool delayed_size_change;
-/* 1 means glyph initialization has been completed at startup. */
-
-static bool glyphs_initialized_initially_p;
-
/* Updated window if != 0. Set by update_window. */
struct window *updated_window;
unblock_input ();
}
-
-/* Adjust frame glyphs when Emacs is initialized.
-
- To be called from init_display.
-
- We need a glyph matrix because redraw will happen soon.
- Unfortunately, window sizes on selected_frame are not yet set to
- meaningful values. I believe we can assume that there are only two
- windows on the frame---the mini-buffer and the root window. Frame
- height and width seem to be correct so far. So, set the sizes of
- windows to estimated values. */
-
-static void
-adjust_frame_glyphs_initially (void)
-{
- struct frame *sf = SELECTED_FRAME ();
- struct window *root = XWINDOW (sf->root_window);
- struct window *mini = XWINDOW (root->next);
- int frame_lines = FRAME_LINES (sf);
- int frame_cols = FRAME_COLS (sf);
- int top_margin = FRAME_TOP_MARGIN (sf);
-
- /* Do it for the root window. */
- 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_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;
-}
-
-
/* Allocate/reallocate glyph matrices of a single frame F. */
static void
Redrawing Frames
**********************************************************************/
-DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 1, 1, 0,
- doc: /* Clear frame FRAME and output again what is supposed to appear on it. */)
- (Lisp_Object frame)
-{
- struct frame *f;
-
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
- /* Ignore redraw requests, if frame has no glyphs yet.
- (Implementation note: It still has to be checked why we are
- called so early here). */
- if (!glyphs_initialized_initially_p)
- return Qnil;
+/* Redraw frame F. */
+void
+redraw_frame (struct frame *f)
+{
+ /* Error if F has no glyphs. */
+ eassert (f->glyphs_initialized_p);
update_begin (f);
#ifdef MSDOS
if (FRAME_MSDOS_P (f))
mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0);
set_window_update_flags (XWINDOW (FRAME_ROOT_WINDOW (f)), 1);
f->garbaged = 0;
- return Qnil;
}
-
-/* Redraw frame F. This is nothing more than a call to the Lisp
- function redraw-frame. */
-
-void
-redraw_frame (struct frame *f)
+DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 0, 1, 0,
+ doc: /* Clear frame FRAME and output again what is supposed to appear on it.
+If FRAME is omitted or nil, the selected frame is used. */)
+ (Lisp_Object frame)
{
- Lisp_Object frame;
- XSETFRAME (frame, f);
- Fredraw_frame (frame);
+ redraw_frame (decode_live_frame (frame));
+ return Qnil;
}
-
DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "",
doc: /* Clear and redisplay all visible frames. */)
(void)
FOR_EACH_FRAME (tail, frame)
if (FRAME_VISIBLE_P (XFRAME (frame)))
- Fredraw_frame (frame);
+ redraw_frame (XFRAME (frame));
return Qnil;
}
FILE *display_output = FRAME_TTY (f)->output;
if (display_output)
{
- int outq = PENDING_OUTPUT_COUNT (display_output);
+ ptrdiff_t outq = __fpending (display_output);
if (outq > 900
|| (outq > 20 && ((i - 1) % preempt_count == 0)))
- {
- fflush (display_output);
- if (preempt_count == 1)
- {
-#ifdef EMACS_OUTQSIZE
- if (EMACS_OUTQSIZE (0, &outq) < 0)
- /* Probably not a tty. Ignore the error and reset
- the outq count. */
- outq = PENDING_OUTPUT_COUNT (FRAME_TTY (f->output));
-#endif
- outq *= 10;
- if (baud_rate <= outq && baud_rate > 0)
- sleep (outq / baud_rate);
- }
- }
+ fflush (display_output);
}
}
So call tgetent. */
{ char b[2044]; tgetent (b, "xterm");}
#endif
- adjust_frame_glyphs_initially ();
return;
}
#endif /* HAVE_X_WINDOWS */
{
Vinitial_window_system = Qw32;
Vwindow_system_version = make_number (1);
- adjust_frame_glyphs_initially ();
return;
}
#endif /* HAVE_NTGUI */
{
Vinitial_window_system = Qns;
Vwindow_system_version = make_number (10);
- adjust_frame_glyphs_initially ();
return;
}
#endif
fatal ("screen size %dx%d too big", width, height);
}
- adjust_frame_glyphs_initially ();
calculate_costs (XFRAME (selected_frame));
/* Set up faces of the initial terminal frame of a dumped Emacs. */
/* Don't change cursor state while redisplaying. This could confuse
output routines. */
if (!redisplaying_p)
- {
- if (NILP (window))
- window = selected_window;
- else
- CHECK_WINDOW (window);
-
- XWINDOW (window)->cursor_off_p = NILP (show);
- }
-
+ decode_any_window (window)->cursor_off_p = NILP (show);
return Qnil;
}
WINDOW nil or omitted means report on the selected window. */)
(Lisp_Object window)
{
- struct window *w;
-
- if (NILP (window))
- window = selected_window;
- else
- CHECK_WINDOW (window);
-
- w = XWINDOW (window);
- return w->cursor_off_p ? Qnil : Qt;
+ return decode_any_window (window)->cursor_off_p ? Qnil : Qt;
}
DEFUN ("last-nonminibuffer-frame", Flast_nonminibuf_frame,
#include <config.h>
#include <sys/types.h>
-#include <sys/file.h> /* Must be after sys/types.h for USG*/
+#include <sys/file.h> /* Must be after sys/types.h for USG. */
#include <fcntl.h>
#include <unistd.h>
static unsigned char *read_bytecode_pointer;
-/* readchar in lread.c calls back here to fetch the next byte.
+/* `readchar' in lread.c calls back here to fetch the next byte.
If UNREADFLAG is 1, we unread a byte. */
int
doc = Qnil;
- if (SYMBOLP (function))
- {
- Lisp_Object tem = Fget (function, Qfunction_documentation);
- if (!NILP (tem))
- return Fdocumentation_property (function, Qfunction_documentation,
- raw);
- }
-
fun = Findirect_function (function, Qnil);
+ if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+ fun = XCDR (fun);
if (SUBRP (fun))
{
if (XSUBR (fun)->doc == 0)
else
return Qnil;
}
- else if (EQ (funcar, Qmacro))
- return Fdocumentation (Fcdr (fun), raw);
else
goto oops;
}
xsignal1 (Qinvalid_function, fun);
}
- /* Check for an advised function. Its doc string
- has an `ad-advice-info' text property. */
+ /* Check for a dynamic docstring. These come with
+ a dynamic-docstring-function text property. */
if (STRINGP (doc))
{
- Lisp_Object innerfunc;
- innerfunc = Fget_text_property (make_number (0),
- intern ("ad-advice-info"),
+ Lisp_Object func
+ = Fget_text_property (make_number (0),
+ intern ("dynamic-docstring-function"),
doc);
- if (! NILP (innerfunc))
- doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
+ if (!NILP (func))
+ /* Pass both `doc' and `function' since `function' can be needed, and
+ finding `doc' can be annoying: calling `documentation' is not an
+ option because it would infloop. */
+ doc = call2 (func, doc, function);
}
/* If DOC is 0, it's typically because of a dumped file missing
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
+ /* FIXME: This modifies typically pure hash-cons'd data, so its
+ correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
#include <sys/file.h>
#include <unistd.h>
+#include <close-stream.h>
#include <ignore-value.h>
#include "lisp.h"
#include <sys/personality.h>
#endif
-#ifndef O_RDWR
-#define O_RDWR 2
-#endif
-
static const char emacs_version[] = VERSION;
static const char emacs_copyright[] = COPYRIGHT;
#endif /* DOUG_LEA_MALLOC */
+/* Close standard output and standard error, reporting any write
+ errors as best we can. This is intended for use with atexit. */
+static void
+close_output_streams (void)
+{
+ if (close_stream (stdout) != 0)
+ {
+ fprintf (stderr, "Write error to standard output: %s\n",
+ strerror (errno));
+ fflush (stderr);
+ _exit (EXIT_FAILURE);
+ }
+
+ if (close_stream (stderr) != 0)
+ _exit (EXIT_FAILURE);
+}
/* ARGSUSED */
int
unexec_init_emacs_zone ();
#endif
+ atexit (close_output_streams);
+
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;
that it is not accessible to programs started from .emacs. */
fcntl (daemon_pipe[1], F_SETFD, FD_CLOEXEC);
-#ifdef HAVE_SETSID
setsid ();
-#endif
#else /* DOS_NT */
fprintf (stderr, "This platform does not support the -daemon flag.\n");
exit (1);
/* Called before syms_of_fileio, because it sets up Qerror_condition. */
syms_of_data ();
+ syms_of_fns (); /* Before syms_of_charset which uses hashtables. */
syms_of_fileio ();
/* Before syms_of_coding to initialize Vgc_cons_threshold. */
syms_of_alloc ();
init_window_once (); /* Init the window system. */
#ifdef HAVE_WINDOW_SYSTEM
- init_fringe_once (); /* Swap bitmaps if necessary. */
+ init_fringe_once (); /* Swap bitmaps if necessary. */
#endif /* HAVE_WINDOW_SYSTEM */
}
syms_of_lread ();
syms_of_print ();
syms_of_eval ();
- syms_of_fns ();
syms_of_floatfns ();
syms_of_buffer ();
exit_code = (XINT (arg) < 0
? XINT (arg) | INT_MIN
: XINT (arg) & INT_MAX);
- else if (noninteractive && (fflush (stdout) || ferror (stdout)))
- exit_code = EXIT_FAILURE;
else
exit_code = EXIT_SUCCESS;
exit (exit_code);
/* If we are controlling the terminal, reset terminal modes. */
#ifndef DOS_NT
{
- pid_t pgrp = EMACS_GETPGRP (0);
+ pid_t pgrp = getpgrp ();
pid_t tpgrp = tcgetpgrp (0);
if ((tpgrp != -1) && tpgrp == pgrp)
{
CHECK_STRING (file);
/* If function is defined and not as an autoload, don't override. */
- if ((CONSP (XSYMBOL (function)->function)
- && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
- /* Remember that the function was already an autoload. */
- LOADHIST_ATTACH (Fcons (Qt, function));
- else if (!EQ (XSYMBOL (function)->function, Qunbound))
+ if (!EQ (XSYMBOL (function)->function, Qunbound)
+ && !AUTOLOADP (XSYMBOL (function)->function))
return Qnil;
- if (NILP (Vpurify_flag))
- /* Only add entries after dumping, because the ones before are
- not useful and else we get loads of them from the loaddefs.el. */
- LOADHIST_ATTACH (Fcons (Qautoload, function));
- else if (EQ (docstring, make_number (0)))
+ if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
/* `read1' in lread.c has found the docstring starting with "\
and assumed the docstring will be provided by Snarf-documentation, so it
passed us 0 instead. But that leads to accidental sharing in purecopy's
hash-consing, so we use a (hopefully) unique integer instead. */
- docstring = make_number (XUNTAG (function, Lisp_Symbol));
- return Ffset (function,
- Fpurecopy (list5 (Qautoload, file, docstring,
- interactive, type)));
+ docstring = make_number (XHASH (function));
+ return Fdefalias (function,
+ list5 (Qautoload, file, docstring, interactive, type),
+ Qnil);
}
Lisp_Object
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
- mark_object (*backlist->function);
+ mark_object (backlist->function);
if (backlist->nargs == UNEVALLED
|| backlist->nargs == MANY) /* FIXME: Can this happen? */
bool
check_existing (const char *filename)
{
-#ifdef DOS_NT
- /* The full emulation of Posix 'stat' is too expensive on
- DOS/Windows, when all we want to know is whether the file exists.
- So we use 'access' instead, which is much more lightweight. */
- return (access (filename, F_OK) >= 0);
-#else
- struct stat st;
- return (stat (filename, &st) >= 0);
-#endif
+ return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
}
/* Return true if file FILENAME exists and can be executed. */
static bool
check_executable (char *filename)
{
-#ifdef DOS_NT
- struct stat st;
- if (stat (filename, &st) < 0)
- return 0;
- return ((st.st_mode & S_IEXEC) != 0);
-#else /* not DOS_NT */
-#ifdef HAVE_EUIDACCESS
- return (euidaccess (filename, 1) >= 0);
-#else
- /* Access isn't quite right because it uses the real uid
- and we really want to test with the effective uid.
- But Unix doesn't give us a right way to do it. */
- return (access (filename, 1) >= 0);
-#endif
-#endif /* not DOS_NT */
+ return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
}
-/* Return true if file FILENAME exists and can be written. */
+/* Return true if file FILENAME exists and can be accessed
+ according to AMODE, which should include W_OK.
+ On failure, return false and set errno. */
static bool
-check_writable (const char *filename)
+check_writable (const char *filename, int amode)
{
#ifdef MSDOS
+ /* FIXME: an faccessat implementation should be added to the
+ DOS/Windows ports and this #ifdef branch should be removed. */
struct stat st;
if (stat (filename, &st) < 0)
return 0;
+ errno = EPERM;
return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
#else /* not MSDOS */
-#ifdef HAVE_EUIDACCESS
- bool res = (euidaccess (filename, 2) >= 0);
+ bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
#ifdef CYGWIN
- /* euidaccess may have returned failure because Cygwin couldn't
+ /* faccessat may have returned failure because Cygwin couldn't
determine the file's UID or GID; if so, we return success. */
if (!res)
{
+ int faccessat_errno = errno;
struct stat st;
if (stat (filename, &st) < 0)
return 0;
res = (st.st_uid == -1 || st.st_gid == -1);
+ errno = faccessat_errno;
}
#endif /* CYGWIN */
return res;
-#else /* not HAVE_EUIDACCESS */
- /* Access isn't quite right because it uses the real uid
- and we really want to test with the effective uid.
- But Unix doesn't give us a right way to do it.
- Opening with O_WRONLY could work for an ordinary file,
- but would lose for directories. */
- return (access (filename, 2) >= 0);
-#endif /* not HAVE_EUIDACCESS */
#endif /* not MSDOS */
}
{
Lisp_Object absname;
Lisp_Object handler;
- int desc;
- int flags;
- struct stat statbuf;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
return call2 (handler, Qfile_readable_p, absname);
absname = ENCODE_FILE (absname);
-
-#if defined (DOS_NT) || defined (macintosh)
- /* Under MS-DOS, Windows, and Macintosh, open does not work for
- directories. */
- if (access (SDATA (absname), 0) == 0)
- return Qt;
- return Qnil;
-#else /* not DOS_NT and not macintosh */
- flags = O_RDONLY;
-#ifdef O_NONBLOCK
- /* Opening a fifo without O_NONBLOCK can wait.
- We don't want to wait. But we don't want to mess wth O_NONBLOCK
- except in the case of a fifo, on a system which handles it. */
- desc = stat (SSDATA (absname), &statbuf);
- if (desc < 0)
- return Qnil;
- if (S_ISFIFO (statbuf.st_mode))
- flags |= O_NONBLOCK;
-#endif
- desc = emacs_open (SSDATA (absname), flags, 0);
- if (desc < 0)
- return Qnil;
- emacs_close (desc);
- return Qt;
-#endif /* not DOS_NT and not macintosh */
+ return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
+ ? Qt : Qnil);
}
-/* Having this before file-symlink-p mysteriously caused it to be forgotten
- on the RT/PC. */
DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
doc: /* Return t if file FILENAME can be written or created by you. */)
(Lisp_Object filename)
return call2 (handler, Qfile_writable_p, absname);
encoded = ENCODE_FILE (absname);
- if (check_existing (SSDATA (encoded)))
- return (check_writable (SSDATA (encoded))
- ? Qt : Qnil);
+ if (check_writable (SSDATA (encoded), W_OK))
+ return Qt;
+ if (errno != ENOENT)
+ return Qnil;
dir = Ffile_name_directory (absname);
+ eassert (!NILP (dir));
#ifdef MSDOS
- if (!NILP (dir))
- dir = Fdirectory_file_name (dir);
+ dir = Fdirectory_file_name (dir);
#endif /* MSDOS */
dir = ENCODE_FILE (dir);
/* The read-only attribute of the parent directory doesn't affect
whether a file or directory can be created within it. Some day we
should check ACLs though, which do affect this. */
- return (access (SDATA (dir), D_OK) < 0) ? Qnil : Qt;
+ return file_directory_p (SDATA (dir)) ? Qt : Qnil;
#else
- return (check_writable (!NILP (dir) ? SSDATA (dir) : "")
- ? Qt : Qnil);
+ return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
#endif
}
\f
See `file-symlink-p' to distinguish symlinks. */)
(Lisp_Object filename)
{
- register Lisp_Object absname;
- struct stat st;
+ Lisp_Object absname;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
absname = ENCODE_FILE (absname);
- if (stat (SSDATA (absname), &st) < 0)
- return Qnil;
- return S_ISDIR (st.st_mode) ? Qt : Qnil;
+ return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
+}
+
+/* Return true if FILE is a directory or a symlink to a directory. */
+bool
+file_directory_p (char const *file)
+{
+#ifdef WINDOWSNT
+ /* This is cheaper than 'stat'. */
+ return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
+#else
+ struct stat st;
+ return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
+#endif
}
DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
searchable directory. */)
(Lisp_Object filename)
{
+ Lisp_Object absname;
Lisp_Object handler;
- bool tem;
- struct gcpro gcpro1;
+
+ CHECK_STRING (filename);
+ absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
+ handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
if (!NILP (handler))
- return call2 (handler, Qfile_accessible_directory_p, filename);
+ return call2 (handler, Qfile_accessible_directory_p, absname);
- GCPRO1 (filename);
- tem = (NILP (Ffile_directory_p (filename))
- || NILP (Ffile_executable_p (filename)));
- UNGCPRO;
- return tem ? Qnil : Qt;
+ absname = ENCODE_FILE (absname);
+ return file_accessible_directory_p (SSDATA (absname)) ? Qt : Qnil;
+}
+
+/* If FILE is a searchable directory or a symlink to a
+ searchable directory, return true. Otherwise return
+ false and set errno to an error number. */
+bool
+file_accessible_directory_p (char const *file)
+{
+#ifdef DOS_NT
+ /* There's no need to test whether FILE is searchable, as the
+ searchable/executable bit is invented on DOS_NT platforms. */
+ return file_directory_p (file);
+#else
+ /* On POSIXish platforms, use just one system call; this avoids a
+ race and is typically faster. */
+ ptrdiff_t len = strlen (file);
+ char const *dir;
+ bool ok;
+ int saved_errno;
+ USE_SAFE_ALLOCA;
+
+ /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
+ There are three exceptions: "", "/", and "//". Leave "" alone,
+ as it's invalid. Append only "." to the other two exceptions as
+ "/" and "//" are distinct on some platforms, whereas "/", "///",
+ "////", etc. are all equivalent. */
+ if (! len)
+ dir = file;
+ else
+ {
+ /* Just check for trailing '/' when deciding whether to append '/'.
+ That's simpler than testing the two special cases "/" and "//",
+ and it's a safe optimization here. */
+ char *buf = SAFE_ALLOCA (len + 3);
+ memcpy (buf, file, len);
+ strcpy (buf + len, "/." + (file[len - 1] == '/'));
+ dir = buf;
+ }
+
+ ok = check_existing (dir);
+ saved_errno = errno;
+ SAFE_FREE ();
+ errno = saved_errno;
+ return ok;
+#endif
}
DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
if (set_file_times (-1, SSDATA (encoded_absname), t, t))
{
#ifdef MSDOS
- struct stat st;
-
/* Setting times on a directory always fails. */
- if (stat (SSDATA (encoded_absname), &st) == 0 && S_ISDIR (st.st_mode))
+ if (file_directory_p (SSDATA (encoded_absname)))
return Qnil;
#endif
report_file_error ("Setting file times", Fcons (absname, Qnil));
struct stat st;
Lisp_Object handler;
Lisp_Object filename;
- EMACS_TIME mtime, diff;
+ EMACS_TIME mtime;
if (NILP (buf))
b = current_buffer;
mtime = (stat (SSDATA (filename), &st) == 0
? get_stat_mtime (&st)
: time_error_value (errno));
- if ((EMACS_TIME_EQ (mtime, b->modtime)
- /* If both exist, accept them if they are off by one second. */
- || (EMACS_TIME_VALID_P (mtime) && EMACS_TIME_VALID_P (b->modtime)
- && ((diff = (EMACS_TIME_LT (mtime, b->modtime)
- ? sub_emacs_time (b->modtime, mtime)
- : sub_emacs_time (mtime, b->modtime))),
- EMACS_TIME_LE (diff, make_emacs_time (1, 0)))))
+ if (EMACS_TIME_EQ (mtime, b->modtime)
&& (st.st_size == b->modtime_size
|| b->modtime_size < 0))
return Qt;
d1 = extract_float (o1);
d2 = extract_float (o2);
/* If d is a NaN, then d != d. Two NaNs should be `equal' even
- though they are not =. */
+ though they are not =. */
return d1 == d2 || (d1 != d1 && d2 != d2);
}
are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
- if (!(size & ((PVEC_COMPILED | PVEC_CHAR_TABLE
- | PVEC_SUB_CHAR_TABLE | PVEC_FONT)
- << PSEUDOVECTOR_SIZE_BITS)))
+ if (((size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
+ < PVEC_COMPILED)
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
/* Various symbols. */
-static Lisp_Object Qhash_table_p, Qkey, Qvalue;
-Lisp_Object Qeq, Qeql, Qequal;
+static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql;
+Lisp_Object Qeq, Qequal;
Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
Low-level Functions
***********************************************************************/
+static struct hash_table_test hashtest_eq;
+struct hash_table_test hashtest_eql, hashtest_equal;
+
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
HASH2 in hash table H using `eql'. Value is true if KEY1 and
KEY2 are the same. */
static bool
-cmpfn_eql (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+cmpfn_eql (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
return (FLOATP (key1)
&& FLOATP (key2)
KEY2 are the same. */
static bool
-cmpfn_equal (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+cmpfn_equal (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
- return hash1 == hash2 && !NILP (Fequal (key1, key2));
+ return !NILP (Fequal (key1, key2));
}
if KEY1 and KEY2 are the same. */
static bool
-cmpfn_user_defined (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+cmpfn_user_defined (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
- if (hash1 == hash2)
- {
- Lisp_Object args[3];
+ Lisp_Object args[3];
- args[0] = h->user_cmp_function;
- args[1] = key1;
- args[2] = key2;
- return !NILP (Ffuncall (3, args));
- }
- else
- return 0;
+ args[0] = ht->user_cmp_function;
+ args[1] = key1;
+ args[2] = key2;
+ return !NILP (Ffuncall (3, args));
}
in a Lisp integer. */
static EMACS_UINT
-hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_eq (struct hash_table_test *ht, Lisp_Object key)
{
- EMACS_UINT hash = XUINT (key) ^ XTYPE (key);
- eassert ((hash & ~INTMASK) == 0);
+ EMACS_UINT hash = XHASH (key) ^ XTYPE (key);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses
`eql' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
{
EMACS_UINT hash;
if (FLOATP (key))
hash = sxhash (key, 0);
else
- hash = XUINT (key) ^ XTYPE (key);
- eassert ((hash & ~INTMASK) == 0);
+ hash = XHASH (key) ^ XTYPE (key);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses
`equal' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
{
EMACS_UINT hash = sxhash (key, 0);
- eassert ((hash & ~INTMASK) == 0);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses as
user-defined function to compare keys. The hash code returned is
guaranteed to fit in a Lisp integer. */
static EMACS_UINT
-hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key)
{
Lisp_Object args[2], hash;
- args[0] = h->user_hash_function;
+ args[0] = ht->user_hash_function;
args[1] = key;
hash = Ffuncall (2, args);
if (!INTEGERP (hash))
one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
Lisp_Object
-make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
- Lisp_Object rehash_threshold, Lisp_Object weak,
- Lisp_Object user_test, Lisp_Object user_hash)
+make_hash_table (struct hash_table_test test,
+ Lisp_Object size, Lisp_Object rehash_size,
+ Lisp_Object rehash_threshold, Lisp_Object weak)
{
struct Lisp_Hash_Table *h;
Lisp_Object table;
double index_float;
/* Preconditions. */
- eassert (SYMBOLP (test));
+ eassert (SYMBOLP (test.name));
eassert (INTEGERP (size) && XINT (size) >= 0);
eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
|| (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size)));
/* Initialize hash table slots. */
h->test = test;
- if (EQ (test, Qeql))
- {
- h->cmpfn = cmpfn_eql;
- h->hashfn = hashfn_eql;
- }
- else if (EQ (test, Qeq))
- {
- h->cmpfn = NULL;
- h->hashfn = hashfn_eq;
- }
- else if (EQ (test, Qequal))
- {
- h->cmpfn = cmpfn_equal;
- h->hashfn = hashfn_equal;
- }
- else
- {
- h->user_cmp_function = user_test;
- h->user_hash_function = user_hash;
- h->cmpfn = cmpfn_user_defined;
- h->hashfn = hashfn_user_defined;
- }
-
h->weak = weak;
h->rehash_threshold = rehash_threshold;
h->rehash_size = rehash_size;
{
Lisp_Object table;
struct Lisp_Hash_Table *h2;
- struct Lisp_Vector *next;
h2 = allocate_hash_table ();
- next = h2->header.next.vector;
*h2 = *h1;
- h2->header.next.vector = next;
h2->key_and_value = Fcopy_sequence (h1->key_and_value);
h2->hash = Fcopy_sequence (h1->hash);
h2->next = Fcopy_sequence (h1->next);
ptrdiff_t start_of_bucket;
Lisp_Object idx;
- hash_code = h->hashfn (h, key);
+ hash_code = h->test.hashfn (&h->test, key);
+ eassert ((hash_code & ~INTMASK) == 0);
if (hash)
*hash = hash_code;
{
ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
- || (h->cmpfn
- && h->cmpfn (h, key, hash_code,
- HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
+ || (h->test.cmpfn
+ && hash_code == XUINT (HASH_HASH (h, i))
+ && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
break;
idx = HASH_NEXT (h, i);
}
ptrdiff_t start_of_bucket;
Lisp_Object idx, prev;
- hash_code = h->hashfn (h, key);
+ hash_code = h->test.hashfn (&h->test, key);
+ eassert ((hash_code & ~INTMASK) == 0);
start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket);
prev = Qnil;
ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
- || (h->cmpfn
- && h->cmpfn (h, key, hash_code,
- HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
+ || (h->test.cmpfn
+ && hash_code == XUINT (HASH_HASH (h, i))
+ && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
{
/* Take entry out of collision chain. */
if (NILP (prev))
#define SXHASH_MAX_LEN 7
-/* Combine two integers X and Y for hashing. The result might not fit
- into a Lisp integer. */
-
-#define SXHASH_COMBINE(X, Y) \
- ((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \
- + (EMACS_UINT) (Y))
-
/* Hash X, returning a value that fits into a Lisp integer. */
#define SXHASH_REDUCE(X) \
((((X) ^ (X) >> (BITS_PER_EMACS_INT - FIXNUM_BITS))) & INTMASK)
while (p != end)
{
c = *p++;
- hash = SXHASH_COMBINE (hash, c);
+ hash = sxhash_combine (hash, c);
}
return hash;
u.val = val;
memset (&u.val + 1, 0, sizeof u - sizeof u.val);
for (i = 0; i < WORDS_PER_DOUBLE; i++)
- hash = SXHASH_COMBINE (hash, u.word[i]);
+ hash = sxhash_combine (hash, u.word[i]);
return SXHASH_REDUCE (hash);
}
list = XCDR (list), ++i)
{
EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
if (!NILP (list))
{
EMACS_UINT hash2 = sxhash (list, depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
return SXHASH_REDUCE (hash);
for (i = 0; i < n; ++i)
{
EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
return SXHASH_REDUCE (hash);
n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->header.size);
for (i = 0; i < n; ++i)
- hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
+ hash = sxhash_combine (hash, XBOOL_VECTOR (vec)->data[i]);
return SXHASH_REDUCE (hash);
}
break;
case Lisp_Misc:
- hash = XUINT (obj);
+ hash = XHASH (obj);
break;
case Lisp_Symbol:
else
/* Others are `equal' if they are `eq', so let's take their
address as hash. */
- hash = XUINT (obj);
+ hash = XHASH (obj);
break;
case Lisp_Cons:
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object test, size, rehash_size, rehash_threshold, weak;
- Lisp_Object user_test, user_hash;
+ struct hash_table_test testdesc;
char *used;
ptrdiff_t i;
/* See if there's a `:test TEST' among the arguments. */
i = get_key_arg (QCtest, nargs, args, used);
test = i ? args[i] : Qeql;
- if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
+ if (EQ (test, Qeq))
+ testdesc = hashtest_eq;
+ else if (EQ (test, Qeql))
+ testdesc = hashtest_eql;
+ else if (EQ (test, Qequal))
+ testdesc = hashtest_equal;
+ else
{
/* See if it is a user-defined test. */
Lisp_Object prop;
prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || !CONSP (XCDR (prop)))
signal_error ("Invalid hash table test", test);
- user_test = XCAR (prop);
- user_hash = XCAR (XCDR (prop));
+ testdesc.name = test;
+ testdesc.user_cmp_function = XCAR (prop);
+ testdesc.user_hash_function = XCAR (XCDR (prop));
+ testdesc.hashfn = hashfn_user_defined;
+ testdesc.cmpfn = cmpfn_user_defined;
}
- else
- user_test = user_hash = Qnil;
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
if (!used[i])
signal_error ("Invalid argument list", args[i]);
- return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
- user_test, user_hash);
+ return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
}
doc: /* Return the test TABLE uses. */)
(Lisp_Object table)
{
- return check_hash_table (table)->test;
+ return check_hash_table (table)->test.name;
}
defsubr (&Smd5);
defsubr (&Ssecure_hash);
defsubr (&Slocale_info);
+
+ {
+ struct hash_table_test
+ eq = { Qeq, Qnil, Qnil, NULL, hashfn_eq },
+ eql = { Qeql, Qnil, Qnil, cmpfn_eql, hashfn_eql },
+ equal = { Qequal, Qnil, Qnil, cmpfn_equal, hashfn_equal };
+ hashtest_eq = eq;
+ hashtest_eql = eql;
+ hashtest_equal = equal;
+ }
}
are to be displayed on. If omitted, the selected frame is used. */)
(Lisp_Object font, Lisp_Object frame)
{
- struct frame *f;
+ struct frame *f = decode_live_frame (frame);
Lisp_Object plist[10];
Lisp_Object val;
int n = 0;
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
if (STRINGP (font))
{
int fontset = fs_query_fontset (font, 0);
DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
doc: /* List available font families on the current frame.
-Optional argument FRAME, if non-nil, specifies the target frame. */)
+If FRAME is omitted or nil, the selected frame is used. */)
(Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
struct font_driver_list *driver_list;
- Lisp_Object list;
+ Lisp_Object list = Qnil;
+
+ XSETFRAME (frame, f);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
- list = Qnil;
for (driver_list = f->font_driver_list; driver_list;
driver_list = driver_list->next)
if (driver_list->driver->list_family)
(Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame)
{
EMACS_INT isize;
+ struct frame *f = decode_live_frame (frame);
CHECK_FONT_ENTITY (font_entity);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
if (NILP (size))
isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
{
CHECK_NUMBER_OR_FLOAT (size);
if (FLOATP (size))
- isize = POINT_TO_PIXEL (XFLOAT_DATA (size), XFRAME (frame)->resy);
+ isize = POINT_TO_PIXEL (XFLOAT_DATA (size), f->resy);
else
isize = XINT (size);
if (! (INT_MIN <= isize && isize <= INT_MAX))
if (isize == 0)
isize = 120;
}
- return font_open_entity (XFRAME (frame), font_entity, isize);
+ return font_open_entity (f, font_entity, isize);
}
DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
(Lisp_Object font_object, Lisp_Object frame)
{
CHECK_FONT_OBJECT (font_object);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- font_close_object (XFRAME (frame), font_object);
+ font_close_object (decode_live_frame (frame), font_object);
return Qnil;
}
character at index specified by POSITION. */)
(Lisp_Object position, Lisp_Object window, Lisp_Object string)
{
- struct window *w;
- ptrdiff_t pos;
+ struct window *w = decode_live_window (window);
- if (NILP (window))
- window = selected_window;
- CHECK_LIVE_WINDOW (window);
- w = XWINDOW (window);
if (NILP (string))
{
if (XBUFFER (w->buffer) != current_buffer)
CHECK_NUMBER_COERCE_MARKER (position);
if (! (BEGV <= XINT (position) && XINT (position) < ZV))
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
- pos = XINT (position);
}
else
{
CHECK_STRING (string);
if (! (0 <= XINT (position) && XINT (position) < SCHARS (string)))
args_out_of_range (string, position);
- pos = XINT (position);
}
- return font_at (-1, pos, NULL, w, string);
+ return font_at (-1, XINT (position), NULL, w, string);
}
#if 0
If the named font is not yet loaded, return nil. */)
(Lisp_Object name, Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f;
struct font *font;
Lisp_Object info;
Lisp_Object font_object;
if (! FONTP (name))
CHECK_STRING (name);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ f = decode_live_frame (frame);
if (STRINGP (name))
{
check_fontset_name (Lisp_Object name, Lisp_Object *frame)
{
int id;
+ struct frame *f = decode_live_frame (*frame);
- if (NILP (*frame))
- *frame = selected_frame;
- CHECK_LIVE_FRAME (*frame);
+ XSETFRAME (*frame, f);
if (EQ (name, Qt))
return Vdefault_fontset;
if (NILP (name))
- {
- id = FRAME_FONTSET (XFRAME (*frame));
- }
+ id = FRAME_FONTSET (f);
else
{
CHECK_STRING (name);
f->minibuffer_window = val;
}
-\f
+struct frame *
+decode_live_frame (register Lisp_Object frame)
+{
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ return XFRAME (frame);
+}
+
+struct frame *
+decode_any_frame (register Lisp_Object frame)
+{
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_FRAME (frame);
+ return XFRAME (frame);
+}
+
static void
set_menu_bar_lines_1 (Lisp_Object window, int n)
{
FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
/* The default value of menu-bar-mode is t. */
FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
#endif /* not MSDOS */
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
static Lisp_Object
next_frame (Lisp_Object frame, Lisp_Object minibuf)
{
- Lisp_Object tail;
+ Lisp_Object f, tail;
int passed = 0;
/* There must always be at least one frame in Vframe_list. */
CHECK_LIVE_FRAME (frame);
while (1)
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, f)
{
- Lisp_Object f;
-
- f = XCAR (tail);
-
if (passed
&& ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
&& FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
static Lisp_Object
prev_frame (Lisp_Object frame, Lisp_Object minibuf)
{
- Lisp_Object tail;
- Lisp_Object prev;
+ Lisp_Object f, tail, prev = Qnil;
/* There must always be at least one frame in Vframe_list. */
- if (! CONSP (Vframe_list))
- emacs_abort ();
+ eassert (CONSP (Vframe_list));
- prev = Qnil;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, f)
{
- Lisp_Object f;
-
- f = XCAR (tail);
- if (!FRAMEP (f))
- emacs_abort ();
-
if (EQ (frame, f) && !NILP (prev))
return prev;
static int
other_visible_frames (FRAME_PTR f)
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
- for (frames = Vframe_list; CONSP (frames); frames = XCDR (frames))
+ FOR_EACH_FRAME (frames, this)
{
- Lisp_Object this = XCAR (frames);
if (f == XFRAME (this))
continue;
Lisp_Object
delete_frame (Lisp_Object frame, Lisp_Object force)
{
- struct frame *f;
+ struct frame *f = decode_any_frame (frame);
struct frame *sf = SELECTED_FRAME ();
struct kboard *kb;
int minibuffer_selected, is_tooltip_frame;
- if (EQ (frame, Qnil))
- {
- f = sf;
- XSETFRAME (frame, f);
- }
- else
- {
- CHECK_FRAME (frame);
- f = XFRAME (frame);
- }
-
if (! FRAME_LIVE_P (f))
return Qnil;
if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
error ("Attempt to delete the only frame");
+ XSETFRAME (frame, f);
+
/* Does this frame have a minibuffer, and is it the surrogate
minibuffer for any other frame? */
- if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
+ if (FRAME_HAS_MINIBUF_P (f))
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
+ FOR_EACH_FRAME (frames, this)
{
- Lisp_Object this;
- this = XCAR (frames);
-
if (! EQ (this, frame)
&& EQ (frame,
WINDOW_FRAME (XWINDOW
another one. */
if (f == last_nonminibuf_frame)
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
last_nonminibuf_frame = 0;
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
+ FOR_EACH_FRAME (frames, this)
{
- f = XFRAME (XCAR (frames));
+ f = XFRAME (this);
if (!FRAME_MINIBUF_ONLY_P (f))
{
last_nonminibuf_frame = f;
single-kboard state if we're in it for this kboard. */
if (kb != NULL)
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
/* Some frame we found on the same kboard, or nil if there are none. */
- Lisp_Object frame_on_same_kboard;
-
- frame_on_same_kboard = Qnil;
-
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
- {
- Lisp_Object this;
- struct frame *f1;
+ Lisp_Object frame_on_same_kboard = Qnil;
- this = XCAR (frames);
- if (!FRAMEP (this))
- emacs_abort ();
- f1 = XFRAME (this);
-
- if (kb == FRAME_KBOARD (f1))
- frame_on_same_kboard = this;
- }
+ FOR_EACH_FRAME (frames, this)
+ if (kb == FRAME_KBOARD (XFRAME (this)))
+ frame_on_same_kboard = this;
if (NILP (frame_on_same_kboard))
not_single_kboard_state (kb);
frames with other windows. */
if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
/* The last frame we saw with a minibuffer, minibuffer-only or not. */
- Lisp_Object frame_with_minibuf;
+ Lisp_Object frame_with_minibuf = Qnil;
/* Some frame we found on the same kboard, or nil if there are none. */
- Lisp_Object frame_on_same_kboard;
+ Lisp_Object frame_on_same_kboard = Qnil;
- frame_on_same_kboard = Qnil;
- frame_with_minibuf = Qnil;
-
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
+ FOR_EACH_FRAME (frames, this)
{
- Lisp_Object this;
- struct frame *f1;
-
- this = XCAR (frames);
- if (!FRAMEP (this))
- emacs_abort ();
- f1 = XFRAME (this);
+ struct frame *f1 = XFRAME (this);
/* Consider only frames on the same kboard
and only those with minibuffers. */
If omitted, FRAME defaults to the currently selected frame. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
+ struct frame *f = decode_live_frame (frame);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (frame)))
+ if (FRAME_WINDOW_P (f))
{
- FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
- x_make_frame_visible (XFRAME (frame));
+ FRAME_SAMPLE_VISIBILITY (f);
+ x_make_frame_visible (f);
}
#endif
- make_frame_visible_1 (XFRAME (frame)->root_window);
+ make_frame_visible_1 (f->root_window);
/* Make menu bar update for the Buffers and Frames menus. */
windows_or_buffers_changed++;
+ XSETFRAME (frame, f);
return frame;
}
displayed in the terminal. */)
(Lisp_Object frame, Lisp_Object force)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
+ struct frame *f = decode_live_frame (frame);
- if (NILP (force) && !other_visible_frames (XFRAME (frame)))
+ if (NILP (force) && !other_visible_frames (f))
error ("Attempt to make invisible the sole visible or iconified frame");
/* Don't allow minibuf_window to remain on a deleted frame. */
- if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
+ if (EQ (f->minibuffer_window, minibuf_window))
{
struct frame *sf = XFRAME (selected_frame);
/* Use set_window_buffer instead of Fset_window_buffer (see
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (frame)))
- x_make_frame_invisible (XFRAME (frame));
+ if (FRAME_WINDOW_P (f))
+ x_make_frame_invisible (f);
#endif
/* Make menu bar update for the Buffers and Frames menus. */
If omitted, FRAME defaults to the currently selected frame. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
-
-#if 0 /* This isn't logically necessary, and it can do GC. */
- /* Don't let the frame remain selected. */
- if (EQ (frame, selected_frame))
- Fhandle_switch_frame (next_frame (frame, Qt));
-#endif
+ struct frame *f = decode_live_frame (frame);
/* Don't allow minibuf_window to remain on an iconified frame. */
- if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
+ if (EQ (f->minibuffer_window, minibuf_window))
{
struct frame *sf = XFRAME (selected_frame);
/* Use set_window_buffer instead of Fset_window_buffer (see
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (frame)))
- x_iconify_frame (XFRAME (frame));
+ if (FRAME_WINDOW_P (f))
+ x_iconify_frame (f);
#endif
/* Make menu bar update for the Buffers and Frames menus. */
doc: /* Return a list of all frames now \"visible\" (being updated). */)
(void)
{
- Lisp_Object tail, frame;
- struct frame *f;
- Lisp_Object value;
+ Lisp_Object tail, frame, value = Qnil;
+
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_VISIBLE_P (XFRAME (frame)))
+ value = Fcons (frame, value);
- value = Qnil;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- {
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
- f = XFRAME (frame);
- if (FRAME_VISIBLE_P (f))
- value = Fcons (frame, value);
- }
return value;
}
doesn't support multiple overlapping frames, this function selects FRAME. */)
(Lisp_Object frame)
{
- struct frame *f;
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
+ struct frame *f = decode_live_frame (frame);
- f = XFRAME (frame);
+ XSETFRAME (frame, f);
if (FRAME_TERMCAP_P (f))
/* On a text terminal select FRAME. */
doesn't support multiple overlapping frames, this function does nothing. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
-
- f = XFRAME (frame);
+ struct frame *f = decode_live_frame (frame);
if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
(*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
The redirection lasts until `redirect-frame-focus' is called to change it. */)
(Lisp_Object frame, Lisp_Object focus_frame)
{
- struct frame *f;
-
/* Note that we don't check for a live frame here. It's reasonable
to redirect the focus of a frame you're about to delete, if you
know what other frame should receive those keystrokes. */
- CHECK_FRAME (frame);
+ struct frame *f = decode_any_frame (frame);
if (! NILP (focus_frame))
CHECK_LIVE_FRAME (focus_frame);
- f = XFRAME (frame);
-
fset_focus_frame (f, focus_frame);
if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
}
-DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
+DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
-This returns nil if FRAME's focus is not redirected.
+If FRAME is omitted or nil, the selected frame is used.
+Return nil if FRAME's focus is not redirected.
See `redirect-frame-focus'. */)
(Lisp_Object frame)
{
- CHECK_LIVE_FRAME (frame);
-
- return FRAME_FOCUS_FRAME (XFRAME (frame));
+ return FRAME_FOCUS_FRAME (decode_live_frame (frame));
}
}
#endif
-/* Return the buffer-predicate of the selected frame. */
-
-Lisp_Object
-frame_buffer_predicate (Lisp_Object frame)
-{
- return XFRAME (frame)->buffer_predicate;
-}
-
-/* Return the buffer-list of the selected frame. */
-
-static Lisp_Object
-frame_buffer_list (Lisp_Object frame)
-{
- return XFRAME (frame)->buffer_list;
-}
-
/* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
void
doc: /* Return the parameters-alist of frame FRAME.
It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
The meaningful PARMs depend on the kind of frame.
-If FRAME is omitted, return information on the currently selected frame. */)
+If FRAME is omitted or nil, return information on the currently selected frame. */)
(Lisp_Object frame)
{
Lisp_Object alist;
- FRAME_PTR f;
+ struct frame *f = decode_any_frame (frame);
int height, width;
struct gcpro gcpro1;
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
if (!FRAME_LIVE_P (f))
return Qnil;
: FRAME_MINIBUF_ONLY_P (f) ? Qonly
: FRAME_MINIBUF_WINDOW (f)));
store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
- store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
- store_in_alist (&alist, Qburied_buffer_list,
- XFRAME (frame)->buried_buffer_list);
+ store_in_alist (&alist, Qbuffer_list, f->buffer_list);
+ store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
If FRAME is nil, describe the currently selected frame. */)
(Lisp_Object frame, Lisp_Object parameter)
{
- struct frame *f;
- Lisp_Object value;
+ struct frame *f = decode_any_frame (frame);
+ Lisp_Object value = Qnil;
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
CHECK_SYMBOL (parameter);
- f = XFRAME (frame);
- value = Qnil;
+ XSETFRAME (frame, f);
if (FRAME_LIVE_P (f))
{
use is not recommended. Explicitly check for a frame-parameter instead. */)
(Lisp_Object frame, Lisp_Object alist)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
register Lisp_Object tail, prop, val;
- if (EQ (frame, Qnil))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
0, 1, 0,
doc: /* Height in pixels of a line in the font in frame FRAME.
-If FRAME is omitted, the selected frame is used.
+If FRAME is omitted or nil, the selected frame is used.
For a terminal frame, the value is always 1. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
#ifdef HAVE_WINDOW_SYSTEM
+ struct frame *f = decode_any_frame (frame);
+
if (FRAME_WINDOW_P (f))
return make_number (x_char_height (f));
else
DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
0, 1, 0,
doc: /* Width in pixels of characters in the font in frame FRAME.
-If FRAME is omitted, the selected frame is used.
+If FRAME is omitted or nil, the selected frame is used.
On a graphical screen, the width is the standard width of the default font.
For a terminal screen, the value is always 1. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
#ifdef HAVE_WINDOW_SYSTEM
+ struct frame *f = decode_any_frame (frame);
+
if (FRAME_WINDOW_P (f))
return make_number (x_char_width (f));
else
DEFUN ("frame-pixel-height", Fframe_pixel_height,
Sframe_pixel_height, 0, 1, 0,
doc: /* Return a FRAME's height in pixels.
-If FRAME is omitted, the selected frame is used. The exact value
+If FRAME is omitted or nil, the selected frame is used. The exact value
of the result depends on the window-system and toolkit in use:
In the Gtk+ version of Emacs, it includes only any window (including
to `frame-height'). */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
Sframe_pixel_width, 0, 1, 0,
doc: /* Return FRAME's width in pixels.
For a terminal frame, the result really gives the width in characters.
-If FRAME is omitted, the selected frame is used. */)
+If FRAME is omitted or nil, the selected frame is used. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
Stool_bar_pixel_width, 0, 1, 0,
doc: /* Return width in pixels of FRAME's tool bar.
The result is greater than zero only when the tool bar is on the left
-or right side of FRAME. If FRAME is omitted, the selected frame is
-used. */)
+or right side of FRAME. If FRAME is omitted or nil, the selected frame
+is used. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
-
#ifdef FRAME_TOOLBAR_WIDTH
- if (FRAME_WINDOW_P (XFRAME (frame)))
- return make_number (FRAME_TOOLBAR_WIDTH (XFRAME (frame)));
+ struct frame *f = decode_any_frame (frame);
+
+ if (FRAME_WINDOW_P (f))
+ return make_number (FRAME_TOOLBAR_WIDTH (f));
#endif
return make_number (0);
}
but that the idea of the actual height of the frame should not be changed. */)
(Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
{
- register struct frame *f;
+ register struct frame *f = decode_live_frame (frame);
CHECK_TYPE_RANGED_INTEGER (int, lines);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
but that the idea of the actual width of the frame should not be changed. */)
(Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
{
- register struct frame *f;
+ register struct frame *f = decode_live_frame (frame);
+
CHECK_TYPE_RANGED_INTEGER (int, cols);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
selected frame. This is useful when `make-pointer-invisible' is set. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_FRAME (frame);
-
- return (XFRAME (frame)->pointer_invisible ? Qnil : Qt);
+ return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
}
\f
#if defined (USE_GTK) || defined (HAVE_NS)
/* Nonzero means using a tool bar that comes from the toolkit. */
- int external_tool_bar;
+ unsigned external_tool_bar : 1;
#endif
/* Margin at the top of the frame. Used to display the tool-bar. */
show no modeline for that window. */
unsigned wants_modeline : 1;
- /* Non-zero if the hardware device this frame is displaying on can
- support scroll bars. */
- char can_have_scroll_bars;
-
/* Non-0 means raise this frame to the top of the heap when selected. */
unsigned auto_raise : 1;
/* Nonzero means that the pointer is invisible. */
unsigned pointer_invisible :1;
- /* If can_have_scroll_bars is non-zero, this is non-zero if we should
- actually display them on this frame. */
+ /* Nonzero if we should actually display the scroll bars on this frame. */
enum vertical_scroll_bar_type vertical_scroll_bar_type;
/* What kind of text cursor should we draw in the future?
#define FRAME_SCROLL_BOTTOM_VPOS(f) (f)->scroll_bottom_vpos
#define FRAME_FOCUS_FRAME(f) f->focus_frame
-/* Nonzero if frame F supports scroll bars.
- If this is zero, then it is impossible to enable scroll bars
- on frame F. */
-#define FRAME_CAN_HAVE_SCROLL_BARS(f) ((f)->can_have_scroll_bars)
-
/* This frame slot says whether scroll bars are currently enabled for frame F,
and which side they are on. */
#define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) ((f)->vertical_scroll_bar_type)
extern struct frame *last_nonminibuf_frame;
extern void set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
+extern struct frame *decode_live_frame (Lisp_Object);
+extern struct frame *decode_any_frame (Lisp_Object);
extern struct frame *make_initial_frame (void);
extern struct frame *make_frame (int);
#ifdef HAVE_WINDOW_SYSTEM
struct glyph_row *row;
ptrdiff_t textpos;
- if (NILP (window))
- window = selected_window;
- CHECK_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_any_window (window);
+ XSETWINDOW (window, w);
if (!NILP (pos))
{
{
*put_func = xpm_put_color_table_h;
*get_func = xpm_get_color_table_h;
- return make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+ return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ Qnil);
}
static void
else
hscroll = tab_offset = 0;
- if (NILP (window))
- window = Fselected_window ();
- else
- CHECK_LIVE_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_live_window (window);
if (XINT (from) < BEGV || XINT (from) > ZV)
args_out_of_range_3 (from, make_number (BEGV), make_number (ZV));
1))
: XINT (XCAR (topos))),
(NILP (width) ? -1 : XINT (width)),
- hscroll, tab_offset,
- XWINDOW (window));
+ hscroll, tab_offset, w);
XSETFASTINT (bufpos, pos->bufpos);
XSETINT (hpos, pos->hpos);
}
CHECK_NUMBER (lines);
- if (! NILP (window))
- CHECK_WINDOW (window);
- else
- window = selected_window;
- w = XWINDOW (window);
+ w = decode_live_window (window);
old_buffer = Qnil;
GCPRO3 (old_buffer, old_charpos, old_bytepos);
static KBOARD *
event_to_kboard (struct input_event *event)
{
- Lisp_Object frame;
- frame = event->frame_or_window;
- if (CONSP (frame))
- frame = XCAR (frame);
- else if (WINDOWP (frame))
- frame = WINDOW_FRAME (XWINDOW (frame));
-
- /* There are still some events that don't set this field.
- For now, just ignore the problem.
- Also ignore dead frames here. */
- if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
- return 0;
+ /* Not applicable for these special events. */
+ if (event->kind == SELECTION_REQUEST_EVENT
+ || event->kind == SELECTION_CLEAR_EVENT)
+ return NULL;
else
- return FRAME_KBOARD (XFRAME (frame));
+ {
+ Lisp_Object obj = event->frame_or_window;
+ /* There are some events that set this field to nil or string. */
+ if (WINDOWP (obj))
+ obj = WINDOW_FRAME (XWINDOW (obj));
+ /* Also ignore dead frames here. */
+ return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj)))
+ ? FRAME_KBOARD (XFRAME (obj)) : NULL);
+ }
}
#ifdef subprocesses
#elif defined USG || defined CYGWIN
/* Read some input if available, but don't wait. */
n_to_read = sizeof cbuf;
- fcntl (fileno (tty->input), F_SETFL, O_NDELAY);
+ fcntl (fileno (tty->input), F_SETFL, O_NONBLOCK);
#else
# error "Cannot read without possibly delaying"
#endif
}
while (
/* We used to retry the read if it was interrupted.
- But this does the wrong thing when O_NDELAY causes
+ But this does the wrong thing when O_NONBLOCK causes
an EAGAIN error. Does anybody know of a situation
where a retry is actually needed? */
#if 0
{
if (event == kbd_buffer + KBD_BUFFER_SIZE)
event = kbd_buffer;
+ /* These two special event types has no Lisp_Objects to mark. */
if (event->kind != SELECTION_REQUEST_EVENT
&& event->kind != SELECTION_CLEAR_EVENT)
{
mark_object (event->x);
mark_object (event->y);
+ mark_object (event->frame_or_window);
+ mark_object (event->arg);
}
- mark_object (event->frame_or_window);
- mark_object (event->arg);
}
}
}
#define GCTYPEBITS 3
GCTYPEBITS,
- /* 2**GCTYPEBITS. This must also be a macro that expands to a
- literal integer constant, for MSVC. */
- GCALIGNMENT =
+ /* 2**GCTYPEBITS. This must be a macro that expands to a literal
+ integer constant, for MSVC. */
#define GCALIGNMENT 8
- GCALIGNMENT,
/* Number of bits in a Lisp_Object value, not counting the tag. */
VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
PVEC_OTHER,
- /* These last 4 are special because we OR them in fns.c:internal_equal,
- so they have to use a disjoint bit pattern:
- if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE
- | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) */
- PVEC_COMPILED = 0x10,
- PVEC_CHAR_TABLE = 0x20,
- PVEC_SUB_CHAR_TABLE = 0x30,
- PVEC_FONT = 0x40
+ /* These should be last, check internal_equal to see why. */
+ PVEC_COMPILED,
+ PVEC_CHAR_TABLE,
+ PVEC_SUB_CHAR_TABLE,
+ PVEC_FONT /* Should be last because it's used for range checking. */
};
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
only the number of Lisp_Object fields (that need to be traced by GC).
The distinction is used, e.g., by Lisp_Process, which places extra
non-Lisp_Object fields at the end of the structure. */
- PSEUDOVECTOR_SIZE_BITS = 16,
+ PSEUDOVECTOR_SIZE_BITS = 12,
PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
- PVEC_TYPE_MASK = 0x0fff << PSEUDOVECTOR_SIZE_BITS,
+
+ /* To calculate the memory footprint of the pseudovector, it's useful
+ to store the size of non-Lisp area in word_size units here. */
+ PSEUDOVECTOR_REST_BITS = 12,
+ PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1)
+ << PSEUDOVECTOR_SIZE_BITS),
+
+ /* Used to extract pseudovector subtype information. */
+ PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
+ PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS,
/* Number of bits to put in each character in the internal representation
of bool vectors. This should not vary across implementations. */
For example, if tem is a Lisp_Object whose type is Lisp_Cons,
XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
-/* Return a perfect hash of the Lisp_Object representation. */
-#define XHASH(a) XLI (a)
-
#if USE_LSB_TAG
enum lsb_bits
#endif /* not USE_LSB_TAG */
+/* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be
+ like XUINT right now, but XUINT should only be applied to objects we know
+ are integers. */
+#define XHASH(a) XUINT (a)
+
/* For integers known to be positive, XFASTINT sometimes provides
faster retrieval and XSETFASTINT provides faster storage.
If not, fallback on the non-accelerated path. */
# define XUNTAG(a, type) XPNTR (a)
#endif
-#define EQ(x, y) (XHASH (x) == XHASH (y))
+#define EQ(x, y) (XLI (x) == XLI (y))
/* Largest and smallest representable fixnum values. These are the C
- values. They are macros for use in static initializers, and
- constants for visibility to GDB. */
-static EMACS_INT const MOST_POSITIVE_FIXNUM =
+ values. They are macros for use in static initializers. */
#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
- MOST_POSITIVE_FIXNUM;
-static EMACS_INT const MOST_NEGATIVE_FIXNUM =
#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
- MOST_NEGATIVE_FIXNUM;
/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
written this way so that it also works if I is of unsigned
/* Pseudovector types. */
-#define XSETPVECTYPE(v, code) XSETTYPED_PVECTYPE (v, header.size, code)
-#define XSETTYPED_PVECTYPE(v, size_member, code) \
- ((v)->size_member |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS))
-#define XSETPVECTYPESIZE(v, code, sizeval) \
+#define XSETPVECTYPE(v, code) \
+ ((v)->header.size |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))
+#define XSETPVECTYPESIZE(v, code, lispsize, restsize) \
((v)->header.size = (PSEUDOVECTOR_FLAG \
- | ((code) << PSEUDOVECTOR_SIZE_BITS) \
- | (sizeval)))
+ | ((code) << PSEUDOVECTOR_AREA_BITS) \
+ | ((restsize) << PSEUDOVECTOR_SIZE_BITS) \
+ | (lispsize)))
/* The cast to struct vectorlike_header * avoids aliasing issues. */
#define XSETPSEUDOVECTOR(a, b, code) \
#define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \
(XSETVECTOR (a, b), \
eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
- == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_SIZE_BITS))))
+ == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))))
#define XSETWINDOW_CONFIGURATION(a, b) \
(XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
-/* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header. */
-#define XSETSUBR(a, b) \
- XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR)
+#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
};
/* Header of vector-like objects. This documents the layout constraints on
- vectors and pseudovectors other than struct Lisp_Subr. It also prevents
+ vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents
compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR
and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *,
because when two such pointers potentially alias, a compiler won't
<http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
struct vectorlike_header
{
- /* This field contains various pieces of information:
+ /* The only field contains various pieces of information:
- The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
- The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
vector (0) or a pseudovector (1).
- If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number
of slots) of the vector.
- - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into
- a "pvec type" tag held in PVEC_TYPE_MASK and a size held in the lowest
- PSEUDOVECTOR_SIZE_BITS. That size normally indicates the number of
- Lisp_Object slots at the beginning of the object that need to be
- traced by the GC, tho some types use it slightly differently.
- - E.g. if the pvec type is PVEC_FREE it means this is an unallocated
- vector on a free-list and PSEUDOVECTOR_SIZE_BITS indicates its size
- in bytes. */
+ - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields:
+ - a) pseudovector subtype held in PVEC_TYPE_MASK field;
+ - b) number of Lisp_Objects slots at the beginning of the object
+ held in PSEUDOVECTOR_SIZE_MASK field. These objects are always
+ traced by the GC;
+ - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and
+ measured in word_size units. Rest fields may also include
+ Lisp_Objects, but these objects usually needs some special treatment
+ during GC.
+ There are some exceptions. For PVEC_FREE, b) is always zero. For
+ PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero.
+ Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
+ 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */
ptrdiff_t size;
-
- /* When the vector is allocated from a vector block, NBYTES is used
- if the vector is not on a free list, and VECTOR is used otherwise.
- For large vector-like objects, BUFFER or VECTOR is used as a pointer
- to the next vector-like object. It is generally a buffer or a
- Lisp_Vector alias, so for convenience it is a union instead of a
- pointer: this way, one can write P->next.vector instead of ((struct
- Lisp_Vector *) P->next). */
- union {
- /* This is only needed for small vectors that are not free because the
- `size' field only gives us the number of Lisp_Object slots, whereas we
- need to know the total size, including non-Lisp_Object data.
- FIXME: figure out a way to store this info elsewhere so we can
- finally get rid of this extra word of overhead. */
- ptrdiff_t nbytes;
- struct buffer *buffer;
- /* FIXME: This can be removed: For large vectors, this field could be
- placed *before* the vector itself. And for small vectors on a free
- list, this field could be stored in the vector's bytes, since the
- empty vector is handled specially anyway. */
- struct Lisp_Vector *vector;
- } next;
};
/* Regular vector is just a header plus array of Lisp_Objects. */
/* This structure describes a built-in function.
It is generated by the DEFUN macro only.
- defsubr makes it into a Lisp object.
-
- This type is treated in most respects as a pseudovector,
- but since we never dynamically allocate or free them,
- we don't need a struct vectorlike_header and its 'next' field. */
+ defsubr makes it into a Lisp object. */
struct Lisp_Subr
{
- ptrdiff_t size;
+ struct vectorlike_header header;
union {
Lisp_Object (*a0) (void);
Lisp_Object (*a1) (Lisp_Object);
/* The structure of a Lisp hash table. */
+struct hash_table_test
+{
+ /* Name of the function used to compare keys. */
+ Lisp_Object name;
+
+ /* User-supplied hash function, or nil. */
+ Lisp_Object user_hash_function;
+
+ /* User-supplied key comparison function, or nil. */
+ Lisp_Object user_cmp_function;
+
+ /* C function to compare two keys. */
+ bool (*cmpfn) (struct hash_table_test *t, Lisp_Object, Lisp_Object);
+
+ /* C function to compute hash code. */
+ EMACS_UINT (*hashfn) (struct hash_table_test *t, Lisp_Object);
+};
+
struct Lisp_Hash_Table
{
/* This is for Lisp; the hash table code does not refer to it. */
struct vectorlike_header header;
- /* Function used to compare keys. */
- Lisp_Object test;
-
/* Nil if table is non-weak. Otherwise a symbol describing the
weakness of the table. */
Lisp_Object weak;
hash table size to reduce collisions. */
Lisp_Object index;
- /* User-supplied hash function, or nil. */
- Lisp_Object user_hash_function;
-
- /* User-supplied key comparison function, or nil. */
- Lisp_Object user_cmp_function;
-
/* Only the fields above are traced normally by the GC. The ones below
`count' are special and are either ignored by the GC or traced in
a special way (e.g. because of weakness). */
This is gc_marked specially if the table is weak. */
Lisp_Object key_and_value;
+ /* The comparison and hash functions. */
+ struct hash_table_test test;
+
/* Next weak hash table if this is a weak hash table. The head
of the list is in weak_hash_tables. */
struct Lisp_Hash_Table *next_weak;
-
- /* C function to compare two keys. */
- bool (*cmpfn) (struct Lisp_Hash_Table *,
- Lisp_Object, EMACS_UINT,
- Lisp_Object, EMACS_UINT);
-
- /* C function to compute hash code. */
- EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
};
static double const DEFAULT_REHASH_SIZE = 1.5;
+/* Combine two integers X and Y for hashing. The result might not fit
+ into a Lisp integer. */
+
+LISP_INLINE EMACS_UINT
+sxhash_combine (EMACS_UINT x, EMACS_UINT y)
+{
+ return (x << 4) + (x >> (BITS_PER_EMACS_INT - 4)) + y;
+}
+
/* These structures are used for various misc types. */
struct Lisp_Misc_Any /* Supertype of all Misc types. */
#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
+#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x)))
+
#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
#define PSEUDOVECTOR_TYPEP(v, code) \
(((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
- == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS)))
+ == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))
/* True if object X, with internal type struct T *, is a pseudovector whose
code is CODE. */
#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
-/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */
-#define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR)
+#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
#define CHECK_WINDOW_CONFIGURATION(x) \
CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
-/* A window of any sort, leaf or interior, is "valid" if one of its
- buffer, vchild, or hchild members is non-nil. */
-#define CHECK_VALID_WINDOW(x) \
- CHECK_TYPE (WINDOWP (x) \
- && (!NILP (XWINDOW (x)->buffer) \
- || !NILP (XWINDOW (x)->vchild) \
- || !NILP (XWINDOW (x)->hchild)), \
- Qwindow_valid_p, x)
-
-/* A window is "live" if and only if it shows a buffer. */
-#define CHECK_LIVE_WINDOW(x) \
- CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), \
- Qwindow_live_p, x)
-
#define CHECK_PROCESS(x) \
CHECK_TYPE (PROCESSP (x), Qprocessp, x)
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
- { (PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS) \
- | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
+ { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \
+ | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \
{ (Lisp_Object (__cdecl *)(void))fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
- { PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS, \
- { .a ## maxargs = fnname }, \
+ { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
+ { .a ## maxargs = fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
#endif
EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
-/* Defined in frame.c. */
-extern Lisp_Object Qframep;
-
/* Defined in data.c. */
extern Lisp_Object indirect_function (Lisp_Object);
extern Lisp_Object find_symbol_value (Lisp_Object);
extern void sweep_weak_hash_tables (void);
extern Lisp_Object Qcursor_in_echo_area;
extern Lisp_Object Qstring_lessp;
-extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql;
+extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq;
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
-Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
+Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
+extern struct hash_table_test hashtest_eql, hashtest_equal;
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern Lisp_Object Qautomatic_gc;
extern Lisp_Object Qchar_table_extra_slots;
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
-extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag);
+extern struct Lisp_Vector *allocate_pseudovector (int, int, enum pvec_type);
#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
((typ*) \
allocate_pseudovector \
extern Lisp_Object restore_point_unwind (Lisp_Object);
extern _Noreturn void report_file_error (const char *, Lisp_Object);
extern void internal_delete_file (Lisp_Object);
+extern bool file_directory_p (const char *);
+extern bool file_accessible_directory_p (const char *);
extern void syms_of_fileio (void);
extern Lisp_Object make_temp_name (Lisp_Object, bool);
extern Lisp_Object Qdelete_file;
#if HAVE_NS
extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
#endif
-extern Lisp_Object frame_buffer_predicate (Lisp_Object);
extern void frames_discard_buffer (Lisp_Object);
extern void syms_of_frame (void);
If SUFFIXES is non-nil, it should be a list of suffixes to append to
file name when searching.
If non-nil, PREDICATE is used instead of `file-readable-p'.
-PREDICATE can also be an integer to pass to the access(2) function,
+PREDICATE can also be an integer to pass to the faccessat(2) function,
in which case file-name-handlers are ignored.
This function will normally skip directories, so if you want it to find
directories, make sure the PREDICATE function returns `dir-ok' for them. */)
int
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
{
- int fd;
ptrdiff_t fn_size = 100;
char buf[100];
char *fn = buf;
{
ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
Lisp_Object handler;
- bool exists;
/* Concatenate path element/specified name with the suffix.
If the directory starts with /:, remove that. */
handler = Ffind_file_name_handler (string, Qfile_exists_p);
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
+ bool exists;
if (NILP (predicate))
exists = !NILP (Ffile_readable_p (string));
else
}
else
{
-#ifndef WINDOWSNT
- struct stat st;
-#endif
+ int fd;
const char *pfn;
encoded_fn = ENCODE_FILE (string);
pfn = SSDATA (encoded_fn);
-#ifdef WINDOWSNT
- exists = access (pfn, F_OK) == 0 && access (pfn, D_OK) < 0;
-#else
- exists = (stat (pfn, &st) == 0 && ! S_ISDIR (st.st_mode));
-#endif
- if (exists)
- {
- /* Check that we can access or open it. */
- if (NATNUMP (predicate))
- fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
- && access (pfn, XFASTINT (predicate)) == 0)
- ? 1 : -1);
- else
- fd = emacs_open (pfn, O_RDONLY, 0);
- if (fd >= 0)
+ /* Check that we can access or open it. */
+ if (NATNUMP (predicate))
+ fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
+ && (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
+ AT_EACCESS)
+ == 0)
+ && ! file_directory_p (pfn))
+ ? 1 : -1);
+ else
+ {
+ struct stat st;
+ fd = emacs_open (pfn, O_RDONLY, 0);
+ if (0 <= fd
+ && (fstat (fd, &st) != 0 || S_ISDIR (st.st_mode)))
{
- /* We succeeded; return this descriptor and filename. */
- if (storeptr)
- *storeptr = string;
- UNGCPRO;
- return fd;
+ emacs_close (fd);
+ fd = -1;
}
}
+
+ if (fd >= 0)
+ {
+ /* We succeeded; return this descriptor and filename. */
+ if (storeptr)
+ *storeptr = string;
+ UNGCPRO;
+ return fd;
+ }
}
}
if (absolute)
{
Lisp_Object sym, tem;
sym = intern_c_string (sname->symbol_name);
- XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR);
+ XSETPVECTYPE (sname, PVEC_SUBR);
XSETSUBR (tem, sname);
set_symbol_function (sym, tem);
}
if (STRINGP (dirfile))
{
dirfile = Fdirectory_file_name (dirfile);
- if (access (SSDATA (dirfile), 0) < 0)
- dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
- XCAR (path_tail));
+ if (! file_accessible_directory_p (SSDATA (dirfile)))
+ dir_warning ("Lisp directory", XCAR (path_tail));
}
}
}
Lisp_Object tem, tem1;
/* Add to the path the lisp subdir of the installation
- dir, if it exists. Note: in out-of-tree builds,
+ dir, if it is accessible. Note: in out-of-tree builds,
this directory is empty save for Makefile. */
tem = Fexpand_file_name (build_string ("lisp"),
Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
+ tem1 = Ffile_accessible_directory_p (tem);
if (!NILP (tem1))
{
if (NILP (Fmember (tem, Vload_path)))
Lisp dirs instead. */
Vload_path = nconc2 (Vload_path, dump_path);
- /* Add leim under the installation dir, if it exists. */
+ /* Add leim under the installation dir, if it is accessible. */
tem = Fexpand_file_name (build_string ("leim"),
Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
+ tem1 = Ffile_accessible_directory_p (tem);
if (!NILP (tem1))
{
if (NILP (Fmember (tem, Vload_path)))
{
tem = Fexpand_file_name (build_string ("site-lisp"),
Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
+ tem1 = Ffile_accessible_directory_p (tem);
if (!NILP (tem1))
{
if (NILP (Fmember (tem, Vload_path)))
{
tem = Fexpand_file_name (build_string ("site-lisp"),
Vsource_directory);
- tem1 = Ffile_exists_p (tem);
+ tem1 = Ffile_accessible_directory_p (tem);
if (!NILP (tem1))
{
if (NILP (Fmember (tem, Vload_path)))
Vloads_in_progress = Qnil;
}
-/* Print a warning, using format string FORMAT, that directory DIRNAME
- does not exist. Print it on stderr and put it in *Messages*. */
+/* Print a warning that directory intended for use USE and with name
+ DIRNAME cannot be accessed. On entry, errno should correspond to
+ the access failure. Print the warning on stderr and put it in
+ *Messages*. */
void
-dir_warning (const char *format, Lisp_Object dirname)
+dir_warning (char const *use, Lisp_Object dirname)
{
- fprintf (stderr, format, SDATA (dirname));
+ static char const format[] = "Warning: %s `%s': %s\n";
+ int access_errno = errno;
+ fprintf (stderr, format, use, SSDATA (dirname), strerror (access_errno));
/* Don't log the warning before we've initialized!! */
if (initialized)
{
+ char const *diagnostic = emacs_strerror (access_errno);
USE_SAFE_ALLOCA;
- char *buffer = SAFE_ALLOCA (SBYTES (dirname)
- + strlen (format) - (sizeof "%s" - 1) + 1);
- ptrdiff_t message_len = esprintf (buffer, format, SDATA (dirname));
+ char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1)
+ + strlen (use) + SBYTES (dirname)
+ + strlen (diagnostic));
+ ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname),
+ diagnostic);
message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
SAFE_FREE ();
}
SYSTTY_H = $(SRC)/systty.h \
$(NT_INC)/sys/ioctl.h \
$(NT_INC)/unistd.h
+SYSWAIT_H = $(SRC)/syswait.h \
+ $(NT_INC)/sys/wait.h
TERMHOOKS_H = $(SRC)/termhooks.h \
$(SYSTIME_H)
W32FONT_H = $(SRC)/w32font.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/epaths.h \
- $(SRC)/syswait.h \
$(SRC)/w32.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
$(PROCESS_H) \
$(SYSSIGNAL_H) \
$(SYSTTY_H) \
+ $(SYSWAIT_H) \
$(TERMHOOKS_H)
$(BLD)/casefiddle.$(O) : \
$(SRC)/termchar.h \
$(SRC)/w32.h \
$(NT_INC)/unistd.h \
+ $(GNU_LIB)/fpending.h \
$(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(SRC)/w32select.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
+ $(GNU_LIB)/close-stream.h \
$(GNU_LIB)/ignore-value.h \
$(ATIMER_H) \
$(BUFFER_H) \
$(BLD)/w32proc.$(O) : \
$(SRC)/w32proc.c \
- $(SRC)/syswait.h \
$(SRC)/w32.h \
$(SRC)/w32common.h \
$(SRC)/w32heap.h \
$(PROCESS_H) \
$(SYSSIGNAL_H) \
$(SYSTIME_H) \
+ $(SYSWAIT_H) \
$(W32TERM_H)
$(BLD)/w32console.$(O) : \
$(SRC)/composite.h \
$(SRC)/gnutls.h \
$(SRC)/sysselect.h \
- $(SRC)/syswait.h \
$(SRC)/termopts.h \
$(NT_INC)/arpa/inet.h \
$(NT_INC)/netdb.h \
$(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(SYSTTY_H) \
+ $(SYSWAIT_H) \
$(TERMHOOKS_H) \
$(W32TERM_H) \
$(WINDOW_H)
$(SRC)/blockinput.h \
$(SRC)/cm.h \
$(SRC)/sysselect.h \
- $(SRC)/syswait.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
$(NT_INC)/netdb.h \
$(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(SYSTTY_H) \
+ $(SYSWAIT_H) \
$(TERMHOOKS_H) \
$(WINDOW_H)
$(SRC)/w32.h \
$(SRC)/w32common.h \
$(SRC)/w32heap.h \
- $(LISP_H) \
- $(CONFIG_H)
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/vm-limit.$(O) : \
$(SRC)/vm-limit.c \
$(SRC)/w32.h \
$(SRC)/w32common.h \
$(SRC)/w32heap.h \
+ $(NT_INC)/unistd.h \
$(BUFFER_H) \
$(CCL_H) \
$(CHARACTER_H) \
/*
* A few unimplemented functions that we silently ignore.
*/
-int setpgrp (void) {return 0; }
+pid_t tcgetpgrp (int fd) { return 0; }
+int setpgid (int pid, int pgid) { return 0; }
int setpriority (int x, int y, int z) { return 0; }
+pid_t setsid (void) { return 0; }
#if __DJGPP__ == 2 && __DJGPP_MINOR__ < 4
ssize_t
f = make_frame (1);
XSETFRAME (frame, f);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
f->terminal = dpyinfo->terminal;
#define NSFONT_TRACE 0
extern Lisp_Object Qns;
-extern Lisp_Object Qnormal, Qbold, Qitalic, Qcondensed, Qexpanded;
+extern Lisp_Object Qnormal, Qbold, Qitalic;
static Lisp_Object Qapple, Qroman, Qmedium;
+static Lisp_Object Qcondensed, Qexpanded;
extern Lisp_Object Qappend;
extern float ns_antialias_threshold;
extern int ns_tmp_flags;
make_number (100 + 100
* ns_attribute_fvalue (desc, NSFontSlantTrait)));*/
FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX,
- traits & NSFontCondensedTrait ? Qcondensed :
- traits & NSFontExpandedTrait ? Qexpanded : Qnormal);
+ traits & NSFontCondensedTrait ? Qcondensed :
+ traits & NSFontExpandedTrait ? Qexpanded : Qnormal);
/* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX,
make_number (100 + 100
* ns_attribute_fvalue (desc, NSFontWidthTrait)));*/
if (isMatch)
[fkeys removeObject: NSFontFamilyAttribute];
- matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys];
+ if ([fkeys count] > 0)
+ matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys];
+ else
+ matchingDescs = [NSMutableArray array];
+
if (NSFONT_TRACE)
NSLog(@"Got desc %@ and found %d matching fonts from it: ", fdesc,
[matchingDescs count]);
{
nsfont_driver.type = Qns;
register_font_driver (&nsfont_driver, NULL);
+ DEFSYM (Qcondensed, "condensed");
+ DEFSYM (Qexpanded, "expanded");
DEFSYM (Qapple, "apple");
DEFSYM (Qroman, "roman");
DEFSYM (Qmedium, "medium");
interpretation of even the system includes. */
#include <config.h>
+#include <fcntl.h>
#include <math.h>
+#include <pthread.h>
#include <sys/types.h>
#include <time.h>
#include <signal.h>
#include <c-strcase.h>
#include <ftoastr.h>
-#ifdef HAVE_FCNTL_H
-#include <fcntl.h>
-#endif
-
#include "lisp.h"
#include "blockinput.h"
#include "sysselect.h"
NSBeginFunctionKey, 0x58,
NSSelectFunctionKey, 0x60,
NSPrintFunctionKey, 0x61,
+ NSClearLineFunctionKey, 0x0B,
NSExecuteFunctionKey, 0x62,
NSInsertFunctionKey, 0x63,
NSUndoFunctionKey, 0x65,
NSNewlineCharacter, 0x0D,
NSEnterCharacter, 0x8D,
+ 0x41|NSNumericPadKeyMask, 0xAE, /* KP_Decimal */
+ 0x43|NSNumericPadKeyMask, 0xAA, /* KP_Multiply */
+ 0x45|NSNumericPadKeyMask, 0xAB, /* KP_Add */
+ 0x4B|NSNumericPadKeyMask, 0xAF, /* KP_Divide */
+ 0x4E|NSNumericPadKeyMask, 0xAD, /* KP_Subtract */
+ 0x51|NSNumericPadKeyMask, 0xBD, /* KP_Equal */
+ 0x52|NSNumericPadKeyMask, 0xB0, /* KP_0 */
+ 0x53|NSNumericPadKeyMask, 0xB1, /* KP_1 */
+ 0x54|NSNumericPadKeyMask, 0xB2, /* KP_2 */
+ 0x55|NSNumericPadKeyMask, 0xB3, /* KP_3 */
+ 0x56|NSNumericPadKeyMask, 0xB4, /* KP_4 */
+ 0x57|NSNumericPadKeyMask, 0xB5, /* KP_5 */
+ 0x58|NSNumericPadKeyMask, 0xB6, /* KP_6 */
+ 0x59|NSNumericPadKeyMask, 0xB7, /* KP_7 */
+ 0x5B|NSNumericPadKeyMask, 0xB8, /* KP_8 */
+ 0x5C|NSNumericPadKeyMask, 0xB9, /* KP_9 */
+
0x1B, 0x1B /* escape */
};
hold_event_q.q[hold_event_q.nr++] = *event;
/* Make sure ns_read_socket is called, i.e. we have input. */
- kill (0, SIGIO);
+ raise (SIGIO);
send_appdefined = YES;
}
if ([NSApp modalWindow] != nil)
return -1;
- if (hold_event_q.nr > 0)
+ if (hold_event_q.nr > 0)
{
int i;
for (i = 0; i < hold_event_q.nr; ++i)
/* Inform fd_handler that select should be called */
c = 'g';
- write (selfds[1], &c, 1);
+ emacs_write (selfds[1], &c, 1);
}
else if (nr == 0 && timeout)
{
if (nr > 0 && readfds)
{
c = 's';
- write (selfds[1], &c, 1);
+ emacs_write (selfds[1], &c, 1);
}
unblock_input ();
color_file = Fexpand_file_name (build_string ("rgb.txt"),
Fsymbol_value (intern ("data-directory")));
- if (NILP (Ffile_readable_p (color_file)))
- fatal ("Could not find %s.\n", SDATA (color_file));
color_map = Fx_load_color_file (color_file);
if (NILP (color_map))
FD_SET (selfds[0], &fds);
result = select (selfds[0]+1, &fds, NULL, NULL, NULL);
- if (result > 0)
- {
- read (selfds[0], &c, 1);
- if (c == 'g') waiting = 0;
- }
+ if (result > 0 && read (selfds[0], &c, 1) == 1 && c == 'g')
+ waiting = 0;
}
else
{
{
if (FD_ISSET (selfds[0], &readfds))
{
- read (selfds[0], &c, 1);
- if (c == 's') waiting = 1;
+ if (read (selfds[0], &c, 1) == 1 && c == 's')
+ waiting = 1;
}
else
{
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (emacsframe);
int code;
unsigned fnKeysym = 0;
- int flags;
static NSMutableArray *nsEvArray;
#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
static BOOL firstTime = YES;
#endif
int left_is_none;
+ unsigned int flags = [theEvent modifierFlags];
NSTRACE (keyDown);
/* (Carbon way: [theEvent keyCode]) */
/* is it a "function key"? */
- fnKeysym = ns_convert_key (code);
+ fnKeysym = (code < 0x00ff && (flags&NSNumericPadKeyMask))
+ ? ns_convert_key ([theEvent keyCode] | NSNumericPadKeyMask)
+ : ns_convert_key (code);
+
if (fnKeysym)
{
/* COUNTERHACK: map 'Delete' on upper-right main KB to 'Backspace',
/* are there modifiers? */
emacs_event->modifiers = 0;
- flags = [theEvent modifierFlags];
if (flags & NSHelpKeyMask)
emacs_event->modifiers |= hyper_modifier;
/* Events may come here even if the event loop is not running.
If we don't enter the event loop, the scroll bar will not update.
So send SIGIO to ourselves. */
- if (apploopnr == 0) kill (0, SIGIO);
+ if (apploopnr == 0) raise (SIGIO);
return self;
}
else
fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
!valid ? "INVALID" : "SOME",
- XHASH (arg));
+ XLI (arg));
}
\f
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
- /* Always print the size. */
+ /* Always print the size. */
len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
strout (buf, len, len, printcharfun);
- if (!NILP (h->test))
+ if (!NILP (h->test.name))
{
strout (" test ", -1, -1, printcharfun);
- print_object (h->test, printcharfun, escapeflag);
+ print_object (h->test.name, printcharfun, escapeflag);
}
if (!NILP (h->weak))
EMACS_TIME *, void *);
#endif
-#ifndef WNOHANG
-# undef waitpid
-# define waitpid(pid, status, options) wait (status)
-#endif
-#ifndef WUNTRACED
-# define WUNTRACED 0
-#endif
-
/* Work around GCC 4.7.0 bug with strict overflow checking; see
<http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
These lines can be removed once the GCC bug is fixed. */
#ifndef NON_BLOCKING_CONNECT
#ifdef HAVE_SELECT
#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
-#if defined (O_NONBLOCK) || defined (O_NDELAY)
#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
#define NON_BLOCKING_CONNECT
#endif /* EWOULDBLOCK || EINPROGRESS */
-#endif /* O_NONBLOCK || O_NDELAY */
#endif /* HAVE_GETPEERNAME || GNU_LINUX */
#endif /* HAVE_SELECT */
#endif /* NON_BLOCKING_CONNECT */
#define DATAGRAM_CONN_P(proc) (0)
#endif
-/* 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 void
pset_buffer (struct Lisp_Process *p, Lisp_Object val)
#ifdef PTY_OPEN
PTY_OPEN;
#else /* no PTY_OPEN */
- {
-# ifdef O_NONBLOCK
- fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
-# else
- fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
-# endif
- }
+ fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
#endif /* no PTY_OPEN */
if (fd >= 0)
#else
sprintf (pty_name, "/dev/tty%c%x", c, i);
#endif /* no PTY_TTY_NAME_SPRINTF */
- if (access (pty_name, 6) != 0)
+ if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
{
emacs_close (fd);
# ifndef __sgi
#ifdef SIGCHLD
/* Fdelete_process promises to immediately forget about the process, but in
reality, Emacs needs to remember those processes until they have been
- treated by the SIGCHLD handler; otherwise this handler would consider the
- process as being synchronous and say that the synchronous process is
- dead. */
+ treated by the SIGCHLD handler and waitpid has been invoked on them;
+ otherwise they might fill up the kernel's process table. */
static Lisp_Object deleted_pid_list;
#endif
int inchannel, outchannel;
pid_t pid;
int sv[2];
-#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+#ifndef WINDOWSNT
int wait_child_setup[2];
#endif
#ifdef SIGCHLD
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
-#ifdef O_NOCTTY
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
-#else
- forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
-#endif
if (forkin < 0)
report_file_error ("Opening pty", Qnil);
#else
forkin = sv[0];
}
-#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+#ifndef WINDOWSNT
{
int tem;
}
#endif
-#ifdef O_NONBLOCK
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (inchannel, F_SETFL, O_NDELAY);
- fcntl (outchannel, F_SETFL, O_NDELAY);
-#endif
-#endif
/* Record this as an active process, with its channels.
As a result, child_setup will close Emacs's side of the pipes. */
if (inchannel > max_process_desc)
max_process_desc = inchannel;
- /* Until we store the proper pid, enable the SIGCHLD handler
- to recognize an unknown pid as standing for this process.
- It is very important not to let this `marker' value stay
- in the table after this function has returned; if it does
- it might cause call-process to hang and subsequent asynchronous
- processes to get their return values scrambled. */
- XPROCESS (process)->pid = -1;
-
- /* This must be called after the above line because it may signal an
- error. */
+ /* This may signal an error. */
setup_process_coding_systems (process);
encoded_current_dir = ENCODE_FILE (current_dir);
/* Make the pty be the controlling terminal of the process. */
#ifdef HAVE_PTYS
/* First, disconnect its current controlling terminal. */
-#ifdef HAVE_SETSID
/* We tried doing setsid only if pty_flag, but it caused
process_set_signal to fail on SGI when using a pipe. */
setsid ();
ioctl (xforkin, TIOCSCTTY, 0);
#endif
}
-#else /* not HAVE_SETSID */
- /* It's very important to call setpgid here and no time
- afterwards. Otherwise, we lose our controlling tty which
- is set when we open the pty. */
- setpgid (0, 0);
-#endif /* not HAVE_SETSID */
#if defined (LDISC1)
if (pty_flag && xforkin >= 0)
{
ioctl (j, TIOCNOTTY, 0);
emacs_close (j);
}
-#ifndef USG
- /* In order to get a controlling terminal on some versions
- of BSD, it is necessary to put the process in pgrp 0
- before it opens the terminal. */
- setpgid (0, 0);
-#endif
}
#endif /* TIOCNOTTY */
#if !defined (DONT_REOPEN_PTY)
/*** There is a suggestion that this ought to be a
- conditional on TIOCSPGRP,
- or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
+ conditional on TIOCSPGRP, or !defined TIOCSCTTY.
Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
that system does seem to need this code, even though
- both HAVE_SETSID and TIOCSCTTY are defined. */
+ both TIOCSCTTY is defined. */
/* Now close the pty (if we had it open) and reopen it.
This makes the pty the controlling terminal of the subprocess. */
if (pty_flag)
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, encoded_current_dir);
#else /* not WINDOWSNT */
-#ifdef FD_CLOEXEC
emacs_close (wait_child_setup[0]);
-#endif
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, encoded_current_dir);
#endif /* not WINDOWSNT */
#endif
XPROCESS (process)->pid = pid;
+ if (0 <= pid)
+ XPROCESS (process)->alive = 1;
/* Stop blocking signals in the parent. */
#ifdef SIGCHLD
pset_tty_name (XPROCESS (process), lisp_pty_name);
-#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+#ifndef WINDOWSNT
/* Wait for child_setup to complete in case that vfork is
actually defined as fork. The descriptor wait_child_setup[1]
of a pipe is closed at the child side either by close-on-exec
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
-#ifdef O_NOCTTY
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
-#else
- int forkout = emacs_open (pty_name, O_RDWR, 0);
-#endif
if (forkout < 0)
report_file_error ("Opening pty", Qnil);
#if defined (DONT_REOPEN_PTY)
}
#endif /* HAVE_PTYS */
-#ifdef O_NONBLOCK
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (inchannel, F_SETFL, O_NDELAY);
- fcntl (outchannel, F_SETFL, O_NDELAY);
-#endif
-#endif
/* Record this as an active process, with its channels.
As a result, child_setup will close Emacs's side of the pipes. */
{
/* Don't support network sockets when non-blocking mode is
not available, since a blocked Emacs is not useful. */
-#if !defined (O_NONBLOCK) && !defined (O_NDELAY)
- error ("Network servers not supported");
-#else
is_server = 1;
if (TYPE_RANGED_INTEGERP (int, tem))
backlog = XINT (tem);
-#endif
}
/* Make QCaddress an alias for :local (server) or :remote (client). */
#ifdef NON_BLOCKING_CONNECT
if (is_non_blocking_client)
{
-#ifdef O_NONBLOCK
ret = fcntl (s, F_SETFL, O_NONBLOCK);
-#else
- ret = fcntl (s, F_SETFL, O_NDELAY);
-#endif
if (ret < 0)
{
xerrno = errno;
chan_process[inch] = proc;
-#ifdef O_NONBLOCK
fcntl (inch, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (inch, F_SETFL, O_NDELAY);
-#endif
-#endif
p = XPROCESS (proc);
chan_process[s] = proc;
-#ifdef O_NONBLOCK
fcntl (s, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (s, F_SETFL, O_NDELAY);
-#endif
-#endif
p = XPROCESS (proc);
if (EMACS_TIME_LT (timer_delay, timeout))
{
timeout = timer_delay;
- timeout_reduced_for_timers = 1;
+ timeout_reduced_for_timers = 1;
}
}
else
else if (nread == -1 && errno == EWOULDBLOCK)
;
#endif
- /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
- and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
-#ifdef O_NONBLOCK
- else if (nread == -1 && errno == EAGAIN)
- ;
-#else
-#ifdef O_NDELAY
else if (nread == -1 && errno == EAGAIN)
;
+#ifdef WINDOWSNT
+ /* FIXME: Is this special case still needed? */
/* Note that we cannot distinguish between no input
available now and a closed pipe.
With luck, a closed pipe will be accompanied by
subprocess termination and SIGCHLD. */
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
;
-#endif /* O_NDELAY */
-#endif /* O_NONBLOCK */
+#endif
#ifdef HAVE_PTYS
/* On some OSs with ptys, when the process on one end of
a pty exits, the other end gets an error reading with
buf = SSDATA (object);
}
- if (pty_max_bytes == 0)
- {
-#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
- pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON);
- if (pty_max_bytes < 0)
- pty_max_bytes = 250;
-#else
- pty_max_bytes = 250;
-#endif
- /* Deduct one, to leave space for the eof. */
- pty_max_bytes--;
- }
-
/* If there is already data in the write_queue, put the new data
in the back of queue. Otherwise, ignore it. */
if (!NILP (p->write_queue))
return process;
}
\f
-/* On receipt of a signal that a child status has changed, loop asking
- about children with changed statuses until the system says there
- are no more.
+/* If the status of the process DESIRED has changed, return true and
+ set *STATUS to its exit status; otherwise, return false.
+ If HAVE is nonnegative, assume that HAVE = waitpid (HAVE, STATUS, ...)
+ has already been invoked, and do not invoke waitpid again. */
+
+static bool
+process_status_retrieved (pid_t desired, pid_t have, int *status)
+{
+ if (have < 0)
+ {
+ /* Invoke waitpid only with a known process ID; do not invoke
+ waitpid with a nonpositive argument. Otherwise, Emacs might
+ reap an unwanted process by mistake. For example, invoking
+ waitpid (-1, ...) can mess up glib by reaping glib's subprocesses,
+ so that another thread running glib won't find them. */
+ do
+ have = waitpid (desired, status, WNOHANG | WUNTRACED);
+ while (have < 0 && errno == EINTR);
+ }
+
+ return have == desired;
+}
+
+/* If PID is nonnegative, the child process PID with wait status W has
+ changed its status; record this and return true.
+
+ If PID is negative, ignore W, and look for known child processes
+ of Emacs whose status have changed. For each one found, record its new
+ status.
All we do is change the status; we do not run sentinels or print
notifications. That is saved for the next time keyboard input is
** Malloc WARNING: This should never call malloc either directly or
indirectly; if it does, that is a bug */
-/* Record the changed status of the child process PID with wait status W. */
void
record_child_status_change (pid_t pid, int w)
{
#ifdef SIGCHLD
- Lisp_Object proc;
- struct Lisp_Process *p;
+
+ /* Record at most one child only if we already know one child that
+ has exited. */
+ bool record_at_most_one_child = 0 <= pid;
+
Lisp_Object tail;
/* Find the process that signaled us, and record its status. */
/* The process can have been deleted by Fdelete_process. */
for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
{
+ bool all_pids_are_fixnums
+ = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
+ && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
Lisp_Object xpid = XCAR (tail);
- if ((INTEGERP (xpid) && pid == XINT (xpid))
- || (FLOATP (xpid) && pid == XFLOAT_DATA (xpid)))
+ if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
{
- XSETCAR (tail, Qnil);
- return;
+ pid_t deleted_pid;
+ if (INTEGERP (xpid))
+ deleted_pid = XINT (xpid);
+ else
+ deleted_pid = XFLOAT_DATA (xpid);
+ if (process_status_retrieved (deleted_pid, pid, &w))
+ {
+ XSETCAR (tail, Qnil);
+ if (record_at_most_one_child)
+ return;
+ }
}
}
/* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
- p = 0;
for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
- proc = XCDR (XCAR (tail));
- p = XPROCESS (proc);
- if (EQ (p->type, Qreal) && p->pid == pid)
- break;
- p = 0;
- }
-
- /* Look for an asynchronous process whose pid hasn't been filled
- in yet. */
- if (! p)
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- proc = XCDR (XCAR (tail));
- p = XPROCESS (proc);
- if (p->pid == -1)
- break;
- p = 0;
- }
+ Lisp_Object proc = XCDR (XCAR (tail));
+ struct Lisp_Process *p = XPROCESS (proc);
+ if (p->alive && process_status_retrieved (p->pid, pid, &w))
+ {
+ /* Change the status of the process that was found. */
+ p->tick = ++process_tick;
+ p->raw_status = w;
+ p->raw_status_new = 1;
- /* Change the status of the process that was found. */
- if (p)
- {
- int clear_desc_flag = 0;
+ /* If process has terminated, stop waiting for its output. */
+ if (WIFSIGNALED (w) || WIFEXITED (w))
+ {
+ int clear_desc_flag = 0;
+ p->alive = 0;
+ if (p->infd >= 0)
+ clear_desc_flag = 1;
- p->tick = ++process_tick;
- p->raw_status = w;
- p->raw_status_new = 1;
+ /* clear_desc_flag avoids a compiler bug in Microsoft C. */
+ if (clear_desc_flag)
+ {
+ FD_CLR (p->infd, &input_wait_mask);
+ FD_CLR (p->infd, &non_keyboard_wait_mask);
+ }
+ }
- /* If process has terminated, stop waiting for its output. */
- if ((WIFSIGNALED (w) || WIFEXITED (w))
- && p->infd >= 0)
- clear_desc_flag = 1;
+ /* Tell wait_reading_process_output that it needs to wake up and
+ look around. */
+ if (input_available_clear_time)
+ *input_available_clear_time = make_emacs_time (0, 0);
- /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
- if (clear_desc_flag)
- {
- FD_CLR (p->infd, &input_wait_mask);
- FD_CLR (p->infd, &non_keyboard_wait_mask);
+ if (record_at_most_one_child)
+ return;
}
-
- /* Tell wait_reading_process_output that it needs to wake up and
- look around. */
- if (input_available_clear_time)
- *input_available_clear_time = make_emacs_time (0, 0);
}
- /* There was no asynchronous process found for that pid: we have
- a synchronous process. */
- else
+
+ if (0 <= pid)
{
+ /* The caller successfully waited for a pid but no asynchronous
+ process was found for it, so this is a synchronous process. */
+
synch_process_alive = 0;
/* Report the status of the synchronous process. */
#ifdef SIGCHLD
-/* On some systems, the SIGCHLD handler must return right away. If
- any more processes want to signal us, we will get another signal.
- Otherwise, loop around to use up all the processes that have
- something to tell us. */
-#if (defined WINDOWSNT \
- || (defined USG && !defined GNU_LINUX \
- && !(defined HPUX && defined WNOHANG)))
-enum { CAN_HANDLE_MULTIPLE_CHILDREN = 0 };
-#else
-enum { CAN_HANDLE_MULTIPLE_CHILDREN = 1 };
-#endif
-
static void
handle_child_signal (int sig)
{
- do
- {
- pid_t pid;
- int status;
-
- do
- pid = waitpid (-1, &status, WNOHANG | WUNTRACED);
- while (pid < 0 && errno == EINTR);
-
- /* PID == 0 means no processes found, PID == -1 means a real failure.
- Either way, we have done all our job. */
- if (pid <= 0)
- break;
-
- record_child_status_change (pid, status);
- }
- while (CAN_HANDLE_MULTIPLE_CHILDREN);
+ record_child_status_change (-1, 0);
}
static void
#ifdef HAVE_GETSOCKNAME
ADD_SUBFEATURE (QCservice, Qt);
#endif
-#if defined (O_NONBLOCK) || defined (O_NDELAY)
ADD_SUBFEATURE (QCserver, Qt);
-#endif
for (sopt = socket_options; sopt->name; sopt++)
subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
/* Flag to set coding-system of the process buffer from the
coding_system used to decode process output. */
unsigned int inherit_coding_system_flag : 1;
+ /* Whether the process is alive, i.e., can be waited for. Running
+ processes can be waited for, but exited and fake processes cannot. */
+ unsigned int alive : 1;
/* Record the process status in the raw form in which it comes from `wait'.
This is to avoid consing in a signal handler. The `raw_status_new'
flag indicates that `raw_status' contains a new status that still
typedef struct Lisp_Hash_Table log_t;
+static Lisp_Object Qprofiler_backtrace_equal;
+static struct hash_table_test hashtest_profiler;
+
static Lisp_Object
make_log (int heap_size, int max_stack_depth)
{
a special way. This is OK as long as the object is not exposed
to Elisp, i.e. until it is returned by *-profiler-log, after which
it can't be used any more. */
- Lisp_Object log = make_hash_table (Qequal, make_number (heap_size),
+ Lisp_Object log = make_hash_table (hashtest_profiler,
+ make_number (heap_size),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ Qnil);
struct Lisp_Hash_Table *h = XHASH_TABLE (log);
/* What is special about our hash-tables is that the keys are pre-filled
cpu_gc_count = saturated_add (cpu_gc_count, 1);
else
{
- Lisp_Object oquit;
- bool saved_pending_signals;
EMACS_INT count = 1;
#ifdef HAVE_ITIMERSPEC
if (profiler_timer_ok)
count += overruns;
}
#endif
- /* record_backtrace uses hash functions that call Fequal, which
- uses QUIT, which can call malloc, which can cause disaster in
- a signal handler. So inhibit QUIT. */
- oquit = Vinhibit_quit;
- saved_pending_signals = pending_signals;
- Vinhibit_quit = Qt;
- pending_signals = 0;
-
eassert (HASH_TABLE_P (cpu_log));
record_backtrace (XHASH_TABLE (cpu_log), count);
-
- Vinhibit_quit = oquit;
- pending_signals = saved_pending_signals;
}
}
record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM));
}
+DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0,
+ doc: /* Return non-nil if F1 and F2 come from the same source.
+Used to determine if different closures are just different instances of
+the same lambda expression, or are really unrelated function. */)
+ (Lisp_Object f1, Lisp_Object f2)
+{
+ bool res;
+ if (EQ (f1, f2))
+ res = true;
+ else if (COMPILEDP (f1) && COMPILEDP (f2))
+ res = EQ (AREF (f1, COMPILED_BYTECODE), AREF (f2, COMPILED_BYTECODE));
+ else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2))
+ && EQ (Qclosure, XCAR (f1))
+ && EQ (Qclosure, XCAR (f2)))
+ res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2)));
+ else
+ res = false;
+ return res ? Qt : Qnil;
+}
+
+static bool
+cmpfn_profiler (struct hash_table_test *t,
+ Lisp_Object bt1, Lisp_Object bt2)
+{
+ if (VECTORP (bt1) && VECTORP (bt2))
+ {
+ ptrdiff_t i, l = ASIZE (bt1);
+ if (l != ASIZE (bt2))
+ return false;
+ for (i = 0; i < l; i++)
+ if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i))))
+ return false;
+ return true;
+ }
+ else
+ return EQ (bt1, bt2);
+}
+
+static EMACS_UINT
+hashfn_profiler (struct hash_table_test *ht, Lisp_Object bt)
+{
+ if (VECTORP (bt))
+ {
+ EMACS_UINT hash = 0;
+ ptrdiff_t i, l = ASIZE (bt);
+ for (i = 0; i < l; i++)
+ {
+ Lisp_Object f = AREF (bt, i);
+ EMACS_UINT hash1
+ = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE))
+ : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f)))
+ ? XHASH (XCDR (XCDR (f))) : XHASH (f));
+ hash = sxhash_combine (hash, hash1);
+ }
+ return (hash & INTMASK);
+ }
+ else
+ return XHASH (bt);
+}
+
void
syms_of_profiler (void)
{
to make room for new entries. */);
profiler_log_size = 10000;
+ DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal");
+ {
+ struct hash_table_test test
+ = { Qprofiler_backtrace_equal, Qnil, Qnil,
+ cmpfn_profiler, hashfn_profiler };
+ hashtest_profiler = test;
+ }
+
+ defsubr (&Sfunction_equal);
+
#ifdef PROFILER_CPU_SUPPORT
profiler_cpu_running = NOT_RUNNING;
cpu_log = Qnil;
rather than at run-time, so that re_match can be reentrant.
*/
-/* AIX requires this to be the first thing in the file. */
+/* AIX requires this to be the first thing in the file. */
#if defined _AIX && !defined REGEX_MALLOC
#pragma alloca
#endif
{
while (1)
{
-#ifdef WINDOWSNT
- wait (0);
- break;
-#else /* not WINDOWSNT */
int status;
int wait_result = waitpid (pid, &status, 0);
if (wait_result < 0)
break;
}
-#endif /* not WINDOWSNT */
+ /* Note: the MS-Windows emulation of waitpid calls QUIT
+ internally. */
if (interruptible)
QUIT;
}
#if defined (SIGTSTP) && !defined (MSDOS)
{
- pid_t pgrp = EMACS_GETPGRP (0);
+ pid_t pgrp = getpgrp ();
EMACS_KILLPG (pgrp, SIGTSTP);
}
void
init_foreground_group (void)
{
- pid_t pgrp = EMACS_GETPGRP (0);
+ pid_t pgrp = getpgrp ();
inherited_pgroup = getpid () == pgrp ? 0 : pgrp;
}
#endif
#endif
-#ifdef F_SETFL
-#ifdef F_GETOWN /* F_SETFL does not imply existence of F_GETOWN */
+#ifdef F_GETOWN
if (interrupt_input)
{
old_fcntl_owner[fileno (tty_out->input)] =
#endif /* HAVE_GPM */
}
#endif /* F_GETOWN */
-#endif /* F_SETFL */
#ifdef _IOFBF
/* This symbol is defined on recent USG systems.
fsync (fileno (tty_out->output));
#endif
-#ifdef F_SETFL
-#ifdef F_SETOWN /* F_SETFL does not imply existence of F_SETOWN */
+#ifndef DOS_NT
+#ifdef F_SETOWN
if (interrupt_input)
{
reset_sigio (fileno (tty_out->input));
old_fcntl_owner[fileno (tty_out->input)]);
}
#endif /* F_SETOWN */
-#ifdef O_NDELAY
fcntl (fileno (tty_out->input), F_SETFL,
- fcntl (fileno (tty_out->input), F_GETFL, 0) & ~O_NDELAY);
+ fcntl (fileno (tty_out->input), F_GETFL, 0) & ~O_NONBLOCK);
#endif
-#endif /* F_SETFL */
if (tty_out->old_tty)
while (emacs_set_tty (fileno (tty_out->input),
int
serial_open (char *port)
{
- int fd = -1;
-
- fd = emacs_open ((char*) port,
- O_RDWR
-#ifdef O_NONBLOCK
- | O_NONBLOCK
-#else
- | O_NDELAY
-#endif
-#ifdef O_NOCTTY
- | O_NOCTTY
-#endif
- , 0);
+ int fd = emacs_open (port, O_RDWR | O_NOCTTY | O_NONBLOCK, 0);
if (fd < 0)
{
error ("Could not open %s: %s",
#endif /* not CDEL */
#endif /* not _POSIX_VDISABLE */
\f
-/* Get the number of characters queued for output. */
-
-/* EMACS_OUTQSIZE(FD, int *SIZE) stores the number of characters
- queued for output to the terminal FD in *SIZE, if FD is a tty.
- Returns -1 if there was an error (i.e. FD is not a tty), 0
- otherwise. */
-#ifdef TIOCOUTQ
-#define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TIOCOUTQ, (size)))
-#endif
-
-\f
-/* Manipulate a terminal's current process group. */
-
-/* EMACS_GETPGRP (arg) returns the process group of the process. */
-
-#if defined (GETPGRP_VOID)
-# define EMACS_GETPGRP(x) getpgrp()
-#else /* !GETPGRP_VOID */
-# define EMACS_GETPGRP(x) getpgrp(x)
-#endif /* !GETPGRP_VOID */
-\f
/* Manipulate a TTY's input/output processing parameters. */
/* struct emacs_tty is a structure used to hold the current tty
/* New redisplay, TTY faces by Gerd Moellmann <gerd@gnu.org>. */
#include <config.h>
-#include <stdio.h>
#include <errno.h>
+#include <fcntl.h>
+#include <stdio.h>
#include <sys/file.h>
#include <sys/time.h>
#include <unistd.h>
#include "xterm.h"
#endif
-#ifndef O_RDWR
-#define O_RDWR 2
-#endif
-
-#ifndef O_NOCTTY
-#define O_NOCTTY 0
-#endif
-
/* The name of the default console device. */
#ifdef WINDOWSNT
#define DEV_TTY "CONOUT$"
static int max_frame_cols;
-/* Non-zero if we have dropped our controlling tty and therefore
- should not open a frame on stdout. */
-static int no_controlling_tty;
-
\f
#ifdef HAVE_GPM
static void
dissociate_if_controlling_tty (int fd)
{
-#ifndef DOS_NT
pid_t pgid = tcgetpgrp (fd); /* If tcgetpgrp succeeds, fd is the ctty. */
- if (pgid != -1)
- {
-#if defined (USG5)
- setpgrp ();
- no_controlling_tty = 1;
-#elif defined (CYGWIN)
- setsid ();
- no_controlling_tty = 1;
-#else
-#ifdef TIOCNOTTY /* Try BSD ioctls. */
- sigset_t blocked;
- sigemptyset (&blocked);
- sigaddset (&blocked, SIGTTOU);
- pthread_sigmask (SIG_BLOCK, &blocked, 0);
- fd = emacs_open (DEV_TTY, O_RDWR, 0);
- if (fd != -1 && ioctl (fd, TIOCNOTTY, 0) != -1)
- {
- no_controlling_tty = 1;
- }
- if (fd != -1)
- emacs_close (fd);
- pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
-#else
-# error "Unknown system."
-#endif /* ! TIOCNOTTY */
-#endif /* ! USG */
- }
-#endif /* !DOS_NT */
+ if (0 <= pgid)
+ setsid ();
}
/* Create a termcap display on the tty device with the given name and
set_tty_hooks (terminal);
{
- int fd;
+ /* Open the terminal device. */
FILE *file;
-#ifdef O_IGNORE_CTTY
- if (!ctty)
- /* Open the terminal device. Don't recognize it as our
- controlling terminal, and don't make it the controlling tty
- if we don't have one at the moment. */
- fd = emacs_open (name, O_RDWR | O_IGNORE_CTTY | O_NOCTTY, 0);
- else
-#endif /* O_IGNORE_CTTY */
- /* Alas, O_IGNORE_CTTY is a GNU extension that seems to be only
- defined on Hurd. On other systems, we need to explicitly
- dissociate ourselves from the controlling tty when we want to
- open a frame on the same terminal. */
- fd = emacs_open (name, O_RDWR | O_NOCTTY, 0);
+ /* If !ctty, don't recognize it as our controlling terminal, and
+ don't make it the controlling tty if we don't have one now.
+
+ Alas, O_IGNORE_CTTY is a GNU extension that seems to be only
+ defined on Hurd. On other systems, we need to explicitly
+ dissociate ourselves from the controlling tty when we want to
+ open a frame on the same terminal. */
+ int flags = O_RDWR | O_NOCTTY | (ctty ? 0 : O_IGNORE_CTTY);
+ int fd = emacs_open (name, flags, 0);
tty->name = xstrdup (name);
terminal->name = xstrdup (name);
name);
}
-#ifndef O_IGNORE_CTTY
- if (!ctty)
+ if (!O_IGNORE_CTTY && !ctty)
dissociate_if_controlling_tty (fd);
-#endif
file = fdopen (fd, "w+");
tty->input = file;
FrameCols (tty) = FRAME_COLS (f);
tty->specified_window = FRAME_LINES (f);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
terminal->char_ins_del_ok = 1;
baud_rate = 19200;
Lisp_Object x, y;
Time timestamp;
- /* This is padding just to put the frame_or_window field
- past the size of struct selection_input_event. */
- int *padding[2];
-
- /* This field is copied into a vector while the event is in the queue,
- so that garbage collections won't kill it. */
- /* In a menu_bar_event, this is a cons cell whose car is the frame
- and whose cdr is the Lisp object that is the event's value. */
- /* This field is last so that struct selection_input_event
- does not overlap with it. */
+ /* This field is copied into a vector while the event is in
+ the queue, so that garbage collections won't kill it. */
Lisp_Object frame_or_window;
/* Additional event argument. This is used for TOOL_BAR_EVENTs and
int memory_below_frame; /* Terminal remembers lines scrolled
off bottom */
-#if 0 /* These are not used anywhere. */
- /* EMACS_INT baud_rate; */ /* Output speed in baud */
- int min_padding_speed; /* Speed below which no padding necessary. */
- int dont_calculate_costs; /* Nonzero means don't bother computing
- various cost tables; we won't use them. */
-#endif
-
-\f
/* Window-based redisplay interface for this device (0 for tty
devices). */
struct redisplay_interface *rif;
Otherwise, set *bar_window to Qnil, and *x and *y to the column and
row of the character cell the mouse is over.
- Set *time to the time the mouse was at the returned position.
-
- This should clear mouse_moved until the next motion
- event arrives. */
+ Set *time to the time the mouse was at the returned position. */
void (*mouse_position_hook) (struct frame **f, int,
Lisp_Object *bar_window,
enum scroll_bar_part *part,
Lisp_Object *y,
Time *);
- /* The window system handling code should set this if the mouse has
- moved since the last call to the mouse_position_hook. Calling that
- hook should clear this. */
- int mouse_moved;
-
/* When a frame's focus redirection is changed, this hook tells the
window system code to re-decide where to put the highlight. Under
X, this means that Emacs lies about where the focus is. */
The terminal device is represented by its integer identifier. */)
(Lisp_Object frame)
{
- struct terminal *t;
-
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
-
- t = FRAME_TERMINAL (XFRAME (frame));
+ struct terminal *t = FRAME_TERMINAL (decode_live_frame (frame));
if (!t)
return Qnil;
see if it succeeds. But I think that's too much to ask. */
/* MSVCRT's _access crashes with D_OK. */
- if (tmp && sys_access (tmp, D_OK) == 0)
+ if (tmp && faccessat (AT_FDCWD, tmp, D_OK, AT_EACCESS) == 0)
{
char * var = alloca (strlen (tmp) + 8);
sprintf (var, "TMPDIR=%s", tmp);
WNetAddConnection2 (&resource, NULL, NULL, CONNECT_INTERACTIVE);
}
-/* Shadow some MSVC runtime functions to map requests for long filenames
- to reasonable short names if necessary. This was originally added to
- permit running Emacs on NT 3.1 on a FAT partition, which doesn't support
- long file names. */
-
+/* Emulate faccessat(2). */
int
-sys_access (const char * path, int mode)
+faccessat (int dirfd, const char * path, int mode, int flags)
{
DWORD attributes;
+ if (dirfd != AT_FDCWD
+ && !(IS_DIRECTORY_SEP (path[0])
+ || IS_DEVICE_SEP (path[1])))
+ {
+ errno = EBADF;
+ return -1;
+ }
+
/* MSVCRT implementation of 'access' doesn't recognize D_OK, and its
newer versions blow up when passed D_OK. */
path = map_w32_filename (path, NULL);
to get the attributes of its target file. Note: any symlinks in
PATH elements other than the last one are transparently resolved
by GetFileAttributes below. */
- if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0)
+ if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0
+ && (flags & AT_SYMLINK_NOFOLLOW) == 0)
path = chase_symlinks (path);
if ((attributes = GetFileAttributes (path)) == -1)
}
return -1;
}
- if ((mode & X_OK) != 0 && !is_exec (path))
+ if ((mode & X_OK) != 0
+ && !(is_exec (path) || (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0))
{
errno = EACCES;
return -1;
return 0;
}
+/* Shadow some MSVC runtime functions to map requests for long filenames
+ to reasonable short names if necessary. This was originally added to
+ permit running Emacs on NT 3.1 on a FAT partition, which doesn't support
+ long file names. */
+
int
sys_chdir (const char * path)
{
{
int save_errno = errno;
p[0] = first_char[i];
- if (sys_access (template, 0) < 0)
+ if (faccessat (AT_FDCWD, template, F_OK, AT_EACCESS) < 0)
{
errno = save_errno;
return template;
{
/* Non-absolute FILENAME is understood as being relative to
LINKNAME's directory. We need to prepend that directory to
- FILENAME to get correct results from sys_access below, since
+ FILENAME to get correct results from faccessat below, since
otherwise it will interpret FILENAME relative to the
directory where the Emacs process runs. Note that
make-symbolic-link always makes sure LINKNAME is a fully
strncpy (tem, linkfn, p - linkfn);
tem[p - linkfn] = '\0';
strcat (tem, filename);
- dir_access = sys_access (tem, D_OK);
+ dir_access = faccessat (AT_FDCWD, tem, D_OK, AT_EACCESS);
}
else
- dir_access = sys_access (filename, D_OK);
+ dir_access = faccessat (AT_FDCWD, filename, D_OK, AT_EACCESS);
/* Since Windows distinguishes between symlinks to directories and
to files, we provide a kludgy feature: if FILENAME doesn't
check_errno ();
if (fd_info[s].flags & FILE_SOCKET)
{
- if (cmd == F_SETFL && options == O_NDELAY)
+ if (cmd == F_SETFL && options == O_NONBLOCK)
{
unsigned long nblock = 1;
int rc = pfn_ioctlsocket (SOCK_HANDLE (s), FIONBIO, &nblock);
#include <limits.h>
#include <errno.h>
#include <math.h>
+#include <fcntl.h>
+#include <unistd.h>
#include "lisp.h"
#include "w32term.h"
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
if (! FRAME_W32_P (f))
error ("Non-W32 frame used");
return f;
/* Return the Emacs frame-object corresponding to an w32 window.
It could be the frame's main window or an icon window. */
-/* This function can be called during GC, so use GC_xxx type test macros. */
-
struct frame *
x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
{
Lisp_Object tail, frame;
struct frame *f;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
continue;
static int
modifier_set (int vkey)
{
- if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
- return (GetKeyState (vkey) & 0x1);
+ /* Warning: The fact that VK_NUMLOCK is not treated as the other 2
+ toggle keys is not an omission! If you want to add it, you will
+ have to make changes in the default sub-case of the WM_KEYDOWN
+ switch, because if the NUMLOCK modifier is set, the code there
+ will directly convert any key that looks like an ASCII letter,
+ and also downcase those that look like upper-case ASCII. */
+ if (vkey == VK_CAPITAL)
+ {
+ if (NILP (Vw32_enable_caps_lock))
+ return 0;
+ else
+ return (GetKeyState (vkey) & 0x1);
+ }
+ if (vkey == VK_SCROLL)
+ {
+ if (NILP (Vw32_scroll_lock_modifier)
+ /* w32-scroll-lock-modifier can be any non-nil value that is
+ not one of the modifiers, in which case it shall be ignored. */
+ || !( EQ (Vw32_scroll_lock_modifier, Qhyper)
+ || EQ (Vw32_scroll_lock_modifier, Qsuper)
+ || EQ (Vw32_scroll_lock_modifier, Qmeta)
+ || EQ (Vw32_scroll_lock_modifier, Qalt)
+ || EQ (Vw32_scroll_lock_modifier, Qcontrol)
+ || EQ (Vw32_scroll_lock_modifier, Qshift)))
+ return 0;
+ else
+ return (GetKeyState (vkey) & 0x1);
+ }
+
if (!modifiers_recorded)
return (GetKeyState (vkey) & 0x8000);
XSETFRAME (frame, f);
- /* Note that Windows does support scroll bars. */
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
-
/* By default, make scrollbars the system standard width. */
FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
Finsert (1, &text);
set_buffer_internal_1 (old_buffer);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
record_unwind_protect (unwind_create_tip_frame, frame);
/* By setting the output method, we're essentially saying that
syms_of_w32uniscribe ();
}
+typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
+ PULONG);
+
+#define BACKTRACE_LIMIT_MAX 62
+
+int
+w32_backtrace (void **buffer, int limit)
+{
+ static CaptureStackBackTrace_proc s_pfn_CaptureStackBackTrace = NULL;
+ HMODULE hm_kernel32 = NULL;
+
+ if (!s_pfn_CaptureStackBackTrace)
+ {
+ hm_kernel32 = LoadLibrary ("Kernel32.dll");
+ s_pfn_CaptureStackBackTrace =
+ (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32,
+ "RtlCaptureStackBackTrace");
+ }
+ if (s_pfn_CaptureStackBackTrace)
+ return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit),
+ buffer, NULL);
+ return 0;
+}
+
void
emacs_abort (void)
{
button = MessageBox (NULL,
"A fatal error has occurred!\n\n"
"Would you like to attach a debugger?\n\n"
- "Select YES to debug, NO to abort Emacs"
+ "Select:\n"
+ "YES -- to debug Emacs, or\n"
+ "NO -- to abort Emacs and produce a backtrace\n"
+ " (emacs_backtrace.txt in current directory)."
#if __GNUC__
"\n\n(type \"gdb -p <emacs-PID>\" and\n"
"\"continue\" inside GDB before clicking YES.)"
exit (2); /* tell the compiler we will never return */
case IDNO:
default:
- abort ();
- break;
+ {
+ void *stack[BACKTRACE_LIMIT_MAX + 1];
+ int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1);
+
+ if (i)
+ {
+#ifdef CYGWIN
+ int stderr_fd = 2;
+#else
+ HANDLE errout = GetStdHandle (STD_ERROR_HANDLE);
+ int stderr_fd = -1;
+#endif
+ int errfile_fd = -1;
+ int j;
+
+#ifndef CYGWIN
+ if (errout && errout != INVALID_HANDLE_VALUE)
+ stderr_fd = _open_osfhandle ((intptr_t)errout, O_APPEND | O_BINARY);
+#endif
+ if (stderr_fd >= 0)
+ write (stderr_fd, "\r\nBacktrace:\r\n", 14);
+ errfile_fd = _open ("emacs_backtrace.txt", O_RDWR | O_CREAT | O_BINARY, S_IREAD | S_IWRITE);
+ if (errfile_fd >= 0)
+ {
+ lseek (errfile_fd, 0L, SEEK_END);
+ write (errfile_fd, "\r\nBacktrace:\r\n", 14);
+ }
+
+ for (j = 0; j < i; j++)
+ {
+ char buf[INT_BUFSIZE_BOUND (void *)];
+
+ /* stack[] gives the return addresses, whereas we want
+ the address of the call, so decrease each address
+ by approximate size of 1 CALL instruction. */
+ sprintf (buf, "0x%p\r\n", stack[j] - sizeof(void *));
+ if (stderr_fd >= 0)
+ write (stderr_fd, buf, strlen (buf));
+ if (errfile_fd >= 0)
+ write (errfile_fd, buf, strlen (buf));
+ }
+ if (i == BACKTRACE_LIMIT_MAX)
+ {
+ if (stderr_fd >= 0)
+ write (stderr_fd, "...\r\n", 5);
+ if (errfile_fd >= 0)
+ write (errfile_fd, "...\r\n", 5);
+ }
+ if (errfile_fd >= 0)
+ close (errfile_fd);
+ }
+ abort ();
+ break;
+ }
}
}
return (*set & (1U << signo)) != 0;
}
-int
-setpgrp (int pid, int gid)
+pid_t
+getpgrp (void)
{
- return 0;
+ return getpid ();
}
pid_t
-getpgrp (void)
+tcgetpgrp (int fd)
{
return getpid ();
}
return 0;
}
+pid_t
+setsid (void)
+{
+ return getpid ();
+}
+
/* Emulations of interval timers.
Limitations: only ITIMER_REAL and ITIMER_PROF are supported.
/* Child process management list. */
int child_proc_count = 0;
child_process child_procs[ MAX_CHILDREN ];
-child_process *dead_child = NULL;
static DWORD WINAPI reader_thread (void *arg);
if (cp->pid < 0)
cp->pid = -cp->pid;
- /* pid must fit in a Lisp_Int */
- cp->pid = cp->pid & INTMASK;
-
*pPid = cp->pid;
return TRUE;
delete_child (cp);
}
-/* Wait for any of our existing child processes to die
- When it does, close its handle
- Return the pid and fill in the status if non-NULL. */
+/* Wait for a child process specified by PID, or for any of our
+ existing child processes (if PID is nonpositive) to die. When it
+ does, close its handle. Return the pid of the process that died
+ and fill in STATUS if non-NULL. */
-int
-sys_wait (int *status)
+pid_t
+waitpid (pid_t pid, int *status, int options)
{
DWORD active, retval;
int nh;
- int pid;
child_process *cp, *cps[MAX_CHILDREN];
HANDLE wait_hnd[MAX_CHILDREN];
+ DWORD timeout_ms;
+ int dont_wait = (options & WNOHANG) != 0;
nh = 0;
- if (dead_child != NULL)
+ /* According to Posix:
+
+ PID = -1 means status is requested for any child process.
+
+ PID > 0 means status is requested for a single child process
+ whose pid is PID.
+
+ PID = 0 means status is requested for any child process whose
+ process group ID is equal to that of the calling process. But
+ since Windows has only a limited support for process groups (only
+ for console processes and only for the purposes of passing
+ Ctrl-BREAK signal to them), and since we have no documented way
+ of determining whether a given process belongs to our group, we
+ treat 0 as -1.
+
+ PID < -1 means status is requested for any child process whose
+ process group ID is equal to the absolute value of PID. Again,
+ since we don't support process groups, we treat that as -1. */
+ if (pid > 0)
{
- /* We want to wait for a specific child */
- wait_hnd[nh] = dead_child->procinfo.hProcess;
- cps[nh] = dead_child;
- if (!wait_hnd[nh]) emacs_abort ();
- nh++;
- active = 0;
- goto get_result;
+ int our_child = 0;
+
+ /* We are requested to wait for a specific child. */
+ for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
+ {
+ /* Some child_procs might be sockets; ignore them. Also
+ ignore subprocesses whose output is not yet completely
+ read. */
+ if (CHILD_ACTIVE (cp)
+ && cp->procinfo.hProcess
+ && cp->pid == pid)
+ {
+ our_child = 1;
+ break;
+ }
+ }
+ if (our_child)
+ {
+ if (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
+ {
+ wait_hnd[nh] = cp->procinfo.hProcess;
+ cps[nh] = cp;
+ nh++;
+ }
+ else if (dont_wait)
+ {
+ /* PID specifies our subprocess, but its status is not
+ yet available. */
+ return 0;
+ }
+ }
+ if (nh == 0)
+ {
+ /* No such child process, or nothing to wait for, so fail. */
+ errno = ECHILD;
+ return -1;
+ }
}
else
{
for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
- /* some child_procs might be sockets; ignore them */
- if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
- && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
- {
- wait_hnd[nh] = cp->procinfo.hProcess;
- cps[nh] = cp;
- nh++;
- }
+ {
+ if (CHILD_ACTIVE (cp)
+ && cp->procinfo.hProcess
+ && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
+ {
+ wait_hnd[nh] = cp->procinfo.hProcess;
+ cps[nh] = cp;
+ nh++;
+ }
+ }
+ if (nh == 0)
+ {
+ /* Nothing to wait on, so fail. */
+ errno = ECHILD;
+ return -1;
+ }
}
- if (nh == 0)
- {
- /* Nothing to wait on, so fail */
- errno = ECHILD;
- return -1;
- }
+ if (dont_wait)
+ timeout_ms = 0;
+ else
+ timeout_ms = 1000; /* check for quit about once a second. */
do
{
- /* Check for quit about once a second. */
QUIT;
- active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000);
+ active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
} while (active == WAIT_TIMEOUT);
if (active == WAIT_FAILED)
else
emacs_abort ();
-get_result:
if (!GetExitCodeProcess (wait_hnd[active], &retval))
{
DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
}
if (retval == STILL_ACTIVE)
{
- /* Should never happen */
+ /* Should never happen. */
DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
+ if (pid > 0 && dont_wait)
+ return 0;
errno = EINVAL;
return -1;
}
else
retval <<= 8;
+ if (pid > 0 && active != 0)
+ emacs_abort ();
cp = cps[active];
pid = cp->pid;
#ifdef FULL_DEBUG
DebPrint (("select calling SIGCHLD handler for pid %d\n",
cp->pid));
#endif
- dead_child = cp;
sig_handlers[SIGCHLD] (SIGCHLD);
- dead_child = NULL;
}
}
else if (fdindex[active] == -1)
static struct scroll_bar *
x_window_to_scroll_bar (Window window_id)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- Lisp_Object frame, bar, condemned;
-
- frame = XCAR (tail);
- /* All elements of Vframe_list should be frames. */
- if (! FRAMEP (frame))
- emacs_abort ();
+ Lisp_Object bar, condemned;
/* Scan this frame's scroll bar list for a scroll bar with the
right window ID. */
HWND hwnd;
SCROLLINFO si;
struct scroll_bar *bar
- = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil));
+ = XSCROLL_BAR (Fmake_vector (make_number (VECSIZE (struct scroll_bar)), Qnil));
Lisp_Object barobj;
block_input ();
struct scroll_bar {
- /* These fields are shared by all vectors. */
- EMACS_INT size_from_Lisp_Vector_struct;
- struct Lisp_Vector *next_from_Lisp_Vector_struct;
+ /* This field is shared by all vectors. */
+ struct vectorlike_header header;
/* The window we're a scroll bar for. */
Lisp_Object window;
Lisp_Object fringe_extended_p;
};
-/* The number of elements a vector holding a struct scroll_bar needs. */
-#define SCROLL_BAR_VEC_SIZE \
- ((sizeof (struct scroll_bar) \
- - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \
- / word_size)
-
/* Turning a lisp vector value into a pointer to a struct scroll_bar. */
#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec))
return XWINDOW (window);
}
-static struct window *
+struct window *
decode_any_window (register Lisp_Object window)
{
struct window *w;
return w;
}
+/* Build a frequently used 4-integer (X Y W H) list. */
+
+static Lisp_Object
+list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h)
+{
+ return list4 (make_number (x), make_number (y),
+ make_number (w), make_number (h));
+}
+
DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0,
doc: /* Return t if OBJECT is a window and nil otherwise. */)
(Lisp_Object object)
}
\f
/* Frames and windows. */
-DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
+DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 0, 1, 0,
doc: /* Return the frame that window WINDOW is on.
WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
If FRAME is omitted or nil, it defaults to the selected frame. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- return FRAME_MINIBUF_WINDOW (XFRAME (frame));
+ return FRAME_MINIBUF_WINDOW (decode_live_frame (frame));
}
DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p,
return decode_valid_window (window)->parent;
}
-DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 1, 1, 0,
+DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 0, 1, 0,
doc: /* Return the topmost child window of window WINDOW.
WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is a live window (live windows have no children).
horizontal combination. */)
(Lisp_Object window)
{
- CHECK_WINDOW (window);
return decode_valid_window (window)->vchild;
}
-DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 1, 1, 0,
+DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 0, 1, 0,
doc: /* Return the leftmost child window of window WINDOW.
WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is a live window (live windows have no children).
vertical combination. */)
(Lisp_Object window)
{
- CHECK_WINDOW (window);
return decode_valid_window (window)->hchild;
}
DEFUN ("window-combination-limit", Fwindow_combination_limit, Swindow_combination_limit, 1, 1, 0,
doc: /* Return combination limit of window WINDOW.
-If the return value is nil, child windows of WINDOW can be recombined
-with WINDOW's siblings. A return value of t means that child windows of
+If the return value is nil, child windows of WINDOW can be recombined with
+WINDOW's siblings. A return value of t means that child windows of
WINDOW are never \(re-)combined with WINDOW's siblings.
WINDOW must be a valid window. The return value is meaningful for
internal windows only. */)
(Lisp_Object window)
{
- return decode_valid_window (window)->combination_limit;
+ CHECK_VALID_WINDOW (window);
+ return XWINDOW (window)->combination_limit;
}
DEFUN ("set-window-combination-limit", Fset_window_combination_limit, Sset_window_combination_limit, 2, 2, 0,
exclude partially-visible lines, use `window-text-height'. */)
(Lisp_Object window)
{
- struct window *w = decode_live_window (window);
- return make_number (window_body_lines (w));
+ return make_number (window_body_lines (decode_live_window (window)));
}
DEFUN ("window-body-width", Fwindow_body_width, Swindow_body_width, 0, 1, 0,
expressed as an integer multiple of the default character width. */)
(Lisp_Object window)
{
- struct window *w = decode_live_window (window);
- return make_number (window_body_cols (w));
+ return make_number (window_body_cols (decode_live_window (window)));
}
DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0,
window so that the location of point moves off-window. */)
(Lisp_Object window, Lisp_Object ncol)
{
- struct window *w = decode_live_window (window);
-
CHECK_NUMBER (ncol);
- return set_window_hscroll (w, XINT (ncol));
+ return set_window_hscroll (decode_live_window (window), XINT (ncol));
}
DEFUN ("window-redisplay-end-trigger", Fwindow_redisplay_end_trigger,
{
register struct window *w = decode_valid_window (window);
- return Fcons (make_number (WINDOW_LEFT_EDGE_COL (w)),
- Fcons (make_number (WINDOW_TOP_EDGE_LINE (w)),
- Fcons (make_number (WINDOW_RIGHT_EDGE_COL (w)),
- Fcons (make_number (WINDOW_BOTTOM_EDGE_LINE (w)),
- Qnil))));
+ return list4i (WINDOW_LEFT_EDGE_COL (w), WINDOW_TOP_EDGE_LINE (w),
+ WINDOW_RIGHT_EDGE_COL (w), WINDOW_BOTTOM_EDGE_LINE (w));
}
DEFUN ("window-pixel-edges", Fwindow_pixel_edges, Swindow_pixel_edges, 0, 1, 0,
{
register struct window *w = decode_valid_window (window);
- return Fcons (make_number (WINDOW_LEFT_EDGE_X (w)),
- Fcons (make_number (WINDOW_TOP_EDGE_Y (w)),
- Fcons (make_number (WINDOW_RIGHT_EDGE_X (w)),
- Fcons (make_number (WINDOW_BOTTOM_EDGE_Y (w)),
- Qnil))));
+ return list4i (WINDOW_LEFT_EDGE_X (w), WINDOW_TOP_EDGE_Y (w),
+ WINDOW_RIGHT_EDGE_X (w), WINDOW_BOTTOM_EDGE_Y (w));
}
static void
{
register struct window *w = decode_valid_window (window);
int add_x, add_y;
+
calc_absolute_offset (w, &add_x, &add_y);
- return Fcons (make_number (WINDOW_LEFT_EDGE_X (w) + add_x),
- Fcons (make_number (WINDOW_TOP_EDGE_Y (w) + add_y),
- Fcons (make_number (WINDOW_RIGHT_EDGE_X (w) + add_x),
- Fcons (make_number (WINDOW_BOTTOM_EDGE_Y (w) + add_y),
- Qnil))));
+ return list4i (WINDOW_LEFT_EDGE_X (w) + add_x,
+ WINDOW_TOP_EDGE_Y (w) + add_y,
+ WINDOW_RIGHT_EDGE_X (w) + add_x,
+ WINDOW_BOTTOM_EDGE_Y (w) + add_y);
}
DEFUN ("window-inside-edges", Fwindow_inside_edges, Swindow_inside_edges, 0, 1, 0,
{
register struct window *w = decode_live_window (window);
- return list4 (make_number (WINDOW_BOX_LEFT_EDGE_COL (w)
- + WINDOW_LEFT_MARGIN_COLS (w)
- + WINDOW_LEFT_FRINGE_COLS (w)),
- make_number (WINDOW_TOP_EDGE_LINE (w)
- + WINDOW_HEADER_LINE_LINES (w)),
- make_number (WINDOW_BOX_RIGHT_EDGE_COL (w)
- - WINDOW_RIGHT_MARGIN_COLS (w)
- - WINDOW_RIGHT_FRINGE_COLS (w)),
- make_number (WINDOW_BOTTOM_EDGE_LINE (w)
- - WINDOW_MODE_LINE_LINES (w)));
+ return list4i ((WINDOW_BOX_LEFT_EDGE_COL (w)
+ + WINDOW_LEFT_MARGIN_COLS (w)
+ + WINDOW_LEFT_FRINGE_COLS (w)),
+ (WINDOW_TOP_EDGE_LINE (w)
+ + WINDOW_HEADER_LINE_LINES (w)),
+ (WINDOW_BOX_RIGHT_EDGE_COL (w)
+ - WINDOW_RIGHT_MARGIN_COLS (w)
+ - WINDOW_RIGHT_FRINGE_COLS (w)),
+ (WINDOW_BOTTOM_EDGE_LINE (w)
+ - WINDOW_MODE_LINE_LINES (w)));
}
DEFUN ("window-inside-pixel-edges", Fwindow_inside_pixel_edges, Swindow_inside_pixel_edges, 0, 1, 0,
{
register struct window *w = decode_live_window (window);
- return list4 (make_number (WINDOW_BOX_LEFT_EDGE_X (w)
- + WINDOW_LEFT_MARGIN_WIDTH (w)
- + WINDOW_LEFT_FRINGE_WIDTH (w)),
- make_number (WINDOW_TOP_EDGE_Y (w)
- + WINDOW_HEADER_LINE_HEIGHT (w)),
- make_number (WINDOW_BOX_RIGHT_EDGE_X (w)
- - WINDOW_RIGHT_MARGIN_WIDTH (w)
- - WINDOW_RIGHT_FRINGE_WIDTH (w)),
- make_number (WINDOW_BOTTOM_EDGE_Y (w)
- - WINDOW_MODE_LINE_HEIGHT (w)));
+ return list4i ((WINDOW_BOX_LEFT_EDGE_X (w)
+ + WINDOW_LEFT_MARGIN_WIDTH (w)
+ + WINDOW_LEFT_FRINGE_WIDTH (w)),
+ (WINDOW_TOP_EDGE_Y (w)
+ + WINDOW_HEADER_LINE_HEIGHT (w)),
+ (WINDOW_BOX_RIGHT_EDGE_X (w)
+ - WINDOW_RIGHT_MARGIN_WIDTH (w)
+ - WINDOW_RIGHT_FRINGE_WIDTH (w)),
+ (WINDOW_BOTTOM_EDGE_Y (w)
+ - WINDOW_MODE_LINE_HEIGHT (w)));
}
DEFUN ("window-inside-absolute-pixel-edges",
{
register struct window *w = decode_live_window (window);
int add_x, add_y;
+
calc_absolute_offset (w, &add_x, &add_y);
- return list4 (make_number (WINDOW_BOX_LEFT_EDGE_X (w)
- + WINDOW_LEFT_MARGIN_WIDTH (w)
- + WINDOW_LEFT_FRINGE_WIDTH (w) + add_x),
- make_number (WINDOW_TOP_EDGE_Y (w)
- + WINDOW_HEADER_LINE_HEIGHT (w) + add_y),
- make_number (WINDOW_BOX_RIGHT_EDGE_X (w)
- - WINDOW_RIGHT_MARGIN_WIDTH (w)
- - WINDOW_RIGHT_FRINGE_WIDTH (w) + add_x),
- make_number (WINDOW_BOTTOM_EDGE_Y (w)
- - WINDOW_MODE_LINE_HEIGHT (w) + add_y));
+ return list4i ((WINDOW_BOX_LEFT_EDGE_X (w)
+ + WINDOW_LEFT_MARGIN_WIDTH (w)
+ + WINDOW_LEFT_FRINGE_WIDTH (w) + add_x),
+ (WINDOW_TOP_EDGE_Y (w)
+ + WINDOW_HEADER_LINE_HEIGHT (w) + add_y),
+ (WINDOW_BOX_RIGHT_EDGE_X (w)
+ - WINDOW_RIGHT_MARGIN_WIDTH (w)
+ - WINDOW_RIGHT_FRINGE_WIDTH (w) + add_x),
+ (WINDOW_BOTTOM_EDGE_Y (w)
+ - WINDOW_MODE_LINE_HEIGHT (w) + add_y));
}
/* Test if the character at column X, row Y is within window W.
column 0. */)
(Lisp_Object x, Lisp_Object y, Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_live_frame (frame);
/* Check that arguments are integers or floats. */
CHECK_NUMBER_OR_FLOAT (x);
{
Lisp_Object part = Qnil;
if (!fully_p)
- part = list4 (make_number (rtop), make_number (rbot),
- make_number (rowh), make_number (vpos));
+ part = list4i (rtop, rbot, rowh, vpos);
in_window = Fcons (make_number (x),
Fcons (make_number (y), part));
}
if (!WINDOW_WANTS_HEADER_LINE_P (w))
return Qnil;
row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
- if (!row->enabled_p)
- return Qnil;
- return list4 (make_number (row->height),
- make_number (0), make_number (0),
- make_number (0));
+ return row->enabled_p ? list4i (row->height, 0, 0, 0) : Qnil;
}
if (EQ (line, Qmode_line))
{
row = MATRIX_MODE_LINE_ROW (w->current_matrix);
- if (!row->enabled_p)
- return Qnil;
- return list4 (make_number (row->height),
- make_number (0), /* not accurate */
- make_number (WINDOW_HEADER_LINE_HEIGHT (w)
- + window_text_bottom_y (w)),
- make_number (0));
+ return (row->enabled_p ?
+ list4i (row->height,
+ 0, /* not accurate */
+ (WINDOW_HEADER_LINE_HEIGHT (w)
+ + window_text_bottom_y (w)),
+ 0)
+ : Qnil);
}
CHECK_NUMBER (line);
found_row:
crop = max (0, (row->y + row->height) - max_y);
- return list4 (make_number (row->height + min (0, row->y) - crop),
- make_number (i),
- make_number (row->y),
- make_number (crop));
+ return list4i (row->height + min (0, row->y) - crop, i, row->y, crop);
}
DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p,
{
if (!CONSP (Vwindow_list))
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
Vwindow_list = Qnil;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
Lisp_Object args[2];
new windows at the front of args[1], which means we
have to reverse this list at the end. */
args[1] = Qnil;
- foreach_window (XFRAME (XCAR (tail)), add_window_to_list, &args[1]);
+ foreach_window (XFRAME (frame), add_window_to_list, &args[1]);
args[0] = Vwindow_list;
args[1] = Fnreverse (args[1]);
Vwindow_list = Fnconc (2, args);
static void
decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object *all_frames)
{
- if (NILP (*window))
- *window = selected_window;
- else
- CHECK_LIVE_WINDOW (*window);
+ struct window *w = decode_live_window (*window);
+ XSETWINDOW (*window, w);
/* MINIBUF nil may or may not include minibuffers. Decide if it
does. */
if (NILP (*minibuf))
if (NILP (*all_frames))
*all_frames
= (!EQ (*minibuf, Qlambda)
- ? FRAME_MINIBUF_WINDOW (XFRAME (XWINDOW (*window)->frame))
+ ? FRAME_MINIBUF_WINDOW (XFRAME (w->frame))
: Qnil);
else if (EQ (*all_frames, Qvisible))
;
}
DEFUN ("run-window-configuration-change-hook", Frun_window_configuration_change_hook,
- Srun_window_configuration_change_hook, 1, 1, 0,
- doc: /* Run `window-configuration-change-hook' for FRAME. */)
+ Srun_window_configuration_change_hook, 0, 1, 0,
+ doc: /* Run `window-configuration-change-hook' for FRAME.
+If FRAME is omitted or nil, it defaults to the selected frame. */)
(Lisp_Object frame)
{
- CHECK_LIVE_FRAME (frame);
- run_window_configuration_change_hook (XFRAME (frame));
+ run_window_configuration_change_hook (decode_live_frame (frame));
return Qnil;
}
}
-DEFUN ("window-resize-apply", Fwindow_resize_apply, Swindow_resize_apply, 1, 2, 0,
+DEFUN ("window-resize-apply", Fwindow_resize_apply, Swindow_resize_apply, 0, 2, 0,
doc: /* Apply requested size values for window-tree of FRAME.
-Optional argument HORIZONTAL omitted or nil means apply requested height
-values. HORIZONTAL non-nil means apply requested width values.
+If FRAME is omitted or nil, it defaults to the selected frame.
+
+Optional argument HORIZONTAL omitted or nil means apply requested
+height values. HORIZONTAL non-nil means apply requested width values.
This function checks whether the requested values sum up to a valid
window layout, recursively assigns the new sizes of all child windows
be applied on the Elisp level. */)
(Lisp_Object frame, Lisp_Object horizontal)
{
- struct frame *f;
- struct window *r;
+ struct frame *f = decode_live_frame (frame);
+ struct window *r = XWINDOW (FRAME_ROOT_WINDOW (f));
int horflag = !NILP (horizontal);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
-
- f = XFRAME (frame);
- r = XWINDOW (FRAME_ROOT_WINDOW (f));
-
if (!window_resize_check (r, horflag)
|| ! EQ (r->new_total,
(horflag ? r->total_cols : r->total_lines)))
register int n_windows;
register struct save_window_data *data;
register int i;
- FRAME_PTR f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_live_frame (frame);
n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f)));
data = ALLOCATE_PSEUDOVECTOR (struct save_window_data, frame_cols,
{
struct window *w = decode_live_window (window);
- return Fcons (make_number (WINDOW_LEFT_FRINGE_WIDTH (w)),
- Fcons (make_number (WINDOW_RIGHT_FRINGE_WIDTH (w)),
- Fcons ((WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
- ? Qt : Qnil), Qnil)));
+ return list3 (make_number (WINDOW_LEFT_FRINGE_WIDTH (w)),
+ make_number (WINDOW_RIGHT_FRINGE_WIDTH (w)),
+ WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) ? Qt : Qnil);
}
(Lisp_Object window)
{
struct window *w = decode_live_window (window);
- return Fcons (make_number ((WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
+
+ return list4 (make_number ((WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
? WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
: WINDOW_SCROLL_BAR_AREA_WIDTH (w))),
- Fcons (make_number (WINDOW_SCROLL_BAR_COLS (w)),
- Fcons (w->vertical_scroll_bar_type,
- Fcons (Qnil, Qnil))));
+ make_number (WINDOW_SCROLL_BAR_COLS (w)),
+ w->vertical_scroll_bar_type, Qnil);
}
|| !NILP (XWINDOW (WINDOW)->vchild) \
|| !NILP (XWINDOW (WINDOW)->hchild)))
+/* A window of any sort, leaf or interior, is "valid" if one
+ of its buffer, vchild, or hchild members is non-nil. */
+#define CHECK_VALID_WINDOW(WINDOW) \
+ CHECK_TYPE (WINDOW_VALID_P (WINDOW), Qwindow_valid_p, WINDOW)
/* Value is non-zero if WINDOW is a live window. */
#define WINDOW_LIVE_P(WINDOW) \
(WINDOWP (WINDOW) && !NILP (XWINDOW (WINDOW)->buffer))
+/* A window is "live" if and only if it shows a buffer. */
+#define CHECK_LIVE_WINDOW(WINDOW) \
+ CHECK_TYPE (WINDOW_LIVE_P (WINDOW), Qwindow_live_p, WINDOW)
+
/* These used to be in lisp.h. */
extern Lisp_Object Qwindowp, Qwindow_live_p;
extern Lisp_Object Vwindow_list;
extern struct window *decode_live_window (Lisp_Object);
+extern struct window *decode_any_window (Lisp_Object);
extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
extern void mark_window_cursors_off (struct window *);
extern int window_internal_height (struct window *);
{
if (f->resized_p)
{
- Fredraw_frame (frame);
+ redraw_frame (f);
f->force_flush_display_p = 1;
}
clear_current_matrices (f);
#endif /* HAVE_WINDOW_SYSTEM */
/* Redraw garbaged frames. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
if (!NILP (echo_area_buffer[0]) || minibuf_level == 0)
{
|| f->explicit_name)
{
/* Do we have more than one visible frame on this X display? */
- Lisp_Object tail;
- Lisp_Object fmt;
+ Lisp_Object tail, other_frame, fmt;
ptrdiff_t title_start;
char *title;
ptrdiff_t len;
struct it it;
ptrdiff_t count = SPECPDL_INDEX ();
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, other_frame)
{
- Lisp_Object other_frame = XCAR (tail);
struct frame *tf = XFRAME (other_frame);
if (tf != f
DEFUN ("tool-bar-lines-needed", Ftool_bar_lines_needed, Stool_bar_lines_needed,
0, 1, 0,
- doc: /* Return the number of lines occupied by the tool bar of FRAME. */)
+ doc: /* Return the number of lines occupied by the tool bar of FRAME.
+If FRAME is nil or omitted, use the selected frame. */)
(Lisp_Object frame)
{
- struct frame *f;
+ struct frame *f = decode_any_frame (frame);
struct window *w;
int nlines = 0;
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
if (WINDOWP (f->tool_bar_window)
&& (w = XWINDOW (f->tool_bar_window),
WINDOW_TOTAL_LINES (w) > 0))
}
/* Clear frames marked as garbaged. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
/* Build menubar and tool-bar items. */
if (NILP (Vmemory_full))
/* If window configuration was changed, frames may have been
marked garbaged. Clear them or we will experience
surprises wrt scrolling. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
}
}
else if (EQ (selected_window, minibuf_window)
/* If window configuration was changed, frames may have been
marked garbaged. Clear them or we will experience
surprises wrt scrolling. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
}
Lisp_Object str;
int string_start = 0;
- if (NILP (window))
- window = selected_window;
- CHECK_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_any_window (window);
+ XSETWINDOW (window, w);
if (NILP (buffer))
buffer = w->buffer;
and set that to nil so that we don't alter the outer value. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (XFRAME (WINDOW_FRAME (XWINDOW (window))),
+ (XFRAME (WINDOW_FRAME (w)),
old_buffer, selected_window, 1));
mode_line_proptrans_alist = Qnil;
delay = make_emacs_time (DEFAULT_HOURGLASS_DELAY, 0);
#ifdef HAVE_NTGUI
- extern void w32_note_current_window (void);
- w32_note_current_window ();
+ {
+ extern void w32_note_current_window (void);
+ w32_note_current_window ();
+ }
#endif /* HAVE_NTGUI */
hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
Lisp_Object Qnormal;
Lisp_Object Qbold;
static Lisp_Object Qline, Qwave;
-static Lisp_Object Qultra_light, Qreverse_oblique, Qreverse_italic;
Lisp_Object Qextra_light, Qlight;
Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
Lisp_Object Qoblique;
Lisp_Object Qitalic;
-static Lisp_Object Qultra_condensed, Qextra_condensed;
-Lisp_Object Qcondensed;
-static Lisp_Object Qsemi_condensed, Qsemi_expanded, Qextra_expanded;
-Lisp_Object Qexpanded;
-static Lisp_Object Qultra_expanded;
static Lisp_Object Qreleased_button, Qpressed_button;
static Lisp_Object QCstyle, QCcolor, QCline_width;
Lisp_Object Qunspecified; /* used in dosfns.c */
}
#endif /* HAVE_NS */
-/* If FRAME is nil, return a pointer to the selected frame.
- Otherwise, check that FRAME is a live frame, and return a pointer
- to it. NPARAM is the parameter number of FRAME, for
- CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
- Lisp function definitions. */
-
-static struct frame *
-frame_or_selected_frame (Lisp_Object frame, int nparam)
-{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
- return XFRAME (frame);
-}
-
-\f
/***********************************************************************
Frames and faces
***********************************************************************/
If FRAME is nil or omitted, use the selected frame. */)
(Lisp_Object color, Lisp_Object frame)
{
- struct frame *f;
-
CHECK_STRING (color);
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
- f = XFRAME (frame);
- return face_color_gray_p (f, SSDATA (color)) ? Qt : Qnil;
+ return (face_color_gray_p (decode_any_frame (frame), SSDATA (color))
+ ? Qt : Qnil);
}
COLOR must be a valid color name. */)
(Lisp_Object color, Lisp_Object frame, Lisp_Object background_p)
{
- struct frame *f;
-
CHECK_STRING (color);
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
- f = XFRAME (frame);
- if (face_color_supported_p (f, SSDATA (color), !NILP (background_p)))
- return Qt;
- return Qnil;
+ return (face_color_supported_p (decode_any_frame (frame),
+ SSDATA (color), !NILP (background_p))
+ ? Qt : Qnil);
}
/* We can't simply call check_x_frame because this function may be
called before any frame is created. */
- if (NILP (frame))
- frame = selected_frame;
- f = frame_or_selected_frame (frame, 2);
+ f = decode_live_frame (frame);
if (! FRAME_WINDOW_P (f))
{
/* Perhaps we have not yet created any frame. */
frame = Qnil;
face = Qnil;
}
+ else
+ XSETFRAME (frame, f);
/* Determine the width standard for comparison with the fonts we find. */
frames). If FRAME is omitted or nil, use the selected frame. */)
(Lisp_Object symbol, Lisp_Object keyword, Lisp_Object frame)
{
- Lisp_Object lface, value = Qnil;
+ struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
+ Lisp_Object lface = lface_from_face_name (f, symbol, 1), value = Qnil;
CHECK_SYMBOL (symbol);
CHECK_SYMBOL (keyword);
- if (EQ (frame, Qt))
- lface = lface_from_face_name (NULL, symbol, 1);
- else
- {
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- lface = lface_from_face_name (XFRAME (frame), symbol, 1);
- }
-
if (EQ (keyword, QCfamily))
value = LFACE_FAMILY (lface);
else if (EQ (keyword, QCfoundry))
}
else
{
- struct frame *f = frame_or_selected_frame (frame, 1);
+ struct frame *f = decode_live_frame (frame);
int face_id = lookup_named_face (f, face, 1);
struct face *fface = FACE_FROM_ID (f, face_id);
struct frame *f;
Lisp_Object lface1, lface2;
- if (EQ (frame, Qt))
- f = NULL;
- else
- /* Don't use check_x_frame here because this function is called
- before X frames exist. At that time, if FRAME is nil,
- selected_frame will be used which is the frame dumped with
- Emacs. That frame is not an X frame. */
- f = frame_or_selected_frame (frame, 2);
+ /* Don't use check_x_frame here because this function is called
+ before X frames exist. At that time, if FRAME is nil,
+ selected_frame will be used which is the frame dumped with
+ Emacs. That frame is not an X frame. */
+ f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
lface1 = lface_from_face_name (f, face1, 1);
lface2 = lface_from_face_name (f, face2, 1);
If FRAME is omitted or nil, use the selected frame. */)
(Lisp_Object face, Lisp_Object frame)
{
- struct frame *f;
- Lisp_Object lface;
+ struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
+ Lisp_Object lface = lface_from_face_name (f, face, 1);
int i;
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
- if (EQ (frame, Qt))
- lface = lface_from_face_name (NULL, face, 1);
- else
- lface = lface_from_face_name (f, face, 1);
-
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
if (!UNSPECIFIEDP (AREF (lface, i)))
break;
For internal use only. */)
(Lisp_Object frame)
{
- struct frame *f = frame_or_selected_frame (frame, 0);
- return f->face_alist;
+ return decode_live_frame (frame)->face_alist;
}
If FRAME is unspecified or nil, the current frame is used. */)
(Lisp_Object color1, Lisp_Object color2, Lisp_Object frame)
{
- struct frame *f;
+ struct frame *f = decode_live_frame (frame);
XColor cdef1, cdef2;
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
if (!(CONSP (color1) && parse_rgb_list (color1, &cdef1))
&& !(STRINGP (color1) && defined_color (f, SSDATA (color1), &cdef1, 0)))
signal_error ("Invalid color", color1);
else
{
/* Find any frame on DISPLAY. */
- Lisp_Object fl_tail;
+ Lisp_Object tail;
frame = Qnil;
- for (fl_tail = Vframe_list; CONSP (fl_tail); fl_tail = XCDR (fl_tail))
- {
- frame = XCAR (fl_tail);
- if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
- XFRAME (frame)->param_alist)),
- display)))
- break;
- }
+ FOR_EACH_FRAME (tail, frame)
+ if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
+ XFRAME (frame)->param_alist)),
+ display)))
+ break;
}
CHECK_LIVE_FRAME (frame);
DEFSYM (Qreleased_button, "released-button");
DEFSYM (Qpressed_button, "pressed-button");
DEFSYM (Qnormal, "normal");
- DEFSYM (Qultra_light, "ultra-light");
DEFSYM (Qextra_light, "extra-light");
DEFSYM (Qlight, "light");
DEFSYM (Qsemi_light, "semi-light");
DEFSYM (Qultra_bold, "ultra-bold");
DEFSYM (Qoblique, "oblique");
DEFSYM (Qitalic, "italic");
- DEFSYM (Qreverse_oblique, "reverse-oblique");
- DEFSYM (Qreverse_italic, "reverse-italic");
- DEFSYM (Qultra_condensed, "ultra-condensed");
- DEFSYM (Qextra_condensed, "extra-condensed");
- DEFSYM (Qcondensed, "condensed");
- DEFSYM (Qsemi_condensed, "semi-condensed");
- DEFSYM (Qsemi_expanded, "semi-expanded");
- DEFSYM (Qexpanded, "expanded");
- DEFSYM (Qextra_expanded, "extra-expanded");
- DEFSYM (Qultra_expanded, "ultra-expanded");
DEFSYM (Qbackground_color, "background-color");
DEFSYM (Qforeground_color, "foreground-color");
DEFSYM (Qunspecified, "unspecified");
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
if (! FRAME_X_P (f))
error ("Non-X frame used");
return f;
Lisp_Object tail, frame;
struct frame *f;
- if (wdesc == None) return 0;
+ if (wdesc == None)
+ return NULL;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
x_any_window_to_frame (struct x_display_info *dpyinfo, int wdesc)
{
Lisp_Object tail, frame;
- struct frame *f, *found;
+ struct frame *f, *found = NULL;
struct x_output *x;
- if (wdesc == None) return NULL;
+ if (wdesc == None)
+ return NULL;
- found = NULL;
- for (tail = Vframe_list; CONSP (tail) && !found; tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
-
+ if (found)
+ break;
f = XFRAME (frame);
if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
{
struct frame *f;
struct x_output *x;
- if (wdesc == None) return 0;
+ if (wdesc == None)
+ return NULL;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
struct frame *f;
struct x_output *x;
- if (wdesc == None) return 0;
+ if (wdesc == None)
+ return NULL;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
DEFUN ("x-wm-set-size-hint", Fx_wm_set_size_hint, Sx_wm_set_size_hint,
0, 1, 0,
doc: /* Send the size hints for frame FRAME to the window manager.
-If FRAME is nil, use the selected frame. */)
+If FRAME is omitted or nil, use the selected frame.
+Signal error if FRAME is not an X frame. */)
(Lisp_Object frame)
{
- struct frame *f;
- if (NILP (frame))
- frame = selected_frame;
- f = XFRAME (frame);
+ struct frame *f = check_x_frame (frame);
+
block_input ();
- if (FRAME_X_P (f))
- x_wm_set_size_hint (f, 0, 0);
+ x_wm_set_size_hint (f, 0, 0);
unblock_input ();
return Qnil;
}
XSETFRAME (frame, f);
- /* Note that X Windows does support scroll bars. */
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
-
f->terminal = dpyinfo->terminal;
f->output_method = output_x_window;
Finsert (1, &text);
set_buffer_internal_1 (old_buffer);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
record_unwind_protect (unwind_create_tip_frame, frame);
f->terminal = dpyinfo->terminal;
Lisp_Object tail, frame;
FRAME_PTR f;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_WINDOW_P (f))
continue;
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
-#include <sys/stat.h>
#ifdef USE_MOTIF
/* For Vdouble_click_time. */
char *x_get_string_resource (XrmDatabase rdb, const char *name,
const char *class);
-static int file_p (const char *filename);
\f
/* X file search path processing. */
database associated with display.
(This is x_customization_string.)
- Return the expanded file name if it exists and is readable, and
+ Return the resource database if its file was read successfully, and
refers to %L only when the LANG environment variable is set, or
otherwise provided by X.
Return NULL otherwise. */
-static char *
-magic_file_p (const char *string, ptrdiff_t string_len, const char *class,
- const char *escaped_suffix)
+static XrmDatabase
+magic_db (const char *string, ptrdiff_t string_len, const char *class,
+ const char *escaped_suffix)
{
+ XrmDatabase db;
char *lang = getenv ("LANG");
ptrdiff_t path_size = 100;
}
path[path_len] = '\0';
-
- if (! file_p (path))
- {
- xfree (path);
- return NULL;
- }
-
- return path;
+ db = XrmGetFileDatabase (path);
+ xfree (path);
+ return db;
}
}
-static int
-file_p (const char *filename)
-{
- struct stat status;
-
- return (access (filename, 4) == 0 /* exists and is readable */
- && stat (filename, &status) == 0 /* get the status */
- && (S_ISDIR (status.st_mode)) == 0); /* not a directory */
-}
-
-
/* Find the first element of SEARCH_PATH which exists and is readable,
after expanding the %-escapes. Return 0 if we didn't find any, and
the path name of the one we found otherwise. */
-static char *
+static XrmDatabase
search_magic_path (const char *search_path, const char *class,
const char *escaped_suffix)
{
if (p > s)
{
- char *path = magic_file_p (s, p - s, class, escaped_suffix);
- if (path)
- return path;
+ XrmDatabase db = magic_db (s, p - s, class, escaped_suffix);
+ if (db)
+ return db;
}
else if (*p == ':')
{
- char *path;
-
- s = "%N%S";
- path = magic_file_p (s, strlen (s), class, escaped_suffix);
- if (path)
- return path;
+ static char const ns[] = "%N%S";
+ XrmDatabase db = magic_db (ns, strlen (ns), class, escaped_suffix);
+ if (db)
+ return db;
}
if (*p == ':')
static XrmDatabase
get_system_app (const char *class)
{
- XrmDatabase db = NULL;
const char *path;
- char *p;
path = getenv ("XFILESEARCHPATH");
if (! path) path = PATH_X_DEFAULTS;
- p = search_magic_path (path, class, 0);
- if (p)
- {
- db = XrmGetFileDatabase (p);
- xfree (p);
- }
-
- return db;
+ return search_magic_path (path, class, 0);
}
static XrmDatabase
get_user_app (const char *class)
{
+ XrmDatabase db = 0;
const char *path;
- char *file = 0;
- char *free_it = 0;
/* Check for XUSERFILESEARCHPATH. It is a path of complete file
names, not directories. */
- if (((path = getenv ("XUSERFILESEARCHPATH"))
- && (file = search_magic_path (path, class, 0)))
+ path = getenv ("XUSERFILESEARCHPATH");
+ if (path)
+ db = search_magic_path (path, class, 0);
+ if (! db)
+ {
/* Check for APPLRESDIR; it is a path of directories. In each,
we have to search for LANG/CLASS and then CLASS. */
- || ((path = getenv ("XAPPLRESDIR"))
- && ((file = search_magic_path (path, class, "/%L/%N"))
- || (file = search_magic_path (path, class, "/%N"))))
+ path = getenv ("XAPPLRESDIR");
+ if (path)
+ {
+ db = search_magic_path (path, class, "/%L/%N");
+ if (!db)
+ db = search_magic_path (path, class, "/%N");
+ }
+ }
+ if (! db)
+ {
/* Check in the home directory. This is a bit of a hack; let's
hope one's home directory doesn't contain any %-escapes. */
- || (free_it = gethomedir (),
- ((file = search_magic_path (free_it, class, "%L/%N"))
- || (file = search_magic_path (free_it, class, "%N")))))
- {
- XrmDatabase db = XrmGetFileDatabase (file);
- xfree (file);
- xfree (free_it);
- return db;
+ char *home = gethomedir ();
+ db = search_magic_path (home, class, "%L/%N");
+ if (! db)
+ db = search_magic_path (home, class, "%N");
+ xfree (home);
}
- xfree (free_it);
- return NULL;
+ return db;
}
static struct frame *
frame_for_x_selection (Lisp_Object object)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
struct frame *f;
if (NILP (object))
if (FRAME_X_P (f) && FRAME_LIVE_P (f))
return f;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- f = XFRAME (XCAR (tail));
+ f = XFRAME (frame);
if (FRAME_X_P (f) && FRAME_LIVE_P (f))
return f;
}
else if (TERMINALP (object))
{
struct terminal *t = get_terminal (object, 1);
+
if (t->type == output_x_window)
- {
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- {
- f = XFRAME (XCAR (tail));
- if (FRAME_LIVE_P (f) && f->terminal == t)
- return f;
- }
- }
+ FOR_EACH_FRAME (tail, frame)
+ {
+ f = XFRAME (frame);
+ if (FRAME_LIVE_P (f) && f->terminal == t)
+ return f;
+ }
}
else if (FRAMEP (object))
{
x_frame_of_widget (Widget widget)
{
struct x_display_info *dpyinfo;
- Lisp_Object tail;
+ Lisp_Object tail, frame;
struct frame *f;
dpyinfo = x_display_info_for_display (XtDisplay (widget));
/* Look for a frame with that top-level widget. Allocate the color
on that frame to get the right gamma correction value. */
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- if (FRAMEP (XCAR (tail))
- && (f = XFRAME (XCAR (tail)),
- (FRAME_X_P (f)
- && f->output_data.nothing != 1
- && FRAME_X_DISPLAY_INFO (f) == dpyinfo))
- && f->output_data.x->widget == widget)
- return f;
-
+ FOR_EACH_FRAME (tail, frame)
+ {
+ f = XFRAME (frame);
+ if (FRAME_X_P (f)
+ && f->output_data.nothing != 1
+ && FRAME_X_DISPLAY_INFO (f) == dpyinfo
+ && f->output_data.x->widget == widget)
+ return f;
+ }
emacs_abort ();
}
static struct scroll_bar *
x_window_to_scroll_bar (Display *display, Window window_id)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS)
window_id = (Window) xg_get_scroll_id_for_window (display, window_id);
#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- Lisp_Object frame, bar, condemned;
-
- frame = XCAR (tail);
- /* All elements of Vframe_list should be frames. */
- if (! FRAMEP (frame))
- emacs_abort ();
+ Lisp_Object bar, condemned;
if (! FRAME_X_P (XFRAME (frame)))
continue;
static Widget
x_window_to_menu_bar (Window window)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- {
- if (FRAME_X_P (XFRAME (XCAR (tail))))
- {
- Lisp_Object frame = XCAR (tail);
- Widget menu_bar = XFRAME (frame)->output_data.x->menubar_widget;
-
- if (menu_bar && xlwmenu_window_p (menu_bar, window))
- return menu_bar;
- }
- }
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_X_P (XFRAME (frame)))
+ {
+ Widget menu_bar = XFRAME (frame)->output_data.x->menubar_widget;
+ if (menu_bar && xlwmenu_window_p (menu_bar, window))
+ return menu_bar;
+ }
return NULL;
}
SELECTION_EVENT_DISPLAY (&inev.sie) = eventp->display;
SELECTION_EVENT_SELECTION (&inev.sie) = eventp->selection;
SELECTION_EVENT_TIME (&inev.sie) = eventp->time;
- inev.ie.frame_or_window = Qnil;
}
break;
SELECTION_EVENT_TARGET (&inev.sie) = eventp->target;
SELECTION_EVENT_PROPERTY (&inev.sie) = eventp->property;
SELECTION_EVENT_TIME (&inev.sie) = eventp->time;
- inev.ie.frame_or_window = Qnil;
}
break;
DEFVAR_LISP ("x-keysym-table", Vx_keysym_table,
doc: /* Hash table of character codes indexed by X keysym codes. */);
- Vx_keysym_table = make_hash_table (Qeql, make_number (900),
+ Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ Qnil);
}
#endif /* HAVE_X_WINDOWS */
by this structure. */
/* For an event of kind SELECTION_REQUEST_EVENT,
- this structure really describes the contents.
- **Don't make this struct longer!**
- If it overlaps the frame_or_window field of struct input_event,
- that will cause GC to crash. */
+ this structure really describes the contents. */
+
struct selection_input_event
{
int kind;
+2012-11-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass.
+ (ruby-indent-inside-heredoc-after-operator)
+ (ruby-indent-inside-heredoc-after-space): New tests.
+ Change direct font-lock face references to var references.
+ (ruby-interpolation-suppresses-syntax-inside): New test.
+ (ruby-interpolation-inside-percent-literal-with-paren): New
+ failing test.
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-heredoc-font-lock)
+ (ruby-singleton-class-no-heredoc-font-lock)
+ (ruby-add-log-current-method-examples): New tests.
+ (ruby-test-string): Extract from ruby-should-indent-buffer.
+ (ruby-deftest-move-to-block): New macro.
+ Add several move-to-block tests.
+
+2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/advice-tests.el: New tests.
+
2012-10-14 Eli Zaretskii <eliz@gnu.org>
* automated/compile-tests.el (compile-tests--test-regexps-data):
--- /dev/null
+;;; advice-tests.el --- Test suite for the new advice thingy.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(defvar advice-tests--data
+ '(((defun sm-test1 (x) (+ x 4))
+ (sm-test1 6) 10)
+ ((advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
+ (sm-test1 6) 50)
+ ((defun sm-test1 (x) (+ x 14))
+ (sm-test1 6) 100)
+ ((null (get 'sm-test1 'defalias-fset-function)) nil)
+ ((advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
+ (sm-test1 6) 20)
+ ((null (get 'sm-test1 'defalias-fset-function)) t)
+
+ ((defun sm-test2 (x) (+ x 4))
+ (sm-test2 6) 10)
+ ((defadvice sm-test2 (around sm-test activate)
+ ad-do-it (setq ad-return-value (* ad-return-value 5)))
+ (sm-test2 6) 50)
+ ((ad-deactivate 'sm-test2)
+ (sm-test2 6) 10)
+ ((ad-activate 'sm-test2)
+ (sm-test2 6) 50)
+ ((defun sm-test2 (x) (+ x 14))
+ (sm-test2 6) 100)
+ ((null (get 'sm-test2 'defalias-fset-function)) nil)
+ ((ad-remove-advice 'sm-test2 'around 'sm-test)
+ (sm-test2 6) 100)
+ ((ad-activate 'sm-test2)
+ (sm-test2 6) 20)
+ ((null (get 'sm-test2 'defalias-fset-function)) t)
+
+ ((advice-add 'sm-test3 :around
+ (lambda (f &rest args) `(toto ,(apply f args)))
+ '((name . wrap-with-toto)))
+ (defmacro sm-test3 (x) `(call-test3 ,x))
+ (macroexpand '(sm-test3 56)) (toto (call-test3 56)))
+
+ ((defadvice sm-test4 (around wrap-with-toto activate)
+ ad-do-it (setq ad-return-value `(toto ,ad-return-value)))
+ (defmacro sm-test4 (x) `(call-test4 ,x))
+ (macroexpand '(sm-test4 56)) (toto (call-test4 56)))
+ ((defmacro sm-test4 (x) `(call-testq ,x))
+ (macroexpand '(sm-test4 56)) (toto (call-testq 56)))
+
+ ;; Combining old style and new style advices.
+ ((defun sm-test5 (x) (+ x 4))
+ (sm-test5 6) 10)
+ ((advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
+ (sm-test5 6) 50)
+ ((defadvice sm-test5 (around test activate)
+ ad-do-it (setq ad-return-value (+ ad-return-value 0.1)))
+ (sm-test5 5) 45.1)
+ ((ad-deactivate 'sm-test5)
+ (sm-test5 6) 50)
+ ((ad-activate 'sm-test5)
+ (sm-test5 6) 50.1)
+ ((defun sm-test5 (x) (+ x 14))
+ (sm-test5 6) 100.1)
+ ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5)))
+ (sm-test5 6) 20.1)
+
+ ;; This used to signal an error (bug#12858).
+ ((autoload 'sm-test6 "foo")
+ (defadvice sm-test6 (around test activate)
+ ad-do-it)
+ t t)
+
+ ))
+
+(ert-deftest advice-tests ()
+ "Test advice code."
+ (with-temp-buffer
+ (dolist (test advice-tests--data)
+ (let ((res (eval `(progn ,@(butlast test)))))
+ (should (equal (car (last test)) res))))))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; advice-tests.el ends here.
The whitespace before and including \"|\" on each line is removed."
(with-temp-buffer
- (cl-flet ((fix-indent (s) (replace-regexp-in-string "^[ \t]*|" "" s)))
- (insert (fix-indent content))
- (ruby-mode)
- (indent-region (point-min) (point-max))
- (should (string= (fix-indent expected) (buffer-string))))))
+ (insert (ruby-test-string content))
+ (ruby-mode)
+ (indent-region (point-min) (point-max))
+ (should (string= (ruby-test-string expected) (buffer-string)))))
+
+(defun ruby-test-string (s &rest args)
+ (apply 'format (replace-regexp-in-string "^[ \t]*|" "" s) args))
(defun ruby-assert-state (content &rest values-plist)
"Assert syntax state values at the end of CONTENT.
(ruby-assert-state "foo <<asd\n" 3 ?\n)
(ruby-assert-state "class <<asd\n" 3 nil))
+(ert-deftest ruby-heredoc-font-lock ()
+ (let ((s "foo <<eos.gsub('^ *', '')"))
+ (ruby-assert-face s 9 font-lock-string-face)
+ (ruby-assert-face s 10 nil)))
+
+(ert-deftest ruby-singleton-class-no-heredoc-font-lock ()
+ (ruby-assert-face "class<<a" 8 nil))
+
(ert-deftest ruby-deep-indent ()
(let ((ruby-deep-arglist nil)
(ruby-deep-indent-paren '(?\( ?\{ ?\[ ?\] t)))
|"))
(ert-deftest ruby-indent-singleton-class ()
- :expected-result :failed ; Doesn't work yet, when no space before "<<".
(ruby-should-indent-buffer
"class<<bar
| foo
| end
|"))
+(ert-deftest ruby-indent-inside-heredoc-after-operator ()
+ (ruby-should-indent-buffer
+ "b=<<eos
+ | 42"
+ "b=<<eos
+ | 42"))
+
+(ert-deftest ruby-indent-inside-heredoc-after-space ()
+ (ruby-should-indent-buffer
+ "foo <<eos.gsub(' ', '*')
+ | 42"
+ "foo <<eos.gsub(' ', '*')
+ | 42"))
+
(ert-deftest ruby-indent-array-literal ()
(let ((ruby-deep-indent-paren nil))
(ruby-should-indent-buffer
(should (string= "foo do |b|\n b + 1\nend" (buffer-string)))))
(ert-deftest ruby-recognize-symbols-starting-with-at-character ()
- (ruby-assert-face ":@abc" 3 'font-lock-constant-face))
+ (ruby-assert-face ":@abc" 3 font-lock-constant-face))
(ert-deftest ruby-hash-character-not-interpolation ()
(ruby-assert-face "\"This is #{interpolation}\"" 15
- 'font-lock-variable-name-face)
+ font-lock-variable-name-face)
(ruby-assert-face "\"This is \\#{no interpolation} despite the #\""
- 15 'font-lock-string-face)
- (ruby-assert-face "\n#@comment, not ruby code" 5 'font-lock-comment-face)
+ 15 font-lock-string-face)
+ (ruby-assert-face "\n#@comment, not ruby code" 5 font-lock-comment-face)
(ruby-assert-state "\n#@comment, not ruby code" 4 t)
(ruby-assert-face "# A comment cannot have #{an interpolation} in it"
- 30 'font-lock-comment-face)
+ 30 font-lock-comment-face)
(ruby-assert-face "# #{comment}\n \"#{interpolation}\"" 16
- 'font-lock-variable-name-face))
+ font-lock-variable-name-face))
+
+(ert-deftest ruby-interpolation-suppresses-syntax-inside ()
+ (let ((s "\"<ul><li>#{@files.join(\"</li><li>\")}</li></ul>\""))
+ (ruby-assert-state s 8 nil)
+ (ruby-assert-face s 9 font-lock-string-face)
+ (ruby-assert-face s 10 font-lock-variable-name-face)
+ (ruby-assert-face s 41 font-lock-string-face)))
+
+(ert-deftest ruby-interpolation-inside-percent-literal-with-paren ()
+ :expected-result :failed
+ (let ((s "%(^#{\")\"}^)"))
+ (ruby-assert-face s 3 font-lock-string-face)
+ (ruby-assert-face s 4 font-lock-variable-name-face)
+ (ruby-assert-face s 10 font-lock-string-face)
+ ;; It's confused by the closing paren in the middle.
+ (ruby-assert-state s 8 nil)))
+
+(ert-deftest ruby-add-log-current-method-examples ()
+ (let ((pairs '(("foo" . "#foo")
+ ("C.foo" . ".foo")
+ ("self.foo" . ".foo"))))
+ (loop for (name . value) in pairs
+ do (with-temp-buffer
+ (insert (ruby-test-string
+ "module M
+ | class C
+ | def %s
+ | end
+ | end
+ |end"
+ name))
+ (ruby-mode)
+ (search-backward "def")
+ (forward-line)
+ (should (string= (ruby-add-log-current-method)
+ (format "M::C%s" value)))))))
+
+(defvar ruby-block-test-example
+ (ruby-test-string
+ "class C
+ | def foo
+ | 1
+ | end
+ |
+ | def bar
+ | 2
+ | end
+ |
+ | def baz
+ | some do
+ | end
+ | end
+ |end"))
+
+(defmacro ruby-deftest-move-to-block (name &rest body)
+ `(ert-deftest ,(intern (format "ruby-move-to-block-%s" name)) ()
+ (with-temp-buffer
+ (insert ruby-block-test-example)
+ (ruby-mode)
+ ,@body)))
+
+(put 'ruby-deftest-move-to-block 'lisp-indent-function 'defun)
+
+(ruby-deftest-move-to-block works-on-do
+ (goto-line 11)
+ (ruby-end-of-block)
+ (should (= 12 (line-number-at-pos)))
+ (ruby-beginning-of-block)
+ (should (= 11 (line-number-at-pos))))
+
+(ruby-deftest-move-to-block zero-is-noop
+ (goto-line 5)
+ (ruby-move-to-block 0)
+ (should (= 5 (line-number-at-pos))))
+
+(ruby-deftest-move-to-block ok-with-three
+ (goto-line 2)
+ (ruby-move-to-block 3)
+ (should (= 13 (line-number-at-pos))))
+
+(ruby-deftest-move-to-block ok-with-minus-two
+ (goto-line 10)
+ (ruby-move-to-block -2)
+ (should (= 2 (line-number-at-pos))))
(provide 'ruby-mode-tests)
HCoop / bpt / emacs.git / commitdiff