diff --git a/ChangeLog b/ChangeLog index e8bff20d56d..05e1a14d55d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,27 @@ +2012-11-17 Paul Eggert + + 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 + + Remove no-longer-used pty_max_bytes variable. + * configure.ac (fpathconf): Remove unnecessary check. + +2012-11-14 Paul Eggert + + 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 Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800). diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 0a4c14cb95c..ae8673452a3 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -150,9 +150,7 @@ HAVE_ENDGRENT HAVE_ENDPWENT HAVE_ENVIRON_DECL HAVE_EUIDACCESS -HAVE_FCNTL_H HAVE_FORK -HAVE_FPATHCONF HAVE_FREEIFADDRS HAVE_FREETYPE HAVE_FSEEKO @@ -420,8 +418,6 @@ NSIG NSIG_MINIMUM NULL_DEVICE ORDINARY_LINK -O_RDONLY -O_RDWR PAGESIZE PREFER_VSUSP PTY_ITERATION diff --git a/admin/ChangeLog b/admin/ChangeLog index 496e1c1bb6a..3d76f9dd2ba 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,22 @@ +2012-11-17 Paul Eggert + + 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 + + Remove no-longer-used pty_max_bytes variable. + * CPP-DEFINES (HAVE_FPATHCONF): Remove. + +2012-11-14 Paul Eggert + + 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 Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800). diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 901daf4e442..792818b2efe 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -28,8 +28,8 @@ GNULIB_URL=git://git.savannah.gnu.org/gnulib.git GNULIB_MODULES=' alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 - dtoastr dtotimespec dup2 environ execinfo - filemode getloadavg getopt-gnu gettime gettimeofday + 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 @@ -39,9 +39,12 @@ GNULIB_MODULES=' ' 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 @@ -85,7 +88,7 @@ test -x "$gnulib_srcdir"/gnulib-tool || { } "$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"} diff --git a/autogen/Makefile.in b/autogen/Makefile.in index d7855ac46ee..4599f20df45 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -36,7 +36,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream 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 VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -66,14 +66,17 @@ 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/close-stream.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/fpending.m4 $(top_srcdir)/m4/getloadavg.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 \ @@ -213,6 +216,7 @@ GNULIB_FCHDIR = @GNULIB_FCHDIR@ 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@ @@ -279,8 +283,11 @@ GNULIB_MKSTEMP = @GNULIB_MKSTEMP@ 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@ @@ -408,6 +415,7 @@ HAVE_FACCESSAT = @HAVE_FACCESSAT@ 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@ @@ -444,6 +452,7 @@ HAVE_MKOSTEMPS = @HAVE_MKOSTEMPS@ 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@ @@ -563,6 +572,7 @@ LIBXTR6 = @LIBXTR6@ 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@ @@ -578,6 +588,7 @@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ 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@ @@ -591,6 +602,7 @@ NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_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@ @@ -641,6 +653,7 @@ REPLACE_DUP = @REPLACE_DUP@ 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@ @@ -680,6 +693,8 @@ REPLACE_MKTIME = @REPLACE_MKTIME@ 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@ @@ -859,18 +874,20 @@ x_default_search_path = @x_default_search_path@ # 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 +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 execinfo.c execinfo.in.h filemode.h fpending.c \ - fpending.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 \ + 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 \ @@ -879,12 +896,12 @@ EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h close-stream.h \ 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 \ @@ -900,8 +917,9 @@ libgnu_a_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \ 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 fpending.c \ - getloadavg.c getopt.c getopt1.c gettimeofday.c lstat.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 @@ -963,6 +981,7 @@ distclean-compile: -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@ @@ -971,15 +990,19 @@ distclean-compile: @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@ @@ -1243,6 +1266,32 @@ uninstall-am: @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 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 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) diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 index 37d734c2c7f..f423953b3c8 100644 --- a/autogen/aclocal.m4 +++ b/autogen/aclocal.m4 @@ -991,17 +991,22 @@ 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]) diff --git a/autogen/config.in b/autogen/config.in index 05418e64623..9f664063761 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -174,6 +174,14 @@ along with GNU Emacs. If not, see . */ garbage collection in the jmp_buf. */ #undef GC_SETJMP_WORKS +/* 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 @@ -188,6 +196,10 @@ along with GNU Emacs. If not, see . */ 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 @@ -209,6 +221,9 @@ along with GNU Emacs. If not, see . */ 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 @@ -333,6 +348,9 @@ along with GNU Emacs. If not, see . */ /* 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 @@ -348,15 +366,12 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the header file. */ #undef HAVE_EXECINFO_H -/* Define to 1 if you have the header file. */ -#undef HAVE_FCNTL_H +/* Define to 1 if you have the `faccessat' function. */ +#undef HAVE_FACCESSAT /* 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 @@ -396,6 +411,9 @@ along with GNU Emacs. If not, see . */ /* 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 @@ -562,6 +580,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `dnet' library (-ldnet). */ #undef HAVE_LIBDNET +/* Define to 1 if you have the header file. */ +#undef HAVE_LIBGEN_H + /* Define to 1 if you have the hesiod library (-lhesiod). */ #undef HAVE_LIBHESIOD diff --git a/autogen/configure b/autogen/configure index 159a91bb48c..afcf9a73fa6 100755 --- a/autogen/configure +++ b/autogen/configure @@ -611,6 +611,8 @@ LD_SWITCH_SYSTEM_TEMACS 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 @@ -619,14 +621,23 @@ gl_GNULIB_ENABLED_strtoll_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 @@ -895,10 +906,6 @@ GETOPT_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 @@ -974,6 +981,21 @@ GNULIB_CANONICALIZE_FILE_NAME 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 @@ -3184,7 +3206,6 @@ fi as_fn_append ac_header_list " linux/version.h" as_fn_append ac_header_list " sys/systeminfo.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_header_list " sys/vlimit.h" @@ -3205,6 +3226,7 @@ as_fn_append ac_header_list " sys/un.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 @@ -5738,6 +5760,8 @@ else 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. @@ -6969,18 +6993,23 @@ esac # 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: @@ -6996,6 +7025,7 @@ esac # 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: @@ -7035,6 +7065,7 @@ esac # 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 @@ -8747,8 +8778,6 @@ done - - @@ -13417,7 +13446,7 @@ esac for ac_func in gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ -fpathconf select euidaccess getpagesize setlocale \ +select getpagesize setlocale \ utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ @@ -16777,6 +16806,145 @@ $as_echo "#define HAVE_ENVIRON_DECL 1" >>confdefs.h + + + + 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; + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5 +$as_echo_n "checking whether the preprocessor supports include_next... " >&6; } +if test "${gl_cv_have_include_next+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + rm -rf conftestd1a conftestd1b conftestd2 + mkdir conftestd1a conftestd1b conftestd2 + cat < conftestd1a/conftest.h +#define DEFINED_IN_CONFTESTD1 +#include_next +#ifdef DEFINED_IN_CONFTESTD2 +int foo; +#else +#error "include_next doesn't work" +#endif +EOF + cat < conftestd1b/conftest.h +#define DEFINED_IN_CONFTESTD1 +#include +#include_next +#ifdef DEFINED_IN_CONFTESTD2 +int foo; +#else +#error "include_next doesn't work" +#endif +EOF + cat < conftestd2/conftest.h +#ifndef DEFINED_IN_CONFTESTD1 +#error "include_next test doesn't work" +#endif +#define DEFINED_IN_CONFTESTD2 +EOF + gl_save_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1b -Iconftestd2" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_have_include_next=yes +else + CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1a -Iconftestd2" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_have_include_next=buggy +else + gl_cv_have_include_next=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CPPFLAGS="$gl_save_CPPFLAGS" + rm -rf conftestd1a conftestd1b conftestd2 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_have_include_next" >&5 +$as_echo "$gl_cv_have_include_next" >&6; } + PRAGMA_SYSTEM_HEADER= + if test $gl_cv_have_include_next = yes; then + INCLUDE_NEXT=include_next + INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next + if test -n "$GCC"; then + PRAGMA_SYSTEM_HEADER='#pragma GCC system_header' + fi + else + if test $gl_cv_have_include_next = buggy; then + INCLUDE_NEXT=include + INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next + else + INCLUDE_NEXT=include + INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include + fi + fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system header files limit the line length" >&5 +$as_echo_n "checking whether system header files limit the line length... " >&6; } +if test "${gl_cv_pragma_columns+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef __TANDEM +choke me +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "choke me" >/dev/null 2>&1; then : + gl_cv_pragma_columns=yes +else + gl_cv_pragma_columns=no +fi +rm -f conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_pragma_columns" >&5 +$as_echo "$gl_cv_pragma_columns" >&6; } + if test $gl_cv_pragma_columns = yes; then + PRAGMA_COLUMNS="#pragma COLUMNS 10000" + else + PRAGMA_COLUMNS= + 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 : @@ -16905,120 +17073,6 @@ _ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5 -$as_echo_n "checking whether the preprocessor supports include_next... " >&6; } -if test "${gl_cv_have_include_next+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - rm -rf conftestd1a conftestd1b conftestd2 - mkdir conftestd1a conftestd1b conftestd2 - cat < conftestd1a/conftest.h -#define DEFINED_IN_CONFTESTD1 -#include_next -#ifdef DEFINED_IN_CONFTESTD2 -int foo; -#else -#error "include_next doesn't work" -#endif -EOF - cat < conftestd1b/conftest.h -#define DEFINED_IN_CONFTESTD1 -#include -#include_next -#ifdef DEFINED_IN_CONFTESTD2 -int foo; -#else -#error "include_next doesn't work" -#endif -EOF - cat < conftestd2/conftest.h -#ifndef DEFINED_IN_CONFTESTD1 -#error "include_next test doesn't work" -#endif -#define DEFINED_IN_CONFTESTD2 -EOF - gl_save_CPPFLAGS="$CPPFLAGS" - CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1b -Iconftestd2" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_have_include_next=yes -else - CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1a -Iconftestd2" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_have_include_next=buggy -else - gl_cv_have_include_next=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CPPFLAGS="$gl_save_CPPFLAGS" - rm -rf conftestd1a conftestd1b conftestd2 - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_have_include_next" >&5 -$as_echo "$gl_cv_have_include_next" >&6; } - PRAGMA_SYSTEM_HEADER= - if test $gl_cv_have_include_next = yes; then - INCLUDE_NEXT=include_next - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next - if test -n "$GCC"; then - PRAGMA_SYSTEM_HEADER='#pragma GCC system_header' - fi - else - if test $gl_cv_have_include_next = buggy; then - INCLUDE_NEXT=include - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next - else - INCLUDE_NEXT=include - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include - fi - fi - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system header files limit the line length" >&5 -$as_echo_n "checking whether system header files limit the line length... " >&6; } -if test "${gl_cv_pragma_columns+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifdef __TANDEM -choke me -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "choke me" >/dev/null 2>&1; then : - gl_cv_pragma_columns=yes -else - gl_cv_pragma_columns=no -fi -rm -f conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_pragma_columns" >&5 -$as_echo "$gl_cv_pragma_columns" >&6; } - if test $gl_cv_pragma_columns = yes; then - PRAGMA_COLUMNS="#pragma COLUMNS 10000" - else - PRAGMA_COLUMNS= - fi - - - - @@ -19735,17 +19789,6 @@ 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 struct timespec in " >&5 @@ -20113,6 +20156,74 @@ $as_echo "#define HAVE_STRUCT_UTIMBUF 1" >>confdefs.h +{ $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 + +_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= @@ -20526,6 +20637,136 @@ fi + if test $ac_cv_func_faccessat = no; then + HAVE_FACCESSAT=0 + fi + + if test $HAVE_FACCESSAT = 0; then + + + + + + + + + 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 + +fi +done + + + 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 " >&5 +$as_echo_n "checking absolute name of ... " >&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 + +_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 @@ -24124,18 +24365,481 @@ $as_echo "#define FUTIMESAT_NULL_BUG 1" >>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_euidaccess () + { + if ! $gl_gnulib_enabled_euidaccess; 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 + + if test $HAVE_EUIDACCESS = 0; then + + + + + + + + + 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 @@ -24144,6 +24848,59 @@ $as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h 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 @@ -24153,6 +24910,12 @@ $as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h 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 @@ -24409,6 +25172,18 @@ done 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 @@ -24442,6 +25217,22 @@ else 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='#' @@ -24450,6 +25241,14 @@ else 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='#' @@ -24458,6 +25257,14 @@ else 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='#' @@ -24490,6 +25297,14 @@ else 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 @@ -24970,14 +25785,30 @@ if test -z "${gl_GNULIB_ENABLED_dosname_TRUE}" && test -z "${gl_GNULIB_ENABLED_d 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 @@ -24993,6 +25824,10 @@ fi 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= diff --git a/configure.ac b/configure.ac index e9b338e9551..9656319ef63 100644 --- a/configure.ac +++ b/configure.ac @@ -574,6 +574,8 @@ else 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]) @@ -1268,7 +1270,7 @@ fi dnl checks for header files AC_CHECK_HEADERS_ONCE( linux/version.h sys/systeminfo.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) @@ -2933,7 +2935,7 @@ AC_SUBST(BLESSMAIL_TARGET) AC_CHECK_FUNCS(gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ -fpathconf select euidaccess getpagesize setlocale \ +select getpagesize setlocale \ utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index fbdb6363b34..dc5fa539cd1 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,12 @@ +2012-11-18 Dani Moncayo + + * mark.texi (Disabled Transient Mark): Doc fixes (Bug#12746). + +2012-11-16 Eli Zaretskii + + * trouble.texi (Crashing): Add information about MS-Windows and + the emacs_backtrace.txt file. (Bug#12908) + 2012-11-13 Chong Yidong * building.texi (Multithreaded Debugging): gdb-stopped-hooks is diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 83d519a4cd2..db191eb175c 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -429,10 +429,6 @@ soon, before you forget where it is. You can also check where the mark is by using @kbd{C-x C-x}, which exchanges the positions of the point and the mark (@pxref{Setting Mark}). -@item -Many commands that move point long distances, like @kbd{M-<} and -@kbd{C-s}, first set the mark where point was. - @item Some commands, which ordinarily act on the region when the mark is active, no longer do so. For example, normally @kbd{M-%} @@ -455,9 +451,10 @@ command twice.) @item C-u C-x C-x @kindex C-u C-x C-x -Activate the mark and enable Transient Mark mode temporarily, until -the mark is next deactivated. (This is the @kbd{C-x C-x} command, -@code{exchange-point-and-mark}, with a prefix argument.) +Exchange point and mark, activate the mark and enable Transient Mark +mode temporarily, until the mark is next deactivated. (This is the +@kbd{C-x C-x} command, @code{exchange-point-and-mark}, with a prefix +argument.) @end table These commands set or activate the mark, and enable Transient Mark diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index 1a891a62b33..705cd5a4bbe 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -282,18 +282,23 @@ itself, and the reserve supply may not be enough. @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 @@ -320,22 +325,24 @@ backtrace with source-code line numbers: @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 diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 6d6ddf4da9a..a5295adc368 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,56 @@ +2012-11-18 Glenn Morris + + * loading.texi (How Programs Do Loading): Add eager macro expansion. + * macros.texi (Expansion): Mention eager macro expansion. + + * minibuf.texi (Basic Completion): Mention misc completion-table funcs. + +2012-11-18 Leo Liu + + * minibuf.texi (Programmed Completion): Doc fix for metadata + request (Bug#12850). + +2012-11-18 Glenn Morris + + * display.texi (Temporary Displays): Document with-temp-buffer-window. + + * frames.texi (Size and Position): Add fit-frame-to-buffer command. + * windows.texi (Resizing Windows): Add fit-frame-to-buffer option. + (Window Sizes): Add vindex for window-min-height, window-min-width. + (Display Action Functions): Mention pop-up-frame-parameters. + +2012-11-16 Martin Rudalics + + * windows.texi (Choosing Window): Rewrite description of + display-buffer-alist (Bug#12167). + (Display Action Functions): Mention inhibit-switch-frame. Fix + description of display-buffer-below-selected. Reorder actions. + Add example (Bug#12848). + +2012-11-16 Glenn Morris + + * 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. + + * 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-15 Stefan Monnier + + * keymaps.texi (Translation Keymaps): Add a subsection "Interaction + with normal keymaps". + +2012-11-15 Dmitry Antipov + + * 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 * variables.texi (Adding Generalized Variables): diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 68701a47126..475a9550f99 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1078,7 +1078,8 @@ editing. Many help commands use this feature. This function executes @var{forms} while arranging to insert any output they print into the buffer named @var{buffer-name}, which is first created if necessary, and put into Help mode. Finally, the buffer is -displayed in some window, but not selected. +displayed in some window, but not selected. (See the similar +form @code{with-temp-buffer-window} below.) If the @var{forms} do not change the major mode in the output buffer, so that it is still Help mode at the end of their execution, then @@ -1152,6 +1153,37 @@ displaying the temporary buffer. When the hook runs, the temporary buffer is current, and the window it was displayed in is selected. @end defvar +@defmac with-temp-buffer-window buffer-or-name action quit-function forms@dots{} +This macro is similar to @code{with-output-to-temp-buffer}. +Like that construct, it executes @var{forms} while arranging to insert +any output they print into the buffer named @var{buffer-or-name}. +Finally, the buffer is displayed in some window, but not selected. +Unlike @code{with-output-to-temp-buffer}, this does not switch to Help +mode. + +The argument @var{buffer-or-name} specifies the temporary buffer. +It can be either a buffer, which must already exist, or a string, +in which case a buffer of that name is created if necessary. +The buffer is marked as unmodified and read-only when +@code{with-temp-buffer-window} exits. + +This macro does not call @code{temp-buffer-show-function}. Rather, it +passes the @var{action} argument to @code{display-buffer} in order to +display the buffer. + +The value of the last form in @var{forms} is returned, unless the +argument @var{quit-function} is specified. In that case, +it is called with two arguments: the window showing the buffer +and the result of @var{forms}. The final return value is then +whatever @var{quit-function} returns. + +@vindex temp-buffer-window-setup-hook +@vindex temp-buffer-window-show-hook +This macro uses the normal hooks @code{temp-buffer-window-setup-hook} +and @code{temp-buffer-window-show-hook} in place of the analogous hooks +run by @code{with-output-to-temp-buffer}. +@end defmac + @defun momentary-string-display string position &optional char message This function momentarily displays @var{string} in the current buffer at @var{position}. It has no effect on the undo list or on the buffer's @@ -2009,12 +2041,11 @@ Don't underline. Underline with the foreground color of the face. @item @var{color} -Underline in color @var{color}; which should be either a string -specifying a color, or the symbol @code{foreground-color}, meaning the -foreground color of the face. +Underline in color @var{color}, a string specifying a color. @item @code{(:color @var{color} :style @var{style})} -@var{color} is as described above. Omitting the attribute +@var{color} is either a string, or the symbol @code{foreground-color}, +meaning the foreground color of the face. Omitting the attribute @code{:color} means to use the foreground color of the face. @var{style} should be a symbol @code{line} or @code{wave}, meaning to use a straight or wavy line. Omitting the attribute @code{:style} @@ -2404,7 +2435,7 @@ This sets the @code{:slant} attribute of @var{face} to @var{normal} if @var{italic-p} is @code{nil}, and to @var{italic} otherwise. @end defun -@defun set-face-underline-p face underline &optional frame +@defun set-face-underline face underline &optional frame This sets the @code{:underline} attribute of @var{face} to @var{underline}. @end defun @@ -2467,12 +2498,16 @@ attribute of @var{face} is @code{italic} or @code{oblique}, and @code{nil} otherwise. @end defun +@c Note the weasel words. A face that inherits from an underlined +@c face but does not specify :underline will return nil. @defun face-underline-p face &optional frame -This function returns the @code{:underline} attribute of face @var{face}. +This function returns non-@code{nil} if face @var{face} specifies +a non-@code{nil} @code{:underline} attribute. @end defun @defun face-inverse-video-p face &optional frame -This function returns the @code{:inverse-video} attribute of face @var{face}. +This function returns non-@code{nil} if face @var{face} specifies +a non-@code{nil} @code{:inverse-video} attribute. @end defun @node Displaying Faces diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 27d55c4fdb9..846dfbaf17c 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1113,6 +1113,21 @@ The argument @var{pretend} has the same meaning as in @code{set-frame-height}. @end defun +@c FIXME? Belongs more in Emacs manual than here? +@c But eg fit-window-to-buffer is in this manual. +@deffn Command fit-frame-to-buffer &optional frame max-height min-height +This command adjusts the height of @var{frame} (the default is the +selected frame) to fit its contents. The optional arguments +@var{max-height} and @var{min-height} specify the maximum and minimum +new frame heights, respectively. + +@vindex fit-frame-to-buffer-bottom-margin +The default minimum height corresponds to @code{window-min-height}. +The default maximum height is the screen height below the current top +position of the frame, minus any margin specified by the option +@code{fit-frame-to-buffer-bottom-margin}. +@end deffn + @node Geometry @subsection Geometry diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 1459f52d979..2a2846921c5 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -226,12 +226,11 @@ of 8k bytes, and small vectors are packed into blocks of 4k bytes). 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 @@ -284,88 +283,147 @@ the amount of space in use. (Garbage collection can also occur 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-vector-slots -The total number of elements of existing vectors. +@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-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}), @@ -388,23 +446,25 @@ careful writing them. @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. +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 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. +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 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. +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 @@ -639,7 +699,12 @@ in the file @file{lisp.h}.) If the primitive has no upper limit on 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 @@ -820,23 +885,70 @@ knows about it. @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. + 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}. - 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 + 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. @@ -912,12 +1024,8 @@ Some of the fields of @code{struct buffer} are: @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 @@ -928,6 +1036,11 @@ A pointer to the @code{buffer_text} structure for this buffer. In an 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. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index f658f7e66fb..d01ecba4bed 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -664,7 +664,9 @@ additional active keymaps through the variable The highest precedence normal keymap comes from the @code{keymap} text or overlay property. If that is non-@code{nil}, it is the first -keymap to be processed, in normal circumstances. +keymap to be processed, in normal circumstances. Next comes +any keymap added by the function @code{set-temporary-overlay-map}. +@xref{Controlling Active Maps}. However, there are also special ways for programs to substitute other keymaps for some of those. The variable @@ -753,12 +755,13 @@ them: (overriding-local-map (@var{find-in} overriding-local-map)) ((or (@var{find-in} (get-char-property (point) 'keymap)) - (@var{find-in-any} emulation-mode-map-alists) - (@var{find-in-any} minor-mode-overriding-map-alist) - (@var{find-in-any} minor-mode-map-alist) - (if (get-text-property (point) 'local-map) - (@var{find-in} (get-char-property (point) 'local-map)) - (@var{find-in} (current-local-map)))))) + (@var{find-in} @var{temp-map}) + (@var{find-in-any} emulation-mode-map-alists) + (@var{find-in-any} minor-mode-overriding-map-alist) + (@var{find-in-any} minor-mode-map-alist) + (if (get-text-property (point) 'local-map) + (@var{find-in} (get-char-property (point) 'local-map)) + (@var{find-in} (current-local-map)))))) (@var{find-in} (current-global-map))) @end lisp @@ -770,7 +773,8 @@ Lookup}.) If the key sequence starts with a mouse event, or a symbolic prefix event followed by a mouse event, that event's position is used instead of point and the current buffer. Mouse events on an embedded string use non-@code{nil} text properties from that string -instead of the buffer. +instead of the buffer. @var{temp-map} is a pseudo variable that +represents the effect of a @code{set-temporary-overlay-map} call. When a match is found (@pxref{Key Lookup}), if the binding in the keymap is a function, the search is over. However if the keymap entry @@ -950,6 +954,21 @@ are used before @code{minor-mode-map-alist} and @code{minor-mode-overriding-map-alist}. @end defvar +@defun set-temporary-overlay-map keymap &optional keep +This function adds @var{keymap} as a temporary keymap that takes +precedence over most other keymaps. It does not take precedence over +the ``overriding'' maps (see above); and unlike them, if no match for +a key is found in @var{keymap}, the search continues. + +Normally, @var{keymap} is used only once. If the optional argument +@var{pred} is @code{t}, the map stays active if a key from @var{keymap} +is used. @var{pred} can also be a function of no arguments: if it returns +non-@code{nil} then @var{keymap} stays active. + +For a pseudo-Lisp description of exactly how and when this keymap applies, +@pxref{Searching Keymaps}. +@end defun + @node Key Lookup @section Key Lookup @cindex key lookup @@ -1540,14 +1559,11 @@ sequence, to translate certain event sequences into others. being read, as it is read, against @code{input-decode-map}, then @code{local-function-key-map}, and then against @code{key-translation-map}. -@defvar input-decode-map -This variable holds a keymap that describes the character sequences sent -by function keys on an ordinary character terminal. This keymap has the -same structure as other keymaps, but is used differently: it specifies -translations to make while reading key sequences, rather than bindings -for key sequences. +These keymaps have the same structure as other keymaps, but they are used +differently: they specify translations to make while reading key sequences, +rather than bindings for key sequences. -If @code{input-decode-map} ``binds'' a key sequence @var{k} to a vector +If one of these keymaps ``binds'' a key sequence @var{k} to a vector @var{v}, then when @var{k} appears as a subsequence @emph{anywhere} in a key sequence, it is replaced with the events in @var{v}. @@ -1562,6 +1578,10 @@ Thus, typing @kbd{C-c @key{PF1}} sends the character sequence @kbd{C-c this back into @kbd{C-c @key{PF1}}, which it returns as the vector @code{[?\C-c pf1]}. +@defvar input-decode-map +This variable holds a keymap that describes the character sequences sent +by function keys on an ordinary character terminal. + The value of @code{input-decode-map} is usually set up automatically according to the terminal's Terminfo or Termcap entry, but sometimes those need help from terminal-specific Lisp files. Emacs comes with @@ -1636,8 +1656,6 @@ to turn the character that follows into a Hyper character: (let ((symbol (if (symbolp e) e (car e)))) (setq symbol (intern (concat string (symbol-name symbol)))) -@end group -@group (if (symbolp e) symbol (cons symbol (cdr e))))) @@ -1647,10 +1665,30 @@ to turn the character that follows into a Hyper character: @end example If you have enabled keyboard character set decoding using -@code{set-keyboard-coding-system}, decoding is done after the -translations listed above. @xref{Terminal I/O Encoding}. However, in -future Emacs versions, character set decoding may be done at an -earlier stage. +@code{set-keyboard-coding-system}, decoding is done before the +translations listed above. @xref{Terminal I/O Encoding}. + +@subsection Interaction with normal keymaps + +The end of a key sequence is detected when that key sequence either is bound +to a command, or when Emacs determines that no additional event can lead +to a sequence that is bound to a command. + +This means that, while @code{input-decode-map} and @code{key-translation-map} +apply regardless of whether the original key sequence would have a binding, the +presence of such a binding can still prevent translation from taking place. +For example, let us return to our VT100 example above and add a binding for +@kbd{C-c @key{ESC}} to the global map; now when the user hits @kbd{C-c +@key{PF1}} Emacs will fail to decode @kbd{C-c @key{ESC} O P} into @kbd{C-c +@key{PF1}} because it will stop reading keys right after @kbd{C-x @key{ESC}}, +leaving @kbd{O P} for later. This is in case the user really hit @kbd{C-c +@key{ESC}}, in which case Emacs should not sit there waiting for the next key +to decide whether the user really pressed @kbd{@key{ESC}} or @kbd{@key{PF1}}. + +For that reason, it is better to avoid binding commands to key sequences where +the end of the key sequence is a prefix of a key translation. The main such +problematic suffixes/prefixes are @kbd{@key{ESC}}, @kbd{M-O} (which is really +@kbd{@key{ESC} O}) and @kbd{M-[} (which is really @kbd{@key{ESC} [}). @node Key Binding Commands @section Commands for Binding Keys @@ -2629,8 +2667,8 @@ By default, the global map binds @code{[tool-bar]} as follows: @example (global-set-key [tool-bar] - `(menu-item ,(purecopy "tool bar") ignore - :filter tool-bar-make-keymap)) + `(menu-item ,(purecopy "tool bar") ignore + :filter tool-bar-make-keymap)) @end example @noindent diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 3a511d34829..54acd0b4d4c 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -113,6 +113,25 @@ When loading a source file (not compiled), @code{load} performs character set translation just as Emacs would do when visiting the file. @xref{Coding Systems}. +@c This is referred to from the Macros chapter. +@c Not sure if it should be the other way round. +@cindex eager macro expansion +When loading an uncompiled file, Emacs tries to expand any macros +that the file contains (@pxref{Macros}). We refer to this as +@dfn{eager macro expansion}. Doing this (rather than deferring +the expansion until the relevant code runs) can significantly speed +up the execution of uncompiled code. Sometimes, this macro expansion +cannot be done, owing to a cyclic dependency. In the simplest +example of this, the file you are loading refers to a macro defined +in another file, and that file in turn requires the file you are +loading. This is generally harmless. Emacs prints a warning +(@samp{Eager macro-expansion skipped due to cycle@dots{}}) +giving details of the problem, but it still loads the file, just +leaving the macro unexpanded for now. You may wish to restructure +your code so that this does not happen. Loading a compiled file does +not cause macroexpansion, because this should already have happened +during compilation. @xref{Compiling Macros}. + Messages like @samp{Loading foo...} and @samp{Loading foo...done} appear in the echo area during loading unless @var{nomessage} is non-@code{nil}. diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi index 8be6a3fbcde..b0dee1bf215 100644 --- a/doc/lispref/macros.texi +++ b/doc/lispref/macros.texi @@ -86,6 +86,10 @@ macro. calls to other macros. It may even be a call to the same macro, though this is unusual. + Note that Emacs tries to expand macros when loading an uncompiled +Lisp file. This is not always possible, but if it is, it speeds up +subsequent execution. @xref{How Programs Do Loading}. + You can see the expansion of a given macro call by calling @code{macroexpand}. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 7243f46b882..033c10fbf7d 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -886,6 +886,26 @@ Here is an example: @end smallexample @end defmac +@c FIXME? completion-table-with-context? +@findex completion-table-case-fold +@findex completion-table-in-turn +@findex completion-table-subvert +@findex completion-table-with-quoting +@findex completion-table-with-predicate +@findex completion-table-with-terminator +@cindex completion table, modifying +@cindex completion tables, combining +There are several functions that take an existing completion table and +return a modified version. @code{completion-table-case-fold} returns +a case-insensitive table. @code{completion-table-in-turn} combines +multiple input tables. @code{completion-table-subvert} alters a table +to use a different initial prefix. @code{completion-table-with-quoting} +returns a table suitable for operating on quoted text. +@code{completion-table-with-predicate} filters a table with a +predicate function. @code{completion-table-with-terminator} adds a +terminating string. + + @node Minibuffer Completion @subsection Completion and the Minibuffer @cindex minibuffer completion @@ -1710,8 +1730,9 @@ string, and @var{end} is the position of the end boundary in @item metadata This specifies a request for information about the state of the -current completion. The function should return an alist, as described -below. The alist may contain any number of elements. +current completion. The return value should have the form +@code{(metadata . @var{alist})}, where @var{alist} is an alist whose +elements are described below. @end table @noindent diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index bb02b1d54fd..b8581b1cc62 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -490,6 +490,8 @@ partially-visible line at the bottom of the text area is not counted. aliases are considered obsolete and will be removed in the future. @cindex fixed-size window +@vindex window-min-height +@vindex window-min-width Commands that change the size of windows (@pxref{Resizing Windows}), or split them (@pxref{Splitting Windows}), obey the variables @code{window-min-height} and @code{window-min-width}, which specify @@ -633,6 +635,10 @@ variable @code{window-min-height}. If the optional argument @var{override} is non-@code{nil}, this function ignores any size restrictions imposed by @code{window-min-height} and @code{window-min-width}. + +@vindex fit-frame-to-buffer +If the option @code{fit-frame-to-buffer} is non-@code{nil}, this +command may resize the frame to fit its contents. @end deffn @deffn Command shrink-window-if-larger-than-buffer &optional window @@ -1055,7 +1061,7 @@ including the space earlier stolen from @code{W3}. @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. @@ -1766,6 +1772,7 @@ Like @code{switch-to-buffer}, this function updates the buffer list unless @var{norecord} is non-@code{nil}. @end deffn + @node Choosing Window @section Choosing a Window for Display @@ -1851,10 +1858,14 @@ default value is empty, i.e. @code{(nil . nil)}. @end defvar @defopt display-buffer-alist -The value of this option is an alist mapping regular expressions to -display actions. If the name of the buffer passed to -@code{display-buffer} matches a regular expression in this alist, then -@code{display-buffer} uses the corresponding display action. +The value of this option is an alist mapping conditions to display +actions. Each condition may be either a regular expression matching a +buffer name or a function that takes two arguments - a buffer name and +the @var{action} argument passed to @code{display-buffer}. If the name +of the buffer passed to @code{display-buffer} either matches a regular +expression in this alist or the function specified by a condition +returns non-@code{nil}, then @code{display-buffer} uses the +corresponding display action to display the buffer. @end defopt @defopt display-buffer-base-action @@ -1868,6 +1879,7 @@ This display action specifies the fallback behavior for @code{display-buffer} if no other display actions are given. @end defvr + @node Display Action Functions @section Action Functions for @code{display-buffer} @@ -1911,15 +1923,18 @@ normally searches just the selected frame; however, if the variable @code{pop-up-frames} is non-@code{nil}, it searches all frames on the current terminal. @xref{Choosing Window Options}. -If this function chooses a window on another frame, it makes that -frame visible and raises it if necessary. +If this function chooses a window on another frame, it makes that frame +visible and, unless @var{alist} contains an @code{inhibit-switch-frame} +entry (@pxref{Choosing Window Options}), raises that frame if necessary. @end defun @defun display-buffer-pop-up-frame buffer alist This function creates a new frame, and displays the buffer in that frame's window. It actually performs the frame creation by calling the function specified in @code{pop-up-frame-function} -(@pxref{Choosing Window Options}). +(@pxref{Choosing Window Options}). If @var{alist} contains a +@code{pop-up-frame-parameters} entry, the associated value +is added to the newly created frame's parameters. @end defun @defun display-buffer-pop-up-window buffer alist @@ -1976,16 +1991,12 @@ reason (e.g. if there is just one frame and it has an @code{unsplittable} frame parameter; @pxref{Buffer Parameters}). @end defun -@defun display-buffer-use-some-window buffer alist -This function tries to display @var{buffer} by choosing an existing -window and displaying the buffer in that window. It can fail if all -windows are dedicated to another buffer (@pxref{Dedicated Windows}). -@end defun - @defun display-buffer-below-selected buffer alist This function tries to display @var{buffer} in a window below the -selected window. This means to either split the selected window or -reuse the window below the selected one. +selected window. This means to either split the selected window or use +the window below the selected one. If it does create a new window, it +will also adjust its size provided @var{alist} contains a suitable +@code{window-height} or @code{window-width} entry, see above. @end defun @defun display-buffer-in-previous-window buffer alist @@ -2001,6 +2012,83 @@ specified by that entry will override any other window found by the methods above, even if that window never showed @var{buffer} before. @end defun +@defun display-buffer-use-some-window buffer alist +This function tries to display @var{buffer} by choosing an existing +window and displaying the buffer in that window. It can fail if all +windows are dedicated to another buffer (@pxref{Dedicated Windows}). +@end defun + +To illustrate the use of action functions, consider the following +example. + +@example +@group +(display-buffer + (get-buffer-create "*foo*") + '((display-buffer-reuse-window + display-buffer-pop-up-window + display-buffer-pop-up-frame) + (reusable-frames . 0) + (window-height . 10) (window-width . 40))) +@end group +@end example + +@noindent +Evaluating the form above will cause @code{display-buffer} to proceed as +follows: If `*foo*' already appears on a visible or iconified frame, it +will reuse its window. Otherwise, it will try to pop up a new window +or, if that is impossible, a new frame. If all these steps fail, it +will try to use some existing window. + + Furthermore, @code{display-buffer} will try to adjust a reused window +(provided `*foo*' was put by @code{display-buffer} there before) or a +popped-up window as follows: If the window is part of a vertical +combination, it will set its height to ten lines. Note that if, instead +of the number ``10'', we specified the function +@code{fit-window-to-buffer}, @code{display-buffer} would come up with a +one-line window to fit the empty buffer. If the window is part of a +horizontal combination, it sets its width to 40 columns. Whether a new +window is vertically or horizontally combined depends on the shape of +the window split and the values of +@code{split-window-preferred-function}, @code{split-height-threshold} +and @code{split-width-threshold} (@pxref{Choosing Window Options}). + + Now suppose we combine this call with a preexisting setup for +`display-buffer-alist' as follows. + +@example +@group +(let ((display-buffer-alist + (cons + '("\\*foo\\*" + (display-buffer-reuse-window display-buffer-below-selected) + (reusable-frames) + (window-height . 5)) + display-buffer-alist))) + (display-buffer + (get-buffer-create "*foo*") + '((display-buffer-reuse-window + display-buffer-pop-up-window + display-buffer-pop-up-frame) + (reusable-frames . 0) + (window-height . 10) (window-width . 40)))) +@end group +@end example + +@noindent +Evaluating this form will cause @code{display-buffer} to first try +reusing a window showing @code{*foo*} on the selected frame. +If no such window exists, it will try to split the selected window or, +if that is impossible, use the window below the selected window. + + If there's no window below the selected one, or the window below the +selected one is dedicated to its buffer, @code{display-buffer} will +proceed as described in the previous example. Note, however, that when +it tries to adjust the height of any reused or popped-up window, it will +in any case try to set its number of lines to ``5'' since that value +overrides the corresponding specification in the @var{action} argument +of @code{display-buffer}. + @node Choosing Window Options @section Additional Options for Displaying Buffers @@ -2343,7 +2431,7 @@ buffer previously shown no longer exists, this function calls @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 diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 7322613e0db..39931f3a779 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,20 @@ +2012-11-17 Paul Eggert + + 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 + + * cl.texi (Function Bindings): Clarify that cl-flet is lexical. + (Obsolete Macros): Move example here from Function Bindings. + + * 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-13 Glenn Morris * flymake.texi (Customizable variables) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 2b198575bcb..6daceb4d41a 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -11010,35 +11010,41 @@ You can use the @kbd{v p} (@code{calc-pack}) and @kbd{v u} 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{} is @samp{}. 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. @@ -11046,15 +11052,6 @@ 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{} is @samp{}. 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 diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index a50be1027f3..beefa3e9c40 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1292,28 +1292,14 @@ it were a @code{cl-defun} form. The function @var{name} is defined accordingly for the duration of the body of the @code{cl-flet}; then the old function definition, or lack thereof, is restored. -You can use @code{cl-flet} to disable or modify the behavior of a -function in a temporary fashion. (Compare this with the idea -of advising functions. +You can use @code{cl-flet} to disable or modify the behavior of +functions (including Emacs primitives) in a temporary, localized fashion. +(Compare this with the idea of advising functions. @xref{Advising Functions,,,elisp,GNU Emacs Lisp Reference Manual}.) -This will even work on Emacs primitives, although note that some calls -to primitive functions internal to Emacs are made without going -through the symbol's function cell, and so will not be affected by -@code{cl-flet}. For example, -@example -(cl-flet ((message (&rest args) (push args saved-msgs))) - (do-something)) -@end example - -This code attempts to replace the built-in function @code{message} -with a function that simply saves the messages in a list rather -than displaying them. The original definition of @code{message} -will be restored after @code{do-something} exits. This code will -work fine on messages generated by other Lisp code, but messages -generated directly inside Emacs will not be caught since they make -direct C-language calls to the message routines rather than going -through the Lisp @code{message} function. +The bindings are lexical in scope. This means that all references to +the named functions must appear physically within the body of the +@code{cl-flet} form. Functions defined by @code{cl-flet} may use the full Common Lisp argument notation supported by @code{cl-defun}; also, the function @@ -1321,7 +1307,8 @@ body is enclosed in an implicit block as if by @code{cl-defun}. @xref{Program Structure}. Note that the @file{cl.el} version of this macro behaves slightly -differently. @xref{Obsolete Macros}. +differently. In particular, its binding is dynamic rather than +lexical. @xref{Obsolete Macros}. @end defmac @defmac cl-labels (bindings@dots{}) forms@dots{} @@ -4863,6 +4850,25 @@ time before Emacs had lexical binding). The result is that @code{flet} affects indirect calls to a function as well as calls directly inside the @code{flet} form itself. +This will even work on Emacs primitives, although note that some calls +to primitive functions internal to Emacs are made without going +through the symbol's function cell, and so will not be affected by +@code{flet}. For example, + +@example +(flet ((message (&rest args) (push args saved-msgs))) + (do-something)) +@end example + +This code attempts to replace the built-in function @code{message} +with a function that simply saves the messages in a list rather +than displaying them. The original definition of @code{message} +will be restored after @code{do-something} exits. This code will +work fine on messages generated by other Lisp code, but messages +generated directly inside Emacs will not be caught since they make +direct C-language calls to the message routines rather than going +through the Lisp @code{message} function. + @c Bug#411. Note that many primitives (e.g.@: @code{+}) have special byte-compile handling. Attempts to redefine such functions using @code{flet} will diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 378180bef31..834d2ea844d 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -390,11 +390,6 @@ Complete nicknames and commands (programmable) @item fill Wrap long lines -@cindex modules, hecomplete -@item hecomplete -Complete nicknames and commands (old). This is the old module---you -might prefer the ``completion'' module instead. - @cindex modules, identd @item identd Launch an identd server on port 8113 @@ -427,6 +422,11 @@ Don't display non-IRC commands after evaluation @item notify Notify when the online status of certain users changes +@cindex modules, notifications +@item notifications +Send you a notification when you get a private message, +or your nickname is mentioned + @cindex modules, page @item page Process CTCP PAGE requests from IRC @@ -530,7 +530,7 @@ parameters. @defun erc-compute-server &optional server Return an IRC server name. -This tries a number of increasingly more default methods until a non-nil +This tries a number of increasingly more default methods until a non-@code{nil} value is found. @itemize @bullet @@ -542,7 +542,7 @@ value is found. @end defun -@defopt erc-server nil +@defopt erc-server IRC server to use if one is not provided. @end defopt @@ -551,7 +551,7 @@ IRC server to use if one is not provided. @defun erc-compute-port &optional port Return a port for an IRC server. -This tries a number of increasingly more default methods until a non-nil +This tries a number of increasingly more default methods until a non-@code{nil} value is found. @itemize @bullet @@ -574,7 +574,7 @@ This can be either a string or a number. Return user's IRC nick. This tries a number of increasingly more default methods until a -non-nil value is found. +non-@code{nil} value is found. @itemize @item @var{nick} (the argument passed to this function) @@ -598,19 +598,43 @@ The string to append to the nick if it is already in use. @end defopt @defopt erc-try-new-nick-p -If the nickname you chose isn't available, and this option is non-nil, +If the nickname you chose isn't available, and this option is non-@code{nil}, ERC should automatically attempt to connect with another nickname. You can manually set another nickname with the /NICK command. @end defopt +@subheading Password +@cindex password + +@defopt erc-prompt-for-password +If non-@code{nil} (the default), @kbd{M-x erc} prompts for a password. +@end defopt + +If you prefer, you can set this option to @code{nil} and use the +@code{auth-source} mechanism to store your password. For instance, if +you use @file{~/.authinfo} as your auth-source backend, then put +something like the following in that file: + +@example +machine irc.example.net login "#fsf" password sEcReT +@end example + +@noindent +ERC also consults @code{auth-source} to find any channel keys required +for the channels that you wish to autojoin, as specified by the +variable @code{erc-autojoin-channels-alist}. + +For more details, @pxref{Top,,auth-source, auth, Emacs auth-source Library}. + + @subheading Full name @defun erc-compute-full-name &optional full-name Return user's full name. This tries a number of increasingly more default methods until a -non-nil value is found. +non-@code{nil} value is found. @itemize @bullet @item @var{full-name} (the argument passed to this function) @@ -713,10 +737,24 @@ stuff, to the current ERC buffer." @c PRE5_4: (Node) Document every ERC option (module options go in @c previous chapter) -This section has not yet been written. For now, the easiest way to -check out the available options for ERC is to do +This section is extremely incomplete. For now, the easiest way to +check out all the available options for ERC is to do @kbd{M-x customize-group erc RET}. +@defopt erc-hide-list +If non, @code{nil}, this is a list of IRC message types to hide, e.g. + +@example +(setq erc-hide-list '("JOIN" "PART" "QUIT")) +@end example +@end defopt + +@defopt erc-lurker-hide-list +Like @code{erc-hide-list}, but only applies to messages sent by +lurkers. The function @code{erc-lurker-p} determines whether a given +nickname is considerd a lurker. +@end defopt + @node Getting Help and Reporting Bugs @chapter Getting Help and Reporting Bugs diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 5de87a2f1c7..cccd74dec0f 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -482,9 +482,9 @@ show column letters again. 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. +@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 @@ -606,15 +606,15 @@ instance @code{(ses-range A1 A4 _ "empty")} will do the same as 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 rowwise from top left +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 -List cells by reading cells columnwise from top left to bottom right. +List cells by reading cells column-wise from top left to bottom right. @item v< -List cells by reading cells columnwise from top right to bottom left. +List cells by reading cells column-wise from top right to bottom left. @item v A short hand for @code{v>}. @item ^ diff --git a/doc/misc/url.texi b/doc/misc/url.texi index fdb3ab452f2..90ab7f5554f 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -346,7 +346,7 @@ To use this function, you must @code{(require 'url-queue)}. 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 diff --git a/etc/NEWS b/etc/NEWS index 32dea505e02..57e40982af6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -25,7 +25,14 @@ so we will look at it and add it to the manual. * Startup Changes in Emacs 24.4 * Changes in Emacs 24.4 * Editing Changes in Emacs 24.4 + + * Changes in Specialized Modes and Packages in Emacs 24.4 + ++++ +** New function `ses-rename-cell' to give SES cells arbitrary names. + + * New Modes and Packages in Emacs 24.4 ** New nadvice.el package offering lighter-weight advice facilities. It is layered as: @@ -36,6 +43,9 @@ It is layered as: * 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. @@ -51,6 +61,11 @@ 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. + * Installation Changes in Emacs 24.3 @@ -351,6 +366,8 @@ provide the old non-prefixed names. Some exceptions are listed below. +++ *** `cl-flet' is not like `flet' (which is deprecated). Instead it obeys the behavior of Common-Lisp's `flet'. +In particular, in cl-flet function definitions are lexically scoped, +whereas in flet the scoping is dynamic. +++ *** `cl-labels' is slightly different from `labels'. @@ -465,12 +482,18 @@ The global binding for `M-=', `count-words-region' is in effect. ** ERC -*** New package `erc-desktop-notifications.el', which can send a notification -when you receive a private message or your nickname is mentioned. ++++ +*** New module "notifications", which can send a notification when you +receive a private message or your nickname is mentioned. ++++ *** ERC will look up server/channel names via auth-source and use any channel keys found. ++++ +*** New option `erc-lurker-hide-list', similar to `erc-hide-list', but +only applies to messages sent by lurkers. + +++ ** Flymake uses fringe bitmaps to indicate errors and warnings. See `flymake-fringe-indicator-position', `flymake-error-bitmap' and @@ -658,8 +681,7 @@ enabled, applies to all applicable major modes. ** winner-mode-hook now runs when the mode is disabled, as well as when it is enabled. -** FIXME something happened to ses.el, 2012-04-17. - ++++ ** Hooks renamed to avoid obsolete "-hooks" suffix: *** semantic-lex-reset-hooks -> semantic-lex-reset-functions *** semantic-change-hooks -> semantic-change-functions @@ -836,6 +858,7 @@ More commands use `read-regexp' now to read their regexp arguments. *** New function `completion-table-with-quoting' to handle completion in the presence of quoting, such as file completion in shell buffers. ++++ *** New function `completion-table-subvert' to use an existing completion table, but with a different prefix. @@ -864,24 +887,33 @@ now accept a third argument to avoid choosing the selected window. +++ *** Additional values recognized for option `window-combination-limit'. -*** New macro `with-temp-buffer-window'. ++++ +*** New macro `with-temp-buffer-window', similar to +`with-output-to-temp-buffer'. +--- *** `temp-buffer-resize-mode' no longer resizes windows that have been reused. -*** New function `fit-frame-to-buffer' and new options -`fit-frame-to-buffer' and `fit-frame-to-buffer-bottom-margin'. ++++ +*** New command `fit-frame-to-buffer' adjusts the frame height to +fit the contents. + ++++ +*** The command `fit-window-to-buffer' can adjust the frame height +if the new option `fit-frame-to-buffer' is non-nil. + +++ *** New option switch-to-buffer-preserve-window-point to restore a window's point when switching buffers. +++ *** New display action functions `display-buffer-below-selected', and `display-buffer-in-previous-window'. - ++++ *** New display action alist entry `inhibit-switch-frame', if non-nil, tells display action functions to avoid changing which frame is selected. - ++++ *** New display action alist entry `pop-up-frame-parameters', if non-nil, specifies frame parameters to give any newly-created frame. +++ @@ -937,13 +969,14 @@ Previously, they returned NaNs on some platforms but signaled errors on others. The affected functions are acos, asin, tan, exp, expt, log, log10, sqrt, and mod. -** Interpreted files are eagerly macro-expanded during load. ++++ +** Emacs tries to macroexpand interpreted (non-compiled) files during load. This can significantly speed up execution of non-byte-compiled code, -but can also bump into harmless and previously unnoticed cyclic -dependencies. These should not be fatal: they will simply cause the -macro-calls to be left for later expansion (as before), but will also -result in a warning ("Eager macro-expansion skipped due to cycle") -describing the cycle. +but can also bump into previously unnoticed cyclic dependencies. +These are generally harmless: they will simply cause the macro calls +to be left for later expansion (as before), but will result in a +warning ("Eager macro-expansion skipped due to cycle") describing the cycle. +You may wish to restructure your code so this does not happen. ** Miscellaneous new functions: +++ @@ -958,7 +991,9 @@ describing the cycle. *** `function-get' fetches a function property, following aliases. +++ *** `posnp' tests if an object is a `posn'. -*** `set-temporary-overlay-map' sets up a temporary overlay map. ++++ +*** `set-temporary-overlay-map' sets up a temporary keymap that +takes precedence over most other maps for a short while (normally one key). +++ *** `system-users' returns the user names on the system. +++ @@ -972,8 +1007,8 @@ describing the cycle. +++ ** New fringe bitmap `exclamation-mark'. ++++ ** Face underlining can now use a wave. -See the "Face Attributes" section of the Elisp manual. ** The following functions and variables are obsolete: --- diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 03cddc6a035..926297b6dd3 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,13 @@ +2012-11-17 Juanma Barranquero + + * makefile.w32-in (SYSWAIT_H): New macro. + ($(BLD)/movemail.$(O)): Update dependencies. + +2012-11-17 Paul Eggert + + Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881). + * movemail.c, update-game-score.c: Assume exists. + 2012-10-26 Glenn Morris * Makefile.in (uninstall): No INSTALLABLES live in archlibdir. diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index f3ab4421fd3..cbd29f32cfe 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -374,6 +374,8 @@ NTLIB_H = $(LIB_SRC)/ntlib.h \ 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 \ @@ -419,14 +421,14 @@ $(BLD)/make-docfile.$(O) : \ $(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 \ diff --git a/lib-src/movemail.c b/lib-src/movemail.c index 32d32e69abf..cd329a110a8 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -65,9 +65,7 @@ along with GNU Emacs. If not, see . */ #include #include -#ifdef HAVE_FCNTL_H #include -#endif #include #include "syswait.h" #ifdef MAIL_USE_POP diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c index 40397536fad..59cab61aa29 100644 --- a/lib-src/update-game-score.c +++ b/lib-src/update-game-score.c @@ -42,9 +42,7 @@ along with GNU Emacs. If not, see . */ #include #include #include -#ifdef HAVE_FCNTL_H #include -#endif #include #include diff --git a/lib/at-func.c b/lib/at-func.c new file mode 100644 index 00000000000..481eea475a1 --- /dev/null +++ b/lib/at-func.c @@ -0,0 +1,146 @@ +/* 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 . */ + +/* written by Jim Meyering */ + +#include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */ + +#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD +# include +# 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 diff --git a/lib/euidaccess.c b/lib/euidaccess.c new file mode 100644 index 00000000000..ca2ceca5d22 --- /dev/null +++ b/lib/euidaccess.c @@ -0,0 +1,221 @@ +/* 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 . */ + +/* Written by David MacKenzie and Torbjorn Granlund. + Adapted for GNU C library by Roland McGrath. */ + +#ifndef _LIBC +# include +#endif + +#include +#include +#include +#include + +#include "root-uid.h" + +#if HAVE_LIBGEN_H +# include +#endif + +#include +#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 + +#ifdef TEST +# include +# include +# include + +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 diff --git a/lib/faccessat.c b/lib/faccessat.c new file mode 100644 index 00000000000..d11a3efaad6 --- /dev/null +++ b/lib/faccessat.c @@ -0,0 +1,45 @@ +/* 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 . */ + +/* written by Eric Blake */ + +#include + +#include +#include + +#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" diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h new file mode 100644 index 00000000000..604c31b7984 --- /dev/null +++ b/lib/fcntl.in.h @@ -0,0 +1,347 @@ +/* Like , 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 . */ + +/* written by Paul Eggert */ + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +#if defined __need_system_fcntl_h +/* Special invocation convention. */ + +/* Needed before . + May also define off_t to a 64-bit type on native Windows. */ +#include +/* On some systems other than glibc, is a prerequisite of + . On glibc systems, we would like to avoid namespace pollution. + But on glibc systems, includes inside an + extern "C" { ... } block, which leads to errors in C++ mode with the + overridden 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 +#endif +#@INCLUDE_NEXT@ @NEXT_FCNTL_H@ + +#else +/* Normal invocation convention. */ + +#ifndef _@GUARD_PREFIX@_FCNTL_H + +/* Needed before . + May also define off_t to a 64-bit type on native Windows. */ +#include +/* On some systems other than glibc, is a prerequisite of + . On glibc systems, we would like to avoid namespace pollution. + But on glibc systems, includes inside an + extern "C" { ... } block, which leads to errors in C++ mode with the + overridden 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 +#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 +#endif + +/* Native Windows platforms declare open(), creat() in . */ +#if (@GNULIB_OPEN@ || defined GNULIB_POSIXCHECK) \ + && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) +# include +#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 diff --git a/lib/getgroups.c b/lib/getgroups.c new file mode 100644 index 00000000000..f9d36236afe --- /dev/null +++ b/lib/getgroups.c @@ -0,0 +1,116 @@ +/* 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 . */ + +/* written by Jim Meyering */ + +#include + +#include + +#include +#include +#include + +#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 */ diff --git a/lib/gnulib.mk b/lib/gnulib.mk index 324e5cb78fd..834f63169e2 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream 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 @@ -158,6 +158,17 @@ EXTRA_libgnu_a_SOURCES += dup2.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) @@ -183,6 +194,50 @@ EXTRA_libgnu_a_SOURCES += execinfo.c ## 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 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 @@ -200,6 +255,17 @@ 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 @@ -259,6 +325,17 @@ EXTRA_libgnu_a_SOURCES += gettimeofday.c ## 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 @@ -371,6 +448,15 @@ EXTRA_libgnu_a_SOURCES += readlink.c ## 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 @@ -1329,6 +1415,15 @@ EXTRA_DIST += verify.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 \ diff --git a/lib/group-member.c b/lib/group-member.c new file mode 100644 index 00000000000..5fcc7e01d0c --- /dev/null +++ b/lib/group-member.c @@ -0,0 +1,119 @@ +/* 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 . */ + +#include + +/* Specification. */ +#include + +#include +#include +#include + +#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 */ diff --git a/lib/root-uid.h b/lib/root-uid.h new file mode 100644 index 00000000000..2379773c291 --- /dev/null +++ b/lib/root-uid.h @@ -0,0 +1,30 @@ +/* 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 . + + 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 diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h new file mode 100644 index 00000000000..ad777d8dd79 --- /dev/null +++ b/lib/xalloc-oversized.h @@ -0,0 +1,38 @@ +/* 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 . */ + +#ifndef XALLOC_OVERSIZED_H_ +# define XALLOC_OVERSIZED_H_ + +# include + +/* 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_ */ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6ab2880f09f..ca65e431964 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,322 @@ +2012-11-18 Chong Yidong + + * filecache.el (file-cache--read-list): New function. + (file-cache-add-directory-list, file-cache-add-file-list) + (file-cache-delete-file-list, file-cache-delete-directory-list): + Use it to read a list of files or directories (Bug#12846). + (file-cache-add-file, file-cache-add-directory) + (file-cache-delete-file-list, file-cache-delete-file-regexp) + (file-cache-delete-directory): Print an message. + +2012-11-18 Jay Belanger + + * calc/calc-forms.el (math-date-to-dt): Use integer date when + calling `math-date-to-julian-dt' and 'math-date-to-gregorian-dt'. + +2012-11-18 Glenn Morris + + * image.el (insert-image, insert-sliced-image): Doc fix. + +2012-11-18 Chong Yidong + + * emacs-lisp/syntax.el (syntax-propertize-function): Doc fix + (Bug#12810). + +2012-11-18 OKAZAKI Tetsurou (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-18 Chong Yidong + + * filecache.el (file-cache-add-file-list): Doc fix (Bug#12694). + +2012-11-18 Glenn Morris + + * emacs-lisp/cl-lib.el (face-underline-p): + Use set-face-underline rather than the alias set-face-underline-p. + + * window.el (with-temp-buffer-window): Doc fix. + * subr.el (with-output-to-temp-buffer): + Add doc xref to with-temp-buffer-window. + +2012-11-18 Juanma Barranquero + + * woman.el (woman-non-underline-faces): Use `set-face-underline'. + * calc/calc.el (math-format-date-cache): Declare. + +2012-11-17 Paul Eggert + + * calc/calc-forms.el (math-julian-date-beginning) + (math-julian-date-beginning-int): Implement [new date numbering]. + +2012-11-17 Juanma Barranquero + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 (tiny change) + + * eshell/em-unix.el (eshell/mkdir): Handle "--parents" (bug#12897). + +2012-11-16 Stefan Monnier + + * 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 + + * window.el (enlarge-window, shrink-window): Don't mention return + value in doc-string (Bug#12896). + (window--display-buffer): Don't resize frames - it won't work + with all window managers and defeat pop-up-frame-alist. + (display-buffer-alist): In doc-string explain that CONDITION can + be a function and which arguments are passed to it (Bug#12854). + (display-buffer-assq-regexp): New argument ACTION. Handle lambda + expressions (Bug#12854). + (display-buffer): Pass ACTION argument to + display-buffer-assq-regexp. + +2012-11-16 Glenn Morris + + * window.el (fit-frame-to-buffer-bottom-margin) + (fit-frame-to-buffer, fit-window-to-buffer): Doc fixes. + + * faces.el (face-underline-p): Use face-attribute-specified-or. + +2012-11-16 Juanma Barranquero + + * emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes. + +2012-11-16 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring (bug#12895). + +2012-11-16 Glenn Morris + + * eshell/em-cmpl.el (eshell-pcomplete): New command. (Bug#12838) + (eshell-cmpl-initialize): Bind eshell-pcomplete to TAB, C-i. + + * faces.el (face-underline-p): Doc fix. Handle :underline being + things other than `t' (a string, a list). + (face-inverse-video-p): Doc fix. + (set-face-underline): Rename it back from set-face-underline-p. + Doc fix. Allow interactive input of values other than t. + (read-face-attribute): Apply formatting to :underline, + since like :box and :stipple it can take list values. + + * term.el (ansi-term): Don't let C-x escape-char binding + clobber the more standard C-c binding. (Bug#12842) + + * subr.el (set-temporary-overlay-map): Doc fix. + +2012-11-16 Martin Rudalics + + * 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-16 Glenn Morris + + * 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-15 Daniel Colascione + + * 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 + + * 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 + + * 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 + + * 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 + + * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717). + +2012-11-15 Stefan Monnier + + * 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 + + * 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 + + * 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 + + * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments + (bug#12879). + +2012-11-13 Dmitry Gutov + + * 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 + + * 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 + + * 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 + + * 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 + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): + Never font-lock the beginning of singleton class as heredoc. + 2012-11-13 Stefan Monnier * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871). diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index cebd4302d0c..9fc91a242d2 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -96,7 +96,7 @@ ;; ;; archive-mode-hook ;; archive-foo-mode-hook -;; archive-extract-hooks +;; archive-extract-hook ;;; Code: diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index bd748158d66..709250f9ba9 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -369,17 +369,67 @@ ;;; 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) @@ -387,32 +437,21 @@ (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 date) + (math-date-to-gregorian-dt date)))) (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)) @@ -423,7 +462,7 @@ (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) @@ -446,8 +485,12 @@ (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)) @@ -460,39 +503,104 @@ 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. @@ -548,13 +656,13 @@ (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) @@ -585,8 +693,7 @@ as measured in the integer number of days before January 1 of the year 1AD.") 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)) @@ -1098,7 +1205,7 @@ as measured in the integer number of days before January 1 of the year 1AD.") (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))) @@ -1298,7 +1405,7 @@ second, the number of seconds offset for daylight savings." 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) @@ -1434,28 +1541,100 @@ and ends on the last Sunday of October at 2 a.m." (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)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index f1643b10a76..aeca45ebf26 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -464,6 +464,52 @@ to be identified as that note." :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)) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 755f4c8159b..a01ce4c30a3 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,24 @@ +2012-11-16 David Engster + + * semantic/symref/list.el (semantic-symref-symbol): Use + `semantic-complete-read-tag-project' instead of + `semantic-complete-read-tag-buffer-deep', since the latter is not + working correctly. + + * semantic/symref.el (semantic-symref-result-get-tags): Use + `find-buffer-visiting' to follow symbolic links. + + * semantic/fw.el (semantic-find-file-noselect): Always set + `enable-local-variables' to `:safe' when loading files. + +2012-11-16 Glenn Morris + + * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): + * semantic/util.el (semantic-describe-buffer): + * semantic/bovine/c.el (semantic-c-parse-lexical-token) + (semantic-default-c-setup): + Use new names for hooks rather than obsolete aliases. + 2012-11-13 Stefan Monnier * semantic/mru-bookmark.el (semantic-mru-bookmark-mode): diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 02ad6e05d1a..a3d57108d1d 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -931,8 +931,8 @@ the regular parser." (setq semantic-new-buffer-fcn-was-run t) (semantic-lex-init) (semantic-clear-toplevel-cache) - (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook - t) + (remove-hook 'semantic-lex-reset-functions + 'semantic-lex-spp-reset-hook t) ) ;; Get the macro symbol table right. (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms) @@ -2073,7 +2073,7 @@ actually in their parent which is not accessible.") ) (setq semantic-lex-analyzer #'semantic-c-lexer) - (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) + (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t) (when (eq major-mode 'c++-mode) (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . ""))) ) diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 5a12047eb76..14ffc808c44 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -421,14 +421,7 @@ into `mode-local-init-hook'." file filename) ;; Don't prompt to insert a template if we visit an empty file (auto-insert nil) ;; We don't want emacs to query about unsafe local variables - (enable-local-variables - (if (featurep 'xemacs) - ;; XEmacs only has nil as an option? - nil - ;; Emacs 23 has the spiffy :safe option, nil otherwise. - (if (>= emacs-major-version 22) - nil - :safe))) + (enable-local-variables :safe) ;; ... or eval variables (enable-local-eval nil) ) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 406f2900563..ad366c2b94f 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -30,7 +30,7 @@ ;; If you use SPP in your language, be sure to specify this in your ;; semantic language setup function: ;; -;; (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) +;; (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t) ;; ;; ;; Special Lexical Tokens: @@ -947,8 +947,8 @@ and variable state from the current buffer." (setq semantic-new-buffer-fcn-was-run t) (semantic-lex-init) (semantic-clear-toplevel-cache) - (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook - t) + (remove-hook 'semantic-lex-reset-functions + 'semantic-lex-spp-reset-hook t) )) ;; Second Cheat: copy key variables regarding macro state from the diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index 540c766cc94..ad897680d7f 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -356,7 +356,7 @@ already." (lambda (hit) (let* ((line (car hit)) (file (cdr hit)) - (buff (get-file-buffer file)) + (buff (find-buffer-visiting file)) (tag nil) ) (cond diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 55ccf1c103f..729bd8e153c 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -69,7 +69,7 @@ current project to find references to the input SYM. The references are organized by file and the name of the function they are used in. Display the references in `semantic-symref-results-mode'." - (interactive (list (semantic-tag-name (semantic-complete-read-tag-buffer-deep + (interactive (list (semantic-tag-name (semantic-complete-read-tag-project "Symrefs for: ")))) (semantic-fetch-tags) (let ((res nil) diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 65201c4fd12..f3d30f6af5c 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -280,7 +280,7 @@ If TAG is not specified, use the tag at point." semantic-parser-name semantic-parse-tree-state semantic-lex-analyzer - semantic-lex-reset-hooks + semantic-lex-reset-functions semantic-lex-syntax-modifications ))) (dolist (V vars) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 0c7f82d516e..c384b96df86 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -374,6 +374,8 @@ This function is semi-obsolete. Use `get-char-code-property'." (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. diff --git a/lisp/dired.el b/lisp/dired.el index 5f7ee48a810..f6056e20d0a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3732,6 +3732,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;; 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." diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 5e825032741..a66fc23dec1 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -220,6 +220,9 @@ the mode if ARG is omitted or nil." (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. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 16c12aad29b..c2ebb3bbdc6 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -47,14 +47,12 @@ ;; @ 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 @@ -63,7 +61,7 @@ ;; 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. @@ -77,7 +75,7 @@ ;; - 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: ;; ===================================== @@ -113,23 +111,12 @@ ;; 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 . - ;; @ 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: @@ -137,45 +124,37 @@ ;; - 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) @@ -206,13 +185,12 @@ ;; @ 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". @@ -236,22 +214,22 @@ ;; 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 specifies where in the current list of advices of -;; the specified this new advice will be placed. has to +;; the specified this new advice will be placed. 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 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. @@ -267,10 +245,10 @@ ;; `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 can be supplied to document the advice. @@ -278,20 +256,20 @@ ;; documentation strings of the original function and other advices. ;; An optional 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 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): @@ -330,11 +308,11 @@ ;; 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 @@ -343,45 +321,44 @@ ;; ;; 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 ;; > -;; 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). @@ -393,9 +370,9 @@ ;; ;; (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): @@ -408,17 +385,17 @@ ;; `(ad-get-arg )' will return the actual argument that was supplied ;; at , `(ad-get-args )' will return the list of actual -;; arguments supplied starting at . Note that these macros can be +;; arguments supplied starting at . 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 )' can be used to set the -;; value of the actual argument at to . For example, +;; value of the actual argument at to . 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 )' can be used to set +;; called. `(ad-set-args )' can be used to set ;; the list of actual arguments starting at to . ;; For example, ;; @@ -427,7 +404,7 @@ ;; 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 @@ -437,7 +414,7 @@ ;; ======================================================= ;; 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 @@ -463,7 +440,7 @@ ;; ========================== ;; 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 @@ -474,11 +451,10 @@ ;; @@ 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 @@ -496,7 +472,7 @@ ;; 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 @@ -504,12 +480,12 @@ ;; `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: @@ -521,26 +497,26 @@ ;; 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 - @@ -548,7 +524,7 @@ ;; 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 @@ -556,17 +532,15 @@ ;; 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) @@ -576,28 +550,28 @@ ;; ;; (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: @@ -616,7 +590,7 @@ ;; 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. @@ -625,16 +599,11 @@ ;; 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 @@ -642,19 +611,19 @@ ;; 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 @@ -665,27 +634,27 @@ ;; 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. @@ -697,18 +666,18 @@ ;; - `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 @@ -720,30 +689,20 @@ ;; 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. +;; 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 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. +;; MORAL: - Only advise macros when you are absolutely sure what you are doing. ;; @@ Adding a piece of advice with `ad-add-advice': ;; ================================================= @@ -754,10 +713,10 @@ ;; @@ 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 @@ -769,7 +728,7 @@ ;; ;; 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'. @@ -784,14 +743,14 @@ ;; 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: @@ -800,7 +759,7 @@ ;; - 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. @@ -860,12 +819,8 @@ ;; @ 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: @@ -988,19 +943,6 @@ ;; (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 @@ -1038,20 +980,6 @@ ;; (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 @@ -1071,9 +999,9 @@ ;; 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) @@ -1121,24 +1049,6 @@ ;; "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 @@ -1150,13 +1060,10 @@ ;; (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!" @@ -1262,7 +1169,7 @@ ;; 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-") @@ -1274,7 +1181,7 @@ ;; (ad-activate-regexp "^fg-") ;; nil ;; -;; (eq old-definition (symbol-function 'foo)) +;; (eq old-definition (symbol-function 'ad-Advice-foo)) ;; t ;; ;; (foo 3) @@ -1283,14 +1190,6 @@ ;; ;; @@ 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: ;; @@ -1303,9 +1202,7 @@ ;; (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." @@ -1357,7 +1254,7 @@ ;; (ad-activate 'fie) ;; fie ;; -;; (eq cached-definition (symbol-function 'fie)) +;; (eq cached-definition (symbol-function 'ad-Advice-fie)) ;; t ;; ;; (fie 2) @@ -1365,7 +1262,7 @@ ;; ;; 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, ;; @@ -1407,18 +1304,16 @@ ;; 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") ...) @@ -1431,7 +1326,7 @@ ;; 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: ;; @@ -1440,7 +1335,7 @@ ;; ;; A new uncompiled advised definition got constructed: ;; -;; (ad-compiled-p (symbol-function 'fum)) +;; (byte-code-function-p 'ad-Advice-fum) ;; nil ;; ;; (fum 2) @@ -1448,7 +1343,7 @@ ;; ;; 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. ;; @@ -1702,15 +1597,9 @@ ;; @@ 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: ;; ======================== @@ -1789,7 +1678,7 @@ generates a copy of TREE." ;; (after adv1 adv2 ...) ;; (activation adv1 adv2 ...) ;; (deactivation adv1 adv2 ...) -;; (origname . ) +;; (advicefunname . ) ;; (cache . ( . ))) ;; List of currently advised though not necessarily activated functions @@ -1816,7 +1705,7 @@ generates a copy of TREE." 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) + `(dolist (,(car varform) ad-advised-functions) (setq ,(car varform) (intern (car ,(car varform)))) ,@body)) @@ -1882,18 +1771,17 @@ either t or nil, and DEFINITION should be a list of the form ;; 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) @@ -1906,9 +1794,6 @@ either t or nil, and DEFINITION should be a list of the form ;; @@ 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)) @@ -1948,58 +1833,23 @@ Redefining advices affect the construction of an advised definition." ;; 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'. +(defalias 'ad-activate-internal 'ad-activate) -(defun ad--defalias-fset (fsetfun function definition) - (funcall (or fsetfun #'fset) function definition) - (ad-activate-internal function nil)) +(defun ad-make-advicefunname (function) + "Make name to be used to call the assembled advice function." + (intern (format "ad-Advice-%s" function))) -;; 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) +(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) -;; 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)) - -;; @@ 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-origname (function) - "Make name to be used to call the original FUNCTION." - (intern (format "ad-Orig-%s" 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) - `(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: @@ -2259,7 +2109,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation." (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)) @@ -2374,7 +2224,8 @@ 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')." (eval-when-compile - (propertize "Advice doc string" 'dynamic-docstring-function + (propertize "Advice function assembled by advice.el." + 'dynamic-docstring-function #'ad--make-advised-docstring))) (defun ad-advised-definition-p (definition) @@ -2388,16 +2239,15 @@ definition (see the code for `documentation')." (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 (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. @@ -2417,9 +2267,9 @@ For that it has to be fbound with a non-autoload 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." @@ -2430,24 +2280,15 @@ For that it has to be fbound with a non-autoload definition." (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: ;; ============================= @@ -2634,7 +2475,7 @@ Excess source arguments will be neglected, missing source arguments will be 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))) @@ -2648,7 +2489,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return ;; 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))) @@ -2663,13 +2504,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (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: ;; =========================================== @@ -2686,11 +2520,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (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)) @@ -2702,29 +2531,22 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. -(defun ad-make-advised-docstring (function &optional style) - (let* ((origdef (ad-real-orig-definition function)) - (origdoc - ;; Retrieve raw doc, key substitution will be taken care of later: - (documentation origdef t))) - (ad--make-advised-docstring origdoc function 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))) - (usage (help-split-fundoc origdoc function)) + (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 @@ -2740,10 +2562,6 @@ in any of these classes." #'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: ;; ======================================================== @@ -2777,64 +2595,18 @@ in any of these classes." (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 (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)) + (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 @@ -2844,13 +2616,11 @@ in any of these classes." (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." @@ -2901,16 +2671,12 @@ should be modified. The assembled function will be returned." (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))) @@ -3007,11 +2773,11 @@ advised definition from scratch." "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) @@ -3125,83 +2891,6 @@ advised definition from scratch." (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)) - (cl-letf* - ((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))) - ;; Make sure we construct a proper docstring: - ((symbol-function 'ad-make-advised-definition-docstring) - #'ad-make-freeze-docstring) - ;; Make sure `unique-origname' is used as the origname: - ((symbol-function 'ad-make-origname) (lambda (_x) unique-origname)) - (frozen-definition - (unwind-protect - (progn - ;; 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)))) - (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: ;; ====================================== @@ -3231,25 +2920,32 @@ The resulting FUNCTION will be compiled if `ad-should-compile' returns t. 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)))) - (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 @@ -3261,33 +2957,27 @@ associated with it but got redefined with a new definition and then 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) - (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: @@ -3313,24 +3003,20 @@ definition will always be cached for later usage." (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) @@ -3345,11 +3031,10 @@ a call to `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) - (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))))) @@ -3371,7 +3056,7 @@ If FUNCTION was not advised this will be a noop." (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)))) @@ -3386,9 +3071,7 @@ Use in emergencies." (list (intern (completing-read "Recover advised function: " obarray nil t)))) (cond ((ad-is-advised function) - (cond ((ad-get-orig-definition function) - (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)))) @@ -3468,7 +3151,7 @@ deactivation, which might run hooks and get into other trouble." ;; 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) @@ -3487,7 +3170,7 @@ POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', 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 @@ -3513,13 +3196,6 @@ time. This generates a compiled advised definition according to the current 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] @@ -3569,29 +3245,24 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) (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: @@ -3640,35 +3311,15 @@ undone on exit of this macro." ;; @@ 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) - (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) - (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) - (fset 'ad-activate-internal 'ad-activate-internal-off) (ad-recover-all) (ad-do-advised-functions (function) (message "Oops! Left over advised function %S" function) (ad-pop-advised-function function))) -(ad-start-advice) - (provide 'advice) ;;; advice.el ends here diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index ffa42e97221..1cbed17cbab 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -124,7 +124,7 @@ ;; Adding your own checks: ;; ;; You can experiment with adding your own checks by setting the -;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-hooks'. +;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-functions'. ;; Return a string which is the error you wish to report. The cursor ;; position should be preserved. ;; diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index a9be08b1383..d5e5f4bbfbc 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie -;; Version: 2.02 +;; Version: 1.0 ;; Keywords: extensions ;; This file is part of GNU Emacs. @@ -661,7 +661,7 @@ If ALIST is non-nil, the new pairs are prepended to it." (gv-define-setter face-foreground (x f &optional s) `(set-face-foreground ,f ,x ,s)) (gv-define-setter face-underline-p (x f &optional s) - `(set-face-underline-p ,f ,x ,s)) + `(set-face-underline ,f ,x ,s)) (gv-define-simple-setter file-modes set-file-modes t) (gv-define-simple-setter frame-height set-screen-height t) (gv-define-simple-setter frame-parameters modify-frame-parameters t) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 5b7c3822ef4..69882e36f22 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. ;;;;;; 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" "747d3cde8ebe1b8f8eab86642a4eb739") +;;;;;; "cl-macs" "cl-macs.el" "a7d9b56ea588b869813de8ed7ec1fbcd") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -416,7 +416,7 @@ This is compatible with Common Lisp, but note that `defun' and (put 'cl-return-from 'lisp-indent-function '1) (autoload 'cl-loop "cl-macs" "\ -The Common Lisp `cl-loop' macro. +The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, @@ -432,14 +432,14 @@ Valid clauses are: \(fn CLAUSE...)" nil t) (autoload 'cl-do "cl-macs" "\ -The Common Lisp `cl-do' loop. +The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) (put 'cl-do 'lisp-indent-function '2) (autoload 'cl-do* "cl-macs" "\ -The Common Lisp `cl-do*' loop. +The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) @@ -501,7 +501,7 @@ a `let' form, except that the list of symbols can be computed at run-time. (put 'cl-progv 'lisp-indent-function '2) (autoload 'cl-flet "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-labels' but the definitions are not recursive. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) @@ -509,7 +509,7 @@ Like `cl-labels' but the definitions are not recursive. (put 'cl-flet 'lisp-indent-function '1) (autoload 'cl-flet* "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-flet' but the definitions can refer to previous ones. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index f3bf36de376..f8c18339ff2 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -260,9 +260,11 @@ The name is made by appending a number to PREFIX, default \"G\"." (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) @@ -756,7 +758,7 @@ This is compatible with Common Lisp, but note that `defun' and ;;;###autoload (defmacro cl-loop (&rest loop-args) - "The Common Lisp `cl-loop' macro. + "The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, @@ -1501,7 +1503,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do (steps endtest &rest body) - "The Common Lisp `cl-do' loop. + "The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) @@ -1513,7 +1515,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do* (steps endtest &rest body) - "The Common Lisp `cl-do*' loop. + "The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) (debug cl-do)) @@ -1547,9 +1549,9 @@ An implicit nil block is established around the loop. \(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) @@ -1560,9 +1562,9 @@ nil. \(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) @@ -1648,7 +1650,7 @@ a `let' form, except that the list of symbols can be computed at run-time." ;;;###autoload (defmacro cl-flet (bindings &rest body) - "Make temporary function definitions. + "Make local function definitions. Like `cl-labels' but the definitions are not recursive. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" @@ -1672,7 +1674,7 @@ Like `cl-labels' but the definitions are not recursive. ;;;###autoload (defmacro cl-flet* (bindings &rest body) - "Make temporary function definitions. + "Make local function definitions. Like `cl-flet' but the definitions can refer to previous ones. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 3fb5b227c73..5d890015055 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -107,14 +107,6 @@ )) (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) @@ -228,7 +220,6 @@ remf psetf (define-setf-method . define-setf-expander) - declare the locally multiple-value-setq @@ -239,8 +230,6 @@ psetq do-all-symbols do-symbols - dotimes - dolist do* do loop @@ -322,6 +311,15 @@ (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 diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index ec470d21bf3..a1db1972b83 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -131,7 +131,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." (defun eieio-debug-methodinvoke (method class) "Show the method invocation order for METHOD with CLASS object." (interactive "aMethod: \nXClass Expression: ") - (let* ((eieio-pre-method-execution-hooks + (let* ((eieio-pre-method-execution-functions (lambda (l) (throw 'moose l) )) (data (catch 'moose (eieio-generic-call diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 02eec08f96b..5488330a1a4 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -236,7 +236,7 @@ For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y). The return value is the last VAL in the list. \(fn PLACE VAL PLACE VAL ...)" - (declare (debug (gv-place form))) + (declare (debug (&rest [gv-place form]))) (if (and args (null (cddr args))) (let ((place (pop args)) (val (car args))) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 020a2f89bdb..540e0166ec2 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -30,7 +30,7 @@ ;; holds a function. ;; This part provides mainly 2 macros: `add-function' and `remove-function'. ;; -;; - The second part provides `add-advice' and `remove-advice' which are +;; - 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'. @@ -109,18 +109,33 @@ Each element has the form (WHERE BYTECODE STACK) where: (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 possible to do around-like advising on the - ;; interactive forms (bug#12844). ;; TODO: make it so that interactive spec can be a constant which ;; dynamically checks the advice--car/cdr to do its job. - ;; TODO: Implement interactive-read-args: - ;;(when (or (commandp function) (commandp main)) - ;; `(interactive-read-args - ;; (cadr (or (interactive-form function) (interactive-form main))))) - ;; FIXME: This loads autoloaded functions too eagerly. + ;; 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)))) + (interactive-form main)))))) (defsubst advice--make-1 (byte-code stack-depth function main props) "Build a function value that adds FUNCTION to MAIN." @@ -167,17 +182,31 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (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: - ;; - provide something like `around' for interactive forms. - ;; - provide some kind of buffer-local functionality at least when `place' - ;; is a variable. ;; - 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 also let `where' specify some kind of predicate and use it + ;; - 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. @@ -197,8 +226,24 @@ call OLDFUN here: 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." +- `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 @@ -213,6 +258,10 @@ 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))))) @@ -230,23 +279,49 @@ of the piece of advice." (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) - (let* ((olddef (if (fboundp symbol) (symbol-function symbol))) + (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))) + ((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)))) - (funcall (or fsetfun #'fset) symbol (advice--subst-main oldadv newdef)))) + (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 @@ -259,39 +334,21 @@ is defined as a macro, alias, command, ..." ;; - change all defadvice in lisp/**/*.el. ;; - rewrite advice.el on top of this. ;; - obsolete advice.el. - ;; To make advice.el and nadvice.el interoperate properly I see 2 different - ;; ways: - ;; - keep them separate: complete the defalias-fset-function setter with - ;; a matching accessor which both nadvice.el and advice.el will have to use - ;; in place of symbol-function. This can probably be made to work, but - ;; they have to agree on a "protocol". - ;; - layer advice.el on top of nadvice.el. I prefer this approach. the - ;; simplest way is to make advice.el build one ad-Advice-foo function for - ;; each advised function which is advice-added/removed whenever ad-activate - ;; ad-deactivate is called. - (let ((f (and (fboundp symbol) (symbol-function symbol)))) - (cond - ((special-form-p f) - ;; Not worth the trouble trying to handle this, I think. - (error "add-advice failure: %S is a special form" symbol)) - ((and (symbolp f) - (eq 'macro (car-safe (ignore-errors (indirect-function f))))) - (let ((newval (cons 'macro (cdr (indirect-function f))))) - (put symbol 'advice--saved-rewrite (cons f newval)) - (fset symbol newval))) - ;; `f' might be a pure (hence read-only) cons! - ((and (eq 'macro (car-safe f)) (not (ignore-errors (setcdr f (cdr f)) t))) - (fset symbol (cons 'macro (cdr f)))) - )) - (let ((f (and (fboundp symbol) (symbol-function symbol)))) + (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 f) 'macro) (cdr f)) - ;; If the function is not yet defined, we can't yet - ;; install the advice. - ;; FIXME: If it's an autoloaded command, we also - ;; have a problem because we need to load the - ;; command to build the interactive-form. - ((or (not f) (and (autoloadp f))) ;; (commandp f) + ((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) @@ -316,7 +373,7 @@ of the piece of advice." function) (unless (advice--p (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol))) - ;; Not adviced any more. + ;; Not advised any more. (remove-function (get symbol 'defalias-fset-function) #'advice--defalias-fset) (if (eq (symbol-function symbol) @@ -335,13 +392,15 @@ of the piece of advice." ;; (setq def (advice--cdr def))))) ;;;###autoload -(defun advice-member-p (function symbol) - "Return non-nil if advice FUNCTION has been added to function SYMBOL. -Instead of FUNCTION being the actual function, it can also be the `name' +(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 function - (or (get symbol 'advice--pending) - (if (fboundp symbol) (symbol-function symbol))))) + (advice--member-p advice + (or (get function-name 'advice--pending) + (advice--strip-macro + (if (fboundp function-name) + (symbol-function function-name)))))) (provide 'nadvice) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index c3d78b3444b..592cb1b0174 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -55,12 +55,18 @@ ;; have to flush that cache between each function, and we couldn't use ;; syntax-ppss-flush-cache since that would not only flush the cache but also ;; reset syntax-propertize--done which should not be done in this case). - "Mode-specific function to apply the syntax-table properties. -Called with two arguments: START and END. -This function can call `syntax-ppss' on any position before END, but it -should not call `syntax-ppss-flush-cache', which means that it should not -call `syntax-ppss' on some position and later modify the buffer on some -earlier position.") + "Mode-specific function to apply `syntax-table' text properties. +The value of this variable is a function to be called by Font +Lock mode, prior to performing syntactic fontification on a +stretch of text. It is given two arguments, START and END: the +start and end of the text to be fontified. Major modes can +specify a custom function to apply `syntax-table' properties to +override the default syntax table in special cases. + +The specified function may call `syntax-ppss' on any position +before END, but it should not call `syntax-ppss-flush-cache', +which means that it should not call `syntax-ppss' on some +position and later modify the buffer on some earlier position.") (defvar syntax-propertize-chunk-size 500) @@ -118,7 +124,7 @@ The arg RULES can be of the same form as in `syntax-propertize-rules'. The return value is an object that can be passed as a rule to `syntax-propertize-rules'. I.e. this is useful only when you want to share rules among several -syntax-propertize-functions." +`syntax-propertize-function's." (declare (debug syntax-propertize-rules)) ;; Precompile? Yeah, right! ;; Seriously, tho, this is a macro for 2 reasons: diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 13dbba769a4..e0a88461dc9 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,7 @@ +2012-11-16 Glenn Morris + + * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc. + 2012-10-28 Stefan Monnier * erc-backend.el: Only require `erc' during compilation (bug#12740). diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2e97131b603..7cb6fbb595b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1843,7 +1843,7 @@ removed from the list will be disabled." capab-identify) (const :tag "completion: Complete nicknames and commands (programmable)" completion) - (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete) + (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete) (const :tag "dcc: Provide Direct Client-to-Client support" dcc) (const :tag "fill: Wrap long lines" fill) (const :tag "identd: Launch an identd server on port 8113" identd) @@ -1863,6 +1863,8 @@ removed from the list will be disabled." (const :tag "notify: Notify when the online status of certain users changes" notify) + (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions" + notifications) (const :tag "page: Process CTCP PAGE requests from IRC" page) (const :tag "readonly: Make displayed lines read-only" readonly) (const :tag "replace: Replace text in messages" replace) diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index a67861e83a9..aa8aae2d245 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -295,8 +295,8 @@ to writing a completion function." 'pcomplete-expand-and-complete) (define-key eshell-command-map [space] 'pcomplete-expand) (define-key eshell-command-map [? ] 'pcomplete-expand) - (define-key eshell-mode-map [tab] 'pcomplete) - (define-key eshell-mode-map [(control ?i)] 'pcomplete) + (define-key eshell-mode-map [tab] 'eshell-pcomplete) + (define-key eshell-mode-map [(control ?i)] 'eshell-pcomplete) ;; jww (1999-10-19): Will this work on anything but X? (if (featurep 'xemacs) (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse) @@ -449,6 +449,13 @@ to writing a completion function." (all-completions filename obarray 'functionp)) completions))))))) +(defun eshell-pcomplete () + "Eshell wrapper for `pcomplete'." + (interactive) + (if eshell-cmpl-ignore-case + (pcomplete-expand-and-complete) ; hack workaround for bug#12838 + (pcomplete))) + (provide 'em-cmpl) ;; Local Variables: diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index d3ddab8af1b..32744c702a6 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -306,12 +306,13 @@ Remove (unlink) the FILE(s).") (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)) diff --git a/lisp/faces.el b/lisp/faces.el index f5ef88d08b0..9e0ca962499 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -487,16 +487,21 @@ with the `default' face (which is always completely specified)." (defalias 'face-background-pixmap 'face-stipple) +;; FIXME all of these -p functions ignore inheritance (cf face-stipple). +;; Ie, a face that inherits from an underlined face but does not +;; specify :underline will return nil. +;; So these functions don't actually tell you anything about how the +;; face will _appear_. So not very useful IMO. (defun face-underline-p (face &optional frame) - "Return non-nil if FACE is underlined. + "Return non-nil if FACE specifies a non-nil underlining. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." - (eq (face-attribute face :underline frame) t)) + (face-attribute-specified-or (face-attribute face :underline frame) nil)) (defun face-inverse-video-p (face &optional frame) - "Return non-nil if FACE is in inverse video on FRAME. + "Return non-nil if FACE specifies a non-nil inverse-video. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." @@ -837,21 +842,24 @@ and DATA is a string, containing the raw bits of the bitmap." (set-face-attribute face frame :stipple (or stipple 'unspecified))) -(defun set-face-underline-p (face underline &optional frame) +(defun set-face-underline (face underline &optional frame) "Specify whether face FACE is underlined. UNDERLINE nil means FACE explicitly doesn't underline. -UNDERLINE non-nil means FACE explicitly does underlining -with the same of the foreground color. -If UNDERLINE is a string, underline with the color named UNDERLINE. +UNDERLINE t means FACE underlines with its foreground color. +If UNDERLINE is a string, underline with that color. + +UNDERLINE may also be a list of the form (:color COLOR :style STYLE), +where COLOR is a string or `foreground-color', and STYLE is either +`line' or `wave'. :color may be omitted, which means to use the +foreground color. :style may be omitted, which means to use a line. + FRAME nil or not specified means change face on all frames. Use `set-face-attribute' to ``unspecify'' underlining." - (interactive - (let ((list (read-face-and-attribute :underline))) - (list (car list) (eq (car (cdr list)) t)))) + (interactive (read-face-and-attribute :underline)) (set-face-attribute face frame :underline underline)) -(define-obsolete-function-alias 'set-face-underline - 'set-face-underline-p "22.1") +(define-obsolete-function-alias 'set-face-underline-p + 'set-face-underline "24.3") (defun set-face-inverse-video-p (face inverse-video-p &optional frame) @@ -866,6 +874,9 @@ Use `set-face-attribute' to ``unspecify'' the inverse video attribute." (set-face-attribute face frame :inverse-video inverse-video-p)) +;; The -p suffix is a hostage to fortune. What if we want to extend +;; this to allow more than boolean options? Exactly this happened +;; to set-face-underline-p. (defun set-face-bold-p (face bold-p &optional frame) "Specify whether face FACE is bold. BOLD-P non-nil means FACE should explicitly display bold. @@ -1114,6 +1125,9 @@ name of the attribute for prompting. Value is the new attribute value." (string-to-number new-value))))) +;; FIXME this does allow you to enter the list forms of :box, +;; :stipple, or :underline, because face-valid-attribute-values does +;; not return those forms. (defun read-face-attribute (face attribute &optional frame) "Interactively read a new value for FACE's ATTRIBUTE. Optional argument FRAME nil or unspecified means read an attribute value @@ -1125,12 +1139,11 @@ of a global face. Value is the new attribute value." ;; Represent complex attribute values as strings by printing them ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow - ;; SHADOW)'. - (when (and (or (eq attribute :stipple) - (eq attribute :box)) - (or (consp old-value) - (vectorp old-value))) - (setq old-value (prin1-to-string old-value))) + ;; SHADOW)'. Underline can be `(:color COLOR :style STYLE)'. + (and (memq attribute '(:box :stipple :underline)) + (or (consp old-value) + (vectorp old-value)) + (setq old-value (prin1-to-string old-value))) (cond ((listp valid) (let ((default (or (car (rassoc old-value valid)) @@ -1160,11 +1173,10 @@ of a global face. Value is the new attribute value." ;; Convert stipple and box value text we read back to a list or ;; vector if it looks like one. This makes the assumption that a ;; pixmap file name won't start with an open-paren. - (when (and (or (eq attribute :stipple) - (eq attribute :box)) - (stringp new-value) - (string-match "^[[(]" new-value)) - (setq new-value (read new-value))) + (and (memq attribute '(:stipple :box :underline)) + (stringp new-value) + (string-match "^[[(]" new-value) + (setq new-value (read new-value))) new-value)) (declare-function fontset-list "fontset.c" ()) diff --git a/lisp/filecache.el b/lisp/filecache.el index 2dd7c2673bf..bc77c24fe63 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -267,42 +267,63 @@ files of names DIRNAME1/FILENAME, DIRNAME2/FILENAME, ...") ;; Functions to add files to the cache ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun file-cache--read-list (file op-prompt) + (let* ((fun (if file 'read-file-name 'read-directory-name)) + (type (if file "file" "directory")) + (prompt-1 (concat op-prompt " " type ": ")) + (prompt-2 (concat op-prompt " another " type "?")) + (continue t) + result) + (while continue + (push (funcall fun prompt-1 nil nil t) result) + (setq continue (y-or-n-p prompt-2))) + (nreverse result))) + ;;;###autoload (defun file-cache-add-directory (directory &optional regexp) - "Add DIRECTORY to the file cache. -If the optional REGEXP argument is non-nil, only files which match it will -be added to the cache." - (interactive "DAdd files from directory: ") + "Add all files in DIRECTORY to the file cache. +If called from Lisp with a non-nil REGEXP argument is non-nil, +only add files whose names match REGEXP." + (interactive (list (read-directory-name "Add files from directory: " + nil nil t) + nil)) ;; Not an error, because otherwise we can't use load-paths that ;; contain non-existent directories. - (if (not (file-accessible-directory-p directory)) - (message "Directory %s does not exist" directory) + (when (file-accessible-directory-p directory) (let* ((dir (expand-file-name directory)) (dir-files (directory-files dir t regexp))) ;; Filter out files we don't want to see (dolist (file dir-files) - (if (file-directory-p file) - (setq dir-files (delq file dir-files)) - (dolist (regexp file-cache-filter-regexps) - (if (string-match regexp file) - (setq dir-files (delq file dir-files)))))) + (if (file-directory-p file) + (setq dir-files (delq file dir-files)) + (dolist (regexp file-cache-filter-regexps) + (if (string-match regexp file) + (setq dir-files (delq file dir-files)))))) (file-cache-add-file-list dir-files)))) ;;;###autoload -(defun file-cache-add-directory-list (directory-list &optional regexp) - "Add DIRECTORY-LIST (a list of directory names) to the file cache. +(defun file-cache-add-directory-list (directories &optional regexp) + "Add DIRECTORIES (a list of directory names) to the file cache. +If called interactively, read the directory names one by one. If the optional REGEXP argument is non-nil, only files which match it 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 "XAdd files from directory list: ") - (mapcar - (lambda (dir) (file-cache-add-directory dir regexp)) - directory-list)) + (interactive (list (file-cache--read-list nil "Add"))) + (dolist (dir directories) + (file-cache-add-directory dir regexp)) + (let ((n (length directories))) + (message "Filecache: cached file names from %d director%s." + n (if (= n 1) "y" "ies")))) -(defun file-cache-add-file-list (file-list) - "Add FILE-LIST (a list of files names) to the file cache." - (interactive "XFile List: ") - (mapcar 'file-cache-add-file file-list)) +(defun file-cache-add-file-list (files) + "Add FILES (a list of file names) to the file cache. +If called interactively, read the file names one by one." + (interactive (list (file-cache--read-list t "Add"))) + (dolist (f files) + (file-cache-add-file f)) + (let ((n (length files))) + (message "Filecache: cached %d file name%s." + n (if (= n 1) "" "s")))) ;; Workhorse function @@ -310,23 +331,25 @@ files in each directory, not to the directory list itself." (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))) + (cond ((null the-entry) + ;; If the entry wasn't in the cache, add it. + (push (list file-name dir-name) file-cache-alist) + (if (called-interactively-p 'interactive) + (message "Filecache: cached file name %s." file))) + ((not (member dir-name (cdr the-entry))) + (setcdr the-entry (cons dir-name (cdr the-entry))) + (if (called-interactively-p 'interactive) + (message "Filecache: cached file name %s." file))) + (t + (if (called-interactively-p 'interactive) + (message "Filecache: %s is already cached." file)))))) ;;;###autoload (defun file-cache-add-directory-using-find (directory) @@ -412,17 +435,26 @@ or the optional REGEXP argument." ;; This clears *all* files with the given name (defun file-cache-delete-file (file) - "Delete FILE from the file cache." + "Delete FILE (a relative file name) from the file cache. +Return nil if FILE was not in the file cache, non-nil otherwise." (interactive (list (completing-read "Delete file from cache: " file-cache-alist))) - (setq file-cache-alist - (delq (assoc-string file file-cache-alist file-cache-ignore-case) - file-cache-alist))) + (let ((elt (assoc-string file file-cache-alist file-cache-ignore-case))) + (setq file-cache-alist (delq elt file-cache-alist)) + elt)) -(defun file-cache-delete-file-list (file-list) - "Delete FILE-LIST (a list of files) from the file cache." - (interactive "XFile List: ") - (mapcar 'file-cache-delete-file file-list)) +(defun file-cache-delete-file-list (files &optional message) + "Delete FILES (a list of files) from the file cache. +If called interactively, read the file names one by one. +If MESSAGE is non-nil, or if called interactively, print a +message reporting the number of file names deleted." + (interactive (list (file-cache--read-list t "Uncache") t)) + (let ((n 0)) + (dolist (f files) + (if (file-cache-delete-file f) + (setq n (1+ n)))) + (message "Filecache: uncached %d file name%s." + n (if (= n 1) "" "s")))) (defun file-cache-delete-file-regexp (regexp) "Delete files matching REGEXP from the file cache." @@ -431,21 +463,18 @@ or the optional REGEXP argument." (dolist (elt file-cache-alist) (and (string-match regexp (car elt)) (push (car elt) delete-list))) - (file-cache-delete-file-list delete-list) - (message "Filecache: deleted %d files from file cache" - (length delete-list)))) + (file-cache-delete-file-list delete-list))) (defun file-cache-delete-directory (directory) "Delete DIRECTORY from the file cache." (interactive "DDelete directory from file cache: ") (let ((dir (expand-file-name directory)) - (result 0)) + (n 0)) (dolist (entry file-cache-alist) (if (file-cache-do-delete-directory dir entry) - (setq result (1+ result)))) - (if (zerop result) - (error "Filecache: no entries containing %s found in cache" directory) - (message "Filecache: deleted %d entries" result)))) + (setq n (1+ n)))) + (message "Filecache: uncached %d file name%s." + n (if (= n 1) "" "s")))) (defun file-cache-do-delete-directory (dir entry) (let ((directory-list (cdr entry)) @@ -456,10 +485,12 @@ or the optional REGEXP argument." (delq entry file-cache-alist)) (setcdr entry (delete directory directory-list)))))) -(defun file-cache-delete-directory-list (directory-list) - "Delete DIRECTORY-LIST (a list of directories) from the file cache." - (interactive "XDirectory List: ") - (mapcar 'file-cache-delete-directory directory-list)) +(defun file-cache-delete-directory-list (directories) + "Delete DIRECTORIES (a list of directory names) from the file cache. +If called interactively, read the directory names one by one." + (interactive (list (file-cache--read-list nil "Uncache"))) + (dolist (d directories) + (file-cache-delete-directory d))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 878021ec5c5..e2533c1f12b 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -549,6 +549,9 @@ like an INI file. You can add this hook to `find-file-hook'." (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) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 5f635e59cdf..dd493d383a3 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,17 @@ +2012-11-16 Jan Tatarik + + * gnus-score.el (gnus-score-body): + * gnus-logic.el (gnus-advanced-body): Don't score by headers when + scoring by body. + +2012-11-16 Glenn Morris + + * gnus-diary.el (nndiary-request-create-group-functions) + (nndiary-request-update-info-functions) + (gnus-subscribe-newsgroup-functions) + (nndiary-request-accept-article-functions): + Use new names for hooks rather than obsolete aliases. + 2012-11-08 Katsumi Yamaoka * gnus-art.el (gnus-article-browse-html-parts): Always replace charset diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 854af2f5d76..bca307b19b6 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -277,18 +277,18 @@ Optional prefix (or REVERSE argument) means sort in reverse order." ;; Called when a group is subscribed. This is needed because groups created ;; because of mail splitting are *not* created with the back end function. -;; Thus, `nndiary-request-create-group-hooks' is inoperative. +;; Thus, `nndiary-request-create-group-functions' is inoperative. (defun gnus-diary-maybe-update-group-parameters (group) (when (eq (car (gnus-find-method-for-group group)) 'nndiary) (gnus-diary-update-group-parameters group))) -(add-hook 'nndiary-request-create-group-hooks +(add-hook 'nndiary-request-create-group-functions 'gnus-diary-update-group-parameters) -;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed +;; Now that we have `gnus-subscribe-newsgroup-functions', this is not needed ;; anymore. Maybe I should remove this completely. -(add-hook 'nndiary-request-update-info-hooks +(add-hook 'nndiary-request-update-info-functions 'gnus-diary-update-group-parameters) -(add-hook 'gnus-subscribe-newsgroup-hooks +(add-hook 'gnus-subscribe-newsgroup-functions 'gnus-diary-maybe-update-group-parameters) @@ -384,7 +384,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." nndiary-headers) )) -(add-hook 'nndiary-request-accept-article-hooks +(add-hook 'nndiary-request-accept-article-functions (lambda () (gnus-diary-check-message nil))) (define-key message-mode-map "\C-c\C-fd" 'gnus-diary-check-message) diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index a440b779930..60d7b31713b 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -181,17 +181,18 @@ (with-current-buffer nntp-server-buffer (let* ((request-func (cond ((string= "head" header) 'gnus-request-head) - ;; We need to peek at the headers to detect the - ;; content encoding ((string= "body" header) - 'gnus-request-article) + 'gnus-request-body) (t 'gnus-request-article))) ofunc article handles) ;; Not all backends support partial fetching. In that case, we ;; just fetch the entire article. - (unless (gnus-check-backend-function - (intern (concat "request-" header)) - gnus-newsgroup-name) + ;; When scoring by body, we need to peek at the headers to detect the + ;; content encoding + (unless (or (gnus-check-backend-function + (intern (concat "request-" header)) + gnus-newsgroup-name) + (string= "body" header)) (setq ofunc request-func) (setq request-func 'gnus-request-article)) (setq article (mail-header-number gnus-advanced-headers)) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index f215b845514..b7061960839 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1762,21 +1762,22 @@ score in `gnus-newsgroup-scored' by SCORE." (all-scores scores) (request-func (cond ((string= "head" header) 'gnus-request-head) - ;; We need to peek at the headers to detect - ;; the content encoding ((string= "body" header) - 'gnus-request-article) + 'gnus-request-body) (t 'gnus-request-article))) entries alist ofunc article last) (when articles (setq last (mail-header-number (caar (last articles)))) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) + ;; When scoring by body, we need to peek at the headers to detect + ;; the content encoding + (unless (or (gnus-check-backend-function + (and (string-match "^gnus-" (symbol-name request-func)) + (intern (substring (symbol-name request-func) + (match-end 0)))) + gnus-newsgroup-name) + (string= "body" header)) (setq ofunc request-func) (setq request-func 'gnus-request-article)) (while articles diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index f95bf26ad1d..801ed66ec2b 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -178,7 +178,7 @@ Shorter values mean quicker response, but are more CPU intensive.") 1000)))))) (defvar pop3-uidl) -;; List of UIDLs of existing messages at pesent in the server: +;; List of UIDLs of existing messages at present in the server: ;; ("UIDL1" "UIDL2" "UIDL3"...) (defvar pop3-uidl-saved) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index c1ce5a521be..48c5849d301 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -677,7 +677,8 @@ help buffer." " 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))))) ;; Navigation/hyperlinking with xrefs diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 72ca189e9d5..4e0ac1a4856 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1362,24 +1362,27 @@ group." (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 @@ -1389,8 +1392,12 @@ If point is on a group name, this function operates on that group." (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) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 3659894f08d..77c968b21ae 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -2454,6 +2454,8 @@ when using per-directory thumbnail file storage")) (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. diff --git a/lisp/image.el b/lisp/image.el index bd2f5c3a3ca..27bbc2c08d6 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -429,7 +429,7 @@ means display it in the right marginal area." "Insert IMAGE into current buffer at point. IMAGE is displayed by inserting STRING into the current buffer with a `display' property whose value is the image. STRING -defaults to the empty string if you omit it. +defaults to a single space if you omit it. AREA is where to display the image. AREA nil or omitted means display it in the text area, a value of `left-margin' means display it in the left marginal area, a value of `right-margin' @@ -467,8 +467,8 @@ height of the image; integer values are taken as pixel values." (defun insert-sliced-image (image &optional string area rows cols) "Insert IMAGE into current buffer at point. IMAGE is displayed by inserting STRING into the current buffer -with a `display' property whose value is the image. STRING is -defaulted if you omit it. +with a `display' property whose value is the image. The default +STRING is a single space. AREA is where to display the image. AREA nil or omitted means display it in the text area, a value of `left-margin' means display it in the left marginal area, a value of `right-margin' diff --git a/lisp/imenu.el b/lisp/imenu.el index 4686d1cf538..1d3da2db15b 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -546,9 +546,7 @@ The returned alist DOES NOT share structure with MENULIST." 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)) diff --git a/lisp/info.el b/lisp/info.el index 36ffa806f04..b0ef5c6bc4d 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4836,6 +4836,17 @@ first line or header line, and for breadcrumb links.") ;; 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.") diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 60b39606d86..0aa1b8957ac 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -521,12 +521,12 @@ It is needed when D-Bus signals or errors arrive, because there is no information where to trace the message.") (defun tramp-gvfs-dbus-event-error (event err) - "Called when a D-Bus error message arrives, see `dbus-event-error-hooks'." + "Called when a D-Bus error message arrives, see `dbus-event-error-functions'." (when tramp-gvfs-dbus-event-vector (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) -(add-hook 'dbus-event-error-hooks 'tramp-gvfs-dbus-event-error) +(add-hook 'dbus-event-error-functions 'tramp-gvfs-dbus-event-error) ;; File name primitives. diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index f3e277e338c..a3ea4af4651 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -560,7 +560,7 @@ FILE is created there." (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) diff --git a/lisp/printing.el b/lisp/printing.el index 02b2fb0139c..26a7648f68e 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1383,6 +1383,10 @@ Used by `pr-menu-bind' and `pr-update-menus'.") (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) @@ -6079,6 +6083,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (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: diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 67f25eda288..9d78b20ba4c 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -105,7 +105,10 @@ (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. @@ -384,7 +387,9 @@ and `\\' when preceded by `?'." (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")) @@ -397,10 +402,10 @@ and `\\' when preceded by `?'." (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) @@ -865,39 +870,54 @@ calculating indentation on the lines after it." (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) @@ -909,8 +929,7 @@ With ARG, move up multiple blocks." (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) @@ -1033,21 +1052,19 @@ For example: #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)) @@ -1056,7 +1073,7 @@ See `add-log-current-defun-function'." (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 @@ -1069,28 +1086,26 @@ See `add-log-current-defun-function'." (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 @@ -1237,7 +1252,19 @@ It will be properly highlighted even when the call omits parens.")) ;; 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)) @@ -1551,7 +1578,8 @@ See `font-lock-syntax-table'.") 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) @@ -1569,7 +1597,7 @@ See `font-lock-syntax-table'.") '("\\(^\\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) @@ -1577,9 +1605,14 @@ See `font-lock-syntax-table'.") "Additional expressions to highlight in Ruby mode.") (defun ruby-match-expression-expansion (limit) - (when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move) - (or (ruby-in-ppss-context-p 'string) - (ruby-match-expression-expansion limit)))) + (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" diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 25a6fbfd998..dd104d436b5 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3608,6 +3608,7 @@ functions to do caching and flushing if appropriate." 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. diff --git a/lisp/subr.el b/lisp/subr.el index ebfcfbc0930..8410897fd6f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -195,11 +195,6 @@ value of last one, or nil if there are none. (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. @@ -279,7 +274,6 @@ The possible values of SPECS are specified by `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. @@ -3195,6 +3189,7 @@ in which case `save-window-excursion' cannot help." ;; Return nil. nil) +;; Doc is very similar to with-temp-buffer-window. (defmacro with-output-to-temp-buffer (bufname &rest body) "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer. @@ -3220,7 +3215,9 @@ with the buffer BUFNAME temporarily current. It runs the hook `temp-buffer-show-hook' after displaying buffer BUFNAME, with that buffer temporarily current, and the window that was used to display it temporarily selected. But it doesn't run `temp-buffer-show-hook' -if it uses `temp-buffer-show-function'." +if it uses `temp-buffer-show-function'. + +See the related form `with-temp-buffer-window'." (declare (debug t)) (let ((old-dir (make-symbol "old-dir")) (buf (make-symbol "buf"))) @@ -3967,11 +3964,16 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'hookvar (or hookvar 'mail-send-hook))) (defun set-temporary-overlay-map (map &optional keep-pred) - "Set MAP as a temporary overlay map. -When KEEP-PRED is `t', using a key from the temporary keymap -leaves this keymap activated. KEEP-PRED can also be a function, -which will have the same effect when it returns `t'. -When KEEP-PRED is nil, the temporary keymap is used only once." + "Set MAP as a temporary keymap taking precedence over most other keymaps. +Note that this does NOT take precedence over the \"overriding\" maps +`overriding-terminal-local-map' and `overriding-local-map' (or the +`keymap' text property). Unlike those maps, if no match for a key is +found in MAP, the normal key lookup sequence then continues. + +Normally, MAP is used only once. If the optional argument +KEEP-PRED is t, MAP stays active if a key from MAP is used. +KEEP-PRED can also be a function of no arguments: if it returns +non-nil then MAP stays active." (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) (overlaysym (make-symbol "t")) (alist (list (cons overlaysym map))) diff --git a/lisp/term.el b/lisp/term.el index e6466b8fa95..a7c50d65562 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -397,6 +397,12 @@ (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) @@ -4178,11 +4184,16 @@ the process. Any more args are arguments to PROGRAM." (term-mode) (term-char-mode) - ;; I wanna have find-file on C-x C-f -mm - ;; your mileage may definitely vary, maybe it's better to put this in your - ;; .emacs ... - - (term-set-escape-char ?\C-x) + ;; Historical baggage. A call to term-set-escape-char used to not + ;; undo any previous call to t-s-e-c. Because of this, ansi-term + ;; ended up with both C-x and C-c as escape chars. Who knows what + ;; the original intention was, but people could have become used to + ;; either. (Bug#12842) + (let (term-escape-char) + ;; I wanna have find-file on C-x C-f -mm + ;; your mileage may definitely vary, maybe it's better to put this in your + ;; .emacs ... + (term-set-escape-char ?\C-x)) (switch-to-buffer term-ansi-buffer-name)) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index ad6e1125027..42e09b65750 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -91,6 +91,9 @@ (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)) @@ -116,7 +119,11 @@ "/") "/"))) (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. diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index cb61a021251..2efabed5cd8 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -48,7 +48,7 @@ (defun url-path-and-query (urlobj) "Return the path and query components of URLOBJ. -These two components are store together in the FILENAME slot of +These two components are stored together in the FILENAME slot of the object. The return value of this function is (PATH . QUERY), where each of PATH and QUERY are strings or nil." (let ((name (url-filename urlobj)) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 3becd8950f1..370cd0a9dca 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -414,7 +414,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." ;; We also used to match the filename in column 0 without any ;; meta-info before it, but I believe this can never happen. (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)" - (regexp-quote (file-name-nondirectory file))) + (regexp-quote (file-relative-name file))) nil t) (cond ;; Merge successful, we are in sync with repository now diff --git a/lisp/vcursor.el b/lisp/vcursor.el index 19cb7a9df8d..a277abcad9b 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -881,6 +881,8 @@ ALL-FRAMES is also used to decide whether to split the window." (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. diff --git a/lisp/window.el b/lisp/window.el index 30ee622cfe6..d378ea5ff14 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -142,41 +142,46 @@ to `display-buffer'." ;; Return the window. window)))) +;; Doc is very similar to with-output-to-temp-buffer. (defmacro with-temp-buffer-window (buffer-or-name action quit-function &rest body) - "Evaluate BODY and display the buffer specified by BUFFER-OR-NAME. + "Bind `standard-output' to BUFFER-OR-NAME, eval BODY, show the buffer. BUFFER-OR-NAME must specify either a live buffer, or the name of a buffer (if it does not exist, this macro creates it). -Make sure the specified buffer is empty before evaluating BODY. -Do not make that buffer current for BODY. Instead, bind -`standard-output' to that buffer, so that output generated with -`prin1' and similar functions in BODY goes into that buffer. +This construct makes buffer BUFFER-OR-NAME empty before running BODY. +It does not make the buffer current for BODY. +Instead it binds `standard-output' to that buffer, so that output +generated with `prin1' and similar functions in BODY goes into +the buffer. -After evaluating BODY, this marks the specified buffer unmodified and -read-only, and displays it in a window via `display-buffer', passing -ACTION as the action argument to `display-buffer'. It automatically -shrinks the relevant window if `temp-buffer-resize-mode' is enabled. +At the end of BODY, this marks the specified buffer unmodified and +read-only, and displays it in a window (but does not select it, or make +the buffer current). The display happens by calling `display-buffer' +with the ACTION argument. If `temp-buffer-resize-mode' is enabled, +the relevant window shrinks automatically. -Returns the value returned by BODY, unless QUIT-FUNCTION specifies -a function. In that case, runs the function with two arguments - +This returns the value returned by BODY, unless QUIT-FUNCTION specifies +a function. In that case, it runs the function with two arguments - the window showing the specified buffer and the value returned by BODY - and returns the value returned by that function. If the buffer is displayed on a new frame, the window manager may decide to select that frame. In that case, it's usually a good -strategy if the function specified by QUIT-FUNCTION selects the -window showing the buffer before reading a value from the -minibuffer; for example, when asking a `yes-or-no-p' question. +strategy if QUIT-FUNCTION selects the window showing the buffer +before reading any value from the minibuffer; for example, when +asking a `yes-or-no-p' question. -This construct is similar to `with-output-to-temp-buffer', but does -not put the buffer in help mode, or call `temp-buffer-show-function'. -It also runs different hooks, namely `temp-buffer-window-setup-hook' -\(with the specified buffer current) and `temp-buffer-window-show-hook' -\(with the specified buffer current and the window showing it selected). +This runs the hook `temp-buffer-window-setup-hook' before BODY, +with the specified buffer temporarily current. It runs the +hook `temp-buffer-window-show-hook' after displaying the buffer, +with that buffer temporarily current, and the window that was used to +display it temporarily selected. -Since this macro calls `display-buffer', the window displaying -the buffer is usually not selected and the specified buffer -usually not made current. QUIT-FUNCTION can override that." +This construct is similar to `with-output-to-temp-buffer', but +runs different hooks. In particular, it does not run +`temp-buffer-setup-hook', which usually puts the buffer in Help mode. +Also, it does not call `temp-buffer-show-function' (the ACTION +argument replaces this)." (declare (debug t)) (let ((buffer (make-symbol "buffer")) (window (make-symbol "window")) @@ -2571,8 +2576,7 @@ move it as far as possible in the desired direction." Interactively, if no argument is given, make the selected window one line taller. If optional argument HORIZONTAL is non-nil, make selected window wider by DELTA columns. If DELTA is -negative, shrink selected window by -DELTA lines or columns. -Return nil." +negative, shrink selected window by -DELTA lines or columns." (interactive "p") (let ((minibuffer-window (minibuffer-window))) (cond @@ -2605,8 +2609,7 @@ Interactively, if no argument is given, make the selected window one line smaller. If optional argument HORIZONTAL is non-nil, make selected window narrower by DELTA columns. If DELTA is negative, enlarge selected window by -DELTA lines or columns. -Also see the `window-min-height' variable. -Return nil." +Also see the `window-min-height' variable." (interactive "p") (let ((minibuffer-window (minibuffer-window))) (cond @@ -3049,8 +3052,10 @@ WINDOW must be a live window and defaults to the selected one." (set-marker (nth 2 entry) point)) ;; Make new markers. (list (copy-marker start) - (copy-marker point))))) - + (copy-marker + ;; Preserve window-point-insertion-type + ;; (Bug#12588). + point window-point-insertion-type))))) (set-window-prev-buffers window (cons entry (window-prev-buffers window)))))))) @@ -4555,13 +4560,17 @@ element is BUFFER." ;; If WINDOW has a quit-restore parameter, reset its car. (setcar (window-parameter window 'quit-restore) 'same)) ;; WINDOW shows another buffer. - (set-window-parameter - window 'quit-restore - (list 'other - ;; A quadruple of WINDOW's buffer, start, point and height. - (list (window-buffer window) (window-start window) - (window-point window) (window-total-size window)) - (selected-window) buffer)))) + (with-current-buffer (window-buffer window) + (set-window-parameter + window 'quit-restore + (list 'other + ;; A quadruple of WINDOW's buffer, start, point and height. + (list (current-buffer) (window-start window) + ;; Preserve window-point-insertion-type (Bug#12588). + (copy-marker + (window-point window) window-point-insertion-type) + (window-total-size window)) + (selected-window) buffer))))) ((eq type 'window) ;; WINDOW has been created on an existing frame. (set-window-parameter @@ -5170,11 +5179,12 @@ is higher than WINDOW." (error nil)))) (defun window--display-buffer (buffer window type &optional alist dedicated) - "Display BUFFER in WINDOW and make its frame visible. + "Display BUFFER in WINDOW. TYPE must be one of the symbols `reuse', `window' or `frame' and -is passed unaltered to `display-buffer-record-window'. Set -`window-dedicated-p' to DEDICATED if non-nil. Return WINDOW if -BUFFER and WINDOW are live." +is passed unaltered to `display-buffer-record-window'. ALIST is +the alist argument of `display-buffer'. Set `window-dedicated-p' +to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are +live." (when (and (buffer-live-p buffer) (window-live-p window)) (display-buffer-record-window type window buffer) (unless (eq buffer (window-buffer window)) @@ -5187,10 +5197,10 @@ BUFFER and WINDOW are live." (let ((parameter (window-parameter window 'quit-restore)) (height (cdr (assq 'window-height alist))) (width (cdr (assq 'window-width alist)))) - (when (or (memq type '(window frame)) + (when (or (eq type 'window) (and (eq (car parameter) 'same) - (memq (nth 1 parameter) '(window frame)))) - ;; Adjust height of new window or frame. + (eq (nth 1 parameter) 'window))) + ;; Adjust height of window if asked for. (cond ((not height)) ((numberp height) @@ -5201,19 +5211,12 @@ BUFFER and WINDOW are live." (* (window-total-size (frame-root-window window)) height)))) (delta (- new-height (window-total-size window)))) - (cond - ((and (window--resizable-p window delta nil 'safe) - (window-combined-p window)) - (window-resize window delta nil 'safe)) - ((or (eq type 'frame) - (and (eq (car parameter) 'same) - (eq (nth 1 parameter) 'frame))) - (set-frame-height - (window-frame window) - (+ (frame-height (window-frame window)) delta)))))) + (when (and (window--resizable-p window delta nil 'safe) + (window-combined-p window)) + (window-resize window delta nil 'safe)))) ((functionp height) (ignore-errors (funcall height window)))) - ;; Adjust width of a window or frame. + ;; Adjust width of window if asked for. (cond ((not width)) ((numberp width) @@ -5224,18 +5227,12 @@ BUFFER and WINDOW are live." (* (window-total-size (frame-root-window window) t) width)))) (delta (- new-width (window-total-size window t)))) - (cond - ((and (window--resizable-p window delta t 'safe) - (window-combined-p window t)) - (window-resize window delta t 'safe)) - ((or (eq type 'frame) - (and (eq (car parameter) 'same) - (eq (nth 1 parameter) 'frame))) - (set-frame-width - (window-frame window) - (+ (frame-width (window-frame window)) delta)))))) + (when (and (window--resizable-p window delta t 'safe) + (window-combined-p window t)) + (window-resize window delta t 'safe)))) ((functionp width) (ignore-errors (funcall width window)))))) + window)) (defun window--maybe-raise-frame (frame) @@ -5295,13 +5292,19 @@ See `display-buffer' for details.") "Alist of conditional actions for `display-buffer'. This is a list of elements (CONDITION . ACTION), where: - CONDITION is either a regexp matching buffer names, or a function - that takes a buffer and returns a boolean. + CONDITION is either a regexp matching buffer names, or a + function that takes two arguments - a buffer name and the + ACTION argument of `display-buffer' - and returns a boolean. ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a function or a list of functions. Each such function should accept two arguments: a buffer to display and an alist of the - same form as ALIST. See `display-buffer' for details." + same form as ALIST. See `display-buffer' for details. + +`display-buffer' scans this alist until it either finds a +matching regular expression or the function specified by a +condition returns non-nil. In any of these cases, it adds the +associated action to the list of actions it will try." :type `(alist :key-type (choice :tag "Condition" regexp @@ -5335,15 +5338,16 @@ specified, e.g. by the user options `display-buffer-alist' or `display-buffer-base-action'. See `display-buffer'.") (put 'display-buffer-fallback-action 'risky-local-variable t) -(defun display-buffer-assq-regexp (buffer-name alist) - "Retrieve ALIST entry corresponding to BUFFER-NAME." +(defun display-buffer-assq-regexp (buffer-name alist action) + "Retrieve ALIST entry corresponding to BUFFER-NAME. +ACTION is the action argument passed to `display-buffer'." (catch 'match (dolist (entry alist) (let ((key (car entry))) (when (or (and (stringp key) (string-match-p key buffer-name)) - (and (symbolp key) (functionp key) - (funcall key buffer-name alist))) + (and (functionp key) + (funcall key buffer-name action))) (throw 'match (cdr entry))))))) (defvar display-buffer--same-window-action @@ -5453,8 +5457,8 @@ argument, ACTION is t." (funcall display-buffer-function buffer inhibit-same-window) ;; Otherwise, use the defined actions. (let* ((user-action - (display-buffer-assq-regexp (buffer-name buffer) - display-buffer-alist)) + (display-buffer-assq-regexp + (buffer-name buffer) display-buffer-alist action)) (special-action (display-buffer--special-action buffer)) ;; Extra actions from the arguments to this function: (extra-action @@ -6068,22 +6072,26 @@ of `fit-frame-to-buffer-max-height' and `window-min-height'." :group 'help) (defcustom fit-frame-to-buffer-bottom-margin 4 - "Bottom margin for `fit-frame-to-buffer'. -This is the number of lines `fit-frame-to-buffer' leaves free at the -bottom of the display in order to not obscure the system task bar." + "Bottom margin for the command `fit-frame-to-buffer'. +This is the number of lines that function leaves free at the bottom of +the display, in order to not obscure any system task bar or panel. +If you do not have one (or if it is vertical) you might want to +reduce this. If it is thicker, you might want to increase this." + ;; If you set this too small, fit-frame-to-buffer can shift the + ;; frame up to avoid the panel. :type 'integer :version "24.3" :group 'windows) (defun fit-frame-to-buffer (&optional frame max-height min-height) - "Adjust height of FRAME to display its buffer's contents exactly. + "Adjust height of FRAME to display its buffer contents exactly. FRAME can be any live frame and defaults to the selected one. -Optional argument MAX-HEIGHT specifies the maximum height of -FRAME and defaults to the height of the display below the current -top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. -Optional argument MIN-HEIGHT specifies the minimum height of -FRAME." +Optional argument MAX-HEIGHT specifies the maximum height of FRAME. +It defaults to the height of the display below the current +top line of FRAME, minus `fit-frame-to-buffer-bottom-margin'. +Optional argument MIN-HEIGHT specifies the minimum height of FRAME. +The default corresponds to `window-min-height'." (interactive) (setq frame (window-normalize-frame frame)) (let* ((root (frame-root-window frame)) @@ -6160,6 +6168,10 @@ defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT are specified in lines and include the mode line and header line, if any. +If WINDOW is a full height window, then if the option +`fit-frame-to-buffer' is non-nil, this calls the function +`fit-frame-to-buffer' to adjust the frame height. + Return the number of lines by which WINDOW was enlarged or shrunk. If an error occurs during resizing, return nil but don't signal an error. diff --git a/lisp/woman.el b/lisp/woman.el index 974a7d72465..1410a8971ad 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1303,12 +1303,12 @@ cache to be re-read." ((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. @@ -1550,11 +1550,13 @@ Also make each path-info component into a 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))) @@ -1947,6 +1949,9 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (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 @@ -2191,7 +2196,7 @@ To be called on original buffer and any .so insertions." (face-underline-p face)) (let ((face-no-ul (intern (concat face-name "-no-ul")))) (copy-face face face-no-ul) - (set-face-underline-p face-no-ul nil))))))) + (set-face-underline face-no-ul nil))))))) ;; Preprocessors ;; ============= diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4 new file mode 100644 index 00000000000..2de95b88ba8 --- /dev/null +++ b/m4/euidaccess.m4 @@ -0,0 +1,52 @@ +# 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 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 +]) diff --git a/m4/faccessat.m4 b/m4/faccessat.m4 new file mode 100644 index 00000000000..82f3b1f8dde --- /dev/null +++ b/m4/faccessat.m4 @@ -0,0 +1,28 @@ +# 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 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]) +]) diff --git a/m4/fcntl_h.m4 b/m4/fcntl_h.m4 new file mode 100644 index 00000000000..cac28aeb283 --- /dev/null +++ b/m4/fcntl_h.m4 @@ -0,0 +1,50 @@ +# 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 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]) +]) diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 new file mode 100644 index 00000000000..17473af486b --- /dev/null +++ b/m4/getgroups.m4 @@ -0,0 +1,107 @@ +# 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" +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 5cd278454e7..30f81b4781f 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -54,18 +54,23 @@ AC_DEFUN([gl_EARLY], # 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: @@ -81,6 +86,7 @@ AC_DEFUN([gl_EARLY], # 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: @@ -122,6 +128,7 @@ AC_DEFUN([gl_EARLY], # 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 @@ -160,6 +167,14 @@ AC_DEFUN([gl_INIT], 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 @@ -278,18 +293,53 @@ AC_DEFUN([gl_INIT], 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 @@ -298,6 +348,24 @@ AC_DEFUN([gl_INIT], 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 @@ -305,6 +373,12 @@ AC_DEFUN([gl_INIT], 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 @@ -356,6 +430,18 @@ AC_DEFUN([gl_INIT], 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 @@ -382,12 +468,17 @@ AC_DEFUN([gl_INIT], 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])[ || @@ -536,6 +627,7 @@ AC_DEFUN([gl_FILE_LIST], [ 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 @@ -549,14 +641,18 @@ AC_DEFUN([gl_FILE_LIST], [ 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 @@ -565,6 +661,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/gettext.h lib/gettime.c lib/gettimeofday.c + lib/group-member.c lib/ignore-value.h lib/intprops.h lib/inttypes.in.h @@ -577,6 +674,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/pselect.c lib/pthread_sigmask.c lib/readlink.c + lib/root-uid.h lib/sha1.c lib/sha1.h lib/sha256.c @@ -618,6 +716,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/utimens.c lib/utimens.h lib/verify.h + lib/xalloc-oversized.h m4/00gnulib.m4 m4/alloca.m4 m4/c-strtod.m4 @@ -625,16 +724,22 @@ AC_DEFUN([gl_FILE_LIST], [ 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 diff --git a/m4/group-member.m4 b/m4/group-member.m4 new file mode 100644 index 00000000000..c393b5b1303 --- /dev/null +++ b/m4/group-member.m4 @@ -0,0 +1,29 @@ +# 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 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]) +]) diff --git a/nt/ChangeLog b/nt/ChangeLog index 931cb745c8b..95203b9d2fa 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,57 @@ +2012-11-17 Juanma Barranquero + + * config.nt: Sync with autogen/config.in. + (HAVE_FPATHCONF): Remove. + +2012-11-17 Paul Eggert + + 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 if and + when that gets implemented. In the meantime, include + to make sure we don't override its definitions. + +2012-11-17 Eli Zaretskii + + * 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 + + * 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 + + * 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 + + * 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 + + 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 * inc/unistd.h (tcgetpgrp, setsid): Provide prototypes. diff --git a/nt/config.nt b/nt/config.nt index 443a1025761..57c18ad2789 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -180,6 +180,14 @@ along with GNU Emacs. If not, see . */ setjmp does work. */ #define GC_SETJMP_WORKS 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 @@ -194,6 +202,10 @@ along with GNU Emacs. If not, see . */ 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 @@ -215,6 +227,9 @@ along with GNU Emacs. If not, see . */ 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 @@ -339,6 +354,9 @@ along with GNU Emacs. If not, see . */ /* 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 @@ -354,15 +372,15 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the 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 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 @@ -405,6 +423,9 @@ along with GNU Emacs. If not, see . */ /* 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 @@ -571,6 +592,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `dnet' library (-ldnet). */ #undef HAVE_LIBDNET +/* Define to 1 if you have the header file. */ +#undef HAVE_LIBGEN_H + /* Define to 1 if you have the hesiod library (-lhesiod). */ #undef HAVE_LIBHESIOD @@ -959,7 +983,7 @@ along with GNU Emacs. If not, see . */ #undef HAVE_SYS_VLIMIT_H /* Define to 1 if you have that is POSIX.1 compatible. */ -#undef HAVE_SYS_WAIT_H +#define HAVE_SYS_WAIT_H 1 /* Define to 1 if you have the header file. */ #undef HAVE_TERM_H diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index dd2ae781cb8..7b16ccab069 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -145,8 +145,6 @@ extern char *getenv (); #endif /* Calls that are emulated or shadowed. */ -#undef access -#define access sys_access #undef chdir #define chdir sys_chdir #undef chmod @@ -185,15 +183,12 @@ extern char *getenv (); /* 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 diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 70225a9c82f..95fee4c4659 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -119,7 +119,7 @@ int sys_sendto (int s, const char * buf, int len, int flags, 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 diff --git a/nt/inc/sys/wait.h b/nt/inc/sys/wait.h new file mode 100644 index 00000000000..8d890c9e175 --- /dev/null +++ b/nt/inc/sys/wait.h @@ -0,0 +1,33 @@ +/* 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 . */ + +#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_ */ diff --git a/nt/inc/unistd.h b/nt/inc/unistd.h index 4c5f7d4c124..0173fdbb943 100644 --- a/nt/inc/unistd.h +++ b/nt/inc/unistd.h @@ -18,4 +18,25 @@ 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 first, to make sure we don't override + its values if any. FIXME: If we know 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 +#ifndef O_NOCTTY +#define O_NOCTTY 0 +#endif +#ifndef O_RDWR +#define O_RDWR 2 +#endif + #endif /* _UNISTD_H */ diff --git a/nt/zipdist.bat b/nt/zipdist.bat index 806415054fd..e196299b6d6 100644 --- a/nt/zipdist.bat +++ b/nt/zipdist.bat @@ -25,9 +25,8 @@ set EMACS_VER=%1 set TMP_DIST_DIR=emacs-%EMACS_VER% rem Check, if 7zip is installed and available on path -:ZIP_CHECK -7z -if %ERRORLEVEL% NEQ 0 goto :ZIP_ERROR +7z 1>NUL 2>NUL +if %ERRORLEVEL% NEQ 0 goto ZIP_ERROR goto ZIP_DIST :ZIP_ERROR @@ -35,14 +34,10 @@ echo. echo ERROR: Make sure 7zip is installed and available on the Windows Path! goto EXIT -rem Build distributions +rem Build and verify the binary distribution :ZIP_DIST -rem Build and verify full distribution 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% 7z t emacs-%EMACS_VER%-bin-i386.zip -rem Build and verify binary only distribution -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 -7z t emacs-%EMACS_VER%-barebin-i386.zip goto EXIT :EXIT diff --git a/src/ChangeLog b/src/ChangeLog index 88352c201b6..2a0c0e6822d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,233 @@ +2012-11-18 Paul Eggert + + * nsterm.m (ns_select): Send SIGIO only to self, not to process group. + +2012-11-18 Eli Zaretskii + + * w32select.c: Include w32common.h before w32term.h, so that + windows.h gets included before w32term.h uses some of its + features, see below. + + * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]: New + typedefs. + (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]: New + prototypes. + (EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878) + +2012-11-18 Jan Djärv + + * nsterm.m (hold_event): Set send_appdefined to YES (Bug#12834). + (ns_select): Return at once if events are held (Bug#12834). + +2012-11-18 enami tsugutomo + + * unexelf.c (ELFSIZE) [__NetBSD__ && _LP64]: Set to 64. + Needed following 2012-10-20 change. (Bug#12902) + +2012-11-18 Juanma Barranquero + + * w32proc.c (waitpid): Remove unused label get_result. + +2012-11-17 Juanma Barranquero + + * 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 + + 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 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 , 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 + + * 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 + + Fix problems in ns port found by static checking. + * nsterm.m: Include , 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 + + * editfns.c (Fmessage): Mention message-log-max. (Bug#12849) + +2012-11-16 Stefan Monnier + + * eval.c (Finteractive_p): Revert lexbind-merge mishap. + +2012-11-16 Eli Zaretskii + + * w32proc.c (timer_loop): Make sure SuspendThread and ResumeThread + use the same value of thread handle. + (start_timer_thread): If the timer thread exited (due to error), + clean up by closing the two handles it used. Duplicate the caller + thread's handle here, so it gets duplicated only once, when + launching the timer thread. Set priority of the timer thread, not + the caller thread. + (getitimer): Don't duplicate the caller thread's handle here. + (Bug#12832) + +2012-11-16 Jan Djärv + + * nsterm.m (hold_event): Send SIGIO to make sure ns_read_socket is + called (Bug#12834). + +2012-11-16 Paul Eggert + + 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 + + * makefile.w32-in ($(BLD)/dispnew.$(O), $(BLD)/emacs.$(O)): + Update dependencies. + +2012-11-15 Paul Eggert + + * 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 + . + +2012-11-14 Eli Zaretskii + + * 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 + + * xdisp.c (echo_area_display, redisplay_internal): + Omit redundant check whether frame_garbaged is set. + +2012-11-14 Paul Eggert + + 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 ; 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 + + 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 * xdisp.c (decode_mode_spec): Limit the value of WIDTH argument diff --git a/src/Makefile.in b/src/Makefile.in index 20e9366592d..88e1fc544d0 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -150,6 +150,7 @@ M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@ 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@ @@ -405,7 +406,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBX_OTHER) $(LIBSOUND) \ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_CLOCK_GETTIME) \ $(WEBKIT_LIBS) $(CLUTTER_LIBS) $(GIR_LIBS) \ - $(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) \ diff --git a/src/callproc.c b/src/callproc.c index c7bbe36e605..c9a504746b3 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1317,16 +1317,7 @@ relocate_fd (int fd, int minfd) 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: "; @@ -1576,15 +1567,13 @@ init_callproc (void) #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"); @@ -1593,7 +1582,7 @@ init_callproc (void) 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 } diff --git a/src/charset.c b/src/charset.c index 6b999824dab..c9133c780e8 100644 --- a/src/charset.c +++ b/src/charset.c @@ -2293,7 +2293,7 @@ init_charset (void) { 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 diff --git a/src/conf_post.h b/src/conf_post.h index 66390ddf103..b1997e79081 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -178,6 +178,10 @@ extern void _DebPrint (const char *fmt, ...); #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 #include diff --git a/src/dispnew.c b/src/dispnew.c index 7a0901aafd6..5c162cdfadf 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -144,10 +144,6 @@ struct frame *last_nonminibuf_frame; 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; @@ -1852,43 +1848,6 @@ adjust_glyphs (struct frame *f) 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 @@ -3073,19 +3032,13 @@ window_to_frame_hpos (struct window *w, int hpos) Redrawing Frames **********************************************************************/ -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) +/* Redraw frame F. */ + +void +redraw_frame (struct frame *f) { - struct frame *f = decode_live_frame (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; - + /* Error if F has no glyphs. */ + eassert (f->glyphs_initialized_p); update_begin (f); #ifdef MSDOS if (FRAME_MSDOS_P (f)) @@ -3102,22 +3055,17 @@ If FRAME is omitted or nil, the selected frame is used. */) mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0); set_window_update_flags (XWINDOW (FRAME_ROOT_WINDOW (f)), 1); f->garbaged = 0; +} + +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) +{ + redraw_frame (decode_live_frame (frame)); return Qnil; } - -/* Redraw frame F. This is nothing more than a call to the Lisp - function redraw-frame. */ - -void -redraw_frame (struct frame *f) -{ - Lisp_Object frame; - XSETFRAME (frame, f); - Fredraw_frame (frame); -} - - DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", doc: /* Clear and redisplay all visible frames. */) (void) @@ -3126,7 +3074,7 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", FOR_EACH_FRAME (tail, frame) if (FRAME_VISIBLE_P (XFRAME (frame))) - Fredraw_frame (frame); + redraw_frame (XFRAME (frame)); return Qnil; } @@ -6219,7 +6167,6 @@ init_display (void) So call tgetent. */ { char b[2044]; tgetent (b, "xterm");} #endif - adjust_frame_glyphs_initially (); return; } #endif /* HAVE_X_WINDOWS */ @@ -6229,7 +6176,6 @@ init_display (void) { Vinitial_window_system = Qw32; Vwindow_system_version = make_number (1); - adjust_frame_glyphs_initially (); return; } #endif /* HAVE_NTGUI */ @@ -6243,7 +6189,6 @@ init_display (void) { Vinitial_window_system = Qns; Vwindow_system_version = make_number (10); - adjust_frame_glyphs_initially (); return; } #endif @@ -6333,7 +6278,6 @@ init_display (void) 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. */ diff --git a/src/editfns.c b/src/editfns.c index c5d4ed295ab..8122ffdd0d4 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3434,8 +3434,8 @@ static ptrdiff_t message_length; DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, doc: /* Display a message at the bottom of the screen. -The message also goes into the `*Messages*' buffer. -\(In keyboard macros, that's all it does.) +The message also goes into the `*Messages*' buffer, if `message-log-max' +is non-nil. (In keyboard macros, that's all it does.) Return the message. The first argument is a format control string, and the rest are data diff --git a/src/emacs.c b/src/emacs.c index aece6069230..079304b6c8e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -98,10 +98,6 @@ extern void moncontrol (int mode); #include #endif -#ifndef O_RDWR -#define O_RDWR 2 -#endif - static const char emacs_version[] = VERSION; static const char emacs_copyright[] = COPYRIGHT; diff --git a/src/eval.c b/src/eval.c index dcd48cb7250..f8a76646352 100644 --- a/src/eval.c +++ b/src/eval.c @@ -508,7 +508,7 @@ spec that specifies non-nil unconditionally (such as \"p\"); or (ii) use `called-interactively-p'. */) (void) { - return interactive_p () ? Qt : Qnil; + return (INTERACTIVE && interactive_p ()) ? Qt : Qnil; } @@ -3369,7 +3369,7 @@ mark_backtrace (void) 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? */ diff --git a/src/fileio.c b/src/fileio.c index b9541e78838..572f6d8ef83 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2425,15 +2425,7 @@ On Unix, this is a name starting with a `/' or a `~'. */) 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. */ @@ -2441,56 +2433,40 @@ check_existing (const char *filename) 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 */ } @@ -2547,9 +2523,6 @@ See also `file-exists-p' and `file-attributes'. */) { Lisp_Object absname; Lisp_Object handler; - int desc; - int flags; - struct stat statbuf; CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); @@ -2561,35 +2534,10 @@ See also `file-exists-p' and `file-attributes'. */) 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) @@ -2607,14 +2555,15 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, 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); @@ -2622,10 +2571,9 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, /* 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 } @@ -2703,8 +2651,7 @@ Symbolic links to directories count as directories. 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)); @@ -2717,9 +2664,20 @@ See `file-symlink-p' to distinguish symlinks. */) 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, @@ -2733,21 +2691,65 @@ if the directory so specified exists and really is a readable and 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, @@ -3044,10 +3046,8 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of 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)); diff --git a/src/keyboard.c b/src/keyboard.c index 42c26982086..bf441efef90 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -6964,7 +6964,7 @@ tty_read_avail_input (struct terminal *terminal, #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 @@ -6998,7 +6998,7 @@ tty_read_avail_input (struct terminal *terminal, } 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 diff --git a/src/lisp.h b/src/lisp.h index b56e499ce29..4941f649e79 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3207,6 +3207,8 @@ extern Lisp_Object close_file_unwind (Lisp_Object); 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; diff --git a/src/lread.c b/src/lread.c index 3a82e0057e2..5859a2f85a9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1403,7 +1403,7 @@ Returns the file's name in absolute form, or nil if not found. 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. */) @@ -1441,7 +1441,6 @@ static Lisp_Object Qdir_ok; 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; @@ -1496,7 +1495,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto { 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. */ @@ -1520,6 +1518,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto 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 @@ -1541,37 +1540,40 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto } 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) @@ -4087,9 +4089,8 @@ load_path_check (void) 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)); } } } @@ -4201,11 +4202,11 @@ init_lread (void) 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))) @@ -4222,10 +4223,10 @@ init_lread (void) 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))) @@ -4237,7 +4238,7 @@ init_lread (void) { 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))) @@ -4282,7 +4283,7 @@ init_lread (void) { 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))) @@ -4338,21 +4339,28 @@ init_lread (void) 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 (); } diff --git a/src/makefile.w32-in b/src/makefile.w32-in index f5cab34d7dc..9778e955677 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -472,6 +472,8 @@ SYSSIGNAL_H = $(SRC)/syssignal.h \ 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 \ @@ -566,7 +568,6 @@ $(BLD)/callproc.$(O) : \ $(SRC)/commands.h \ $(SRC)/composite.h \ $(SRC)/epaths.h \ - $(SRC)/syswait.h \ $(SRC)/w32.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/unistd.h \ @@ -580,6 +581,7 @@ $(BLD)/callproc.$(O) : \ $(PROCESS_H) \ $(SYSSIGNAL_H) \ $(SYSTTY_H) \ + $(SYSWAIT_H) \ $(TERMHOOKS_H) $(BLD)/casefiddle.$(O) : \ @@ -737,6 +739,7 @@ $(BLD)/dispnew.$(O) : \ $(SRC)/termchar.h \ $(SRC)/w32.h \ $(NT_INC)/unistd.h \ + $(GNU_LIB)/fpending.h \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -802,6 +805,7 @@ $(BLD)/emacs.$(O) : \ $(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) \ @@ -1214,7 +1218,6 @@ $(BLD)/w32inevt.$(O) : \ $(BLD)/w32proc.$(O) : \ $(SRC)/w32proc.c \ - $(SRC)/syswait.h \ $(SRC)/w32.h \ $(SRC)/w32common.h \ $(SRC)/w32heap.h \ @@ -1228,6 +1231,7 @@ $(BLD)/w32proc.$(O) : \ $(PROCESS_H) \ $(SYSSIGNAL_H) \ $(SYSTIME_H) \ + $(SYSWAIT_H) \ $(W32TERM_H) $(BLD)/w32console.$(O) : \ @@ -1272,7 +1276,6 @@ $(BLD)/process.$(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 \ @@ -1295,6 +1298,7 @@ $(BLD)/process.$(O) : \ $(SYSSIGNAL_H) \ $(SYSTIME_H) \ $(SYSTTY_H) \ + $(SYSWAIT_H) \ $(TERMHOOKS_H) \ $(W32TERM_H) \ $(WINDOW_H) @@ -1378,7 +1382,6 @@ $(BLD)/sysdep.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/cm.h \ $(SRC)/sysselect.h \ - $(SRC)/syswait.h \ $(SRC)/termchar.h \ $(SRC)/termopts.h \ $(NT_INC)/netdb.h \ @@ -1403,6 +1406,7 @@ $(BLD)/sysdep.$(O) : \ $(SYSSIGNAL_H) \ $(SYSTIME_H) \ $(SYSTTY_H) \ + $(SYSWAIT_H) \ $(TERMHOOKS_H) \ $(WINDOW_H) diff --git a/src/nsterm.m b/src/nsterm.m index 7ba1608268b..57d32ee0528 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -30,7 +30,9 @@ Updated by Christian Limpach (chris@nice.ch) interpretation of even the system includes. */ #include +#include #include +#include #include #include #include @@ -40,10 +42,6 @@ Updated by Christian Limpach (chris@nice.ch) #include #include -#ifdef HAVE_FCNTL_H -#include -#endif - #include "lisp.h" #include "blockinput.h" #include "sysselect.h" @@ -330,6 +328,9 @@ Updated by Christian Limpach (chris@nice.ch) } hold_event_q.q[hold_event_q.nr++] = *event; + /* Make sure ns_read_socket is called, i.e. we have input. */ + raise (SIGIO); + send_appdefined = YES; } static Lisp_Object @@ -3387,7 +3388,7 @@ overwriting cursor (usually when cursor on a tab) */ 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) @@ -3461,6 +3462,14 @@ overwriting cursor (usually when cursor on a tab) */ /* NSTRACE (ns_select); */ + if (hold_event_q.nr > 0) + { + /* We already have events pending. */ + raise (SIGIO); + errno = EINTR; + return -1; + } + for (k = 0; k < nfds+1; k++) { if (readfds && FD_ISSET(k, readfds)) ++nr; @@ -3502,7 +3511,7 @@ overwriting cursor (usually when cursor on a tab) */ /* 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) { @@ -3535,7 +3544,7 @@ overwriting cursor (usually when cursor on a tab) */ if (nr > 0 && readfds) { c = 's'; - write (selfds[1], &c, 1); + emacs_write (selfds[1], &c, 1); } unblock_input (); @@ -4112,8 +4121,6 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. 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)) @@ -4576,11 +4583,8 @@ - (void)fd_handler:(id)unused 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 { @@ -4620,8 +4624,8 @@ - (void)fd_handler:(id)unused { 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 { @@ -6696,7 +6700,7 @@ - (int) checkSamePosition: (int) position portion: (int) portion /* 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; } diff --git a/src/process.c b/src/process.c index 43f0239d301..0036ce595f5 100644 --- a/src/process.c +++ b/src/process.c @@ -130,18 +130,6 @@ extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, EMACS_TIME *, void *); #endif -/* This is for DOS_NT ports. FIXME: Remove this old portability cruft - by having DOS_NT ports implement waitpid instead of wait. Nowadays - POSIXish hosts all define waitpid, WNOHANG, and WUNTRACED, as these - have been standard since POSIX.1-1988. */ -#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 . These lines can be removed once the GCC bug is fixed. */ @@ -208,11 +196,9 @@ static EMACS_INT update_tick; #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 */ @@ -340,9 +326,6 @@ static struct sockaddr_and_len { #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) @@ -654,13 +637,7 @@ allocate_pty (void) #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) @@ -672,7 +649,7 @@ allocate_pty (void) #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 @@ -1598,7 +1575,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) 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 @@ -1624,13 +1601,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #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 @@ -1659,7 +1632,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) forkin = sv[0]; } -#if !defined (WINDOWSNT) && defined (FD_CLOEXEC) +#ifndef WINDOWSNT { int tem; @@ -1678,15 +1651,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) } #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. */ @@ -1845,9 +1811,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) 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 */ @@ -1906,7 +1870,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) 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 @@ -1943,13 +1907,9 @@ create_pty (Lisp_Object process) #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) @@ -1963,15 +1923,8 @@ create_pty (Lisp_Object process) } #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. */ @@ -2927,13 +2880,9 @@ usage: (make-network-process &rest ARGS) */) { /* 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). */ @@ -3193,11 +3142,7 @@ usage: (make-network-process &rest ARGS) */) #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; @@ -3410,13 +3355,7 @@ usage: (make-network-process &rest ARGS) */) 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); @@ -4145,13 +4084,7 @@ server_accept_connection (Lisp_Object server, int channel) 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); @@ -4847,23 +4780,17 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, 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 @@ -5532,19 +5459,6 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, 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)) @@ -6311,17 +6225,9 @@ record_child_status_change (pid_t pid, int w) { #ifdef SIGCHLD -# ifdef WNOHANG - /* On POSIXish hosts, record at most one child only if we already - know one child that has exited. */ + /* Record at most one child only if we already know one child that + has exited. */ bool record_at_most_one_child = 0 <= pid; -# else - /* On DOS_NT (the only porting target that lacks WNOHANG), - record the status of at most one child process, since the SIGCHLD - handler must return right away. If any more processes want to - signal us, we will get another signal. */ - bool record_at_most_one_child = 1; -# endif Lisp_Object tail; @@ -7348,9 +7254,7 @@ init_process_emacs (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); diff --git a/src/sysdep.c b/src/sysdep.c index aa9d0f38c3c..7c5c144fa8c 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -289,10 +289,6 @@ wait_for_termination_1 (pid_t pid, int interruptible) { while (1) { -#ifdef WINDOWSNT - wait (0); - break; -#else /* not WINDOWSNT */ int status; int wait_result = waitpid (pid, &status, 0); if (wait_result < 0) @@ -306,7 +302,8 @@ wait_for_termination_1 (pid_t pid, int interruptible) break; } -#endif /* not WINDOWSNT */ + /* Note: the MS-Windows emulation of waitpid calls QUIT + internally. */ if (interruptible) QUIT; } @@ -1039,8 +1036,7 @@ init_sys_modes (struct tty_display_info *tty_out) #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)] = @@ -1058,7 +1054,6 @@ init_sys_modes (struct tty_display_info *tty_out) #endif /* HAVE_GPM */ } #endif /* F_GETOWN */ -#endif /* F_SETFL */ #ifdef _IOFBF /* This symbol is defined on recent USG systems. @@ -1278,8 +1273,8 @@ reset_sys_modes (struct tty_display_info *tty_out) 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)); @@ -1287,11 +1282,9 @@ reset_sys_modes (struct tty_display_info *tty_out) 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), @@ -2380,19 +2373,7 @@ safe_strsignal (int code) 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", diff --git a/src/term.c b/src/term.c index 578c701858f..481a3423989 100644 --- a/src/term.c +++ b/src/term.c @@ -20,8 +20,9 @@ along with GNU Emacs. If not, see . */ /* New redisplay, TTY faces by Gerd Moellmann . */ #include -#include #include +#include +#include #include #include #include @@ -55,14 +56,6 @@ static int been_here = -1; #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$" @@ -2989,22 +2982,18 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) 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); @@ -3023,10 +3012,8 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) 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; diff --git a/src/unexelf.c b/src/unexelf.c index 121e6042fc9..b9f8e05e959 100644 --- a/src/unexelf.c +++ b/src/unexelf.c @@ -461,7 +461,7 @@ typedef struct { /* * NetBSD does not have normal-looking user-land ELF support. */ -# if defined __alpha__ || defined __sparc_v9__ +# if defined __alpha__ || defined __sparc_v9__ || defined _LP64 # define ELFSIZE 64 # else # define ELFSIZE 32 diff --git a/src/w32.c b/src/w32.c index 5ac1bc3eb7c..94cf472a4ae 100644 --- a/src/w32.c +++ b/src/w32.c @@ -1597,7 +1597,7 @@ init_environment (char ** argv) 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); @@ -2708,16 +2708,20 @@ logon_network_drive (const char *path) 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); @@ -2725,7 +2729,8 @@ sys_access (const char * path, int mode) 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) @@ -2757,7 +2762,8 @@ sys_access (const char * path, int mode) } 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; @@ -2775,6 +2781,11 @@ sys_access (const char * path, int mode) 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) { @@ -2960,7 +2971,7 @@ sys_mktemp (char * template) { 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; @@ -4011,7 +4022,7 @@ symlink (char const *filename, char const *linkname) { /* 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 @@ -4025,10 +4036,10 @@ symlink (char const *filename, char const *linkname) 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 @@ -5843,7 +5854,7 @@ fcntl (int s, int cmd, int options) 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); diff --git a/src/w32proc.c b/src/w32proc.c index f35a2da537c..9b111b40e36 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -431,13 +431,14 @@ timer_loop (LPVOID arg) /* Simulate a signal delivered to the thread which installed the timer, by suspending that thread while the handler runs. */ - DWORD result = SuspendThread (itimer->caller_thread); + HANDLE th = itimer->caller_thread; + DWORD result = SuspendThread (th); if (result == (DWORD)-1) return 2; handler (sig); - ResumeThread (itimer->caller_thread); + ResumeThread (th); } /* Update expiration time and loop. */ @@ -562,6 +563,7 @@ static int start_timer_thread (int which) { DWORD exit_code; + HANDLE th; struct itimer_data *itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer; @@ -570,9 +572,29 @@ start_timer_thread (int which) && exit_code == STILL_ACTIVE) return 0; + /* Clean up after possibly exited thread. */ + if (itimer->timer_thread) + { + CloseHandle (itimer->timer_thread); + itimer->timer_thread = NULL; + } + if (itimer->caller_thread) + { + CloseHandle (itimer->caller_thread); + itimer->caller_thread = NULL; + } + /* Start a new thread. */ + if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), + GetCurrentProcess (), &th, 0, FALSE, + DUPLICATE_SAME_ACCESS)) + { + errno = ESRCH; + return -1; + } itimer->terminate = 0; itimer->type = which; + itimer->caller_thread = th; /* Request that no more than 64KB of stack be reserved for this thread, to avoid reserving too much memory, which would get in the way of threads we start to wait for subprocesses. See also @@ -591,7 +613,7 @@ start_timer_thread (int which) /* This is needed to make sure that the timer thread running for profiling gets CPU as soon as the Sleep call terminates. */ if (which == ITIMER_PROF) - SetThreadPriority (itimer->caller_thread, THREAD_PRIORITY_TIME_CRITICAL); + SetThreadPriority (itimer->timer_thread, THREAD_PRIORITY_TIME_CRITICAL); return 0; } @@ -626,17 +648,9 @@ getitimer (int which, struct itimerval *value) itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer; - if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), - GetCurrentProcess (), &itimer->caller_thread, 0, - FALSE, DUPLICATE_SAME_ACCESS)) - { - errno = ESRCH; - return -1; - } - ticks_now = w32_get_timer_time ((which == ITIMER_REAL) ? NULL - : itimer->caller_thread); + : GetCurrentThread ()); t_expire = &itimer->expire; t_reload = &itimer->reload; @@ -775,7 +789,6 @@ alarm (int seconds) /* 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); @@ -1028,9 +1041,6 @@ create_child (char *exe, char *cmdline, char *env, int is_gui_app, 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; @@ -1106,55 +1116,110 @@ reap_subprocess (child_process *cp) 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) @@ -1175,7 +1240,6 @@ sys_wait (int *status) else emacs_abort (); -get_result: if (!GetExitCodeProcess (wait_hnd[active], &retval)) { DebPrint (("Wait.GetExitCodeProcess failed with %lu\n", @@ -1184,8 +1248,10 @@ sys_wait (int *status) } 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; } @@ -1199,6 +1265,8 @@ sys_wait (int *status) else retval <<= 8; + if (pid > 0 && active != 0) + emacs_abort (); cp = cps[active]; pid = cp->pid; #ifdef FULL_DEBUG @@ -1987,9 +2055,7 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, 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) diff --git a/src/w32select.c b/src/w32select.c index 1b10c74cfe9..6a2a840f914 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -74,8 +74,8 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" -#include "w32term.h" /* for all of the w32 includes */ #include "w32common.h" /* os_subtype */ +#include "w32term.h" /* for all of the w32 includes */ #include "keyboard.h" #include "blockinput.h" #include "charset.h" diff --git a/src/w32term.h b/src/w32term.h index 72fb8a76e35..83535b8faa3 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -745,6 +745,21 @@ extern int w32_system_caret_height; extern int w32_system_caret_x; extern int w32_system_caret_y; +#ifdef _MSC_VER +#ifndef EnumSystemLocales +/* MSVC headers define these only for _WIN32_WINNT >= 0x0500. */ +typedef BOOL (CALLBACK *LOCALE_ENUMPROCA)(LPSTR); +typedef BOOL (CALLBACK *LOCALE_ENUMPROCW)(LPWSTR); +BOOL WINAPI EnumSystemLocalesA(LOCALE_ENUMPROCA,DWORD); +BOOL WINAPI EnumSystemLocalesW(LOCALE_ENUMPROCW,DWORD) +#ifdef UNICODE +#define EnumSystemLocales EnumSystemLocalesW +#else +#define EnumSystemLocales EnumSystemLocalesA +#endif +#endif +#endif + #if EMACSDEBUG extern const char* w32_name_of_message (UINT msg); diff --git a/src/xdisp.c b/src/xdisp.c index 679b51b0d7d..5e53168cf0e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10823,7 +10823,7 @@ clear_garbaged_frames (void) { if (f->resized_p) { - Fredraw_frame (frame); + redraw_frame (f); f->force_flush_display_p = 1; } clear_current_matrices (f); @@ -10870,8 +10870,7 @@ echo_area_display (int update_frame_p) #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) { @@ -13158,8 +13157,7 @@ redisplay_internal (void) } /* Clear frames marked as garbaged. */ - if (frame_garbaged) - clear_garbaged_frames (); + clear_garbaged_frames (); /* Build menubar and tool-bar items. */ if (NILP (Vmemory_full)) @@ -13243,8 +13241,7 @@ redisplay_internal (void) /* 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) @@ -13267,8 +13264,7 @@ redisplay_internal (void) /* 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 (); } diff --git a/src/xfaces.c b/src/xfaces.c index daf329791c1..1e27d5cc043 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2870,6 +2870,12 @@ FRAME 0 means change the face on all frames, and change the default Lisp_Object key, val, list; list = value; + /* FIXME? This errs on the side of acceptance. Eg it accepts: + (defface foo '((t :underline 'foo) "doc") + Maybe this is intentional, maybe it isn't. + Non-nil symbols other than t are not documented as being valid. + Eg compare with inverse-video, which explicitly rejects them. + */ valid_p = 1; while (!NILP (CAR_SAFE(list))) @@ -5660,6 +5666,8 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) face->underline_defaulted_p = 1; face->underline_type = FACE_UNDER_LINE; + /* FIXME? This is also not robust about checking the precise form. + See comments in Finternal_set_lisp_face_attribute. */ while (CONSP (underline)) { Lisp_Object keyword, value; diff --git a/src/xrdb.c b/src/xrdb.c index 9d056a607e4..59b0876ebf8 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -41,7 +41,6 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_PWD_H #include #endif -#include #ifdef USE_MOTIF /* For Vdouble_click_time. */ @@ -50,7 +49,6 @@ along with GNU Emacs. If not, see . */ char *x_get_string_resource (XrmDatabase rdb, const char *name, const char *class); -static int file_p (const char *filename); /* X file search path processing. */ @@ -108,7 +106,7 @@ x_get_customization_string (XrmDatabase db, const char *name, 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. @@ -117,10 +115,11 @@ x_get_customization_string (XrmDatabase db, const char *name, 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; @@ -217,14 +216,9 @@ magic_file_p (const char *string, ptrdiff_t string_len, const char *class, } path[path_len] = '\0'; - - if (! file_p (path)) - { - xfree (path); - return NULL; - } - - return path; + db = XrmGetFileDatabase (path); + xfree (path); + return db; } @@ -258,22 +252,11 @@ gethomedir (void) } -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) { @@ -286,18 +269,16 @@ search_magic_path (const char *search_path, const char *class, 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 == ':') @@ -312,21 +293,12 @@ search_magic_path (const char *search_path, const char *class, 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); } @@ -340,35 +312,40 @@ get_fallback (Display *display) 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")))) - - /* 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; + path = getenv ("XAPPLRESDIR"); + if (path) + { + db = search_magic_path (path, class, "/%L/%N"); + if (!db) + db = search_magic_path (path, class, "/%N"); + } } - xfree (free_it); - return NULL; + 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. */ + char *home = gethomedir (); + db = search_magic_path (home, class, "%L/%N"); + if (! db) + db = search_magic_path (home, class, "%N"); + xfree (home); + } + + return db; } diff --git a/test/ChangeLog b/test/ChangeLog index 4a9d215aa21..f11325d0318 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,22 @@ +2012-11-14 Dmitry Gutov + + * 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 + + * 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 * automated/advice-tests.el: New tests. diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index cac10e9602f..80321f8f3f9 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el @@ -50,6 +50,43 @@ ((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 () diff --git a/test/automated/ruby-mode-tests.el b/test/automated/ruby-mode-tests.el index 8da0041e9a4..ad48413b030 100644 --- a/test/automated/ruby-mode-tests.el +++ b/test/automated/ruby-mode-tests.el @@ -36,11 +36,13 @@ 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. @@ -76,6 +78,14 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby-assert-state "foo <
  • #{@files.join(\"
  • \")}
    • \"")) + (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)