commit 4132bd74e9816ca913f862835cc062e092ab8b79 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sun May 14 01:29:05 2017 -0700 Merge from gnulib This incorporates: 2017-05-13 largefile: Simplify 2017-05-13 largefile: Improve and document 2017-05-13 truncate: New module 2017-05-13 windows-stat-timespec: New module 2017-05-13 windows-stat-override: New module 2017-05-11 getopt-posix: port to mingw 2017-05-11 gettimeofday: Increase precision on mingw 2017-05-10 time: Fix missing initialization of HAVE_TIMEZONE_T 2017-05-10 Implement a way to opt out from MSVC support 2017-05-09 tzset: Expand comment about TZ problem on native Windows * build-aux/config.guess, lib/dup2.c, lib/fcntl.c, lib/fsync.c: * lib/getdtablesize.c, lib/getopt.c, lib/gettimeofday.c: * lib/mktime.c, lib/stat-time.h, lib/sys_stat.in.h, lib/unistd.in.h: * lib/utimens.c, m4/gettimeofday.m4, m4/largefile.m4: * m4/sys_stat_h.m4, m4/sys_time_h.m4, m4/time_h.m4, m4/time_rz.m4: * m4/unistd_h.m4: Copy from gnulib. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. diff --git a/build-aux/config.guess b/build-aux/config.guess index 69ed3e573b..faa63aa942 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-03-05' +timestamp='2017-05-11' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1335,16 +1335,16 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NEO-?:NONSTOP_KERNEL:*:*) + NEO-*:NONSTOP_KERNEL:*:*) echo neo-tandem-nsk${UNAME_RELEASE} exit ;; NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; - NSR-?:NONSTOP_KERNEL:*:*) + NSR-*:NONSTOP_KERNEL:*:*) echo nsr-tandem-nsk${UNAME_RELEASE} exit ;; - NSX-?:NONSTOP_KERNEL:*:*) + NSX-*:NONSTOP_KERNEL:*:*) echo nsx-tandem-nsk${UNAME_RELEASE} exit ;; *:NonStop-UX:*:*) diff --git a/lib/dup2.c b/lib/dup2.c index c0c7cadf4a..002dc8c76c 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -35,10 +35,39 @@ # define WIN32_LEAN_AND_MEAN # include -# include "msvc-inval.h" +# if HAVE_MSVC_INVALID_PARAMETER_HANDLER +# include "msvc-inval.h" +# endif /* Get _get_osfhandle. */ -# include "msvc-nothrow.h" +# if GNULIB_MSVC_NOTHROW +# include "msvc-nothrow.h" +# else +# include +# endif + +# if HAVE_MSVC_INVALID_PARAMETER_HANDLER +static int +dup2_nothrow (int fd, int desired_fd) +{ + int result; + + TRY_MSVC_INVAL + { + result = dup2 (fd, desired_fd); + } + CATCH_MSVC_INVAL + { + errno = EBADF; + result = -1; + } + DONE_MSVC_INVAL; + + return result; +} +# else +# define dup2_nothrow dup2 +# endif static int ms_windows_dup2 (int fd, int desired_fd) @@ -66,16 +95,7 @@ ms_windows_dup2 (int fd, int desired_fd) return -1; } - TRY_MSVC_INVAL - { - result = dup2 (fd, desired_fd); - } - CATCH_MSVC_INVAL - { - errno = EBADF; - result = -1; - } - DONE_MSVC_INVAL; + result = dup2_nothrow (fd, desired_fd); if (result == 0) result = desired_fd; diff --git a/lib/fcntl.c b/lib/fcntl.c index afe15468ff..d4dd144e05 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -38,7 +38,11 @@ # include /* Get _get_osfhandle. */ -# include "msvc-nothrow.h" +# if GNULIB_MSVC_NOTHROW +# include "msvc-nothrow.h" +# else +# include +# endif /* Upper bound on getdtablesize(). See lib/getdtablesize.c. */ # define OPEN_MAX_MAX 0x10000 diff --git a/lib/fsync.c b/lib/fsync.c index 46dd59b3d2..5a4945ef2b 100644 --- a/lib/fsync.c +++ b/lib/fsync.c @@ -34,7 +34,11 @@ # include /* Get _get_osfhandle. */ -# include "msvc-nothrow.h" +# if GNULIB_MSVC_NOTHROW +# include "msvc-nothrow.h" +# else +# include +# endif int fsync (int fd) diff --git a/lib/getdtablesize.c b/lib/getdtablesize.c index 7fabb51e2c..c356cf4aa9 100644 --- a/lib/getdtablesize.c +++ b/lib/getdtablesize.c @@ -24,7 +24,9 @@ # include -# include "msvc-inval.h" +# if HAVE_MSVC_INVALID_PARAMETER_HANDLER +# include "msvc-inval.h" +# endif # if HAVE_MSVC_INVALID_PARAMETER_HANDLER static int @@ -44,7 +46,8 @@ _setmaxstdio_nothrow (int newmax) return result; } -# define _setmaxstdio _setmaxstdio_nothrow +# else +# define _setmaxstdio_nothrow _setmaxstdio # endif /* Cache for the previous getdtablesize () result. Safe to cache because @@ -76,9 +79,9 @@ getdtablesize (void) 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) + for (bound = 0x10000; _setmaxstdio_nothrow (bound) < 0; bound = bound / 2) ; - _setmaxstdio (orig_max_stdio); + _setmaxstdio_nothrow (orig_max_stdio); dtablesize = bound; } return dtablesize; diff --git a/lib/getopt.c b/lib/getopt.c index a7db39b68d..9a2867db27 100644 --- a/lib/getopt.c +++ b/lib/getopt.c @@ -45,7 +45,8 @@ # define _(msgid) gettext (msgid) /* When used standalone, flockfile and funlockfile might not be available. */ -# ifndef _POSIX_THREAD_SAFE_FUNCTIONS +# if (!defined _POSIX_THREAD_SAFE_FUNCTIONS \ + || ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)) # define flockfile(fp) /* nop */ # define funlockfile(fp) /* nop */ # endif diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index 1039f77d18..8ae7622af3 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -64,42 +64,20 @@ int gettimeofday (struct timeval *restrict tv, void *restrict tz) { #undef gettimeofday -#if HAVE_GETTIMEOFDAY -# if GETTIMEOFDAY_CLOBBERS_LOCALTIME - /* Save and restore the contents of the buffer used for localtime's - result around the call to gettimeofday. */ - struct tm save = *localtime_buffer_addr; -# endif - -# if defined timeval /* 'struct timeval' overridden by gnulib? */ -# undef timeval - struct timeval otv; - int result = gettimeofday (&otv, (struct timezone *) tz); - if (result == 0) - { - tv->tv_sec = otv.tv_sec; - tv->tv_usec = otv.tv_usec; - } -# else - int result = gettimeofday (tv, (struct timezone *) tz); -# endif - -# if GETTIMEOFDAY_CLOBBERS_LOCALTIME - *localtime_buffer_addr = save; -# endif - - return result; - -#else - -# ifdef WINDOWS_NATIVE +#ifdef WINDOWS_NATIVE /* On native Windows, there are two ways to get the current time: GetSystemTimeAsFileTime or GetSystemTimePreciseAsFileTime - . */ + . + GetSystemTimeAsFileTime produces values that jump by increments of + 15.627 milliseconds (!) on average. + Whereas GetSystemTimePreciseAsFileTime values usually jump by 1 or 2 + microseconds. + More discussion on this topic: + . */ FILETIME current_time; if (!initialized) @@ -122,6 +100,36 @@ gettimeofday (struct timeval *restrict tv, void *restrict tz) tv->tv_sec = microseconds_since_1970 / (ULONGLONG) 1000000; tv->tv_usec = microseconds_since_1970 % (ULONGLONG) 1000000; + return 0; + +#else + +# if HAVE_GETTIMEOFDAY +# if GETTIMEOFDAY_CLOBBERS_LOCALTIME + /* Save and restore the contents of the buffer used for localtime's + result around the call to gettimeofday. */ + struct tm save = *localtime_buffer_addr; +# endif + +# if defined timeval /* 'struct timeval' overridden by gnulib? */ +# undef timeval + struct timeval otv; + int result = gettimeofday (&otv, (struct timezone *) tz); + if (result == 0) + { + tv->tv_sec = otv.tv_sec; + tv->tv_usec = otv.tv_usec; + } +# else + int result = gettimeofday (tv, (struct timezone *) tz); +# endif + +# if GETTIMEOFDAY_CLOBBERS_LOCALTIME + *localtime_buffer_addr = save; +# endif + + return result; + # else # if !defined OK_TO_USE_1S_CLOCK @@ -131,9 +139,8 @@ gettimeofday (struct timeval *restrict tv, void *restrict tz) tv->tv_sec = time (NULL); tv->tv_usec = 0; -# endif - return 0; +# endif #endif } diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 51ae189124..d4afafbecc 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -225,6 +225,7 @@ GNULIB_OBSTACK_PRINTF_POSIX = @GNULIB_OBSTACK_PRINTF_POSIX@ GNULIB_OPEN = @GNULIB_OPEN@ GNULIB_OPENAT = @GNULIB_OPENAT@ GNULIB_OPENDIR = @GNULIB_OPENDIR@ +GNULIB_OVERRIDES_STRUCT_STAT = @GNULIB_OVERRIDES_STRUCT_STAT@ GNULIB_OVERRIDES_WINT_T = @GNULIB_OVERRIDES_WINT_T@ GNULIB_PCLOSE = @GNULIB_PCLOSE@ GNULIB_PERROR = @GNULIB_PERROR@ @@ -306,6 +307,7 @@ GNULIB_TIMEGM = @GNULIB_TIMEGM@ GNULIB_TIME_R = @GNULIB_TIME_R@ GNULIB_TIME_RZ = @GNULIB_TIME_RZ@ GNULIB_TMPFILE = @GNULIB_TMPFILE@ +GNULIB_TRUNCATE = @GNULIB_TRUNCATE@ GNULIB_TTYNAME_R = @GNULIB_TTYNAME_R@ GNULIB_TZSET = @GNULIB_TZSET@ GNULIB_UNISTD_H_NONBLOCKING = @GNULIB_UNISTD_H_NONBLOCKING@ @@ -504,6 +506,7 @@ HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@ HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@ HAVE_TIMEGM = @HAVE_TIMEGM@ HAVE_TIMEZONE_T = @HAVE_TIMEZONE_T@ +HAVE_TRUNCATE = @HAVE_TRUNCATE@ HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@ HAVE_TZSET = @HAVE_TZSET@ HAVE_UNISTD_H = @HAVE_UNISTD_H@ @@ -781,6 +784,7 @@ REPLACE_SYMLINK = @REPLACE_SYMLINK@ REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ REPLACE_TMPFILE = @REPLACE_TMPFILE@ +REPLACE_TRUNCATE = @REPLACE_TRUNCATE@ REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ REPLACE_TZSET = @REPLACE_TZSET@ REPLACE_UNLINK = @REPLACE_UNLINK@ @@ -834,6 +838,7 @@ WERROR_CFLAGS = @WERROR_CFLAGS@ WIDGET_OBJ = @WIDGET_OBJ@ WINDOWS_64_BIT_OFF_T = @WINDOWS_64_BIT_OFF_T@ WINDOWS_64_BIT_ST_SIZE = @WINDOWS_64_BIT_ST_SIZE@ +WINDOWS_STAT_TIMESPEC = @WINDOWS_STAT_TIMESPEC@ WINDOW_SYSTEM_OBJ = @WINDOW_SYSTEM_OBJ@ WINDRES = @WINDRES@ WINT_T_SUFFIX = @WINT_T_SUFFIX@ @@ -2586,6 +2591,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \ -e 's|@''WINDOWS_64_BIT_ST_SIZE''@|$(WINDOWS_64_BIT_ST_SIZE)|g' \ + -e 's|@''WINDOWS_STAT_TIMESPEC''@|$(WINDOWS_STAT_TIMESPEC)|g' \ -e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \ -e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/g' \ -e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \ @@ -2599,6 +2605,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU -e 's/@''GNULIB_MKNODAT''@/$(GNULIB_MKNODAT)/g' \ -e 's/@''GNULIB_STAT''@/$(GNULIB_STAT)/g' \ -e 's/@''GNULIB_UTIMENSAT''@/$(GNULIB_UTIMENSAT)/g' \ + -e 's/@''GNULIB_OVERRIDES_STRUCT_STAT''@/$(GNULIB_OVERRIDES_STRUCT_STAT)/g' \ -e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \ -e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \ -e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \ @@ -2893,6 +2900,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_SLEEP''@/$(GNULIB_SLEEP)/g' \ -e 's/@''GNULIB_SYMLINK''@/$(GNULIB_SYMLINK)/g' \ -e 's/@''GNULIB_SYMLINKAT''@/$(GNULIB_SYMLINKAT)/g' \ + -e 's/@''GNULIB_TRUNCATE''@/$(GNULIB_TRUNCATE)/g' \ -e 's/@''GNULIB_TTYNAME_R''@/$(GNULIB_TTYNAME_R)/g' \ -e 's/@''GNULIB_UNISTD_H_GETOPT''@/0$(GNULIB_GL_UNISTD_H_GETOPT)/g' \ -e 's/@''GNULIB_UNISTD_H_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \ @@ -2930,6 +2938,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_SLEEP''@|$(HAVE_SLEEP)|g' \ -e 's|@''HAVE_SYMLINK''@|$(HAVE_SYMLINK)|g' \ -e 's|@''HAVE_SYMLINKAT''@|$(HAVE_SYMLINKAT)|g' \ + -e 's|@''HAVE_TRUNCATE''@|$(HAVE_TRUNCATE)|g' \ -e 's|@''HAVE_UNLINKAT''@|$(HAVE_UNLINKAT)|g' \ -e 's|@''HAVE_USLEEP''@|$(HAVE_USLEEP)|g' \ -e 's|@''HAVE_DECL_ENVIRON''@|$(HAVE_DECL_ENVIRON)|g' \ @@ -2971,6 +2980,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_SLEEP''@|$(REPLACE_SLEEP)|g' \ -e 's|@''REPLACE_SYMLINK''@|$(REPLACE_SYMLINK)|g' \ -e 's|@''REPLACE_SYMLINKAT''@|$(REPLACE_SYMLINKAT)|g' \ + -e 's|@''REPLACE_TRUNCATE''@|$(REPLACE_TRUNCATE)|g' \ -e 's|@''REPLACE_TTYNAME_R''@|$(REPLACE_TTYNAME_R)|g' \ -e 's|@''REPLACE_UNLINK''@|$(REPLACE_UNLINK)|g' \ -e 's|@''REPLACE_UNLINKAT''@|$(REPLACE_UNLINKAT)|g' \ diff --git a/lib/mktime.c b/lib/mktime.c index 06d5916e91..058ab65c03 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -491,9 +491,28 @@ time_t mktime (struct tm *tp) { # if NEED_MKTIME_WINDOWS - /* If the environment variable TZ has been set by Cygwin, neutralize it. - The Microsoft CRT interprets TZ differently than Cygwin and produces - incorrect results if TZ has the syntax used by Cygwin. */ + /* Rectify the value of the environment variable TZ. + There are four possible kinds of such values: + - Traditional US time zone names, e.g. "PST8PDT". Syntax: see + + - Time zone names based on geography, that contain one or more + slashes, e.g. "Europe/Moscow". + - Time zone names based on geography, without slashes, e.g. + "Singapore". + - Time zone names that contain explicit DST rules. Syntax: see + + The Microsoft CRT understands only the first kind. It produces incorrect + results if the value of TZ is of the other kinds. + But in a Cygwin environment, /etc/profile.d/tzset.sh sets TZ to a value + of the second kind for most geographies, or of the first kind in a few + other geographies. If it is of the second kind, neutralize it. For the + Microsoft CRT, an absent or empty TZ means the time zone that the user + has set in the Windows Control Panel. + If the value of TZ is of the third or fourth kind -- Cygwin programs + understand these syntaxes as well --, it does not matter whether we + neutralize it or not, since these values occur only when a Cygwin user + has set TZ explicitly; this case is 1. rare and 2. under the user's + responsibility. */ const char *tz = getenv ("TZ"); if (tz != NULL && strchr (tz, '/') != NULL) _putenv ("TZ="); diff --git a/lib/stat-time.h b/lib/stat-time.h index 154d62a01f..88dcc7f3e0 100644 --- a/lib/stat-time.h +++ b/lib/stat-time.h @@ -43,8 +43,8 @@ extern "C" { time respectively. These macros are private to stat-time.h. */ -#if defined HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC -# ifdef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC +#if _GL_WINDOWS_STAT_TIMESPEC || defined HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC +# if _GL_WINDOWS_STAT_TIMESPEC || defined TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC # define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim) # else # define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.tv_nsec) diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index d5ca343437..1831740900 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -1,4 +1,4 @@ -/* Provide a more complete sys/stat header file. +/* Provide a more complete sys/stat.h header file. Copyright (C) 2005-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify @@ -72,6 +72,75 @@ # define stat _stati64 #endif +/* Optionally, override 'struct stat' on native Windows. */ +#if @GNULIB_OVERRIDES_STRUCT_STAT@ + +# undef stat +# if @GNULIB_STAT@ +# define stat rpl_stat +# else + /* Provoke a clear link error if stat() is used as a function and + module 'stat' is not in use. */ +# define stat stat_used_without_requesting_gnulib_module_stat +# endif + +# if !GNULIB_defined_struct_stat +struct stat +{ + dev_t st_dev; + ino_t st_ino; + mode_t st_mode; + nlink_t st_nlink; +# if 0 + uid_t st_uid; +# else /* uid_t is not defined by default on native Windows. */ + short st_uid; +# endif +# if 0 + gid_t st_gid; +# else /* gid_t is not defined by default on native Windows. */ + short st_gid; +# endif + dev_t st_rdev; + off_t st_size; +# if 0 + blksize_t st_blksize; + blkcnt_t st_blocks; +# endif + +# if @WINDOWS_STAT_TIMESPEC@ + struct timespec st_atim; + struct timespec st_mtim; + struct timespec st_ctim; +# else + time_t st_atime; + time_t st_mtime; + time_t st_ctime; +# endif +}; +# if @WINDOWS_STAT_TIMESPEC@ +# define st_atime st_atim.tv_sec +# define st_mtime st_mtim.tv_sec +# define st_ctime st_ctim.tv_sec + /* Indicator, for gnulib internal purposes. */ +# define _GL_WINDOWS_STAT_TIMESPEC 1 +# endif +# define GNULIB_defined_struct_stat 1 +# endif + +/* Other possible values of st_mode. */ +# if 0 +# define _S_IFBLK 0x6000 +# endif +# if 0 +# define _S_IFLNK 0xA000 +# endif +# if 0 +# define _S_IFSOCK 0xC000 +# endif + +#endif + #ifndef S_IFIFO # ifdef _S_IFIFO # define S_IFIFO _S_IFIFO @@ -345,6 +414,9 @@ _GL_CXXALIAS_RPL (fstat, int, (int fd, struct stat *buf)); _GL_CXXALIAS_SYS (fstat, int, (int fd, struct stat *buf)); # endif _GL_CXXALIASWARN (fstat); +#elif @GNULIB_OVERRIDES_STRUCT_STAT@ +# undef fstat +# define fstat fstat_used_without_requesting_gnulib_module_fstat #elif @WINDOWS_64_BIT_ST_SIZE@ /* Above, we define stat to _stati64. */ # define fstat _fstati64 @@ -378,6 +450,9 @@ _GL_CXXALIAS_SYS (fstatat, int, (int fd, char const *name, struct stat *st, int flags)); # endif _GL_CXXALIASWARN (fstatat); +#elif @GNULIB_OVERRIDES_STRUCT_STAT@ +# undef fstatat +# define fstatat fstatat_used_without_requesting_gnulib_module_fstatat #elif defined GNULIB_POSIXCHECK # undef fstatat # if HAVE_RAW_DECL_FSTATAT @@ -476,6 +551,9 @@ _GL_CXXALIAS_SYS (lstat, int, (const char *name, struct stat *buf)); # if @HAVE_LSTAT@ _GL_CXXALIASWARN (lstat); # endif +#elif @GNULIB_OVERRIDES_STRUCT_STAT@ +# undef lstat +# define lstat lstat_used_without_requesting_gnulib_module_lstat #elif defined GNULIB_POSIXCHECK # undef lstat # if HAVE_RAW_DECL_LSTAT @@ -625,63 +703,69 @@ _GL_WARN_ON_USE (mknodat, "mknodat is not portable - " #if @GNULIB_STAT@ # if @REPLACE_STAT@ -/* We can't use the object-like #define stat rpl_stat, because of - struct stat. This means that rpl_stat will not be used if the user - does (stat)(a,b). Oh well. */ -# if defined _AIX && defined stat && defined _LARGE_FILES - /* With _LARGE_FILES defined, AIX (only) defines stat to stat64, - so we have to replace stat64() instead of stat(). */ -# undef stat64 -# define stat64(name, st) rpl_stat (name, st) -# elif @WINDOWS_64_BIT_ST_SIZE@ - /* Above, we define stat to _stati64. */ -# if defined __MINGW32__ && defined _stati64 -# ifndef _USE_32BIT_TIME_T - /* The system headers define _stati64 to _stat64. */ -# undef _stat64 -# define _stat64(name, st) rpl_stat (name, st) +# if !@GNULIB_OVERRIDES_STRUCT_STAT@ + /* We can't use the object-like #define stat rpl_stat, because of + struct stat. This means that rpl_stat will not be used if the user + does (stat)(a,b). Oh well. */ +# if defined _AIX && defined stat && defined _LARGE_FILES + /* With _LARGE_FILES defined, AIX (only) defines stat to stat64, + so we have to replace stat64() instead of stat(). */ +# undef stat64 +# define stat64(name, st) rpl_stat (name, st) +# elif @WINDOWS_64_BIT_ST_SIZE@ + /* Above, we define stat to _stati64. */ +# if defined __MINGW32__ && defined _stati64 +# ifndef _USE_32BIT_TIME_T + /* The system headers define _stati64 to _stat64. */ +# undef _stat64 +# define _stat64(name, st) rpl_stat (name, st) +# endif +# elif defined _MSC_VER && defined _stati64 +# ifdef _USE_32BIT_TIME_T + /* The system headers define _stati64 to _stat32i64. */ +# undef _stat32i64 +# define _stat32i64(name, st) rpl_stat (name, st) +# else + /* The system headers define _stati64 to _stat64. */ +# undef _stat64 +# define _stat64(name, st) rpl_stat (name, st) +# endif +# else +# undef _stati64 +# define _stati64(name, st) rpl_stat (name, st) # endif -# elif defined _MSC_VER && defined _stati64 +# elif defined __MINGW32__ && defined stat # ifdef _USE_32BIT_TIME_T - /* The system headers define _stati64 to _stat32i64. */ + /* The system headers define stat to _stat32i64. */ # undef _stat32i64 # define _stat32i64(name, st) rpl_stat (name, st) # else - /* The system headers define _stati64 to _stat64. */ + /* The system headers define stat to _stat64. */ # undef _stat64 # define _stat64(name, st) rpl_stat (name, st) # endif -# else -# undef _stati64 -# define _stati64(name, st) rpl_stat (name, st) -# endif -# elif defined __MINGW32__ && defined stat -# ifdef _USE_32BIT_TIME_T - /* The system headers define stat to _stat32i64. */ -# undef _stat32i64 -# define _stat32i64(name, st) rpl_stat (name, st) -# else - /* The system headers define stat to _stat64. */ -# undef _stat64 -# define _stat64(name, st) rpl_stat (name, st) -# endif -# elif defined _MSC_VER && defined stat -# ifdef _USE_32BIT_TIME_T - /* The system headers define stat to _stat32. */ -# undef _stat32 -# define _stat32(name, st) rpl_stat (name, st) -# else - /* The system headers define stat to _stat64i32. */ -# undef _stat64i32 -# define _stat64i32(name, st) rpl_stat (name, st) -# endif -# else /* !(_AIX ||__MINGW32__ || _MSC_VER) */ -# undef stat -# define stat(name, st) rpl_stat (name, st) -# endif /* !_LARGE_FILES */ +# elif defined _MSC_VER && defined stat +# ifdef _USE_32BIT_TIME_T + /* The system headers define stat to _stat32. */ +# undef _stat32 +# define _stat32(name, st) rpl_stat (name, st) +# else + /* The system headers define stat to _stat64i32. */ +# undef _stat64i32 +# define _stat64i32(name, st) rpl_stat (name, st) +# endif +# else /* !(_AIX || __MINGW32__ || _MSC_VER) */ +# undef stat +# define stat(name, st) rpl_stat (name, st) +# endif /* !_LARGE_FILES */ +# endif /* !@GNULIB_OVERRIDES_STRUCT_STAT@ */ _GL_EXTERN_C int stat (const char *name, struct stat *buf) _GL_ARG_NONNULL ((1, 2)); # endif +#elif @GNULIB_OVERRIDES_STRUCT_STAT@ +/* see above: + #define stat stat_used_without_requesting_gnulib_module_stat + */ #elif defined GNULIB_POSIXCHECK # undef stat # if HAVE_RAW_DECL_STAT diff --git a/lib/unistd.in.h b/lib/unistd.in.h index cb9321e502..f366caffa5 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -1457,6 +1457,36 @@ _GL_WARN_ON_USE (symlinkat, "symlinkat is not portable - " #endif +#if @GNULIB_TRUNCATE@ +/* Change the size of the file designated by FILENAME to become equal to LENGTH. + Return 0 if successful, otherwise -1 and errno set. + See the POSIX:2008 specification + . */ +# if @REPLACE_TRUNCATE@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef truncate +# define truncate rpl_truncate +# endif +_GL_FUNCDECL_RPL (truncate, int, (const char *filename, off_t length) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (truncate, int, (const char *filename, off_t length)); +# else +# if !@HAVE_TRUNCATE@ +_GL_FUNCDECL_SYS (truncate, int, (const char *filename, off_t length) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (truncate, int, (const char *filename, off_t length)); +# endif +_GL_CXXALIASWARN (truncate); +#elif defined GNULIB_POSIXCHECK +# undef truncate +# if HAVE_RAW_DECL_TRUNCATE +_GL_WARN_ON_USE (truncate, "truncate is unportable - " + "use gnulib module truncate for portability"); +# endif +#endif + + #if @GNULIB_TTYNAME_R@ /* Store at most BUFLEN characters of the pathname of the terminal FD is open on in BUF. Return 0 on success, otherwise an error number. */ diff --git a/lib/utimens.c b/lib/utimens.c index b4bfa8e322..ff4eab073c 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -44,7 +44,11 @@ # define USE_SETFILETIME # define WIN32_LEAN_AND_MEAN # include -# include "msvc-nothrow.h" +# if GNULIB_MSVC_NOTHROW +# include "msvc-nothrow.h" +# else +# include +# endif #endif /* Avoid recursion with rpl_futimens or rpl_utimensat. */ diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4 index 34adc64778..8ee206eea2 100644 --- a/m4/gettimeofday.m4 +++ b/m4/gettimeofday.m4 @@ -1,4 +1,4 @@ -# serial 22 +# serial 23 # Copyright (C) 2001-2003, 2005, 2007, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -9,9 +9,10 @@ dnl From Jim Meyering. AC_DEFUN([gl_FUNC_GETTIMEOFDAY], [ + AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS]) AC_REQUIRE([AC_C_RESTRICT]) + AC_REQUIRE([AC_CANONICAL_HOST]) AC_REQUIRE([gl_HEADER_SYS_TIME_H]) - AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS]) AC_CHECK_FUNCS_ONCE([gettimeofday]) gl_gettimeofday_timezone=void @@ -54,6 +55,11 @@ int gettimeofday (struct timeval *restrict, struct timezone *restrict); if test $REPLACE_STRUCT_TIMEVAL = 1; then REPLACE_GETTIMEOFDAY=1 fi + dnl On mingw, the original gettimeofday has only a precision of 15.6 + dnl milliseconds. So override it. + case "$host_os" in + mingw*) REPLACE_GETTIMEOFDAY=1 ;; + esac fi AC_DEFINE_UNQUOTED([GETTIMEOFDAY_TIMEZONE], [$gl_gettimeofday_timezone], [Define this to 'void' or 'struct timezone' to match the system's diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 74b197c863..8295e48358 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -391,7 +391,7 @@ AC_DEFUN([gl_INIT], fi gl_TIME_MODULE_INDICATOR([time_r]) gl_TIME_RZ - if test "$HAVE_TIMEZONE_T" = 0; then + if test $HAVE_TIMEZONE_T = 0; then AC_LIBOBJ([time_rz]) fi gl_TIME_MODULE_INDICATOR([time_rz]) diff --git a/m4/largefile.m4 b/m4/largefile.m4 index 790f7c0ad3..edc1a9b41b 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -126,9 +126,24 @@ AC_DEFUN([gl_LARGEFILE], else WINDOWS_64_BIT_OFF_T=0 fi - dnl But all native Windows platforms (including mingw64) have a 32-bit - dnl st_size member in 'struct stat'. - WINDOWS_64_BIT_ST_SIZE=1 + dnl Some mingw versions define, if _FILE_OFFSET_BITS=64, 'struct stat' + dnl to 'struct _stat32i64' or 'struct _stat64' (depending on + dnl _USE_32BIT_TIME_T), which has a 32-bit st_size member. + AC_CACHE_CHECK([for 64-bit st_size], [gl_cv_member_st_size_64], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include + struct stat buf; + int verify_st_size_size[sizeof (buf.st_size) >= 8 ? 1 : -1]; + ]], + [[]])], + [gl_cv_member_st_size_64=yes], [gl_cv_member_st_size_64=no]) + ]) + if test $gl_cv_member_st_size_64 = no; then + WINDOWS_64_BIT_ST_SIZE=1 + else + WINDOWS_64_BIT_ST_SIZE=0 + fi ;; *) dnl Nothing to do on gnulib's side. diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4 index 1e34ac40da..8934278982 100644 --- a/m4/sys_stat_h.m4 +++ b/m4/sys_stat_h.m4 @@ -1,4 +1,4 @@ -# sys_stat_h.m4 serial 28 -*- Autoconf -*- +# sys_stat_h.m4 serial 31 -*- Autoconf -*- dnl Copyright (C) 2006-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -19,18 +19,21 @@ AC_DEFUN([gl_HEADER_SYS_STAT_H], dnl Ensure the type mode_t gets defined. AC_REQUIRE([AC_TYPE_MODE_T]) - dnl Whether to override 'struct stat'. + dnl Whether to enable precise timestamps in 'struct stat'. + m4_ifdef([gl_WINDOWS_STAT_TIMESPEC], [ + AC_REQUIRE([gl_WINDOWS_STAT_TIMESPEC]) + ], [ + WINDOWS_STAT_TIMESPEC=0 + ]) + AC_SUBST([WINDOWS_STAT_TIMESPEC]) + + dnl Whether to ensure that struct stat.st_size is 64-bit wide. m4_ifdef([gl_LARGEFILE], [ AC_REQUIRE([gl_LARGEFILE]) ], [ WINDOWS_64_BIT_ST_SIZE=0 ]) AC_SUBST([WINDOWS_64_BIT_ST_SIZE]) - if test $WINDOWS_64_BIT_ST_SIZE = 1; then - AC_DEFINE([_GL_WINDOWS_64_BIT_ST_SIZE], [1], - [Define to 1 if Gnulib overrides 'struct stat' on Windows so that - struct stat.st_size becomes 64-bit.]) - fi dnl Define types that are supposed to be defined in or dnl . @@ -72,6 +75,7 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS], GNULIB_MKNODAT=0; AC_SUBST([GNULIB_MKNODAT]) GNULIB_STAT=0; AC_SUBST([GNULIB_STAT]) GNULIB_UTIMENSAT=0; AC_SUBST([GNULIB_UTIMENSAT]) + GNULIB_OVERRIDES_STRUCT_STAT=0; AC_SUBST([GNULIB_OVERRIDES_STRUCT_STAT]) dnl Assume proper GNU behavior unless another module says otherwise. HAVE_FCHMODAT=1; AC_SUBST([HAVE_FCHMODAT]) HAVE_FSTATAT=1; AC_SUBST([HAVE_FSTATAT]) diff --git a/m4/sys_time_h.m4 b/m4/sys_time_h.m4 index e622dbe9a2..1c8c3cfcc3 100644 --- a/m4/sys_time_h.m4 +++ b/m4/sys_time_h.m4 @@ -1,5 +1,5 @@ # Configure a replacement for . -# serial 8 +# serial 9 # Copyright (C) 2007, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -105,7 +105,6 @@ AC_DEFUN([gl_HEADER_SYS_TIME_H_DEFAULTS], HAVE_GETTIMEOFDAY=1; AC_SUBST([HAVE_GETTIMEOFDAY]) HAVE_STRUCT_TIMEVAL=1; AC_SUBST([HAVE_STRUCT_TIMEVAL]) HAVE_SYS_TIME_H=1; AC_SUBST([HAVE_SYS_TIME_H]) - HAVE_TIMEZONE_T=0; AC_SUBST([HAVE_TIMEZONE_T]) REPLACE_GETTIMEOFDAY=0; AC_SUBST([REPLACE_GETTIMEOFDAY]) REPLACE_STRUCT_TIMEVAL=0; AC_SUBST([REPLACE_STRUCT_TIMEVAL]) ]) diff --git a/m4/time_h.m4 b/m4/time_h.m4 index f52b60192e..28e22092e1 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -2,7 +2,7 @@ # Copyright (C) 2000-2001, 2003-2007, 2009-2017 Free Software Foundation, Inc. -# serial 10 +# serial 11 # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, @@ -120,6 +120,8 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS], HAVE_STRPTIME=1; AC_SUBST([HAVE_STRPTIME]) HAVE_TIMEGM=1; AC_SUBST([HAVE_TIMEGM]) HAVE_TZSET=1; AC_SUBST([HAVE_TZSET]) + dnl Even GNU libc does not have timezone_t yet. + HAVE_TIMEZONE_T=0; AC_SUBST([HAVE_TIMEZONE_T]) dnl If another module says to replace or to not replace, do that. dnl Otherwise, replace only if someone compiles with -DGNULIB_PORTCHECK; dnl this lets maintainers check for portability. diff --git a/m4/time_rz.m4 b/m4/time_rz.m4 index 079e933b4e..3991118b61 100644 --- a/m4/time_rz.m4 +++ b/m4/time_rz.m4 @@ -10,7 +10,7 @@ dnl Written by Paul Eggert. AC_DEFUN([gl_TIME_RZ], [ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS]) + AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS]) AC_REQUIRE([AC_STRUCT_TIMEZONE]) AC_CHECK_TYPES([timezone_t], [], [], [[#include ]]) diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index 25aef19ec9..cc44677d9e 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 69 +# unistd_h.m4 serial 70 dnl Copyright (C) 2006-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -46,8 +46,8 @@ AC_DEFUN([gl_UNISTD_H], gethostname getlogin getlogin_r getpagesize getusershell setusershell endusershell group_member isatty lchown link linkat lseek pipe pipe2 pread pwrite - readlink readlinkat rmdir sethostname sleep symlink symlinkat ttyname_r - unlink unlinkat usleep]) + readlink readlinkat rmdir sethostname sleep symlink symlinkat + truncate ttyname_r unlink unlinkat usleep]) ]) AC_DEFUN([gl_UNISTD_MODULE_INDICATOR], @@ -102,6 +102,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], GNULIB_SLEEP=0; AC_SUBST([GNULIB_SLEEP]) GNULIB_SYMLINK=0; AC_SUBST([GNULIB_SYMLINK]) GNULIB_SYMLINKAT=0; AC_SUBST([GNULIB_SYMLINKAT]) + GNULIB_TRUNCATE=0; AC_SUBST([GNULIB_TRUNCATE]) GNULIB_TTYNAME_R=0; AC_SUBST([GNULIB_TTYNAME_R]) GNULIB_UNISTD_H_NONBLOCKING=0; AC_SUBST([GNULIB_UNISTD_H_NONBLOCKING]) GNULIB_UNISTD_H_SIGPIPE=0; AC_SUBST([GNULIB_UNISTD_H_SIGPIPE]) @@ -139,6 +140,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], HAVE_SLEEP=1; AC_SUBST([HAVE_SLEEP]) HAVE_SYMLINK=1; AC_SUBST([HAVE_SYMLINK]) HAVE_SYMLINKAT=1; AC_SUBST([HAVE_SYMLINKAT]) + HAVE_TRUNCATE=1; AC_SUBST([HAVE_TRUNCATE]) HAVE_UNLINKAT=1; AC_SUBST([HAVE_UNLINKAT]) HAVE_USLEEP=1; AC_SUBST([HAVE_USLEEP]) HAVE_DECL_ENVIRON=1; AC_SUBST([HAVE_DECL_ENVIRON]) @@ -179,6 +181,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], REPLACE_SLEEP=0; AC_SUBST([REPLACE_SLEEP]) REPLACE_SYMLINK=0; AC_SUBST([REPLACE_SYMLINK]) REPLACE_SYMLINKAT=0; AC_SUBST([REPLACE_SYMLINKAT]) + REPLACE_TRUNCATE=0; AC_SUBST([REPLACE_TRUNCATE]) REPLACE_TTYNAME_R=0; AC_SUBST([REPLACE_TTYNAME_R]) REPLACE_UNLINK=0; AC_SUBST([REPLACE_UNLINK]) REPLACE_UNLINKAT=0; AC_SUBST([REPLACE_UNLINKAT]) commit 9a5e864de731e113badbe300b1e4174f103547fa Merge: 91ccb2661e aa779b0f15 Author: Marcin Borkowski Date: Sun May 14 07:09:54 2017 +0200 Merge branch 'fix/bug-21072' commit 91ccb2661eac1bd5b2bbf87780d9113e75535d6b Author: Ted Zlatanov Date: Wed Apr 26 14:40:03 2017 -0400 * .gitlab-ci.yml: Add setup for GitLab CI builds. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000000..893cb61afb --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,41 @@ +# Copyright (C) 2017 Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +# GitLab CI support for GNU Emacs + +# The presence of this file does not imply any FSF/GNU endorsement of +# GitLab CI or any related entities and is intended only for +# evaluation purposes. + +# Maintainer: tzz@lifelogs.com +# URL: https://gitlab.com/emacs-ci/emacs + +image: debian:unstable + +before_script: + - apt update -qq + - apt install -y -qq build-essential autoconf automake libncurses-dev gnutls-dev + +stages: + - test + +test: + stage: test + script: + - ./autogen.sh + - ./configure --without-makeinfo + - make check commit 4e0887556776086a0f508c394ab56cac5e1a4c8d Author: Mark Oteiza Date: Sat May 13 21:40:23 2017 -0400 ; Revert "Adjust the edebug spec of if-let*" This reverts commit fd4b83ca7c20a68060772ec13aadbe29db612b3f. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 440213eb38..8a955277fe 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -128,8 +128,7 @@ In the special case you only want to bind a single value, VARLIST can just be a plain tuple. \n(fn VARLIST THEN ELSE...)" (declare (indent 2) - (debug ([&or (&rest &or symbolp (gate symbolp &optional form)) - (symbolp form)] + (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)] form body))) (when (and (<= (length bindings) 2) (not (listp (car bindings)))) commit 78fe5abc11c9ff237615d6884aed159229377cc5 Author: Tak Kunihiro Date: Sat May 13 20:25:39 2017 +0300 New minor mode 'pixel-scroll-mode' * lisp/pixel-scroll.el: New file. * etc/NEWS: Mention pixel-scroll-mode. diff --git a/etc/NEWS b/etc/NEWS index 380ce71013..b7dbb14630 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -828,6 +828,8 @@ processes on exit. mode for *.html files. This mode handles indentation, fontification, and commenting for embedded JavaScript and CSS. +** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling. + * Incompatible Lisp Changes in Emacs 26.1 diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el new file mode 100644 index 0000000000..18c0bc8507 --- /dev/null +++ b/lisp/pixel-scroll.el @@ -0,0 +1,250 @@ +;;; pixel-scroll.el --- Scroll a line smoothly + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Author: Tak Kunihiro +;; Keywords: mouse +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;; Usage: +;; +;; To interactively toggle the mode: +;; +;; M-x pixel-scroll-mode RET +;; +;; To make the mode permanent, put these in your init file: +;; +;; (require 'pixel-scroll) +;; (pixel-scroll-mode 1) + +;;; Commentary: + +;; This package offers a global minor mode which makes mouse-wheel +;; scroll a line smoothly. +;; +;; Scrolling a line up by `set-window-vscroll' and that by `scroll-up' +;; give similar display as shown below. +;; +;; A: (scroll-up 1) +;; B: (set-window-vscroll nil (frame-char-height) t) +;; +;; Also scrolling a pixel up by `set-window-vscroll' and that by +;; `scroll-up' give similar display, when vscroll is the last pixel of +;; the line, as shown below. +;; +;; A: (scroll-up 1) +;; B: (set-window-vscroll nil (1- (frame-char-height) t)) (scroll-up 1) +;; +;; When point reaches to the top of a window on scroll by +;; `set-window-vscroll', vscroll is set to zero. To scroll a line +;; smoothly and continuously, this package scrolls a line by following +;; sequences. +;; +;; (vertical-motion 1) +;; (dolist (vs (number-sequence 1 (1- (frame-char-height)))) +;; (set-window-vscroll nil vs t) (sit-for 0)) +;; (scroll-up 1) + +;;; Todo: +;; +;; Allowing pixel-level scrolling in Emacs requires a thorough review +;; of the related functionalities, to make sure none of them zeroes +;; out vscroll where users won't want that. + +;;; Code: + +(require 'mwheel) + +(defvar pixel-wait 0 + "Idle time on each step of pixel scroll specified in second. +More wait will result in slow and gentle scroll.") + +(defvar pixel-resolution-fine-flag nil + "Set scrolling resolution to a pixel instead of a line. +After a pixel scroll, typing C-n or C-p scrolls the window to +make it fully visible, and undoes the effect of the pixel-level +scroll.") + +;;;###autoload +(define-minor-mode pixel-scroll-mode + "A minor mode to scroll text pixel-by-pixel. +With a prefix argument ARG, enable Pixel Scroll mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable Pixel Scroll mode +if ARG is omitted or nil." + :init-value nil + :group 'scrolling + :global t + :version "26.1" + + (if pixel-scroll-mode + (setq mwheel-scroll-up-function 'pixel-scroll-up + mwheel-scroll-down-function 'pixel-scroll-down) + (setq mwheel-scroll-up-function 'scroll-up + mwheel-scroll-down-function 'scroll-down))) + +(defun pixel-scroll-up (&optional arg) + "Scroll text of selected window up ARG lines. +This is an alternative of `scroll-up'. Scope moves downward." + (interactive) + (or arg (setq arg 1)) + (dotimes (ii arg) ; move scope downward + (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close + (scroll-up 1) ; relay on robust method + (when (pixel-point-at-top-p) ; prevent too late + (vertical-motion 1)) ; move point downward + (pixel-scroll-pixel-up (if pixel-resolution-fine-flag + 1 + (pixel-line-height)))))) ; move scope downward + +(defun pixel-scroll-down (&optional arg) + "Scroll text of selected window down ARG lines. +This is and alternative of `scroll-down'. Scope moves upward." + (interactive) + (or arg (setq arg 1)) + (dotimes (ii arg) + (if (or (pixel-bob-at-top-p) ; when beginning-of-the-buffer is seen + (pixel-eob-at-top-p)) ; for file with a long line + (scroll-down 1) ; relay on robust method + (while (pixel-point-at-bottom-p) ; prevent too late (multi tries) + (vertical-motion -1)) + (pixel-scroll-pixel-down (if pixel-resolution-fine-flag + 1 + (pixel-line-height -1)))))) + +(defun pixel-bob-at-top-p () + "Return non-nil if beginning of buffer is at top of window." + (equal (window-start) (point-min))) + +(defun pixel-eob-at-top-p () + "Return non-nil if end of buffer is at top of window." + (<= (count-lines (window-start) (window-end)) 2)) ; count-screen-lines + +(defun pixel-posn-y-at-point () + "Return y coordinates of point in pixels of current window." + (let ((hscroll0 (window-hscroll)) + (y (cdr (posn-x-y (posn-at-point))))) + ;; when point is out of scope by hscroll + (unless y + (save-excursion + (set-window-hscroll nil (current-column)) + (setq y (cdr (posn-x-y (posn-at-point)))) + (set-window-hscroll nil hscroll0))) + y)) + +(defun pixel-point-at-top-p () + "Return if point is located at top of a window." + (let* ((y (pixel-posn-y-at-point)) + (top-margin y)) + (< top-margin (pixel-line-height)))) + +(defun pixel-point-at-bottom-p () + "Return if point is located at bottom of a window." + (let* ((y (pixel-posn-y-at-point)) + (edges (window-inside-pixel-edges)) + (height (- (nth 3 edges) (nth 1 edges))) ; (- bottom top) + (bottom-margin (- height (+ y (line-pixel-height))))) ; bottom margin + (< bottom-margin (pixel-line-height -1)))) ; coming unseen line + +(defun pixel-scroll-pixel-up (amt) + "Scroll text of selected windows up AMT pixels. +Scope moves downward." + (while (>= (+ (window-vscroll nil t) amt) + (pixel-line-height)) + (setq amt (- amt (pixel--whistlestop-line-up)))) ; major scroll + (pixel--whistlestop-pixel-up amt)) ; minor scroll + +(defun pixel-scroll-pixel-down (amt) + "Scroll text of selected windows down AMT pixels. +Scope moves upward." + (while (> amt 0) + (let ((vs (window-vscroll nil t))) + (if (equal vs 0) + (pixel-scroll-down-and-set-window-vscroll + (1- (pixel-line-height -1))) + (set-window-vscroll nil (1- vs) t)) + (setq amt (1- amt)) + (sit-for pixel-wait)))) + +(defun pixel--whistlestop-line-up () + "Scroll text upward a line with each pixel whistlestopped. +When `vscroll' is non-zero, complete scrolling a line. When +`vscroll' is larger than height of multiple lines, for example +88, this flushes multiple lines. At the end, `vscroll' will be +zero. This assumes that the lines are with the same height. +Scope moves downward. This function returns number of pixels +that was scrolled." + (let* ((src (window-vscroll nil t)) ; EXAMPLE (initial) @0 @8 @88 + (height (pixel-line-height)) ; 25 25 23 + (line (1+ (/ src height))) ; catch up + one line Ä1 Ä1 Ä4 + (dst (* line height)) ; goal @25 @25 @92 + (delta (- dst src))) ; pixels to be scrolled 25 17 4 + (pixel--whistlestop-pixel-up (1- delta)) ; until one less @24 @24 @91 + (scroll-up line) (sit-for pixel-wait) ; scroll 1 pixel @0 @0 @0 + delta)) + +(defun pixel--whistlestop-pixel-up (n) + "Scroll text upward by N pixels with each pixel whistlestopped. +Scope moves downward." + (when (> n 0) + (let ((vs0 (window-vscroll nil t))) + (dolist (vs (number-sequence (1+ vs0) (+ vs0 n))) + (set-window-vscroll nil vs t) (sit-for pixel-wait))))) + +(defun pixel-line-height (&optional pos) + "Return height in pixels of text line at POS in the selected window. +When POS is nil or negative, height of the first line or the coming +unseen line above the first line, respectively, is provided." + (or pos (setq pos (window-start))) + (when (< pos 0) + (setq pos (pixel-point-at-unseen-line))) + (save-excursion + (goto-char pos) + (line-pixel-height))) ; frame-char-height + +(defun pixel-point-at-unseen-line () + "Return the character position of line above the selected window. +The returned value is the position of the first character on the +unseen line just above the scope of current window." + (let* ((pos0 (window-start)) + (vscroll0 (window-vscroll nil t)) + (pos + (save-excursion + (goto-char pos0) + (if (bobp) + (point-min) + ;; When there's an overlay string at window-start, + ;; (beginning-of-visual-line 0) stays put. + (let ((ppos (point)) + (tem (beginning-of-visual-line 0))) + (if (eq tem ppos) + (vertical-motion -1)) + (point)))))) + ;; restore initial position + (set-window-start nil pos0 t) + (set-window-vscroll nil vscroll0 t) + pos)) + +(defun pixel-scroll-down-and-set-window-vscroll (vscroll) + "Scroll down a line and set VSCROLL in pixels. +It is important to call `set-window-start' to force the display +engine use that particular position as the window-start point. +Otherwise, redisplay will reset the window's vscroll." + (set-window-start nil (pixel-point-at-unseen-line) t) + (set-window-vscroll nil vscroll t)) + +(provide 'pixel-scroll) +;;; pixel-scroll.el ends here commit a1d461592172ca4c8aac0e4e923ef5e909cfb361 Author: Philipp Date: Sat May 6 22:23:03 2017 +0200 Make `old-style-backquotes' variable internal * src/lread.c (load_warn_old_style_backquotes, Fload, read1) (syms_of_lread): Rename `old-style-backquotes' to `lread--old-style-backquotes', and clarify that it's for internal use only. * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Rename variable. * test/src/lread-tests.el (lread-tests--old-style-backquotes): Add unit test. * emacs-lisp/bytecomp-tests.el (bytecomp-tests--old-style-backquotes): Add unit test. diff --git a/etc/NEWS b/etc/NEWS index 9be6ee0f3f..380ce71013 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -907,6 +907,11 @@ which was sometimes numerically incorrect. For example, on a 64-bit host (max 1e16 10000000000000001) now returns its second argument instead of its first. ++++ +** The variable 'old-style-backquotes' has been made internal and +renamed to 'lread--old-style-backquotes'. No user code should use +this variable. + * Lisp Changes in Emacs 26.1 diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index daad93de18..e716eef10a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2021,11 +2021,11 @@ With argument ARG, insert value in current buffer after the form." (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let* ((old-style-backquotes nil) + (let* ((lread--old-style-backquotes nil) (lread--unescaped-character-literals nil) (form (read inbuffer))) ;; Warn about the use of old-style backquotes. - (when old-style-backquotes + (when lread--old-style-backquotes (byte-compile-warn "!! The file uses old-style backquotes !! This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual.")) diff --git a/src/lread.c b/src/lread.c index 0e5b476a9a..c03aad4f72 100644 --- a/src/lread.c +++ b/src/lread.c @@ -948,7 +948,7 @@ load_error_handler (Lisp_Object data) static void load_warn_old_style_backquotes (Lisp_Object file) { - if (!NILP (Vold_style_backquotes)) + if (!NILP (Vlread_old_style_backquotes)) { AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); CALLN (Fmessage, format, file); @@ -1216,7 +1216,7 @@ Return t if the file exists and loads successfully. */) version = -1; /* Check for the presence of old-style quotes and warn about them. */ - specbind (Qold_style_backquotes, Qnil); + specbind (Qlread_old_style_backquotes, Qnil); record_unwind_protect (load_warn_old_style_backquotes, file); /* Check for the presence of unescaped character literals and warn @@ -3040,7 +3040,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) "(\`" anyway). */ if (!new_backquote_flag && first_in_list && next_char == ' ') { - Vold_style_backquotes = Qt; + Vlread_old_style_backquotes = Qt; goto default_label; } else @@ -3094,7 +3094,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } else { - Vold_style_backquotes = Qt; + Vlread_old_style_backquotes = Qt; goto default_label; } } @@ -4843,10 +4843,11 @@ variables, this must be set in the first line of a file. */); doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); Veval_buffer_list = Qnil; - DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes, - doc: /* Set to non-nil when `read' encounters an old-style backquote. */); - Vold_style_backquotes = Qnil; - DEFSYM (Qold_style_backquotes, "old-style-backquotes"); + DEFVAR_LISP ("lread--old-style-backquotes", Vlread_old_style_backquotes, + doc: /* Set to non-nil when `read' encounters an old-style backquote. +For internal use only. */); + Vlread_old_style_backquotes = Qnil; + DEFSYM (Qlread_old_style_backquotes, "lread--old-style-backquotes"); DEFVAR_LISP ("lread--unescaped-character-literals", Vlread_unescaped_character_literals, diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 84004a9264..d15bd8b6e6 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -530,6 +530,21 @@ literals (Bug#20852)." "`?\"', `?(', `?)', `?;', `?[', `?]' " "detected!")))))))) +(ert-deftest bytecomp-tests--old-style-backquotes () + "Check that byte compiling warns about old-style backquotes." + (should (boundp 'lread--old-style-backquotes)) + (bytecomp-tests--with-temp-file source + (write-region "(` (a b))" nil source) + (bytecomp-tests--with-temp-file destination + (let* ((byte-compile-dest-file-function (lambda (_) destination)) + (byte-compile-error-on-warn t) + (byte-compile-debug t) + (err (should-error (byte-compile-file source)))) + (should (equal (cdr err) + (list "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual."))))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 685ea682e2..98cbb6a301 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -155,4 +155,13 @@ literals (Bug#20852)." (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))))) +(ert-deftest lread-tests--old-style-backquotes () + "Check that loading warns about old-style backquotes." + (lread-tests--with-temp-file file-name + (write-region "(` (a b))" nil file-name) + (should (equal (load file-name nil :nomessage :nosuffix) t)) + (should (equal (lread-tests--last-message) + (concat (format-message "Loading `%s': " file-name) + "old-style backquotes detected!"))))) + ;;; lread-tests.el ends here commit 16004397f40d15d9db6b90632c236c804f38fc40 Author: Philipp Stephani Date: Sat May 13 12:28:48 2017 +0200 Improve unescaped character literal warnings * src/lread.c (load_warn_unescaped_character_literals) (syms_of_lread): lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Improve formatting of unescaped character literal warnings. * test/src/lread-tests.el (lread-tests--unescaped-char-literals): test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--unescaped-char-literals): Adapt unit tests. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 201733ff03..daad93de18 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2032,7 +2032,7 @@ and will be removed soon. See (elisp)Backquote in the manual.")) (when lread--unescaped-character-literals (byte-compile-warn "unescaped character literals %s detected!" - (mapconcat #'string + (mapconcat (lambda (char) (format "`?%c'" char)) (sort lread--unescaped-character-literals #'<) ", "))) (byte-compile-toplevel-file-form form))) diff --git a/src/lread.c b/src/lread.c index f0ad0c28e5..0e5b476a9a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -963,9 +963,11 @@ load_warn_unescaped_character_literals (Lisp_Object file) AUTO_STRING (format, "Loading `%s': unescaped character literals %s detected!"); AUTO_STRING (separator, ", "); + AUTO_STRING (inner_format, "`?%c'"); CALLN (Fmessage, format, file, - Fmapconcat (Qstring, + Fmapconcat (list3 (Qlambda, list1 (Qchar), + list3 (Qformat, inner_format, Qchar)), Fsort (Vlread_unescaped_character_literals, Qlss), separator)); } @@ -4855,6 +4857,8 @@ For internal use only. */); "lread--unescaped-character-literals"); DEFSYM (Qlss, "<"); + DEFSYM (Qchar, "char"); + DEFSYM (Qformat, "format"); DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer, doc: /* Non-nil means `load' prefers the newest version of a file. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 3624904753..84004a9264 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -527,7 +527,8 @@ literals (Bug#20852)." (err (should-error (byte-compile-file source)))) (should (equal (cdr err) (list (concat "unescaped character literals " - "\", (, ), ;, [, ] detected!")))))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' " + "detected!")))))))) ;; Local Variables: ;; no-byte-compile: t diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 0427fe64e4..685ea682e2 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -140,7 +140,7 @@ literals (Bug#20852)." (should (equal (lread-tests--last-message) (concat (format-message "Loading `%s': " file-name) "unescaped character literals " - "\", (, ), ;, [, ] detected!"))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) (ert-deftest lread-test-bug26837 () "Test for http://debbugs.gnu.org/26837 ." commit aa779b0f15faa114fa5e3f59b17e628b1a837af8 (refs/remotes/origin/fix/bug-21072) Author: Noam Postavsky Date: Tue May 9 09:38:49 2017 +0200 Modify `beginning-of-defun-comments' * lisp/emacs-lisp/lisp.el (beginning-of-defun-comments): Try not to stop in the middle of a multiline comment. diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 71c27d08a2..0c1fe42fed 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -417,14 +417,22 @@ whitespace." (interactive "^p") (unless arg (setq arg 1)) (beginning-of-defun arg) - (let (nbobp) - (while (progn - (setq nbobp (zerop (forward-line -1))) - (and (not (looking-at "^\\s-*$")) - (beginning-of-defun--in-emptyish-line-p) - nbobp))) - (when nbobp - (forward-line 1)))) + (let (first-line-p) + (while (let ((ppss (progn (setq first-line-p (= (forward-line -1) -1)) + (syntax-ppss (line-end-position))))) + (while (and (nth 4 ppss) ; If eol is in a line-spanning comment, + (< (nth 8 ppss) (line-beginning-position))) + (goto-char (nth 8 ppss)) ; skip to comment start. + (setq ppss (syntax-ppss (line-end-position)))) + (and (not first-line-p) + (progn (skip-syntax-backward + "-" (line-beginning-position)) + (not (bolp))) ; Check for blank line. + (progn (parse-partial-sexp + (line-beginning-position) (line-end-position) + nil t (syntax-ppss (line-beginning-position))) + (eolp))))) ; Check for non-comment text. + (forward-line (if first-line-p 0 1)))) (defvar end-of-defun-function (lambda () (forward-sexp 1)) commit cb8fcbc3cbd8f6cf95bb858b72188d752672cf6b Author: Noam Postavsky Date: Thu Apr 27 17:13:33 2017 -0400 Fix elisp-tests-with-temp-buffer compilation * test/lisp/emacs-lisp/lisp-tests.el (elisp-tests-with-temp-buffer): Don't refer to the =!NAME= as "markers" since they produce variables with just plain positions, not marker objects. Explicitly specify that CONTENTS is evaluated at compile time. Don't re-evaluate CONTENTS at runtime. Fix debug specification. Suppress warnings due to BODY not using =!NAME= variables. (elisp-test-point-position-regex): Rename from `elisp-test-point-marker-regex'. (mark-defun-test-buffer): Wrap in `eval-and-compile'. diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 2119758bb7..ddbf378683 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -306,46 +306,46 @@ ;;; Helpers -(defvar elisp-test-point-marker-regex "=!\\([a-zA-Z0-9-]+\\)=" - "A regexp matching placeholders for point position for -`elisp-tests-with-temp-buffer'.") +(eval-and-compile + (defvar elisp-test-point-position-regex "=!\\([a-zA-Z0-9-]+\\)=" + "A regexp matching placeholders for point position for +`elisp-tests-with-temp-buffer'.")) ;; Copied and heavily modified from `python-tests-with-temp-buffer' (defmacro elisp-tests-with-temp-buffer (contents &rest body) "Create an `emacs-lisp-mode' enabled temp buffer with CONTENTS. BODY is the code to be executed within the temp buffer. Point is -always located at the beginning of buffer. Special markers of -the form =!NAME= in CONTENTS are removed, and a for each one -a variable called NAME is bound to the position of such -a marker." - (declare (indent 1) (debug t)) - `(with-temp-buffer - (emacs-lisp-mode) - (insert ,contents) - (goto-char (point-min)) - (while (re-search-forward elisp-test-point-marker-regex nil t) - (delete-region (match-beginning 0) - (match-end 0))) - (goto-char (point-min)) - ,(let (marker-list) - (with-temp-buffer - (insert (cond ((symbolp contents) - (symbol-value contents)) - (t contents))) - (goto-char (point-min)) - (while (re-search-forward elisp-test-point-marker-regex nil t) - (push (list (intern (match-string-no-properties 1)) - (match-beginning 0)) - marker-list) - (delete-region (match-beginning 0) - (match-end 0)))) - `(let ,marker-list - ,@body)))) +always located at the beginning of buffer. CONTENTS is an +expression that must evaluate to a string at compile time. Words +of the form =!NAME= in CONTENTS are removed, and a for each one a +variable called NAME is bound to the position of the word's +start." + (declare (indent 1) (debug (def-form body))) + (let* ((var-pos nil) + (text (with-temp-buffer + (insert (eval contents)) + (goto-char (point-min)) + (while (re-search-forward elisp-test-point-position-regex nil t) + (push (list (intern (match-string-no-properties 1)) + (match-beginning 0)) + var-pos) + (delete-region (match-beginning 0) + (match-end 0))) + (buffer-string)))) + `(with-temp-buffer + (emacs-lisp-mode) + (insert ,text) + (goto-char (point-min)) + (let ,var-pos + ;; Let the =!POSITION= variables be ignorable. + ,@(mapcar (lambda (v-p) `(ignore ,(car v-p))) var-pos) + ,@body)))) ;;; mark-defun -(defvar mark-defun-test-buffer - ";; Comment header +(eval-and-compile + (defvar mark-defun-test-buffer + ";; Comment header =!before-1= \(defun func-1 (arg) =!inside-1=\"docstring\" @@ -365,7 +365,7 @@ a marker." =!after-4= ;; end " - "Test buffer for `mark-defun'.") + "Test buffer for `mark-defun'.")) (ert-deftest mark-defun-no-arg-region-inactive () "Test `mark-defun' with no prefix argument and inactive commit 0397f85c6f9b0a5325f774e2a56e7cd85176e228 Author: Noam Postavsky Date: Thu Apr 20 14:07:19 2017 +0200 * lisp/emacs-lisp/lisp.el (mark-defun): Simplify moving the point. diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index e74e2474ee..71c27d08a2 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -569,13 +569,9 @@ the one(s) already marked." ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html (beginning-of-defun (1- (- arg)))) (push-mark end nil t)))))) - (let (nbobp) - (while (progn - (setq nbobp (zerop (forward-line -1))) - (and (looking-at "^\\s-*$") - nbobp))) - (when nbobp - (forward-line 1)))) + (skip-chars-backward "[:space:]\n") + (unless (bobp) + (forward-line 1))) (defvar narrow-to-defun-include-comments nil "If non-nil, `narrow-to-defun' will also show comments preceding the defun.") commit 22fc91704be4737865b3715e5278dc78029791bd Author: Marcin Borkowski Date: Fri Mar 31 13:06:06 2017 +0200 Fix Bug#21072 and rework `mark-defun' * test/lisp/progmodes/elisp-mode-tests.el (mark-defun-test-buffer): New variable (mark-defun-no-arg-region-inactive) (mark-defun-no-arg-region-active) (mark-defun-arg-region-active) (mark-defun-pos-arg-region-inactive) (mark-defun-neg-arg-region-inactive, mark-defun-bob): Add tests for the new `mark-defun'. * lisp/emacs-lisp/lisp.el (beginning-of-defun--in-emptyish-line-p): New function. (beginning-of-defun-comments): New function. (mark-defun): Fix bug#21072, also rewrite large parts of `mark-defun' to accept a numerical prefix argument. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 1533c7ee8b..222d1c2a4d 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -248,11 +248,15 @@ the same as @kbd{C-M-a} with a positive argument. (@code{mark-defun}), which sets the mark at the end of the current defun and puts point at its beginning. @xref{Marking Objects}. This is the easiest way to get ready to kill the defun in order to move it -to a different place in the file. If you use the command while point -is between defuns, it uses the following defun. If you use the -command while the mark is already active, it sets the mark but does -not move point; furthermore, each successive use of @kbd{C-M-h} -extends the end of the region to include one more defun. +to a different place in the file. If the defun is directly preceded +by comments (with no intervening blank lines), they are marked, too. +If you use the command while point is between defuns, it uses the +following defun. If you use the command while the mark is already +active, it extends the end of the region to include one more defun. +With a prefix argument, it marks that many defuns or extends the +region by the appropriate number of defuns. With negative prefix +argument it marks defuns in the opposite direction and also changes +the direction of selecting for subsequent uses of @code{mark-defun}. In C mode, @kbd{C-M-h} runs the function @code{c-mark-function}, which is almost the same as @code{mark-defun}; the difference is that diff --git a/etc/NEWS b/etc/NEWS index 7281827878..8e628aad20 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -383,6 +383,15 @@ Strings such as ΌΣΟΣ are now correctly converted to Όσος when capitalized instead of incorrect Όσοσ (compare lowercase sigma at the end of the word). ++++ +** New behavior of 'mark-defun' implemented +Prefix argument selects that many (or that many more) defuns. +Negative prefix arg flips the direction of selection. Also, +'mark-defun' between defuns correctly selects N following defuns (or +-N previous for negative arguments). Finally, comments preceding the +defun are selected unless they are separated from the defun by a blank +line. + * Changes in Specialized Modes and Packages in Emacs 26.1 diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 0172e3af26..e74e2474ee 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -398,6 +398,34 @@ is called as a function to find the defun's beginning." (goto-char (if arg-+ve floor ceiling)) nil)))))))) +(defun beginning-of-defun--in-emptyish-line-p () + "Return non-nil if the point is in an \"emptyish\" line. +This means a line that consists entirely of comments and/or +whitespace." +;; See http://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00141.html + (save-excursion + (forward-line 0) + (< (line-end-position) + (let ((ppss (syntax-ppss))) + (when (nth 4 ppss) + (goto-char (nth 8 ppss))) + (forward-comment (point-max)) + (point))))) + +(defun beginning-of-defun-comments (&optional arg) + "Move to the beginning of ARGth defun, including comments." + (interactive "^p") + (unless arg (setq arg 1)) + (beginning-of-defun arg) + (let (nbobp) + (while (progn + (setq nbobp (zerop (forward-line -1))) + (and (not (looking-at "^\\s-*$")) + (beginning-of-defun--in-emptyish-line-p) + nbobp))) + (when nbobp + (forward-line 1)))) + (defvar end-of-defun-function (lambda () (forward-sexp 1)) "Function for `end-of-defun' to call. @@ -478,48 +506,76 @@ is called as a function to find the defun's end." (funcall end-of-defun-function) (funcall skip))))) -(defun mark-defun (&optional allow-extend) +(defun mark-defun (&optional arg) "Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point. +With positive ARG, mark this and that many next defuns; with negative +ARG, change the direction of marking. -Interactively, if this command is repeated -or (in Transient Mark mode) if the mark is active, -it marks the next defun after the ones already marked." +If the mark is active, it marks the next or previous defun(s) after +the one(s) already marked." (interactive "p") - (cond ((and allow-extend - (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active))) - (set-mark - (save-excursion - (goto-char (mark)) - (end-of-defun) - (point)))) - (t - (let ((opoint (point)) - beg end) - (push-mark opoint) - ;; Try first in this order for the sake of languages with nested - ;; functions where several can end at the same place as with - ;; the offside rule, e.g. Python. - (beginning-of-defun) - (setq beg (point)) - (end-of-defun) - (setq end (point)) - (while (looking-at "^\n") - (forward-line 1)) - (if (> (point) opoint) - (progn - ;; We got the right defun. - (push-mark beg nil t) - (goto-char end) - (exchange-point-and-mark)) - ;; beginning-of-defun moved back one defun - ;; so we got the wrong one. - (goto-char opoint) - (end-of-defun) - (push-mark (point) nil t) - (beginning-of-defun)) - (re-search-backward "^\n" (- (point) 1) t))))) + (setq arg (or arg 1)) + ;; There is no `mark-defun-back' function - see + ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2016-11/msg00079.html + ;; for explanation + (when (eq last-command 'mark-defun-back) + (setq arg (- arg))) + (when (< arg 0) + (setq this-command 'mark-defun-back)) + (cond ((use-region-p) + (if (>= arg 0) + (set-mark + (save-excursion + (goto-char (mark)) + ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed + (dotimes (_ignore arg) + (end-of-defun)) + (point))) + (beginning-of-defun-comments (- arg)))) + (t + (let ((opoint (point)) + beg end) + (push-mark opoint) + ;; Try first in this order for the sake of languages with nested + ;; functions where several can end at the same place as with the + ;; offside rule, e.g. Python. + (beginning-of-defun-comments) + (setq beg (point)) + (end-of-defun) + (setq end (point)) + (when (or (and (<= (point) opoint) + (> arg 0)) + (= beg (point-min))) ; we were before the first defun! + ;; beginning-of-defun moved back one defun so we got the wrong + ;; one. If ARG < 0, however, we actually want to go back. + (goto-char opoint) + (end-of-defun) + (setq end (point)) + (beginning-of-defun-comments) + (setq beg (point))) + (goto-char beg) + (cond ((> arg 0) + ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed + (dotimes (_ignore arg) + (end-of-defun)) + (setq end (point)) + (push-mark end nil t) + (goto-char beg)) + (t + (goto-char beg) + (unless (= arg -1) ; beginning-of-defun behaves + ; strange with zero arg - see + ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html + (beginning-of-defun (1- (- arg)))) + (push-mark end nil t)))))) + (let (nbobp) + (while (progn + (setq nbobp (zerop (forward-line -1))) + (and (looking-at "^\\s-*$") + nbobp))) + (when nbobp + (forward-line 1)))) (defvar narrow-to-defun-include-comments nil "If non-nil, `narrow-to-defun' will also show comments preceding the defun.") diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index f6039f78eb..2119758bb7 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -342,5 +342,252 @@ a marker." `(let ,marker-list ,@body)))) +;;; mark-defun + +(defvar mark-defun-test-buffer + ";; Comment header +=!before-1= +\(defun func-1 (arg) + =!inside-1=\"docstring\" + body) +=!after-1==!before-2= +;; Comment before a defun +\(d=!inside-2=efun func-2 (arg) + \"docstring\" + body) +=!after-2==!before-3= +\(defun func-3 (arg) + \"docstring\"=!inside-3= + body) +=!after-3==!before-4=(defun func-4 (arg) + \"docstring\"=!inside-4= + body) +=!after-4= +;; end +" + "Test buffer for `mark-defun'.") + +(ert-deftest mark-defun-no-arg-region-inactive () + "Test `mark-defun' with no prefix argument and inactive +region." + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun inside a defun, with comments and an empty line + ;; before + (goto-char inside-1) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun inside a defun with comments before + (deactivate-mark) + (goto-char inside-2) + (mark-defun) + (should (= (point) before-2)) + (should (= (mark) after-2)) + ;; mark-defun inside a defun with empty line before + (deactivate-mark) + (goto-char inside-3) + (mark-defun) + (should (= (point) before-3)) + (should (= (mark) after-3)) + ;; mark-defun inside a defun with another one right before + (deactivate-mark) + (goto-char inside-4) + (mark-defun) + (should (= (point) before-4)) + (should (= (mark) after-4)) + ;; mark-defun between a comment and a defun + (deactivate-mark) + (goto-char before-1) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun between defuns + (deactivate-mark) + (goto-char before-3) + (mark-defun) + (should (= (point) before-3)) + (should (= (mark) after-3)) + ;; mark-defun in comment right before the defun + (deactivate-mark) + (goto-char before-2) + (mark-defun) + (should (= (point) before-2)) + (should (= (mark) after-2)))) + +(ert-deftest mark-defun-no-arg-region-active () + "Test `mark-defun' with no prefix argument and active +region." + (transient-mark-mode 1) + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun when a defun is marked + (goto-char before-1) + (set-mark after-1) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-2)) + ;; mark-defun when two defuns are marked + (deactivate-mark) + (goto-char before-1) + (set-mark after-2) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-3)))) + +(ert-deftest mark-defun-arg-region-active () + "Test `mark-defun' with a prefix arg and active region." + (transient-mark-mode 1) + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun with positive arg when a defun is marked + (goto-char before-1) + (set-mark after-1) + (mark-defun 2) + (should (= (point) before-1)) + (should (= (mark) after-3)) + ;; mark-defun with arg=-1 when a defun is marked + (goto-char before-2) + (set-mark after-2) + (mark-defun -1) + (should (= (point) before-1)) + (should (= (mark) after-2)) + ;; mark-defun with arg=-2 when a defun is marked + (goto-char before-3) + (set-mark after-3) + (mark-defun -2) + (should (= (point) before-1)) + (should (= (mark) after-3)))) + +(ert-deftest mark-defun-pos-arg-region-inactive () + "Test `mark-defun' with positive argument and inactive + region." + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun with positive arg inside a defun + (goto-char inside-1) + (mark-defun 2) + (should (= (point) before-1)) + (should (= (mark) after-2)) + ;; mark-defun with positive arg between defuns + (deactivate-mark) + (goto-char before-3) + (mark-defun 2) + (should (= (point) before-3)) + (should (= (mark) after-4)) + ;; mark-defun with positive arg in a comment + (deactivate-mark) + (goto-char before-2) + (mark-defun 2) + (should (= (point) before-2)) + (should (= (mark) after-3)))) + +(ert-deftest mark-defun-neg-arg-region-inactive () + "Test `mark-defun' with negative argument and inactive + region." + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun with arg=-1 inside a defun + (goto-char inside-1) + (mark-defun -1) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun with arg=-1 between defuns + (deactivate-mark) + (goto-char after-2) + (mark-defun -1) + (should (= (point) before-2)) + (should (= (mark) after-2)) + ;; mark-defun with arg=-1 in a comment + ;; (this is probably not an optimal behavior...) + (deactivate-mark) + (goto-char before-2) + (mark-defun -1) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun with arg=-2 inside a defun + (deactivate-mark) + (goto-char inside-4) + (mark-defun -2) + (should (= (point) before-3)) + (should (= (mark) after-4)) + ;; mark-defun with arg=-2 between defuns + (deactivate-mark) + (goto-char before-3) + (mark-defun -2) + (should (= (point) before-1)) + (should (= (mark) after-2))) + (elisp-tests-with-temp-buffer ; test case submitted by Drew Adams + "(defun a () + nil) +=!before-b=(defun b () +=!in-b= nil) +=!after-b=;;;; +\(defun c () + nil) +" + (setq last-command nil) + (goto-char in-b) + (mark-defun -1) + (should (= (point) before-b)) + (should (= (mark) after-b)))) + +(ert-deftest mark-defun-bob () + "Test `mark-defun' at the beginning of buffer." + ;; Bob, comment, newline, defun + (setq last-command nil) + (elisp-tests-with-temp-buffer + ";; Comment at the bob +=!before= +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after))) + ;; Bob, newline, comment, defun + (elisp-tests-with-temp-buffer + "=!before= +;; Comment before the defun +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after))) + ;; Bob, comment, defun + (elisp-tests-with-temp-buffer + "=!before=;; Comment at the bob before the defun +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after))) + ;; Bob, newline, comment, newline, defun + (elisp-tests-with-temp-buffer + " +;; Comment before the defun +=!before= +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after)))) + (provide 'lisp-tests) ;;; lisp-tests.el ends here commit 6d58dda40a0a43d14dffdd995f0cb3dcc329fa4b Author: Marcin Borkowski Date: Tue Feb 14 11:30:36 2017 +0100 Add elisp-tests-with-temp-buffer, a new testing macro * test/lisp/emacs-lisp/lisp-tests.el (elisp-test-point-marker-regex) New variable. (elisp-tests-with-temp-buffer): New macro to help test functions moving the point and/or mark. diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 8cba7fc526..f6039f78eb 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -5,6 +5,7 @@ ;; Author: Aaron S. Hawley ;; Author: Stefan Monnier ;; Author: Daniel Colascione +;; Author: Marcin Borkowski ;; Keywords: internal ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -303,5 +304,43 @@ ;; abcdefghijklmnopqrstuv i f a scan-error) +;;; Helpers + +(defvar elisp-test-point-marker-regex "=!\\([a-zA-Z0-9-]+\\)=" + "A regexp matching placeholders for point position for +`elisp-tests-with-temp-buffer'.") + +;; Copied and heavily modified from `python-tests-with-temp-buffer' +(defmacro elisp-tests-with-temp-buffer (contents &rest body) + "Create an `emacs-lisp-mode' enabled temp buffer with CONTENTS. +BODY is the code to be executed within the temp buffer. Point is +always located at the beginning of buffer. Special markers of +the form =!NAME= in CONTENTS are removed, and a for each one +a variable called NAME is bound to the position of such +a marker." + (declare (indent 1) (debug t)) + `(with-temp-buffer + (emacs-lisp-mode) + (insert ,contents) + (goto-char (point-min)) + (while (re-search-forward elisp-test-point-marker-regex nil t) + (delete-region (match-beginning 0) + (match-end 0))) + (goto-char (point-min)) + ,(let (marker-list) + (with-temp-buffer + (insert (cond ((symbolp contents) + (symbol-value contents)) + (t contents))) + (goto-char (point-min)) + (while (re-search-forward elisp-test-point-marker-regex nil t) + (push (list (intern (match-string-no-properties 1)) + (match-beginning 0)) + marker-list) + (delete-region (match-beginning 0) + (match-end 0)))) + `(let ,marker-list + ,@body)))) + (provide 'lisp-tests) ;;; lisp-tests.el ends here