diff options
| author | Tom Tromey <tromey@redhat.com> | 2013-07-12 18:44:13 -0600 |
|---|---|---|
| committer | Tom Tromey <tromey@redhat.com> | 2013-07-12 18:44:13 -0600 |
| commit | b34a529f177a6ea32da5cb1254f91bf9d71838db (patch) | |
| tree | 477131abc15d3107b30b635223d87a22550b480b | |
| parent | e6f63071a3f7721f55220514b6d9a8ee8c1232d8 (diff) | |
| parent | 5e301d7651c0691bb2bc7f3fbe711fdbe26ac471 (diff) | |
| download | emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.tar.gz | |
Merge from trunk
158 files changed, 4301 insertions, 2228 deletions
diff --git a/ChangeLog b/ChangeLog index bd938539421..967284b485d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,62 @@ +2013-07-13 Paul Eggert <eggert@cs.ucla.edu> + + * configure.ac: Simplify --with-file-notification handling. + +2013-07-12 Glenn Morris <rgm@gnu.org> + + * configure.ac: If with-file-notification=yes, if gfile not found, + go on to try inotify (not on MS Windows or Nextstep). + +2013-07-12 Paul Eggert <eggert@cs.ucla.edu> + + Fix races with threads and file descriptors. + * configure.ac (PTY_TTY_NAME_SPRINTF): Use emacs_close, not close. + +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + * Makefile.in (removenullpaths): Remove adjacent null paths (Bug#14835). + +2013-07-09 Peter Rosin <peda@lysator.liu.se> (tiny change> + + * configure.ac (HAVE_W32): Avoid nested functions (the second + argument of AC_LANG_PROGRAM is already expanded inside a + function). (Bug#14830) + +2013-07-09 Paul Eggert <eggert@cs.ucla.edu> + + Port recent close-on-exec changes to Cygwin (Bug#14821). + * lib/binary-io.c, lib/binary-io.h: New files. + Merge from gnulib, incorporating: + 2013-07-09 accept4, dup3, pipe2: port to Cygwin + * lib/pipe2.c: Update from gnulib, as part of this merge. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + + Handle errno and exit status a bit more carefully. + * lib/ignore-value.h: Remove this gnulib-imported file. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change) + + * configure.ac (HAVE_IMAGEMAGICK): Check on NS also (Bug#14798). + +2013-07-08 Paul Eggert <eggert@cs.ucla.edu> + + Try to fix FreeBSD 9.1 porting problem (Bug#14812). + This incorporates the following merge from gnulib: + 2013-07-07 stdalign, verify: port to FreeBSD 9.1, to C11, and to C++11 + +2013-07-07 Paul Eggert <eggert@cs.ucla.edu> + + Port to Ubuntu 10 (Bug#14803). + * configure.ac (accept4): New function to check for. + + Make file descriptors close-on-exec when possible (Bug#14803). + * configure.ac (mkostemp): New function to check for. + (PTY_OPEN): Pass O_CLOEXEC to posix_openpt. + * lib/fcntl.c, lib/getdtablesize.c, lib/pipe2.c, m4/fcntl.m4: + * m4/getdtablesize.m4, m4/pipe2.m4: New files, taken from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + 2013-07-03 Christoph Egger <christoph@debian.org> (tiny change) * configure.ac (emacs_broken_SIGIO): Set on gnu-kfreebsd to avoid hang. @@ -36,7 +95,7 @@ * Makefile.in (install-arch-indep): Do not create directories passed with --enable-locallisppath. -2013-06-24 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-24 Glenn Morris <rgm@gnu.org> * configure.ac: Include X11/X.h when testing for Xft.h. (Bug#14684) diff --git a/Makefile.in b/Makefile.in index 4afe6746cfc..a5accbf04a9 100644 --- a/Makefile.in +++ b/Makefile.in @@ -293,7 +293,7 @@ all: ${SUBDIR} .PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 FRC -removenullpaths=sed -e 's/^://g' -e 's/:$$//g' -e 's/::/:/g' +removenullpaths=sed -e 's/^:*//' -e 's/:*$$//g' -e 's/::*/:/g' # Generate epaths.h from epaths.in. This target is invoked by `configure'. # See comments in configure.ac for why it is done this way, as opposed diff --git a/admin/ChangeLog b/admin/ChangeLog index 592a41968db..cbcd698e8b1 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,21 @@ +2013-07-12 Glenn Morris <rgm@gnu.org> + + * admin.el (manual-style-string): Use non-abbreviated url. + +2013-07-09 Paul Eggert <eggert@cs.ucla.edu> + + Port recent close-on-exec changes to Cygwin (Bug#14821). + * merge-gnulib (GNULIB_TOOL_FLAGS): Don't avoid binary-io. + + Handle error numbers a bit more reliably. + * merge-gnulib (GNULIB_MODULES): Remove ignore-value. + +2013-07-07 Paul Eggert <eggert@cs.ucla.edu> + + Make file descriptors close-on-exec when possible (Bug#14803). + * merge-gnulib (GNULIB_MODULES): Add fcntl, pipe2. + (GNULIB_TOOL_FLAGS): Avoid binary-io, close. Do not avoid fcntl. + 2013-07-06 Glenn Morris <rgm@gnu.org> * admin.el (manual-misc-manuals): New function. diff --git a/admin/admin.el b/admin/admin.el index 927f68e978a..9c0015fc413 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -283,7 +283,7 @@ Optional argument TYPE is type of output (nil means all)." <meta name=\"DC.title\" content=\"gnu.org\">\n\n") (defconst manual-style-string "<style type=\"text/css\"> -@import url('/s/emacs/manual.css');\n</style>\n") +@import url('/software/emacs/manual.css');\n</style>\n") (defun manual-misc-html (name root html-node-dir html-mono-dir) ;; Hack to deal with the cases where .texi creates a different .info. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index c8bfe0dacc3..82e0cd77fca 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -29,11 +29,11 @@ GNULIB_MODULES=' 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 fdatasync fdopendir filemode fstatat fsync + fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday - ignore-value intprops largefile lstat + intprops largefile lstat manywarnings memrchr mktime - pselect pthread_sigmask putenv qacl readlink readlinkat + pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens @@ -41,8 +41,8 @@ GNULIB_MODULES=' ' GNULIB_TOOL_FLAGS=' - --avoid=dup - --avoid=fchdir --avoid=fcntl --avoid=fstat + --avoid=close --avoid=dup + --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise diff --git a/admin/notes/changelogs b/admin/notes/changelogs index ae9ce40aa0a..1025cfc217f 100644 --- a/admin/notes/changelogs +++ b/admin/notes/changelogs @@ -3,9 +3,10 @@ entry in their name, not yours. http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg00793.html -http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00485.html - There is no need to make trivial change log entries for files such - as NEWS, MAINTAINERS, and FOR-RELEASE. + There is no need to make change log entries for files such as NEWS, + MAINTAINERS, and FOR-RELEASE. +"There is no need" means you don't have to, but you can if you want to. + http://lists.gnu.org/archive/html/emacs-devel/2006-12/msg01135.html There is no need to indicate regeneration of files such as configure diff --git a/autogen/Makefile.in b/autogen/Makefile.in index 99805dd1fe8..d471a9eeb18 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -59,7 +59,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=dup --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --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 fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings memrchr mktime pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv 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=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --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 fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -192,19 +192,20 @@ DIST_COMMON = $(srcdir)/../nt/gnulib.mk $(srcdir)/Makefile.am \ @BUILDING_FOR_WINDOWSNT_FALSE@ ftoastr.h dup2.c errno.in.h \ @BUILDING_FOR_WINDOWSNT_FALSE@ euidaccess.c execinfo.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ execinfo.in.h at-func.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ faccessat.c fcntl.in.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ faccessat.c fcntl.c fcntl.in.h \ @BUILDING_FOR_WINDOWSNT_FALSE@ fdatasync.c fdopendir.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ filemode.h fpending.c fpending.h \ @BUILDING_FOR_WINDOWSNT_FALSE@ at-func.c fstatat.c fsync.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ getgroups.c getloadavg.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ getopt.c getopt.in.h getopt1.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ getdtablesize.c getgroups.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ getloadavg.c getopt.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ getopt.in.h getopt1.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ getopt_int.h gettimeofday.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ group-member.c ignore-value.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ intprops.h inttypes.in.h lstat.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ memrchr.c mktime-internal.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ mktime.c openat.h pathmax.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ pselect.c pthread_sigmask.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ putenv.c acl-internal.h acl.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ group-member.c intprops.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ inttypes.in.h lstat.c memrchr.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ mktime-internal.h mktime.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ openat.h pathmax.h pselect.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ pthread_sigmask.c putenv.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ acl-internal.h acl.h \ @BUILDING_FOR_WINDOWSNT_FALSE@ acl_entries.c readlink.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ at-func.c readlinkat.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ root-uid.h sig2str.c sig2str.h \ @@ -239,10 +240,11 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/errno_h.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/fdatasync.m4 $(top_srcdir)/m4/fdopendir.m4 \ - $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/fpending.m4 \ - $(top_srcdir)/m4/fstatat.m4 $(top_srcdir)/m4/fsync.m4 \ + $(top_srcdir)/m4/faccessat.m4 $(top_srcdir)/m4/fcntl.m4 \ + $(top_srcdir)/m4/fcntl_h.m4 $(top_srcdir)/m4/fdatasync.m4 \ + $(top_srcdir)/m4/fdopendir.m4 $(top_srcdir)/m4/filemode.m4 \ + $(top_srcdir)/m4/fpending.m4 $(top_srcdir)/m4/fstatat.m4 \ + $(top_srcdir)/m4/fsync.m4 $(top_srcdir)/m4/getdtablesize.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 \ @@ -255,7 +257,8 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/memrchr.m4 \ $(top_srcdir)/m4/mktime.m4 $(top_srcdir)/m4/multiarch.m4 \ $(top_srcdir)/m4/nocrash.m4 $(top_srcdir)/m4/off_t.m4 \ - $(top_srcdir)/m4/pathmax.m4 $(top_srcdir)/m4/pselect.m4 \ + $(top_srcdir)/m4/pathmax.m4 $(top_srcdir)/m4/pipe2.m4 \ + $(top_srcdir)/m4/pselect.m4 \ $(top_srcdir)/m4/pthread_sigmask.m4 $(top_srcdir)/m4/putenv.m4 \ $(top_srcdir)/m4/readlink.m4 $(top_srcdir)/m4/readlinkat.m4 \ $(top_srcdir)/m4/setenv.m4 $(top_srcdir)/m4/sha1.m4 \ @@ -288,16 +291,18 @@ CONFIG_CLEAN_VPATH_FILES = LIBRARIES = $(noinst_LIBRARIES) libgnu_a_AR = $(AR) $(ARFLAGS) am__DEPENDENCIES_1 = -am__libgnu_a_SOURCES_DIST = allocator.c c-ctype.h c-ctype.c \ - c-strcase.h c-strcasecmp.c c-strncasecmp.c careadlinkat.c \ - close-stream.c md5.c sha1.c sha256.c sha512.c dtoastr.c \ - dtotimespec.c filemode.c gettext.h gettime.c acl-errno-valid.c \ - file-has-acl.c qcopy-acl.c qset-acl.c stat-time.c strftime.c \ - timespec.c timespec-add.c timespec-sub.c u64.c unistd.c \ - utimens.c openat-die.c save-cwd.c +am__libgnu_a_SOURCES_DIST = allocator.c binary-io.h binary-io.c \ + c-ctype.h c-ctype.c c-strcase.h c-strcasecmp.c c-strncasecmp.c \ + careadlinkat.c close-stream.c md5.c sha1.c sha256.c sha512.c \ + dtoastr.c dtotimespec.c filemode.c gettext.h gettime.c pipe2.c \ + acl-errno-valid.c file-has-acl.c qcopy-acl.c qset-acl.c \ + stat-time.c strftime.c timespec.c timespec-add.c \ + timespec-sub.c u64.c unistd.c utimens.c openat-die.c \ + save-cwd.c am__objects_1 = @BUILDING_FOR_WINDOWSNT_FALSE@am_libgnu_a_OBJECTS = \ @BUILDING_FOR_WINDOWSNT_FALSE@ allocator.$(OBJEXT) \ +@BUILDING_FOR_WINDOWSNT_FALSE@ binary-io.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ c-ctype.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ c-strcasecmp.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ c-strncasecmp.$(OBJEXT) \ @@ -311,6 +316,7 @@ am__objects_1 = @BUILDING_FOR_WINDOWSNT_FALSE@ filemode.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ $(am__objects_1) \ @BUILDING_FOR_WINDOWSNT_FALSE@ gettime.$(OBJEXT) \ +@BUILDING_FOR_WINDOWSNT_FALSE@ pipe2.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ acl-errno-valid.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ file-has-acl.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ qcopy-acl.$(OBJEXT) \ @@ -346,13 +352,13 @@ am__objects_1 = @BUILDING_FOR_WINDOWSNT_TRUE@ u64.$(OBJEXT) utimens.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_TRUE@ $(am__objects_1) am__EXTRA_libgnu_a_SOURCES_DIST = openat-proc.c ftoastr.c dup2.c \ - euidaccess.c execinfo.c at-func.c faccessat.c fdatasync.c \ - fdopendir.c fpending.c fstatat.c fsync.c getgroups.c \ - getloadavg.c getopt.c getopt1.c gettimeofday.c group-member.c \ - lstat.c memrchr.c mktime.c pselect.c pthread_sigmask.c \ - putenv.c acl_entries.c readlink.c readlinkat.c sig2str.c \ - stat.c strtoimax.c strtol.c strtoll.c strtoul.c strtoull.c \ - strtoumax.c symlink.c time_r.c unsetenv.c + euidaccess.c execinfo.c at-func.c faccessat.c fcntl.c \ + fdatasync.c fdopendir.c fpending.c fstatat.c fsync.c \ + getdtablesize.c getgroups.c getloadavg.c getopt.c getopt1.c \ + gettimeofday.c group-member.c lstat.c memrchr.c mktime.c \ + pselect.c pthread_sigmask.c putenv.c acl_entries.c readlink.c \ + readlinkat.c sig2str.c stat.c strtoimax.c strtol.c strtoll.c \ + strtoul.c strtoull.c strtoumax.c symlink.c time_r.c unsetenv.c libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS) depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp am__depfiles_maybe = depfiles @@ -1230,20 +1236,22 @@ noinst_LIBRARIES = $(am__append_2) $(am__append_7) SUFFIXES = AM_CFLAGS = $(PROFILING_CFLAGS) $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS) DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src -@BUILDING_FOR_WINDOWSNT_FALSE@libgnu_a_SOURCES = allocator.c c-ctype.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ c-ctype.c c-strcase.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@libgnu_a_SOURCES = allocator.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ binary-io.h binary-io.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ c-ctype.h c-ctype.c c-strcase.h \ @BUILDING_FOR_WINDOWSNT_FALSE@ c-strcasecmp.c c-strncasecmp.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ careadlinkat.c close-stream.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ md5.c sha1.c sha256.c sha512.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ dtoastr.c dtotimespec.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ filemode.c $(am__append_10) \ -@BUILDING_FOR_WINDOWSNT_FALSE@ gettime.c acl-errno-valid.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ file-has-acl.c qcopy-acl.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ qset-acl.c stat-time.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ strftime.c timespec.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ timespec-add.c timespec-sub.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ u64.c unistd.c utimens.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ openat-die.c save-cwd.c +@BUILDING_FOR_WINDOWSNT_FALSE@ gettime.c pipe2.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ acl-errno-valid.c file-has-acl.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ qcopy-acl.c qset-acl.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ stat-time.c strftime.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ timespec.c timespec-add.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ timespec-sub.c u64.c unistd.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ utimens.c openat-die.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ save-cwd.c @BUILDING_FOR_WINDOWSNT_TRUE@libgnu_a_SOURCES = c-ctype.h c-ctype.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ c-strcase.h c-strcasecmp.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ c-strncasecmp.c close-stream.c \ @@ -1262,9 +1270,10 @@ DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src @BUILDING_FOR_WINDOWSNT_FALSE@EXTRA_libgnu_a_SOURCES = openat-proc.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ ftoastr.c dup2.c euidaccess.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ execinfo.c at-func.c faccessat.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ fdatasync.c fdopendir.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ fcntl.c fdatasync.c fdopendir.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ fpending.c at-func.c fstatat.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ fsync.c getgroups.c getloadavg.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ fsync.c getdtablesize.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ getgroups.c getloadavg.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ getopt.c getopt1.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ gettimeofday.c group-member.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ lstat.c memrchr.c mktime.c \ @@ -1361,6 +1370,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/acl_entries.Po@am__quote@ @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)/binary-io.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@ @@ -1372,6 +1382,7 @@ distclean-compile: @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)/fcntl.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fdatasync.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fdopendir.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/file-has-acl.Po@am__quote@ @@ -1380,6 +1391,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fstatat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fsync.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getdtablesize.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@ @@ -1393,6 +1405,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/openat-die.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/openat-proc.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pipe2.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pselect.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pthread_sigmask.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/putenv.Po@am__quote@ diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 index eb324b06b37..c9e796a081f 100644 --- a/autogen/aclocal.m4 +++ b/autogen/aclocal.m4 @@ -999,6 +999,7 @@ 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.m4]) m4_include([m4/fcntl_h.m4]) m4_include([m4/fdatasync.m4]) m4_include([m4/fdopendir.m4]) @@ -1006,6 +1007,7 @@ m4_include([m4/filemode.m4]) m4_include([m4/fpending.m4]) m4_include([m4/fstatat.m4]) m4_include([m4/fsync.m4]) +m4_include([m4/getdtablesize.m4]) m4_include([m4/getgroups.m4]) m4_include([m4/getloadavg.m4]) m4_include([m4/getopt.m4]) @@ -1027,6 +1029,7 @@ m4_include([m4/multiarch.m4]) m4_include([m4/nocrash.m4]) m4_include([m4/off_t.m4]) m4_include([m4/pathmax.m4]) +m4_include([m4/pipe2.m4]) m4_include([m4/pselect.m4]) m4_include([m4/pthread_sigmask.m4]) m4_include([m4/putenv.m4]) diff --git a/autogen/config.in b/autogen/config.in index 89ad415f3b0..3fe82ce0f92 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -120,6 +120,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ enabled. */ #undef ENABLE_CHECKING +/* Define this to 1 if F_DUPFD behavior does not match POSIX */ +#undef FCNTL_DUPFD_BUGGY + /* Letter to use in finding device name of first PTY, if PTYs are supported. */ #undef FIRST_PTY_LETTER @@ -206,6 +209,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ startup, if using GTK. */ #undef G_SLICE_ALWAYS_MALLOC +/* Define to 1 if you have the `accept4' function. */ +#undef HAVE_ACCEPT4 + /* Define to 1 if you have the `access' function. */ #undef HAVE_ACCESS @@ -439,6 +445,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the `facl' function. */ #undef HAVE_FACL +/* Define to 1 if you have the `fcntl' function. */ +#undef HAVE_FCNTL + /* Define to 1 if you have the `fdatasync' function. */ #undef HAVE_FDATASYNC @@ -487,6 +496,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the `getdelim' function. */ #undef HAVE_GETDELIM +/* Define to 1 if you have the `getdtablesize' function. */ +#undef HAVE_GETDTABLESIZE + /* Define to 1 if you have the `getgrent' function. */ #undef HAVE_GETGRENT @@ -738,6 +750,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ systems that support xmenu.c. */ #undef HAVE_MENUS +/* Define to 1 if you have the `mkostemp' function. */ +#undef HAVE_MKOSTEMP + /* Define to 1 if you have the `mkstemp' function. */ #undef HAVE_MKSTEMP @@ -769,6 +784,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if personality LINUX32 can be set. */ #undef HAVE_PERSONALITY_LINUX32 +/* Define to 1 if you have the `pipe2' function. */ +#undef HAVE_PIPE2 + /* Define to 1 if you have the png library (-lpng). */ #undef HAVE_PNG diff --git a/autogen/configure b/autogen/configure index 463c5905a12..faa09d0e9c3 100755 --- a/autogen/configure +++ b/autogen/configure @@ -614,8 +614,6 @@ LIBGNU_LIBDEPS gltests_WITNESS gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE -gl_GNULIB_ENABLED_verify_FALSE -gl_GNULIB_ENABLED_verify_TRUE gl_GNULIB_ENABLED_strtoull_FALSE gl_GNULIB_ENABLED_strtoull_TRUE gl_GNULIB_ENABLED_strtoll_FALSE @@ -634,6 +632,8 @@ gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE gl_GNULIB_ENABLED_getgroups_FALSE gl_GNULIB_ENABLED_getgroups_TRUE +gl_GNULIB_ENABLED_getdtablesize_FALSE +gl_GNULIB_ENABLED_getdtablesize_TRUE gl_GNULIB_ENABLED_euidaccess_FALSE gl_GNULIB_ENABLED_euidaccess_TRUE gl_GNULIB_ENABLED_dosname_FALSE @@ -3373,6 +3373,7 @@ as_fn_append ac_func_list " readlinkat" as_fn_append ac_header_list " dirent.h" as_fn_append ac_header_list " execinfo.h" as_fn_append ac_func_list " faccessat" +as_fn_append ac_func_list " fcntl" as_fn_append ac_func_list " fdopendir" as_fn_append ac_header_list " stdio_ext.h" as_fn_append ac_func_list " __fpending" @@ -3387,6 +3388,7 @@ as_fn_append ac_header_list " wchar.h" as_fn_append ac_header_list " stdint.h" as_fn_append ac_header_list " inttypes.h" as_fn_append ac_func_list " lstat" +as_fn_append ac_func_list " pipe2" as_fn_append ac_header_list " sys/select.h" as_fn_append ac_func_list " pselect" as_fn_append ac_func_list " pthread_sigmask" @@ -3402,6 +3404,7 @@ as_fn_append ac_func_list " futimesat" as_fn_append ac_func_list " futimens" as_fn_append ac_func_list " utimensat" as_fn_append ac_func_list " lutimes" +as_fn_append ac_func_list " getdtablesize" # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false @@ -7225,6 +7228,7 @@ esac # Code from module alloca-opt: # Code from module allocator: # Code from module at-internal: + # Code from module binary-io: # Code from module c-ctype: # Code from module c-strcase: # Code from module careadlinkat: @@ -7247,6 +7251,7 @@ esac # Code from module extern-inline: # Code from module faccessat: + # Code from module fcntl: # Code from module fcntl-h: # Code from module fdatasync: # Code from module fdopendir: @@ -7254,6 +7259,7 @@ esac # Code from module fpending: # Code from module fstatat: # Code from module fsync: + # Code from module getdtablesize: # Code from module getgroups: # Code from module getloadavg: # Code from module getopt-gnu: @@ -7262,7 +7268,6 @@ esac # Code from module gettime: # Code from module gettimeofday: # Code from module group-member: - # Code from module ignore-value: # Code from module include_next: # Code from module intprops: # Code from module inttypes-incomplete: @@ -7276,6 +7281,7 @@ esac # Code from module nocrash: # Code from module openat-h: # Code from module pathmax: + # Code from module pipe2: # Code from module pselect: # Code from module pthread_sigmask: # Code from module putenv: @@ -10079,8 +10085,8 @@ $as_echo_n "checking whether Windows API headers are recent enough... " >&6; } int main () { -void test(PIMAGE_NT_HEADERS pHeader) - {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);} +PIMAGE_NT_HEADERS pHeader; + PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader) ; return 0; } @@ -11177,7 +11183,7 @@ $as_echo "#define HAVE_RSVG 1" >>confdefs.h fi HAVE_IMAGEMAGICK=no -if test "${HAVE_X11}" = "yes"; then +if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then if test "${with_imagemagick}" != "no"; then ## 6.2.8 is the earliest version known to work, but earlier versions ## might work - let us know if you find one. @@ -14655,14 +14661,14 @@ esac -for ac_func in gethostname \ +for ac_func in accept4 gethostname \ getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ getrlimit setrlimit shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ -gai_strerror mkstemp getline getdelim sync \ +gai_strerror mkostemp mkstemp getline getdelim sync \ difftime posix_memalign \ getpwent endpwent getgrent endgrent \ touchlock \ @@ -16430,10 +16436,10 @@ $as_echo "#define UNIX98_PTYS 1" >>confdefs.h $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h if test "x$ac_cv_func_posix_openpt" = xyes; then - $as_echo "#define PTY_OPEN fd = posix_openpt (O_RDWR | O_NOCTTY)" >>confdefs.h + $as_echo "#define PTY_OPEN fd = posix_openpt (O_RDWR | O_CLOEXEC | O_NOCTTY)" >>confdefs.h $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h @@ -18402,6 +18408,8 @@ $as_echo "$gl_cv_header_errno_h_EOVERFLOW" >&6; } REPLACE_OPENAT=0; + + ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" if test "x$ac_cv_type_mode_t" = x""yes; then : @@ -20692,6 +20700,8 @@ cat >>confdefs.h <<_ACEOF _ACEOF + + GNULIB_PSELECT=0; GNULIB_SELECT=0; HAVE_PSELECT=1; @@ -21891,6 +21901,8 @@ _ACEOF + + if false; then GL_COND_LIBTOOL_TRUE= GL_COND_LIBTOOL_FALSE='#' @@ -22441,6 +22453,169 @@ _ACEOF + if test $ac_cv_func_fcntl = no; then + + + + if test $ac_cv_func_fcntl = no; then + HAVE_FCNTL=0 + else + REPLACE_FCNTL=1 + fi + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether fcntl handles F_DUPFD correctly" >&5 +$as_echo_n "checking whether fcntl handles F_DUPFD correctly... " >&6; } +if test "${gl_cv_func_fcntl_f_dupfd_works+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + # Guess that it works on glibc systems + case $host_os in #(( + *-gnu*) gl_cv_func_fcntl_f_dupfd_works="guessing yes";; + *) gl_cv_func_fcntl_f_dupfd_works="guessing no";; + esac +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <fcntl.h> +#include <errno.h> + +int +main () +{ +int result = 0; + if (fcntl (0, F_DUPFD, -1) != -1) result |= 1; + if (errno != EINVAL) result |= 2; + return result; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gl_cv_func_fcntl_f_dupfd_works=yes +else + gl_cv_func_fcntl_f_dupfd_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_fcntl_f_dupfd_works" >&5 +$as_echo "$gl_cv_func_fcntl_f_dupfd_works" >&6; } + case $gl_cv_func_fcntl_f_dupfd_works in + *yes) ;; + *) + + + if test $ac_cv_func_fcntl = no; then + HAVE_FCNTL=0 + else + REPLACE_FCNTL=1 + fi + + +$as_echo "#define FCNTL_DUPFD_BUGGY 1" >>confdefs.h + ;; + esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether fcntl understands F_DUPFD_CLOEXEC" >&5 +$as_echo_n "checking whether fcntl understands F_DUPFD_CLOEXEC... " >&6; } +if test "${gl_cv_func_fcntl_f_dupfd_cloexec+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <fcntl.h> +#ifndef F_DUPFD_CLOEXEC +choke me +#endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef __linux__ +/* The Linux kernel only added F_DUPFD_CLOEXEC in 2.6.24, so we always replace + it to support the semantics on older kernels that failed with EINVAL. */ +choke me +#endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_func_fcntl_f_dupfd_cloexec=yes +else + gl_cv_func_fcntl_f_dupfd_cloexec="needs runtime check" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + gl_cv_func_fcntl_f_dupfd_cloexec=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_fcntl_f_dupfd_cloexec" >&5 +$as_echo "$gl_cv_func_fcntl_f_dupfd_cloexec" >&6; } + if test "$gl_cv_func_fcntl_f_dupfd_cloexec" != yes; then + + + + if test $ac_cv_func_fcntl = no; then + HAVE_FCNTL=0 + else + REPLACE_FCNTL=1 + fi + + fi + fi + + + if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS fcntl.$ac_objext" + + fi + + + + + + GNULIB_FCNTL=1 + + + + + + + + + + @@ -24150,6 +24325,27 @@ $as_echo "$gl_cv_func_working_mktime" >&6; } + + if test $ac_cv_func_pipe2 != yes; then + HAVE_PIPE2=0 + fi + + + + + + + GNULIB_PIPE2=1 + + + + + + + + + + if test $ac_cv_func_pselect = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether signature of pselect conforms to POSIX" >&5 $as_echo_n "checking whether signature of pselect conforms to POSIX... " >&6; } @@ -25637,7 +25833,8 @@ else /* Test _Alignas only on platforms where gnulib can help. */ #if \ - (__GNUC__ || __IBMC__ || __IBMCPP__ \ + ((defined __cplusplus && 201103 <= __cplusplus) \ + || __GNUC__ || __IBMC__ || __IBMCPP__ || __ICC \ || 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER) struct alignas_test { char c; char alignas (8) alignas_8; }; char test_alignas[offsetof (struct alignas_test, alignas_8) == 8 @@ -27260,6 +27457,7 @@ $as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false gl_gnulib_enabled_dosname=false gl_gnulib_enabled_euidaccess=false + gl_gnulib_enabled_getdtablesize=false gl_gnulib_enabled_getgroups=false gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false @@ -27269,7 +27467,6 @@ $as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h 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_260941c0e5dc67ec9e87d1fb321c300b () { @@ -27549,6 +27746,43 @@ done fi fi } + func_gl_gnulib_m4code_getdtablesize () + { + if ! $gl_gnulib_enabled_getdtablesize; then + + + + if test $ac_cv_func_getdtablesize != yes; then + HAVE_GETDTABLESIZE=0 + fi + + if test $HAVE_GETDTABLESIZE = 0; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS getdtablesize.$ac_objext" + + : + fi + + + + + + GNULIB_GETDTABLESIZE=1 + + + + + + gl_gnulib_enabled_getdtablesize=true + fi + } func_gl_gnulib_m4code_getgroups () { if ! $gl_gnulib_enabled_getgroups; then @@ -27971,9 +28205,6 @@ $as_echo "#define REPLACE_FUNC_STAT_FILE 1" >>confdefs.h if test $REPLACE_STAT = 1; then func_gl_gnulib_m4code_pathmax fi - if test $REPLACE_STAT = 1; then - func_gl_gnulib_m4code_verify - fi fi } func_gl_gnulib_m4code_strtoll () @@ -28080,12 +28311,6 @@ done gl_gnulib_enabled_strtoull=true fi } - func_gl_gnulib_m4code_verify () - { - if ! $gl_gnulib_enabled_verify; then - gl_gnulib_enabled_verify=true - fi - } func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec () { if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then @@ -28104,6 +28329,9 @@ done if test $HAVE_FACCESSAT = 0; then func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 fi + if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then + func_gl_gnulib_m4code_getdtablesize + fi if test $HAVE_FDOPENDIR = 0; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi @@ -28140,15 +28368,9 @@ done if { test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then func_gl_gnulib_m4code_strtoll fi - if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then - func_gl_gnulib_m4code_verify - fi if test $ac_cv_func_strtoumax = no && test $ac_cv_type_unsigned_long_long_int = yes; then func_gl_gnulib_m4code_strtoull fi - if test $ac_cv_func_strtoumax = no; then - func_gl_gnulib_m4code_verify - fi if $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_TRUE= @@ -28174,6 +28396,14 @@ else gl_GNULIB_ENABLED_euidaccess_FALSE= fi + if $gl_gnulib_enabled_getdtablesize; then + gl_GNULIB_ENABLED_getdtablesize_TRUE= + gl_GNULIB_ENABLED_getdtablesize_FALSE='#' +else + gl_GNULIB_ENABLED_getdtablesize_TRUE='#' + gl_GNULIB_ENABLED_getdtablesize_FALSE= +fi + if $gl_gnulib_enabled_getgroups; then gl_GNULIB_ENABLED_getgroups_TRUE= gl_GNULIB_ENABLED_getgroups_FALSE='#' @@ -28246,14 +28476,6 @@ else gl_GNULIB_ENABLED_strtoull_FALSE= fi - if $gl_gnulib_enabled_verify; then - gl_GNULIB_ENABLED_verify_TRUE= - gl_GNULIB_ENABLED_verify_FALSE='#' -else - gl_GNULIB_ENABLED_verify_TRUE='#' - gl_GNULIB_ENABLED_verify_FALSE= -fi - if $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE= gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE='#' @@ -28715,6 +28937,10 @@ if test -z "${gl_GNULIB_ENABLED_euidaccess_TRUE}" && test -z "${gl_GNULIB_ENABLE 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_getdtablesize_TRUE}" && test -z "${gl_GNULIB_ENABLED_getdtablesize_FALSE}"; then + as_fn_error "conditional \"gl_GNULIB_ENABLED_getdtablesize\" 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 @@ -28751,10 +28977,6 @@ if test -z "${gl_GNULIB_ENABLED_strtoull_TRUE}" && test -z "${gl_GNULIB_ENABLED_ as_fn_error "conditional \"gl_GNULIB_ENABLED_strtoull\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 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 diff --git a/configure.ac b/configure.ac index 90f9f3a4799..73dcdb06bee 100644 --- a/configure.ac +++ b/configure.ac @@ -211,7 +211,8 @@ AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], w | w3 | w32 ) val=w32 ;; * ) AC_MSG_ERROR([`--with-file-notification=$withval' is invalid; this option's value should be `yes', `no', `gfile', `inotify' or `w32'. -`yes' is a synonym for `w32' on MS-Windows, and for `gfile' otherwise.]) +`yes' is a synonym for `w32' on MS-Windows, for `no' on Nextstep, +otherwise for the first of `gfile' or `inotify' that is usable.]) ;; esac with_file_notification=$val @@ -1635,8 +1636,8 @@ if test "${opsys}" = "mingw32"; then AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <windows.h> #include <usp10.h>]], - [[void test(PIMAGE_NT_HEADERS pHeader) - {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);}]])], + [[PIMAGE_NT_HEADERS pHeader; + PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader)]])], [emacs_cv_w32api=yes HAVE_W32=yes], emacs_cv_w32api=no) @@ -2041,7 +2042,7 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${opsys}" = fi HAVE_IMAGEMAGICK=no -if test "${HAVE_X11}" = "yes"; then +if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then if test "${with_imagemagick}" != "no"; then ## 6.2.8 is the earliest version known to work, but earlier versions ## might work - let us know if you find one. @@ -2312,51 +2313,57 @@ AC_SUBST(LIBGNUTLS_CFLAGS) NOTIFY_OBJ= NOTIFY_SUMMARY=no -dnl Set defaults of $with_file_notification. -if test "${with_file_notification}" = "yes"; then - if test "${opsys}" = "mingw32"; then - with_file_notification=w32 - else - if test "${with_ns}" != yes; then - with_file_notification=gfile - fi - fi +dnl FIXME? Don't auto-detect on NS, but do allow someone to specify +dnl a particular library. This doesn't make much sense? +if test "${with_ns}" = yes && test ${with_file_notification} = yes; then + with_file_notification=no fi +dnl MS Windows native file monitor is available for mingw32 only. +case $with_file_notification,$opsys in + w32,* | yes,mingw32) + AC_CHECK_HEADER(windows.h) + if test "$ac_cv_header_windows_h" = yes ; then + AC_DEFINE(HAVE_W32NOTIFY, 1, [Define to 1 to use w32notify.]) + NOTIFY_OBJ=w32notify.o + NOTIFY_SUMMARY="yes (w32)" + fi ;; +esac + dnl g_file_monitor exists since glib 2.18. G_FILE_MONITOR_EVENT_MOVED dnl has been added in glib 2.24. It has been tested under dnl GNU/Linux only. We take precedence over inotify, but this makes dnl only sense when glib has been compiled with inotify support. How dnl to check? -if test "${with_file_notification}" = "gfile"; then - PKG_CHECK_MODULES(GFILENOTIFY, gio-2.0 >= 2.24, HAVE_GFILENOTIFY=yes, HAVE_GFILENOTIFY=no) - if test "$HAVE_GFILENOTIFY" = "yes"; then - AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) - NOTIFY_OBJ=gfilenotify.o - NOTIFY_SUMMARY="yes -lgio (gfile)" - fi -fi +case $with_file_notification,$NOTIFY_OBJ in + gfile, | yes,) + PKG_CHECK_MODULES(GFILENOTIFY, gio-2.0 >= 2.24, HAVE_GFILENOTIFY=yes, HAVE_GFILENOTIFY=no) + if test "$HAVE_GFILENOTIFY" = "yes"; then + AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) + NOTIFY_OBJ=gfilenotify.o + NOTIFY_SUMMARY="yes -lgio (gfile)" + fi ;; +esac + dnl inotify is only available on GNU/Linux. -if test "${with_file_notification}" = "inotify"; then - AC_CHECK_HEADER(sys/inotify.h) - if test "$ac_cv_header_sys_inotify_h" = yes ; then - AC_CHECK_FUNC(inotify_init1) - if test "$ac_cv_func_inotify_init1" = yes; then - AC_DEFINE(HAVE_INOTIFY, 1, [Define to 1 to use inotify.]) - NOTIFY_OBJ=inotify.o - NOTIFY_SUMMARY="yes -lglibc (inotify)" - fi - fi -fi -dnl MS Windows native file monitor is available for mingw32 only. -if test "${with_file_notification}" = "w32"; then - AC_CHECK_HEADER(windows.h) - if test "$ac_cv_header_windows_h" = yes ; then - AC_DEFINE(HAVE_W32NOTIFY, 1, [Define to 1 to use w32notify.]) - NOTIFY_OBJ=w32notify.o - NOTIFY_SUMMARY="yes (w32)" - fi -fi +case $with_file_notification,$NOTIFY_OBJ in + inotify, | yes,) + AC_CHECK_HEADER(sys/inotify.h) + if test "$ac_cv_header_sys_inotify_h" = yes ; then + AC_CHECK_FUNC(inotify_init1) + if test "$ac_cv_func_inotify_init1" = yes; then + AC_DEFINE(HAVE_INOTIFY, 1, [Define to 1 to use inotify.]) + NOTIFY_OBJ=inotify.o + NOTIFY_SUMMARY="yes -lglibc (inotify)" + fi + fi ;; +esac + +case $with_file_notification,$NOTIFY_OBJ in + yes,* | no,* | *,?*) ;; + *) AC_MSG_ERROR([File notification `$with_file_notification' requested but requirements not found.]) ;; +esac + if test -n "$NOTIFY_OBJ"; then AC_DEFINE(USE_FILE_NOTIFY, 1, [Define to 1 if using file notifications.]) fi @@ -3237,14 +3244,14 @@ esac AC_SUBST(BLESSMAIL_TARGET) -AC_CHECK_FUNCS(gethostname \ +AC_CHECK_FUNCS(accept4 gethostname \ getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ getrlimit setrlimit shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ -gai_strerror mkstemp getline getdelim sync \ +gai_strerror mkostemp mkstemp getline getdelim sync \ difftime posix_memalign \ getpwent endpwent getgrent endgrent \ touchlock \ @@ -3931,10 +3938,10 @@ case $opsys in AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)]) dnl Note that grantpt and unlockpt may fork. We must block SIGCHLD dnl to prevent sigchld_handler from intercepting the child's death. - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) dnl if HAVE_POSIX_OPENPT if test "x$ac_cv_func_posix_openpt" = xyes; then - AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_NOCTTY)]) + AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_CLOEXEC | O_NOCTTY)]) AC_DEFINE(PTY_NAME_SPRINTF, []) dnl if HAVE_GETPT elif test "x$ac_cv_func_getpt" = xyes; then diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index e4bc6eb5bcc..f8b7406c427 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + Timestamp fixes for undo (Bug#14824). + * text.texi (Undo): Document (t . 0) and (t . -1) in buffer-undo-list. + 2013-07-06 Eli Zaretskii <eliz@gnu.org> * nonascii.texi (Text Representations): Document that diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index c10458b39ae..7cace70ad07 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1250,14 +1250,18 @@ reinsert it is @code{(abs @var{position})}. If @var{position} is positive, point was at the beginning of the deleted text, otherwise it was at the end. -@item (t @var{sec-high} @var{sec-low} @var{microsec} @var{picosec}) +@item (t . @var{time-flag}) This kind of element indicates that an unmodified buffer became -modified. The list @code{(@var{sec-high} @var{sec-low} @var{microsec} +modified. A @var{time-flag} of the form +@code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})} represents the visited file's modification time as of when it was previously visited or saved, using the same format as -@code{current-time}; see @ref{Time of Day}. @code{primitive-undo} uses those +@code{current-time}; see @ref{Time of Day}. +A @var{time-flag} of 0 means the buffer does not correspond to any file; +@minus{}1 means the visited file previously did not exist. +@code{primitive-undo} uses these values to determine whether to mark the buffer as unmodified once again; -it does so only if the file's modification time matches those numbers. +it does so only if the file's status matches that of @var{time-flag}. @item (nil @var{property} @var{value} @var{beg} . @var{end}) This kind of element records a change in a text property. diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index e4a66e19877..2fe1914f926 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,24 @@ +2013-07-08 Tassilo Horn <tsdh@gnu.org> + + * gnus.texi (lines): Correct description of + `gnus-registry-track-extra's default value. Mention + `gnus-registry-remove-extra-data'. + +2013-07-06 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Group Parameters): Mention regexp + substitutions (bug#11688). + +2013-07-06 Nathan Trapuzzano <nbtrap@nbtrap.com> (tiny change) + + * gnus.texi (Generic Marking Commands): Fix grammar (bug#13368). + +2013-07-06 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Emacsen): Fix version. + + * gnus-faq.texi (FAQ 1-6): Mention the correct Emacs version. + 2013-07-06 Glenn Morris <rgm@gnu.org> * mh-e.texi: Fix external links. diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index ff29647d166..1a0469c14f4 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -222,10 +222,9 @@ Which version of Emacs do I need? @subsubheading Answer -Gnus 5.10 requires an Emacs version that is greater than or equal -to Emacs 20.7 or XEmacs 21.1. -The development versions of Gnus (aka No Gnus) requires Emacs 21 -or XEmacs 21.4. +Gnus 5.13 requires an Emacs version that is greater than or equal +to Emacs 23.1 or XEmacs 21.1, although there are some features that +only work on Emacs 24. @node FAQ 1-7 @subsubheading Question 1.7 diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 3d4bd378869..e5ba2c19eec 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -3091,6 +3091,12 @@ if address "sender" ["name@@one.org", "else@@two.org"] @{ @} @end example +You can also use regexp expansions in the rules: + +@example +(sieve header :regex "list-id" "<c++std-\\1.accu.org>") +@end example + See @pxref{Sieve Commands} for commands and variables that might be of interest in relation to the sieve parameter. @@ -6380,10 +6386,10 @@ The default is @code{t}. @node Generic Marking Commands @subsection Generic Marking Commands -Some people would like the command that ticks an article (@kbd{!}) go to -the next article. Others would like it to go to the next unread -article. Yet others would like it to stay on the current article. And -even though I haven't heard of anybody wanting it to go to the +Some people would like the command that ticks an article (@kbd{!}) to +go to the next article. Others would like it to go to the next unread +article. Yet others would like it to stay on the current article. +And even though I haven't heard of anybody wanting it to go to the previous (unread) article, I'm sure there are people that want that as well. @@ -26000,9 +26006,13 @@ following variables. @defvar gnus-registry-track-extra This is a list of symbols, so it's best to change it from the -Customize interface. By default it's @code{(subject sender)}, which -may work for you. It can be annoying if your mail flow is large and -people don't stick to the same groups. +Customize interface. By default it's @code{(subject sender recipient)}, +which may work for you. It can be annoying if your mail flow is large +and people don't stick to the same groups. + +When you decide to stop tracking any of those extra data, you can use +the command @code{gnus-registry-remove-extra-data} to purge it from +the existing registry entries. @end defvar @defvar gnus-registry-split-strategy @@ -26575,7 +26585,7 @@ This version of Gnus should work on: @itemize @bullet @item -Emacs 21.1 and up. +Emacs 23.1 and up. @item XEmacs 21.4 and up. diff --git a/etc/ChangeLog b/etc/ChangeLog index 9dbcc70ee01..73bc76a1ff8 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,12 @@ +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + Timestamp fixes for undo (Bug#14824). + * NEWS: Changes to visited-file-modtime, set-visited-file-modtime. + +2013-07-08 Jan Djärv <jan.h.d@swipnet.se> + + * NEWS: NS can be built with ImageMagick. + 2013-07-06 Juanma Barranquero <lekktu@gmail.com> * NEWS: Document new "generic commands" support. @@ -29,37 +29,22 @@ build time, like libacl on GNU/Linux. To prevent this, use the configure option `--disable-acl'. ** Emacs can be compiled with file notification support. -The configure option `--with-file-notification=LIB' enables file -notification support in Emacs. This option's value should be `yes', -`no', `gfile', `inotify' or `w32'. `yes' is a synonym for `w32' on -MS-Windows, and for `gfile' otherwise. The default value is `yes'. +This happens by default if a suitable system library is found at +build time. To prevent this, use the configure option +`--with-file-notification-no'. See below for file-notify features. +FIXME? This feature is not available for the Nextstep port. (?) ** The configure option --with-crt-dir has been removed. It is no longer needed, as the crt*.o files are no longer linked specially. -** Emacs for MS-Windows can now be built by running the configure script -using the MSYS environment and MinGW development tools. -This is from now on the preferred method of building Emacs on -MS-Windows. The Windows-specific configure.bat and makefile.w32-in -files are deprecated. See the file nt/INSTALL.MSYS for detailed -instructions. - -Using the Posix configure script and Makefile's also means a change in -the directory structure of the Emacs installation on Windows. It is -now the same as on GNU and Unix systems. In particular, the auxiliary -programs, such as cmdproxy.exe and hexl.exe, are in -libexec/emacs/VERSION/i686-pc-mingw32 (where VERSION is the Emacs -version), version-independent site-lisp is in share/emacs/site-lisp, -version-specific Lisp files are in share/emacs/VERSION/lisp and in -share/emacs/VERSION/site-lisp, Info docs are in share/info, and data -files are in share/emacs/VERSION/etc. (Emacs knows about all these -directories and will find the files in there automatically; there's no -need to set any variables due to this change.) - ** Directories passed to configure option `--enable-locallisppath' are no longer created during installation. +--- +** Emacs for NS (OSX, GNUStep) can be built with ImageMagick support. +pkg-config is required to find ImageMagick libraries. + * Startup Changes in Emacs 24.4 @@ -533,9 +518,14 @@ alist of extended attributes as returned by the new function `file-extended-attributes'. The attributes can be applied to another file using `set-file-extended-attributes'. +** `visited-file-modtime' now returns -1 for nonexistent files. +Formerly it returned a list (-1 LOW USEC PSEC), but this was ambiguous +in the presence of files with negative time stamps. * Lisp Changes in Emacs 24.4 +** New hook `tty-setup-hook'. + +++ ** New macro with-eval-after-load. Like eval-after-load, but better behaved. @@ -607,6 +597,9 @@ Emacs uses `image-default-frame-delay'. *** New functions `image-current-frame' and `image-show-frame' for getting and setting the current frame of a multi-frame image. +** The function `set-visited-file-modtime' now accepts a 0 or -1 argument +with the same interpretation as the returned value of `visited-file-modtime'. + ** time-to-seconds is not obsolete any more. ** New function special-form-p. ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' @@ -650,6 +643,25 @@ meant to be used by other packages. * Changes in Emacs 24.4 on Non-Free Operating Systems +** Emacs for MS-Windows can now be built by running the configure script +using the MSYS environment and MinGW development tools. +This is from now on the preferred method of building Emacs on +MS-Windows. The Windows-specific configure.bat and makefile.w32-in +files are deprecated. See the file nt/INSTALL.MSYS for detailed +instructions. + +Using the Posix configure script and Makefile's also means a change in +the directory structure of the Emacs installation on Windows. It is +now the same as on GNU and Unix systems. In particular, the auxiliary +programs, such as cmdproxy.exe and hexl.exe, are in +libexec/emacs/VERSION/i686-pc-mingw32 (where VERSION is the Emacs +version), version-independent site-lisp is in share/emacs/site-lisp, +version-specific Lisp files are in share/emacs/VERSION/lisp and in +share/emacs/VERSION/site-lisp, Info docs are in share/info, and data +files are in share/emacs/VERSION/etc. (Emacs knows about all these +directories and will find the files in there automatically; there's no +need to set any variables due to this change.) + +++ ** 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 diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 4a43a741e54..f41c23df5d2 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,15 @@ +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + Port to C89. + * ebrowse.c (USAGE): Remove macro with too-long string literal ... + (usage_message): ... and replace it with this new static constant + containing multiple literals. All uses changed. + * emacsclient.c (print_help_and_exit): + Rewrite to avoid string literals longer than the C89 limits. + (start_daemon_and_retry_set_socket): + Rewrite to avoid non-constant array initializer. + * make-docfile.c (enum global_type): Omit trailing comma. + 2013-07-02 Paul Eggert <eggert@cs.ucla.edu> Prefer plain 'static' to 'static inline' (Bug#12541). @@ -6134,7 +6146,7 @@ 1995-06-13 Geoff Voelker <voelker@cs.washington.edu> - * etags.c (process_file,absolute_filename): Handle filenames + * etags.c (process_file, absolute_filename): Handle filenames starting with a drive letter. * makefile.nt (install): Copy wakeup.exe properly. @@ -6161,12 +6173,12 @@ 1995-05-25 Geoff Voelker <voelker@cs.washington.edu> * makefile.nt (LIBS): Use BASE_LIBS. - (make-docfile.exe,hexl.exe,wakeup.exe,etags.exe): Don't depend + (make-docfile.exe, hexl.exe, wakeup.exe, etags.exe): Don't depend upon LIBS. (DOC): Use del instead of rm. (DOC) [WINDOWS95]: Use DOC. (clean): Handle MSVC aux files. - (config.h,paths.h): Use $(CP) instead of cp. + (config.h, paths.h): Use $(CP) instead of cp. (config.h): Use $(CONFIG_H) (make-docfile.obj): Depend upon config.h. Clean up comments. diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 407f769afc8..216865c3800 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -3481,7 +3481,9 @@ open_file (char *file) /* Display usage information and exit program. */ -#define USAGE "\ +static char const *const usage_message[] = + { + "\ Usage: ebrowse [options] {files}\n\ \n\ -a, --append append output to existing file\n\ @@ -3489,6 +3491,8 @@ Usage: ebrowse [options] {files}\n\ -I, --search-path=LIST set search path for input files\n\ -m, --min-regexp-length=N set minimum regexp length to N\n\ -M, --max-regexp-length=N set maximum regexp length to N\n\ +", + "\ -n, --no-nested-classes exclude nested classes\n\ -o, --output-file=FILE set output file name to FILE\n\ -p, --position-info print info about position in file\n\ @@ -3498,12 +3502,16 @@ Usage: ebrowse [options] {files}\n\ -x, --no-regexps don't record regular expressions\n\ --help display this help\n\ --version display version info\n\ +\n\ " + }; static _Noreturn void usage (int error) { - puts (USAGE); + int i; + for (i = 0; i < sizeof usage_message / sizeof *usage_message; i++) + fputs (usage_message[i], stdout); exit (error ? EXIT_FAILURE : EXIT_SUCCESS); } diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 898e8d69b07..74ccfa26259 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -630,7 +630,7 @@ print_help_and_exit (void) Please try to preserve them; otherwise the output is very hard to read when using emacsclientw. */ message (FALSE, - "Usage: %s [OPTIONS] FILE...\n\ + "Usage: %s [OPTIONS] FILE...\n%s%s%s", progname, "\ Tell the Emacs server to visit the specified files.\n\ Every FILE can be either just a FILENAME or [+LINE[:COLUMN]] FILENAME.\n\ \n\ @@ -640,6 +640,7 @@ The following OPTIONS are accepted:\n\ -nw, -t, --tty Open a new Emacs frame on the current terminal\n\ -c, --create-frame Create a new frame instead of trying to\n\ use the current Emacs frame\n\ +", "\ -F ALIST, --frame-parameters=ALIST\n\ Set the parameters of a new frame\n\ -e, --eval Evaluate the FILE arguments as ELisp expressions\n\ @@ -647,6 +648,7 @@ The following OPTIONS are accepted:\n\ -q, --quiet Don't display messages on success\n\ -d DISPLAY, --display=DISPLAY\n\ Visit the file in the given display\n\ +", "\ --parent-id=ID Open in parent window ID, via XEmbed\n" #ifndef NO_SOCKETS_IN_FILE_SYSTEM "-s SOCKET, --socket-name=SOCKET\n\ @@ -661,7 +663,7 @@ The following OPTIONS are accepted:\n\ mode and try connecting again\n" #endif /* not WINDOWSNT */ "\n\ -Report bugs with M-x report-emacs-bug.\n", progname); +Report bugs with M-x report-emacs-bug.\n"); exit (EXIT_SUCCESS); } @@ -1509,7 +1511,10 @@ start_daemon_and_retry_set_socket (void) { char emacs[] = "emacs"; char daemon_option[] = "--daemon"; - char *d_argv[] = {emacs, daemon_option, 0 }; + char *d_argv[3]; + d_argv[0] = emacs; + d_argv[1] = daemon_option; + d_argv[2] = 0; if (socket_name != NULL) { /* Pass --daemon=socket_name as argument. */ diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 9bc91bc4f77..73d1a0eb31d 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -555,7 +555,7 @@ enum global_type LISP_OBJECT, EMACS_INTEGER, BOOLEAN, - FUNCTION, + FUNCTION }; /* A single global. */ diff --git a/lib/binary-io.c b/lib/binary-io.c new file mode 100644 index 00000000000..8bbdb44d121 --- /dev/null +++ b/lib/binary-io.c @@ -0,0 +1,3 @@ +#include <config.h> +#define BINARY_IO_INLINE _GL_EXTERN_INLINE +#include "binary-io.h" diff --git a/lib/binary-io.h b/lib/binary-io.h new file mode 100644 index 00000000000..317fe3d3c20 --- /dev/null +++ b/lib/binary-io.h @@ -0,0 +1,72 @@ +/* Binary mode I/O. + Copyright (C) 2001, 2003, 2005, 2008-2013 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +#ifndef _BINARY_H +#define _BINARY_H + +/* For systems that distinguish between text and binary I/O. + O_BINARY is guaranteed by the gnulib <fcntl.h>. */ +#include <fcntl.h> + +/* The MSVC7 <stdio.h> doesn't like to be included after '#define fileno ...', + so we include it here first. */ +#include <stdio.h> + +_GL_INLINE_HEADER_BEGIN +#ifndef BINARY_IO_INLINE +# define BINARY_IO_INLINE _GL_INLINE +#endif + +/* set_binary_mode (fd, mode) + sets the binary/text I/O mode of file descriptor fd to the given mode + (must be O_BINARY or O_TEXT) and returns the previous mode. */ +#if O_BINARY +# if defined __EMX__ || defined __DJGPP__ || defined __CYGWIN__ +# include <io.h> /* declares setmode() */ +# define set_binary_mode setmode +# else +# define set_binary_mode _setmode +# undef fileno +# define fileno _fileno +# endif +#else + /* On reasonable systems, binary I/O is the only choice. */ + /* Use a function rather than a macro, to avoid gcc warnings + "warning: statement with no effect". */ +BINARY_IO_INLINE int +set_binary_mode (int fd, int mode) +{ + (void) fd; + (void) mode; + return O_BINARY; +} +#endif + +/* SET_BINARY (fd); + changes the file descriptor fd to perform binary I/O. */ +#ifdef __DJGPP__ +# include <unistd.h> /* declares isatty() */ + /* Avoid putting stdin/stdout in binary mode if it is connected to + the console, because that would make it impossible for the user + to interrupt the program through Ctrl-C or Ctrl-Break. */ +# define SET_BINARY(fd) ((void) (!isatty (fd) ? (set_binary_mode (fd, O_BINARY), 0) : 0)) +#else +# define SET_BINARY(fd) ((void) set_binary_mode (fd, O_BINARY)) +#endif + +_GL_INLINE_HEADER_END + +#endif /* _BINARY_H */ diff --git a/lib/fcntl.c b/lib/fcntl.c new file mode 100644 index 00000000000..735fa66f4d7 --- /dev/null +++ b/lib/fcntl.c @@ -0,0 +1,311 @@ +/* Provide file descriptor control. + + Copyright (C) 2009-2013 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +/* Written by Eric Blake <ebb9@byu.net>. */ + +#include <config.h> + +/* Specification. */ +#include <fcntl.h> + +#include <errno.h> +#include <limits.h> +#include <stdarg.h> +#include <unistd.h> + +#if !HAVE_FCNTL +# define rpl_fcntl fcntl +#endif +#undef fcntl + +#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ +/* Get declarations of the native Windows API functions. */ +# define WIN32_LEAN_AND_MEAN +# include <windows.h> + +/* Get _get_osfhandle. */ +# include "msvc-nothrow.h" + +/* Upper bound on getdtablesize(). See lib/getdtablesize.c. */ +# define OPEN_MAX_MAX 0x10000 + +/* Duplicate OLDFD into the first available slot of at least NEWFD, + which must be positive, with FLAGS determining whether the duplicate + will be inheritable. */ +static int +dupfd (int oldfd, int newfd, int flags) +{ + /* Mingw has no way to create an arbitrary fd. Iterate until all + file descriptors less than newfd are filled up. */ + HANDLE curr_process = GetCurrentProcess (); + HANDLE old_handle = (HANDLE) _get_osfhandle (oldfd); + unsigned char fds_to_close[OPEN_MAX_MAX / CHAR_BIT]; + unsigned int fds_to_close_bound = 0; + int result; + BOOL inherit = flags & O_CLOEXEC ? FALSE : TRUE; + int mode; + + if (newfd < 0 || getdtablesize () <= newfd) + { + errno = EINVAL; + return -1; + } + if (old_handle == INVALID_HANDLE_VALUE + || (mode = setmode (oldfd, O_BINARY)) == -1) + { + /* oldfd is not open, or is an unassigned standard file + descriptor. */ + errno = EBADF; + return -1; + } + setmode (oldfd, mode); + flags |= mode; + + for (;;) + { + HANDLE new_handle; + int duplicated_fd; + unsigned int index; + + if (!DuplicateHandle (curr_process, /* SourceProcessHandle */ + old_handle, /* SourceHandle */ + curr_process, /* TargetProcessHandle */ + (PHANDLE) &new_handle, /* TargetHandle */ + (DWORD) 0, /* DesiredAccess */ + inherit, /* InheritHandle */ + DUPLICATE_SAME_ACCESS)) /* Options */ + { + /* TODO: Translate GetLastError () into errno. */ + errno = EMFILE; + result = -1; + break; + } + duplicated_fd = _open_osfhandle ((intptr_t) new_handle, flags); + if (duplicated_fd < 0) + { + CloseHandle (new_handle); + errno = EMFILE; + result = -1; + break; + } + if (newfd <= duplicated_fd) + { + result = duplicated_fd; + break; + } + + /* Set the bit duplicated_fd in fds_to_close[]. */ + index = (unsigned int) duplicated_fd / CHAR_BIT; + if (fds_to_close_bound <= index) + { + if (sizeof fds_to_close <= index) + /* Need to increase OPEN_MAX_MAX. */ + abort (); + memset (fds_to_close + fds_to_close_bound, '\0', + index + 1 - fds_to_close_bound); + fds_to_close_bound = index + 1; + } + fds_to_close[index] |= 1 << ((unsigned int) duplicated_fd % CHAR_BIT); + } + + /* Close the previous fds that turned out to be too small. */ + { + int saved_errno = errno; + unsigned int duplicated_fd; + + for (duplicated_fd = 0; + duplicated_fd < fds_to_close_bound * CHAR_BIT; + duplicated_fd++) + if ((fds_to_close[duplicated_fd / CHAR_BIT] + >> (duplicated_fd % CHAR_BIT)) + & 1) + close (duplicated_fd); + + errno = saved_errno; + } + +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (oldfd, result); +# endif + return result; +} +#endif /* W32 */ + +/* Perform the specified ACTION on the file descriptor FD, possibly + using the argument ARG further described below. This replacement + handles the following actions, and forwards all others on to the + native fcntl. An unrecognized ACTION returns -1 with errno set to + EINVAL. + + F_DUPFD - duplicate FD, with int ARG being the minimum target fd. + If successful, return the duplicate, which will be inheritable; + otherwise return -1 and set errno. + + F_DUPFD_CLOEXEC - duplicate FD, with int ARG being the minimum + target fd. If successful, return the duplicate, which will not be + inheritable; otherwise return -1 and set errno. + + F_GETFD - ARG need not be present. If successful, return a + non-negative value containing the descriptor flags of FD (only + FD_CLOEXEC is portable, but other flags may be present); otherwise + return -1 and set errno. */ + +int +rpl_fcntl (int fd, int action, /* arg */...) +{ + va_list arg; + int result = -1; + va_start (arg, action); + switch (action) + { + +#if !HAVE_FCNTL + case F_DUPFD: + { + int target = va_arg (arg, int); + result = dupfd (fd, target, 0); + break; + } +#elif FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR + case F_DUPFD: + { + int target = va_arg (arg, int); + /* Detect invalid target; needed for cygwin 1.5.x. */ + if (target < 0 || getdtablesize () <= target) + errno = EINVAL; + else + { + /* Haiku alpha 2 loses fd flags on original. */ + int flags = fcntl (fd, F_GETFD); + if (flags < 0) + { + result = -1; + break; + } + result = fcntl (fd, action, target); + if (0 <= result && fcntl (fd, F_SETFD, flags) == -1) + { + int saved_errno = errno; + close (result); + result = -1; + errno = saved_errno; + } +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (fd, result); +# endif + } + break; + } /* F_DUPFD */ +#endif /* FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR */ + + case F_DUPFD_CLOEXEC: + { + int target = va_arg (arg, int); + +#if !HAVE_FCNTL + result = dupfd (fd, target, O_CLOEXEC); + break; +#else /* HAVE_FCNTL */ + /* Try the system call first, if the headers claim it exists + (that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we + may be running with a glibc that has the macro but with an + older kernel that does not support it. Cache the + information on whether the system call really works, but + avoid caching failure if the corresponding F_DUPFD fails + for any reason. 0 = unknown, 1 = yes, -1 = no. */ + static int have_dupfd_cloexec = GNULIB_defined_F_DUPFD_CLOEXEC ? -1 : 0; + if (0 <= have_dupfd_cloexec) + { + result = fcntl (fd, action, target); + if (0 <= result || errno != EINVAL) + { + have_dupfd_cloexec = 1; +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (fd, result); +# endif + } + else + { + result = rpl_fcntl (fd, F_DUPFD, target); + if (result < 0) + break; + have_dupfd_cloexec = -1; + } + } + else + result = rpl_fcntl (fd, F_DUPFD, target); + if (0 <= result && have_dupfd_cloexec == -1) + { + int flags = fcntl (result, F_GETFD); + if (flags < 0 || fcntl (result, F_SETFD, flags | FD_CLOEXEC) == -1) + { + int saved_errno = errno; + close (result); + errno = saved_errno; + result = -1; + } + } + break; +#endif /* HAVE_FCNTL */ + } /* F_DUPFD_CLOEXEC */ + +#if !HAVE_FCNTL + case F_GETFD: + { +# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ + HANDLE handle = (HANDLE) _get_osfhandle (fd); + DWORD flags; + if (handle == INVALID_HANDLE_VALUE + || GetHandleInformation (handle, &flags) == 0) + errno = EBADF; + else + result = (flags & HANDLE_FLAG_INHERIT) ? 0 : FD_CLOEXEC; +# else /* !W32 */ + /* Use dup2 to reject invalid file descriptors. No way to + access this information, so punt. */ + if (0 <= dup2 (fd, fd)) + result = 0; +# endif /* !W32 */ + break; + } /* F_GETFD */ +#endif /* !HAVE_FCNTL */ + + /* Implementing F_SETFD on mingw is not trivial - there is no + API for changing the O_NOINHERIT bit on an fd, and merely + changing the HANDLE_FLAG_INHERIT bit on the underlying handle + can lead to odd state. It may be possible by duplicating the + handle, using _open_osfhandle with the right flags, then + using dup2 to move the duplicate onto the original, but that + is not supported for now. */ + + default: + { +#if HAVE_FCNTL + void *p = va_arg (arg, void *); + result = fcntl (fd, action, p); +#else + errno = EINVAL; +#endif + break; + } + } + va_end (arg); + return result; +} diff --git a/lib/getdtablesize.c b/lib/getdtablesize.c new file mode 100644 index 00000000000..9947405af61 --- /dev/null +++ b/lib/getdtablesize.c @@ -0,0 +1,86 @@ +/* getdtablesize() function for platforms that don't have it. + Copyright (C) 2008-2013 Free Software Foundation, Inc. + Written by Bruno Haible <bruno@clisp.org>, 2008. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> + +/* Specification. */ +#include <unistd.h> + +#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ + +#include <stdio.h> + +#include "msvc-inval.h" + +#if HAVE_MSVC_INVALID_PARAMETER_HANDLER +static int +_setmaxstdio_nothrow (int newmax) +{ + int result; + + TRY_MSVC_INVAL + { + result = _setmaxstdio (newmax); + } + CATCH_MSVC_INVAL + { + result = -1; + } + DONE_MSVC_INVAL; + + return result; +} +# define _setmaxstdio _setmaxstdio_nothrow +#endif + +/* Cache for the previous getdtablesize () result. */ +static int dtablesize; + +int +getdtablesize (void) +{ + if (dtablesize == 0) + { + /* We are looking for the number N such that the valid file descriptors + are 0..N-1. It can be obtained through a loop as follows: + { + int fd; + for (fd = 3; fd < 65536; fd++) + if (dup2 (0, fd) == -1) + break; + return fd; + } + On Windows XP, the result is 2048. + The drawback of this loop is that it allocates memory for a libc + internal array that is never freed. + + The number N can also be obtained as the upper bound for + _getmaxstdio (). _getmaxstdio () returns the maximum number of open + FILE objects. The sanity check in _setmaxstdio reveals the maximum + number of file descriptors. This too allocates memory, but it is + freed when we call _setmaxstdio with the original value. */ + int orig_max_stdio = _getmaxstdio (); + unsigned int bound; + for (bound = 0x10000; _setmaxstdio (bound) < 0; bound = bound / 2) + ; + _setmaxstdio (orig_max_stdio); + dtablesize = bound; + } + return dtablesize; +} + +#endif diff --git a/lib/gnulib.mk b/lib/gnulib.mk index 4a84b1db261..d053e15efc1 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=dup --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --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 fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings memrchr mktime pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv 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=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --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 fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings MOSTLYCLEANFILES += core *.stackdump @@ -75,6 +75,12 @@ EXTRA_libgnu_a_SOURCES += openat-proc.c ## end gnulib module at-internal +## begin gnulib module binary-io + +libgnu_a_SOURCES += binary-io.h binary-io.c + +## end gnulib module binary-io + ## begin gnulib module c-ctype libgnu_a_SOURCES += c-ctype.h c-ctype.c @@ -296,6 +302,15 @@ EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c ## end gnulib module faccessat +## begin gnulib module fcntl + + +EXTRA_DIST += fcntl.c + +EXTRA_libgnu_a_SOURCES += fcntl.c + +## end gnulib module fcntl + ## begin gnulib module fcntl-h BUILT_SOURCES += fcntl.h @@ -384,6 +399,17 @@ EXTRA_libgnu_a_SOURCES += fsync.c ## end gnulib module fsync +## begin gnulib module getdtablesize + +if gl_GNULIB_ENABLED_getdtablesize + +endif +EXTRA_DIST += getdtablesize.c + +EXTRA_libgnu_a_SOURCES += getdtablesize.c + +## end gnulib module getdtablesize + ## begin gnulib module getgroups if gl_GNULIB_ENABLED_getgroups @@ -465,13 +491,6 @@ EXTRA_libgnu_a_SOURCES += group-member.c ## end gnulib module group-member -## begin gnulib module ignore-value - - -EXTRA_DIST += ignore-value.h - -## end gnulib module ignore-value - ## begin gnulib module intprops @@ -568,6 +587,12 @@ EXTRA_DIST += pathmax.h ## end gnulib module pathmax +## begin gnulib module pipe2 + +libgnu_a_SOURCES += pipe2.c + +## end gnulib module pipe2 + ## begin gnulib module pselect @@ -1704,9 +1729,7 @@ EXTRA_DIST += utimens.h ## begin gnulib module verify -if gl_GNULIB_ENABLED_verify -endif EXTRA_DIST += verify.h ## end gnulib module verify diff --git a/lib/ignore-value.h b/lib/ignore-value.h deleted file mode 100644 index ebd6bf42f56..00000000000 --- a/lib/ignore-value.h +++ /dev/null @@ -1,48 +0,0 @@ -/* ignore a function return without a compiler warning - - Copyright (C) 2008-2013 Free Software Foundation, Inc. - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. */ - -/* Written by Jim Meyering, Eric Blake and Pádraig Brady. */ - -/* Use "ignore_value" to avoid a warning when using a function declared with - gcc's warn_unused_result attribute, but for which you really do want to - ignore the result. Traditionally, people have used a "(void)" cast to - indicate that a function's return value is deliberately unused. However, - if the function is declared with __attribute__((warn_unused_result)), - gcc issues a warning even with the cast. - - Caution: most of the time, you really should heed gcc's warning, and - check the return value. However, in those exceptional cases in which - you're sure you know what you're doing, use this function. - - For the record, here's one of the ignorable warnings: - "copy.c:233: warning: ignoring return value of 'fchown', - declared with attribute warn_unused_result". */ - -#ifndef _GL_IGNORE_VALUE_H -#define _GL_IGNORE_VALUE_H - -/* The __attribute__((__warn_unused_result__)) feature - is available in gcc versions 3.4 and newer, - while the typeof feature has been available since 2.7 at least. */ -#if 3 < __GNUC__ + (4 <= __GNUC_MINOR__) -# define ignore_value(x) \ - (__extension__ ({ __typeof__ (x) __x = (x); (void) __x; })) -#else -# define ignore_value(x) ((void) (x)) -#endif - -#endif diff --git a/lib/pipe2.c b/lib/pipe2.c new file mode 100644 index 00000000000..211d75545c0 --- /dev/null +++ b/lib/pipe2.c @@ -0,0 +1,168 @@ +/* Create a pipe, with specific opening flags. + Copyright (C) 2009-2013 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, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> + +/* Specification. */ +#include <unistd.h> + +#include <errno.h> +#include <fcntl.h> + +#include "binary-io.h" +#include "verify.h" + +#if GNULIB_defined_O_NONBLOCK +# include "nonblocking.h" +#endif + +#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ +/* Native Windows API. */ + +# include <io.h> + +#endif + +int +pipe2 (int fd[2], int flags) +{ + /* Mingw _pipe() corrupts fd on failure; also, if we succeed at + creating the pipe but later fail at changing fcntl, we want + to leave fd unchanged: http://austingroupbugs.net/view.php?id=467 */ + int tmp[2]; + tmp[0] = fd[0]; + tmp[1] = fd[1]; + +#if HAVE_PIPE2 +# undef pipe2 + /* Try the system call first, if it exists. (We may be running with a glibc + that has the function but with an older kernel that lacks it.) */ + { + /* Cache the information whether the system call really exists. */ + static int have_pipe2_really; /* 0 = unknown, 1 = yes, -1 = no */ + if (have_pipe2_really >= 0) + { + int result = pipe2 (fd, flags); + if (!(result < 0 && errno == ENOSYS)) + { + have_pipe2_really = 1; + return result; + } + have_pipe2_really = -1; + } + } +#endif + + /* Check the supported flags. */ + if ((flags & ~(O_CLOEXEC | O_NONBLOCK | O_BINARY | O_TEXT)) != 0) + { + errno = EINVAL; + return -1; + } + +#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ +/* Native Windows API. */ + + if (_pipe (fd, 4096, flags & ~O_NONBLOCK) < 0) + { + fd[0] = tmp[0]; + fd[1] = tmp[1]; + return -1; + } + + /* O_NONBLOCK handling. + On native Windows platforms, O_NONBLOCK is defined by gnulib. Use the + functions defined by the gnulib module 'nonblocking'. */ +# if GNULIB_defined_O_NONBLOCK + if (flags & O_NONBLOCK) + { + if (set_nonblocking_flag (fd[0], true) != 0 + || set_nonblocking_flag (fd[1], true) != 0) + goto fail; + } +# else + { + verify (O_NONBLOCK == 0); + } +# endif + + return 0; + +#else +/* Unix API. */ + + if (pipe (fd) < 0) + return -1; + + /* POSIX <http://www.opengroup.org/onlinepubs/9699919799/functions/pipe.html> + says that initially, the O_NONBLOCK and FD_CLOEXEC flags are cleared on + both fd[0] and fd[1]. */ + + /* O_NONBLOCK handling. + On Unix platforms, O_NONBLOCK is defined by the system. Use fcntl(). */ + if (flags & O_NONBLOCK) + { + int fcntl_flags; + + if ((fcntl_flags = fcntl (fd[1], F_GETFL, 0)) < 0 + || fcntl (fd[1], F_SETFL, fcntl_flags | O_NONBLOCK) == -1 + || (fcntl_flags = fcntl (fd[0], F_GETFL, 0)) < 0 + || fcntl (fd[0], F_SETFL, fcntl_flags | O_NONBLOCK) == -1) + goto fail; + } + + if (flags & O_CLOEXEC) + { + int fcntl_flags; + + if ((fcntl_flags = fcntl (fd[1], F_GETFD, 0)) < 0 + || fcntl (fd[1], F_SETFD, fcntl_flags | FD_CLOEXEC) == -1 + || (fcntl_flags = fcntl (fd[0], F_GETFD, 0)) < 0 + || fcntl (fd[0], F_SETFD, fcntl_flags | FD_CLOEXEC) == -1) + goto fail; + } + +# if O_BINARY + if (flags & O_BINARY) + { + set_binary_mode (fd[1], O_BINARY); + set_binary_mode (fd[0], O_BINARY); + } + else if (flags & O_TEXT) + { + set_binary_mode (fd[1], O_TEXT); + set_binary_mode (fd[0], O_TEXT); + } +# endif + + return 0; + +#endif + +#if GNULIB_defined_O_NONBLOCK || \ + !((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) + fail: + { + int saved_errno = errno; + close (fd[0]); + close (fd[1]); + fd[0] = tmp[0]; + fd[1] = tmp[1]; + errno = saved_errno; + return -1; + } +#endif +} diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h index c3a67321b0e..7254a3dec17 100644 --- a/lib/stdalign.in.h +++ b/lib/stdalign.in.h @@ -41,13 +41,28 @@ are 4 unless the option '-malign-double' is used. The result cannot be used as a value for an 'enum' constant, if you - want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ + want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. + + Include <stddef.h> for offsetof. */ #include <stddef.h> -#if defined __cplusplus + +/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other + standard headers, defines conflicting implementations of _Alignas + and _Alignof that are no better than ours; override them. */ +#undef _Alignas +#undef _Alignof + +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 +# ifdef __cplusplus +# if 201103 <= __cplusplus +# define _Alignof(type) alignof (type) +# else template <class __t> struct __alignof_helper { char __a; __t __b; }; -# define _Alignof(type) offsetof (__alignof_helper<type>, __b) -#else -# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) +# define _Alignof(type) offsetof (__alignof_helper<type>, __b) +# endif +# else +# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) +# endif #endif #define alignof _Alignof #define __alignof_is_defined 1 @@ -77,12 +92,16 @@ */ -#if __GNUC__ || __IBMC__ || __IBMCPP__ || 0x5110 <= __SUNPRO_C -# define _Alignas(a) __attribute__ ((__aligned__ (a))) -#elif 1300 <= _MSC_VER -# define _Alignas(a) __declspec (align (a)) +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 +# if defined __cplusplus && 201103 <= __cplusplus +# define _Alignas(a) alignas (a) +# elif __GNUC__ || __IBMC__ || __IBMCPP__ || __ICC || 0x5110 <= __SUNPRO_C +# define _Alignas(a) __attribute__ ((__aligned__ (a))) +# elif 1300 <= _MSC_VER +# define _Alignas(a) __declspec (align (a)) +# endif #endif -#ifdef _Alignas +#if defined _Alignas || (defined __STDC_VERSION && 201112 <= __STDC_VERSION__) # define alignas _Alignas # define __alignas_is_defined 1 #endif diff --git a/lib/verify.h b/lib/verify.h index 03492efcd3f..d42d0750ee1 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -18,7 +18,7 @@ /* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */ #ifndef _GL_VERIFY_H -# define _GL_VERIFY_H +#define _GL_VERIFY_H /* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert works as per C11. @@ -31,16 +31,24 @@ Use this only with GCC. If we were willing to slow 'configure' down we could also use it with other compilers, but since this affects only the quality of diagnostics, why bother? */ -# if (4 < __GNUC__ + (6 <= __GNUC_MINOR__) \ - && (201112L <= __STDC_VERSION__ || !defined __STRICT_ANSI__) \ - && !defined __cplusplus) -# define _GL_HAVE__STATIC_ASSERT 1 -# endif +#if (4 < __GNUC__ + (6 <= __GNUC_MINOR__) \ + && (201112L <= __STDC_VERSION__ || !defined __STRICT_ANSI__) \ + && !defined __cplusplus) +# define _GL_HAVE__STATIC_ASSERT 1 +#endif /* The condition (99 < __GNUC__) is temporary, until we know about the first G++ release that supports static_assert. */ -# if (99 < __GNUC__) && defined __cplusplus -# define _GL_HAVE_STATIC_ASSERT 1 -# endif +#if (99 < __GNUC__) && defined __cplusplus +# define _GL_HAVE_STATIC_ASSERT 1 +#endif + +/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other + system headers, defines a conflicting _Static_assert that is no + better than ours; override it. */ +#ifndef _GL_HAVE_STATIC_ASSERT +# include <stddef.h> +# undef _Static_assert +#endif /* Each of these macros verifies that its argument R is nonzero. To be portable, R should be an integer constant expression. Unlike @@ -143,50 +151,50 @@ Use a template type to work around the problem. */ /* Concatenate two preprocessor tokens. */ -# define _GL_CONCAT(x, y) _GL_CONCAT0 (x, y) -# define _GL_CONCAT0(x, y) x##y +#define _GL_CONCAT(x, y) _GL_CONCAT0 (x, y) +#define _GL_CONCAT0(x, y) x##y /* _GL_COUNTER is an integer, preferably one that changes each time we use it. Use __COUNTER__ if it works, falling back on __LINE__ otherwise. __LINE__ isn't perfect, but it's better than a constant. */ -# if defined __COUNTER__ && __COUNTER__ != __COUNTER__ -# define _GL_COUNTER __COUNTER__ -# else -# define _GL_COUNTER __LINE__ -# endif +#if defined __COUNTER__ && __COUNTER__ != __COUNTER__ +# define _GL_COUNTER __COUNTER__ +#else +# define _GL_COUNTER __LINE__ +#endif /* Generate a symbol with the given prefix, making it unique if possible. */ -# define _GL_GENSYM(prefix) _GL_CONCAT (prefix, _GL_COUNTER) +#define _GL_GENSYM(prefix) _GL_CONCAT (prefix, _GL_COUNTER) /* Verify requirement R at compile-time, as an integer constant expression that returns 1. If R is false, fail at compile-time, preferably with a diagnostic that includes the string-literal DIAGNOSTIC. */ -# define _GL_VERIFY_TRUE(R, DIAGNOSTIC) \ - (!!sizeof (_GL_VERIFY_TYPE (R, DIAGNOSTIC))) +#define _GL_VERIFY_TRUE(R, DIAGNOSTIC) \ + (!!sizeof (_GL_VERIFY_TYPE (R, DIAGNOSTIC))) -# ifdef __cplusplus -# if !GNULIB_defined_struct__gl_verify_type +#ifdef __cplusplus +# if !GNULIB_defined_struct__gl_verify_type template <int w> struct _gl_verify_type { unsigned int _gl_verify_error_if_negative: w; }; -# define GNULIB_defined_struct__gl_verify_type 1 -# endif -# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ - _gl_verify_type<(R) ? 1 : -1> -# elif defined _GL_HAVE__STATIC_ASSERT -# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ - struct { \ - _Static_assert (R, DIAGNOSTIC); \ - int _gl_dummy; \ - } -# else -# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ - struct { unsigned int _gl_verify_error_if_negative: (R) ? 1 : -1; } +# define GNULIB_defined_struct__gl_verify_type 1 # endif +# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ + _gl_verify_type<(R) ? 1 : -1> +#elif defined _GL_HAVE__STATIC_ASSERT +# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ + struct { \ + _Static_assert (R, DIAGNOSTIC); \ + int _gl_dummy; \ + } +#else +# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ + struct { unsigned int _gl_verify_error_if_negative: (R) ? 1 : -1; } +#endif /* Verify requirement R at compile-time, as a declaration without a trailing ';'. If R is false, fail at compile-time, preferably @@ -195,23 +203,23 @@ template <int w> Unfortunately, unlike C11, this implementation must appear as an ordinary declaration, and cannot appear inside struct { ... }. */ -# ifdef _GL_HAVE__STATIC_ASSERT -# define _GL_VERIFY _Static_assert -# else -# define _GL_VERIFY(R, DIAGNOSTIC) \ - extern int (*_GL_GENSYM (_gl_verify_function) (void)) \ - [_GL_VERIFY_TRUE (R, DIAGNOSTIC)] -# endif +#ifdef _GL_HAVE__STATIC_ASSERT +# define _GL_VERIFY _Static_assert +#else +# define _GL_VERIFY(R, DIAGNOSTIC) \ + extern int (*_GL_GENSYM (_gl_verify_function) (void)) \ + [_GL_VERIFY_TRUE (R, DIAGNOSTIC)] +#endif /* _GL_STATIC_ASSERT_H is defined if this code is copied into assert.h. */ -# ifdef _GL_STATIC_ASSERT_H -# if !defined _GL_HAVE__STATIC_ASSERT && !defined _Static_assert -# define _Static_assert(R, DIAGNOSTIC) _GL_VERIFY (R, DIAGNOSTIC) -# endif -# if !defined _GL_HAVE_STATIC_ASSERT && !defined static_assert -# define static_assert _Static_assert /* C11 requires this #define. */ -# endif +#ifdef _GL_STATIC_ASSERT_H +# if !defined _GL_HAVE__STATIC_ASSERT && !defined _Static_assert +# define _Static_assert(R, DIAGNOSTIC) _GL_VERIFY (R, DIAGNOSTIC) +# endif +# if !defined _GL_HAVE_STATIC_ASSERT && !defined static_assert +# define static_assert _Static_assert /* C11 requires this #define. */ # endif +#endif /* @assert.h omit start@ */ @@ -229,18 +237,18 @@ template <int w> verify_true is obsolescent; please use verify_expr instead. */ -# define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")") +#define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")") /* Verify requirement R at compile-time. Return the value of the expression E. */ -# define verify_expr(R, E) \ - (_GL_VERIFY_TRUE (R, "verify_expr (" #R ", " #E ")") ? (E) : (E)) +#define verify_expr(R, E) \ + (_GL_VERIFY_TRUE (R, "verify_expr (" #R ", " #E ")") ? (E) : (E)) /* Verify requirement R at compile-time, as a declaration without a trailing ';'. */ -# define verify(R) _GL_VERIFY (R, "verify (" #R ")") +#define verify(R) _GL_VERIFY (R, "verify (" #R ")") /* @assert.h omit end@ */ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2402ea0cd1f..81bcb1d033c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,237 @@ +2013-07-12 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-percent-literals-beg-re): + (ruby-syntax-expansion-allowed-p): Support array of symbols, for + Ruby 2.0. + (ruby-font-lock-keywords): Distinguish calls to functions with + module-like names from module references. Highlight character + literals. + +2013-07-12 Sergio Durigan Junior <sergiodj@riseup.net> (tiny change) + + * progmodes/gdb-mi.el (gdb-strip-string-backslash): New function. + (gdb-send): Handle continued commands. (Bug#14847) + +2013-07-12 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop--v2s): Remove unused local variable. + (desktop-save-buffer): Make defvar-local; adjust docstring. + (desktop-auto-save-timeout, desktop-owner): Use ignore-errors. + (desktop-clear, desktop-save-buffer-p): Use string-match-p. + +2013-07-12 Andreas Schwab <schwab@linux-m68k.org> + + * emacs-lisp/map-ynp.el (map-y-or-n-p): Fix last change. + +2013-07-12 Eli Zaretskii <eliz@gnu.org> + + * simple.el (next-line, previous-line): Document TRY-VSCROLL and ARG. + (Bug#14842) + +2013-07-12 Glenn Morris <rgm@gnu.org> + + * doc-view.el: Require cl-lib at runtime too. + (doc-view-remove-if): Remove. + (doc-view-search-next-match, doc-view-search-previous-match): + Use cl-remove-if. + + * edmacro.el: Require cl-lib at runtime too. + (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq. + (edmacro-mismatch, edmacro-subseq): Remove. + + * shadowfile.el: Require cl-lib. + (shadow-remove-if): Remove. + (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo): + Use cl-remove-if. + + * wid-edit.el: Require cl-lib. + (widget-choose): Use cl-remove-if. + (widget-remove-if): Remove. + + * progmodes/ebrowse.el: Require cl-lib at runtime too. + (ebrowse-delete-if-not): Remove. + (ebrowse-browser-buffer-list, ebrowse-member-buffer-list) + (ebrowse-tree-buffer-list, ebrowse-same-tree-member-buffer-list): + Use cl-delete-if-not. + +2013-07-12 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq) + (cl-the, cl-declare, cl-defstruct): Fix typos in docstrings. + +2013-07-12 Leo Liu <sdl.web@gmail.com> + + * ido.el (dired-do-copy, dired): Set 'ido property. (Bug#11954) + +2013-07-11 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/edebug.el: Require cl-lib at run-time too. + (edebug-gensym-index, edebug-gensym): + Remove reimplementation of cl-gensym. + (edebug-make-enter-wrapper, edebug-make-form-wrapper): Use cl-gensym. + + * thumbs.el: Require cl-lib at run-time too. + (thumbs-gensym-counter, thumbs-gensym): + Remove reimplementation of cl-gensym. + (thumbs-temp-file): Use cl-gensym. + + * emacs-lisp/ert.el: Require cl-lib at runtime too. + (ert--cl-do-remf, ert--remprop, ert--remove-if-not) + (ert--intersection, ert--set-difference, ert--set-difference-eq) + (ert--union, ert--gensym-counter, ert--gensym-counter) + (ert--coerce-to-vector, ert--remove*, ert--string-position) + (ert--mismatch, ert--subseq): Remove reimplementations of cl funcs. + (ert-make-test-unbound, ert--expand-should-1) + (ert--expand-should, ert--should-error-handle-error) + (should-error, ert--explain-equal-rec) + (ert--plist-difference-explanation, ert-select-tests) + (ert--make-stats, ert--remove-from-list, ert--string-first-line): + Use cl-lib functions rather than reimplementations. + +2013-07-11 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-methods): Extend docstring. + (tramp-connection-timeout): New defcustom. + (tramp-error-with-buffer): Reset timestamp only when appropriate. + (with-tramp-progress-reporter): Simplify. + (tramp-process-actions): Improve messages. + + * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): + * net/tramp-sh.el (tramp-maybe-open-connection): + Use `tramp-connection-timeout'. + (tramp-methods) [su, sudo, ksu]: Add method specific timeouts. + (Bug#14808) + +2013-07-11 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-read-file-name): Conform to the requirements of + read-file-name. (Bug#11861) + (ido-read-directory-name): Conform to the requirements of + read-directory-name. + +2013-07-11 Juanma Barranquero <lekktu@gmail.com> + + * subr.el (delay-warning): New function. + +2013-07-10 Eli Zaretskii <eliz@gnu.org> + + * simple.el (default-line-height): New function. + (line-move-partial, line-move): Use it instead of computing the + line height inline. + (line-move-partial): Always compute ROWH. If the last line is + partially-visible, but its text is completely visible, allow + cursor to enter such a partially-visible line. + +2013-07-10 Michael Albinus <michael.albinus@gmx.de> + + Improve error messages. (Bug#14808) + + * net/tramp.el (tramp-current-connection): New defvar, moved from + tramp-sh.el. + (tramp-message-show-progress-reporter-message): Removed, not + needed anymore. + (tramp-error-with-buffer): Show message in minibuffer. Discard + input before waiting. Reset connection timestamp. + (with-tramp-progress-reporter): Improve messages. + (tramp-process-actions): Use progress reporter. Delete process in + case of error. Improve messages. + + * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use + condition-case. Call `tramp-error-with-buffer' with vector and buffer. + (tramp-current-connection): Removed. + (tramp-maybe-open-connection): The car of + `tramp-current-connection' are the first 3 slots of the vector. + +2013-07-10 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/cfengine.el (cfengine3-indent-line): Do not indent + inside continued strings. + +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + Timestamp fixes for undo (Bug#14824). + * files.el (clear-visited-file-modtime): Move here from fileio.c. + +2013-07-10 Leo Liu <sdl.web@gmail.com> + + * files.el (require-final-newline): Allow safe local value. + (Bug#14834) + +2013-07-09 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-read-directory-name): Handle fallback. + (ido-read-file-name): Update DIR to ido-current-directory. + (Bug#1516) + (ido-add-virtual-buffers-to-list): Robustify. (Bug#14552) + +2013-07-09 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Remove extra + "autoload". Remove "warn lower camel case" section, previously + commented out. Highlight negation char. Do not highlight the + target in singleton method definitions. + +2013-07-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * faces.el (tty-setup-hook): Declare the hook. + + * emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try + and detect when a guard/pred depends on local vars (bug#14773). + (pcase--u1): Adjust caller. + +2013-07-08 Eli Zaretskii <eliz@gnu.org> + + * simple.el (line-move-partial, line-move): Account for + line-spacing. + (line-move-partial): Avoid setting vscroll when the last + partially-visible line in window is of default height. + +2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-map): Reinstate the `u' key binding, since it's + been used a while. + +2013-07-07 Juanma Barranquero <lekktu@gmail.com> + + * subr.el (read-quoted-char): Remove unused local variable `char'. + +2013-07-07 Michael Kifer <kifer@cs.stonybrook.edu> + + * ediff.el (ediff-version): Version update. + (ediff-files-command, ediff3-files-command, ediff-merge-command) + (ediff-merge-with-ancestor-command, ediff-directories-command) + (ediff-directories3-command, ediff-merge-directories-command) + (ediff-merge-directories-with-ancestor-command): New functions. + All are command-line interfaces to ediff: to facilitate calling + Emacs with the appropriate ediff functions invoked. + + * viper-cmd.el (viper-del-forward-char-in-insert): New function. + (viper-save-kill-buffer): Check if buffer is modified. + + * viper.el (viper-version): Version update. + (viper-emacs-state-mode-list): Add egg-status-buffer-mode. + +2013-07-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook. + * viper-cmd.el (viper-envelop-ESC-key): Remove function. + (viper-intercept-ESC-key): Simplify. + * viper-keym.el (viper-ESC-key): Make it a constant, don't use kbd. + * viper.el (viper--tty-ESC-filter, viper--lookup-key) + (viper-catch-tty-ESC, viper-uncatch-tty-ESC) + (viper-setup-ESC-to-escape): New functions. + (viper-go-away, viper-set-hooks): Call viper-setup-ESC-to-escape. + (viper-set-hooks): Do not modify flyspell-mode-hook. (Bug#13793) + +2013-07-07 Eli Zaretskii <eliz@gnu.org> + + * simple.el (default-font-height, window-screen-lines): + New functions. + (line-move, line-move-partial): Use them instead of + frame-char-height and window-text-height. This makes scrolling + text smoother when the buffer's default face uses a font that is + different from the frame's default font. + 2013-07-06 Jan Djärv <jan.h.d@swipnet.se> * files.el (write-file): Do not display confirm dialog for NS, @@ -532,7 +766,7 @@ * emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode) (emacs-lock--try-unlocking): Make defvar-local. -2013-06-22 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-22 Glenn Morris <rgm@gnu.org> * play/cookie1.el (cookie-apropos): Minor simplification. @@ -998,7 +1232,7 @@ * net/shr.el (shr-map): Bind [down-mouse-1] to browse URLs. -2013-06-19 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-19 Glenn Morris <rgm@gnu.org> * emacs-lisp/eieio.el (defclass): Make it eval-and-compile once more. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 7a2c5755cc0..705277c97a0 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -2,7 +2,7 @@ * data-debug.el, cedet-idutils.el: Neuter the "Version:" header. -2013-06-19 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-19 Glenn Morris <rgm@gnu.org> * semantic/idle.el (define-semantic-idle-service): No need to use eval-and-compile, progn will do. diff --git a/lisp/desktop.el b/lisp/desktop.el index 2f4c2a8589c..322b95715a2 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -196,9 +196,7 @@ Zero or nil means disable timer-based auto-saving." (integer :tag "Seconds")) :set (lambda (symbol value) (set-default symbol value) - (condition-case nil - (desktop-auto-save-set-timer) - (error nil))) + (ignore-errors (desktop-auto-save-set-timer))) :group 'desktop :version "24.4") @@ -416,9 +414,8 @@ See `desktop-restore-eager'." :version "22.1") ;;;###autoload -(defvar desktop-save-buffer nil +(defvar-local desktop-save-buffer nil "When non-nil, save buffer status in desktop file. -This variable becomes buffer local when set. If the value is a function, it is called by `desktop-save' with argument DESKTOP-DIRNAME to obtain auxiliary information to save in the desktop @@ -430,7 +427,6 @@ When file names are returned, they should be formatted using the call Later, when `desktop-read' evaluates the desktop file, auxiliary information is passed as the argument DESKTOP-BUFFER-MISC to functions in `desktop-buffer-mode-handlers'.") -(make-variable-buffer-local 'desktop-save-buffer) (make-obsolete-variable 'desktop-buffer-modes-to-save 'desktop-save-buffer "22.1") (make-obsolete-variable 'desktop-buffer-misc-functions @@ -582,15 +578,15 @@ Used to detect desktop file conflicts.") "Return the PID of the Emacs process that owns the desktop file in DIRNAME. Return nil if no desktop file found or no Emacs process is using it. DIRNAME omitted or nil means use `desktop-dirname'." - (let (owner) - (and (file-exists-p (desktop-full-lock-name dirname)) - (condition-case nil - (with-temp-buffer - (insert-file-contents-literally (desktop-full-lock-name dirname)) - (goto-char (point-min)) - (setq owner (read (current-buffer))) - (integerp owner)) - (error nil)) + (let (owner + (file (desktop-full-lock-name dirname))) + (and (file-exists-p file) + (ignore-errors + (with-temp-buffer + (insert-file-contents-literally file) + (goto-char (point-min)) + (setq owner (read (current-buffer))) + (integerp owner))) owner))) (defun desktop-claim-lock (&optional dirname) @@ -636,7 +632,7 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'." (let ((bufname (buffer-name (car buffers)))) (or (null bufname) - (string-match preserve-regexp bufname) + (string-match-p preserve-regexp bufname) ;; Don't kill buffers made for internal purposes. (and (not (equal bufname "")) (eq (aref bufname 0) ?\s)) (kill-buffer (car buffers)))) @@ -758,8 +754,7 @@ QUOTE may be `may' (value may be quoted), ((consp value) (let ((p value) newlist - use-list* - anynil) + use-list*) (while (consp p) (let ((q.sexp (desktop--v2s (car p)))) (push q.sexp newlist)) @@ -841,17 +836,17 @@ MODE is the major mode. dired-skip) (and (not (and (stringp desktop-buffers-not-to-save) (not filename) - (string-match desktop-buffers-not-to-save bufname))) + (string-match-p desktop-buffers-not-to-save bufname))) (not (memq mode desktop-modes-not-to-save)) ;; FIXME this is broken if desktop-files-not-to-save is nil. (or (and filename (stringp desktop-files-not-to-save) - (not (string-match desktop-files-not-to-save filename))) + (not (string-match-p desktop-files-not-to-save filename))) (and (memq mode '(dired-mode vc-dir-mode)) (with-current-buffer bufname (not (setq dired-skip - (string-match desktop-files-not-to-save - default-directory))))) + (string-match-p desktop-files-not-to-save + default-directory))))) (and (null filename) (null dired-skip) ; bug#5755 (with-current-buffer bufname desktop-save-buffer)))))) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index e4434c3a0d8..10968f7f8dd 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -136,7 +136,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'dired) (require 'image-mode) (require 'jka-compr) @@ -698,14 +698,6 @@ It's a subdirectory of `doc-view-cache-directory'." (md5 (current-buffer))))) doc-view-cache-directory))))) -(defun doc-view-remove-if (predicate list) - "Return LIST with all items removed that satisfy PREDICATE." - (let (new-list) - (dolist (item list) - (when (not (funcall predicate item)) - (setq new-list (cons item new-list)))) - (nreverse new-list))) - ;;;###autoload (defun doc-view-mode-p (type) "Return non-nil if document type TYPE is available for `doc-view'. @@ -1488,7 +1480,7 @@ If BACKWARD is non-nil, jump to the previous match." (defun doc-view-search-next-match (arg) "Go to the ARGth next matching page." (interactive "p") - (let* ((next-pages (doc-view-remove-if + (let* ((next-pages (cl-remove-if (lambda (i) (<= (car i) (doc-view-current-page))) doc-view--current-search-matches)) (page (car (nth (1- arg) next-pages)))) @@ -1502,7 +1494,7 @@ If BACKWARD is non-nil, jump to the previous match." (defun doc-view-search-previous-match (arg) "Go to the ARGth previous matching page." (interactive "p") - (let* ((prev-pages (doc-view-remove-if + (let* ((prev-pages (cl-remove-if (lambda (i) (>= (car i) (doc-view-current-page))) doc-view--current-search-matches)) (page (car (nth (1- arg) (nreverse prev-pages))))) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 6ef2e29dc83..67992d16527 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -62,9 +62,8 @@ ;; macro in a more concise way that omits the comments. ;;; Code: - -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'kmacro) ;;; The user-level commands for editing macros. @@ -444,14 +443,14 @@ doubt, use whitespace." (let* ((prefix (or (and (integerp (aref rest-mac 0)) (memq (aref rest-mac 0) mdigs) - (memq (key-binding (edmacro-subseq rest-mac 0 1)) + (memq (key-binding (cl-subseq rest-mac 0 1)) '(digit-argument negative-argument)) (let ((i 1)) (while (memq (aref rest-mac i) (cdr mdigs)) (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") - (cl-callf edmacro-subseq rest-mac i))))) + (prog1 (vconcat "M-" (cl-subseq rest-mac 0 i) " ") + (cl-callf cl-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -459,7 +458,7 @@ doubt, use whitespace." (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (cl-loop repeat i concat "C-u ") - (cl-callf edmacro-subseq rest-mac i))))) + (cl-callf cl-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -469,18 +468,18 @@ doubt, use whitespace." '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") - (cl-callf edmacro-subseq rest-mac i))))))) + (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") + (cl-callf cl-subseq rest-mac i))))))) (bind-len (apply 'max 1 (cl-loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) - (key (edmacro-subseq rest-mac 0 bind-len)) + (key (cl-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (cl-loop for map in maps for b = (lookup-key map key) thereis (and (not (integerp b)) b)) (and (setq fkey (lookup-key local-function-key-map rest-mac)) - (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) + (setq tlen fkey tkey (cl-subseq rest-mac 0 tlen) fkey (lookup-key local-function-key-map tkey)) (cl-loop for map in maps for b = (lookup-key map fkey) @@ -507,7 +506,7 @@ doubt, use whitespace." (> first 32) (<= first maxkey) (/= first 92) (progn (if (> text 30) (setq text 30)) - (setq desc (concat (edmacro-subseq rest-mac 0 text))) + (setq desc (concat (cl-subseq rest-mac 0 text))) (when (string-match "^[ACHMsS]-." desc) (setq text 2) (cl-callf substring desc 0 2)) @@ -524,7 +523,7 @@ doubt, use whitespace." (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn - (setq desc (concat (edmacro-subseq rest-mac bind-len text))) + (setq desc (concat (cl-subseq rest-mac bind-len text))) (commandp (intern-soft desc)))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) @@ -562,14 +561,14 @@ doubt, use whitespace." (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) (unless (string-match " " desc) (let ((times 1) (pos bind-len)) - (while (not (edmacro-mismatch rest-mac rest-mac + (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (cl-incf times) (cl-incf pos bind-len)) (when (> times 1) (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))) - (setq rest-mac (edmacro-subseq rest-mac bind-len)) + (setq rest-mac (cl-subseq rest-mac bind-len)) (if verbose (progn (unless (equal res "") (cl-callf concat res "\n")) @@ -590,50 +589,6 @@ doubt, use whitespace." (cl-incf len (length desc))))) res)) -(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) - "Compare SEQ1 with SEQ2, return index of first mismatching element. -Return nil if the sequences match. If one sequence is a prefix of the -other, the return value indicates the end of the shorted sequence. -\n(fn SEQ1 SEQ2 START1 END1 START2 END2)" - (or cl-end1 (setq cl-end1 (length cl-seq1))) - (or cl-end2 (setq cl-end2 (length cl-seq2))) - (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) - (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) - (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) - (eql (if cl-p1 (car cl-p1) - (aref cl-seq1 cl-start1)) - (if cl-p2 (car cl-p2) - (aref cl-seq2 cl-start2)))) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) - cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) - (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) - cl-start1))) - -(defun edmacro-subseq (seq start &optional end) - "Return the subsequence of SEQ from START to END. -If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end." - (if (stringp seq) (substring seq start end) - (let (len) - (and end (< end 0) (setq end (+ end (setq len (length seq))))) - (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) (setq seq (nthcdr start seq))) - (if end - (let ((res nil)) - (while (>= (setq end (1- end)) start) - (push (pop seq) res)) - (nreverse res)) - (copy-sequence seq))) - (t - (or end (setq end (or len (length seq)))) - (let ((res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) start (1+ start))) - res)))))) - (defun edmacro-sanitize-for-string (seq) "Convert a key sequence vector SEQ into a string. The string represents the same events; Meta is indicated by bit 7. @@ -760,7 +715,7 @@ This function assumes that the events can be stored in a string." (eq (aref res 1) ?\() (eq (aref res (- (length res) 2)) ?\C-x) (eq (aref res (- (length res) 1)) ?\))) - (setq res (edmacro-subseq res 2 -2))) + (setq res (cl-subseq res 2 -2))) (if (and (not need-vector) (cl-loop for ch across res always (and (characterp ch) diff --git a/lisp/emacs-lisp/.gitignore b/lisp/emacs-lisp/.gitignore deleted file mode 100644 index 133e79e817a..00000000000 --- a/lisp/emacs-lisp/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -!*-loaddefs.el - diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3cf744f1245..c47c9b61030 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1957,7 +1957,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). "Collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This -is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to +is analogous to the Common Lisp `multiple-value-bind' macro, using lists to simulate true multiple return values. For compatibility, (cl-values A B C) is a synonym for (list A B C). @@ -1975,7 +1975,7 @@ a synonym for (list A B C). "Collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp -`cl-multiple-value-setq' macro, using lists to simulate true multiple return +`multiple-value-setq' macro, using lists to simulate true multiple return values. For compatibility, (cl-values A B C) is a synonym for (list A B C). \(fn (SYM...) FORM)" @@ -2002,7 +2002,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (cons 'progn body)) ;;;###autoload (defmacro cl-the (_type form) - "At present this ignores _TYPE and is simply equivalent to FORM." + "At present this ignores TYPE and is simply equivalent to FORM." (declare (indent 1) (debug (cl-type-spec form))) form) @@ -2059,7 +2059,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). "Declare SPECS about the current function while compiling. For instance - \(cl-declare (warn 0)) + (cl-declare (warn 0)) will turn off byte-compile warnings in the function. See Info node `(cl)Declarations' for details." @@ -2279,8 +2279,8 @@ KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where SDEFAULT is the default value of that slot and SOPTIONS are keyword-value pairs for that slot. -Currently, only one keyword is supported, `:read-only'. If this has a non-nil -value, that slot cannot be set via `setf'. +Currently, only one keyword is supported, `:read-only'. If this has a +non-nil value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" (declare (doc-string 2) (indent 1) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 319af588eac..36c72f3a3bd 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -53,7 +53,7 @@ ;;; Code: (require 'macroexp) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (eval-when-compile (require 'pcase)) ;;; Options @@ -263,26 +263,6 @@ An extant spec symbol is a symbol that is not a function and has a ;;; Utilities -;; Define edebug-gensym - from old cl.el -(defvar edebug-gensym-index 0 - "Integer used by `edebug-gensym' to produce new names.") - -(defun edebug-gensym (&optional prefix) - "Generate a fresh uninterned symbol. -There is an optional argument, PREFIX. PREFIX is the string -that begins the new name. Most people take just the default, -except when debugging needs suggest otherwise." - (if (null prefix) - (setq prefix "G")) - (let ((newsymbol nil) - (newname "")) - (while (not newsymbol) - (setq newname (concat prefix (int-to-string edebug-gensym-index))) - (setq edebug-gensym-index (+ edebug-gensym-index 1)) - (if (not (intern-soft newname)) - (setq newsymbol (make-symbol newname)))) - newsymbol)) - (defun edebug-lambda-list-keywordp (object) "Return t if OBJECT is a lambda list keyword. A lambda list keyword is a symbol that starts with `&'." @@ -1186,7 +1166,7 @@ Maybe clear the markers and delete the symbol's edebug property?" ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. ;; Do this after parsing since that may find a name. (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) + (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) `(edebug-enter (quote ,edebug-def-name) ,(if edebug-inside-func @@ -1299,7 +1279,7 @@ expressions; a `progn' form will be returned enclosing these forms." ;; Set the name here if it was not set by edebug-make-enter-wrapper. (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) + (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) ;; Add this def as a dependent of containing def. Buggy. '(if (and edebug-containing-def-name diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 656cb0a6a14..1f5edefea08 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -54,7 +54,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'button) (require 'debug) (require 'easymenu) @@ -87,127 +87,6 @@ ;;; Copies/reimplementations of cl functions. -(defun ert--cl-do-remf (plist tag) - "Copy of `cl-do-remf'. Modify PLIST by removing TAG." - (let ((p (cdr plist))) - (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) - (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) - -(defun ert--remprop (sym tag) - "Copy of `cl-remprop'. Modify SYM's plist by removing TAG." - (let ((plist (symbol-plist sym))) - (if (and plist (eq tag (car plist))) - (progn (setplist sym (cdr (cdr plist))) t) - (ert--cl-do-remf plist tag)))) - -(defun ert--remove-if-not (ert-pred ert-list) - "A reimplementation of `remove-if-not'. - -ERT-PRED is a predicate, ERT-LIST is the input list." - (cl-loop for ert-x in ert-list - if (funcall ert-pred ert-x) - collect ert-x)) - -(defun ert--intersection (a b) - "A reimplementation of `intersection'. Intersect the sets A and B. - -Elements are compared using `eql'." - (cl-loop for x in a - if (memql x b) - collect x)) - -(defun ert--set-difference (a b) - "A reimplementation of `set-difference'. Subtract the set B from the set A. - -Elements are compared using `eql'." - (cl-loop for x in a - unless (memql x b) - collect x)) - -(defun ert--set-difference-eq (a b) - "A reimplementation of `set-difference'. Subtract the set B from the set A. - -Elements are compared using `eq'." - (cl-loop for x in a - unless (memq x b) - collect x)) - -(defun ert--union (a b) - "A reimplementation of `union'. Compute the union of the sets A and B. - -Elements are compared using `eql'." - (append a (ert--set-difference b a))) - -(eval-and-compile - (defvar ert--gensym-counter 0)) - -(eval-and-compile - (defun ert--gensym (&optional prefix) - "Only allows string PREFIX, not compatible with CL." - (unless prefix (setq prefix "G")) - (make-symbol (format "%s%s" - prefix - (prog1 ert--gensym-counter - (cl-incf ert--gensym-counter)))))) - -(defun ert--coerce-to-vector (x) - "Coerce X to a vector." - (when (char-table-p x) (error "Not supported")) - (if (vectorp x) - x - (vconcat x))) - -(cl-defun ert--remove* (x list &key key test) - "Does not support all the keywords of remove*." - (unless key (setq key #'identity)) - (unless test (setq test #'eql)) - (cl-loop for y in list - unless (funcall test x (funcall key y)) - collect y)) - -(defun ert--string-position (c s) - "Return the position of the first occurrence of C in S, or nil if none." - (cl-loop for i from 0 - for x across s - when (eql x c) return i)) - -(defun ert--mismatch (a b) - "Return index of first element that differs between A and B. - -Like `mismatch'. Uses `equal' for comparison." - (cond ((or (listp a) (listp b)) - (ert--mismatch (ert--coerce-to-vector a) - (ert--coerce-to-vector b))) - ((> (length a) (length b)) - (ert--mismatch b a)) - (t - (let ((la (length a)) - (lb (length b))) - (cl-assert (arrayp a) t) - (cl-assert (arrayp b) t) - (cl-assert (<= la lb) t) - (cl-loop for i below la - when (not (equal (aref a i) (aref b i))) return i - finally (cl-return (if (/= la lb) - la - (cl-assert (equal a b) t) - nil))))))) - -(defun ert--subseq (seq start &optional end) - "Return a subsequence of SEQ from START to END." - (when (char-table-p seq) (error "Not supported")) - (let ((vector (substring (ert--coerce-to-vector seq) start end))) - (cl-etypecase seq - (vector vector) - (string (concat vector)) - (list (append vector nil)) - (bool-vector (cl-loop with result - = (make-bool-vector (length vector) nil) - for i below (length vector) do - (setf (aref result i) (aref vector i)) - finally (cl-return result))) - (char-table (cl-assert nil))))) - (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. @@ -258,7 +137,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." (defun ert-make-test-unbound (symbol) "Make SYMBOL name no test. Return SYMBOL." - (ert--remprop symbol 'ert--test) + (cl-remprop symbol 'ert--test) symbol) (defun ert--parse-keys-and-body (keys-and-body) @@ -396,8 +275,8 @@ DATA is displayed to the user and should state the reason of the failure." cl-macro-environment))))) (cond ((or (atom form) (ert--special-operator-p (car form))) - (let ((value (ert--gensym "value-"))) - `(let ((,value (ert--gensym "ert-form-evaluation-aborted-"))) + (let ((value (cl-gensym "value-"))) + `(let ((,value (cl-gensym "ert-form-evaluation-aborted-"))) ,(funcall inner-expander `(setq ,value ,form) `(list ',whole :form ',form :value ,value) @@ -410,10 +289,10 @@ DATA is displayed to the user and should state the reason of the failure." (and (consp fn-name) (eql (car fn-name) 'lambda) (listp (cdr fn-name))))) - (let ((fn (ert--gensym "fn-")) - (args (ert--gensym "args-")) - (value (ert--gensym "value-")) - (default-value (ert--gensym "ert-form-evaluation-aborted-"))) + (let ((fn (cl-gensym "fn-")) + (args (cl-gensym "args-")) + (value (cl-gensym "value-")) + (default-value (cl-gensym "ert-form-evaluation-aborted-"))) `(let ((,fn (function ,fn-name)) (,args (list ,@arg-forms))) (let ((,value ',default-value)) @@ -450,7 +329,7 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM." (ert--expand-should-1 whole form (lambda (inner-form form-description-form value-var) - (let ((form-description (ert--gensym "form-description-"))) + (let ((form-description (cl-gensym "form-description-"))) `(let (,form-description) ,(funcall inner-expander `(unwind-protect @@ -491,7 +370,7 @@ and aborts the current test as failed if it doesn't." (list type) (symbol (list type))))) (cl-assert signaled-conditions) - (unless (ert--intersection signaled-conditions handled-conditions) + (unless (cl-intersection signaled-conditions handled-conditions) (ert-fail (append (funcall form-description-fn) (list @@ -528,8 +407,8 @@ failed." `(should-error ,form ,@keys) form (lambda (inner-form form-description-form value-var) - (let ((errorp (ert--gensym "errorp")) - (form-description-fn (ert--gensym "form-description-fn-"))) + (let ((errorp (cl-gensym "errorp")) + (form-description-fn (cl-gensym "form-description-fn-"))) `(let ((,errorp nil) (,form-description-fn (lambda () ,form-description-form))) (condition-case -condition- @@ -591,7 +470,7 @@ Returns nil if they are." `(proper-lists-of-different-length ,(length a) ,(length b) ,a ,b first-mismatch-at - ,(ert--mismatch a b)) + ,(cl-mismatch a b :test 'equal)) (cl-loop for i from 0 for ai in a for bi in b @@ -611,7 +490,7 @@ Returns nil if they are." ,a ,b ,@(unless (char-table-p a) `(first-mismatch-at - ,(ert--mismatch a b)))) + ,(cl-mismatch a b :test 'equal)))) (cl-loop for i from 0 for ai across a for bi across b @@ -656,8 +535,8 @@ key/value pairs in each list does not matter." ;; work, so let's punt on it for now. (let* ((keys-a (ert--significant-plist-keys a)) (keys-b (ert--significant-plist-keys b)) - (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) - (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) + (keys-in-a-not-in-b (cl-set-difference keys-a keys-b :test 'eq)) + (keys-in-b-not-in-a (cl-set-difference keys-b keys-a :test 'eq))) (cl-flet ((explain-with-key (key) (let ((value-a (plist-get a key)) (value-b (plist-get b key))) @@ -1090,7 +969,7 @@ contained in UNIVERSE." (cl-etypecase universe ((member t) (mapcar #'ert-get-test (apropos-internal selector #'ert-test-boundp))) - (list (ert--remove-if-not (lambda (test) + (list (cl-remove-if-not (lambda (test) (and (ert-test-name test) (string-match selector (ert-test-name test)))) @@ -1123,13 +1002,13 @@ contained in UNIVERSE." (not (cl-assert (eql (length operands) 1)) (let ((all-tests (ert-select-tests 't universe))) - (ert--set-difference all-tests + (cl-set-difference all-tests (ert-select-tests (car operands) all-tests)))) (or (cl-case (length operands) (0 (ert-select-tests 'nil universe)) - (t (ert--union (ert-select-tests (car operands) universe) + (t (cl-union (ert-select-tests (car operands) universe) (ert-select-tests `(or ,@(cdr operands)) universe))))) (tag @@ -1141,7 +1020,7 @@ contained in UNIVERSE." universe))) (satisfies (cl-assert (eql (length operands) 1)) - (ert--remove-if-not (car operands) + (cl-remove-if-not (car operands) (ert-select-tests 't universe)))))))) (defun ert--insert-human-readable-selector (selector) @@ -1285,7 +1164,7 @@ Also changes the counters in STATS to match." "Create a new `ert--stats' object for running TESTS. SELECTOR is the selector that was used to select TESTS." - (setq tests (ert--coerce-to-vector tests)) + (setq tests (cl-coerce tests 'vector)) (let ((map (make-hash-table :size (length tests)))) (cl-loop for i from 0 for test across tests @@ -1548,10 +1427,10 @@ This can be used as an inverse of `add-to-list'." (unless key (setq key #'identity)) (unless test (setq test #'equal)) (setf (symbol-value list-var) - (ert--remove* element - (symbol-value list-var) - :key key - :test test))) + (cl-remove element + (symbol-value list-var) + :key key + :test test))) ;;; Some basic interactive functions. @@ -1810,7 +1689,7 @@ BEGIN and END specify a region in the current buffer." "Return the first line of S, or S if it contains no newlines. The return value does not include the line terminator." - (substring s 0 (ert--string-position ?\n s))) + (substring s 0 (cl-position ?\n s))) (defun ert-face-for-test-result (expectedp) "Return a face that shows whether a test result was expected or unexpected. diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 1919d47687b..56bfe04f9ce 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -131,8 +131,9 @@ Returns the number of actions taken." (unwind-protect (progn (if (stringp prompter) - (setq prompter (lambda (object) - (format prompter object)))) + (setq prompter (let ((prompter prompter)) + (lambda (object) + (format prompter object))))) (while (funcall next) (setq prompt (funcall prompter elt)) (cond ((stringp prompt) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e000c343721..511f1480099 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -482,12 +482,19 @@ MATCH is the pattern that needs to be matched, of the form: all)) '(:pcase--succeed . nil)))) -(defun pcase--split-pred (upat pat) - ;; FIXME: For predicates like (pred (> a)), two such predicates may - ;; actually refer to different variables `a'. +(defun pcase--split-pred (vars upat pat) (let (test) (cond - ((equal upat pat) '(:pcase--succeed . :pcase--fail)) + ((and (equal upat pat) + ;; For predicates like (pred (> a)), two such predicates may + ;; actually refer to different variables `a'. + (or (and (eq 'pred (car upat)) (symbolp (cadr upat))) + ;; FIXME: `vars' gives us the environment in which `upat' will + ;; run, but we don't have the environment in which `pat' will + ;; run, so we can't do a reliable verification. But let's try + ;; and catch at least the easy cases such as (bug#14773). + (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) + '(:pcase--succeed . :pcase--fail)) ((and (eq 'pred (car upat)) (eq 'pred (car-safe pat)) (or (member (cons (cadr upat) (cadr pat)) @@ -589,7 +596,7 @@ Otherwise, it defers to REST which is a list of branches of the form (if (eq (car upat) 'pred) (pcase--mark-used sym)) (let* ((splitrest (pcase--split-rest - sym (lambda (pat) (pcase--split-pred upat pat)) rest)) + sym (lambda (pat) (pcase--split-pred vars upat pat)) rest)) (then-rest (car splitrest)) (else-rest (cdr splitrest))) (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index e7b371365e4..c39d896f3d3 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -996,93 +996,7 @@ as a Meta key and any number of multiple escapes are allowed." (suspend-emacs)) (viper-change-state-to-emacs))) - -;; Intercept ESC sequences on dumb terminals. -;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es> - -;; Check if last key was ESC and if so try to reread it as a function key. -;; But only if there are characters to read during a very short time. -;; Returns the last event, if any. -(defun viper-envelop-ESC-key () - (let ((event last-input-event) - (keyseq [nil]) - (inhibit-quit t)) - (if (viper-ESC-event-p event) - (progn - ;; Some versions of Emacs (eg., 22.50.8 (?)) have a bug, which makes - ;; even a single ESC into a fast keyseq. To guard against this, we - ;; added a check if there are other events as well. Keep the next - ;; line for the next time the bug reappears, so that will remember to - ;; report it. - ;;(if (and (viper-fast-keysequence-p) unread-command-events) - (if (viper-fast-keysequence-p) ;; for Emacsen without the above bug - (progn - (let (minor-mode-map-alist emulation-mode-map-alists) - (viper-set-unread-command-events event) - (setq keyseq (read-key-sequence nil 'continue-echo)) - ) ; let - ;; If keyseq translates into something that still has ESC - ;; at the beginning, separate ESC from the rest of the seq. - ;; In XEmacs we check for events that are keypress meta-key - ;; and convert them into [escape key] - ;; - ;; This is needed for the following reason: - ;; If ESC is the first symbol, we interpret it as if the - ;; user typed ESC and then quickly some other symbols. - ;; If ESC is not the first one, then the key sequence - ;; entered was apparently translated into a function key or - ;; something (e.g., one may have - ;; (define-key function-key-map "\e[192z" [f11]) - ;; which would translate the escape-sequence generated by - ;; f11 in an xterm window into the symbolic key f11. - ;; - ;; If `first-key' is not an ESC event, we make it into the - ;; last-command-event in order to pretend that this key was - ;; pressed. This is needed to allow arrow keys to be bound to - ;; macros. Otherwise, viper-exec-mapped-kbd-macro will think - ;; that the last event was ESC and so it'll execute whatever is - ;; bound to ESC. (Viper macros can't be bound to - ;; ESC-sequences). - (let* ((first-key (elt keyseq 0)) - (key-mod (event-modifiers first-key))) - (cond ((and (viper-ESC-event-p first-key) - (not (viper-translate-all-ESC-keysequences))) - ;; put keys following ESC on the unread list - ;; and return ESC as the key-sequence - (viper-set-unread-command-events (viper-subseq keyseq 1)) - (setq last-input-event event - keyseq (if (featurep 'emacs) - "\e" - (vector (character-to-event ?\e))))) - ((and (featurep 'xemacs) - (key-press-event-p first-key) - (equal '(meta) key-mod)) - (viper-set-unread-command-events - (vconcat (vector - (character-to-event (event-key first-key))) - (viper-subseq keyseq 1))) - (setq last-input-event event - keyseq (vector (character-to-event ?\e)))) - ((eventp first-key) - (setq last-command-event - (viper-copy-event first-key))) - )) - ) ; end progn - - ;; this is escape event with nothing after it - ;; put in unread-command-event and then re-read - (viper-set-unread-command-events event) - (setq keyseq (read-key-sequence nil)) - )) - ;; not an escape event - (setq keyseq (vector event))) - keyseq)) - - - ;; Listen to ESC key. -;; If a sequence of keys starting with ESC is issued with very short delays, -;; interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key. (defun viper-intercept-ESC-key () "Function that implements ESC key in Viper emulation of Vi." (interactive) @@ -1090,13 +1004,7 @@ as a Meta key and any number of multiple escapes are allowed." ;; minor-mode map(s) have been temporarily disabled so the ESC ;; binding to viper-intercept-ESC-key doesn't hide the binding we're ;; looking for (Bug#9146): - (let* ((event (viper-envelop-ESC-key)) - (cmd (cond ((equal event viper-ESC-key) - 'viper-intercept-ESC-key) - ((let ((emulation-mode-map-alists nil)) - (key-binding event))) - (t - (error "Viper bell"))))) + (let* ((cmd 'viper-intercept-ESC-key)) ;; call the actual function to execute ESC (if no other symbols followed) ;; or the key bound to the ESC sequence (if the sequence was issued @@ -4289,6 +4197,11 @@ cursor move past the beginning of line." (t (backward-char 1)))) +(defun viper-del-forward-char-in-insert () + "Delete 1 char forward if in insert or replace state." + (interactive) + ;; don't put on kill ring + (delete-char 1 nil)) ;; join lines. @@ -4947,7 +4860,7 @@ Please, specify your level now: ") (interactive) (if (< viper-expert-level 2) (save-buffers-kill-emacs) - (save-buffer) + (if (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer)))) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 0d9d300ab1a..d33b5f4ed58 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -192,7 +192,7 @@ Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]." :type 'string :group 'viper) -(defvar viper-ESC-key (kbd "ESC") +(defconst viper-ESC-key [escape] "Key used to ESC.") diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 7f432cdc143..266af1abf2b 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -14,7 +14,7 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst viper-version "3.14.1 of August 15, 2009" +(defconst viper-version "3.14.2 of July 4, 2013" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -411,6 +411,7 @@ widget." dired-mode efs-mode tar-mode + egg-status-buffer-mode browse-kill-ring-mode recentf-mode @@ -660,7 +661,7 @@ user customization, unrelated to Viper. For instance, if the user advised undone. It also can't undo some Viper settings." (interactive) - + (viper-setup-ESC-to-escape nil) ;; restore non-viper vars (setq-default next-line-add-newlines @@ -825,6 +826,58 @@ It also can't undo some Viper settings." (add-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode t)) +;;; Handling of tty's ESC event + +;; On a tty, an ESC event can either be the user hitting the escape key, or +;; some element of a byte sequence used to encode for example cursor keys. +;; So we try to recognize those events that correspond to the escape key and +;; turn them into `escape' events (same as used under GUIs). The heuristic we +;; use to distinguish the two cases is based, as usual, on a timeout, and on +;; the fact that the special ESC=>escape mapping only takes place if the whole +;; last key-sequence so far is just [?\e], i.e. either we're still in +;; read-key-sequence, or the last read-key-sequence only read [?\e], which +;; should ideally never happen because it should have been mapped to [escape]. + +(defun viper--tty-ESC-filter (map) + (if (and (equal (this-single-command-keys) [?\e]) + (sit-for (/ viper-fast-keyseq-timeout 1000))) + [escape] map)) + +(defun viper--lookup-key (map key) + "Kind of like `lookup-key'. +Two differences: +- KEY is a single key, not a sequence. +- the result is the \"raw\" binding, so it can be a `menu-item', rather than the + binding contained in that menu item." + (catch 'found + (map-keymap (lambda (k b) (if (equal key k) (throw 'found b))) map))) + +(defun viper-catch-tty-ESC () + "Setup key mappings of current terminal to turn a tty's ESC into `escape'." + (when (memq (terminal-live-p (frame-terminal)) '(t pc)) + (let ((esc-binding (viper-uncatch-tty-ESC))) + (define-key input-decode-map + [?\e] `(menu-item "" ,esc-binding :filter viper--tty-ESC-filter))))) + +(defun viper-uncatch-tty-ESC () + "Don't hack ESC into `escape' any more." + (let ((b (viper--lookup-key input-decode-map ?\e))) + (and (eq 'menu-item (car-safe b)) + (eq 'viper--tty-ESC-filter (nth 4 b)) + (define-key input-decode-map [?\e] (setq b (nth 2 b)))) + b)) + +(defun viper-setup-ESC-to-escape (enable) + (if enable + (add-hook 'tty-setup-hook 'viper-catch-tty-ESC) + (remove-hook 'tty-setup-hook 'viper-catch-tty-ESC)) + (let ((seen ())) + (dolist (frame (frame-list)) + (let ((terminal (frame-terminal frame))) + (unless (memq terminal seen) + (push terminal seen) + (with-selected-frame frame + (if enable (viper-catch-tty-ESC) (viper-uncatch-tty-ESC)))))))) ;; This sets major mode hooks to make them come up in vi-state. (defun viper-set-hooks () @@ -837,6 +890,8 @@ It also can't undo some Viper settings." (if (eq (default-value 'major-mode) 'fundamental-mode) (setq-default major-mode 'viper-mode)) + (viper-setup-ESC-to-escape t) + (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) (add-hook 'find-file-hooks 'set-viper-state-in-major-mode) @@ -847,13 +902,6 @@ It also can't undo some Viper settings." (defvar emerge-startup-hook) (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs) - ;; Zap bad bindings in flyspell-mouse-map, which prevent ESC from working - ;; over misspelled words (due to the overlay keymaps) - (defvar flyspell-mode-hook) - (defvar flyspell-mouse-map) - (add-hook 'flyspell-mode-hook - (lambda () - (define-key flyspell-mouse-map viper-ESC-key nil))) ;; if viper is started from .emacs, it might be impossible to get certain ;; info about the display and windows until emacs initialization is complete ;; So do it via the window-setup-hook diff --git a/lisp/faces.el b/lisp/faces.el index 0a3f0551325..9a34aec2549 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2097,6 +2097,10 @@ the above example." nil)))) type) +(defvar tty-setup-hook nil + "Hook run after running the initialization function of a new text terminal. +This can be used to fine tune the `input-decode-map', for example.") + (defun tty-run-terminal-initialization (frame &optional type) "Run the special initialization code for the terminal type of FRAME. The optional TYPE parameter may be used to override the autodetected @@ -2122,7 +2126,8 @@ terminal type to a different value." type) (when (fboundp term-init-func) (funcall term-init-func)) - (set-terminal-parameter frame 'terminal-initted term-init-func))))) + (set-terminal-parameter frame 'terminal-initted term-init-func) + (run-hooks 'tty-setup-hook))))) ;; Called from C function init_display to initialize faces of the ;; dumped terminal frame on startup. diff --git a/lisp/files.el b/lisp/files.el index 9b56dfa9693..ff4ccec2279 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -316,6 +316,7 @@ A value of nil means don't add newlines. Certain major modes set this locally to the value obtained from `mode-require-final-newline'." + :safe #'symbolp :type '(choice (const :tag "When visiting" visit) (const :tag "When saving" t) (const :tag "When visiting or saving" visit-save) @@ -4916,6 +4917,11 @@ change the additional actions you can take on files." (length autosaved-buffers) (mapconcat 'identity autosaved-buffers ", ")))))))) +(defun clear-visited-file-modtime () + "Clear out records of last mod time of visited file. +Next attempt to save will certainly not complain of a discrepancy." + (set-visited-file-modtime 0)) + (defun not-modified (&optional arg) "Mark current buffer as unmodified, not needing to be saved. With prefix ARG, mark buffer as modified, so \\[save-buffer] will save. diff --git a/lisp/filesets.el b/lisp/filesets.el index 978512bd3a4..fbf28dbecbc 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -149,7 +149,7 @@ is loaded before custom.el, set this variable to t.") (defun filesets-filter-list (lst cond-fn) "Remove all elements not conforming to COND-FN from list LST. COND-FN takes one argument: the current element." -; (remove* 'dummy lst :test (lambda (dummy elt) +; (cl-remove 'dummy lst :test (lambda (dummy elt) ; (not (funcall cond-fn elt))))) (let ((rv nil)) (dolist (elt lst rv) @@ -175,7 +175,7 @@ Like `some', return the first value of FSS-PRED that is non-nil." (let ((fss-rv (funcall fss-pred fss-this))) (when fss-rv (throw 'exit fss-rv)))))) -;(fset 'filesets-some 'some) ;; or use the cl function +;(fset 'filesets-some 'cl-some) ;; or use the cl function (defun filesets-member (fsm-item fsm-lst &rest fsm-keys) "Find the first occurrence of FSM-ITEM in FSM-LST. @@ -186,7 +186,7 @@ key is supported." (filesets-ormap (lambda (fsm-this) (funcall fsm-test fsm-item fsm-this)) fsm-lst))) -;(fset 'filesets-member 'member*) ;; or use the cl function +;(fset 'filesets-member 'cl-member) ;; or use the cl function (defun filesets-sublist (lst beg &optional end) "Get the sublist of LST from BEG to END - 1." diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 34eb28f0965..006b415b180 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,47 @@ +2013-07-10 David Engster <deng@randomsample.de> + + * gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks + if `gnus-newsrc-file-version' does not match `gnus-version'. This + fixes a bug in Emacs trunk where the 'unexist' marks were always + removed at startup because "Gnus v5.13" was considered smaller than "Ma + Gnus v0.03". + +2013-07-10 Tassilo Horn <tsdh@gnu.org> + + * gnus.el (gnus-summary-line-format): Reference + `gnus-user-date-format-alist' for the &user-date; format, not + `gnus-summary-user-date-format-alist'. + +2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnml.el (nnml-request-compact-group): Don't bug out if we can't + delete files (bug#13481). + +2013-07-08 Tassilo Horn <tsdh@gnu.org> + + * gnus-registry.el (gnus-registry-remove-extra-data): New function. + +2013-07-06 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-block-private-groups): Allow `global' methods to + display images. + + * gnus.el (gnus-valid-select-methods): Mark nnrss as global. + + * message.el (message-cancel-news): According to + <mailman.216.1372942181.12400.help-gnu-emacs@gnu.org>, "cancel" is + preferred over "cmsg cancel" in the Subject. + + * nnir.el (nnir-engines): Note that the group specs are regexps + (bug#13238). + + * gnus-msg.el (gnus-copy-article-buffer): If the article buffer has + gotten read-only text properties, ensure that those aren't heeded when + copying stuff over (bug#13434). + + * mm-view.el (mm-inline-text-html): Don't bug out on multipart messages + (bug#13762). + 2013-07-05 David Kastrup <dak@gnu.org> * auth-source.el (auth-source-netrc-parse-one): Allow empty strings in diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5840aacd7a3..b41ff9c0550 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6947,7 +6947,8 @@ If given a prefix, show the hidden text instead." (set-buffer buf)))))) (defun gnus-block-private-groups (group) - (if (gnus-news-group-p group) + (if (or (gnus-news-group-p group) + (gnus-member-of-valid 'global group)) ;; Block nothing in news groups. nil ;; Block everything anywhere else. diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index fce9a3633c2..e3f18662af4 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -920,6 +920,7 @@ header line with the old Message-ID." (with-current-buffer article-buffer (let ((gnus-newsgroup-charset (or gnus-article-charset gnus-newsgroup-charset)) + (inhibit-read-only t) (gnus-newsgroup-ignored-charsets (or gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets))) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 5a7dfd82d28..6f2fe78c3d8 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1186,6 +1186,29 @@ data stored in the registry." (gnus-select-group-with-message-id group message-id) t) (throw 'found t)))))))) +(defun gnus-registry-remove-extra-data (extra) + "Remove tracked EXTRA data from the gnus registry. +EXTRA is a list of symbols. Valid symbols are those contained in +the docs of `gnus-registry-track-extra'. This command is useful +when you stop tracking some extra data and now want to purge it +from your existing entries." + (interactive (list (mapcar 'intern + (completing-read-multiple + "Extra data: " + '("subject" "sender" "recipient"))))) + (when extra + (let ((db gnus-registry-db)) + (registry-reindex db) + (loop for k being the hash-keys of (oref db :data) + using (hash-value v) + do (let ((newv (delq nil (mapcar #'(lambda (entry) + (unless (member (car entry) extra) + entry)) + v)))) + (registry-delete db (list k) nil) + (gnus-registry-insert db k newv))) + (registry-reindex db)))) + ;; TODO: a few things (provide 'gnus-registry) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 084af884930..94803800e0b 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2314,8 +2314,9 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-info-set-marks info (delete exist (gnus-info-marks info)))))) (when (or force - (< (gnus-continuum-version gnus-newsrc-file-version) - (gnus-continuum-version "Ma Gnus v0.03"))) + (not (string= gnus-newsrc-file-version gnus-version))) + (message (concat "Removing unexist marks because newsrc " + "version does not match Gnus version.")) ;; Remove old `exist' marks from old nnimap groups. (dolist (info (cdr gnus-newsrc-alist)) (let ((exist (assoc 'unexist (gnus-info-marks info)))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 9a927a1cfab..8741a03b54d 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1628,7 +1628,7 @@ slower." ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) - ("nnrss" none) + ("nnrss" none global) ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address respool server-marks) @@ -3007,7 +3007,7 @@ with some simple extensions. summary just like information from any other summary specifier. &user-date; Age sensitive date format. Various date format is - defined in `gnus-summary-user-date-format-alist'. + defined in `gnus-user-date-format-alist'. The %U (status), %R (replied) and %z (zcore) specs have to be handled diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c6f5d904677..b35eb9dca12 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -7145,7 +7145,7 @@ If ARG, allow editing of the cancellation message." (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "From: " from "\n" - "Subject: cmsg cancel " message-id "\n" + "Subject: cancel " message-id "\n" "Control: cancel " message-id "\n" (if distribution (concat "Distribution: " distribution "\n") diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index b1cba27c335..9512a411d81 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -419,16 +419,18 @@ (buffer-string))))) (defun mm-inline-text-html (handle) - (let* ((func mm-text-html-renderer) - (entry (assq func mm-text-html-renderer-alist)) - (inhibit-read-only t)) - (if entry - (setq func (cdr entry))) - (cond - ((functionp func) - (funcall func handle)) - (t - (apply (car func) handle (cdr func)))))) + (if (stringp (car handle)) + (mapcar 'mm-inline-text-html (cdr handle)) + (let* ((func mm-text-html-renderer) + (entry (assq func mm-text-html-renderer-alist)) + (inhibit-read-only t)) + (if entry + (setq func (cdr entry))) + (cond + ((functionp func) + (funcall func handle)) + (t + (apply (car func) handle (cdr func))))))) (defun mm-inline-text-vcard (handle) (let ((inhibit-read-only t)) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 22dee30e8fa..4dd123bf2c7 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -548,15 +548,15 @@ that it is for notmuch, not Namazu." (gmane nnir-run-gmane ((gmane-author . "Gmane Author: "))) (swish++ nnir-run-swish++ - ((swish++-group . "Swish++ Group spec: "))) + ((swish++-group . "Swish++ Group spec (regexp): "))) (swish-e nnir-run-swish-e - ((swish-e-group . "Swish-e Group spec: "))) + ((swish-e-group . "Swish-e Group spec (regexp): "))) (namazu nnir-run-namazu ()) (notmuch nnir-run-notmuch ()) (hyrex nnir-run-hyrex - ((hyrex-group . "Hyrex Group spec: "))) + ((hyrex-group . "Hyrex Group spec (regexp): "))) (find-grep nnir-run-find-grep ((grep-options . "Grep options: ")))) "Alist of supported search engines. diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 64e1ee11977..05d0c902340 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -1094,7 +1094,10 @@ Use the nov database for the current group if available." (concat group ":" new-number-string))) ;; Save to the new file: (nnmail-write-region (point-min) (point-max) newfile)) - (funcall nnmail-delete-file-function oldfile)) + (condition-case () + (funcall nnmail-delete-file-function oldfile) + (file-error + (message "Couldn't delete %s" oldfile)))) ;; 2/ Update all marks for this article: ;; #### NOTE: it is possible that the new article number ;; #### already belongs to a range, whereas the corresponding diff --git a/lisp/ido.el b/lisp/ido.el index f695ec117f1..9c4e56544cb 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3461,8 +3461,14 @@ This is to make them appear as if they were \"virtual buffers\"." (setq ido-virtual-buffers nil) (let (name) (dolist (head recentf-list) - (and (setq name (file-name-nondirectory head)) - (null (get-file-buffer head)) + (setq name (file-name-nondirectory head)) + ;; In case HEAD is a directory with trailing /. See bug#14552. + (when (equal name "") + (setq name (file-name-nondirectory (directory-file-name head)))) + (when (equal name "") + (setq name head)) + (and (not (equal name "")) + (null (get-file-buffer head)) (not (assoc name ido-virtual-buffers)) (not (member name ido-temp-list)) (not (ido-ignore-item-p name ido-ignore-buffers)) @@ -4721,9 +4727,12 @@ Modified from `icomplete-completions'." ;;; Helper functions for other programs -(put 'dired-do-rename 'ido 'ignore) (put 'ibuffer-find-file 'ido 'find-file) +(put 'dired 'ido 'dir) (put 'dired-other-window 'ido 'dir) +;; See http://debbugs.gnu.org/11954 for reasons. +(put 'dired-do-copy 'ido 'ignore) +(put 'dired-do-rename 'ido 'ignore) ;;;###autoload (defun ido-read-buffer (prompt &optional default require-match) @@ -4754,9 +4763,7 @@ See `read-file-name' for additional parameters." (eq (get this-command 'ido) 'dir) (memq this-command ido-read-file-name-as-directory-commands)) (setq filename - (ido-read-directory-name prompt dir default-filename mustmatch initial)) - (if (eq ido-exit 'fallback) - (setq filename 'fallback))) + (ido-read-directory-name prompt dir default-filename mustmatch initial))) ((and (not (eq (get this-command 'ido) 'ignore)) (not (memq this-command ido-read-file-name-non-ido)) (or (null predicate) (eq predicate 'file-exists-p))) @@ -4776,7 +4783,15 @@ See `read-file-name' for additional parameters." (ido-find-literal nil)) (setq ido-exit nil) (setq filename - (ido-read-internal 'file prompt 'ido-file-history default-filename mustmatch initial)) + (ido-read-internal 'file prompt 'ido-file-history + (cond ; Bug#11861. + ((stringp default-filename) default-filename) + ((consp default-filename) (car default-filename)) + ((and (not default-filename) initial) + (expand-file-name initial dir)) + (buffer-file-name buffer-file-name)) + mustmatch initial)) + (setq dir ido-current-directory) ; See bug#1516. (cond ((eq ido-exit 'fallback) (setq filename 'fallback)) @@ -4808,12 +4823,21 @@ See `read-directory-name' for additional parameters." (ido-directory-too-big-p ido-current-directory))) (ido-work-directory-index -1) (ido-work-file-index -1)) - (setq filename - (ido-read-internal 'dir prompt 'ido-file-history default-dirname mustmatch initial)) - (if filename - (if (and (stringp filename) (string-equal filename ".")) - ido-current-directory - (concat ido-current-directory filename))))) + (setq filename (ido-read-internal + 'dir prompt 'ido-file-history + (or default-dirname ; Bug#11861. + (if initial + (expand-file-name initial ido-current-directory) + ido-current-directory)) + mustmatch initial)) + (cond + ((eq ido-exit 'fallback) + (let ((read-file-name-function nil)) + (run-hook-with-args 'ido-before-fallback-functions 'read-directory-name) + (read-directory-name prompt ido-current-directory + default-dirname mustmatch initial))) + ((equal filename ".") ido-current-directory) + (t (concat ido-current-directory filename))))) ;;;###autoload (defun ido-completing-read (prompt choices &optional _predicate require-match diff --git a/lisp/net/shr.el b/lisp/net/shr.el index bdc30bc9292..4506ede8722 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -145,6 +145,7 @@ cid: URL as the argument.") (define-key map [follow-link] 'mouse-face) (define-key map "I" 'shr-insert-image) (define-key map "w" 'shr-copy-url) + (define-key map "u" 'shr-copy-url) (define-key map "v" 'shr-browse-url) (define-key map "o" 'shr-save-contents) (define-key map "\r" 'shr-browse-url) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 4c6141fe42b..f7f570590c8 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -38,9 +38,11 @@ ;; ;; - localname is a string. This are temporary properties, which are ;; related to the file localname is referring to. Examples: -;; "file-exists-p" is t or nile, depending on the file existence, or +;; "file-exists-p" is t or nil, depending on the file existence, or ;; "file-attributes" caches the result of the function -;; `file-attributes'. +;; `file-attributes'. These entries have a timestamp, and they +;; expire after `remote-file-name-inhibit-cache' seconds if this +;; variable is set. ;; ;; - The key is a process. This are temporary properties related to ;; an open connection. Examples: "scripts" keeps shell script diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 6ba055b8bb8..c2fdc0491b6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1539,7 +1539,8 @@ connection if a previous connection has died for some reason." ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint" ;; file property. (with-timeout - (60 + ((or (tramp-get-method-parameter method 'tramp-connection-timeout) + tramp-connection-timeout) (if (zerop (length (tramp-file-name-user vec))) (tramp-error vec 'file-error diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d7316b8d2ea..281f497692d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -222,21 +222,24 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-login-program "su") (tramp-login-args (("-") ("%u"))) (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")))) + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("sudo" (tramp-login-program "sudo") (tramp-login-args (("-u" "%u") ("-s") ("-H") ("-p" "Password:"))) (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")))) + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("ksu" (tramp-login-program "ksu") (tramp-login-args (("%u") ("-q"))) (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")))) + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("krlogin" @@ -3752,12 +3755,16 @@ file exists and nonzero exit status otherwise." "Wait for shell prompt and barf if none appears. Looks at process PROC to see if a shell prompt appears in TIMEOUT seconds. If not, it produces an error message with the given ERROR-ARGS." - (unless - (tramp-wait-for-regexp - proc timeout - (format - "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) - (apply 'tramp-error-with-buffer nil proc 'file-error error-args))) + (let ((vec (tramp-get-connection-property proc "vector" nil))) + (condition-case err + (tramp-wait-for-regexp + proc timeout + (format + "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) + (error + (delete-process proc) + (apply 'tramp-error-with-buffer + (tramp-get-connection-buffer vec) vec 'file-error error-args))))) (defun tramp-open-connection-setup-interactive-shell (proc vec) "Set up an interactive shell. @@ -4332,9 +4339,6 @@ Gateway hops are already opened." ;; Result. target-alist)) -(defvar tramp-current-connection nil - "Last connection timestamp.") - (defun tramp-maybe-open-connection (vec) "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the @@ -4348,7 +4352,7 @@ connection if a previous connection has died for some reason." ;; If Tramp opens the same connection within a short time frame, ;; there is a problem. We shall signal this. (unless (or (and p (processp p) (memq (process-status p) '(run open))) - (not (equal (butlast (append vec nil)) + (not (equal (butlast (append vec nil) 2) (car tramp-current-connection))) (> (tramp-time-diff (current-time) (cdr tramp-current-connection)) @@ -4433,7 +4437,7 @@ connection if a previous connection has died for some reason." (set-process-sentinel p 'tramp-process-sentinel) (tramp-compat-set-process-query-on-exit-flag p nil) (setq tramp-current-connection - (cons (butlast (append vec nil)) (current-time)) + (cons (butlast (append vec nil) 2) (current-time)) tramp-current-host (system-name)) (tramp-message @@ -4441,8 +4445,8 @@ connection if a previous connection has died for some reason." ;; Check whether process is alive. (tramp-barf-if-no-shell-prompt - p 60 - "Couldn't find local shell prompt %s" tramp-encoding-shell) + p 10 + "Couldn't find local shell prompt for %s" tramp-encoding-shell) ;; Now do all the connections as specified. (while target-alist @@ -4460,6 +4464,9 @@ connection if a previous connection has died for some reason." (async-args (tramp-get-method-parameter l-method 'tramp-async-args)) + (connection-timeout + (tramp-get-method-parameter + l-method 'tramp-connection-timeout)) (gw-args (tramp-get-method-parameter l-method 'tramp-gw-args)) (gw (tramp-get-file-property hop "" "gateway" nil)) @@ -4542,7 +4549,8 @@ connection if a previous connection has died for some reason." (tramp-message vec 3 "Sending command `%s'" command) (tramp-send-command vec command t t) (tramp-process-actions - p vec pos tramp-actions-before-shell 60) + p vec pos tramp-actions-before-shell + (or connection-timeout tramp-connection-timeout)) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host)) ;; Next hop. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f114c681fb7..3513701d20e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -252,6 +252,11 @@ pair of the form (KEY VALUE). The following KEYs are defined: * `tramp-tmpdir' A directory on the remote host for temporary files. If not specified, \"/tmp\" is taken as default. + * `tramp-connection-timeout' + This is the maximum time to be spent for establishing a connection. + In general, the global default value shall be used, but for + some methods, like \"su\" or \"sudo\", a shorter timeout + might be desirable. What does all this mean? Well, you should specify `tramp-login-program' for all methods; this program is used to log in to the remote site. Then, @@ -1034,6 +1039,13 @@ opening a connection to a remote host." :group 'tramp :type '(choice (const nil) (const t) (const pty))) +(defcustom tramp-connection-timeout 60 + "Defines the max time to wait for establishing a connection (in seconds). +This can be overwritten for different connection types in `tramp-methods'." + :group 'tramp + :version "24.4" + :type 'integer) + (defcustom tramp-connection-min-time-diff 5 "Defines seconds between two consecutive connection attempts. This is necessary as self defense mechanism, in order to avoid @@ -1071,6 +1083,9 @@ means to use always cached values for the directory contents." (defvar tramp-current-host nil "Remote host for this *tramp* buffer.") +(defvar tramp-current-connection nil + "Last connection timestamp.") + ;;;###autoload (defconst tramp-completion-file-name-handler-alist '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) @@ -1464,10 +1479,6 @@ ARGS to actually emit the message (if applicable)." This variable is used to disable messages from `tramp-error'. The messages are visible anyway, because an error is raised.") -(defvar tramp-message-show-progress-reporter-message t - "Show Tramp progress reporter message in the minibuffer. -This variable is used to disable recursive progress reporter messages.") - (defsubst tramp-message (vec-or-proc level fmt-string &rest args) "Emit a message depending on verbosity level. VEC-OR-PROC identifies the Tramp buffer to use. It can be either a @@ -1536,23 +1547,32 @@ signal identifier to be raised, remaining args passed to If BUFFER is nil, show the connection buffer. Wait for 30\", or until an input event arrives. The other arguments are passed to `tramp-error'." (save-window-excursion - (unwind-protect - (apply 'tramp-error vec-or-proc signal fmt-string args) - (when (and vec-or-proc - tramp-message-show-message - (not (zerop tramp-verbose)) - (not (tramp-completion-mode-p))) - (let ((enable-recursive-minibuffers t)) - (pop-to-buffer - (or (and (bufferp buffer) buffer) - (and (processp vec-or-proc) (process-buffer vec-or-proc)) - (tramp-get-connection-buffer vec-or-proc))) - (when (string-equal fmt-string "Process died") - (message - "%s\n %s" - "Tramp failed to connect. If this happens repeatedly, try" - "`M-x tramp-cleanup-this-connection'")) - (sit-for 30)))))) + (let* ((buf (or (and (bufferp buffer) buffer) + (and (processp vec-or-proc) (process-buffer vec-or-proc)) + (and (vectorp vec-or-proc) + (tramp-get-connection-buffer vec-or-proc)))) + (vec (or (and (vectorp vec-or-proc) vec-or-proc) + (and buf (with-current-buffer buf + (tramp-dissect-file-name default-directory)))))) + (unwind-protect + (apply 'tramp-error vec-or-proc signal fmt-string args) + ;; Save exit. + (when (and buf + tramp-message-show-message + (not (zerop tramp-verbose)) + (not (tramp-completion-mode-p))) + (let ((enable-recursive-minibuffers t)) + ;; `tramp-error' does not show messages. So we must do it + ;; ourselves. + (message fmt-string args) + ;; Show buffer. + (pop-to-buffer buf) + (discard-input) + (sit-for 30))) + ;; Reset timestamp. It would be wrong after waiting for a while. + (when (equal (butlast (append vec nil) 2) + (car tramp-current-connection)) + (setcdr tramp-current-connection (current-time))))))) (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. @@ -1596,16 +1616,15 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (defmacro with-tramp-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. -If LEVEL does not fit for visible messages, or if this is a -nested call of the macro, there are only traces without a visible -progress reporter." +If LEVEL does not fit for visible messages, there are only traces +without a visible progress reporter." (declare (indent 3) (debug t)) - `(let (pr tm) + `(let ((result "failed") + pr tm) (tramp-message ,vec ,level "%s..." ,message) ;; We start a pulsing progress reporter after 3 seconds. Feature ;; introduced in Emacs 24.1. - (when (and tramp-message-show-progress-reporter-message - tramp-message-show-message + (when (and tramp-message-show-message ;; Display only when there is a minimum level. (<= ,level (min tramp-verbose 3))) (ignore-errors @@ -1613,14 +1632,11 @@ progress reporter." tm (when pr (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) (unwind-protect - ;; Execute the body. Suppress concurrent progress reporter - ;; messages. - (let ((tramp-message-show-progress-reporter-message - (and tramp-message-show-progress-reporter-message (not tm)))) - ,@body) + ;; Execute the body. + (prog1 (progn ,@body) (setq result "done")) ;; Stop progress reporter. (if tm (tramp-compat-funcall 'cancel-timer tm)) - (tramp-message ,vec ,level "%s...done" ,message)))) + (tramp-message ,vec ,level "%s...%s" ,message result)))) (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) @@ -3393,39 +3409,49 @@ The terminal type can be configured with `tramp-terminal-type'." PROC and VEC indicate the remote connection to be used. POS, if set, is the starting point of the region to be deleted in the connection buffer." - ;; Preserve message for `progress-reporter'. - (tramp-compat-with-temp-message "" - ;; Enable `auth-source' and `password-cache'. We must use - ;; tramp-current-* variables in case we have several hops. - (tramp-set-connection-property - (tramp-dissect-file-name - (tramp-make-tramp-file-name - tramp-current-method tramp-current-user tramp-current-host "")) - "first-password-request" t) - (save-restriction + ;; Enable `auth-source' and `password-cache'. We must use + ;; tramp-current-* variables in case we have several hops. + (tramp-set-connection-property + (tramp-dissect-file-name + (tramp-make-tramp-file-name + tramp-current-method tramp-current-user tramp-current-host "")) + "first-password-request" t) + (save-restriction + (with-tramp-progress-reporter + proc 3 "Waiting for prompts from remote shell" (let (exit) - (while (not exit) - (tramp-message proc 3 "Waiting for prompts from remote shell") - (setq exit - (catch 'tramp-action - (if timeout - (with-timeout (timeout) - (tramp-process-one-action proc vec actions)) + (if timeout + (with-timeout (timeout (setq exit 'timeout)) + (while (not exit) + (setq exit + (catch 'tramp-action + (tramp-process-one-action proc vec actions))))) + (while (not exit) + (setq exit + (catch 'tramp-action (tramp-process-one-action proc vec actions))))) (with-current-buffer (tramp-get-connection-buffer vec) (widen) (tramp-message vec 6 "\n%s" (buffer-string))) (unless (eq exit 'ok) (tramp-clear-passwd vec) + (delete-process proc) (tramp-error-with-buffer - nil vec 'file-error + (tramp-get-connection-buffer vec) vec 'file-error (cond ((eq exit 'permission-denied) "Permission denied") - ((eq exit 'process-died) "Process died") - (t "Login failed")))) - (when (numberp pos) - (with-current-buffer (tramp-get-connection-buffer vec) - (let (buffer-read-only) (delete-region pos (point))))))))) + ((eq exit 'process-died) + (concat + "Tramp failed to connect. If this happens repeatedly, try\n" + " `M-x tramp-cleanup-this-connection'")) + ((eq exit 'timeout) + (format + "Timeout reached, see buffer `%s' for details" + (tramp-get-connection-buffer vec))) + (t "Login failed"))))) + (when (numberp pos) + (with-current-buffer (tramp-get-connection-buffer vec) + (let (buffer-read-only) (delete-region pos (point)))))))) :;; Utility functions: diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 55d5b8b0be7..85a9074760d 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -387,10 +387,10 @@ Intended as the value of `indent-line-function'." (skip-chars-forward " \t") (current-column))) (error nil))) - ;; Inside a string and it starts before this line. + ;; Inside a string and it starts before this line: do nothing. ((and (nth 3 parse) (< (nth 8 parse) (save-excursion (beginning-of-line) (point)))) - (indent-line-to 0)) + ) ;; Inside a defun, but not a nested list (depth is 1). This is ;; a promise, usually. diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 4957b58d469..6a71ab330a8 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -33,12 +33,12 @@ ;;; Code: +(require 'cl-lib) (require 'easymenu) (require 'view) (require 'ebuff-menu) (eval-when-compile - (require 'cl-lib) (require 'helper)) @@ -233,19 +233,6 @@ Compare items with `eq' or TEST if specified." found)) -(defun ebrowse-delete-if-not (predicate list) - "Remove elements not satisfying PREDICATE from LIST and return the result. -This is a destructive operation." - (let (result) - (while list - (let ((next (cdr list))) - (when (funcall predicate (car list)) - (setq result (nconc result list)) - (setf (cdr list) nil)) - (setq list next))) - result)) - - (defmacro ebrowse-output (&rest body) "Eval BODY with a writable current buffer. Preserve buffer's modified state." @@ -1310,17 +1297,17 @@ With PREFIX, insert that many filenames." (defun ebrowse-browser-buffer-list () "Return a list of all tree or member buffers." - (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) (defun ebrowse-member-buffer-list () "Return a list of all member buffers." - (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) (defun ebrowse-tree-buffer-list () "Return a list of all tree buffers." - (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) (defun ebrowse-known-class-trees-buffer-list () @@ -1341,7 +1328,7 @@ one buffer. Prefer tree buffers over member buffers." (defun ebrowse-same-tree-member-buffer-list () "Return a list of members buffers with same tree as current buffer." - (ebrowse-delete-if-not + (cl-delete-if-not (lambda (buffer) (eq (buffer-local-value 'ebrowse--tree buffer) ebrowse--tree)) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 2c4d6a0e3d7..10472ec5815 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1759,6 +1759,9 @@ static char *magick[] = { As long as GDB is in the recursive reading loop, it does not expect commands to be prefixed by \"-interpreter-exec console\".") +(defun gdb-strip-string-backslash (string) + (replace-regexp-in-string "\\\\$" "" string)) + (defun gdb-send (proc string) "A comint send filter for gdb." (with-current-buffer gud-comint-buffer @@ -1766,10 +1769,15 @@ commands to be prefixed by \"-interpreter-exec console\".") (remove-text-properties (point-min) (point-max) '(face)))) ;; mimic <RET> key to repeat previous command in GDB (if (not (string= "" string)) - (setq gdb-last-command string) - (if gdb-last-command (setq string gdb-last-command))) - (if (or (string-match "^-" string) - (> gdb-control-level 0)) + (if gdb-continuation + (setq gdb-last-command (concat gdb-continuation + (gdb-strip-string-backslash string) + " ")) + (setq gdb-last-command (gdb-strip-string-backslash string))) + (if gdb-last-command (setq string gdb-last-command)) + (setq gdb-continuation nil)) + (if (and (not gdb-continuation) (or (string-match "^-" string) + (> gdb-control-level 0))) ;; Either MI command or we are feeding GDB's recursive reading loop. (progn (setq gdb-first-done-or-error t) @@ -1779,10 +1787,13 @@ commands to be prefixed by \"-interpreter-exec console\".") (setq gdb-control-level (1- gdb-control-level)))) ;; CLI command (if (string-match "\\\\$" string) - (setq gdb-continuation (concat gdb-continuation string "\n")) + (setq gdb-continuation + (concat gdb-continuation (gdb-strip-string-backslash + string) + " ")) (setq gdb-first-done-or-error t) (let ((to-send (concat "-interpreter-exec console " - (gdb-mi-quote string) + (gdb-mi-quote (concat gdb-continuation string " ")) "\n"))) (if gdb-enable-debug (push (cons 'mi-send to-send) gdb-debug-log)) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5f92d197a66..06dffd80d88 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1351,7 +1351,7 @@ If the result is do-end block, it will always be multiline." (progn (eval-and-compile (defconst ruby-percent-literal-beg-re - "\\(%\\)[qQrswWx]?\\([[:punct:]]\\)" + "\\(%\\)[qQrswWxIi]?\\([[:punct:]]\\)" "Regexp to match the beginning of percent literal.") (defconst ruby-syntax-methods-before-regexp @@ -1387,7 +1387,7 @@ It will be properly highlighted even when the call omits parens.") (funcall (syntax-propertize-rules ;; $' $" $` .... are variables. - ;; ?' ?" ?` are ascii codes. + ;; ?' ?" ?` are character literals (one-char strings in 1.9+). ("\\([?$]\\)[#\"'`]" (1 (unless (save-excursion ;; Not within a string. @@ -1518,7 +1518,7 @@ It will be properly highlighted even when the call omits parens.") (save-match-data (save-excursion (goto-char (nth 8 parse-state)) - (looking-at "%\\(?:[QWrx]\\|\\W\\)"))))))) + (looking-at "%\\(?:[QWrxI]\\|\\W\\)"))))))) (defun ruby-syntax-propertize-expansions (start end) (save-excursion @@ -1721,7 +1721,7 @@ See `font-lock-syntax-table'.") (defconst ruby-font-lock-keywords (list ;; functions - '("^\\s *def\\s +\\([^( \t\n]+\\)" + '("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)" 1 font-lock-function-name-face) (list (concat "\\(^\\|[^.@$]\\|\\.\\.\\)\\(" @@ -1809,7 +1809,6 @@ See `font-lock-syntax-table'.") "warn" ;; keyword-like private methods on Module "alias_method" - "autoload" "attr" "attr_accessor" "attr_reader" @@ -1850,14 +1849,17 @@ See `font-lock-syntax-table'.") 0 font-lock-variable-name-face) ;; constants '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" - 1 font-lock-type-face) + 1 (unless (eq ?\( (char-after)) font-lock-type-face)) '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) ;; expression expansion '(ruby-match-expression-expansion 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) + ;; negation char + '("[^[:alnum:]_]\\(!\\)[^=]" + 1 font-lock-negation-char-face) + ;; character literals + ;; FIXME: Support longer escape sequences. + '("\\?\\\\?\\S " 0 font-lock-string-face) ) "Additional expressions to highlight in Ruby mode.") diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index ec6e6e7ff10..3e7789069f9 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -74,6 +74,7 @@ ;;; Code: +(require 'cl-lib) (require 'ange-ftp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -180,15 +181,6 @@ created by `shadow-define-regexp-group'.") (setq list (cdr list))) (car list)) -(defun shadow-remove-if (func list) - "Remove elements satisfying FUNC from LIST. -Nondestructive; actually returns a copy of the list with the elements removed." - (if list - (if (funcall func (car list)) - (shadow-remove-if func (cdr list)) - (cons (car list) (shadow-remove-if func (cdr list)))) - nil)) - (defun shadow-regexp-superquote (string) "Like `regexp-quote', but includes the ^ and $. This makes sure regexp matches nothing but STRING." @@ -238,9 +230,8 @@ instead." Replace old definition, if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call `shadow-define-cluster' instead." - (let ((rest (shadow-remove-if - (function (lambda (x) (equal name (car x)))) - shadow-clusters))) + (let ((rest (cl-remove-if (lambda (x) (equal name (car x))) + shadow-clusters))) (setq shadow-clusters (cons (shadow-make-cluster name primary regexp) rest)))) @@ -602,9 +593,8 @@ and to are absolute file names." Consider them as regular expressions if third arg REGEXP is true." (if groups (let ((nonmatching - (shadow-remove-if - (function (lambda (x) (shadow-file-match x file regexp))) - (car groups)))) + (cl-remove-if (lambda (x) (shadow-file-match x file regexp)) + (car groups)))) (append (cond ((equal nonmatching (car groups)) nil) (regexp (let ((realname (nth 2 (shadow-parse-fullname file)))) @@ -635,8 +625,7 @@ Consider them as regular expressions if third arg REGEXP is true." "Remove PAIR from `shadow-files-to-copy'. PAIR must be `eq' to one of the elements of that list." (setq shadow-files-to-copy - (shadow-remove-if (function (lambda (s) (eq s pair))) - shadow-files-to-copy))) + (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) (defun shadow-read-files () "Visit and load `shadow-info-file' and `shadow-todo-file'. diff --git a/lisp/simple.el b/lisp/simple.el index b4b8ddfabed..9158452fd64 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4602,6 +4602,12 @@ for it.") (defun next-line (&optional arg try-vscroll) "Move cursor vertically down ARG lines. Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. +Non-interactively, use TRY-VSCROLL to control whether to vscroll tall +lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this +function will not vscroll. + +ARG defaults to 1. + If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. @@ -4646,6 +4652,12 @@ and more reliable (no dependence on goal column, etc.)." (defun previous-line (&optional arg try-vscroll) "Move cursor vertically up ARG lines. Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. +Non-interactively, use TRY-VSCROLL to control whether to vscroll tall +lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this +function will not vscroll. + +ARG defaults to 1. + If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. @@ -4725,33 +4737,76 @@ lines." :group 'editing-basics :version "23.1") +(defun default-font-height () + "Return the height in pixels of the current buffer's default face font." + (cond + ((display-multi-font-p) + (aref (font-info (face-font 'default)) 3)) + (t (frame-char-height)))) + +(defun default-line-height () + "Return the pixel height of current buffer's default-face text line. + +The value includes `line-spacing', if any, defined for the buffer +or the frame." + (let ((dfh (default-font-height)) + (lsp (if (display-graphic-p) + (or line-spacing + (default-value 'line-spacing) + (frame-parameter nil 'line-spacing) + 0) + 0))) + (if (floatp lsp) + (setq lsp (* dfh lsp))) + (+ dfh lsp))) + +(defun window-screen-lines () + "Return the number of screen lines in the text area of the selected window. + +This is different from `window-text-height' in that this function counts +lines in units of the height of the font used by the default face displayed +in the window, not in units of the frame's default font, and also accounts +for `line-spacing', if any, defined for the window's buffer or frame. + +The value is a floating-point number." + (let ((canonical (window-text-height)) + (fch (frame-char-height)) + (dlh (default-line-height))) + (/ (* (float canonical) fch) dlh))) + ;; Returns non-nil if partial move was done. (defun line-move-partial (arg noerror to-end) (if (< arg 0) ;; Move backward (up). ;; If already vscrolled, reduce vscroll - (let ((vs (window-vscroll nil t))) - (when (> vs (frame-char-height)) - (set-window-vscroll nil (- vs (frame-char-height)) t))) + (let ((vs (window-vscroll nil t)) + (dlh (default-line-height))) + (when (> vs dlh) + (set-window-vscroll nil (- vs dlh) t))) ;; Move forward (down). (let* ((lh (window-line-height -1)) + (rowh (car lh)) (vpos (nth 1 lh)) (ypos (nth 2 lh)) (rbot (nth 3 lh)) (this-lh (window-line-height)) - (this-height (nth 0 this-lh)) + (this-height (car this-lh)) (this-ypos (nth 2 this-lh)) - (fch (frame-char-height)) - py vs) + (dlh (default-line-height)) + (wslines (window-screen-lines)) + py vs last-line) + (if (> (mod wslines 1.0) 0.0) + (setq wslines (round (+ wslines 0.5)))) (when (or (null lh) - (>= rbot fch) - (<= ypos (- fch)) + (>= rbot dlh) + (<= ypos (- dlh)) (null this-lh) - (<= this-ypos (- fch))) + (<= this-ypos (- dlh))) (unless lh (let ((wend (pos-visible-in-window-p t nil t))) (setq rbot (nth 3 wend) + rowh (nth 4 wend) vpos (nth 5 wend)))) (unless this-lh (let ((wstart (pos-visible-in-window-p nil nil t))) @@ -4765,35 +4820,57 @@ lines." (if col-row (- (cdr col-row) (window-vscroll)) (cdr (posn-col-row ppos)))))) + ;; VPOS > 0 means the last line is only partially visible. + ;; But if the part that is visible is at least as tall as the + ;; default font, that means the line is actually fully + ;; readable, and something like line-spacing is hidden. So in + ;; that case we accept the last line in the window as still + ;; visible, and consider the margin as starting one line + ;; later. + (if (and vpos (> vpos 0)) + (if (and rowh + (>= rowh (default-font-height)) + (< rowh dlh)) + (setq last-line (min (- wslines scroll-margin) vpos)) + (setq last-line (min (- wslines scroll-margin 1) (1- vpos))))) (cond ;; If last line of window is fully visible, and vscrolling ;; more would make this line invisible, move forward. - ((and (or (< (setq vs (window-vscroll nil t)) fch) + ((and (or (< (setq vs (window-vscroll nil t)) dlh) (null this-height) - (<= this-height fch)) + (<= this-height dlh)) (or (null rbot) (= rbot 0))) nil) ;; If cursor is not in the bottom scroll margin, and the ;; current line is is not too tall, move forward. - ((and (or (null this-height) (<= this-height fch)) + ((and (or (null this-height) (<= this-height dlh)) vpos (> vpos 0) - (< py - (min (- (window-text-height) scroll-margin 1) (1- vpos)))) + (< py last-line)) nil) ;; When already vscrolled, we vscroll some more if we can, ;; or clear vscroll and move forward at end of tall image. ((> vs 0) (when (or (and rbot (> rbot 0)) - (and this-height (> this-height fch))) - (set-window-vscroll nil (+ vs fch) t))) + (and this-height (> this-height dlh))) + (set-window-vscroll nil (+ vs dlh) t))) ;; If cursor just entered the bottom scroll margin, move forward, - ;; but also vscroll one line so redisplay won't recenter. + ;; but also optionally vscroll one line so redisplay won't recenter. ((and vpos (> vpos 0) - (= py (min (- (window-text-height) scroll-margin 1) - (1- vpos)))) - (set-window-vscroll nil (frame-char-height) t) + (= py last-line)) + ;; Don't vscroll if the partially-visible line at window + ;; bottom has the default height (a.k.a. "just one more text + ;; line"): in that case, we do want redisplay to behave + ;; normally, i.e. recenter or whatever. + ;; + ;; Note: ROWH + RBOT from the value returned by + ;; pos-visible-in-window-p give the total height of the + ;; partially-visible glyph row at the end of the window. As + ;; we are dealing with floats, we disregard sub-pixel + ;; discrepancies between that and DLH. + (if (and rowh rbot (>= (- (+ rowh rbot) dlh) 1)) + (set-window-vscroll nil dlh t)) (line-move-1 arg noerror to-end) t) ;; If there are lines above the last line, scroll-up one line. @@ -4802,7 +4879,7 @@ lines." t) ;; Finally, start vscroll. (t - (set-window-vscroll nil (frame-char-height) t))))))) + (set-window-vscroll nil dlh t))))))) ;; This is like line-move-1 except that it also performs @@ -4835,11 +4912,14 @@ lines." (prog1 (line-move-visual arg noerror) ;; If we moved into a tall line, set vscroll to make ;; scrolling through tall images more smooth. - (let ((lh (line-pixel-height))) + (let ((lh (line-pixel-height)) + (dlh (default-line-height))) (if (and (< arg 0) (< (point) (window-start)) - (> lh (frame-char-height))) - (set-window-vscroll nil (- lh (frame-char-height)) t)))) + (> lh dlh)) + (set-window-vscroll + nil + (- lh dlh) t)))) (line-move-1 arg noerror to-end))))) ;; Display-based alternative to line-move-1. diff --git a/lisp/subr.el b/lisp/subr.el index b2918baf247..a2afe0768c4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1980,7 +1980,7 @@ any other terminator is used itself as input. The optional argument PROMPT specifies a string to use to prompt the user. The variable `read-quoted-char-radix' controls which radix to use for numeric input." - (let ((message-log-max nil) done (first t) (code 0) char translated) + (let ((message-log-max nil) done (first t) (code 0) translated) (while (not done) (let ((inhibit-quit first) ;; Don't let C-h get the help message--only help function keys. @@ -3853,6 +3853,7 @@ FILE should be the name of a library, with no directory name." (declare (obsolete eval-after-load "23.2")) (eval-after-load file (read))) + (defun display-delayed-warnings () "Display delayed warnings from `delayed-warnings-list'. Used from `delayed-warnings-hook' (which see)." @@ -3886,6 +3887,12 @@ By default, this hook contains functions to consolidate the warnings listed in `delayed-warnings-list', display them, and set `delayed-warnings-list' back to nil.") +(defun delay-warning (type message &optional level buffer-name) + "Display a delayed warning. +Aside from going through `delayed-warnings-list', this is equivalent +to `display-warning'." + (push (list type message level buffer-name) delayed-warnings-list)) + ;;;; invisibility specs diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 3d591303414..8032de85b01 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -57,6 +57,7 @@ ;;; Code: (require 'dired) +(require 'cl-lib) ; for cl-gensym ;; CUSTOMIZATIONS @@ -179,21 +180,6 @@ this value can let another user see some of your images." (make-variable-buffer-local 'thumbs-marked-list) (put 'thumbs-marked-list 'permanent-local t) -(defalias 'thumbs-gensym - (if (fboundp 'gensym) - 'gensym - ;; Copied from cl-macs.el - (defvar thumbs-gensym-counter 0) - (lambda (&optional prefix) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((pfix (if (stringp prefix) prefix "G")) - (num (if (integerp prefix) prefix - (prog1 thumbs-gensym-counter - (setq thumbs-gensym-counter - (1+ thumbs-gensym-counter)))))) - (make-symbol (format "%s%d" pfix num)))))) - (defsubst thumbs-temp-dir () (file-name-as-directory (expand-file-name thumbs-temp-dir))) @@ -202,7 +188,7 @@ The name is made by appending a number to PREFIX, default \"G\"." (format "%s%s-%s.jpg" (thumbs-temp-dir) thumbs-temp-prefix - (thumbs-gensym "T"))) + (cl-gensym "T"))) (defun thumbs-thumbsdir () "Return the current thumbnails directory (from `thumbs-thumbsdir'). diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 7a8f399a6ce..e9a6a97409c 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -12,8 +12,8 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst ediff-version "2.81.4" "The current version of Ediff") -(defconst ediff-date "December 7, 2009" "Date of last update") +(defconst ediff-version "2.81.5" "The current version of Ediff") +(defconst ediff-date "July 4, 2013" "Date of last update") ;; This file is part of GNU Emacs. @@ -1560,6 +1560,75 @@ With optional NODE, goes to that node." (add-to-list 'debug-ignored-errors mess)) + +;;; Command line interface + +;;;###autoload +(defun ediff-files-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left))) + (setq command-line-args-left (nthcdr 2 command-line-args-left)) + (ediff file-a file-b))) + +;;;###autoload +(defun ediff3-files-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (file-c (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff3 file-a file-b file-c))) + +;;;###autoload +(defun ediff-merge-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left))) + (setq command-line-args-left (nthcdr 2 command-line-args-left)) + (ediff-merge-files file-a file-b))) + +;;;###autoload +(defun ediff-merge-with-ancestor-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (ancestor (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-merge-files-with-ancestor file-a file-b ancestor))) + +;;;###autoload +(defun ediff-directories-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (regexp (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-directories file-a file-b regexp))) + +;;;###autoload +(defun ediff-directories3-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (file-c (nth 2 command-line-args-left)) + (regexp (nth 3 command-line-args-left))) + (setq command-line-args-left (nthcdr 4 command-line-args-left)) + (ediff-directories3 file-a file-b file-c regexp))) + +;;;###autoload +(defun ediff-merge-directories-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (regexp (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-merge-directories file-a file-b regexp))) + +;;;###autoload +(defun ediff-merge-directories-with-ancestor-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (ancestor (nth 2 command-line-args-left)) + (regexp (nth 3 command-line-args-left))) + (setq command-line-args-left (nthcdr 4 command-line-args-left)) + (ediff-merge-directories-with-ancestor file-a file-b ancestor regexp))) + + + (require 'ediff-util) (run-hooks 'ediff-load-hook) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 2dc1e502171..b351d896911 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -55,6 +55,7 @@ ;; See `widget.el'. ;;; Code: +(require 'cl-lib) ;;; Compatibility. @@ -221,7 +222,7 @@ minibuffer." ((or widget-menu-minibuffer-flag (> (length items) widget-menu-max-shortcuts)) ;; Read the choice of name from the minibuffer. - (setq items (widget-remove-if 'stringp items)) + (setq items (cl-remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -295,14 +296,6 @@ minibuffer." (error "Canceled")) value)))) -(defun widget-remove-if (predicate list) - (let (result (tail list)) - (while tail - (or (funcall predicate (car tail)) - (setq result (cons (car tail) result))) - (setq tail (cdr tail))) - (nreverse result))) - ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. diff --git a/m4/fcntl.m4 b/m4/fcntl.m4 new file mode 100644 index 00000000000..5481cae4d80 --- /dev/null +++ b/m4/fcntl.m4 @@ -0,0 +1,95 @@ +# fcntl.m4 serial 5 +dnl Copyright (C) 2009-2013 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. + +# For now, this module ensures that fcntl() +# - supports F_DUPFD correctly +# - supports or emulates F_DUPFD_CLOEXEC +# - supports F_GETFD +# Still to be ported to mingw: +# - F_SETFD +# - F_GETFL, F_SETFL +# - F_GETOWN, F_SETOWN +# - F_GETLK, F_SETLK, F_SETLKW +AC_DEFUN([gl_FUNC_FCNTL], +[ + dnl Persuade glibc to expose F_DUPFD_CLOEXEC. + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + AC_REQUIRE([gl_FCNTL_H_DEFAULTS]) + AC_REQUIRE([AC_CANONICAL_HOST]) + AC_CHECK_FUNCS_ONCE([fcntl]) + if test $ac_cv_func_fcntl = no; then + gl_REPLACE_FCNTL + else + dnl cygwin 1.5.x F_DUPFD has wrong errno, and allows negative target + dnl haiku alpha 2 F_DUPFD has wrong errno + AC_CACHE_CHECK([whether fcntl handles F_DUPFD correctly], + [gl_cv_func_fcntl_f_dupfd_works], + [AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +#include <fcntl.h> +#include <errno.h> +]], [[int result = 0; + if (fcntl (0, F_DUPFD, -1) != -1) result |= 1; + if (errno != EINVAL) result |= 2; + return result; + ]])], + [gl_cv_func_fcntl_f_dupfd_works=yes], + [gl_cv_func_fcntl_f_dupfd_works=no], + [# Guess that it works on glibc systems + case $host_os in #(( + *-gnu*) gl_cv_func_fcntl_f_dupfd_works="guessing yes";; + *) gl_cv_func_fcntl_f_dupfd_works="guessing no";; + esac])]) + case $gl_cv_func_fcntl_f_dupfd_works in + *yes) ;; + *) gl_REPLACE_FCNTL + AC_DEFINE([FCNTL_DUPFD_BUGGY], [1], [Define this to 1 if F_DUPFD + behavior does not match POSIX]) ;; + esac + + dnl Many systems lack F_DUPFD_CLOEXEC + AC_CACHE_CHECK([whether fcntl understands F_DUPFD_CLOEXEC], + [gl_cv_func_fcntl_f_dupfd_cloexec], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#include <fcntl.h> +#ifndef F_DUPFD_CLOEXEC +choke me +#endif + ]])], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#ifdef __linux__ +/* The Linux kernel only added F_DUPFD_CLOEXEC in 2.6.24, so we always replace + it to support the semantics on older kernels that failed with EINVAL. */ +choke me +#endif + ]])], + [gl_cv_func_fcntl_f_dupfd_cloexec=yes], + [gl_cv_func_fcntl_f_dupfd_cloexec="needs runtime check"])], + [gl_cv_func_fcntl_f_dupfd_cloexec=no])]) + if test "$gl_cv_func_fcntl_f_dupfd_cloexec" != yes; then + gl_REPLACE_FCNTL + dnl No witness macro needed for this bug. + fi + fi + dnl Replace fcntl() for supporting the gnulib-defined fchdir() function, + dnl to keep fchdir's bookkeeping up-to-date. + m4_ifdef([gl_FUNC_FCHDIR], [ + gl_TEST_FCHDIR + if test $HAVE_FCHDIR = 0; then + gl_REPLACE_FCNTL + fi + ]) +]) + +AC_DEFUN([gl_REPLACE_FCNTL], +[ + AC_REQUIRE([gl_FCNTL_H_DEFAULTS]) + AC_CHECK_FUNCS_ONCE([fcntl]) + if test $ac_cv_func_fcntl = no; then + HAVE_FCNTL=0 + else + REPLACE_FCNTL=1 + fi +]) diff --git a/m4/getdtablesize.m4 b/m4/getdtablesize.m4 new file mode 100644 index 00000000000..8f04b3b8c2a --- /dev/null +++ b/m4/getdtablesize.m4 @@ -0,0 +1,17 @@ +# getdtablesize.m4 serial 4 +dnl Copyright (C) 2008-2013 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_GETDTABLESIZE], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + AC_CHECK_FUNCS_ONCE([getdtablesize]) + if test $ac_cv_func_getdtablesize != yes; then + HAVE_GETDTABLESIZE=0 + fi +]) + +# Prerequisites of lib/getdtablesize.c. +AC_DEFUN([gl_PREREQ_GETDTABLESIZE], [:]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 344b77642b9..d7062e862de 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -41,6 +41,7 @@ AC_DEFUN([gl_EARLY], # Code from module alloca-opt: # Code from module allocator: # Code from module at-internal: + # Code from module binary-io: # Code from module c-ctype: # Code from module c-strcase: # Code from module careadlinkat: @@ -63,6 +64,7 @@ AC_DEFUN([gl_EARLY], AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) # Code from module extern-inline: # Code from module faccessat: + # Code from module fcntl: # Code from module fcntl-h: # Code from module fdatasync: # Code from module fdopendir: @@ -70,6 +72,7 @@ AC_DEFUN([gl_EARLY], # Code from module fpending: # Code from module fstatat: # Code from module fsync: + # Code from module getdtablesize: # Code from module getgroups: # Code from module getloadavg: # Code from module getopt-gnu: @@ -78,7 +81,6 @@ AC_DEFUN([gl_EARLY], # Code from module gettime: # Code from module gettimeofday: # Code from module group-member: - # Code from module ignore-value: # Code from module include_next: # Code from module intprops: # Code from module inttypes-incomplete: @@ -92,6 +94,7 @@ AC_DEFUN([gl_EARLY], # Code from module nocrash: # Code from module openat-h: # Code from module pathmax: + # Code from module pipe2: # Code from module pselect: # Code from module pthread_sigmask: # Code from module putenv: @@ -191,6 +194,11 @@ AC_DEFUN([gl_INIT], fi gl_MODULE_INDICATOR([faccessat]) gl_UNISTD_MODULE_INDICATOR([faccessat]) + gl_FUNC_FCNTL + if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then + AC_LIBOBJ([fcntl]) + fi + gl_FCNTL_MODULE_INDICATOR([fcntl]) gl_FCNTL_H gl_FUNC_FDATASYNC if test $HAVE_FDATASYNC = 0; then @@ -273,6 +281,8 @@ AC_DEFUN([gl_INIT], fi gl_TIME_MODULE_INDICATOR([mktime]) gl_MULTIARCH + gl_FUNC_PIPE2 + gl_UNISTD_MODULE_INDICATOR([pipe2]) gl_FUNC_PSELECT if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then AC_LIBOBJ([pselect]) @@ -364,6 +374,7 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false gl_gnulib_enabled_dosname=false gl_gnulib_enabled_euidaccess=false + gl_gnulib_enabled_getdtablesize=false gl_gnulib_enabled_getgroups=false gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false @@ -373,7 +384,6 @@ AC_DEFUN([gl_INIT], 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_260941c0e5dc67ec9e87d1fb321c300b () { @@ -407,6 +417,18 @@ AC_DEFUN([gl_INIT], fi fi } + func_gl_gnulib_m4code_getdtablesize () + { + if ! $gl_gnulib_enabled_getdtablesize; then + gl_FUNC_GETDTABLESIZE + if test $HAVE_GETDTABLESIZE = 0; then + AC_LIBOBJ([getdtablesize]) + gl_PREREQ_GETDTABLESIZE + fi + gl_UNISTD_MODULE_INDICATOR([getdtablesize]) + gl_gnulib_enabled_getdtablesize=true + fi + } func_gl_gnulib_m4code_getgroups () { if ! $gl_gnulib_enabled_getgroups; then @@ -479,9 +501,6 @@ AC_DEFUN([gl_INIT], if test $REPLACE_STAT = 1; then func_gl_gnulib_m4code_pathmax fi - if test $REPLACE_STAT = 1; then - func_gl_gnulib_m4code_verify - fi fi } func_gl_gnulib_m4code_strtoll () @@ -508,12 +527,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_strtoull=true fi } - func_gl_gnulib_m4code_verify () - { - if ! $gl_gnulib_enabled_verify; then - gl_gnulib_enabled_verify=true - fi - } func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec () { if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then @@ -532,6 +545,9 @@ AC_DEFUN([gl_INIT], if test $HAVE_FACCESSAT = 0; then func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 fi + if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then + func_gl_gnulib_m4code_getdtablesize + fi if test $HAVE_FDOPENDIR = 0; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi @@ -568,19 +584,14 @@ AC_DEFUN([gl_INIT], if { test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then func_gl_gnulib_m4code_strtoll fi - if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then - func_gl_gnulib_m4code_verify - fi if test $ac_cv_func_strtoumax = no && test $ac_cv_type_unsigned_long_long_int = yes; then func_gl_gnulib_m4code_strtoull fi - if test $ac_cv_func_strtoumax = no; then - func_gl_gnulib_m4code_verify - fi m4_pattern_allow([^gl_GNULIB_ENABLED_]) AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b], [$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b]) 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_getdtablesize], [$gl_gnulib_enabled_getdtablesize]) 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]) @@ -590,7 +601,6 @@ AC_DEFUN([gl_INIT], 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, [ @@ -745,6 +755,8 @@ AC_DEFUN([gl_FILE_LIST], [ lib/allocator.c lib/allocator.h lib/at-func.c + lib/binary-io.c + lib/binary-io.h lib/c-ctype.c lib/c-ctype.h lib/c-strcase.h @@ -764,6 +776,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/execinfo.c lib/execinfo.in.h lib/faccessat.c + lib/fcntl.c lib/fcntl.in.h lib/fdatasync.c lib/fdopendir.c @@ -776,6 +789,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/fsync.c lib/ftoastr.c lib/ftoastr.h + lib/getdtablesize.c lib/getgroups.c lib/getloadavg.c lib/getopt.c @@ -786,7 +800,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/gettime.c lib/gettimeofday.c lib/group-member.c - lib/ignore-value.h lib/intprops.h lib/inttypes.in.h lib/lstat.c @@ -799,6 +812,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/openat-proc.c lib/openat.h lib/pathmax.h + lib/pipe2.c lib/pselect.c lib/pthread_sigmask.c lib/putenv.c @@ -870,6 +884,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/extern-inline.m4 m4/faccessat.m4 m4/fcntl-o.m4 + m4/fcntl.m4 m4/fcntl_h.m4 m4/fdatasync.m4 m4/fdopendir.m4 @@ -877,6 +892,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/fpending.m4 m4/fstatat.m4 m4/fsync.m4 + m4/getdtablesize.m4 m4/getgroups.m4 m4/getloadavg.m4 m4/getopt.m4 @@ -897,6 +913,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/nocrash.m4 m4/off_t.m4 m4/pathmax.m4 + m4/pipe2.m4 m4/pselect.m4 m4/pthread_sigmask.m4 m4/putenv.m4 diff --git a/m4/pipe2.m4 b/m4/pipe2.m4 new file mode 100644 index 00000000000..6ccee105239 --- /dev/null +++ b/m4/pipe2.m4 @@ -0,0 +1,18 @@ +# pipe2.m4 serial 2 +dnl Copyright (C) 2009-2013 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_PIPE2], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + + dnl Persuade glibc <unistd.h> to declare pipe2(). + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + + AC_CHECK_FUNCS_ONCE([pipe2]) + if test $ac_cv_func_pipe2 != yes; then + HAVE_PIPE2=0 + fi +]) diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index a866ff670b1..20be01aaf20 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -31,7 +31,8 @@ AC_DEFUN([gl_STDALIGN_H], /* Test _Alignas only on platforms where gnulib can help. */ #if \ - (__GNUC__ || __IBMC__ || __IBMCPP__ \ + ((defined __cplusplus && 201103 <= __cplusplus) \ + || __GNUC__ || __IBMC__ || __IBMCPP__ || __ICC \ || 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER) struct alignas_test { char c; char alignas (8) alignas_8; }; char test_alignas[offsetof (struct alignas_test, alignas_8) == 8 diff --git a/nt/ChangeLog b/nt/ChangeLog index 1a0746b3181..c0598dd5630 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,17 @@ +2013-07-07 Eli Zaretskii <eliz@gnu.org> + + * inc/sys/socket.h (F_SETFD, O_CLOEXEC, F_DUPFD_CLOEXEC) + (FD_CLOEXEC): New macros. + +2013-07-07 Paul Eggert <eggert@cs.ucla.edu> + + Make file descriptors close-on-exec when possible (Bug#14803). + * gnulib.mk: Remove empty gl_GNULIB_ENABLED_verify section; + otherwise, gnulib-tool complains given close-on-exec changes. + * inc/ms-w32.h (pipe): Remove. + * mingw-cfg.site (ac_cv_func_fcntl, gl_cv_func_fcntl_f_dupfd_cloexec) + (gl_cv_func_fcntl_f_dupfd_works, ac_cv_func_pipe2): New vars. + 2013-06-25 Juanma Barranquero <lekktu@gmail.com> * configure.bat: Add warning to the help text about using the diff --git a/nt/gnulib.mk b/nt/gnulib.mk index ac4fc2768d9..df27dcf610c 100644 --- a/nt/gnulib.mk +++ b/nt/gnulib.mk @@ -876,9 +876,6 @@ EXTRA_DIST += utimens.h ## begin gnulib module verify -if gl_GNULIB_ENABLED_verify - -endif EXTRA_DIST += verify.h ## end gnulib module verify diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 29c8e383893..3e50c78f145 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -211,7 +211,6 @@ extern struct tm * sys_localtime (const time_t *); #define mktemp sys_mktemp #undef open #define open sys_open -#define pipe sys_pipe #undef read #define read sys_read #define rename sys_rename diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 99227d75d28..93bf9f91665 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -123,7 +123,11 @@ 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 F_SETFD 2 #define O_NONBLOCK 04000 +#define O_CLOEXEC O_NOINHERIT +#define F_DUPFD_CLOEXEC 0x40000000 +#define FD_CLOEXEC 1 /* we are providing a real h_errno variable */ #undef h_errno diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site index 41e4f23784e..cf55fe04ed8 100644 --- a/nt/mingw-cfg.site +++ b/nt/mingw-cfg.site @@ -67,6 +67,10 @@ gl_cv_func_readlink_works=yes gl_cv_func_symlink_works=yes ac_cv_func_readlinkat=yes ac_cv_func_faccessat=yes +# Implemented in w32.c +ac_cv_func_fcntl=yes +gl_cv_func_fcntl_f_dupfd_cloexec=yes +gl_cv_func_fcntl_f_dupfd_works=yes # We don't need fdopendir ac_cv_func_fdopendir="not-needed" gl_cv_func_fdopendir_works="no-but-not-needed-so-yes" @@ -95,6 +99,7 @@ ac_cv_func_getloadavg=yes # Avoid compiling gnulib mktime gl_cv_func_working_mktime=yes # Implemented in w32.c +ac_cv_func_pipe2=yes ac_cv_have_decl_unsetenv=yes ac_cv_func_unsetenv=yes gt_cv_func_unsetenv_ret='int' diff --git a/src/ChangeLog b/src/ChangeLog index b95488c1e70..60e7e376729 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,309 @@ +2013-07-13 Paul Eggert <eggert@cs.ucla.edu> + + Don't lose top specpdl entry when memory is exhausted. + * eval.c (grow_specpdl): Increment specpdl top by 1 and check for + specpdl overflow here, to simplify callers; all callers changed. + Always reserve an unused entry at the stack top; this avoids + losing the top entry's information when memory is exhausted. + +2013-07-12 Paul Eggert <eggert@cs.ucla.edu> + + Clean up errno reporting and fix some errno-reporting bugs. + * callproc.c (Fcall_process): + * fileio.c (Fcopy_file, Finsert_file_contents, Fwrite_region): + * process.c (create_process, Fmake_network_process): + * unexaix.c (report_error): + * unexcoff.c (report_error): + Be more careful about reporting the errno of failed operations. + The code previously reported the wrong errno sometimes. + Also, prefer report_file_errno to setting errno + report_file_error. + (Fcall_process): Look at openp return value rather than at path, + as that's a bit faster and clearer when there's a numeric predicate. + * fileio.c (report_file_errno): New function, with most of the + old contents of report_file_error. + (report_file_error): Use it. + (Ffile_exists_p, Ffile_accessible_directory_p): + Set errno to 0 when it is junk. + * fileio.c (Faccess_file): + * image.c (x_create_bitmap_from_file): + Use faccessat rather than opening the file, to avoid the hassle of + having a file descriptor open. + * lisp.h (report_file_errno): New decl. + * lread.c (Flocate_file_internal): File descriptor 0 is valid, too. + + Minor EBADF fixes. + * process.c (create_process, wait_reading_process_output) [AIX]: + Remove obsolete SIGHUP-related code, as Emacs no longer disables + SIGHUP, so EBADF is no longer acceptable here (it wouldn't work in + a multithreaded environment anyway). + * sysdep.c (emacs_close): It's not dangerous to invoke emacs_close (-1). + +2013-07-12 Andreas Schwab <schwab@linux-m68k.org> + + * image.c (x_find_image_file): Don't close a remote file handle. + +2013-07-12 Paul Eggert <eggert@cs.ucla.edu> + + Fix races with threads and file descriptors. + * callproc.c (Fcall_process_region): + * dired.c (open_directory): + * emacs.c (main, Fdaemon_initialized): + * image.c (x_find_image_file): + * inotify.c (Finotify_rm_watch): + * lread.c (Flocate_file_internal): + * process.c (Fnetwork_interface_list, Fnetwork_interface_info): + * term.c (term_mouse_moveto, init_tty): + * termcap.c (tgetent): + * unexaix.c, unexcoff.c (report_error, report_error_1, adjust_lnnoptrs) + * unexaix.c, unexcoff.c, unexcw.c, unexelf.c (unexec): + * unexhp9k800.c, unexmacosx.c (unexec): + * callproc.c (Fcall_process_region): + Use emacs_close, not close. + * sysdep.c (POSIX_CLOSE_RESTART, posix_close) [!POSIX_CLOSE_RESTART]: + New macro and function, which emulates the POSIX_CLOSE_RESTART macro + and posix_close function on current platforms (which all lack them). + (emacs_close): Use it. This should fix the races on GNU/Linux and + on AIX and on future platforms that support POSIX_CLOSE_RESTART, + and it should avoid closing random victim file descriptors on + other platforms. + +2013-07-11 Paul Eggert <eggert@cs.ucla.edu> + + * inotify.c (uninitialized): Remove. All uses replaced by -1. + (Finotify_add_watch): Simplify, since -1 means uninitialized now. + Touch up doc a bit. + + * eval.c (backtrace_function, backtrace_args): Now EXTERNALLY_VISIBLE. + This is for .gdbinit xbacktrace. + + * sysdep.c, term.c, termcap.c, terminal.c: Integer-related minor fixes. + * sysdep.c (emacs_get_tty): Return void, since nobody uses the value. + (emacs_set_tty): Now static. + * sysdep.c (emacs_set_tty, tabs_safe_p, emacs_close): + * term.c (tty_capable_p, tty_default_color_capabilities) + (get_tty_terminal, term_mouse_movement) + (handle_one_term_event, init_tty, maybe_fatal): + * termcap.c (tgetst1, struct termcap_buffer, valid_filename_p) + (tgetent, scan_file, name_match, compare_contin): + * terminal.c (get_terminal): + Use bool for boolean. + * sysdep.c (init_system_name): Don't overflow stack on huge hostname. + Prefer char to unsigned char if either will do. + * term.c (OUTPUT, turn_on_face): Omit unnecessary casts to int. + (tty_write_glyphs): Prefer int to unsigned. + (produce_glyphless_glyph): Remove 2nd (unused) int arg. + All callers changed. + * termcap.c (tprint, main) [TEST]: Remove non-working test. + +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + Port to C89. + * bytecode.c (BYTE_CODE_THREADED): Do not define if __STRICT_ANSI__. + (B__dummy__): New dummy symbol, to pacify C89. + * dbusbind.c (XD_DEBUG_MESSAGE): Omit debugging on C89 hosts, since + they can't grok varargs macros. + * dispnew.c (add_window_display_history) + (add_frame_display_history): + * print.c (print_object): + * xdisp.c (debug_method_add): + Use %p printf format only for void pointers. + * emacs.c (usage_message): New constant, replacing ... + (USAGE1, USAGE2, USAGE3): Remove; they were too long for C89. + (main): Adjust to usage reorg. + * fns.c (syms_of_fns): + * profiler.c (syms_of_profiler): + Don't use non-constant struct initializers. + * gnutls.h (gnutls_initstage_t): + * lisp.h (enum Lisp_Fwd_Type): + * lread.c (lisp_file_lexically_bound_p): + * xsettings.c (anonymous enum): + Remove trailing comma. + * xsettings.c (apply_xft_settings): Use %f, not %lf; %lf is a C99ism. + * lisp.h (ENUM_BF): Use unsigned if pedantic. + (DEFUN_FUNCTION_INIT): New macro, that falls back on a cast if pre-C99. + (DEFUN): Use it. + * regex.c (const_re_char): New type, to pacify strict C89. + All uses of 'const re_char' replaced to use it. + * regex.h (_Restrict_): Rename from __restrict, to avoid clash + with glibc when strict C89. This change is imported from gnulib. + All uses changed. + (_Restrict_arr_): Rename from __restrict_arr, similarly. + * sysdep.c (time_from_jiffies) [!HAVE_LONG_LONG_INT]: + Omit GNU_LINUX implementation, since it requires long long. + * xterm.c (x_draw_underwave): + Do not assume the traditional order of struct's members. + (x_term_init): Rewrite to avoid the need for non-constant structure + initializers. + + Syntax cleanup, mostly replacing macros with functions. +` This removes the need for the syntax_temp hack. + * search.c: Include syntax.h after buffer.h, since syntax.h uses BVAR. + * syntax.c (SYNTAX_INLINE): New macro. + (SYNTAX_FLAGS_COMSTART_FIRST, SYNTAX_FLAGS_COMSTART_SECOND) + (SYNTAX_FLAGS_COMEND_FIRST, SYNTAX_FLAGS_COMEND_SECOND) + (SYNTAX_FLAGS_PREFIX, SYNTAX_FLAGS_COMMENT_STYLEB) + (SYNTAX_FLAGS_COMMENT_STYLEC, SYNTAX_FLAGS_COMMENT_STYLEC2) + (SYNTAX_FLAGS_COMMENT_NESTED, SYNTAX_FLAGS_COMMENT_STYLE) + (SYNTAX_COMEND_FIRST): Now functions, not macros. + (ST_COMMENT_STYLE, ST_STRING_STYLE, INTERVALS_AT_ONCE): + Now constants, not macros. + (syntax_temp) [!__GNUC__]: Remove. + (SYNTAX_PREFIX): Remove; all uses replaced by syntax_prefix_flag_p. + (syntax_prefix_flag_p): Move implementation of SYNTAX_PREFIX here. + (SET_RAW_SYNTAX_ENTRY, SET_RAW_SYNTAX_ENTRY_RANGE, SYNTAX_MATCH) + (SETUP_SYNTAX_TABLE, SETUP_SYNTAX_TABLE_FOR_OBJECT): + Move here from syntax.h; now functions, not macros. Except for the + last function, these are static since only syntax.c uses them. + (syntax_multibyte): Rename from SYNTAX_WITH_MULTIBYTE_CHECK. + All uses changed. Now a function, not a macro; use this fact + to simplify the code. + (scan_lists, scan_sexps_forward): Remove workarounds for ancient + compiler bugs; no longer relevant. + * syntax.h: Use INLINE_HEADER_BEGIN, INLINE_HEADER_END. + (SYNTAX_INLINE): New macro. + (struct gl_state_s, gl_state): Move earlier, so that it's in scope + for the new functions. Use bool for boolean member. + (SYNTAX_ENTRY, SYNTAX, SYNTAX_WITH_FLAGS, SYNTAX_MATCH) + (SYNTAX_TABLE_BYTE_TO_CHAR, UPDATE_SYNTAX_TABLE_FORWARD) + (UPDATE_SYNTAX_TABLE_BACKWARD, UPDATE_SYNTAX_TABLE) + (SETUP_BUFFER_SYNTAX_TABLE): + Now extern inline functions, not macros. + (CURRENT_SYNTAX_TABLE, SYNTAX_ENTRY_INT): + Remove; all uses replaced by implementation. + (syntax_temp) [!__GNUC__]: Remove decl. + (SETUP_SYNTAX_TABLE_FOR_OBJECT): New decl. + +2013-07-10 Jan Djärv <jan.h.d@swipnet.se> + + * emacs.c (main): Fix syntax error. + +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + Timestamp fixes for undo (Bug#14824). + * atimer.c (schedule_atimer): + * fileio.c (Ffile_newer_than_file_p): + Minor cleanup: use EMACS_TIME_LT so that we can remove EMACS_TIME_GT. + * buffer.c (buffer-undo-list): Document (t . 0) and (t . -1). + * fileio.c (Fclear_visited_file_modtime): Move to lisp/files.el. + (syms_of_fileio): Remove Sclear_visited_file_name. + (Fvisited_file_modtime): Return -1, not (-1 ...), when the visited + file doesn't exist; this avoids an ambiguity with negative timestamps. + (Fset_visited_file_modtime): Accept -1 and 0 as time-list arg. + * systime.h (make_emacs_time, invalid_emacs_time): + Don't assume struct timespec layout; POSIX doesn't guarantee it. + (EMACS_TIME_NE, EMACS_TIME_GT, EMACS_TIME_GE): Remove. + * undo.c (record_first_change): Push (visited-file-modtime) onto + undo list rather than reimplementing it by hand, incorrectly. + +2013-07-09 Ken Brown <kbrown@cornell.edu> + + * sheap.c (STATIC_HEAP_SIZE) [__x86_64__]: Increase to 18MB. + +2013-07-09 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/emacs.$(O), $(BLD)/sysdep.$(O)): Update. + +2013-07-09 Paul Eggert <eggert@cs.ucla.edu> + + Handle errno and exit status a bit more carefully. + * callproc.c (child_setup) [!DOS_NT]: Don't try to stuff an error + number into an exit status. Instead, use EXIT_CANCELED. + (child_setup) [!MSDOS]: Avoid possible deadlock with vfork. + * callproc.c (relocate_fd): + * emacs.c (close_output_streams, main): + * process.c (create_process): + * sysdep.c (sys_subshell) [!DOS_NT || !WINDOWSNT]: + Use emacs_perror for simplicity. + * callproc.c (relocate_fd, main): + * sysdep.c (sys_subshell): + Exit with EXIT_CANCELED etc., not 1, when exec setup fails. + (shut_down_emacs): Use emacs_write, not write. + * emacs.c, sysdep.c: Don't include <ignore-value.h>. + * fileio.c (Fcopy_file, e_write): + * nsterm.m (ns_select): + * process.c (send_process): + * sound.c (vox_write): + Use emacs_write_sig, not emacs_write. + * lisp.h (emacs_write_sig, emacs_perror): New decls. + * process.h (EXIT_CANCELED), EXIT_CANNOT_INVOKE, EXIT_ENOENT): + New constants. + * sysdep.c (emacs_backtrace): Use emacs_write, not ignore_value + of write. + (emacs_full_write): New function. + (emacs_write): Rewrite to use it. + (emacswrite_sig, emacs_perror): New functions. + * xrdb.c (fatal): Don't invoke perror, since errno might be garbage. + +2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change). + + * image.c (imagemagick_load_image): Do not use MagickExportImagePixels + on NS even if it is present. Pixmap on NS is a void*. + +2013-07-07 Paul Eggert <eggert@cs.ucla.edu> + + Port to Ubuntu 10 (Bug#14803). + Problem reported by T.V. Raman. + * process.c (close_on_exec, accept4, process_socket): + Define these if !HAVE_ACCEPT4, not if !SOCK_CLOEXEC. + +2013-07-07 Eli Zaretskii <eliz@gnu.org> + + * w32.c (sys_dup): Declare prototype. + + * filelock.c: + * emacs.c: + * callproc.c [WINDOWSNT]: Include sys/socket.h. + +2013-07-07 Paul Eggert <eggert@cs.ucla.edu> + + Make file descriptors close-on-exec when possible (Bug#14803). + This simplifies Emacs a bit, since it no longer needs to worry + about closing file descriptors by hand in some cases. + It also fixes some unlikely races. Not all such races, as + libraries often open files internally without setting + close-on-exec, but it's an improvement. + * alloc.c (valid_pointer_p) [!WINDOWSNT]: + * callproc.c (Fcall_process) [!MSDOS]: + * emacs.c (main) [!DOS_NT]: + * nsterm.m (ns_term_init): + * process.c (create_process): + Use 'pipe2' with O_CLOEXEC instead of 'pipe'. + * emacs.c (Fcall_process_region) [HAVE_MKOSTEMP]: + * filelock.c (create_lock_file) [HAVE_MKOSTEMP]: + Prefer mkostemp with O_CLOEXEC to mkstemp. + * callproc.c (relocate_fd) [!WINDOWSNT]: + * emacs.c (main): Use F_DUPFD_CLOEXEC, not plain F_DUPFD. + No need to use fcntl (..., F_SETFD, FD_CLOEXEC), since we're + now using pipe2. + * filelock.c (create_lock_file) [! HAVE_MKOSTEMP]: + Make the resulting file descriptor close-on-exec. + * lisp.h, lread.c, process.c (close_load_descs, close_process_descs): + * lread.c (load_descriptor_list, load_descriptor_unwind): + Remove; no longer needed. All uses removed. + * process.c (SOCK_CLOEXEC): Define to 0 if not supplied by system. + (close_on_exec, accept4, process_socket) [!SOCK_CLOEXEC]: + New functions. + (socket) [!SOCK_CLOEXEC]: Supply a substitute. + (Fmake_network_process, Fnetwork_interface_list): + (Fnetwork_interface_info, server_accept_connection): + Make newly-created socket close-on-exec. + * sysdep.c (emacs_open, emacs_fopen): + Make new-created descriptor close-on-exec. + * w32.c (fcntl): Support F_DUPFD_CLOEXEC well enough for Emacs. + * w32.c, w32.h (pipe2): Rename from 'pipe', with new flags arg. + +2013-07-07 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (sendEvent:): Propagate keyboard events to modal windows + for NS_IMPL_GNUSTEP. + +2013-07-07 Paul Eggert <eggert@cs.ucla.edu> + + Fix openp errno handling. + * callproc.c (Fcall_process): Preserve openp errno around close. + * lread.c (openp): Set errno when returning -1, as some callers + expect this. + 2013-07-06 Jan Djärv <jan.h.d@swipnet.se> * nsterm.m (sendEvent:): Handle NSAPP_DATA2_RUNFILEDIALOG. @@ -655,7 +961,7 @@ (VALMASK): Also a constant, for benefit of old GDB. (LISP_INT_TAG_P): Remove; no longer needed as the only caller is INTEGERP, which can fold it in. - (XLI, XIL, XHASH, XTYPE,XINT, XFASTINT, XUINT) + (XLI, XIL, XHASH, XTYPE, XINT, XFASTINT, XUINT) (make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR, XSTRING, XSYMBOL) (XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE) (XSUB_CHAR_TABLE, XBOOL_VECTOR, make_lisp_ptr, CHECK_TYPE) diff --git a/src/alloc.c b/src/alloc.c index 230b3b614d7..6ef6af1e3a1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4750,7 +4750,7 @@ valid_pointer_p (void *p) Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may not validate p in that case. */ - if (pipe (fd) == 0) + if (pipe2 (fd, O_CLOEXEC) == 0) { bool valid = emacs_write (fd[1], (char *) p, 16) == 16; emacs_close (fd[1]); diff --git a/src/atimer.c b/src/atimer.c index 73c7aa5686b..bb5294670d3 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -336,7 +336,7 @@ schedule_atimer (struct atimer *t) struct atimer *a = atimers, *prev = NULL; /* Look for the first atimer that is ripe after T. */ - while (a && EMACS_TIME_GT (t->expiration, a->expiration)) + while (a && EMACS_TIME_LT (a->expiration, t->expiration)) prev = a, a = a->next; /* Insert T in front of the atimer found, if any. */ diff --git a/src/buffer.c b/src/buffer.c index 2555b5c17ac..19e3982a8a4 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -6096,6 +6096,11 @@ and is the visited file's modification time, as of that time. If the modification time of the most recent save is different, this entry is obsolete. +An entry (t . 0) means means the buffer was previously unmodified but +its time stamp was unknown because it was not associated with a file. +An entry (t . -1) is similar, except that it means the buffer's visited +file did not exist. + An entry (nil PROPERTY VALUE BEG . END) indicates that a text property was modified between BEG and END. PROPERTY is the property name, and VALUE is the old value. diff --git a/src/bytecode.c b/src/bytecode.c index a22be984b44..f186f7d1bc3 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -59,7 +59,8 @@ by Hallvard: indirect threaded, using GCC's computed goto extension. This code, as currently implemented, is incompatible with BYTE_CODE_SAFE and BYTE_CODE_METER. */ -#if defined (__GNUC__) && !defined (BYTE_CODE_SAFE) && !defined (BYTE_CODE_METER) +#if (defined __GNUC__ && !defined __STRICT_ANSI__ \ + && !defined BYTE_CODE_SAFE && !defined BYTE_CODE_METER) #define BYTE_CODE_THREADED #endif @@ -285,8 +286,10 @@ enum byte_code_op #ifdef BYTE_CODE_SAFE Bscan_buffer = 0153, /* No longer generated as of v18. */ - Bset_mark = 0163 /* this loser is no longer generated as of v18 */ + Bset_mark = 0163, /* this loser is no longer generated as of v18 */ #endif + + B__dummy__ = 0 /* Pacify C89. */ }; /* Whether to maintain a `top' and `bottom' field in the stack frame. */ diff --git a/src/callproc.c b/src/callproc.c index 6de8113dc14..30f9dc58d46 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifdef WINDOWSNT #define NOMINMAX +#include <sys/socket.h> /* for fcntl */ #include <windows.h> #include "w32.h" #define _P_NOWAIT 1 /* from process.h */ @@ -418,9 +419,10 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * default_output_mode); if (fd_output < 0) { + int open_errno = errno; output_file = DECODE_FILE (output_file); - report_file_error ("Opening process output file", - Fcons (output_file, Qnil)); + report_file_errno ("Opening process output file", + Fcons (output_file, Qnil), open_errno); } if (STRINGP (error_file) || NILP (error_file)) output_to_buffer = 0; @@ -429,16 +431,19 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * /* Search for program; barf if not found. */ { struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + int ok; GCPRO4 (infile, buffer, current_dir, error_file); - openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK)); + ok = openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK)); UNGCPRO; + if (ok < 0) + { + int openp_errno = errno; + emacs_close (filefd); + report_file_errno ("Searching for program", + Fcons (args[0], Qnil), openp_errno); + } } - if (NILP (path)) - { - emacs_close (filefd); - report_file_error ("Searching for program", Fcons (args[0], Qnil)); - } /* If program file name starts with /: for quoting a magic name, discard that. */ @@ -496,11 +501,13 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * mktemp (tempfile); outfilefd = emacs_open (tempfile, O_WRONLY | O_CREAT | O_TRUNC, S_IREAD | S_IWRITE); - if (outfilefd < 0) { - emacs_close (filefd); - report_file_error ("Opening process output file", - Fcons (build_string (tempfile), Qnil)); - } + if (outfilefd < 0) + { + int open_errno = errno; + emacs_close (filefd); + report_file_errno ("Opening process output file", + Fcons (build_string (tempfile), Qnil), open_errno); + } } else outfilefd = fd_output; @@ -517,12 +524,11 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * { #ifndef MSDOS int fd[2]; - if (pipe (fd) == -1) + if (pipe2 (fd, O_CLOEXEC) != 0) { int pipe_errno = errno; emacs_close (filefd); - errno = pipe_errno; - report_file_error ("Creating process pipe", Qnil); + report_file_errno ("Creating process pipe", Qnil, pipe_errno); } fd0 = fd[0]; fd1 = fd[1]; @@ -544,6 +550,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * if (fd_error < 0) { + int open_errno = errno; emacs_close (filefd); if (fd0 != filefd) emacs_close (fd0); @@ -556,7 +563,8 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * error_file = build_string (NULL_DEVICE); else if (STRINGP (error_file)) error_file = DECODE_FILE (error_file); - report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil)); + report_file_errno ("Cannot redirect stderr", + Fcons (error_file, Qnil), open_errno); } #ifdef MSDOS /* MW, July 1993 */ @@ -584,10 +592,12 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * fd0 = emacs_open (tempfile, O_RDONLY | O_BINARY, 0); if (fd0 < 0) { + int open_errno = errno; unlink (tempfile); emacs_close (filefd); - report_file_error ("Cannot re-open temporary file", - Fcons (build_string (tempfile), Qnil)); + report_file_errno ("Cannot re-open temporary file", + Fcons (build_string (tempfile), Qnil), + open_errno); } } else @@ -705,10 +715,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * } if (pid < 0) - { - errno = child_errno; - report_file_error ("Doing vfork", Qnil); - } + report_file_errno ("Doing vfork", Qnil, child_errno); if (INTEGERP (buffer)) return unbind_to (count, Qnil); @@ -1034,29 +1041,29 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r memcpy (tempfile, SDATA (encoded_tem), SBYTES (encoded_tem) + 1); coding_systems = Qt; -#ifdef HAVE_MKSTEMP +#if defined HAVE_MKOSTEMP || defined HAVE_MKSTEMP { - int fd; + int fd, open_errno; block_input (); +# ifdef HAVE_MKOSTEMP + fd = mkostemp (tempfile, O_CLOEXEC); +# else fd = mkstemp (tempfile); +# endif + open_errno = errno; unblock_input (); - if (fd == -1) - report_file_error ("Failed to open temporary file", - Fcons (build_string (tempfile), Qnil)); - else - close (fd); + if (fd < 0) + report_file_errno ("Failed to open temporary file", + Fcons (build_string (tempfile), Qnil), open_errno); + emacs_close (fd); } #else - errno = 0; + errno = EEXIST; mktemp (tempfile); if (!*tempfile) - { - if (!errno) - errno = EEXIST; - report_file_error ("Failed to open temporary file using pattern", - Fcons (pattern, Qnil)); - } + report_file_error ("Failed to open temporary file using pattern", + Fcons (pattern, Qnil)); #endif filename_string = build_string (tempfile); @@ -1182,15 +1189,6 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, pid_t pid = getpid (); - /* Close Emacs's descriptors that this process should not have. */ - close_process_descs (); - - /* DOS_NT isn't in a vfork, so if we are in the middle of load-file, - we will lose if we call close_load_descs here. */ -#ifndef DOS_NT - close_load_descs (); -#endif - /* Note that use of alloca is always safe here. It's obvious for systems that do not have true vfork or that have true (stack) alloca. If using vfork and C_ALLOCA (when Emacs used to include @@ -1223,7 +1221,7 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, are changed between the check and this chdir, but we should at least check. */ if (chdir (temp) < 0) - _exit (errno); + _exit (EXIT_CANCELED); #else /* DOS_NT */ /* Get past the drive letter, so that d:/ is left alone. */ if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2])) @@ -1352,9 +1350,11 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, emacs_close (1); emacs_close (2); + /* Redirect file descriptors and clear FD_CLOEXEC on the redirected ones. */ dup2 (in, 0); dup2 (out, 1); dup2 (err, 2); + emacs_close (in); if (out != in) emacs_close (out); @@ -1366,10 +1366,12 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, execve (new_argv[0], new_argv, env); - emacs_write (1, "Can't exec program: ", 20); - emacs_write (1, new_argv[0], strlen (new_argv[0])); - emacs_write (1, "\n", 1); - _exit (1); + /* Don't output the program name here, as it can be arbitrarily long, + and a long write from a vforked child to its parent can cause a + deadlock. */ + emacs_perror ("child process"); + + _exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); #else /* MSDOS */ pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env); @@ -1392,16 +1394,11 @@ relocate_fd (int fd, int minfd) return fd; else { - int new = fcntl (fd, F_DUPFD, minfd); + int new = fcntl (fd, F_DUPFD_CLOEXEC, minfd); if (new == -1) { - const char *message_1 = "Error while setting up child: "; - const char *errmessage = strerror (errno); - const char *message_2 = "\n"; - emacs_write (2, message_1, strlen (message_1)); - emacs_write (2, errmessage, strlen (errmessage)); - emacs_write (2, message_2, strlen (message_2)); - _exit (1); + emacs_perror ("while setting up child"); + _exit (EXIT_CANCELED); } emacs_close (fd); return new; diff --git a/src/dbusbind.c b/src/dbusbind.c index 3ec3c28431b..523544d56ca 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -142,7 +142,10 @@ static bool xd_in_read_queued_messages = 0; } while (0) #else /* !DBUS_DEBUG */ -#define XD_DEBUG_MESSAGE(...) \ +# if __STDC_VERSION__ < 199901 +# define XD_DEBUG_MESSAGE (void) /* Pre-C99 compilers cannot debug. */ +# else +# define XD_DEBUG_MESSAGE(...) \ do { \ if (!NILP (Vdbus_debug)) \ { \ @@ -151,7 +154,8 @@ static bool xd_in_read_queued_messages = 0; message ("%s: %s", __func__, s); \ } \ } while (0) -#define XD_DEBUG_VALID_LISP_OBJECT_P(object) +# endif +# define XD_DEBUG_VALID_LISP_OBJECT_P(object) #endif /* Check whether TYPE is a basic DBusType. */ diff --git a/src/dired.c b/src/dired.c index 7bbfee7e5b0..b3348b0aff0 100644 --- a/src/dired.c +++ b/src/dired.c @@ -95,7 +95,7 @@ open_directory (char const *name, int *fdp) d = fdopendir (fd); opendir_errno = errno; if (! d) - close (fd); + emacs_close (fd); } #endif diff --git a/src/dispextern.h b/src/dispextern.h index 1dd96c6638d..e0d04231d3a 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3298,7 +3298,7 @@ int image_ascent (struct image *, struct face *, struct glyph_slice *); void get_tty_size (int, int *, int *); void request_sigio (void); void unrequest_sigio (void); -int tabs_safe_p (int); +bool tabs_safe_p (int); void init_baud_rate (int); void init_sigio (int); void ignore_sigio (void); @@ -3470,11 +3470,12 @@ extern int string_cost (const char *); extern int per_line_cost (const char *); extern void calculate_costs (struct frame *); extern void produce_glyphs (struct it *); -extern int tty_capable_p (struct tty_display_info *, unsigned, unsigned long, unsigned long); +extern bool tty_capable_p (struct tty_display_info *, unsigned, + unsigned long, unsigned long); extern void set_tty_color_mode (struct tty_display_info *, struct frame *); extern struct terminal *get_named_tty (const char *); extern void create_tty_output (struct frame *); -extern struct terminal *init_tty (const char *, const char *, int); +extern struct terminal *init_tty (const char *, const char *, bool); extern void tty_append_glyph (struct it *); diff --git a/src/dispnew.c b/src/dispnew.c index 31b8a1310ea..1eb097f05ab 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -213,6 +213,7 @@ static void add_window_display_history (struct window *w, const char *msg, bool paused_p) { char *buf; + void *ptr = w; if (history_idx >= REDISPLAY_HISTORY_SIZE) history_idx = 0; @@ -222,7 +223,7 @@ add_window_display_history (struct window *w, const char *msg, bool paused_p) snprintf (buf, sizeof redisplay_history[0].trace, "%"pMu": window %p (`%s')%s\n%s", history_tick++, - w, + ptr, ((BUFFERP (w->contents) && STRINGP (BVAR (XBUFFER (w->contents), name))) ? SSDATA (BVAR (XBUFFER (w->contents), name)) @@ -240,6 +241,7 @@ static void add_frame_display_history (struct frame *f, bool paused_p) { char *buf; + void *ptr = f; if (history_idx >= REDISPLAY_HISTORY_SIZE) history_idx = 0; @@ -248,7 +250,7 @@ add_frame_display_history (struct frame *f, bool paused_p) sprintf (buf, "%"pMu": update frame %p%s", history_tick++, - f, paused_p ? " ***paused***" : ""); + ptr, paused_p ? " ***paused***" : ""); } diff --git a/src/emacs.c b/src/emacs.c index ec17322f57a..274321482e1 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -28,12 +28,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <unistd.h> #include <close-stream.h> -#include <ignore-value.h> #include "lisp.h" #ifdef WINDOWSNT #include <fcntl.h> +#include <sys/socket.h> #include "w32.h" #include "w32heap.h" #endif @@ -197,10 +197,10 @@ int initial_argc; static void sort_args (int argc, char **argv); static void syms_of_emacs (void); -/* MSVC needs each string be shorter than 2048 bytes, so the usage +/* C89 needs each string be at most 509 characters, so the usage strings below are split to not overflow this limit. */ -#define USAGE1 "\ -Usage: %s [OPTION-OR-FILENAME]...\n\ +static char const *const usage_message[] = + { "\ \n\ Run Emacs, the extensible, customizable, self-documenting real-time\n\ display editor. The recommended way to start Emacs for normal editing\n\ @@ -211,11 +211,15 @@ read the main documentation for these command-line arguments.\n\ \n\ Initialization options:\n\ \n\ +", + "\ --batch do not do interactive display; implies -q\n\ --chdir DIR change to directory DIR\n\ --daemon start a server in the background\n\ --debug-init enable Emacs Lisp debugger for init file\n\ --display, -d DISPLAY use X server DISPLAY\n\ +", + "\ --no-desktop do not load a saved desktop\n\ --no-init-file, -q load neither ~/.emacs nor default.el\n\ --no-shared-memory, -nl do not use shared memory\n\ @@ -223,14 +227,16 @@ Initialization options:\n\ --no-site-lisp, -nsl do not add site-lisp directories to load-path\n\ --no-splash do not display a splash screen on startup\n\ --no-window-system, -nw do not communicate with X, ignoring $DISPLAY\n\ +", + "\ --quick, -Q equivalent to:\n\ -q --no-site-file --no-site-lisp --no-splash\n\ --script FILE run FILE as an Emacs Lisp script\n\ --terminal, -t DEVICE use DEVICE for terminal I/O\n\ --user, -u USER load ~USER/.emacs instead of your own\n\ -\n%s" - -#define USAGE2 "\ +\n\ +", + "\ Action options:\n\ \n\ FILE visit FILE using find-file\n\ @@ -239,6 +245,8 @@ FILE visit FILE using find-file\n\ --directory, -L DIR add DIR to variable load-path\n\ --eval EXPR evaluate Emacs Lisp expression EXPR\n\ --execute EXPR evaluate Emacs Lisp expression EXPR\n\ +", + "\ --file FILE visit FILE using find-file\n\ --find-file FILE visit FILE using find-file\n\ --funcall, -f FUNC call Emacs Lisp function FUNC with no arguments\n\ @@ -246,9 +254,9 @@ FILE visit FILE using find-file\n\ --kill exit without asking for confirmation\n\ --load, -l FILE load Emacs Lisp FILE using the load function\n\ --visit FILE visit FILE using find-file\n\ -\n" - -#define USAGE3 "\ +\n\ +", + "\ Display options:\n\ \n\ --background-color, -bg COLOR window background color\n\ @@ -256,6 +264,8 @@ Display options:\n\ used for debugging Emacs\n\ --border-color, -bd COLOR main border color\n\ --border-width, -bw WIDTH width of main border\n\ +", + "\ --color, --color=MODE override color mode for character terminals;\n\ MODE defaults to `auto', and\n\ can also be `never', `always',\n\ @@ -263,17 +273,23 @@ Display options:\n\ --cursor-color, -cr COLOR color of the Emacs cursor indicating point\n\ --font, -fn FONT default font; must be fixed-width\n\ --foreground-color, -fg COLOR window foreground color\n\ +", + "\ --fullheight, -fh make the first frame high as the screen\n\ --fullscreen, -fs make the first frame fullscreen\n\ --fullwidth, -fw make the first frame wide as the screen\n\ --maximized, -mm make the first frame maximized\n\ --geometry, -g GEOMETRY window geometry\n\ +", + "\ --no-bitmap-icon, -nbi do not use picture of gnu for Emacs icon\n\ --iconic start Emacs in iconified state\n\ --internal-border, -ib WIDTH width between text and main border\n\ --line-spacing, -lsp PIXELS additional space to put between lines\n\ --mouse-color, -ms COLOR mouse cursor color in Emacs window\n\ --name NAME title for initial Emacs frame\n\ +", + "\ --no-blinking-cursor, -nbc disable blinking cursor\n\ --reverse-video, -r, -rv switch foreground and background\n\ --title, -T TITLE title for initial Emacs frame\n\ @@ -282,9 +298,9 @@ Display options:\n\ --parent-id XID set parent window\n\ --help display this help and exit\n\ --version output version information and exit\n\ -\n" - -#define USAGE4 "\ +\n\ +", + "\ You can generally also specify long option names with a single -; for\n\ example, -batch as well as --batch. You can use any unambiguous\n\ abbreviation for a --option.\n\ @@ -294,6 +310,7 @@ Emacs' operation. See the main documentation.\n\ \n\ Report bugs to bug-gnu-emacs@gnu.org. First, please see the Bugs\n\ section of the Emacs manual or the file BUGS.\n" + }; /* True if handling a fatal error already. */ @@ -641,9 +658,7 @@ close_output_streams (void) { if (close_stream (stdout) != 0) { - fprintf (stderr, "Write error to standard output: %s\n", - strerror (errno)); - fflush (stderr); + emacs_perror ("Write error to standard output"); _exit (EXIT_FAILURE); } @@ -780,7 +795,7 @@ main (int argc, char **argv) execvp (argv[0], argv); /* If the exec fails, try to dump anyway. */ - perror ("execvp"); + emacs_perror (argv[0]); } #endif /* HAVE_PERSONALITY_LINUX32 */ @@ -878,7 +893,7 @@ main (int argc, char **argv) emacs_close (0); emacs_close (1); result = emacs_open (term, O_RDWR, 0); - if (result < 0 || dup (0) < 0) + if (result < 0 || fcntl (0, F_DUPFD_CLOEXEC, 1) < 0) { char *errstring = strerror (errno); fprintf (stderr, "%s: %s: %s\n", argv[0], term, errstring); @@ -925,9 +940,10 @@ main (int argc, char **argv) /* Handle the --help option, which gives a usage message. */ if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args)) { - printf (USAGE1, argv[0], USAGE2); - printf (USAGE3); - printf (USAGE4); + int i; + printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]); + for (i = 0; i < sizeof usage_message / sizeof *usage_message; i++) + fputs (usage_message[i], stdout); exit (0); } @@ -958,7 +974,7 @@ main (int argc, char **argv) use a pipe for synchronization. The parent waits for the child to close its end of the pipe (using `daemon-initialized') before exiting. */ - if (pipe (daemon_pipe) == -1) + if (pipe2 (daemon_pipe, O_CLOEXEC) != 0) { fprintf (stderr, "Cannot pipe!\n"); exit (1); @@ -983,7 +999,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem char buf[1]; /* Close unused writing end of the pipe. */ - close (daemon_pipe[1]); + emacs_close (daemon_pipe[1]); /* Just wait for the child to close its end of the pipe. */ do @@ -1003,13 +1019,13 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem exit (1); } - close (daemon_pipe[0]); + emacs_close (daemon_pipe[0]); exit (0); } if (f < 0) { - fprintf (stderr, "Cannot fork!\n"); - exit (1); + emacs_perror ("fork"); + exit (EXIT_CANCELED); } #ifdef DAEMON_MUST_EXEC @@ -1026,14 +1042,14 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (! (0 <= fdStrlen && fdStrlen < sizeof fdStr)) { fprintf (stderr, "daemon: child name too long\n"); - exit (1); + exit (EXIT_CANNOT_INVOKE); } argv[skip_args] = fdStr; execvp (argv[0], argv); - fprintf (stderr, "emacs daemon: exec failed: %d\n", errno); - exit (1); + emacs_perror (argv[0]); + exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); } /* In exec'd: parse special dname into pipe and name info. */ @@ -1041,7 +1057,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem || strlen (dname_arg) < 1 || strlen (dname_arg) > 70) { fprintf (stderr, "emacs daemon: daemon name absent or too long\n"); - exit (1); + exit (EXIT_CANNOT_INVOKE); } dname_arg2[0] = '\0'; sscanf (dname_arg, "\n%d,%d\n%s", &(daemon_pipe[0]), &(daemon_pipe[1]), @@ -1053,10 +1069,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (dname_arg) daemon_name = xstrdup (dname_arg); /* Close unused reading end of the pipe. */ - close (daemon_pipe[0]); - /* Make sure that the used end of the pipe is closed on exec, so - that it is not accessible to programs started from .emacs. */ - fcntl (daemon_pipe[1], F_SETFD, FD_CLOEXEC); + emacs_close (daemon_pipe[0]); setsid (); #else /* DOS_NT */ @@ -1910,8 +1923,8 @@ shut_down_emacs (int sig, Lisp_Object stuff) char buf[sizeof format - 2 + INT_STRLEN_BOUND (int)]; int buflen = sprintf (buf, format, sig); char const *sig_desc = safe_strsignal (sig); - ignore_value (write (STDERR_FILENO, buf, buflen)); - ignore_value (write (STDERR_FILENO, sig_desc, strlen (sig_desc))); + emacs_write (STDERR_FILENO, buf, buflen); + emacs_write (STDERR_FILENO, sig_desc, strlen (sig_desc)); } } } @@ -2233,7 +2246,7 @@ from the parent process and its tty file descriptors. */) err |= dup2 (nfd, 0) < 0; err |= dup2 (nfd, 1) < 0; err |= dup2 (nfd, 2) < 0; - err |= close (nfd) != 0; + err |= emacs_close (nfd) != 0; /* Closing the pipe will notify the parent that it can exit. FIXME: In case some other process inherited the pipe, closing it here @@ -2243,7 +2256,7 @@ from the parent process and its tty file descriptors. */) call-process to make sure the pipe is never inherited by subprocesses. */ err |= write (daemon_pipe[1], "\n", 1) < 0; - err |= close (daemon_pipe[1]) != 0; + err |= emacs_close (daemon_pipe[1]) != 0; /* Set it to an invalid value so we know we've already run this function. */ daemon_pipe[1] = -1; diff --git a/src/eval.c b/src/eval.c index 451a7b0cc28..97e812dd890 100644 --- a/src/eval.c +++ b/src/eval.c @@ -114,6 +114,13 @@ Lisp_Object Vsignaling_function; frame is half-initialized. */ Lisp_Object inhibit_lisp_code; +/* These would ordinarily be static, but they need to be visible to GDB. */ +bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; +Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; +Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE; +union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; +union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; + static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); @@ -159,7 +166,7 @@ specpdl_func (union specbinding *pdl) return pdl->unwind.func; } -static Lisp_Object +Lisp_Object backtrace_function (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_BACKTRACE); @@ -173,7 +180,7 @@ backtrace_nargs (union specbinding *pdl) return pdl->bt.nargs; } -static Lisp_Object * +Lisp_Object * backtrace_args (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_BACKTRACE); @@ -212,10 +219,6 @@ set_backtrace_debug_on_exit (union specbinding *pdl, bool doe) /* Helper functions to scan the backtrace. */ -bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; -union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; -union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE; - bool backtrace_p (union specbinding *pdl) { return pdl >= specpdl; } @@ -2013,38 +2016,52 @@ If LEXICAL is t, evaluate using lexical scoping. */) return unbind_to (count, eval_sub (form)); } +/* Grow the specpdl stack by one entry. + The caller should have already initialized the entry. + Signal an error on stack overflow. + + Make sure that there is always one unused entry past the top of the + stack, so that the just-initialized entry is safely unwound if + memory exhausted and an error is signaled here. Also, allocate a + never-used entry just before the bottom of the stack; sometimes its + address is taken. */ + static void grow_specpdl (void) { - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); - union specbinding *pdlvec = specpdl - 1; - ptrdiff_t pdlvecsize = specpdl_size + 1; - if (max_size <= specpdl_size) + specpdl_ptr++; + + if (specpdl_ptr == specpdl + specpdl_size) { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; + ptrdiff_t count = SPECPDL_INDEX (); + ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); + union specbinding *pdlvec = specpdl - 1; + ptrdiff_t pdlvecsize = specpdl_size + 1; if (max_size <= specpdl_size) - signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); + { + if (max_specpdl_size < 400) + max_size = max_specpdl_size = 400; + if (max_size <= specpdl_size) + signal_error ("Variable binding depth exceeds max-specpdl-size", + Qnil); + } + pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); + specpdl = pdlvec + 1; + specpdl_size = pdlvecsize - 1; + specpdl_ptr = specpdl + count; } - pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); - specpdl = pdlvec + 1; - specpdl_size = pdlvecsize - 1; - specpdl_ptr = specpdl + count; } void record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) { eassert (nargs >= UNEVALLED); - if (specpdl_ptr == specpdl + specpdl_size) - grow_specpdl (); specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; specpdl_ptr->bt.debug_on_exit = false; specpdl_ptr->bt.function = function; specpdl_ptr->bt.args = args; specpdl_ptr->bt.nargs = nargs; - specpdl_ptr++; + grow_specpdl (); } /* Eval a sub-expression of the current expression (i.e. in the same @@ -3176,8 +3193,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) CHECK_SYMBOL (symbol); sym = XSYMBOL (symbol); - if (specpdl_ptr == specpdl + specpdl_size) - grow_specpdl (); start: switch (sym->redirect) @@ -3191,7 +3206,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); specpdl_ptr->let.saved_value = Qnil; - ++specpdl_ptr; + grow_specpdl (); do_specbind (sym, specpdl_ptr - 1, value); break; case SYMBOL_LOCALIZED: @@ -3224,7 +3239,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) if (NILP (Flocal_variable_p (symbol, Qnil))) { specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; - ++specpdl_ptr; + grow_specpdl (); do_specbind (sym, specpdl_ptr - 1, value); return; } @@ -3232,7 +3247,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) else specpdl_ptr->let.kind = SPECPDL_LET; - specpdl_ptr++; + grow_specpdl (); do_specbind (sym, specpdl_ptr - 1, value); break; } @@ -3243,12 +3258,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) void record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) { - if (specpdl_ptr == specpdl + specpdl_size) - grow_specpdl (); specpdl_ptr->unwind.kind = SPECPDL_UNWIND; specpdl_ptr->unwind.func = function; specpdl_ptr->unwind.arg = arg; - specpdl_ptr++; + grow_specpdl (); } void diff --git a/src/fileio.c b/src/fileio.c index 89ae89e1613..c3566390130 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -159,11 +159,13 @@ static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, struct coding_system *); +/* Signal a file-access failure. STRING describes the failure, + DATA the file that was involved, and ERRORNO the errno value. */ + void -report_file_error (const char *string, Lisp_Object data) +report_file_errno (char const *string, Lisp_Object data, int errorno) { Lisp_Object errstring; - int errorno = errno; char *str; synchronize_system_messages_locale (); @@ -196,6 +198,12 @@ report_file_error (const char *string, Lisp_Object data) } } +void +report_file_error (char const *string, Lisp_Object data) +{ + report_file_errno (string, data, errno); +} + Lisp_Object close_file_unwind (Lisp_Object fd) { @@ -2019,11 +2027,8 @@ entries (depending on how Emacs was built). */) { /* CopyFile doesn't set errno when it fails. By far the most "popular" reason is that the target is read-only. */ - if (GetLastError () == 5) - errno = EACCES; - else - errno = EPERM; - report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); + report_file_errno ("Copying file", Fcons (file, Fcons (newname, Qnil)), + GetLastError () == 5 ? EACCES : EPERM); } /* CopyFile retains the timestamp by default. */ else if (NILP (keep_time)) @@ -2084,36 +2089,25 @@ entries (depending on how Emacs was built). */) if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) - { - errno = 0; - report_file_error ("Input and output files are the same", - Fcons (file, Fcons (newname, Qnil))); - } + report_file_errno ("Input and output files are the same", + Fcons (file, Fcons (newname, Qnil)), 0); /* We can copy only regular files. */ if (!S_ISREG (st.st_mode)) - { - /* Get a better looking error message. */ - errno = S_ISDIR (st.st_mode) ? EISDIR : EINVAL; - report_file_error ("Non-regular file", Fcons (file, Qnil)); - } + report_file_errno ("Non-regular file", Fcons (file, Qnil), + S_ISDIR (st.st_mode) ? EISDIR : EINVAL); -#ifdef MSDOS - /* System's default file type was set to binary by _fmode in emacs.c. */ - ofd = emacs_open (SDATA (encoded_newname), - O_WRONLY | O_TRUNC | O_CREAT - | (NILP (ok_if_already_exists) ? O_EXCL : 0), - S_IREAD | S_IWRITE); -#else /* not MSDOS */ { - mode_t new_mask = !NILP (preserve_uid_gid) ? 0600 : 0666; - new_mask &= st.st_mode; +#ifndef MSDOS + int new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0600 : 0666); +#else + int new_mask = S_IREAD | S_IWRITE; +#endif ofd = emacs_open (SSDATA (encoded_newname), (O_WRONLY | O_TRUNC | O_CREAT | (NILP (ok_if_already_exists) ? O_EXCL : 0)), new_mask); } -#endif /* not MSDOS */ if (ofd < 0) report_file_error ("Opening output file", Fcons (newname, Qnil)); @@ -2122,7 +2116,7 @@ entries (depending on how Emacs was built). */) immediate_quit = 1; QUIT; while ((n = emacs_read (ifd, buf, sizeof buf)) > 0) - if (emacs_write (ofd, buf, n) != n) + if (emacs_write_sig (ofd, buf, n) != n) report_file_error ("I/O error", Fcons (newname, Qnil)); immediate_quit = 0; @@ -2609,7 +2603,11 @@ Use `file-symlink-p' to test for such links. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (absname, Qfile_exists_p); if (!NILP (handler)) - return call2 (handler, Qfile_exists_p, absname); + { + Lisp_Object result = call2 (handler, Qfile_exists_p, absname); + errno = 0; + return result; + } absname = ENCODE_FILE (absname); @@ -2706,7 +2704,6 @@ If there is no error, returns nil. */) (Lisp_Object filename, Lisp_Object string) { Lisp_Object handler, encoded_filename, absname; - int fd; CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); @@ -2721,10 +2718,8 @@ If there is no error, returns nil. */) encoded_filename = ENCODE_FILE (absname); - fd = emacs_open (SSDATA (encoded_filename), O_RDONLY, 0); - if (fd < 0) + if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0) report_file_error (SSDATA (string), Fcons (filename, Qnil)); - emacs_close (fd); return Qnil; } @@ -2833,7 +2828,11 @@ searchable directory. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p); if (!NILP (handler)) - return call2 (handler, Qfile_accessible_directory_p, absname); + { + Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname); + errno = 0; + return r; + } absname = ENCODE_FILE (absname); return file_accessible_directory_p (SSDATA (absname)) ? Qt : Qnil; @@ -3345,7 +3344,7 @@ otherwise, if FILE2 does not exist, the answer is t. */) if (stat (SSDATA (absname2), &st2) < 0) return Qt; - return (EMACS_TIME_GT (get_stat_mtime (&st1), get_stat_mtime (&st2)) + return (EMACS_TIME_LT (get_stat_mtime (&st2), get_stat_mtime (&st1)) ? Qt : Qnil); } @@ -4575,8 +4574,8 @@ by calling `format-decode', which see. */) && EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS) { /* If visiting nonexistent file, return nil. */ - errno = save_errno; - report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); + report_file_errno ("Opening input file", Fcons (orig_filename, Qnil), + save_errno); } if (read_quit) @@ -4897,13 +4896,13 @@ This calls `write-region-annotate-functions' at the start, and if (desc < 0) { + int open_errno = errno; #ifdef CLASH_DETECTION - save_errno = errno; if (!auto_saving) unlock_file (lockname); - errno = save_errno; #endif /* CLASH_DETECTION */ UNGCPRO; - report_file_error ("Opening output file", Fcons (filename, Qnil)); + report_file_errno ("Opening output file", Fcons (filename, Qnil), + open_errno); } record_unwind_protect (close_file_unwind, make_number (desc)); @@ -4913,13 +4912,13 @@ This calls `write-region-annotate-functions' at the start, and off_t ret = lseek (desc, offset, SEEK_SET); if (ret < 0) { + int lseek_errno = errno; #ifdef CLASH_DETECTION - save_errno = errno; if (!auto_saving) unlock_file (lockname); - errno = save_errno; #endif /* CLASH_DETECTION */ UNGCPRO; - report_file_error ("Lseek error", Fcons (filename, Qnil)); + report_file_errno ("Lseek error", Fcons (filename, Qnil), + lseek_errno); } } @@ -5317,12 +5316,10 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end, if (coding->produced > 0) { - coding->produced - -= emacs_write (desc, - STRINGP (coding->dst_object) - ? SSDATA (coding->dst_object) - : (char *) BYTE_POS_ADDR (coding->dst_pos_byte), - coding->produced); + char *buf = (STRINGP (coding->dst_object) + ? SSDATA (coding->dst_object) + : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)); + coding->produced -= emacs_write_sig (desc, buf, coding->produced); if (coding->produced) return 0; @@ -5377,36 +5374,19 @@ See Info node `(elisp)Modification Time' for more details. */) return Qnil; } -DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, - Sclear_visited_file_modtime, 0, 0, 0, - doc: /* Clear out records of last mod time of visited file. -Next attempt to save will certainly not complain of a discrepancy. */) - (void) -{ - current_buffer->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS); - current_buffer->modtime_size = -1; - return Qnil; -} - DEFUN ("visited-file-modtime", Fvisited_file_modtime, Svisited_file_modtime, 0, 0, 0, doc: /* Return the current buffer's recorded visited file modification time. The value is a list of the form (HIGH LOW USEC PSEC), like the time values that `file-attributes' returns. If the current buffer has no recorded file modification time, this function returns 0. If the visited file -doesn't exist, HIGH will be -1. +doesn't exist, return -1. See Info node `(elisp)Modification Time' for more details. */) (void) { - if (EMACS_NSECS (current_buffer->modtime) < 0) - { - if (EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS) - { - /* make_lisp_time won't work here if time_t is unsigned. */ - return list4i (-1, 65535, 0, 0); - } - return make_number (0); - } + int ns = EMACS_NSECS (current_buffer->modtime); + if (ns < 0) + return make_number (UNKNOWN_MODTIME_NSECS - ns); return make_lisp_time (current_buffer->modtime); } @@ -5417,12 +5397,22 @@ Useful if the buffer was not read from the file normally or if the file itself has been changed for some known benign reason. An argument specifies the modification time value to use \(instead of that of the visited file), in the form of a list -\(HIGH LOW USEC PSEC) as returned by `current-time'. */) - (Lisp_Object time_list) +\(HIGH LOW USEC PSEC) or an integer flag as returned by +`visited-file-modtime'. */) + (Lisp_Object time_flag) { - if (!NILP (time_list)) + if (!NILP (time_flag)) { - current_buffer->modtime = lisp_time_argument (time_list); + EMACS_TIME mtime; + if (INTEGERP (time_flag)) + { + CHECK_RANGED_INTEGER (time_flag, -1, 0); + mtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag)); + } + else + mtime = lisp_time_argument (time_flag); + + current_buffer->modtime = mtime; current_buffer->modtime_size = -1; } else @@ -6123,7 +6113,6 @@ This includes interactive calls to `delete-file' and defsubr (&Swrite_region); defsubr (&Scar_less_than_car); defsubr (&Sverify_visited_file_modtime); - defsubr (&Sclear_visited_file_modtime); defsubr (&Svisited_file_modtime); defsubr (&Sset_visited_file_modtime); defsubr (&Sdo_auto_save); diff --git a/src/filelock.c b/src/filelock.c index de6aba8385c..244663ad20a 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -47,6 +47,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "systime.h" #ifdef WINDOWSNT #include <share.h> +#include <sys/socket.h> /* for fcntl */ #include "w32.h" /* for dostounix_filename */ #endif @@ -380,9 +381,9 @@ rename_lock_file (char const *old, char const *new, bool force) #endif } -/* Create the lock file FILE with contents CONTENTS. Return 0 if +/* Create the lock file LFNAME with contents LOCK_INFO_STR. Return 0 if successful, an errno value on failure. If FORCE, remove any - existing FILE if necessary. */ + existing LFNAME if necessary. */ static int create_lock_file (char *lfname, char *lock_info_str, bool force) @@ -416,8 +417,13 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) memcpy (nonce, lfname, lfdirlen); strcpy (nonce + lfdirlen, nonce_base); -#if HAVE_MKSTEMP - /* Prefer mkstemp if available, as it avoids a race between +#if HAVE_MKOSTEMP + /* Prefer mkostemp to mkstemp, as it avoids a window where FD is + temporarily open without close-on-exec. */ + fd = mkostemp (nonce, O_BINARY | O_CLOEXEC); + need_fchmod = 1; +#elif HAVE_MKSTEMP + /* Prefer mkstemp to mktemp, as it avoids a race between mktemp and emacs_open. */ fd = mkstemp (nonce); need_fchmod = 1; @@ -432,7 +438,11 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) err = errno; else { - ptrdiff_t lock_info_len = strlen (lock_info_str); + ptrdiff_t lock_info_len; +#if ! HAVE_MKOSTEMP + fcntl (fd, F_SETFD, FD_CLOEXEC); +#endif + lock_info_len = strlen (lock_info_str); err = 0; if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len || (need_fchmod && fchmod (fd, world_readable) != 0)) diff --git a/src/fns.c b/src/fns.c index 7a8ddc04540..49bd8470f7f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5011,13 +5011,21 @@ this variable. */); defsubr (&Ssecure_hash); defsubr (&Slocale_info); - { - struct hash_table_test - eq = { Qeq, Qnil, Qnil, NULL, hashfn_eq }, - eql = { Qeql, Qnil, Qnil, cmpfn_eql, hashfn_eql }, - equal = { Qequal, Qnil, Qnil, cmpfn_equal, hashfn_equal }; - hashtest_eq = eq; - hashtest_eql = eql; - hashtest_equal = equal; - } + hashtest_eq.name = Qeq; + hashtest_eq.user_hash_function = Qnil; + hashtest_eq.user_cmp_function = Qnil; + hashtest_eq.cmpfn = 0; + hashtest_eq.hashfn = hashfn_eq; + + hashtest_eql.name = Qeql; + hashtest_eql.user_hash_function = Qnil; + hashtest_eql.user_cmp_function = Qnil; + hashtest_eql.cmpfn = cmpfn_eql; + hashtest_eql.hashfn = hashfn_eql; + + hashtest_equal.name = Qequal; + hashtest_equal.user_hash_function = Qnil; + hashtest_equal.user_cmp_function = Qnil; + hashtest_equal.cmpfn = cmpfn_equal; + hashtest_equal.hashfn = hashfn_equal; } diff --git a/src/frame.c b/src/frame.c index 6ecc7147c18..648687a7cb4 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1855,7 +1855,7 @@ See `redirect-frame-focus'. */) /* Return the value of frame parameter PROP in frame FRAME. */ #ifdef HAVE_WINDOW_SYSTEM -#if !HAVE_NS && !defined(WINDOWSNT) +#if !HAVE_NS && !defined (WINDOWSNT) static #endif Lisp_Object diff --git a/src/gnutls.h b/src/gnutls.h index f1a337e7b3e..86dcab77b62 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -42,7 +42,7 @@ typedef enum GNUTLS_STAGE_TRANSPORT_POINTERS_SET, GNUTLS_STAGE_HANDSHAKE_TRIED, - GNUTLS_STAGE_READY, + GNUTLS_STAGE_READY } gnutls_initstage_t; #define GNUTLS_EMACS_ERROR_NOT_LOADED GNUTLS_E_APPLICATION_ERROR_MIN + 1 diff --git a/src/image.c b/src/image.c index 7ecd59d27b4..c085e6e63eb 100644 --- a/src/image.c +++ b/src/image.c @@ -316,7 +316,6 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file) int xhot, yhot, result; ptrdiff_t id; Lisp_Object found; - int fd; char *filename; /* Look for an existing bitmap with the same name. */ @@ -332,10 +331,8 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file) } /* Search bitmap-file-path for the file, if appropriate. */ - fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil); - if (fd < 0) + if (openp (Vx_bitmap_file_path, file, Qnil, &found, make_number (R_OK)) < 0) return -1; - emacs_close (fd); filename = SSDATA (found); @@ -2260,7 +2257,8 @@ x_find_image_file (Lisp_Object file) else { file_found = ENCODE_FILE (file_found); - close (fd); + if (fd != -2) + emacs_close (fd); } return file_found; @@ -8054,7 +8052,7 @@ imagemagick_load_image (struct frame *f, struct image *img, init_color_table (); -#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS +#if defined (HAVE_MAGICKEXPORTIMAGEPIXELS) && ! defined (HAVE_NS) if (imagemagick_render_type != 0) { /* Magicexportimage is normally faster than pixelpushing. This diff --git a/src/inotify.c b/src/inotify.c index 01fb34a5c4a..f4f850bf180 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -71,9 +71,8 @@ static Lisp_Object Qunmount; /* IN_UNMOUNT */ # define IN_ONLYDIR 0 #endif -enum { uninitialized = -100 }; /* File handle for inotify. */ -static int inotifyfd = uninitialized; +static int inotifyfd = -1; /* Assoc list of files being watched. Format: @@ -268,8 +267,10 @@ aspect_to_inotifymask (Lisp_Object aspect) DEFUN ("inotify-add-watch", Finotify_add_watch, Sinotify_add_watch, 3, 3, 0, doc: /* Add a watch for FILE-NAME to inotify. -A WATCH-DESCRIPTOR is returned on success. ASPECT might be one of the following -symbols or a list of those symbols: +Return a watch descriptor. The watch will look for ASPECT events and +invoke CALLBACK when an event occurs. + +ASPECT might be one of the following symbols or a list of those symbols: access attrib @@ -288,7 +289,7 @@ all-events or t move close -The following symbols can also be added to a list of aspects +The following symbols can also be added to a list of aspects: dont-follow excl-unlink @@ -296,9 +297,8 @@ mask-add oneshot onlydir -Watching a directory is not recursive. CALLBACK gets called in case of an -event. It gets passed a single argument EVENT which contains an event structure -of the format +Watching a directory is not recursive. CALLBACK is passed a single argument +EVENT which contains an event structure of the format (WATCH-DESCRIPTOR ASPECTS NAME COOKIE) @@ -331,16 +331,13 @@ is managed internally and there is no corresponding inotify_init. Use CHECK_STRING (file_name); - if (inotifyfd == uninitialized) + if (inotifyfd < 0) { inotifyfd = inotify_init1 (IN_NONBLOCK|IN_CLOEXEC); - if (inotifyfd == -1) - { - inotifyfd = uninitialized; - xsignal1 - (Qfile_notify_error, - build_string ("File watching feature (inotify) is not available")); - } + if (inotifyfd < 0) + xsignal1 + (Qfile_notify_error, + build_string ("File watching feature (inotify) is not available")); watch_list = Qnil; add_read_fd (inotifyfd, &inotify_callback, NULL); } @@ -390,9 +387,9 @@ See inotify_rm_watch(2) for more information. /* Cleanup if no more files are watched. */ if (NILP (watch_list)) { - close (inotifyfd); + emacs_close (inotifyfd); delete_read_fd (inotifyfd); - inotifyfd = uninitialized; + inotifyfd = -1; } return Qt; diff --git a/src/keyboard.c b/src/keyboard.c index 39535f5cd71..b6eb9e6ad15 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7008,7 +7008,7 @@ tty_read_avail_input (struct terminal *terminal, { nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); /* POSIX infers that processes which are not in the session leader's - process group won't get SIGHUP's at logout time. BSDI adheres to + process group won't get SIGHUPs at logout time. BSDI adheres to this part standard and returns -1 from read (0) with errno==EIO when the control tty is taken away. Jeffrey Honig <jch@bsdi.com> says this is generally safe. */ diff --git a/src/lisp.h b/src/lisp.h index 9af69c61da8..acd21089655 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -365,9 +365,9 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 }; #define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 -/* Idea stolen from GDB. MSVC doesn't support enums in bitfields, - and xlc complains vociferously about them. */ -#if defined _MSC_VER || defined __IBMC__ +/* Idea stolen from GDB. Pedantic GCC complains about enum bitfields, + MSVC doesn't support them, and xlc complains vociferously about them. */ +#if defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__ #define ENUM_BF(TYPE) unsigned int #else #define ENUM_BF(TYPE) enum TYPE @@ -400,7 +400,7 @@ enum Lisp_Type /* Cons. XCONS (object) points to a struct Lisp_Cons. */ Lisp_Cons = 6, - Lisp_Float = 7, + Lisp_Float = 7 }; /* This is the set of data types that share a common structure. @@ -430,7 +430,7 @@ enum Lisp_Fwd_Type Lisp_Fwd_Bool, /* Fwd to a C boolean var. */ Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */ Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */ - Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */ + Lisp_Fwd_Kboard_Obj /* Fwd to a Lisp_Object field of kboards. */ }; /* If you want to define a new Lisp data type, here are some @@ -2614,11 +2614,16 @@ CHECK_NUMBER_CDR (Lisp_Object x) minargs, maxargs, lname, intspec, 0}; \ Lisp_Object fnname #else /* not _MSC_VER */ +# if __STDC_VERSION__ < 199901 +# define DEFUN_FUNCTION_INIT(fnname, maxargs) (Lisp_Object (*) (void)) fnname +# else +# define DEFUN_FUNCTION_INIT(fnname, maxargs) .a ## maxargs = fnname +# endif #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ static struct Lisp_Subr alignas (GCALIGNMENT) sname = \ { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ - { .a ## maxargs = fnname }, \ + { DEFUN_FUNCTION_INIT (fnname, maxargs) }, \ minargs, maxargs, lname, intspec, 0}; \ Lisp_Object fnname #endif @@ -3740,7 +3745,6 @@ extern Lisp_Object string_to_number (char const *, int, bool); extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object), Lisp_Object); extern void dir_warning (const char *, Lisp_Object); -extern void close_load_descs (void); extern void init_obarray (void); extern void init_lread (void); extern void syms_of_lread (void); @@ -3896,6 +3900,7 @@ extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */ extern Lisp_Object close_file_unwind (Lisp_Object); extern Lisp_Object restore_point_unwind (Lisp_Object); +extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); extern bool internal_delete_file (Lisp_Object); extern Lisp_Object emacs_readlinkat (int, const char *); @@ -4001,7 +4006,7 @@ extern Lisp_Object Qvisible; extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object); -#if HAVE_NS || defined(WINDOWSNT) +#if HAVE_NS || defined WINDOWSNT extern Lisp_Object get_frame_param (struct frame *, Lisp_Object); #endif extern void frames_discard_buffer (Lisp_Object); @@ -4073,11 +4078,11 @@ extern void delete_keyboard_wait_descriptor (int); extern void add_gpm_wait_descriptor (int); extern void delete_gpm_wait_descriptor (int); #endif -extern void close_process_descs (void); extern void init_process_emacs (void); extern void syms_of_process (void); extern void setup_process_coding_systems (Lisp_Object); +/* Defined in callproc.c. */ #ifndef DOS_NT _Noreturn #endif @@ -4169,6 +4174,8 @@ extern int emacs_open (const char *, int, int); extern int emacs_close (int); extern ptrdiff_t emacs_read (int, char *, ptrdiff_t); extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t); +extern ptrdiff_t emacs_write_sig (int, char const *, ptrdiff_t); +extern void emacs_perror (char const *); extern void unlock_all_files (void); extern void lock_file (Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 06badce12be..f0423f166dd 100644 --- a/src/lread.c +++ b/src/lread.c @@ -95,9 +95,6 @@ static Lisp_Object Qload_in_progress; It must be set to nil before all top-level calls to read0. */ static Lisp_Object read_objects; -/* List of descriptors now open for Fload. */ -static Lisp_Object load_descriptor_list; - /* File for get_file_char to read from. Use by load. */ static FILE *instream; @@ -149,7 +146,6 @@ static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object load_unwind (Lisp_Object); -static Lisp_Object load_descriptor_unwind (Lisp_Object); /* Functions that read one byte from the current source READCHARFUN or unreads one byte. If the integer argument C is -1, it returns @@ -827,7 +823,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) { bool rv = 0; enum { - NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX, + NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX } beg_end_state = NOMINAL; bool in_file_vars = 0; @@ -1328,11 +1324,8 @@ Return t if the file exists and loads successfully. */) } record_unwind_protect (load_unwind, make_save_pointer (stream)); - record_unwind_protect (load_descriptor_unwind, load_descriptor_list); specbind (Qload_file_name, found); specbind (Qinhibit_file_name_operation, Qnil); - load_descriptor_list - = Fcons (make_number (fileno (stream)), load_descriptor_list); specbind (Qload_in_progress, Qt); instream = stream; @@ -1395,26 +1388,6 @@ load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ } return Qnil; } - -static Lisp_Object -load_descriptor_unwind (Lisp_Object oldlist) -{ - load_descriptor_list = oldlist; - return Qnil; -} - -/* Close all descriptors in use for Floads. - This is used when starting a subprocess. */ - -void -close_load_descs (void) -{ -#ifndef WINDOWSNT - Lisp_Object tail; - for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail)) - emacs_close (XFASTINT (XCAR (tail))); -#endif -} static bool complete_filename_p (Lisp_Object pathname) @@ -1439,8 +1412,8 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) { Lisp_Object file; int fd = openp (path, filename, suffixes, &file, predicate); - if (NILP (predicate) && fd > 0) - close (fd); + if (NILP (predicate) && fd >= 0) + emacs_close (fd); return file; } @@ -1448,14 +1421,15 @@ static Lisp_Object Qdir_ok; /* Search for a file whose name is STR, looking in directories in the Lisp list PATH, and trying suffixes from SUFFIX. - On success, returns a file descriptor. On failure, returns -1. + On success, return a file descriptor (or 1 or -2 as described below). + On failure, return -1 and set errno. SUFFIXES is a list of strings containing possible suffixes. The empty suffix is automatically added if the list is empty. PREDICATE non-nil means don't open the files, just look for one that satisfies the predicate. In this case, - returns 1 on success. The predicate can be a lisp function or + return 1 on success. The predicate can be a lisp function or an integer to pass to `access' (in which case file-name-handlers are ignored). @@ -1467,7 +1441,8 @@ static Lisp_Object Qdir_ok; but store the found remote file name in *STOREPTR. */ int -openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate) +openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, + Lisp_Object *storeptr, Lisp_Object predicate) { ptrdiff_t fn_size = 100; char buf[100]; @@ -1478,6 +1453,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; Lisp_Object string, tail, encoded_fn; ptrdiff_t max_suffix_len = 0; + int last_errno = ENOENT; CHECK_STRING (str); @@ -1547,14 +1523,22 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) { bool exists; + last_errno = ENOENT; if (NILP (predicate)) exists = !NILP (Ffile_readable_p (string)); else { Lisp_Object tmp = call1 (predicate, string); - exists = !NILP (tmp) - && (EQ (tmp, Qdir_ok) - || NILP (Ffile_directory_p (string))); + if (NILP (tmp)) + exists = 0; + else if (EQ (tmp, Qdir_ok) + || NILP (Ffile_directory_p (string))) + exists = 1; + else + { + exists = 0; + last_errno = EISDIR; + } } if (exists) @@ -1576,21 +1560,36 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto /* Check that we can access or open it. */ if (NATNUMP (predicate)) - fd = (((XFASTINT (predicate) & ~INT_MAX) == 0 - && (faccessat (AT_FDCWD, pfn, XFASTINT (predicate), + { + fd = -1; + if (INT_MAX < XFASTINT (predicate)) + last_errno = EINVAL; + else if (faccessat (AT_FDCWD, pfn, XFASTINT (predicate), AT_EACCESS) == 0) - && ! file_directory_p (pfn)) - ? 1 : -1); + { + if (file_directory_p (pfn)) + last_errno = EISDIR; + else + fd = 1; + } + } else { - struct stat st; fd = emacs_open (pfn, O_RDONLY, 0); - if (fd >= 0 - && (fstat (fd, &st) != 0 || S_ISDIR (st.st_mode))) + if (fd < 0) + last_errno = errno; + else { - emacs_close (fd); - fd = -1; + struct stat st; + int err = (fstat (fd, &st) != 0 ? errno + : S_ISDIR (st.st_mode) ? EISDIR : 0); + if (err) + { + last_errno = err; + emacs_close (fd); + fd = -1; + } } } @@ -1609,6 +1608,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto } UNGCPRO; + errno = last_errno; return -1; } @@ -4349,9 +4349,6 @@ init_lread (void) load_in_progress = 0; Vload_file_name = Qnil; - - load_descriptor_list = Qnil; - Vstandard_input = Qt; Vloads_in_progress = Qnil; } @@ -4624,9 +4621,6 @@ variables, this must be set in the first line of a file. */); /* Vsource_directory was initialized in init_lread. */ - load_descriptor_list = Qnil; - staticpro (&load_descriptor_list); - DEFSYM (Qcurrent_load_list, "current-load-list"); DEFSYM (Qstandard_input, "standard-input"); DEFSYM (Qread_char, "read-char"); diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 272b053ed12..f4885580e1c 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -813,7 +813,6 @@ $(BLD)/emacs.$(O) : \ $(NT_INC)/sys/file.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/close-stream.h \ - $(GNU_LIB)/ignore-value.h \ $(ATIMER_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ @@ -1407,7 +1406,6 @@ $(BLD)/sysdep.$(O) : \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/execinfo.h \ - $(GNU_LIB)/ignore-value.h \ $(GNU_LIB)/utimens.h \ $(CONFIG_H) \ $(C_CTYPE_H) \ diff --git a/src/nsfns.m b/src/nsfns.m index b8f46e461fa..6eebb4d2567 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -885,7 +885,7 @@ ns_appkit_version_str (void) #ifdef NS_IMPL_GNUSTEP sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION)); -#elif defined(NS_IMPL_COCOA) +#elif defined (NS_IMPL_COCOA) sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber); #else tmp = "ns-unknown"; @@ -902,7 +902,7 @@ ns_appkit_version_int (void) { #ifdef NS_IMPL_GNUSTEP return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION; -#elif defined(NS_IMPL_COCOA) +#elif defined (NS_IMPL_COCOA) return (int)NSAppKitVersionNumber; #endif return 0; @@ -2493,7 +2493,7 @@ Internal use only, use `display-monitor-attributes-list' instead. */) vy = (short) (primary_display_height - vfr.size.height - vfr.origin.y); } - + m->geom.x = (short) fr.origin.x; m->geom.y = y; m->geom.width = (unsigned short) fr.size.width; diff --git a/src/nsmenu.m b/src/nsmenu.m index 1d3d111e9a1..22635dca0a2 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -612,8 +612,8 @@ extern NSString *NSMenuDidBeginTrackingNotification; if (trackingMenu == 0) return; /*fprintf (stderr, "Updating menu '%s'\n", [[self title] UTF8String]); NSLog (@"%@\n", event); */ -#if ! defined(NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_5 +#if (! defined (NS_IMPL_COCOA) \ + || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_5) /* Don't know how to do this for anything other than OSX >= 10.5 This is wrong, as it might run Lisp code in the event loop. */ ns_update_menubar (frame, true, self); @@ -1240,7 +1240,7 @@ update_frame_tool_bar (FRAME_PTR f) #ifdef NS_IMPL_GNUSTEP [self insertItemWithItemIdentifier: identifier atIndex: idx]; #endif - + [item setTag: tag]; [item setEnabled: enabled]; diff --git a/src/nsterm.m b/src/nsterm.m index 97a6313489d..d7cea5c189a 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3603,7 +3603,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, /* Inform fd_handler that select should be called */ c = 'g'; - emacs_write (selfds[1], &c, 1); + emacs_write_sig (selfds[1], &c, 1); } else if (nr == 0 && timeout) { @@ -3636,7 +3636,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, if (nr > 0 && readfds) { c = 's'; - emacs_write (selfds[1], &c, 1); + emacs_write_sig (selfds[1], &c, 1); } unblock_input (); @@ -4142,7 +4142,7 @@ ns_term_init (Lisp_Object display_name) if (selfds[0] == -1) { - if (pipe (selfds) == -1) + if (pipe2 (selfds, O_CLOEXEC) != 0) { fprintf (stderr, "Failed to create pipe: %s\n", emacs_strerror (errno)); @@ -4419,6 +4419,16 @@ ns_term_shutdown (int sig) /* NSTRACE (sendEvent); */ /*fprintf (stderr, "received event of type %d\t%d\n", type);*/ +#ifdef NS_IMPL_GNUSTEP + // Keyboard events aren't propagated to file dialogs for some reason. + if ([NSApp modalWindow] != nil && + (type == NSKeyDown || type == NSKeyUp || type == NSFlagsChanged)) + { + [[NSApp modalWindow] sendEvent: theEvent]; + return; + } +#endif + if (type == NSApplicationDefined) { switch ([theEvent data2]) diff --git a/src/print.c b/src/print.c index 09519d93cfe..01e490dcbad 100644 --- a/src/print.c +++ b/src/print.c @@ -1765,9 +1765,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else if (WINDOWP (obj)) { - int len; - strout ("#<window ", -1, -1, printcharfun); - len = sprintf (buf, "%p", XWINDOW (obj)); + void *ptr = XWINDOW (obj); + int len = sprintf (buf, "#<window %p", ptr); strout (buf, len, len, printcharfun); if (BUFFERP (XWINDOW (obj)->contents)) { @@ -1798,6 +1797,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) ptrdiff_t real_size, size; int len; #if 0 + void *ptr = h; strout ("#<hash-table", -1, -1, printcharfun); if (SYMBOLP (h->test)) { @@ -1810,9 +1810,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) len = sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next)); strout (buf, len, len, printcharfun); } - len = sprintf (buf, " %p", h); + len = sprintf (buf, " %p>", ptr); strout (buf, len, len, printcharfun); - PRINTCHAR ('>'); #endif /* Implement a readable output, e.g.: #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ @@ -1892,6 +1891,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) else if (FRAMEP (obj)) { int len; + void *ptr = XFRAME (obj); Lisp_Object frame_name = XFRAME (obj)->name; strout ((FRAME_LIVE_P (XFRAME (obj)) @@ -1907,9 +1907,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) frame_name = build_string ("*INVALID*FRAME*NAME*"); } print_string (frame_name, printcharfun); - len = sprintf (buf, " %p", XFRAME (obj)); + len = sprintf (buf, " %p>", ptr); strout (buf, len, len, printcharfun); - PRINTCHAR ('>'); } else if (FONTP (obj)) { diff --git a/src/process.c b/src/process.c index 2e2610ffde4..dc37bfe7067 100644 --- a/src/process.c +++ b/src/process.c @@ -135,6 +135,37 @@ extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, EMACS_TIME *, void *); #endif +#ifndef SOCK_CLOEXEC +# define SOCK_CLOEXEC 0 +#endif + +#ifndef HAVE_ACCEPT4 + +/* Emulate GNU/Linux accept4 and socket well enough for this module. */ + +static int +close_on_exec (int fd) +{ + if (0 <= fd) + fcntl (fd, F_SETFD, FD_CLOEXEC); + return fd; +} + +static int +accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags) +{ + return close_on_exec (accept (sockfd, addr, addrlen)); +} + +static int +process_socket (int domain, int type, int protocol) +{ + return close_on_exec (socket (domain, type, protocol)); +} +# undef socket +# define socket(domain, type, protocol) process_socket (domain, type, protocol) +#endif + /* Work around GCC 4.7.0 bug with strict overflow checking; see <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>. These lines can be removed once the GCC bug is fixed. */ @@ -1782,6 +1813,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) { int inchannel, outchannel; pid_t pid; + int vfork_errno; int sv[2]; #ifndef WINDOWSNT int wait_child_setup[2]; @@ -1816,47 +1848,30 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) else #endif /* HAVE_PTYS */ { - int tem; - tem = pipe (sv); - if (tem < 0) + if (pipe2 (sv, O_CLOEXEC) != 0) report_file_error ("Creating pipe", Qnil); inchannel = sv[0]; forkout = sv[1]; - tem = pipe (sv); - if (tem < 0) + if (pipe2 (sv, O_CLOEXEC) != 0) { + int pipe_errno = errno; emacs_close (inchannel); emacs_close (forkout); - report_file_error ("Creating pipe", Qnil); + report_file_errno ("Creating pipe", Qnil, pipe_errno); } outchannel = sv[1]; forkin = sv[0]; } #ifndef WINDOWSNT - { - int tem; - - tem = pipe (wait_child_setup); - if (tem < 0) - report_file_error ("Creating pipe", Qnil); - tem = fcntl (wait_child_setup[1], F_GETFD, 0); - if (tem >= 0) - tem = fcntl (wait_child_setup[1], F_SETFD, tem | FD_CLOEXEC); - if (tem < 0) - { - emacs_close (wait_child_setup[0]); - emacs_close (wait_child_setup[1]); - report_file_error ("Setting file descriptor flags", Qnil); - } - } + if (pipe2 (wait_child_setup, O_CLOEXEC) != 0) + report_file_error ("Creating pipe", Qnil); #endif fcntl (inchannel, F_SETFL, O_NONBLOCK); fcntl (outchannel, F_SETFL, O_NONBLOCK); - /* Record this as an active process, with its channels. - As a result, child_setup will close Emacs's side of the pipes. */ + /* Record this as an active process, with its channels. */ chan_process[inchannel] = process; XPROCESS (process)->infd = inchannel; XPROCESS (process)->outfd = outchannel; @@ -1933,7 +1948,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) tcgetattr (xforkin, &t); t.c_lflag = LDISC1; if (tcsetattr (xforkin, TCSANOW, &t) < 0) - emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39); + emacs_perror ("create_process/tcsetattr LDISC1"); } #else #if defined (NTTYDISC) && defined (TIOCSETD) @@ -1980,10 +1995,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (xforkin < 0) { - emacs_write (1, "Couldn't open the pty terminal ", 31); - emacs_write (1, pty_name, strlen (pty_name)); - emacs_write (1, "\n", 1); - _exit (1); + emacs_perror (pty_name); + _exit (EXIT_CANCELED); } } @@ -1995,12 +2008,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) SETUP_SLAVE_PTY; } #endif /* SETUP_SLAVE_PTY */ -#ifdef AIX - /* On AIX, we've disabled SIGHUP above once we start a child on a pty. - Now reenable it in the child, so it will die when we want it to. */ - if (pty_flag) - signal (SIGHUP, SIG_DFL); -#endif #endif /* HAVE_PTYS */ signal (SIGINT, SIG_DFL); @@ -2026,6 +2033,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) /* Back in the parent process. */ + vfork_errno = errno; XPROCESS (process)->pid = pid; if (pid >= 0) XPROCESS (process)->alive = 1; @@ -2040,6 +2048,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) emacs_close (forkin); if (forkin != forkout && forkout >= 0) emacs_close (forkout); + report_file_errno ("Doing vfork", Qnil, vfork_errno); } else { @@ -2085,10 +2094,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) } #endif } - - /* Now generate the error if vfork failed. */ - if (pid < 0) - report_file_error ("Doing vfork", Qnil); } void @@ -3323,7 +3328,8 @@ usage: (make-network-process &rest ARGS) */) retry_connect: #endif - s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol); + s = socket (lres->ai_family, lres->ai_socktype | SOCK_CLOEXEC, + lres->ai_protocol); if (s < 0) { xerrno = errno; @@ -3447,12 +3453,11 @@ usage: (make-network-process &rest ARGS) */) len = sizeof xerrno; eassert (FD_ISSET (s, &fdset)); - if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) == -1) + if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0) report_file_error ("getsockopt failed", Qnil); if (xerrno) - errno = xerrno, report_file_error ("error during connect", Qnil); - else - break; + report_file_errno ("error during connect", Qnil, xerrno); + break; } #endif /* !WINDOWSNT */ @@ -3536,11 +3541,10 @@ usage: (make-network-process &rest ARGS) */) if (is_non_blocking_client) return Qnil; - errno = xerrno; - if (is_server) - report_file_error ("make server process failed", contact); - else - report_file_error ("make client process failed", contact); + report_file_errno ((is_server + ? "make server process failed" + : "make client process failed"), + contact, xerrno); } inch = s; @@ -3713,7 +3717,7 @@ format; see the description of ADDRESS in `make-network-process'. */) int s; Lisp_Object res; - s = socket (AF_INET, SOCK_STREAM, 0); + s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); if (s < 0) return Qnil; @@ -3724,14 +3728,14 @@ format; see the description of ADDRESS in `make-network-process'. */) ifconf.ifc_len = buf_size; if (ioctl (s, SIOCGIFCONF, &ifconf)) { - close (s); + emacs_close (s); xfree (buf); return Qnil; } } while (ifconf.ifc_len == buf_size); - close (s); + emacs_close (s); res = Qnil; ifreq = ifconf.ifc_req; @@ -3869,7 +3873,7 @@ FLAGS is the current flags of the interface. */) error ("interface name too long"); strcpy (rq.ifr_name, SSDATA (ifname)); - s = socket (AF_INET, SOCK_STREAM, 0); + s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); if (s < 0) return Qnil; @@ -3988,7 +3992,7 @@ FLAGS is the current flags of the interface. */) #endif res = Fcons (elt, res); - close (s); + emacs_close (s); return any ? res : Qnil; } @@ -4161,7 +4165,7 @@ server_accept_connection (Lisp_Object server, int channel) } saddr; socklen_t len = sizeof saddr; - s = accept (channel, &saddr.sa, &len); + s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC); if (s < 0) { @@ -4785,20 +4789,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (xerrno == EINTR) no_avail = 1; else if (xerrno == EBADF) - { -#ifdef AIX - /* AIX doesn't handle PTY closure the same way BSD does. On AIX, - the child's closure of the pts gives the parent a SIGHUP, and - the ptc file descriptor is automatically closed, - yielding EBADF here or at select() call above. - So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF - in m/ibmrt-aix.h), and here we just ignore the select error. - Cleanup occurs c/o status_notify after SIGCHLD. */ - no_avail = 1; /* Cannot depend on values returned */ -#else - emacs_abort (); -#endif - } + emacs_abort (); else error ("select error: %s", emacs_strerror (xerrno)); } @@ -5648,7 +5639,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, written = emacs_gnutls_write (p, cur_buf, cur_len); else #endif - written = emacs_write (outfd, cur_buf, cur_len); + written = emacs_write_sig (outfd, cur_buf, cur_len); rv = (written ? 0 : -1); #ifdef ADAPTIVE_READ_BUFFERING if (p->read_output_delay > 0 @@ -7010,32 +7001,6 @@ setup_process_coding_systems (Lisp_Object process) #endif } -/* Close all descriptors currently in use for communication - with subprocess. This is used in a newly-forked subprocess - to get rid of irrelevant descriptors. */ - -void -close_process_descs (void) -{ -#ifndef DOS_NT - int i; - for (i = 0; i < MAXDESC; i++) - { - Lisp_Object process; - process = chan_process[i]; - if (!NILP (process)) - { - int in = XPROCESS (process)->infd; - int out = XPROCESS (process)->outfd; - if (in >= 0) - emacs_close (in); - if (out >= 0 && in != out) - emacs_close (out); - } - } -#endif -} - DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, doc: /* Return the (or a) process associated with BUFFER. BUFFER may be a buffer or the name of one. */) diff --git a/src/process.h b/src/process.h index 52142e55e94..89c7e8b1259 100644 --- a/src/process.h +++ b/src/process.h @@ -201,6 +201,14 @@ extern Lisp_Object QCspeed; extern Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven; extern Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary; +/* Exit statuses for GNU programs that exec other programs. */ +enum +{ + EXIT_CANCELED = 125, /* Internal error prior to exec attempt. */ + EXIT_CANNOT_INVOKE = 126, /* Program located, but not usable. */ + EXIT_ENOENT = 127 /* Could not find program to exec. */ +}; + /* Defined in callproc.c. */ extern void block_child_signal (void); diff --git a/src/profiler.c b/src/profiler.c index aba81344c68..c86fb47d21d 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -568,12 +568,12 @@ to make room for new entries. */); profiler_log_size = 10000; DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); - { - struct hash_table_test test - = { Qprofiler_backtrace_equal, Qnil, Qnil, - cmpfn_profiler, hashfn_profiler }; - hashtest_profiler = test; - } + + hashtest_profiler.name = Qprofiler_backtrace_equal; + hashtest_profiler.user_hash_function = Qnil; + hashtest_profiler.user_cmp_function = Qnil; + hashtest_profiler.cmpfn = cmpfn_profiler; + hashtest_profiler.hashfn = hashfn_profiler; defsubr (&Sfunction_equal); diff --git a/src/regex.c b/src/regex.c index 73a735cea65..5024f748884 100644 --- a/src/regex.c +++ b/src/regex.c @@ -531,8 +531,10 @@ init_syntax_once (void) /* Type of source-pattern and string chars. */ #ifdef _MSC_VER typedef unsigned char re_char; +typedef const re_char const_re_char; #else typedef const unsigned char re_char; +typedef re_char const_re_char; #endif typedef char boolean; @@ -2019,7 +2021,7 @@ struct range_table_work_area /* Map a string to the char class it names (if any). */ re_wctype_t -re_wctype (const re_char *str) +re_wctype (const_re_char *str) { const char *string = (const char *) str; if (STREQ (string, "alnum")) return RECC_ALNUM; @@ -2413,7 +2415,8 @@ do { \ } while (0) static reg_errcode_t -regex_compile (const re_char *pattern, size_t size, reg_syntax_t syntax, struct re_pattern_buffer *bufp) +regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax, + struct re_pattern_buffer *bufp) { /* We fetch characters from PATTERN here. */ register re_wchar_t c, c1; @@ -3769,7 +3772,7 @@ insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned cha least one character before the ^. */ static boolean -at_begline_loc_p (const re_char *pattern, const re_char *p, reg_syntax_t syntax) +at_begline_loc_p (const_re_char *pattern, const_re_char *p, reg_syntax_t syntax) { re_char *prev = p - 2; boolean odd_backslashes; @@ -3810,7 +3813,7 @@ at_begline_loc_p (const re_char *pattern, const re_char *p, reg_syntax_t syntax) at least one character after the $, i.e., `P < PEND'. */ static boolean -at_endline_loc_p (const re_char *p, const re_char *pend, reg_syntax_t syntax) +at_endline_loc_p (const_re_char *p, const_re_char *pend, reg_syntax_t syntax) { re_char *next = p; boolean next_backslash = *next == '\\'; @@ -3854,7 +3857,8 @@ group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum) Return -1 if fastmap was not updated accurately. */ static int -analyse_first (const re_char *p, const re_char *pend, char *fastmap, const int multibyte) +analyse_first (const_re_char *p, const_re_char *pend, char *fastmap, + const int multibyte) { int j, k; boolean not; @@ -4598,7 +4602,7 @@ static int bcmp_translate (re_char *s1, re_char *s2, /* If the operation is a match against one or more chars, return a pointer to the next operation, else return NULL. */ static re_char * -skip_one_char (const re_char *p) +skip_one_char (const_re_char *p) { switch (*p++) { @@ -4640,7 +4644,7 @@ skip_one_char (const re_char *p) /* Jump over non-matching operations. */ static re_char * -skip_noops (const re_char *p, const re_char *pend) +skip_noops (const_re_char *p, const_re_char *pend) { int mcnt; while (p < pend) @@ -4667,7 +4671,8 @@ skip_noops (const re_char *p, const re_char *pend) /* Non-zero if "p1 matches something" implies "p2 fails". */ static int -mutually_exclusive_p (struct re_pattern_buffer *bufp, const re_char *p1, const re_char *p2) +mutually_exclusive_p (struct re_pattern_buffer *bufp, const_re_char *p1, + const_re_char *p2) { re_opcode_t op2; const boolean multibyte = RE_MULTIBYTE_P (bufp); @@ -4920,8 +4925,8 @@ WEAK_ALIAS (__re_match_2, re_match_2) /* This is a separate function so that we can force an alloca cleanup afterwards. */ static regoff_t -re_match_2_internal (struct re_pattern_buffer *bufp, const re_char *string1, - size_t size1, const re_char *string2, size_t size2, +re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, + size_t size1, const_re_char *string2, size_t size2, ssize_t pos, struct re_registers *regs, ssize_t stop) { /* General temporaries. */ @@ -6263,7 +6268,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const re_char *string1, bytes; nonzero otherwise. */ static int -bcmp_translate (const re_char *s1, const re_char *s2, register ssize_t len, +bcmp_translate (const_re_char *s1, const_re_char *s2, register ssize_t len, RE_TRANSLATE_TYPE translate, const int target_multibyte) { register re_char *p1 = s1, *p2 = s2; @@ -6432,7 +6437,7 @@ re_exec (const char *s) the return codes and their meanings.) */ reg_errcode_t -regcomp (regex_t *__restrict preg, const char *__restrict pattern, +regcomp (regex_t *_Restrict_ preg, const char *_Restrict_ pattern, int cflags) { reg_errcode_t ret; @@ -6513,8 +6518,8 @@ WEAK_ALIAS (__regcomp, regcomp) We return 0 if we find a match and REG_NOMATCH if not. */ reg_errcode_t -regexec (const regex_t *__restrict preg, const char *__restrict string, - size_t nmatch, regmatch_t pmatch[__restrict_arr], int eflags) +regexec (const regex_t *_Restrict_ preg, const char *_Restrict_ string, + size_t nmatch, regmatch_t pmatch[_Restrict_arr_], int eflags) { regoff_t ret; struct re_registers regs; diff --git a/src/regex.h b/src/regex.h index 175eed10177..31be0504c9e 100644 --- a/src/regex.h +++ b/src/regex.h @@ -528,31 +528,41 @@ extern int re_exec (const char *); #endif /* GCC 2.95 and later have "__restrict"; C99 compilers have - "restrict", and "configure" may have defined "restrict". */ -#ifndef __restrict -# if ! (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95)) -# if defined restrict || 199901L <= __STDC_VERSION__ -# define __restrict restrict -# else -# define __restrict -# endif + "restrict", and "configure" may have defined "restrict". + Other compilers use __restrict, __restrict__, and _Restrict, and + 'configure' might #define 'restrict' to those words, so pick a + different name. */ +#ifndef _Restrict_ +# if 199901L <= __STDC_VERSION__ +# define _Restrict_ restrict +# elif 2 < __GNUC__ || (2 == __GNUC__ && 95 <= __GNUC_MINOR__) +# define _Restrict_ __restrict +# else +# define _Restrict_ # endif #endif -/* For now conditionally define __restrict_arr to expand to nothing. - Ideally we would have a test for the compiler which allows defining - it to restrict. */ -#ifndef __restrict_arr -# define __restrict_arr +/* gcc 3.1 and up support the [restrict] syntax. Don't trust + sys/cdefs.h's definition of __restrict_arr, though, as it + mishandles gcc -ansi -pedantic. */ +#ifndef _Restrict_arr_ +# if ((199901L <= __STDC_VERSION__ \ + || ((3 < __GNUC__ || (3 == __GNUC__ && 1 <= __GNUC_MINOR__)) \ + && !defined __STRICT_ANSI__)) \ + && !defined __GNUG__) +# define _Restrict_arr_ _Restrict_ +# else +# define _Restrict_arr_ +# endif #endif /* POSIX compatibility. */ -extern reg_errcode_t regcomp (regex_t *__restrict __preg, - const char *__restrict __pattern, +extern reg_errcode_t regcomp (regex_t *_Restrict_ __preg, + const char *_Restrict_ __pattern, int __cflags); -extern reg_errcode_t regexec (const regex_t *__restrict __preg, - const char *__restrict __string, size_t __nmatch, - regmatch_t __pmatch[__restrict_arr], +extern reg_errcode_t regexec (const regex_t *_Restrict_ __preg, + const char *_Restrict_ __string, size_t __nmatch, + regmatch_t __pmatch[_Restrict_arr_], int __eflags); extern size_t regerror (int __errcode, const regex_t * __preg, diff --git a/src/search.c b/src/search.c index b4e3cca8269..ff47bb2fecf 100644 --- a/src/search.c +++ b/src/search.c @@ -22,10 +22,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <config.h> #include "lisp.h" -#include "syntax.h" #include "category.h" #include "character.h" #include "buffer.h" +#include "syntax.h" #include "charset.h" #include "region-cache.h" #include "commands.h" diff --git a/src/sheap.c b/src/sheap.c index f8eec753268..54eef60c27d 100644 --- a/src/sheap.c +++ b/src/sheap.c @@ -25,7 +25,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <unistd.h> +#ifdef __x86_64__ +#define STATIC_HEAP_SIZE (18 * 1024 * 1024) +#else #define STATIC_HEAP_SIZE (13 * 1024 * 1024) +#endif int debug_sheap = 0; diff --git a/src/sound.c b/src/sound.c index 7f0ede5b398..5ce185ea60e 100644 --- a/src/sound.c +++ b/src/sound.c @@ -879,7 +879,7 @@ vox_init (struct sound_device *sd) static void vox_write (struct sound_device *sd, const char *buffer, ptrdiff_t nbytes) { - if (emacs_write (sd->fd, buffer, nbytes) != nbytes) + if (emacs_write_sig (sd->fd, buffer, nbytes) != nbytes) sound_perror ("Error writing to sound device"); } diff --git a/src/syntax.c b/src/syntax.c index ea15cf68c43..6d52d115889 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -20,6 +20,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <config.h> +#define SYNTAX_INLINE EXTERN_INLINE + #include <sys/types.h> #include "lisp.h" @@ -58,54 +60,86 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ For style c (like the nested flag), the flag can be placed on any of the chars. */ -/* These macros extract specific flags from an integer +/* These functions extract specific flags from an integer that holds the syntax code and the flags. */ -#define SYNTAX_FLAGS_COMSTART_FIRST(flags) (((flags) >> 16) & 1) - -#define SYNTAX_FLAGS_COMSTART_SECOND(flags) (((flags) >> 17) & 1) - -#define SYNTAX_FLAGS_COMEND_FIRST(flags) (((flags) >> 18) & 1) - -#define SYNTAX_FLAGS_COMEND_SECOND(flags) (((flags) >> 19) & 1) - -#define SYNTAX_FLAGS_PREFIX(flags) (((flags) >> 20) & 1) +static bool +SYNTAX_FLAGS_COMSTART_FIRST (int flags) +{ + return (flags >> 16) & 1; +} +static bool +SYNTAX_FLAGS_COMSTART_SECOND (int flags) +{ + return (flags >> 17) & 1; +} +static bool +SYNTAX_FLAGS_COMEND_FIRST (int flags) +{ + return (flags >> 18) & 1; +} +static bool +SYNTAX_FLAGS_COMEND_SECOND (int flags) +{ + return (flags >> 19) & 1; +} +static bool +SYNTAX_FLAGS_PREFIX (int flags) +{ + return (flags >> 20) & 1; +} +static bool +SYNTAX_FLAGS_COMMENT_STYLEB (int flags) +{ + return (flags >> 21) & 1; +} +static bool +SYNTAX_FLAGS_COMMENT_STYLEC (int flags) +{ + return (flags >> 23) & 1; +} +static int +SYNTAX_FLAGS_COMMENT_STYLEC2 (int flags) +{ + return (flags >> 22) & 2; /* SYNTAX_FLAGS_COMMENT_STYLEC (flags) * 2 */ +} +static bool +SYNTAX_FLAGS_COMMENT_NESTED (int flags) +{ + return (flags >> 22) & 1; +} -#define SYNTAX_FLAGS_COMMENT_STYLEB(flags) (((flags) >> 21) & 1) -#define SYNTAX_FLAGS_COMMENT_STYLEC(flags) (((flags) >> 23) & 1) -#define SYNTAX_FLAGS_COMMENT_STYLEC2(flags) (((flags) >> 22) & 2) /* C * 2 */ /* FLAGS should be the flags of the main char of the comment marker, e.g. the second for comstart and the first for comend. */ -#define SYNTAX_FLAGS_COMMENT_STYLE(flags, other_flags) \ - (SYNTAX_FLAGS_COMMENT_STYLEB (flags) \ - | SYNTAX_FLAGS_COMMENT_STYLEC2 (flags) \ - | SYNTAX_FLAGS_COMMENT_STYLEC2 (other_flags)) - -#define SYNTAX_FLAGS_COMMENT_NESTED(flags) (((flags) >> 22) & 1) +static int +SYNTAX_FLAGS_COMMENT_STYLE (int flags, int other_flags) +{ + return (SYNTAX_FLAGS_COMMENT_STYLEB (flags) + | SYNTAX_FLAGS_COMMENT_STYLEC2 (flags) + | SYNTAX_FLAGS_COMMENT_STYLEC2 (other_flags)); +} -/* These macros extract a particular flag for a given character. */ +/* Extract a particular flag for a given character. */ -#define SYNTAX_COMEND_FIRST(c) \ - (SYNTAX_FLAGS_COMEND_FIRST (SYNTAX_WITH_FLAGS (c))) -#define SYNTAX_PREFIX(c) (SYNTAX_FLAGS_PREFIX (SYNTAX_WITH_FLAGS (c))) +static bool +SYNTAX_COMEND_FIRST (int c) +{ + return SYNTAX_FLAGS_COMEND_FIRST (SYNTAX_WITH_FLAGS (c)); +} /* We use these constants in place for comment-style and - string-ender-char to distinguish comments/strings started by + string-ender-char to distinguish comments/strings started by comment_fence and string_fence codes. */ -#define ST_COMMENT_STYLE (256 + 1) -#define ST_STRING_STYLE (256 + 2) +enum + { + ST_COMMENT_STYLE = 256 + 1, + ST_STRING_STYLE = 256 + 2 + }; static Lisp_Object Qsyntax_table_p; static Lisp_Object Qsyntax_table, Qscan_error; -#ifndef __GNUC__ -/* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h, - if not compiled with GCC. No need to mark it, since it is used - only very temporarily. */ -Lisp_Object syntax_temp; -#endif - /* This is the internal form of the parse state used in parse-partial-sexp. */ struct lisp_parse_state @@ -162,14 +196,107 @@ bset_syntax_table (struct buffer *b, Lisp_Object val) bool syntax_prefix_flag_p (int c) { - return SYNTAX_PREFIX (c); + return SYNTAX_FLAGS_PREFIX (SYNTAX_WITH_FLAGS (c)); } struct gl_state_s gl_state; /* Global state of syntax parser. */ -#define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals +enum { INTERVALS_AT_ONCE = 10 }; /* 1 + max-number of intervals to scan to property-change. */ +/* Set the syntax entry VAL for char C in table TABLE. */ + +static void +SET_RAW_SYNTAX_ENTRY (Lisp_Object table, int c, Lisp_Object val) +{ + CHAR_TABLE_SET (table, c, val); +} + +/* Set the syntax entry VAL for char-range RANGE in table TABLE. + RANGE is a cons (FROM . TO) specifying the range of characters. */ + +static void +SET_RAW_SYNTAX_ENTRY_RANGE (Lisp_Object table, Lisp_Object range, + Lisp_Object val) +{ + Fset_char_table_range (table, range, val); +} + +/* Extract the information from the entry for character C + in the current syntax table. */ + +static Lisp_Object +SYNTAX_MATCH (int c) +{ + Lisp_Object ent = SYNTAX_ENTRY (c); + return CONSP (ent) ? XCDR (ent) : Qnil; +} + +/* This should be called with FROM at the start of forward + search, or after the last position of the backward search. It + makes sure that the first char is picked up with correct table, so + one does not need to call UPDATE_SYNTAX_TABLE immediately after the + call. + Sign of COUNT gives the direction of the search. + */ + +static void +SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count) +{ + SETUP_BUFFER_SYNTAX_TABLE (); + gl_state.b_property = BEGV; + gl_state.e_property = ZV + 1; + gl_state.object = Qnil; + gl_state.offset = 0; + if (parse_sexp_lookup_properties) + if (count > 0 || from > BEGV) + update_syntax_table (count > 0 ? from : from - 1, count, 1, Qnil); +} + +/* Same as above, but in OBJECT. If OBJECT is nil, use current buffer. + If it is t (which is only used in fast_c_string_match_ignore_case), + ignore properties altogether. + + This is meant for regex.c to use. For buffers, regex.c passes arguments + to the UPDATE_SYNTAX_TABLE functions which are relative to BEGV. + So if it is a buffer, we set the offset field to BEGV. */ + +void +SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object object, + ptrdiff_t from, ptrdiff_t count) +{ + SETUP_BUFFER_SYNTAX_TABLE (); + gl_state.object = object; + if (BUFFERP (gl_state.object)) + { + struct buffer *buf = XBUFFER (gl_state.object); + gl_state.b_property = 1; + gl_state.e_property = BUF_ZV (buf) - BUF_BEGV (buf) + 1; + gl_state.offset = BUF_BEGV (buf) - 1; + } + else if (NILP (gl_state.object)) + { + gl_state.b_property = 1; + gl_state.e_property = ZV - BEGV + 1; + gl_state.offset = BEGV - 1; + } + else if (EQ (gl_state.object, Qt)) + { + gl_state.b_property = 0; + gl_state.e_property = PTRDIFF_MAX; + gl_state.offset = 0; + } + else + { + gl_state.b_property = 0; + gl_state.e_property = 1 + SCHARS (gl_state.object); + gl_state.offset = 0; + } + if (parse_sexp_lookup_properties) + update_syntax_table (from + gl_state.offset - (count <= 0), + count, 1, gl_state.object); +} + /* Update gl_state to an appropriate interval which contains CHARPOS. The sign of COUNT give the relative position of CHARPOS wrt the previously valid interval. If INIT, only [be]_property fields of gl_state are @@ -1751,7 +1878,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, } immediate_quit = 1; - /* This code may look up syntax tables using macros that rely on the + /* This code may look up syntax tables using functions that rely on the gl_state object. To make sure this object is not out of date, let's initialize it manually. We ignore syntax-table text-properties for now, since that's @@ -2426,11 +2553,13 @@ between them, return t; otherwise return nil. */) } /* Return syntax code of character C if C is an ASCII character - or `multibyte_symbol_p' is zero. Otherwise, return Ssymbol. */ + or if MULTIBYTE_SYMBOL_P is false. Otherwise, return Ssymbol. */ -#define SYNTAX_WITH_MULTIBYTE_CHECK(c) \ - ((ASCII_CHAR_P (c) || !multibyte_symbol_p) \ - ? SYNTAX (c) : Ssymbol) +static enum syntaxcode +syntax_multibyte (int c, bool multibyte_symbol_p) +{ + return ASCII_CHAR_P (c) || !multibyte_symbol_p ? SYNTAX (c) : Ssymbol; +} static Lisp_Object scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) @@ -2441,7 +2570,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) int stringterm; bool quoted; bool mathexit = 0; - enum syntaxcode code, temp_code, c_code; + enum syntaxcode code; EMACS_INT min_depth = depth; /* Err out if depth gets less than this. */ int comstyle = 0; /* style of comment encountered */ bool comnested = 0; /* whether the comment is nestable or not */ @@ -2473,7 +2602,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) UPDATE_SYNTAX_TABLE_FORWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); syntax = SYNTAX_WITH_FLAGS (c); - code = SYNTAX_WITH_MULTIBYTE_CHECK (c); + code = syntax_multibyte (c, multibyte_symbol_p); comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax); comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0); @@ -2519,10 +2648,8 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { UPDATE_SYNTAX_TABLE_FORWARD (from); - /* Some compilers can't handle this inside the switch. */ c = FETCH_CHAR_AS_MULTIBYTE (from_byte); - c_code = SYNTAX_WITH_MULTIBYTE_CHECK (c); - switch (c_code) + switch (syntax_multibyte (c, multibyte_symbol_p)) { case Scharquote: case Sescape: @@ -2594,18 +2721,17 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) stringterm = FETCH_CHAR_AS_MULTIBYTE (temp_pos); while (1) { + enum syntaxcode c_code; if (from >= stop) goto lose; UPDATE_SYNTAX_TABLE_FORWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + c_code = syntax_multibyte (c, multibyte_symbol_p); if (code == Sstring - ? (c == stringterm - && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring) - : SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring_fence) + ? c == stringterm && c_code == Sstring + : c_code == Sstring_fence) break; - /* Some compilers can't handle this inside the switch. */ - c_code = SYNTAX_WITH_MULTIBYTE_CHECK (c); switch (c_code) { case Scharquote: @@ -2644,7 +2770,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); syntax= SYNTAX_WITH_FLAGS (c); - code = SYNTAX_WITH_MULTIBYTE_CHECK (c); + code = syntax_multibyte (c, multibyte_symbol_p); if (depth == min_depth) last_good = from; comstyle = 0; @@ -2697,9 +2823,8 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) temp_pos--; UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos); - temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1); /* Don't allow comment-end to be quoted. */ - if (temp_code == Sendcomment) + if (syntax_multibyte (c1, multibyte_symbol_p) == Sendcomment) goto done2; quoted = char_quoted (from - 1, temp_pos); if (quoted) @@ -2709,11 +2834,12 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); } c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos); - temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1); - if (! (quoted || temp_code == Sword - || temp_code == Ssymbol - || temp_code == Squote)) - goto done2; + if (! quoted) + switch (syntax_multibyte (c1, multibyte_symbol_p)) + { + case Sword: case Ssymbol: case Squote: break; + default: goto done2; + } DEC_BOTH (from, from_byte); } goto done2; @@ -2768,10 +2894,12 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) goto lose; DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); - if (!char_quoted (from, from_byte) - && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte), - SYNTAX_WITH_MULTIBYTE_CHECK (c) == code)) - break; + if (!char_quoted (from, from_byte)) + { + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + if (syntax_multibyte (c, multibyte_symbol_p) == code) + break; + } } if (code == Sstring_fence && !depth && sexpflag) goto done2; break; @@ -2784,11 +2912,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) goto lose; DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); - if (!char_quoted (from, from_byte) - && (stringterm - == (c = FETCH_CHAR_AS_MULTIBYTE (from_byte))) - && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring) - break; + if (!char_quoted (from, from_byte)) + { + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + if (c == stringterm + && (syntax_multibyte (c, multibyte_symbol_p) + == Sstring)) + break; + } } if (!depth && sexpflag) goto done2; break; @@ -2894,7 +3025,7 @@ This includes chars with "quote" or "prefix" syntax (' or p). */) while (!char_quoted (pos, pos_byte) /* Previous statement updates syntax table. */ && ((c = FETCH_CHAR_AS_MULTIBYTE (pos_byte), SYNTAX (c) == Squote) - || SYNTAX_PREFIX (c))) + || syntax_prefix_flag_p (c))) { opoint = pos; opoint_byte = pos_byte; @@ -3117,10 +3248,8 @@ do { prev_from = from; \ symstarted: while (from < end) { - /* Some compilers can't handle this inside the switch. */ int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); - enum syntaxcode symcharcode = SYNTAX (symchar); - switch (symcharcode) + switch (SYNTAX (symchar)) { case Scharquote: case Sescape: @@ -3206,7 +3335,6 @@ do { prev_from = from; \ if (from >= end) goto done; c = FETCH_CHAR_AS_MULTIBYTE (from_byte); - /* Some compilers can't handle this inside the switch. */ c_code = SYNTAX (c); /* Check C_CODE here so that if the char has diff --git a/src/syntax.h b/src/syntax.h index 58d39b9059c..1b96284af42 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -18,6 +18,10 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ +INLINE_HEADER_BEGIN +#ifndef SYNTAX_INLINE +# define SYNTAX_INLINE INLINE +#endif extern void update_syntax_table (ptrdiff_t, EMACS_INT, bool, Lisp_Object); @@ -54,79 +58,64 @@ enum syntaxcode Smax /* Upper bound on codes that are meaningful */ }; -/* Set the syntax entry VAL for char C in table TABLE. */ - -#define SET_RAW_SYNTAX_ENTRY(table, c, val) \ - CHAR_TABLE_SET ((table), c, (val)) -/* Set the syntax entry VAL for char-range RANGE in table TABLE. - RANGE is a cons (FROM . TO) specifying the range of characters. */ +struct gl_state_s +{ + Lisp_Object object; /* The object we are scanning. */ + ptrdiff_t start; /* Where to stop. */ + ptrdiff_t stop; /* Where to stop. */ + bool use_global; /* Whether to use global_code + or c_s_t. */ + Lisp_Object global_code; /* Syntax code of current char. */ + Lisp_Object current_syntax_table; /* Syntax table for current pos. */ + Lisp_Object old_prop; /* Syntax-table prop at prev pos. */ + ptrdiff_t b_property; /* First index where c_s_t is valid. */ + ptrdiff_t e_property; /* First index where c_s_t is + not valid. */ + INTERVAL forward_i; /* Where to start lookup on forward */ + INTERVAL backward_i; /* or backward movement. The + data in c_s_t is valid + between these intervals, + and possibly at the + intervals too, depending + on: */ + /* Offset for positions specified to UPDATE_SYNTAX_TABLE. */ + ptrdiff_t offset; +}; -#define SET_RAW_SYNTAX_ENTRY_RANGE(table, range, val) \ - Fset_char_table_range ((table), (range), (val)) +extern struct gl_state_s gl_state; -/* SYNTAX_ENTRY fetches the information from the entry for character C +/* Fetch the information from the entry for character C in syntax table TABLE, or from globally kept data (gl_state). Does inheritance. */ -/* CURRENT_SYNTAX_TABLE gives the syntax table valid for current - position, it is either the buffer's syntax table, or syntax table - found in text properties. */ +SYNTAX_INLINE Lisp_Object +SYNTAX_ENTRY (int c) +{ #ifdef SYNTAX_ENTRY_VIA_PROPERTY -# define SYNTAX_ENTRY(c) \ - (gl_state.use_global ? gl_state.global_code : SYNTAX_ENTRY_INT (c)) -# define CURRENT_SYNTAX_TABLE gl_state.current_syntax_table + return (gl_state.use_global + ? gl_state.global_code + : CHAR_TABLE_REF (gl_state.current_syntax_table, c)); #else -# define SYNTAX_ENTRY SYNTAX_ENTRY_INT -# define CURRENT_SYNTAX_TABLE BVAR (current_buffer, syntax_table) + return CHAR_TABLE_REF (BVAR (current_buffer, syntax_table), c); #endif - -#define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c)) +} /* Extract the information from the entry for character C in the current syntax table. */ -#ifdef __GNUC__ -#define SYNTAX(c) \ - ({ Lisp_Object _syntax_temp; \ - _syntax_temp = SYNTAX_ENTRY (c); \ - (CONSP (_syntax_temp) \ - ? (enum syntaxcode) (XINT (XCAR (_syntax_temp)) & 0xff) \ - : Swhitespace); }) - -#define SYNTAX_WITH_FLAGS(c) \ - ({ Lisp_Object _syntax_temp; \ - _syntax_temp = SYNTAX_ENTRY (c); \ - (CONSP (_syntax_temp) \ - ? XINT (XCAR (_syntax_temp)) \ - : Swhitespace); }) - -#define SYNTAX_MATCH(c) \ - ({ Lisp_Object _syntax_temp; \ - _syntax_temp = SYNTAX_ENTRY (c); \ - (CONSP (_syntax_temp) \ - ? XCDR (_syntax_temp) \ - : Qnil); }) -#else -extern Lisp_Object syntax_temp; -#define SYNTAX(c) \ - (syntax_temp = SYNTAX_ENTRY ((c)), \ - (CONSP (syntax_temp) \ - ? (enum syntaxcode) (XINT (XCAR (syntax_temp)) & 0xff) \ - : Swhitespace)) - -#define SYNTAX_WITH_FLAGS(c) \ - (syntax_temp = SYNTAX_ENTRY ((c)), \ - (CONSP (syntax_temp) \ - ? XINT (XCAR (syntax_temp)) \ - : Swhitespace)) - -#define SYNTAX_MATCH(c) \ - (syntax_temp = SYNTAX_ENTRY ((c)), \ - (CONSP (syntax_temp) \ - ? XCDR (syntax_temp) \ - : Qnil)) -#endif +SYNTAX_INLINE int +SYNTAX_WITH_FLAGS (int c) +{ + Lisp_Object ent = SYNTAX_ENTRY (c); + return CONSP (ent) ? XINT (XCAR (ent)) : Swhitespace; +} + +SYNTAX_INLINE enum syntaxcode +SYNTAX (int c) +{ + return SYNTAX_WITH_FLAGS (c) & 0xff; +} /* Whether the syntax of the character C has the prefix flag set. */ @@ -145,158 +134,65 @@ extern char const syntax_code_spec[16]; /* Convert the byte offset BYTEPOS into a character position, for the object recorded in gl_state with SETUP_SYNTAX_TABLE_FOR_OBJECT. - The value is meant for use in the UPDATE_SYNTAX_TABLE... macros. - These macros do nothing when parse_sexp_lookup_properties is 0, - so we return 0 in that case, for speed. */ - -#define SYNTAX_TABLE_BYTE_TO_CHAR(bytepos) \ - (! parse_sexp_lookup_properties \ - ? 0 \ - : STRINGP (gl_state.object) \ - ? string_byte_to_char (gl_state.object, (bytepos)) \ - : BUFFERP (gl_state.object) \ - ? buf_bytepos_to_charpos (XBUFFER (gl_state.object), \ - (bytepos) + BUF_BEGV_BYTE (XBUFFER (gl_state.object)) - 1) - BUF_BEGV (XBUFFER (gl_state.object)) + 1 \ - : NILP (gl_state.object) \ - ? BYTE_TO_CHAR ((bytepos) + BEGV_BYTE - 1) - BEGV + 1 \ - : (bytepos)) + The value is meant for use in code that does nothing when + parse_sexp_lookup_properties is 0, so return 0 in that case, for speed. */ + +SYNTAX_INLINE ptrdiff_t +SYNTAX_TABLE_BYTE_TO_CHAR (ptrdiff_t bytepos) +{ + return (! parse_sexp_lookup_properties + ? 0 + : STRINGP (gl_state.object) + ? string_byte_to_char (gl_state.object, bytepos) + : BUFFERP (gl_state.object) + ? ((buf_bytepos_to_charpos + (XBUFFER (gl_state.object), + (bytepos + BUF_BEGV_BYTE (XBUFFER (gl_state.object)) - 1))) + - BUF_BEGV (XBUFFER (gl_state.object)) + 1) + : NILP (gl_state.object) + ? BYTE_TO_CHAR (bytepos + BEGV_BYTE - 1) - BEGV + 1 + : bytepos); +} /* Make syntax table state (gl_state) good for CHARPOS, assuming it is currently good for a position before CHARPOS. */ -#define UPDATE_SYNTAX_TABLE_FORWARD(charpos) \ - (parse_sexp_lookup_properties \ - && (charpos) >= gl_state.e_property \ - ? (update_syntax_table ((charpos) + gl_state.offset, 1, 0, \ - gl_state.object), \ - 1) \ - : 0) +SYNTAX_INLINE void +UPDATE_SYNTAX_TABLE_FORWARD (ptrdiff_t charpos) +{ + if (parse_sexp_lookup_properties && charpos >= gl_state.e_property) + update_syntax_table (charpos + gl_state.offset, 1, 0, gl_state.object); +} /* Make syntax table state (gl_state) good for CHARPOS, assuming it is currently good for a position after CHARPOS. */ -#define UPDATE_SYNTAX_TABLE_BACKWARD(charpos) \ - (parse_sexp_lookup_properties \ - && (charpos) < gl_state.b_property \ - ? (update_syntax_table ((charpos) + gl_state.offset, -1, 0, \ - gl_state.object), \ - 1) \ - : 0) +SYNTAX_INLINE void +UPDATE_SYNTAX_TABLE_BACKWARD (ptrdiff_t charpos) +{ + if (parse_sexp_lookup_properties && charpos < gl_state.b_property) + update_syntax_table (charpos + gl_state.offset, -1, 0, gl_state.object); +} /* Make syntax table good for CHARPOS. */ -#define UPDATE_SYNTAX_TABLE(charpos) \ - (parse_sexp_lookup_properties \ - && (charpos) < gl_state.b_property \ - ? (update_syntax_table ((charpos) + gl_state.offset, -1, 0, \ - gl_state.object), \ - 1) \ - : (parse_sexp_lookup_properties \ - && (charpos) >= gl_state.e_property \ - ? (update_syntax_table ((charpos) + gl_state.offset, 1, 0,\ - gl_state.object), \ - 1) \ - : 0)) - -/* This macro sets up the buffer-global syntax table. */ -#define SETUP_BUFFER_SYNTAX_TABLE() \ -do \ - { \ - gl_state.use_global = 0; \ - gl_state.current_syntax_table = BVAR (current_buffer, syntax_table);\ - } while (0) - -/* This macro should be called with FROM at the start of forward - search, or after the last position of the backward search. It - makes sure that the first char is picked up with correct table, so - one does not need to call UPDATE_SYNTAX_TABLE immediately after the - call. - Sign of COUNT gives the direction of the search. - */ - -#define SETUP_SYNTAX_TABLE(FROM, COUNT) \ -do \ - { \ - SETUP_BUFFER_SYNTAX_TABLE (); \ - gl_state.b_property = BEGV; \ - gl_state.e_property = ZV + 1; \ - gl_state.object = Qnil; \ - gl_state.offset = 0; \ - if (parse_sexp_lookup_properties) \ - if ((COUNT) > 0 || (FROM) > BEGV) \ - update_syntax_table ((COUNT) > 0 ? (FROM) : (FROM) - 1, (COUNT),\ - 1, Qnil); \ - } \ -while (0) - -/* Same as above, but in OBJECT. If OBJECT is nil, use current buffer. - If it is t (which is only used in fast_c_string_match_ignore_case), - ignore properties altogether. - - This is meant for regex.c to use. For buffers, regex.c passes arguments - to the UPDATE_SYNTAX_TABLE macros which are relative to BEGV. - So if it is a buffer, we set the offset field to BEGV. */ - -#define SETUP_SYNTAX_TABLE_FOR_OBJECT(OBJECT, FROM, COUNT) \ -do \ - { \ - SETUP_BUFFER_SYNTAX_TABLE (); \ - gl_state.object = (OBJECT); \ - if (BUFFERP (gl_state.object)) \ - { \ - struct buffer *buf = XBUFFER (gl_state.object); \ - gl_state.b_property = 1; \ - gl_state.e_property = BUF_ZV (buf) - BUF_BEGV (buf) + 1; \ - gl_state.offset = BUF_BEGV (buf) - 1; \ - } \ - else if (NILP (gl_state.object)) \ - { \ - gl_state.b_property = 1; \ - gl_state.e_property = ZV - BEGV + 1; \ - gl_state.offset = BEGV - 1; \ - } \ - else if (EQ (gl_state.object, Qt)) \ - { \ - gl_state.b_property = 0; \ - gl_state.e_property = PTRDIFF_MAX; \ - gl_state.offset = 0; \ - } \ - else \ - { \ - gl_state.b_property = 0; \ - gl_state.e_property = 1 + SCHARS (gl_state.object); \ - gl_state.offset = 0; \ - } \ - if (parse_sexp_lookup_properties) \ - update_syntax_table (((FROM) + gl_state.offset \ - + (COUNT > 0 ? 0 : -1)), \ - COUNT, 1, gl_state.object); \ - } \ -while (0) +SYNTAX_INLINE void +UPDATE_SYNTAX_TABLE (ptrdiff_t charpos) +{ + UPDATE_SYNTAX_TABLE_BACKWARD (charpos); + UPDATE_SYNTAX_TABLE_FORWARD (charpos); +} + +/* Set up the buffer-global syntax table. */ -struct gl_state_s +SYNTAX_INLINE void +SETUP_BUFFER_SYNTAX_TABLE (void) { - Lisp_Object object; /* The object we are scanning. */ - ptrdiff_t start; /* Where to stop. */ - ptrdiff_t stop; /* Where to stop. */ - int use_global; /* Whether to use global_code - or c_s_t. */ - Lisp_Object global_code; /* Syntax code of current char. */ - Lisp_Object current_syntax_table; /* Syntax table for current pos. */ - Lisp_Object old_prop; /* Syntax-table prop at prev pos. */ - ptrdiff_t b_property; /* First index where c_s_t is valid. */ - ptrdiff_t e_property; /* First index where c_s_t is - not valid. */ - INTERVAL forward_i; /* Where to start lookup on forward */ - INTERVAL backward_i; /* or backward movement. The - data in c_s_t is valid - between these intervals, - and possibly at the - intervals too, depending - on: */ - /* Offset for positions specified to UPDATE_SYNTAX_TABLE. */ - ptrdiff_t offset; -}; + gl_state.use_global = 0; + gl_state.current_syntax_table = BVAR (current_buffer, syntax_table); +} -extern struct gl_state_s gl_state; extern ptrdiff_t scan_words (ptrdiff_t, EMACS_INT); +extern void SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object, ptrdiff_t, ptrdiff_t); + +INLINE_HEADER_END diff --git a/src/sysdep.c b/src/sysdep.c index 91e941a2050..f614d8bc557 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -31,7 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <unistd.h> #include <c-ctype.h> -#include <ignore-value.h> #include <utimens.h> #include "lisp.h" @@ -103,8 +102,8 @@ int _cdecl _getpid (void); #include "syssignal.h" #include "systime.h" -static int emacs_get_tty (int, struct emacs_tty *); -static int emacs_set_tty (int, struct emacs_tty *, int); +static void emacs_get_tty (int, struct emacs_tty *); +static int emacs_set_tty (int, struct emacs_tty *, bool); /* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */ #ifndef ULLONG_MAX @@ -538,13 +537,11 @@ sys_subshell (void) if (str && chdir ((char *) str) != 0) { #ifndef DOS_NT - ignore_value (write (1, "Can't chdir\n", 12)); - _exit (1); + emacs_perror ((char *) str); + _exit (EXIT_CANCELED); #endif } - close_process_descs (); /* Close Emacs's pipes/ptys */ - #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ { char *epwd = getenv ("PWD"); @@ -572,8 +569,8 @@ sys_subshell (void) write (1, "Can't execute subshell", 22); #else /* not WINDOWSNT */ execlp (sh, sh, (char *) 0); - ignore_value (write (1, "Can't execute subshell", 22)); - _exit (1); + emacs_perror (sh); + _exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); #endif /* not WINDOWSNT */ #endif /* not MSDOS */ } @@ -772,31 +769,26 @@ widen_foreground_group (int fd) /* Getting and setting emacs_tty structures. */ -/* Set *TC to the parameters associated with the terminal FD. - Return zero if all's well, or -1 if we ran into an error we - couldn't deal with. */ -int +/* Set *TC to the parameters associated with the terminal FD, + or clear it if the parameters are not available. */ +static void emacs_get_tty (int fd, struct emacs_tty *settings) { /* Retrieve the primary parameters - baud rate, character size, etcetera. */ #ifndef DOS_NT /* We have those nifty POSIX tcmumbleattr functions. */ memset (&settings->main, 0, sizeof (settings->main)); - if (tcgetattr (fd, &settings->main) < 0) - return -1; + tcgetattr (fd, &settings->main); #endif - - /* We have survived the tempest. */ - return 0; } /* Set the parameters of the tty on FD according to the contents of - *SETTINGS. If FLUSHP is non-zero, we discard input. - Return 0 if all went well, and -1 if anything failed. */ + *SETTINGS. If FLUSHP, discard input. + Return 0 if all went well, and -1 (setting errno) if anything failed. */ -int -emacs_set_tty (int fd, struct emacs_tty *settings, int flushp) +static int +emacs_set_tty (int fd, struct emacs_tty *settings, bool flushp) { /* Set the primary parameters - baud rate, character size, etcetera. */ #ifndef DOS_NT @@ -1121,10 +1113,10 @@ init_sys_modes (struct tty_display_info *tty_out) tty_out->term_initted = 1; } -/* Return nonzero if safe to use tabs in output. +/* Return true if safe to use tabs in output. At the time this is called, init_sys_modes has not been done yet. */ -int +bool tabs_safe_p (int fd) { struct emacs_tty etty; @@ -1378,8 +1370,10 @@ init_system_name (void) uname (&uts); Vsystem_name = build_string (uts.nodename); #else /* HAVE_GETHOSTNAME */ - unsigned int hostname_size = 256; - char *hostname = alloca (hostname_size); + char *hostname_alloc = NULL; + char hostname_buf[256]; + ptrdiff_t hostname_size = sizeof hostname_buf; + char *hostname = hostname_buf; /* Try to get the host name; if the buffer is too short, try again. Apparently, the only indication gethostname gives of @@ -1394,8 +1388,8 @@ init_system_name (void) if (strlen (hostname) < hostname_size - 1) break; - hostname_size <<= 1; - hostname = alloca (hostname_size); + hostname = hostname_alloc = xpalloc (hostname_alloc, &hostname_size, 1, + min (PTRDIFF_MAX, SIZE_MAX), 1); } #ifdef HAVE_SOCKETS /* Turn the hostname into the official, fully-qualified hostname. @@ -1440,7 +1434,13 @@ init_system_name (void) } if (it) { - hostname = alloca (strlen (it->ai_canonname) + 1); + ptrdiff_t len = strlen (it->ai_canonname); + if (hostname_size <= len) + { + hostname_size = len + 1; + hostname = hostname_alloc = xrealloc (hostname_alloc, + hostname_size); + } strcpy (hostname, it->ai_canonname); } freeaddrinfo (res); @@ -1487,10 +1487,11 @@ init_system_name (void) } #endif /* HAVE_SOCKETS */ Vsystem_name = build_string (hostname); + xfree (hostname_alloc); #endif /* HAVE_GETHOSTNAME */ { - unsigned char *p; - for (p = SDATA (Vsystem_name); *p; p++) + char *p; + for (p = SSDATA (Vsystem_name); *p; p++) if (*p == ' ' || *p == '\t') *p = '-'; } @@ -2136,10 +2137,10 @@ emacs_backtrace (int backtrace_limit) if (npointers) { - ignore_value (write (STDERR_FILENO, "\nBacktrace:\n", 12)); + emacs_write (STDERR_FILENO, "\nBacktrace:\n", 12); backtrace_symbols_fd (buffer, npointers, STDERR_FILENO); if (bounded_limit < npointers) - ignore_value (write (STDERR_FILENO, "...\n", 4)); + emacs_write (STDERR_FILENO, "...\n", 4); } } @@ -2152,6 +2153,8 @@ emacs_abort (void) #endif /* Open FILE for Emacs use, using open flags OFLAG and mode MODE. + Arrange for subprograms to not inherit the file descriptor. + Prefer a method that is multithread-safe, if available. Do not fail merely because the open was interrupted by a signal. Allow the user to quit. */ @@ -2159,8 +2162,11 @@ int emacs_open (const char *file, int oflags, int mode) { int fd; + oflags |= O_CLOEXEC; while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) QUIT; + if (! O_CLOEXEC && 0 <= fd) + fcntl (fd, F_SETFD, FD_CLOEXEC); return fd; } @@ -2170,29 +2176,84 @@ emacs_open (const char *file, int oflags, int mode) FILE * emacs_fopen (char const *file, char const *mode) { - FILE *fp; - while (! (fp = fopen (file, mode)) && errno == EINTR) - QUIT; - return fp; + int fd, omode, oflags; + int bflag = 0; + char const *m = mode; + + switch (*m++) + { + case 'r': omode = O_RDONLY; oflags = 0; break; + case 'w': omode = O_WRONLY; oflags = O_CREAT | O_TRUNC; break; + case 'a': omode = O_WRONLY; oflags = O_CREAT | O_APPEND; break; + default: emacs_abort (); + } + + while (*m) + switch (*m++) + { + case '+': omode = O_RDWR; break; + case 'b': bflag = O_BINARY; break; + case 't': bflag = O_TEXT; break; + default: /* Ignore. */ break; + } + + fd = emacs_open (file, omode | oflags | bflag, 0666); + return fd < 0 ? 0 : fdopen (fd, mode); } -int -emacs_close (int fd) +/* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs. + For the background behind this mess, please see Austin Group defect 529 + <http://austingroupbugs.net/view.php?id=529>. */ + +#ifndef POSIX_CLOSE_RESTART +# define POSIX_CLOSE_RESTART 1 +static int +posix_close (int fd, int flag) { - int did_retry = 0; - register int rtnval; + /* Only the POSIX_CLOSE_RESTART case is emulated. */ + eassert (flag == POSIX_CLOSE_RESTART); - while ((rtnval = close (fd)) == -1 - && (errno == EINTR)) - did_retry = 1; + /* Things are tricky if close (fd) returns -1 with errno == EINTR + on a system that does not define POSIX_CLOSE_RESTART. - /* If close is interrupted SunOS 4.1 may or may not have closed the - file descriptor. If it did the second close will fail with - errno = EBADF. That means we have succeeded. */ - if (rtnval == -1 && did_retry && errno == EBADF) - return 0; + In this case, in some systems (e.g., GNU/Linux, AIX) FD is + closed, and retrying the close could inadvertently close a file + descriptor allocated by some other thread. In other systems + (e.g., HP/UX) FD is not closed. And in still other systems + (e.g., OS X, Solaris), maybe FD is closed, maybe not, and in a + multithreaded program there can be no way to tell. - return rtnval; + So, in this case, pretend that the close succeeded. This works + well on systems like GNU/Linux that close FD. Although it may + leak a file descriptor on other systems, the leak is unlikely and + it's better to leak than to close a random victim. */ + return close (fd) == 0 || errno == EINTR ? 0 : -1; +} +#endif + +/* Close FD, retrying if interrupted. If successful, return 0; + otherwise, return -1 and set errno to a non-EINTR value. Consider + an EINPROGRESS error to be successful, as that's merely a signal + arriving. FD is always closed when this function returns, even + when it returns -1. + + Do not call this function if FD is nonnegative and might already be closed, + as that might close an innocent victim opened by some other thread. */ + +int +emacs_close (int fd) +{ + while (1) + { + int r = posix_close (fd, POSIX_CLOSE_RESTART); + if (r == 0) + return r; + if (!POSIX_CLOSE_RESTART || errno != EINTR) + { + eassert (errno != EBADF || fd < 0); + return errno == EINPROGRESS ? 0 : r; + } + } } /* Maximum number of bytes to read or write in a single system call. @@ -2224,27 +2285,26 @@ emacs_read (int fildes, char *buf, ptrdiff_t nbyte) } /* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted - or if a partial write occurs. Return the number of bytes written, setting + or if a partial write occurs. If interrupted, process pending + signals if PROCESS SIGNALS. Return the number of bytes written, setting errno if this is less than NBYTE. */ -ptrdiff_t -emacs_write (int fildes, const char *buf, ptrdiff_t nbyte) +static ptrdiff_t +emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte, + bool process_signals) { - ssize_t rtnval; - ptrdiff_t bytes_written; - - bytes_written = 0; + ptrdiff_t bytes_written = 0; while (nbyte > 0) { - rtnval = write (fildes, buf, min (nbyte, MAX_RW_COUNT)); + ssize_t n = write (fildes, buf, min (nbyte, MAX_RW_COUNT)); - if (rtnval < 0) + if (n < 0) { if (errno == EINTR) { /* I originally used `QUIT' but that might causes files to be truncated if you hit C-g in the middle of it. --Stef */ - if (pending_signals) + if (process_signals && pending_signals) process_pending_signals (); continue; } @@ -2252,12 +2312,57 @@ emacs_write (int fildes, const char *buf, ptrdiff_t nbyte) break; } - buf += rtnval; - nbyte -= rtnval; - bytes_written += rtnval; + buf += n; + nbyte -= n; + bytes_written += n; } - return (bytes_written); + return bytes_written; +} + +/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if + interrupted or if a partial write occurs. Return the number of + bytes written, setting errno if this is less than NBYTE. */ +ptrdiff_t +emacs_write (int fildes, char const *buf, ptrdiff_t nbyte) +{ + return emacs_full_write (fildes, buf, nbyte, 0); +} + +/* Like emacs_write, but also process pending signals if interrupted. */ +ptrdiff_t +emacs_write_sig (int fildes, char const *buf, ptrdiff_t nbyte) +{ + return emacs_full_write (fildes, buf, nbyte, 1); +} + +/* Write a diagnostic to standard error that contains MESSAGE and a + string derived from errno. Preserve errno. Do not buffer stderr. + Do not process pending signals if interrupted. */ +void +emacs_perror (char const *message) +{ + int err = errno; + char const *error_string = strerror (err); + char const *command = (initial_argv && initial_argv[0] + ? initial_argv[0] : "emacs"); + /* Write it out all at once, if it's short; this is less likely to + be interleaved with other output. */ + char buf[BUFSIZ]; + int nbytes = snprintf (buf, sizeof buf, "%s: %s: %s\n", + command, message, error_string); + if (0 <= nbytes && nbytes < BUFSIZ) + emacs_write (STDERR_FILENO, buf, nbytes); + else + { + emacs_write (STDERR_FILENO, command, strlen (command)); + emacs_write (STDERR_FILENO, ": ", 2); + emacs_write (STDERR_FILENO, message, strlen (message)); + emacs_write (STDERR_FILENO, ": ", 2); + emacs_write (STDERR_FILENO, error_string, strlen (error_string)); + emacs_write (STDERR_FILENO, "\n", 1); + } + errno = err; } /* Return a struct timeval that is roughly equivalent to T. @@ -2611,7 +2716,7 @@ list_system_processes (void) #endif /* !defined (WINDOWSNT) */ -#ifdef GNU_LINUX +#if defined GNU_LINUX && defined HAVE_LONG_LONG_INT static EMACS_TIME time_from_jiffies (unsigned long long tval, long hz) { diff --git a/src/systime.h b/src/systime.h index 0e611a3f5e3..657f2cca11f 100644 --- a/src/systime.h +++ b/src/systime.h @@ -67,7 +67,9 @@ SYSTIME_INLINE time_t *emacs_secs_addr (EMACS_TIME *t) { return &t->tv_sec; } SYSTIME_INLINE EMACS_TIME make_emacs_time (time_t s, int ns) { - EMACS_TIME r = { s, ns }; + EMACS_TIME r; + r.tv_sec = s; + r.tv_nsec = ns; return r; } @@ -75,7 +77,9 @@ make_emacs_time (time_t s, int ns) SYSTIME_INLINE EMACS_TIME invalid_emacs_time (void) { - EMACS_TIME r = { 0, -1 }; + EMACS_TIME r; + r.tv_sec = 0; + r.tv_nsec = -1; return r; } @@ -166,21 +170,6 @@ EMACS_TIME_EQ (EMACS_TIME t1, EMACS_TIME t2) return timespec_cmp (t1, t2) == 0; } SYSTIME_INLINE int -EMACS_TIME_NE (EMACS_TIME t1, EMACS_TIME t2) -{ - return timespec_cmp (t1, t2) != 0; -} -SYSTIME_INLINE int -EMACS_TIME_GT (EMACS_TIME t1, EMACS_TIME t2) -{ - return timespec_cmp (t1, t2) > 0; -} -SYSTIME_INLINE int -EMACS_TIME_GE (EMACS_TIME t1, EMACS_TIME t2) -{ - return timespec_cmp (t1, t2) >= 0; -} -SYSTIME_INLINE int EMACS_TIME_LT (EMACS_TIME t1, EMACS_TIME t2) { return timespec_cmp (t1, t2) < 0; diff --git a/src/term.c b/src/term.c index 39d143564c6..b6878a0abd1 100644 --- a/src/term.c +++ b/src/term.c @@ -71,13 +71,13 @@ static void tty_turn_off_highlight (struct tty_display_info *); static void tty_show_cursor (struct tty_display_info *); static void tty_hide_cursor (struct tty_display_info *); static void tty_background_highlight (struct tty_display_info *tty); -static struct terminal *get_tty_terminal (Lisp_Object, int); +static struct terminal *get_tty_terminal (Lisp_Object, bool); static void clear_tty_hooks (struct terminal *terminal); static void set_tty_hooks (struct terminal *terminal); static void dissociate_if_controlling_tty (int fd); static void delete_tty (struct terminal *); -static _Noreturn void maybe_fatal (int must_succeed, struct terminal *terminal, - const char *str1, const char *str2, ...) +static _Noreturn void maybe_fatal (bool, struct terminal *, + const char *, const char *, ...) ATTRIBUTE_FORMAT_PRINTF (3, 5) ATTRIBUTE_FORMAT_PRINTF (4, 5); static _Noreturn void vfatal (const char *str, va_list ap) ATTRIBUTE_FORMAT_PRINTF (1, 0); @@ -85,8 +85,7 @@ static _Noreturn void vfatal (const char *str, va_list ap) #define OUTPUT(tty, a) \ emacs_tputs ((tty), a, \ - (int) (FRAME_LINES (XFRAME (selected_frame)) \ - - curY (tty)), \ + FRAME_LINES (XFRAME (selected_frame)) - curY (tty), \ cmputc) #define OUTPUT1(tty, a) emacs_tputs ((tty), a, 1, cmputc) @@ -695,7 +694,7 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len) { unsigned char *conversion_buffer; struct coding_system *coding; - size_t n, stringlen; + int n, stringlen; struct tty_display_info *tty = FRAME_TTY (f); @@ -1431,7 +1430,7 @@ static void append_glyph (struct it *); static void append_composite_glyph (struct it *); static void produce_composite_glyph (struct it *); static void append_glyphless_glyph (struct it *, int, const char *); -static void produce_glyphless_glyph (struct it *, int, Lisp_Object); +static void produce_glyphless_glyph (struct it *, Lisp_Object); /* Append glyphs to IT's glyph_row. Called from produce_glyphs for terminal frames if IT->glyph_row != NULL. IT->char_to_display is @@ -1551,7 +1550,7 @@ produce_glyphs (struct it *it) if (it->what == IT_GLYPHLESS) { - produce_glyphless_glyph (it, 0, Qnil); + produce_glyphless_glyph (it, Qnil); goto done; } @@ -1620,7 +1619,7 @@ produce_glyphs (struct it *it) Lisp_Object acronym = lookup_glyphless_char_display (-1, it); eassert (it->what == IT_GLYPHLESS); - produce_glyphless_glyph (it, 1, acronym); + produce_glyphless_glyph (it, acronym); } } @@ -1794,14 +1793,12 @@ append_glyphless_glyph (struct it *it, int face_id, const char *str) the character. See the description of enum glyphless_display_method in dispextern.h for the details. - FOR_NO_FONT is nonzero if and only if this is for a character that - is not supported by the coding system of the terminal. ACRONYM, if - non-nil, is an acronym string for the character. + ACRONYM, if non-nil, is an acronym string for the character. The glyphs actually produced are of type CHAR_GLYPH. */ static void -produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym) +produce_glyphless_glyph (struct it *it, Lisp_Object acronym) { int face_id; int len; @@ -1968,7 +1965,7 @@ turn_on_face (struct frame *f, int face_id) ts = tty->standout_mode ? tty->TS_set_background : tty->TS_set_foreground; if (fg >= 0 && ts) { - p = tparam (ts, NULL, 0, (int) fg, 0, 0, 0); + p = tparam (ts, NULL, 0, fg, 0, 0, 0); OUTPUT (tty, p); xfree (p); } @@ -1976,7 +1973,7 @@ turn_on_face (struct frame *f, int face_id) ts = tty->standout_mode ? tty->TS_set_foreground : tty->TS_set_background; if (bg >= 0 && ts) { - p = tparam (ts, NULL, 0, (int) bg, 0, 0, 0); + p = tparam (ts, NULL, 0, bg, 0, 0, 0); OUTPUT (tty, p); xfree (p); } @@ -2027,11 +2024,11 @@ turn_off_face (struct frame *f, int face_id) } -/* Return non-zero if the terminal on frame F supports all of the +/* Return true if the terminal on frame F supports all of the capabilities in CAPS simultaneously, with foreground and background colors FG and BG. */ -int +bool tty_capable_p (struct tty_display_info *tty, unsigned int caps, unsigned long fg, unsigned long bg) { @@ -2099,7 +2096,7 @@ static char *default_set_background; /* Save or restore the default color-related capabilities of this terminal. */ static void -tty_default_color_capabilities (struct tty_display_info *tty, int save) +tty_default_color_capabilities (struct tty_display_info *tty, bool save) { if (save) @@ -2209,7 +2206,7 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f) /* Return the tty display object specified by TERMINAL. */ static struct terminal * -get_tty_terminal (Lisp_Object terminal, int throw) +get_tty_terminal (Lisp_Object terminal, bool throw) { struct terminal *t = get_terminal (terminal, throw); @@ -2481,7 +2478,7 @@ term_mouse_moveto (int x, int y) name = (const char *) ttyname (0); fd = emacs_open (name, O_WRONLY, 0); SOME_FUNCTION (x, y, fd); - close (fd); + emacs_close (fd); last_mouse_x = x; last_mouse_y = y; */ } @@ -2519,7 +2516,7 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, cursor_to (f, save_y, save_x); } -static int +static bool term_mouse_movement (FRAME_PTR frame, Gpm_Event *event) { /* Has the mouse moved off the glyph it was on at the last sighting? */ @@ -2649,7 +2646,7 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event, struct in { struct frame *f = XFRAME (tty->top_frame); struct input_event ie; - int do_help = 0; + bool do_help = 0; int count = 0; EVENT_INIT (ie); @@ -2934,7 +2931,7 @@ dissociate_if_controlling_tty (int fd) If MUST_SUCCEED is true, then all errors are fatal. */ struct terminal * -init_tty (const char *name, const char *terminal_type, int must_succeed) +init_tty (const char *name, const char *terminal_type, bool must_succeed) { char *area = NULL; char **address = &area; @@ -2942,7 +2939,7 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) int status; struct tty_display_info *tty = NULL; struct terminal *terminal = NULL; - int ctty = 0; /* 1 if asked to open controlling tty. */ + bool ctty = 0; /* True if asked to open controlling tty. */ if (!terminal_type) maybe_fatal (must_succeed, 0, @@ -3015,7 +3012,7 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) name); if (!isatty (fd)) { - close (fd); + emacs_close (fd); maybe_fatal (must_succeed, terminal, "Not a tty device: %s", "Not a tty device: %s", @@ -3412,10 +3409,10 @@ vfatal (const char *str, va_list ap) /* Auxiliary error-handling function for init_tty. Delete TERMINAL, then call error or fatal with str1 or str2, - respectively, according to whether MUST_SUCCEED is zero or not. */ + respectively, according to whether MUST_SUCCEED is true. */ static void -maybe_fatal (int must_succeed, struct terminal *terminal, +maybe_fatal (bool must_succeed, struct terminal *terminal, const char *str1, const char *str2, ...) { va_list ap; diff --git a/src/termcap.c b/src/termcap.c index 7256eef9e81..be05828eea6 100644 --- a/src/termcap.c +++ b/src/termcap.c @@ -213,8 +213,8 @@ tgetst1 (char *ptr, char **area) abbreviation expansion makes that effort a little more hairy than its worth; this is cleaner. */ { - register int last_p_param = 0; - int remove_p_params = 1; + int last_p_param = 0; + bool remove_p_params = 1; struct { char *beg; int len; } cut[11]; for (cut[0].beg = p = ret; p < r - 3; p++) @@ -318,26 +318,26 @@ struct termcap_buffer char *beg; ptrdiff_t size; char *ptr; - int ateof; + bool ateof; ptrdiff_t full; }; /* Forward declarations of static functions. */ -static int scan_file (char *str, int fd, register struct termcap_buffer *bufp); -static char *gobble_line (int fd, register struct termcap_buffer *bufp, char *append_end); -static int compare_contin (register char *str1, register char *str2); -static int name_match (char *line, char *name); +static bool scan_file (char *, int, struct termcap_buffer *); +static char *gobble_line (int, struct termcap_buffer *, char *); +static bool compare_contin (char *, char *); +static bool name_match (char *, char *); -#ifdef MSDOS /* MW, May 1993 */ -static int +static bool valid_filename_p (char *fn) { +#ifdef MSDOS return *fn == '/' || fn[1] == ':'; -} #else -#define valid_filename_p(fn) (*(fn) == '/') + return *fn == '/'; #endif +} /* Find the termcap entry data for terminal type NAME and store it in the block that BP points to. @@ -360,10 +360,10 @@ tgetent (char *bp, const char *name) char *tc_search_point; char *term; ptrdiff_t malloc_size = 0; - register int c; + int c; char *tcenv = NULL; /* TERMCAP value, if it contains :tc=. */ char *indirect = NULL; /* Terminal type in :tc= in TERMCAP value. */ - int filep; + bool filep; #ifdef INTERNAL_TERMINAL /* For the internal terminal we don't want to read any termcap file, @@ -455,7 +455,7 @@ tgetent (char *bp, const char *name) /* Scan the file, reading it via buf, till find start of main entry. */ if (scan_file (term, fd, &buf) == 0) { - close (fd); + emacs_close (fd); xfree (buf.beg); if (malloc_size) xfree (bp); @@ -493,7 +493,7 @@ tgetent (char *bp, const char *name) term = tgetst1 (tc_search_point, (char **) 0); } - close (fd); + emacs_close (fd); xfree (buf.beg); if (malloc_size) @@ -510,10 +510,10 @@ tgetent (char *bp, const char *name) Return 1 if successful, with that line in BUFP, or 0 if no entry is found in the file. */ -static int -scan_file (char *str, int fd, register struct termcap_buffer *bufp) +static bool +scan_file (char *str, int fd, struct termcap_buffer *bufp) { - register char *end; + char *end; bufp->ptr = bufp->beg; bufp->full = 0; @@ -544,13 +544,13 @@ scan_file (char *str, int fd, register struct termcap_buffer *bufp) return 0; } -/* Return nonzero if NAME is one of the names specified +/* Return true if NAME is one of the names specified by termcap entry LINE. */ -static int +static bool name_match (char *line, char *name) { - register char *tem; + char *tem; if (!compare_contin (line, name)) return 1; @@ -562,18 +562,18 @@ name_match (char *line, char *name) return 0; } -static int -compare_contin (register char *str1, register char *str2) +static bool +compare_contin (char *str1, char *str2) { - register int c1, c2; while (1) { - c1 = *str1++; - c2 = *str2++; + int c1 = *str1++; + int c2 = *str2++; while (c1 == '\\' && *str1 == '\n') { str1++; - while ((c1 = *str1++) == ' ' || c1 == '\t'); + while ((c1 = *str1++) == ' ' || c1 == '\t') + continue; } if (c2 == '\0') { @@ -647,57 +647,3 @@ gobble_line (int fd, register struct termcap_buffer *bufp, char *append_end) } return end + 1; } - -#ifdef TEST - -#include <stdio.h> - -static void -tprint (char *cap) -{ - char *x = tgetstr (cap, 0); - register char *y; - - printf ("%s: ", cap); - if (x) - { - for (y = x; *y; y++) - if (*y <= ' ' || *y == 0177) - printf ("\\%0o", *y); - else - putchar (*y); - free (x); - } - else - printf ("none"); - putchar ('\n'); -} - -int -main (int argc, char **argv) -{ - char *term; - char *buf; - - term = argv[1]; - printf ("TERM: %s\n", term); - - buf = (char *) tgetent (0, term); - if ((int) buf <= 0) - { - printf ("No entry.\n"); - return 0; - } - - printf ("Entry: %s\n", buf); - - tprint ("cm"); - tprint ("AL"); - - printf ("co: %d\n", tgetnum ("co")); - printf ("am: %d\n", tgetflag ("am")); - - return 0; -} - -#endif /* TEST */ diff --git a/src/termhooks.h b/src/termhooks.h index 4f3fa9cb47f..0190478c254 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -643,7 +643,7 @@ extern struct terminal *terminal_list; (((d)->type != output_termcap && (d)->type != output_msdos_raw) \ || (d)->display_info.tty->input) -extern struct terminal *get_terminal (Lisp_Object terminal, int); +extern struct terminal *get_terminal (Lisp_Object terminal, bool); extern struct terminal *create_terminal (void); extern void delete_terminal (struct terminal *); diff --git a/src/terminal.c b/src/terminal.c index c99c39c64ae..c55fd4eb077 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -199,11 +199,11 @@ ins_del_lines (struct frame *f, int vpos, int n) /* Return the terminal object specified by TERMINAL. TERMINAL may be a terminal object, a frame, or nil for the terminal device of the - current frame. If THROW is zero, return NULL for failure, + current frame. If THROW is false, return NULL for failure, otherwise throw an error. */ struct terminal * -get_terminal (Lisp_Object terminal, int throw) +get_terminal (Lisp_Object terminal, bool throw) { struct terminal *result = NULL; diff --git a/src/undo.c b/src/undo.c index d8711882fbf..234b8510f0a 100644 --- a/src/undo.c +++ b/src/undo.c @@ -229,10 +229,9 @@ record_first_change (void) if (base_buffer->base_buffer) base_buffer = base_buffer->base_buffer; - bset_undo_list - (current_buffer, - Fcons (Fcons (Qt, make_lisp_time (base_buffer->modtime)), - BVAR (current_buffer, undo_list))); + bset_undo_list (current_buffer, + Fcons (Fcons (Qt, Fvisited_file_modtime ()), + BVAR (current_buffer, undo_list))); } /* Record a change in property PROP (whose old value was VAL) diff --git a/src/unexaix.c b/src/unexaix.c index 204f6cf4ad3..757ba6f51b3 100644 --- a/src/unexaix.c +++ b/src/unexaix.c @@ -94,13 +94,10 @@ static int pagemask; static _Noreturn void report_error (const char *file, int fd) { + int err = errno; if (fd) - { - int failed_errno = errno; - close (fd); - errno = failed_errno; - } - report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); + emacs_close (fd); + report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err); } #define ERROR0(msg) report_error_1 (new, msg) @@ -111,7 +108,7 @@ static _Noreturn void ATTRIBUTE_FORMAT_PRINTF (2, 3) report_error_1 (int fd, const char *msg, ...) { va_list ap; - close (fd); + emacs_close (fd); va_start (ap, msg); verror (msg, ap); va_end (ap); @@ -148,13 +145,13 @@ unexec (const char *new_name, const char *a_name) || adjust_lnnoptrs (new, a_out, new_name) < 0 || unrelocate_symbols (new, a_out, a_name, new_name) < 0) { - close (new); + emacs_close (new); return; } - close (new); + emacs_close (new); if (a_out >= 0) - close (a_out); + emacs_close (a_out); mark_x (new_name); } @@ -534,7 +531,7 @@ adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name) } } } - close (new); + emacs_close (new); return 0; } diff --git a/src/unexcoff.c b/src/unexcoff.c index e79821251ba..c467e59a665 100644 --- a/src/unexcoff.c +++ b/src/unexcoff.c @@ -127,9 +127,10 @@ static int pagemask; static void report_error (const char *file, int fd) { + int err = errno; if (fd) - close (fd); - report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); + emacs_close (fd); + report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err); } #define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 @@ -139,7 +140,7 @@ report_error (const char *file, int fd) static void report_error_1 (int fd, const char *msg, int a1, int a2) { - close (fd); + emacs_close (fd); error (msg, a1, a2); } @@ -511,7 +512,7 @@ adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name) } } #ifndef MSDOS - close (new); + emacs_close (new); #endif return 0; } @@ -541,13 +542,13 @@ unexec (const char *new_name, const char *a_name) || adjust_lnnoptrs (new, a_out, new_name) < 0 ) { - close (new); + emacs_close (new); return; } - close (new); + emacs_close (new); if (a_out >= 0) - close (a_out); + emacs_close (a_out); mark_x (new_name); } diff --git a/src/unexcw.c b/src/unexcw.c index 0312a7328fb..12435a85051 100644 --- a/src/unexcw.c +++ b/src/unexcw.c @@ -316,13 +316,13 @@ unexec (const char *outfile, const char *infile) ret2 = write (fd_out, buffer, ret); assert (ret2 == ret); } - ret = close (fd_in); + ret = emacs_close (fd_in); assert (ret == 0); bss_sbrk_did_unexec = 1; fixup_executable (fd_out); bss_sbrk_did_unexec = 0; - ret = close (fd_out); + ret = emacs_close (fd_out); assert (ret == 0); } diff --git a/src/unexelf.c b/src/unexelf.c index 28847157e40..e2412393286 100644 --- a/src/unexelf.c +++ b/src/unexelf.c @@ -1312,13 +1312,13 @@ temacs: /* Close the files and make the new file executable. */ #if MAP_ANON == 0 - close (mmap_fd); + emacs_close (mmap_fd); #endif - if (close (old_file) != 0) + if (emacs_close (old_file) != 0) fatal ("Can't close (%s): %s", old_name, strerror (errno)); - if (close (new_file) != 0) + if (emacs_close (new_file) != 0) fatal ("Can't close (%s): %s", new_name, strerror (errno)); if (stat (new_name, &stat_buf) != 0) diff --git a/src/unexhp9k800.c b/src/unexhp9k800.c index 0f6eb87ee01..bee2517307a 100644 --- a/src/unexhp9k800.c +++ b/src/unexhp9k800.c @@ -306,6 +306,6 @@ unexec (const char *new_name, /* name of the new a.out file to be created * write_header (new, &hdr, &auxhdr); /* Close the binary file */ - close (old); - close (new); + emacs_close (old); + emacs_close (new); } diff --git a/src/unexmacosx.c b/src/unexmacosx.c index 2bc6de177eb..87848b012ba 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -1332,7 +1332,7 @@ unexec (const char *outfile, const char *infile) outfd = emacs_open (outfile, O_WRONLY | O_TRUNC | O_CREAT, 0755); if (outfd < 0) { - close (infd); + emacs_close (infd); unexec_error ("cannot open output file `%s'", outfile); } @@ -1346,7 +1346,7 @@ unexec (const char *outfile, const char *infile) dump_it (); - close (outfd); + emacs_close (outfd); } diff --git a/src/w32.c b/src/w32.c index 230479cd61a..1a3d81bbffc 100644 --- a/src/w32.c +++ b/src/w32.c @@ -234,6 +234,8 @@ extern int sys_access (const char *, int); extern void *e_malloc (size_t); extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, EMACS_TIME *, void *); +extern int sys_dup (int); + @@ -6719,10 +6721,16 @@ sys_sendto (int s, const char * buf, int len, int flags, } /* Windows does not have an fcntl function. Provide an implementation - solely for making sockets non-blocking. */ + good enough for Emacs. */ int fcntl (int s, int cmd, int options) { + /* In the w32 Emacs port, fcntl (fd, F_DUPFD_CLOEXEC, fd1) is always + invoked in a context where fd1 is closed and all descriptors less + than fd1 are open, so sys_dup is an adequate implementation. */ + if (cmd == F_DUPFD_CLOEXEC) + return sys_dup (s); + if (winsock_lib == NULL) { errno = ENETDOWN; @@ -6864,13 +6872,14 @@ sys_dup2 (int src, int dst) return rc; } -/* Unix pipe() has only one arg */ int -sys_pipe (int * phandles) +pipe2 (int * phandles, int pipe2_flags) { int rc; unsigned flags; + eassert (pipe2_flags == O_CLOEXEC); + /* make pipe handles non-inheritable; when we spawn a child, we replace the relevant handle with an inheritable one. Also put pipes into binary mode; we will do text mode translation ourselves diff --git a/src/w32.h b/src/w32.h index 17da0778db1..9c1f1efa699 100644 --- a/src/w32.h +++ b/src/w32.h @@ -188,7 +188,7 @@ extern int random (void); extern int fchmod (int, mode_t); extern int sys_rename_replace (char const *, char const *, BOOL); -extern int sys_pipe (int *); +extern int pipe2 (int *, int); extern void set_process_dir (char *); extern int sys_spawnve (int, char *, char **, char **); diff --git a/src/xdisp.c b/src/xdisp.c index 5869ce5fdfa..12b294e6800 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12589,6 +12589,7 @@ static void debug_method_add (struct window *, char const *, ...) static void debug_method_add (struct window *w, char const *fmt, ...) { + void *ptr = w; char *method = w->desired_matrix->method; int len = strlen (method); int size = sizeof w->desired_matrix->method; @@ -12607,7 +12608,7 @@ debug_method_add (struct window *w, char const *fmt, ...) if (trace_redisplay_p) fprintf (stderr, "%p (%s): %s\n", - w, + ptr, ((BUFFERP (w->contents) && STRINGP (BVAR (XBUFFER (w->contents), name))) ? SSDATA (BVAR (XBUFFER (w->contents), name)) diff --git a/src/xrdb.c b/src/xrdb.c index c25c25d6f33..7c9cd53fa8c 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -634,10 +634,7 @@ member (char *elt, List list) static void fatal (char *msg, char *prog) { - if (errno) - perror (prog); - - (void) fprintf (stderr, msg, prog); + fprintf (stderr, msg, prog); exit (1); } diff --git a/src/xsettings.c b/src/xsettings.c index f48c49dbafe..45f8435d9f4 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -170,7 +170,7 @@ enum { SEEN_HINTSTYLE = 0x10, SEEN_DPI = 0x20, SEEN_FONT = 0x40, - SEEN_TB_STYLE = 0x80, + SEEN_TB_STYLE = 0x80 }; struct xsettings { @@ -687,7 +687,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, { static char const format[] = "Antialias: %d, Hinting: %d, RGBA: %d, LCDFilter: %d, " - "Hintstyle: %d, DPI: %lf"; + "Hintstyle: %d, DPI: %f"; enum { d_formats = 5, @@ -696,7 +696,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, max_f_integer_digits = DBL_MAX_10_EXP + 1, f_precision = 6, lf_growth = (sizeof "-." + max_f_integer_digits + f_precision - - sizeof "%lf") + - sizeof "%f") }; char buf[sizeof format + d_formats * d_growth + lf_formats * lf_growth]; diff --git a/src/xterm.c b/src/xterm.c index f0b95d585e3..818b69cc41d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -2647,7 +2647,10 @@ x_draw_underwave (struct glyph_string *s) /* Find and set clipping rectangle */ - wave_clip = (XRectangle){ x0, y0, width, wave_height }; + wave_clip.x = x0; + wave_clip.y = y0; + wave_clip.width = width; + wave_clip.height = wave_height; get_glyph_string_clip_rect (s, &string_clip); if (!x_intersect_rectangles (&wave_clip, &string_clip, &final_clip)) @@ -10191,71 +10194,73 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } { - const struct + static const struct { const char *name; - Atom *atom; + int offset; } atom_refs[] = { - { "WM_PROTOCOLS", &dpyinfo->Xatom_wm_protocols }, - { "WM_TAKE_FOCUS", &dpyinfo->Xatom_wm_take_focus }, - { "WM_SAVE_YOURSELF", &dpyinfo->Xatom_wm_save_yourself }, - { "WM_DELETE_WINDOW", &dpyinfo->Xatom_wm_delete_window }, - { "WM_CHANGE_STATE", &dpyinfo->Xatom_wm_change_state }, - { "WM_CONFIGURE_DENIED", &dpyinfo->Xatom_wm_configure_denied }, - { "WM_MOVED", &dpyinfo->Xatom_wm_window_moved }, - { "WM_CLIENT_LEADER", &dpyinfo->Xatom_wm_client_leader }, - { "Editres", &dpyinfo->Xatom_editres }, - { "CLIPBOARD", &dpyinfo->Xatom_CLIPBOARD }, - { "TIMESTAMP", &dpyinfo->Xatom_TIMESTAMP }, - { "TEXT", &dpyinfo->Xatom_TEXT }, - { "COMPOUND_TEXT", &dpyinfo->Xatom_COMPOUND_TEXT }, - { "UTF8_STRING", &dpyinfo->Xatom_UTF8_STRING }, - { "DELETE", &dpyinfo->Xatom_DELETE }, - { "MULTIPLE", &dpyinfo->Xatom_MULTIPLE }, - { "INCR", &dpyinfo->Xatom_INCR }, - { "_EMACS_TMP_", &dpyinfo->Xatom_EMACS_TMP }, - { "TARGETS", &dpyinfo->Xatom_TARGETS }, - { "NULL", &dpyinfo->Xatom_NULL }, - { "ATOM", &dpyinfo->Xatom_ATOM }, - { "ATOM_PAIR", &dpyinfo->Xatom_ATOM_PAIR }, - { "CLIPBOARD_MANAGER", &dpyinfo->Xatom_CLIPBOARD_MANAGER }, - { "_XEMBED_INFO", &dpyinfo->Xatom_XEMBED_INFO }, +#define ATOM_REFS_INIT(string, member) \ + { string, offsetof (struct x_display_info, member) }, + ATOM_REFS_INIT ("WM_PROTOCOLS", Xatom_wm_protocols) + ATOM_REFS_INIT ("WM_TAKE_FOCUS", Xatom_wm_take_focus) + ATOM_REFS_INIT ("WM_SAVE_YOURSELF", Xatom_wm_save_yourself) + ATOM_REFS_INIT ("WM_DELETE_WINDOW", Xatom_wm_delete_window) + ATOM_REFS_INIT ("WM_CHANGE_STATE", Xatom_wm_change_state) + ATOM_REFS_INIT ("WM_CONFIGURE_DENIED", Xatom_wm_configure_denied) + ATOM_REFS_INIT ("WM_MOVED", Xatom_wm_window_moved) + ATOM_REFS_INIT ("WM_CLIENT_LEADER", Xatom_wm_client_leader) + ATOM_REFS_INIT ("Editres", Xatom_editres) + ATOM_REFS_INIT ("CLIPBOARD", Xatom_CLIPBOARD) + ATOM_REFS_INIT ("TIMESTAMP", Xatom_TIMESTAMP) + ATOM_REFS_INIT ("TEXT", Xatom_TEXT) + ATOM_REFS_INIT ("COMPOUND_TEXT", Xatom_COMPOUND_TEXT) + ATOM_REFS_INIT ("UTF8_STRING", Xatom_UTF8_STRING) + ATOM_REFS_INIT ("DELETE", Xatom_DELETE) + ATOM_REFS_INIT ("MULTIPLE", Xatom_MULTIPLE) + ATOM_REFS_INIT ("INCR", Xatom_INCR) + ATOM_REFS_INIT ("_EMACS_TMP_", Xatom_EMACS_TMP) + ATOM_REFS_INIT ("TARGETS", Xatom_TARGETS) + ATOM_REFS_INIT ("NULL", Xatom_NULL) + ATOM_REFS_INIT ("ATOM", Xatom_ATOM) + ATOM_REFS_INIT ("ATOM_PAIR", Xatom_ATOM_PAIR) + ATOM_REFS_INIT ("CLIPBOARD_MANAGER", Xatom_CLIPBOARD_MANAGER) + ATOM_REFS_INIT ("_XEMBED_INFO", Xatom_XEMBED_INFO) /* For properties of font. */ - { "PIXEL_SIZE", &dpyinfo->Xatom_PIXEL_SIZE }, - { "AVERAGE_WIDTH", &dpyinfo->Xatom_AVERAGE_WIDTH }, - { "_MULE_BASELINE_OFFSET", &dpyinfo->Xatom_MULE_BASELINE_OFFSET }, - { "_MULE_RELATIVE_COMPOSE", &dpyinfo->Xatom_MULE_RELATIVE_COMPOSE }, - { "_MULE_DEFAULT_ASCENT", &dpyinfo->Xatom_MULE_DEFAULT_ASCENT }, + ATOM_REFS_INIT ("PIXEL_SIZE", Xatom_PIXEL_SIZE) + ATOM_REFS_INIT ("AVERAGE_WIDTH", Xatom_AVERAGE_WIDTH) + ATOM_REFS_INIT ("_MULE_BASELINE_OFFSET", Xatom_MULE_BASELINE_OFFSET) + ATOM_REFS_INIT ("_MULE_RELATIVE_COMPOSE", Xatom_MULE_RELATIVE_COMPOSE) + ATOM_REFS_INIT ("_MULE_DEFAULT_ASCENT", Xatom_MULE_DEFAULT_ASCENT) /* Ghostscript support. */ - { "DONE", &dpyinfo->Xatom_DONE }, - { "PAGE", &dpyinfo->Xatom_PAGE }, - { "SCROLLBAR", &dpyinfo->Xatom_Scrollbar }, - { "_XEMBED", &dpyinfo->Xatom_XEMBED }, + ATOM_REFS_INIT ("DONE", Xatom_DONE) + ATOM_REFS_INIT ("PAGE", Xatom_PAGE) + ATOM_REFS_INIT ("SCROLLBAR", Xatom_Scrollbar) + ATOM_REFS_INIT ("_XEMBED", Xatom_XEMBED) /* EWMH */ - { "_NET_WM_STATE", &dpyinfo->Xatom_net_wm_state }, - { "_NET_WM_STATE_FULLSCREEN", &dpyinfo->Xatom_net_wm_state_fullscreen }, - { "_NET_WM_STATE_MAXIMIZED_HORZ", - &dpyinfo->Xatom_net_wm_state_maximized_horz }, - { "_NET_WM_STATE_MAXIMIZED_VERT", - &dpyinfo->Xatom_net_wm_state_maximized_vert }, - { "_NET_WM_STATE_STICKY", &dpyinfo->Xatom_net_wm_state_sticky }, - { "_NET_WM_STATE_HIDDEN", &dpyinfo->Xatom_net_wm_state_hidden }, - { "_NET_WM_WINDOW_TYPE", &dpyinfo->Xatom_net_window_type }, - { "_NET_WM_WINDOW_TYPE_TOOLTIP", - &dpyinfo->Xatom_net_window_type_tooltip }, - { "_NET_WM_ICON_NAME", &dpyinfo->Xatom_net_wm_icon_name }, - { "_NET_WM_NAME", &dpyinfo->Xatom_net_wm_name }, - { "_NET_SUPPORTED", &dpyinfo->Xatom_net_supported }, - { "_NET_SUPPORTING_WM_CHECK", &dpyinfo->Xatom_net_supporting_wm_check }, - { "_NET_WM_WINDOW_OPACITY", &dpyinfo->Xatom_net_wm_window_opacity }, - { "_NET_ACTIVE_WINDOW", &dpyinfo->Xatom_net_active_window }, - { "_NET_FRAME_EXTENTS", &dpyinfo->Xatom_net_frame_extents }, - { "_NET_CURRENT_DESKTOP", &dpyinfo->Xatom_net_current_desktop }, - { "_NET_WORKAREA", &dpyinfo->Xatom_net_workarea }, + ATOM_REFS_INIT ("_NET_WM_STATE", Xatom_net_wm_state) + ATOM_REFS_INIT ("_NET_WM_STATE_FULLSCREEN", Xatom_net_wm_state_fullscreen) + ATOM_REFS_INIT ("_NET_WM_STATE_MAXIMIZED_HORZ", + Xatom_net_wm_state_maximized_horz) + ATOM_REFS_INIT ("_NET_WM_STATE_MAXIMIZED_VERT", + Xatom_net_wm_state_maximized_vert) + ATOM_REFS_INIT ("_NET_WM_STATE_STICKY", Xatom_net_wm_state_sticky) + ATOM_REFS_INIT ("_NET_WM_STATE_HIDDEN", Xatom_net_wm_state_hidden) + ATOM_REFS_INIT ("_NET_WM_WINDOW_TYPE", Xatom_net_window_type) + ATOM_REFS_INIT ("_NET_WM_WINDOW_TYPE_TOOLTIP", + Xatom_net_window_type_tooltip) + ATOM_REFS_INIT ("_NET_WM_ICON_NAME", Xatom_net_wm_icon_name) + ATOM_REFS_INIT ("_NET_WM_NAME", Xatom_net_wm_name) + ATOM_REFS_INIT ("_NET_SUPPORTED", Xatom_net_supported) + ATOM_REFS_INIT ("_NET_SUPPORTING_WM_CHECK", Xatom_net_supporting_wm_check) + ATOM_REFS_INIT ("_NET_WM_WINDOW_OPACITY", Xatom_net_wm_window_opacity) + ATOM_REFS_INIT ("_NET_ACTIVE_WINDOW", Xatom_net_active_window) + ATOM_REFS_INIT ("_NET_FRAME_EXTENTS", Xatom_net_frame_extents) + ATOM_REFS_INIT ("_NET_CURRENT_DESKTOP", Xatom_net_current_desktop) + ATOM_REFS_INIT ("_NET_WORKAREA", Xatom_net_workarea) /* Session management */ - { "SM_CLIENT_ID", &dpyinfo->Xatom_SM_CLIENT_ID }, - { "_XSETTINGS_SETTINGS", &dpyinfo->Xatom_xsettings_prop }, - { "MANAGER", &dpyinfo->Xatom_xsettings_mgr }, + ATOM_REFS_INIT ("SM_CLIENT_ID", Xatom_SM_CLIENT_ID) + ATOM_REFS_INIT ("_XSETTINGS_SETTINGS", Xatom_xsettings_prop) + ATOM_REFS_INIT ("MANAGER", Xatom_xsettings_mgr) }; int i; @@ -10280,7 +10285,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) False, atoms_return); for (i = 0; i < atom_count; i++) - *atom_refs[i].atom = atoms_return[i]; + *(Atom *) ((char *) dpyinfo + atom_refs[i].offset) = atoms_return[i]; /* Manual copy of last atom */ dpyinfo->Xatom_xsettings_sel = atoms_return[i]; diff --git a/test/ChangeLog b/test/ChangeLog index aded5473304..d3d8db6b501 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,68 @@ +2013-07-11 Glenn Morris <rgm@gnu.org> + + * automated/ert-tests.el: Require cl-lib at runtime too. + (ert-test-special-operator-p): Use cl-gensym rather than ert-- version. + (ert-test-remprop, ert-test-remove-if-not, ert-test-remove*) + (ert-test-set-functions, ert-test-gensym) + (ert-test-coerce-to-vector, ert-test-string-position) + (ert-test-mismatch): Remove tests. + * automated/cl-lib.el: New, split from ert-tests.el. + + * automated/ruby-mode-tests.el (ruby-deftest-move-to-block): + Goto point-min. + (works-on-do, zero-is-noop, ok-with-three, ok-with-minus-two) + (ruby-move-to-block-skips-percent-literal) + (ruby-move-to-block-skips-heredoc) + (ruby-move-to-block-moves-from-else-to-if) + (ruby-beginning-of-defun-does-not-fold-case) + (ruby-end-of-defun-skips-to-next-line-after-the-method): + Replace goto-line with forward-line/goto-char. + (ruby-move-to-block-does-not-fold-case): Remove unneeded end-of-buffer. + + * automated/package-test.el (makeinfo-buffer): Autoload. + (compilation-in-progress, tar-parse-info, tar-header-name): Declare. + (package-test-install-texinfo): Don't require makeinfo. + + * automated/files.el: Stop "local variables" confusion. + + * automated/flymake-tests.el (flymake-tests): Remove unused group. + + * automated/icalendar-tests.el (icalendar-tests--do-test-cycle): + Use with-current-buffer. + + * automated/undo-tests.el (undo-test-buffer-modified) + (undo-test-file-modified): New tests. + +2013-07-09 Michael Albinus <michael.albinus@gmx.de> + + * automated/file-notify-tests.el (file-notify-test00-availability): + Set :expected-result. + (file-notify-test01-add-watch, file-notify-test01-add-watch-remote) + (file-notify-test02-events, file-notify-test02-events-remote) + (file-notify-test03-autorevert, file-notify-test03-autorevert-remote): + Skip when `file-notify-support' is nil. (Bug#14823) + +2013-07-09 Glenn Morris <rgm@gnu.org> + + * automated/inotify-test.el (inotify-add-watch, inotify-rm-watch): + Declare. + (inotify-file-watch-simple): Silence compiler. + + * automated/python-tests.el (python-indent-block-enders): + Make it actually test something. + + * automated/package-x-test.el: Require package-test when compiling. + + * automated/add-log-tests.el, automated/advice-tests.el: + * automated/imenu-test.el, automated/package-x-test.el: + * automated/python-tests.el, automated/ruby-mode-tests.el: + * automated/xml-parse-tests.el: Explictly require ert. + +2013-07-08 Kenichi Handa <handa@gnu.org> + + * automated/decoder-tests.el (decoder-tests-prefer-utf-8-read): + Use with-ccoding-priority to avoid side-effect (Bug#14781). + 2013-07-05 Michael Albinus <michael.albinus@gmx.de> * automated/file-notify-tests.el @@ -71,7 +136,7 @@ Use it to create separate tests for each element, so we run them all rather than stopping at the first error. -2013-06-24 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-24 Glenn Morris <rgm@gnu.org> * automated/occur-tests.el (occur-tests): Update for 2013-05-29 change to occur header line. diff --git a/test/automated/add-log-tests.el b/test/automated/add-log-tests.el index f6e803cd317..bd073016505 100644 --- a/test/automated/add-log-tests.el +++ b/test/automated/add-log-tests.el @@ -22,6 +22,7 @@ ;;; Code: +(require 'ert) (require 'add-log) (defmacro add-log-current-defun-deftest (name doc major-mode diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index 8beaea64cd9..69c15e34ed0 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el @@ -21,6 +21,8 @@ ;;; Code: +(require 'ert) + (ert-deftest advice-tests-nadvice () "Test nadvice code." (defun sm-test1 (x) (+ x 4)) diff --git a/test/automated/cl-lib.el b/test/automated/cl-lib.el new file mode 100644 index 00000000000..3a339e01734 --- /dev/null +++ b/test/automated/cl-lib.el @@ -0,0 +1,198 @@ +;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; Extracted from ert-tests.el, back when ert used to reimplement some +;; cl functions. + +;;; Code: + +(require 'cl-lib) +(require 'ert) + +(ert-deftest cl-lib-test-remprop () + (let ((x (cl-gensym))) + (should (equal (symbol-plist x) '())) + ;; Remove nonexistent property on empty plist. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '())) + (put x 'a 1) + (should (equal (symbol-plist x) '(a 1))) + ;; Remove nonexistent property on nonempty plist. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '(a 1))) + (put x 'b 2) + (put x 'c 3) + (put x 'd 4) + (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) + ;; Remove property that is neither first nor last. + (cl-remprop x 'c) + (should (equal (symbol-plist x) '(a 1 b 2 d 4))) + ;; Remove last property from a plist of length >1. + (cl-remprop x 'd) + (should (equal (symbol-plist x) '(a 1 b 2))) + ;; Remove first property from a plist of length >1. + (cl-remprop x 'a) + (should (equal (symbol-plist x) '(b 2))) + ;; Remove property when there is only one. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '())))) + +(ert-deftest cl-lib-test-remove-if-not () + (let ((list (list 'a 'b 'c 'd)) + (i 0)) + (let ((result (cl-remove-if-not (lambda (x) + (should (eql x (nth i list))) + (cl-incf i) + (member i '(2 3))) + list))) + (should (equal i 4)) + (should (equal result '(b c))) + (should (equal list '(a b c d))))) + (should (equal '() + (cl-remove-if-not (lambda (_x) (should nil)) '())))) + +(ert-deftest cl-lib-test-remove () + (let ((list (list 'a 'b 'c 'd)) + (key-index 0) + (test-index 0)) + (let ((result + (cl-remove 'foo list + :key (lambda (x) + (should (eql x (nth key-index list))) + (prog1 + (list key-index x) + (cl-incf key-index))) + :test + (lambda (a b) + (should (eql a 'foo)) + (should (equal b (list test-index + (nth test-index list)))) + (cl-incf test-index) + (member test-index '(2 3)))))) + (should (equal key-index 4)) + (should (equal test-index 4)) + (should (equal result '(a d))) + (should (equal list '(a b c d))))) + (let ((x (cons nil nil)) + (y (cons nil nil))) + (should (equal (cl-remove x (list x y)) + ;; or (list x), since we use `equal' -- the + ;; important thing is that only one element got + ;; removed, this proves that the default test is + ;; `eql', not `equal' + (list y))))) + + +(ert-deftest cl-lib-test-set-functions () + (let ((c1 (cons nil nil)) + (c2 (cons nil nil)) + (sym (make-symbol "a"))) + (let ((e '()) + (a (list 'a 'b sym nil "" "x" c1 c2)) + (b (list c1 'y 'b sym 'x))) + (should (equal (cl-set-difference e e) e)) + (should (equal (cl-set-difference a e) a)) + (should (equal (cl-set-difference e a) e)) + (should (equal (cl-set-difference a a) e)) + (should (equal (cl-set-difference b e) b)) + (should (equal (cl-set-difference e b) e)) + (should (equal (cl-set-difference b b) e)) + ;; Note: this test (and others) is sensitive to the order of the + ;; result, which is not documented. + (should (equal (cl-set-difference a b) (list c2 "x" "" nil 'a))) + (should (equal (cl-set-difference b a) (list 'x 'y))) + + ;; We aren't testing whether this is really using `eq' rather than `eql'. + (should (equal (cl-set-difference e e :test 'eq) e)) + (should (equal (cl-set-difference a e :test 'eq) a)) + (should (equal (cl-set-difference e a :test 'eq) e)) + (should (equal (cl-set-difference a a :test 'eq) e)) + (should (equal (cl-set-difference b e :test 'eq) b)) + (should (equal (cl-set-difference e b :test 'eq) e)) + (should (equal (cl-set-difference b b :test 'eq) e)) + (should (equal (cl-set-difference a b :test 'eq) (list c2 "x" "" nil 'a))) + (should (equal (cl-set-difference b a :test 'eq) (list 'x 'y))) + + (should (equal (cl-union e e) e)) + (should (equal (cl-union a e) a)) + (should (equal (cl-union e a) a)) + (should (equal (cl-union a a) a)) + (should (equal (cl-union b e) b)) + (should (equal (cl-union e b) b)) + (should (equal (cl-union b b) b)) + (should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) + + (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) + + (should (equal (cl-intersection e e) e)) + (should (equal (cl-intersection a e) e)) + (should (equal (cl-intersection e a) e)) + (should (equal (cl-intersection a a) a)) + (should (equal (cl-intersection b e) e)) + (should (equal (cl-intersection e b) e)) + (should (equal (cl-intersection b b) b)) + (should (equal (cl-intersection a b) (list sym 'b c1))) + (should (equal (cl-intersection b a) (list sym 'b c1)))))) + +(ert-deftest cl-lib-test-gensym () + ;; Since the expansion of `should' calls `cl-gensym' and thus has a + ;; side-effect on `cl--gensym-counter', we have to make sure all + ;; macros in our test body are expanded before we rebind + ;; `cl--gensym-counter' and run the body. Otherwise, the test would + ;; fail if run interpreted. + (let ((body (byte-compile + '(lambda () + (should (equal (symbol-name (cl-gensym)) "G0")) + (should (equal (symbol-name (cl-gensym)) "G1")) + (should (equal (symbol-name (cl-gensym)) "G2")) + (should (equal (symbol-name (cl-gensym "foo")) "foo3")) + (should (equal (symbol-name (cl-gensym "bar")) "bar4")) + (should (equal cl--gensym-counter 5)))))) + (let ((cl--gensym-counter 0)) + (funcall body)))) + +(ert-deftest cl-lib-test-coerce-to-vector () + (let* ((a (vector)) + (b (vector 1 a 3)) + (c (list)) + (d (list b a))) + (should (eql (cl-coerce a 'vector) a)) + (should (eql (cl-coerce b 'vector) b)) + (should (equal (cl-coerce c 'vector) (vector))) + (should (equal (cl-coerce d 'vector) (vector b a))))) + +(ert-deftest cl-lib-test-string-position () + (should (eql (cl-position ?x "") nil)) + (should (eql (cl-position ?a "abc") 0)) + (should (eql (cl-position ?b "abc") 1)) + (should (eql (cl-position ?c "abc") 2)) + (should (eql (cl-position ?d "abc") nil)) + (should (eql (cl-position ?A "abc") nil))) + +(ert-deftest cl-lib-test-mismatch () + (should (eql (cl-mismatch "" "") nil)) + (should (eql (cl-mismatch "" "a") 0)) + (should (eql (cl-mismatch "a" "a") nil)) + (should (eql (cl-mismatch "ab" "a") 1)) + (should (eql (cl-mismatch "Aa" "aA") 0)) + (should (eql (cl-mismatch '(a b c) '(a b d)) 2))) + +;;; cl-lib.el ends here diff --git a/test/automated/decoder-tests.el b/test/automated/decoder-tests.el index e1b05faf3c0..2e99fd7f115 100644 --- a/test/automated/decoder-tests.el +++ b/test/automated/decoder-tests.el @@ -213,10 +213,9 @@ ;; PREFER is non-nil, prefer that coding system before reading. (defun decoder-tests-prefer-utf-8-read (file detect prefer) - (if prefer - (prefer-coding-system prefer)) (with-temp-buffer - (insert-file-contents file) + (with-coding-priority (if prefer (list prefer)) + (insert-file-contents file)) (if (eq buffer-file-coding-system detect) nil (format "Invalid detection: %s" buffer-file-coding-system)))) diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el index 0c3c3692c1d..36864377ec9 100644 --- a/test/automated/ert-tests.el +++ b/test/automated/ert-tests.el @@ -26,11 +26,9 @@ ;;; Code: -(eval-when-compile - (require 'cl-lib)) +(require 'cl-lib) (require 'ert) - ;;; Self-test that doesn't rely on ERT, for bootstrapping. ;; This is used to test that bodies actually run. @@ -578,7 +576,7 @@ This macro is used to test if macroexpansion in `should' works." (should (ert--special-operator-p 'if)) (should-not (ert--special-operator-p 'car)) (should-not (ert--special-operator-p 'ert--special-operator-p)) - (let ((b (ert--gensym))) + (let ((b (cl-gensym))) (should-not (ert--special-operator-p b)) (fset b 'if) (should (ert--special-operator-p b)))) @@ -626,171 +624,6 @@ This macro is used to test if macroexpansion in `should' works." :explanation nil) )))))) -(ert-deftest ert-test-remprop () - (let ((x (ert--gensym))) - (should (equal (symbol-plist x) '())) - ;; Remove nonexistent property on empty plist. - (ert--remprop x 'b) - (should (equal (symbol-plist x) '())) - (put x 'a 1) - (should (equal (symbol-plist x) '(a 1))) - ;; Remove nonexistent property on nonempty plist. - (ert--remprop x 'b) - (should (equal (symbol-plist x) '(a 1))) - (put x 'b 2) - (put x 'c 3) - (put x 'd 4) - (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) - ;; Remove property that is neither first nor last. - (ert--remprop x 'c) - (should (equal (symbol-plist x) '(a 1 b 2 d 4))) - ;; Remove last property from a plist of length >1. - (ert--remprop x 'd) - (should (equal (symbol-plist x) '(a 1 b 2))) - ;; Remove first property from a plist of length >1. - (ert--remprop x 'a) - (should (equal (symbol-plist x) '(b 2))) - ;; Remove property when there is only one. - (ert--remprop x 'b) - (should (equal (symbol-plist x) '())))) - -(ert-deftest ert-test-remove-if-not () - (let ((list (list 'a 'b 'c 'd)) - (i 0)) - (let ((result (ert--remove-if-not (lambda (x) - (should (eql x (nth i list))) - (cl-incf i) - (member i '(2 3))) - list))) - (should (equal i 4)) - (should (equal result '(b c))) - (should (equal list '(a b c d))))) - (should (equal '() - (ert--remove-if-not (lambda (_x) (should nil)) '())))) - -(ert-deftest ert-test-remove* () - (let ((list (list 'a 'b 'c 'd)) - (key-index 0) - (test-index 0)) - (let ((result - (ert--remove* 'foo list - :key (lambda (x) - (should (eql x (nth key-index list))) - (prog1 - (list key-index x) - (cl-incf key-index))) - :test - (lambda (a b) - (should (eql a 'foo)) - (should (equal b (list test-index - (nth test-index list)))) - (cl-incf test-index) - (member test-index '(2 3)))))) - (should (equal key-index 4)) - (should (equal test-index 4)) - (should (equal result '(a d))) - (should (equal list '(a b c d))))) - (let ((x (cons nil nil)) - (y (cons nil nil))) - (should (equal (ert--remove* x (list x y)) - ;; or (list x), since we use `equal' -- the - ;; important thing is that only one element got - ;; removed, this proves that the default test is - ;; `eql', not `equal' - (list y))))) - - -(ert-deftest ert-test-set-functions () - (let ((c1 (cons nil nil)) - (c2 (cons nil nil)) - (sym (make-symbol "a"))) - (let ((e '()) - (a (list 'a 'b sym nil "" "x" c1 c2)) - (b (list c1 'y 'b sym 'x))) - (should (equal (ert--set-difference e e) e)) - (should (equal (ert--set-difference a e) a)) - (should (equal (ert--set-difference e a) e)) - (should (equal (ert--set-difference a a) e)) - (should (equal (ert--set-difference b e) b)) - (should (equal (ert--set-difference e b) e)) - (should (equal (ert--set-difference b b) e)) - (should (equal (ert--set-difference a b) (list 'a nil "" "x" c2))) - (should (equal (ert--set-difference b a) (list 'y 'x))) - - ;; We aren't testing whether this is really using `eq' rather than `eql'. - (should (equal (ert--set-difference-eq e e) e)) - (should (equal (ert--set-difference-eq a e) a)) - (should (equal (ert--set-difference-eq e a) e)) - (should (equal (ert--set-difference-eq a a) e)) - (should (equal (ert--set-difference-eq b e) b)) - (should (equal (ert--set-difference-eq e b) e)) - (should (equal (ert--set-difference-eq b b) e)) - (should (equal (ert--set-difference-eq a b) (list 'a nil "" "x" c2))) - (should (equal (ert--set-difference-eq b a) (list 'y 'x))) - - (should (equal (ert--union e e) e)) - (should (equal (ert--union a e) a)) - (should (equal (ert--union e a) a)) - (should (equal (ert--union a a) a)) - (should (equal (ert--union b e) b)) - (should (equal (ert--union e b) b)) - (should (equal (ert--union b b) b)) - (should (equal (ert--union a b) (list 'a 'b sym nil "" "x" c1 c2 'y 'x))) - (should (equal (ert--union b a) (list c1 'y 'b sym 'x 'a nil "" "x" c2))) - - (should (equal (ert--intersection e e) e)) - (should (equal (ert--intersection a e) e)) - (should (equal (ert--intersection e a) e)) - (should (equal (ert--intersection a a) a)) - (should (equal (ert--intersection b e) e)) - (should (equal (ert--intersection e b) e)) - (should (equal (ert--intersection b b) b)) - (should (equal (ert--intersection a b) (list 'b sym c1))) - (should (equal (ert--intersection b a) (list c1 'b sym)))))) - -(ert-deftest ert-test-gensym () - ;; Since the expansion of `should' calls `ert--gensym' and thus has a - ;; side-effect on `ert--gensym-counter', we have to make sure all - ;; macros in our test body are expanded before we rebind - ;; `ert--gensym-counter' and run the body. Otherwise, the test would - ;; fail if run interpreted. - (let ((body (byte-compile - '(lambda () - (should (equal (symbol-name (ert--gensym)) "G0")) - (should (equal (symbol-name (ert--gensym)) "G1")) - (should (equal (symbol-name (ert--gensym)) "G2")) - (should (equal (symbol-name (ert--gensym "foo")) "foo3")) - (should (equal (symbol-name (ert--gensym "bar")) "bar4")) - (should (equal ert--gensym-counter 5)))))) - (let ((ert--gensym-counter 0)) - (funcall body)))) - -(ert-deftest ert-test-coerce-to-vector () - (let* ((a (vector)) - (b (vector 1 a 3)) - (c (list)) - (d (list b a))) - (should (eql (ert--coerce-to-vector a) a)) - (should (eql (ert--coerce-to-vector b) b)) - (should (equal (ert--coerce-to-vector c) (vector))) - (should (equal (ert--coerce-to-vector d) (vector b a))))) - -(ert-deftest ert-test-string-position () - (should (eql (ert--string-position ?x "") nil)) - (should (eql (ert--string-position ?a "abc") 0)) - (should (eql (ert--string-position ?b "abc") 1)) - (should (eql (ert--string-position ?c "abc") 2)) - (should (eql (ert--string-position ?d "abc") nil)) - (should (eql (ert--string-position ?A "abc") nil))) - -(ert-deftest ert-test-mismatch () - (should (eql (ert--mismatch "" "") nil)) - (should (eql (ert--mismatch "" "a") 0)) - (should (eql (ert--mismatch "a" "a") nil)) - (should (eql (ert--mismatch "ab" "a") 1)) - (should (eql (ert--mismatch "Aa" "aA") 0)) - (should (eql (ert--mismatch '(a b c) '(a b d)) 2))) - (ert-deftest ert-test-string-first-line () (should (equal (ert--string-first-line "") "")) (should (equal (ert--string-first-line "abc") "abc")) diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 8fcfbe548fc..0e9be33f157 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -77,40 +77,46 @@ (ert-deftest file-notify-test00-availability () "Test availability of `file-notify'." + :expected-result (if file-notify-support :passed :failed) (should (memq file-notify-support '(gfilenotify inotify w32notify)))) -(ert-deftest file-notify-test01-add-watch () - "Check `file-notify-add-watch'." - (let (desc) - ;; Check, that different valid parameters are accepted. - (should (setq desc (file-notify-add-watch - temporary-file-directory '(change) 'ignore))) - (file-notify-rm-watch desc) - (should (setq desc (file-notify-add-watch - temporary-file-directory '(attribute-change) 'ignore))) - (file-notify-rm-watch desc) - (should (setq desc (file-notify-add-watch - temporary-file-directory - '(change attribute-change) 'ignore))) - (file-notify-rm-watch desc) - - ;; Check error handling. - (should - (equal (car (should-error (file-notify-add-watch 1 2 3 4))) - 'wrong-number-of-arguments)) - (should - (equal (should-error (file-notify-add-watch 1 2 3)) - '(wrong-type-argument 1))) - (should - (equal (should-error (file-notify-add-watch temporary-file-directory 2 3)) - '(wrong-type-argument 2))) - (should - (equal (should-error (file-notify-add-watch - temporary-file-directory '(change) 3)) - '(wrong-type-argument 3))))) +(when file-notify-support -(file-notify--deftest-remote file-notify-test01-add-watch - "Check `file-notify-add-watch' for remote files.") + (ert-deftest file-notify-test01-add-watch () + "Check `file-notify-add-watch'." + (let (desc) + ;; Check, that different valid parameters are accepted. + (should (setq desc (file-notify-add-watch + temporary-file-directory '(change) 'ignore))) + (file-notify-rm-watch desc) + (should (setq desc (file-notify-add-watch + temporary-file-directory + '(attribute-change) 'ignore))) + (file-notify-rm-watch desc) + (should (setq desc (file-notify-add-watch + temporary-file-directory + '(change attribute-change) 'ignore))) + (file-notify-rm-watch desc) + + ;; Check error handling. + (should + (equal (car (should-error (file-notify-add-watch 1 2 3 4))) + 'wrong-number-of-arguments)) + (should + (equal (should-error (file-notify-add-watch 1 2 3)) + '(wrong-type-argument 1))) + (should + (equal (should-error (file-notify-add-watch + temporary-file-directory 2 3)) + '(wrong-type-argument 2))) + (should + (equal (should-error (file-notify-add-watch + temporary-file-directory '(change) 3)) + '(wrong-type-argument 3))))) + + (file-notify--deftest-remote file-notify-test01-add-watch + "Check `file-notify-add-watch' for remote files.") + ) ;; file-notify-support (defun file-notify--test-event-test () "Ert test function to be called by `file-notify--test-event-handler'. @@ -141,52 +147,55 @@ Save the result in `file-notify--test-results', for later analysis." (expand-file-name (make-temp-name "file-notify-test") temporary-file-directory)) -(ert-deftest file-notify-test02-events () - "Check file creation/removal notifications." - (let (desc) - (unwind-protect - (progn - (setq file-notify--test-results nil - file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-tmpfile1 (file-notify--test-make-temp-name) - desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) - - ;; Check creation and removal. - (write-region "any text" nil file-notify--test-tmpfile) - (delete-file file-notify--test-tmpfile) - - ;; Check copy and rename. - (write-region "any text" nil file-notify--test-tmpfile) - (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) - (delete-file file-notify--test-tmpfile) - (delete-file file-notify--test-tmpfile1) - - (write-region "any text" nil file-notify--test-tmpfile) - (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) - (delete-file file-notify--test-tmpfile1)) - - ;; Wait for events, and exit. - (sit-for 5 'nodisplay) - (file-notify-rm-watch desc) - (ignore-errors (delete-file file-notify--test-tmpfile)) - (ignore-errors (delete-file file-notify--test-tmpfile1)))) +(when file-notify-support + + (ert-deftest file-notify-test02-events () + "Check file creation/removal notifications." + (let (desc) + (unwind-protect + (progn + (setq file-notify--test-results nil + file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 (file-notify--test-make-temp-name) + desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) 'file-notify--test-event-handler)) + + ;; Check creation and removal. + (write-region "any text" nil file-notify--test-tmpfile) + (delete-file file-notify--test-tmpfile) + + ;; Check copy and rename. + (write-region "any text" nil file-notify--test-tmpfile) + (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) + (delete-file file-notify--test-tmpfile) + (delete-file file-notify--test-tmpfile1) + + (write-region "any text" nil file-notify--test-tmpfile) + (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) + (delete-file file-notify--test-tmpfile1)) + + ;; Wait for events, and exit. + (sit-for 5 'nodisplay) + (file-notify-rm-watch desc) + (ignore-errors (delete-file file-notify--test-tmpfile)) + (ignore-errors (delete-file file-notify--test-tmpfile1)))) - (dolist (result file-notify--test-results) - ;(message "%s" (ert-test-result-messages result)) - (when (ert-test-failed-p result) - (ert-fail (cadr (ert-test-result-with-condition-condition result)))))) + (dolist (result file-notify--test-results) + ;(message "%s" (ert-test-result-messages result)) + (when (ert-test-failed-p result) + (ert-fail (cadr (ert-test-result-with-condition-condition result)))))) -(file-notify--deftest-remote file-notify-test02-events - "Check file creation/removal notifications for remote files.") + (file-notify--deftest-remote file-notify-test02-events + "Check file creation/removal notifications for remote files.") + ) ;; file-notify-support ;; autorevert runs only in interactive mode. (defvar auto-revert-remote-files) (setq auto-revert-remote-files t) (require 'autorevert) -(when (null noninteractive) +(when (and file-notify-support (null noninteractive)) (ert-deftest file-notify-test03-autorevert () "Check autorevert via file notification. @@ -240,7 +249,7 @@ This test is skipped in batch mode." (file-notify--deftest-remote file-notify-test03-autorevert "Check autorevert via file notification for remote files. This test is skipped in batch mode.") - ) ;; (null noninteractive) + ) ;; (and file-notify-support (null noninteractive)) (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." diff --git a/test/automated/files.el b/test/automated/files.el index f2d2192a420..8ce2ed7230c 100644 --- a/test/automated/files.el +++ b/test/automated/files.el @@ -146,4 +146,7 @@ form.") (should (file-test--do-local-variables-test str subtest)))))) (ad-disable-advice 'hack-local-variables-confirm 'around 'files-test))) +;; Stop the above "Local Var..." confusing Emacs. + + ;;; files.el ends here diff --git a/test/automated/flymake-tests.el b/test/automated/flymake-tests.el index 9cc87b608ad..03a8fb08bc5 100644 --- a/test/automated/flymake-tests.el +++ b/test/automated/flymake-tests.el @@ -25,9 +25,6 @@ (require 'ert) (require 'flymake) -(defgroup flymake-tests nil - "Test suite for flymake.") - ;; Warning predicate (defun flymake-tests--current-face (file predicate) diff --git a/test/automated/icalendar-tests.el b/test/automated/icalendar-tests.el index bca462da4d9..28fa47630a8 100644 --- a/test/automated/icalendar-tests.el +++ b/test/automated/icalendar-tests.el @@ -1194,8 +1194,7 @@ Argument INPUT icalendar event string." (should (string= org-input cycled))))) ;; clean up (kill-buffer (find-buffer-visiting temp-diary)) - (save-excursion - (set-buffer (find-buffer-visiting temp-ics)) + (with-current-buffer (find-buffer-visiting temp-ics) (set-buffer-modified-p nil) (kill-buffer (current-buffer))) (delete-file temp-diary) diff --git a/test/automated/imenu-test.el b/test/automated/imenu-test.el index 83e19ebd914..b2b0c6b5c31 100644 --- a/test/automated/imenu-test.el +++ b/test/automated/imenu-test.el @@ -22,6 +22,7 @@ ;;; Code: +(require 'ert) (require 'imenu) ;; (imenu-simple-scan-deftest-gather-strings-from-list diff --git a/test/automated/inotify-test.el b/test/automated/inotify-test.el index 175f262b282..b4d20cf4fb1 100644 --- a/test/automated/inotify-test.el +++ b/test/automated/inotify-test.el @@ -25,6 +25,9 @@ (require 'ert) +(declare-function inotify-add-watch "inotify.c" (file-name aspect callback)) +(declare-function inotify-rm-watch "inotify.c" (watch-descriptor)) + (when (featurep 'inotify) ;; (ert-deftest filewatch-file-watch-aspects-check () @@ -45,7 +48,7 @@ (let ((temp-file (make-temp-file "inotify-simple")) (events 0)) (let ((wd - (inotify-add-watch temp-file t (lambda (ev) + (inotify-add-watch temp-file t (lambda (_ev) (setq events (1+ events)))))) (unwind-protect (progn diff --git a/test/automated/package-test.el b/test/automated/package-test.el index 706ba953d98..a5f0ebb1f94 100755 --- a/test/automated/package-test.el +++ b/test/automated/package-test.el @@ -142,6 +142,9 @@ (let ((help-xref-following t)) ,@body))) +(autoload 'makeinfo-buffer "makeinfo") +(defvar compilation-in-progress) + (defun package-test-install-texinfo (file) "Install from texinfo FILE. @@ -156,7 +159,6 @@ FILE should be a .texinfo file relative to the current (with-current-buffer (find-file-literally full-file) (unwind-protect (progn - (require 'makeinfo) (makeinfo-buffer) ;; Give `makeinfo-buffer' a chance to finish (while compilation-in-progress @@ -184,6 +186,9 @@ DIR is the base name of the package directory, without the trailing slash" (dolist (file (package-test-suffix-matches dir package-test-built-file-suffixes)) (delete-file file)))) +(defvar tar-parse-info) +(declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct + (defun package-test-search-tar-file (filename) "Search the current buffer's `tar-parse-info' variable for FILENAME. diff --git a/test/automated/package-x-test.el b/test/automated/package-x-test.el index b8f2a23f6d5..beb18358085 100755 --- a/test/automated/package-x-test.el +++ b/test/automated/package-x-test.el @@ -35,6 +35,7 @@ (require 'package-x) (require 'ert) (require 'cl-lib) +(eval-when-compile (require 'package-test)) ;; package-test is not normally in `load-path', so temporarily set ;; `load-path' to contain the current directory. diff --git a/test/automated/python-tests.el b/test/automated/python-tests.el index 40505cc7953..1dffe9544fe 100644 --- a/test/automated/python-tests.el +++ b/test/automated/python-tests.el @@ -21,6 +21,7 @@ ;;; Code: +(require 'ert) (require 'python) (defmacro python-tests-with-temp-buffer (contents &rest body) @@ -463,10 +464,10 @@ Class foo(object): " (python-tests-look-at "3)") (forward-line 1) - (= (python-indent-calculate-indentation) 12) + (should (= (python-indent-calculate-indentation) 8)) (python-tests-look-at "pass") (forward-line 1) - (= (python-indent-calculate-indentation) 8))) + (should (= (python-indent-calculate-indentation) 8)))) ;;; Navigation diff --git a/test/automated/ruby-mode-tests.el b/test/automated/ruby-mode-tests.el index 02582e8ad2d..ad805f16777 100644 --- a/test/automated/ruby-mode-tests.el +++ b/test/automated/ruby-mode-tests.el @@ -21,6 +21,7 @@ ;;; Code: +(require 'ert) (require 'ruby-mode) (defun ruby-should-indent (content column) @@ -474,29 +475,30 @@ VALUES-PLIST is a list with alternating index and value elements." (with-temp-buffer (insert ruby-block-test-example) (ruby-mode) + (goto-char (point-min)) ,@body))) (put 'ruby-deftest-move-to-block 'lisp-indent-function 'defun) (ruby-deftest-move-to-block works-on-do - (goto-line 11) + (forward-line 10) (ruby-end-of-block) (should (= 13 (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) + (forward-line 4) (ruby-move-to-block 0) (should (= 5 (line-number-at-pos)))) (ruby-deftest-move-to-block ok-with-three - (goto-line 2) + (forward-line 1) (ruby-move-to-block 3) (should (= 14 (line-number-at-pos)))) (ruby-deftest-move-to-block ok-with-minus-two - (goto-line 10) + (forward-line 9) (ruby-move-to-block -2) (should (= 2 (line-number-at-pos)))) @@ -514,7 +516,7 @@ VALUES-PLIST is a list with alternating index and value elements." | | |end"))) (ruby-with-temp-buffer s - (goto-line 1) + (goto-char (point-min)) (ruby-end-of-block) (should (= 5 (line-number-at-pos))) (ruby-beginning-of-block) @@ -529,7 +531,7 @@ VALUES-PLIST is a list with alternating index and value elements." | end | eowarn |end") - (goto-line 1) + (goto-char (point-min)) (ruby-end-of-block) (should (= 6 (line-number-at-pos))) (ruby-beginning-of-block) @@ -541,7 +543,6 @@ VALUES-PLIST is a list with alternating index and value elements." "foo do | Module.to_s |end") - (end-of-buffer) (let ((case-fold-search t)) (ruby-beginning-of-block)) (should (= 1 (line-number-at-pos))))) @@ -553,7 +554,8 @@ VALUES-PLIST is a list with alternating index and value elements." | end |else |end") - (goto-line 4) + (goto-char (point-min)) + (forward-line 3) (ruby-beginning-of-block) (should (= 1 (line-number-at-pos))))) @@ -565,7 +567,8 @@ VALUES-PLIST is a list with alternating index and value elements." | Class.to_s | end |end") - (goto-line 4) + (goto-char (point-min)) + (forward-line 3) (let ((case-fold-search t)) (beginning-of-defun)) (should (= 2 (line-number-at-pos))))) @@ -578,7 +581,8 @@ VALUES-PLIST is a list with alternating index and value elements." | 'ho hum' | end |end") - (goto-line 2) + (goto-char (point-min)) + (forward-line 1) (end-of-defun) (should (= 5 (line-number-at-pos))))) diff --git a/test/automated/undo-tests.el b/test/automated/undo-tests.el index 98b0c52728b..87c55c5d374 100644 --- a/test/automated/undo-tests.el +++ b/test/automated/undo-tests.el @@ -200,6 +200,32 @@ '(error "Unrecognized entry in undo list \"bogus\"")))) (buffer-string)))))) +;; http://debbugs.gnu.org/14824 +(ert-deftest undo-test-buffer-modified () + "Test undoing marks buffer unmodified." + (with-temp-buffer + (buffer-enable-undo) + (insert "1") + (undo-boundary) + (set-buffer-modified-p nil) + (insert "2") + (undo) + (should-not (buffer-modified-p)))) + +(ert-deftest undo-test-file-modified () + "Test undoing marks buffer visiting file unmodified." + (let ((tempfile (make-temp-file "undo-test"))) + (unwind-protect + (progn + (with-current-buffer (find-file-noselect tempfile) + (insert "1") + (undo-boundary) + (set-buffer-modified-p nil) + (insert "2") + (undo) + (should-not (buffer-modified-p)))) + (delete-file tempfile)))) + (defun undo-test-all (&optional interactive) "Run all tests for \\[undo]." (interactive "p") diff --git a/test/automated/xml-parse-tests.el b/test/automated/xml-parse-tests.el index 874ae01affb..9157a0d3002 100644 --- a/test/automated/xml-parse-tests.el +++ b/test/automated/xml-parse-tests.el @@ -27,6 +27,7 @@ ;;; Code: +(require 'ert) (require 'xml) (defvar xml-parse-tests--data |