commit 9dc306b1db08196684d05a474148e16305adbad0 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Tue Sep 17 19:18:14 2019 -0700 Improve reporting of I/O, access errors Signal an error for file-oriented errors that are not tame errors like ENOENT and ENOTDIR (Bug#37389). Do this for primitives exposed to Lisp; the lower level internal C API merely makes errno values available to higher-level C code. * doc/lispref/files.texi (Testing Accessibility) (File Attributes, Extended Attributes): Do not say that the functions return nil when the return value cannot be determined. * etc/NEWS: Mention the change. * src/dired.c (Ffile_attributes): Fix doc string confusion about opening a file vs getting its attributes. (file_attributes): Signal serious errors. * src/fileio.c (check_existing, check_executable) (check_writable): Remove. All callers changed to use check_file_access or file_access_p. (file_access_p, file_metadata_errno, file_attribute_errno) (file_test_errno, check_file_access, check_emacs_readlinkat): New functions. * src/fileio.c (Ffile_executable_p, Ffile_readable_p) (Ffile_name_case_insensitive_p, Frename_file, Ffile_exists_p): (Ffile_symlink_p, Ffile_directory_p) (Ffile_accessible_directory_p, Ffile_regular_p) (Ffile_selinux_context, Ffile_acl, Ffile_modes) (Ffile_newer_than_file_p, Fset_visited_file_modtime) (Ffile_system_info): * src/filelock.c (unlock_file, Ffile_locked_p): * src/lread.c (Fload): Signal serious errors. * src/fileio.c (Ffile_writable_p): Remove unnecessary CHECK_STRING. (emacs_readlinkat): Now static. * src/filelock.c (current_lock_owner, lock_if_free): Return a positive errno on error, and the negative of the old old value on success. All callers changed. * src/lread.c (openp): Propagate serious errno values to caller. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 18a1f4908d..fba9622fec 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -856,8 +856,7 @@ systems, this is true if the file exists and you have execute permission on the containing directories, regardless of the permissions of the file itself.) -If the file does not exist, or if access control policies prevent you -from finding its attributes, this function returns @code{nil}. +If the file does not exist, this function returns @code{nil}. Directories are files, so @code{file-exists-p} can return @code{t} when given a directory. However, because @code{file-exists-p} follows @@ -1262,7 +1261,7 @@ on the 19th, @file{aug-20} was written on the 20th, and the file @defun file-attributes filename &optional id-format @anchor{Definition of file-attributes} This function returns a list of attributes of file @var{filename}. If -the specified file's attributes cannot be accessed, it returns @code{nil}. +the specified file does not exist, it returns @code{nil}. This function does not follow symbolic links. The optional parameter @var{id-format} specifies the preferred format of attributes @acronym{UID} and @acronym{GID} (see below)---the @@ -1464,9 +1463,8 @@ The underlying ACL implementation is platform-specific; on GNU/Linux and BSD, Emacs uses the POSIX ACL interface, while on MS-Windows Emacs emulates the POSIX ACL interface with native file security APIs. -If Emacs was not compiled with ACL support, or the file does not exist -or is inaccessible, or Emacs was unable to determine the ACL entries -for any other reason, then the return value is @code{nil}. +If ACLs are not supported or the file does not exist, +then the return value is @code{nil}. @end defun @defun file-selinux-context filename @@ -1478,8 +1476,7 @@ for details about what these actually mean. The return value has the same form as what @code{set-file-selinux-context} takes for its @var{context} argument (@pxref{Changing Files}). -If Emacs was not compiled with SELinux support, or the file does not -exist or is inaccessible, or if the system does not support SELinux, +If SELinux is not supported or the file does not exist, then the return value is @code{(nil nil nil nil)}. @end defun diff --git a/etc/NEWS b/etc/NEWS index 9aec8da566..dce4903384 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2005,6 +2005,16 @@ file name if there is no user named "foo". ** The FILENAME argument to 'file-name-base' is now mandatory and no longer defaults to 'buffer-file-name'. ++++ +** File metadata primitives now signal an error if I/O, access, or +other serious errors prevent them from determining the result. +Formerly, these functions often (though not always) returned nil. +For example, if the directory /etc/firewalld is not searchable, +(file-symlink-p "/etc/firewalld/firewalld.conf") now signals an error +instead of returning nil, because file-symlink-p cannot determine +whether a symbolic link exists there. These functions still behave as +before if the only problem is that the file does not exist. + --- ** The function 'eldoc-message' now accepts a single argument. Programs that called it with multiple arguments before should pass diff --git a/src/dired.c b/src/dired.c index df03bc32ce..3768b6dbb7 100644 --- a/src/dired.c +++ b/src/dired.c @@ -819,7 +819,7 @@ stat_gname (struct stat *st) DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0, doc: /* Return a list of attributes of file FILENAME. -Value is nil if specified file cannot be opened. +Value is nil if specified file does not exist. ID-FORMAT specifies the preferred format of attributes uid and gid (see below) - valid values are `string' and `integer'. The latter is the @@ -939,15 +939,14 @@ file_attributes (int fd, char const *name, information to be accurate. */ w32_stat_get_owner_group = 1; #endif - if (fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0) - err = 0; + err = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno; #ifdef WINDOWSNT w32_stat_get_owner_group = 0; #endif } if (err != 0) - return unbind_to (count, Qnil); + return unbind_to (count, file_attribute_errno (filename, err)); Lisp_Object file_type; if (S_ISLNK (s.st_mode)) @@ -956,7 +955,7 @@ file_attributes (int fd, char const *name, symlink is replaced between the call to fstatat and the call to emacs_readlinkat. Detect this race unless the replacement is also a symlink. */ - file_type = emacs_readlinkat (fd, name); + file_type = check_emacs_readlinkat (fd, filename, name); if (NILP (file_type)) return unbind_to (count, Qnil); } diff --git a/src/emacs.c b/src/emacs.c index 558dd11a35..eb732810db 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -746,7 +746,7 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) candidate[path_part_length] = DIRECTORY_SEP; memcpy (candidate + path_part_length + 1, argv0, argv0_length + 1); struct stat st; - if (check_executable (candidate) + if (file_access_p (candidate, X_OK) && stat (candidate, &st) == 0 && S_ISREG (st.st_mode)) return candidate; *candidate = '\0'; diff --git a/src/fileio.c b/src/fileio.c index 81c29ca0cc..0977516f01 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -141,54 +141,38 @@ static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, struct coding_system *); -/* Return true if FILENAME exists, otherwise return false and set errno. */ - -static bool -check_existing (const char *filename) -{ - return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0; -} - -/* Return true if file FILENAME exists and can be executed. */ +/* Test whether FILE is accessible for AMODE. + Return true if successful, false (setting errno) otherwise. */ bool -check_executable (char *filename) -{ - return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0; -} - -/* Return true if file FILENAME exists and can be accessed - according to AMODE, which should include W_OK. - On failure, return false and set errno. */ - -static bool -check_writable (const char *filename, int amode) +file_access_p (char const *file, int amode) { #ifdef MSDOS - /* FIXME: an faccessat implementation should be added to the - DOS/Windows ports and this #ifdef branch should be removed. */ - struct stat st; - if (stat (filename, &st) < 0) - return 0; - errno = EPERM; - return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode)); -#else /* not MSDOS */ - bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0; -#ifdef CYGWIN - /* faccessat may have returned failure because Cygwin couldn't - determine the file's UID or GID; if so, we return success. */ - if (!res) + if (amode & W_OK) { - int faccessat_errno = errno; + /* FIXME: The MS-DOS faccessat implementation should handle this. */ struct stat st; - if (stat (filename, &st) < 0) - return 0; - res = (st.st_uid == -1 || st.st_gid == -1); - errno = faccessat_errno; - } -#endif /* CYGWIN */ - return res; -#endif /* not MSDOS */ + if (stat (file, &st) != 0) + return false; + errno = EPERM; + return st.st_mode & S_IWRITE || S_ISDIR (st.st_mode); + } +#endif + + if (faccessat (AT_FDCWD, file, amode, AT_EACCESS) == 0) + return true; + +#ifdef CYGWIN + /* Return success if faccessat failed because Cygwin couldn't + determine the file's UID or GID. */ + int err = errno; + struct stat st; + if (stat (file, &st) == 0 && (st.st_uid == -1 || st.st_gid == -1)) + return true; + errno = err; +#endif + + return false; } /* Signal a file-access failure. STRING describes the failure, @@ -251,6 +235,30 @@ report_file_notify_error (const char *string, Lisp_Object name) } #endif +/* ACTION failed for FILE with errno ERR. Signal an error if ERR + means the file's metadata could not be retrieved even though it may + exist, otherwise return nil. */ + +static Lisp_Object +file_metadata_errno (char const *action, Lisp_Object file, int err) +{ + if (err == ENOENT || err == ENOTDIR || err == 0) + return Qnil; + report_file_errno (action, file, err); +} + +Lisp_Object +file_attribute_errno (Lisp_Object file, int err) +{ + return file_metadata_errno ("Getting attributes", file, err); +} + +static Lisp_Object +file_test_errno (Lisp_Object file, int err) +{ + return file_metadata_errno ("Testing file", file, err); +} + void close_file_unwind (int fd) { @@ -2446,8 +2454,12 @@ The arg must be a string. */) while (true) { int err = file_name_case_insensitive_err (filename); - if (! (err == ENOENT || err == ENOTDIR)) - return err < 0 ? Qt : Qnil; + switch (err) + { + case -1: return Qt; + default: return file_test_errno (filename, err); + case ENOENT: case ENOTDIR: break; + } Lisp_Object parent = file_name_directory (filename); /* Avoid infinite loop if the root is reported as non-existing (impossible?). */ @@ -2560,7 +2572,7 @@ This is what happens in interactive use with M-x. */) { Lisp_Object symlink_target = (S_ISLNK (file_st.st_mode) - ? emacs_readlinkat (AT_FDCWD, SSDATA (encoded_file)) + ? check_emacs_readlinkat (AT_FDCWD, file, SSDATA (encoded_file)) : Qnil); if (!NILP (symlink_target)) Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); @@ -2708,32 +2720,48 @@ file_name_absolute_p (char const *filename) || user_homedir (&filename[1])))); } -DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, - doc: /* Return t if file FILENAME exists (whether or not you can read it). -See also `file-readable-p' and `file-attributes'. -This returns nil for a symlink to a nonexistent file. -Use `file-symlink-p' to test for such links. */) - (Lisp_Object filename) -{ - Lisp_Object absname; - Lisp_Object handler; +/* Return t if FILE exists and is accessible via OPERATION and AMODE, + nil (setting errno) if not. Signal an error if the result cannot + be determined. */ - CHECK_STRING (filename); - absname = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qfile_exists_p); +static Lisp_Object +check_file_access (Lisp_Object file, Lisp_Object operation, int amode) +{ + file = Fexpand_file_name (file, Qnil); + Lisp_Object handler = Ffind_file_name_handler (file, operation); if (!NILP (handler)) { - Lisp_Object result = call2 (handler, Qfile_exists_p, absname); + Lisp_Object ok = call2 (handler, operation, file); + /* This errno value is bogus. Any caller that depends on errno + should be rethought anyway, to avoid a race between testing a + handled file's accessibility and using the file. */ errno = 0; - return result; + return ok; } - absname = ENCODE_FILE (absname); + char *encoded_file = SSDATA (ENCODE_FILE (file)); + bool ok = file_access_p (encoded_file, amode); + if (ok) + return Qt; + int err = errno; + if (err == EROFS || err == ETXTBSY + || (err == EACCES && amode != F_OK + && file_access_p (encoded_file, F_OK))) + { + errno = err; + return Qnil; + } + return file_test_errno (file, err); +} - return check_existing (SSDATA (absname)) ? Qt : Qnil; +DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, + doc: /* Return t if file FILENAME exists (whether or not you can read it). +See also `file-readable-p' and `file-attributes'. +This returns nil for a symlink to a nonexistent file. +Use `file-symlink-p' to test for such links. */) + (Lisp_Object filename) +{ + return check_file_access (filename, Qfile_exists_p, F_OK); } DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, @@ -2743,21 +2771,7 @@ For a directory, this means you can access files in that directory. purpose, though.) */) (Lisp_Object filename) { - Lisp_Object absname; - Lisp_Object handler; - - CHECK_STRING (filename); - absname = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qfile_executable_p); - if (!NILP (handler)) - return call2 (handler, Qfile_executable_p, absname); - - absname = ENCODE_FILE (absname); - - return (check_executable (SSDATA (absname)) ? Qt : Qnil); + return check_file_access (filename, Qfile_executable_p, X_OK); } DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, @@ -2765,21 +2779,7 @@ DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, See also `file-exists-p' and `file-attributes'. */) (Lisp_Object filename) { - Lisp_Object absname; - Lisp_Object handler; - - CHECK_STRING (filename); - absname = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qfile_readable_p); - if (!NILP (handler)) - return call2 (handler, Qfile_readable_p, absname); - - absname = ENCODE_FILE (absname); - return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0 - ? Qt : Qnil); + return check_file_access (filename, Qfile_readable_p, R_OK); } DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, @@ -2789,7 +2789,6 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, Lisp_Object absname, dir, encoded; Lisp_Object handler; - CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -2799,7 +2798,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, return call2 (handler, Qfile_writable_p, absname); encoded = ENCODE_FILE (absname); - if (check_writable (SSDATA (encoded), W_OK)) + if (file_access_p (SSDATA (encoded), W_OK)) return Qt; if (errno != ENOENT) return Qnil; @@ -2810,14 +2809,23 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, dir = Fdirectory_file_name (dir); #endif /* MSDOS */ - dir = ENCODE_FILE (dir); + encoded = ENCODE_FILE (dir); #ifdef WINDOWSNT /* The read-only attribute of the parent directory doesn't affect whether a file or directory can be created within it. Some day we should check ACLs though, which do affect this. */ - return file_directory_p (dir) ? Qt : Qnil; + return file_directory_p (encoded) ? Qt : Qnil; #else - return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil; + if (file_access_p (SSDATA (encoded), W_OK | X_OK)) + return Qt; + int err = errno; + if (err == EROFS + || (err == EACCES && file_access_p (SSDATA (encoded), F_OK))) + { + errno = err; + return Qnil; + } + return file_test_errno (absname, err); #endif } @@ -2849,8 +2857,8 @@ If there is no error, returns nil. */) } /* Relative to directory FD, return the symbolic link value of FILENAME. - On failure, return nil. */ -Lisp_Object + On failure, return nil (setting errno). */ +static Lisp_Object emacs_readlinkat (int fd, char const *filename) { static struct allocator const emacs_norealloc_allocator = @@ -2869,6 +2877,27 @@ emacs_readlinkat (int fd, char const *filename) return val; } +/* Relative to directory FD, return the symbolic link value of FILE. + If FILE is not a symbolic link, return nil (setting errno). + Signal an error if the result cannot be determined. */ +Lisp_Object +check_emacs_readlinkat (int fd, Lisp_Object file, char const *encoded_file) +{ + Lisp_Object val = emacs_readlinkat (fd, encoded_file); + if (NILP (val)) + { + if (errno == EINVAL) + return val; +#ifdef CYGWIN + /* Work around Cygwin bugs. */ + if (errno == EIO || errno == EACCES) + return val; +#endif + return file_metadata_errno ("Reading symbolic link", file, errno); + } + return val; +} + DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, doc: /* Return non-nil if file FILENAME is the name of a symbolic link. The value is the link target, as a string. @@ -2888,9 +2917,8 @@ This function does not check whether the link target exists. */) if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); - filename = ENCODE_FILE (filename); - - return emacs_readlinkat (AT_FDCWD, SSDATA (filename)); + return check_emacs_readlinkat (AT_FDCWD, filename, + SSDATA (ENCODE_FILE (filename))); } DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, @@ -2907,9 +2935,9 @@ See `file-symlink-p' to distinguish symlinks. */) if (!NILP (handler)) return call2 (handler, Qfile_directory_p, absname); - absname = ENCODE_FILE (absname); - - return file_directory_p (absname) ? Qt : Qnil; + if (file_directory_p (absname)) + return Qt; + return file_test_errno (absname, errno); } /* Return true if FILE is a directory or a symlink to a directory. @@ -2934,7 +2962,7 @@ file_directory_p (Lisp_Object file) /* O_PATH is defined but evidently this Linux kernel predates 2.6.39. Fall back on generic POSIX code. */ # endif - /* Use file_accessible_directory, as it avoids stat EOVERFLOW + /* Use file_accessible_directory_p, as it avoids stat EOVERFLOW problems and could be cheaper. However, if it fails because FILE is inaccessible, fall back on stat; if the latter fails with EOVERFLOW then FILE must have been a directory unless a race @@ -2990,8 +3018,13 @@ really is a readable and searchable directory. */) return r; } - absname = ENCODE_FILE (absname); - return file_accessible_directory_p (absname) ? Qt : Qnil; + Lisp_Object encoded_absname = ENCODE_FILE (absname); + if (file_accessible_directory_p (encoded_absname)) + return Qt; + int err = errno; + if (err == EACCES && file_access_p (SSDATA (encoded_absname), F_OK)) + return Qnil; + return file_test_errno (absname, err); } /* If FILE is a searchable directory or a symlink to a @@ -3043,7 +3076,7 @@ file_accessible_directory_p (Lisp_Object file) dir = buf; } - ok = check_existing (dir); + ok = file_access_p (dir, F_OK); saved_errno = errno; SAFE_FREE (); errno = saved_errno; @@ -3067,27 +3100,21 @@ See `file-symlink-p' to distinguish symlinks. */) if (!NILP (handler)) return call2 (handler, Qfile_regular_p, absname); - absname = ENCODE_FILE (absname); - #ifdef WINDOWSNT - { - int result; - Lisp_Object tem = Vw32_get_true_file_attributes; + /* Tell stat to use expensive method to get accurate info. */ + Lisp_Object true_attributes = Vw32_get_true_file_attributes; + Vw32_get_true_file_attributes = Qt; +#endif - /* Tell stat to use expensive method to get accurate info. */ - Vw32_get_true_file_attributes = Qt; - result = stat (SSDATA (absname), &st); - Vw32_get_true_file_attributes = tem; + int stat_result = stat (SSDATA (absname), &st); - if (result < 0) - return Qnil; - return S_ISREG (st.st_mode) ? Qt : Qnil; - } -#else - if (stat (SSDATA (absname), &st) < 0) - return Qnil; - return S_ISREG (st.st_mode) ? Qt : Qnil; +#ifdef WINDOWSNT + Vw32_get_true_file_attributes = true_attributes; #endif + + if (stat_result == 0) + return S_ISREG (st.st_mode) ? Qt : Qnil; + return file_test_errno (absname, errno); } DEFUN ("file-selinux-context", Ffile_selinux_context, @@ -3097,7 +3124,7 @@ The return value is a list (USER ROLE TYPE RANGE), where the list elements are strings naming the user, role, type, and range of the file's SELinux security context. -Return (nil nil nil nil) if the file is nonexistent or inaccessible, +Return (nil nil nil nil) if the file is nonexistent, or if SELinux is disabled, or if Emacs lacks SELinux support. */) (Lisp_Object filename) { @@ -3111,13 +3138,11 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */) if (!NILP (handler)) return call2 (handler, Qfile_selinux_context, absname); - absname = ENCODE_FILE (absname); - #if HAVE_LIBSELINUX if (is_selinux_enabled ()) { security_context_t con; - int conlength = lgetfilecon (SSDATA (absname), &con); + int conlength = lgetfilecon (SSDATA (ENCODE_FILE (absname)), &con); if (conlength > 0) { context_t context = context_new (con); @@ -3132,6 +3157,9 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */) context_free (context); freecon (con); } + else if (! (errno == ENOENT || errno == ENOTDIR || errno == ENODATA + || errno == ENOTSUP)) + report_file_error ("getting SELinux context", absname); } #endif @@ -3227,8 +3255,7 @@ DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0, doc: /* Return ACL entries of file named FILENAME. The entries are returned in a format suitable for use in `set-file-acl' but is otherwise undocumented and subject to change. -Return nil if file does not exist or is not accessible, or if Emacs -was unable to determine the ACL entries. */) +Return nil if file does not exist. */) (Lisp_Object filename) { Lisp_Object acl_string = Qnil; @@ -3243,20 +3270,22 @@ was unable to determine the ACL entries. */) return call2 (handler, Qfile_acl, absname); # ifdef HAVE_ACL_SET_FILE - absname = ENCODE_FILE (absname); - # ifndef HAVE_ACL_TYPE_EXTENDED acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS; # endif - acl_t acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED); + acl_t acl = acl_get_file (SSDATA (ENCODE_FILE (absname)), ACL_TYPE_EXTENDED); if (acl == NULL) - return Qnil; - + { + if (errno == ENOENT || errno == ENOTDIR || errno == ENOTSUP) + return Qnil; + report_file_error ("Getting ACLs", absname); + } char *str = acl_to_text (acl, NULL); if (str == NULL) { + int err = errno; acl_free (acl); - return Qnil; + report_file_errno ("Getting ACLs", absname, err); } acl_string = build_string (str); @@ -3327,7 +3356,7 @@ support. */) DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, doc: /* Return mode bits of file named FILENAME, as an integer. -Return nil, if file does not exist or is not accessible. */) +Return nil if FILENAME does not exist. */) (Lisp_Object filename) { struct stat st; @@ -3339,11 +3368,8 @@ Return nil, if file does not exist or is not accessible. */) if (!NILP (handler)) return call2 (handler, Qfile_modes, absname); - absname = ENCODE_FILE (absname); - - if (stat (SSDATA (absname), &st) < 0) - return Qnil; - + if (stat (SSDATA (ENCODE_FILE (absname)), &st) != 0) + return file_attribute_errno (absname, errno); return make_fixnum (st.st_mode & 07777); } @@ -3487,14 +3513,27 @@ otherwise, if FILE2 does not exist, the answer is t. */) if (!NILP (handler)) return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); - absname1 = ENCODE_FILE (absname1); - absname2 = ENCODE_FILE (absname2); + int err1; + if (stat (SSDATA (ENCODE_FILE (absname1)), &st1) == 0) + err1 = 0; + else + { + err1 = errno; + if (err1 != EOVERFLOW) + return file_test_errno (absname1, err1); + } - if (stat (SSDATA (absname1), &st1) < 0) - return Qnil; + if (stat (SSDATA (ENCODE_FILE (absname2)), &st2) != 0) + { + file_test_errno (absname2, errno); + return Qt; + } - if (stat (SSDATA (absname2), &st2) < 0) - return Qt; + if (err1) + { + file_test_errno (absname1, err1); + eassume (false); + } return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0 ? Qt : Qnil); @@ -5686,13 +5725,13 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) /* The handler can find the file name the same way we did. */ return call2 (handler, Qset_visited_file_modtime, Qnil); - filename = ENCODE_FILE (filename); - - if (stat (SSDATA (filename), &st) >= 0) + if (stat (SSDATA (ENCODE_FILE (filename)), &st) == 0) { current_buffer->modtime = get_stat_mtime (&st); current_buffer->modtime_size = st.st_size; } + else + file_attribute_errno (filename, errno); } return Qnil; @@ -6103,22 +6142,22 @@ storage available to a non-superuser. All 3 numbers are in bytes. If the underlying system call fails, value is nil. */) (Lisp_Object filename) { - Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (filename, Qnil)); + filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file name handler. */ - Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info); + Lisp_Object handler = Ffind_file_name_handler (filename, Qfile_system_info); if (!NILP (handler)) { - Lisp_Object result = call2 (handler, Qfile_system_info, encoded); + Lisp_Object result = call2 (handler, Qfile_system_info, filename); if (CONSP (result) || NILP (result)) return result; error ("Invalid handler in `file-name-handler-alist'"); } struct fs_usage u; - if (get_fs_usage (SSDATA (encoded), NULL, &u) != 0) - return Qnil; + if (get_fs_usage (SSDATA (ENCODE_FILE (filename)), NULL, &u) != 0) + return errno == ENOSYS ? Qnil : file_attribute_errno (filename, errno); return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false), blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false), blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail, diff --git a/src/filelock.c b/src/filelock.c index 46349a63e4..ff25d6475d 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -504,9 +504,9 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) } /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete, - 1 if another process owns it (and set OWNER (if non-null) to info), - 2 if the current process owns it, - or -1 if something is wrong with the locking mechanism. */ + -1 if another process owns it (and set OWNER (if non-null) to info), + -2 if the current process owns it, + or an errno value if something is wrong with the locking mechanism. */ static int current_lock_owner (lock_info_type *owner, char *lfname) @@ -525,23 +525,23 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* If nonexistent lock file, all is well; otherwise, got strange error. */ lfinfolen = read_lock_data (lfname, owner->user); if (lfinfolen < 0) - return errno == ENOENT ? 0 : -1; + return errno == ENOENT ? 0 : errno; if (MAX_LFINFO < lfinfolen) - return -1; + return ENAMETOOLONG; owner->user[lfinfolen] = 0; - /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */ + /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return EINVAL. */ /* The USER is everything before the last @. */ owner->at = at = memrchr (owner->user, '@', lfinfolen); if (!at) - return -1; + return EINVAL; owner->dot = dot = strrchr (at, '.'); if (!dot) - return -1; + return EINVAL; /* The PID is everything from the last '.' to the ':' or equivalent. */ if (! c_isdigit (dot[1])) - return -1; + return EINVAL; errno = 0; pid = strtoimax (dot + 1, &owner->colon, 10); if (errno == ERANGE) @@ -562,20 +562,20 @@ current_lock_owner (lock_info_type *owner, char *lfname) mistakenly transliterate ':' to U+F022 in symlink contents. See . */ if (! (boot[0] == '\200' && boot[1] == '\242')) - return -1; + return EINVAL; boot += 2; FALLTHROUGH; case ':': if (! c_isdigit (boot[0])) - return -1; + return EINVAL; boot_time = strtoimax (boot, &lfinfo_end, 10); break; default: - return -1; + return EINVAL; } if (lfinfo_end != owner->user + lfinfolen) - return -1; + return EINVAL; /* On current host? */ Lisp_Object system_name = Fsystem_name (); @@ -584,22 +584,22 @@ current_lock_owner (lock_info_type *owner, char *lfname) && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) { if (pid == getpid ()) - ret = 2; /* We own it. */ + ret = -2; /* We own it. */ else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t) && (kill (pid, 0) >= 0 || errno == EPERM) && (boot_time == 0 || (boot_time <= TYPE_MAXIMUM (time_t) && within_one_second (boot_time, get_boot_time ())))) - ret = 1; /* An existing process on this machine owns it. */ + ret = -1; /* An existing process on this machine owns it. */ /* The owner process is dead or has a strange pid, so try to zap the lockfile. */ else - return unlink (lfname); + return unlink (lfname) < 0 ? errno : 0; } else { /* If we wanted to support the check for stale locks on remote machines, here's where we'd do it. */ - ret = 1; + ret = -1; } return ret; @@ -608,9 +608,9 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* Lock the lock named LFNAME if possible. Return 0 in that case. - Return positive if some other process owns the lock, and info about + Return negative if some other process owns the lock, and info about that process in CLASHER. - Return -1 if cannot lock for any other reason. */ + Return positive errno value if cannot lock for any other reason. */ static int lock_if_free (lock_info_type *clasher, char *lfname) @@ -618,20 +618,18 @@ lock_if_free (lock_info_type *clasher, char *lfname) int err; while ((err = lock_file_1 (lfname, 0)) == EEXIST) { - switch (current_lock_owner (clasher, lfname)) + err = current_lock_owner (clasher, lfname); + if (err != 0) { - case 2: - return 0; /* We ourselves locked it. */ - case 1: - return 1; /* Someone else has it. */ - case -1: - return -1; /* current_lock_owner returned strange error. */ + if (err < 0) + return -2 - err; /* We locked it, or someone else has it. */ + break; /* current_lock_owner returned strange error. */ } /* We deleted a stale lock; try again to lock the file. */ } - return err ? -1 : 0; + return err; } /* lock_file locks file FN, @@ -697,8 +695,9 @@ lock_file (Lisp_Object fn) /* Create the name of the lock-file for file fn */ MAKE_LOCK_NAME (lfname, encoded_fn); - /* Try to lock the lock. */ - if (0 < lock_if_free (&lock_info, lfname)) + /* Try to lock the lock. FIXME: This ignores errors when + lock_if_free returns a positive errno value. */ + if (lock_if_free (&lock_info, lfname) < 0) { /* Someone else has the lock. Consider breaking it. */ Lisp_Object attack; @@ -725,13 +724,16 @@ unlock_file (Lisp_Object fn) char *lfname; USE_SAFE_ALLOCA; - fn = Fexpand_file_name (fn, Qnil); - fn = ENCODE_FILE (fn); + Lisp_Object filename = Fexpand_file_name (fn, Qnil); + fn = ENCODE_FILE (filename); MAKE_LOCK_NAME (lfname, fn); - if (current_lock_owner (0, lfname) == 2) - unlink (lfname); + int err = current_lock_owner (0, lfname); + if (err == -2 && unlink (lfname) != 0 && errno != ENOENT) + err = errno; + if (0 < err) + report_file_errno ("Unlocking file", filename, err); SAFE_FREE (); } @@ -822,17 +824,17 @@ t if it is locked by you, else a string saying which user has locked it. */) USE_SAFE_ALLOCA; filename = Fexpand_file_name (filename, Qnil); - filename = ENCODE_FILE (filename); - - MAKE_LOCK_NAME (lfname, filename); + Lisp_Object encoded_filename = ENCODE_FILE (filename); + MAKE_LOCK_NAME (lfname, encoded_filename); owner = current_lock_owner (&locker, lfname); - if (owner <= 0) - ret = Qnil; - else if (owner == 2) - ret = Qt; - else - ret = make_string (locker.user, locker.at - locker.user); + switch (owner) + { + case -2: ret = Qt; break; + case -1: ret = make_string (locker.user, locker.at - locker.user); break; + case 0: ret = Qnil; break; + default: report_file_errno ("Testing file lock", filename, owner); + } SAFE_FREE (); return ret; diff --git a/src/lisp.h b/src/lisp.h index 02f8a7b668..e68d2732e2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4299,7 +4299,6 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ -extern bool check_executable (char *); extern char *splice_dir_file (char *, char const *, char const *); extern bool file_name_absolute_p (const char *); extern char const *get_homedir (void); @@ -4310,12 +4309,14 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, extern void close_file_unwind (int); extern void fclose_unwind (void *); extern void restore_point_unwind (Lisp_Object); +extern bool file_access_p (char const *, int); extern Lisp_Object get_file_errno_data (const char *, Lisp_Object, int); extern AVOID report_file_errno (const char *, Lisp_Object, int); extern AVOID report_file_error (const char *, Lisp_Object); extern AVOID report_file_notify_error (const char *, Lisp_Object); +extern Lisp_Object file_attribute_errno (Lisp_Object, int); extern bool internal_delete_file (Lisp_Object); -extern Lisp_Object emacs_readlinkat (int, const char *); +extern Lisp_Object check_emacs_readlinkat (int, Lisp_Object, char const *); extern bool file_directory_p (Lisp_Object); extern bool file_accessible_directory_p (Lisp_Object); extern void init_fileio (void); diff --git a/src/lread.c b/src/lread.c index 6ae7a0d8ba..d8883db46c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1346,15 +1346,22 @@ Return t if the file exists and loads successfully. */) if (!load_prefer_newer && is_elc) { result = stat (SSDATA (efound), &s1); + int err = errno; if (result == 0) { SSET (efound, SBYTES (efound) - 1, 0); result = stat (SSDATA (efound), &s2); + err = errno; SSET (efound, SBYTES (efound) - 1, 'c'); + if (result != 0) + found = Fsubstring (found, make_fixnum (0), + make_fixnum (-1)); } - - if (result == 0 - && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0) + if (result != 0) + file_attribute_errno (found, err); + else if (timespec_cmp (get_stat_mtime (&s1), + get_stat_mtime (&s2)) + < 0) { /* Make the progress messages mention that source is newer. */ newer = 1; @@ -1748,16 +1755,20 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, { if (file_directory_p (encoded_fn)) last_errno = EISDIR; - else + else if (errno == ENOENT || errno == ENOTDIR) fd = 1; + else + last_errno = errno; } + else if (! (errno == ENOENT || errno == ENOTDIR)) + last_errno = errno; } else { fd = emacs_open (pfn, O_RDONLY, 0); if (fd < 0) { - if (errno != ENOENT) + if (! (errno == ENOENT || errno == ENOTDIR)) last_errno = errno; } else commit ae3edf0ac3f1e893338917497b55859d6aca7d42 Author: Jimmy Aguilar Mena Date: Tue Sep 17 22:00:21 2019 +0200 Substituted deprecated WebKitGTK+ api. * src/xwidget.c : Substituted WebKitGTK+ API calls and use JavaScriptCore GLib API instead. diff --git a/src/xwidget.c b/src/xwidget.c index 121510ebac..ecb3793629 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -31,14 +31,6 @@ along with GNU Emacs. If not, see . */ #include #include -/* Suppress GCC deprecation warnings starting in WebKitGTK+ 2.21.1 for - webkit_javascript_result_get_global_context and - webkit_javascript_result_get_value (Bug#33679). - FIXME: Use the JavaScriptCore GLib API instead, and remove this hack. */ -#if WEBKIT_CHECK_VERSION (2, 21, 1) && GNUC_PREREQ (4, 2, 0) -# pragma GCC diagnostic ignored "-Wdeprecated-declarations" -#endif - static struct xwidget * allocate_xwidget (void) { @@ -284,95 +276,70 @@ webkit_view_load_changed_cb (WebKitWebView *webkitwebview, /* Recursively convert a JavaScript value to a Lisp value. */ static Lisp_Object -webkit_js_to_lisp (JSContextRef context, JSValueRef value) +webkit_js_to_lisp (JSCValue *value) { - switch (JSValueGetType (context, value)) + if (jsc_value_is_string (value)) { - case kJSTypeString: - { - JSStringRef js_str_value; - gchar *str_value; - gsize str_length; - - js_str_value = JSValueToStringCopy (context, value, NULL); - str_length = JSStringGetMaximumUTF8CStringSize (js_str_value); - str_value = (gchar *)g_malloc (str_length); - JSStringGetUTF8CString (js_str_value, str_value, str_length); - JSStringRelease (js_str_value); - return build_string (str_value); - } - case kJSTypeBoolean: - return (JSValueToBoolean (context, value)) ? Qt : Qnil; - case kJSTypeNumber: - return make_fixnum (JSValueToNumber (context, value, NULL)); - case kJSTypeObject: - { - if (JSValueIsArray (context, value)) - { - JSStringRef pname = JSStringCreateWithUTF8CString("length"); - JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, - pname, NULL); - double dlen = JSValueToNumber (context, len, NULL); - JSStringRelease(pname); - - Lisp_Object obj; - if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0)) - memory_full (SIZE_MAX); - ptrdiff_t n = dlen; - struct Lisp_Vector *p = allocate_vector (n); - - for (ptrdiff_t i = 0; i < n; ++i) - { - p->contents[i] = - webkit_js_to_lisp (context, - JSObjectGetPropertyAtIndex (context, - (JSObjectRef) value, - i, NULL)); - } - XSETVECTOR (obj, p); - return obj; - } - else - { - JSPropertyNameArrayRef properties = - JSObjectCopyPropertyNames (context, (JSObjectRef) value); - - size_t n = JSPropertyNameArrayGetCount (properties); - Lisp_Object obj; - - /* TODO: can we use a regular list here? */ - if (PTRDIFF_MAX < n) - memory_full (n); - struct Lisp_Vector *p = allocate_vector (n); - - for (ptrdiff_t i = 0; i < n; ++i) - { - JSStringRef name = JSPropertyNameArrayGetNameAtIndex (properties, i); - JSValueRef property = JSObjectGetProperty (context, - (JSObjectRef) value, - name, NULL); - gchar *str_name; - gsize str_length; - str_length = JSStringGetMaximumUTF8CStringSize (name); - str_name = (gchar *)g_malloc (str_length); - JSStringGetUTF8CString (name, str_name, str_length); - JSStringRelease (name); - - p->contents[i] = - Fcons (build_string (str_name), - webkit_js_to_lisp (context, property)); - } - - JSPropertyNameArrayRelease (properties); - XSETVECTOR (obj, p); - return obj; - } - } - case kJSTypeUndefined: - case kJSTypeNull: - default: - return Qnil; + gchar *str_value = jsc_value_to_string (value); + Lisp_Object ret = build_string (str_value); + g_free (str_value); + + return ret; + } + else if (jsc_value_is_boolean (value)) + { + return (jsc_value_to_boolean (value)) ? Qt : Qnil; + } + else if (jsc_value_is_number (value)) + { + return make_fixnum (jsc_value_to_int32 (value)); + } + else if (jsc_value_is_array (value)) + { + JSCValue *len = jsc_value_object_get_property (value, "length"); + const gint32 dlen = jsc_value_to_int32 (len); + + Lisp_Object obj; + if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0)) + memory_full (SIZE_MAX); + + ptrdiff_t n = dlen; + struct Lisp_Vector *p = allocate_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + { + p->contents[i] = + webkit_js_to_lisp (jsc_value_object_get_property_at_index (value, i)); + } + XSETVECTOR (obj, p); + return obj; + } + else if (jsc_value_is_object (value)) + { + char **properties_names = jsc_value_object_enumerate_properties (value); + guint n = g_strv_length (properties_names); + + Lisp_Object obj; + if (PTRDIFF_MAX < n) + memory_full (n); + struct Lisp_Vector *p = allocate_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + { + const char *name = properties_names[i]; + JSCValue *property = jsc_value_object_get_property (value, name); + + p->contents[i] = + Fcons (build_string (name), webkit_js_to_lisp (property)); + } + + g_strfreev (properties_names); + + XSETVECTOR (obj, p); + return obj; } + + return Qnil; } static void @@ -380,41 +347,39 @@ webkit_javascript_finished_cb (GObject *webview, GAsyncResult *result, gpointer arg) { - WebKitJavascriptResult *js_result; - JSValueRef value; - JSGlobalContextRef context; - GError *error = NULL; - struct xwidget *xw = g_object_get_data (G_OBJECT (webview), - XG_XWIDGET); - ptrdiff_t script_idx = (intptr_t) arg; - Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx); - ASET (xw->script_callbacks, script_idx, Qnil); - if (!NILP (script_callback)) - xfree (xmint_pointer (XCAR (script_callback))); - - js_result = webkit_web_view_run_javascript_finish - (WEBKIT_WEB_VIEW (webview), result, &error); - - if (!js_result) - { - g_warning ("Error running javascript: %s", error->message); - g_error_free (error); - return; - } + GError *error = NULL; + struct xwidget *xw = g_object_get_data (G_OBJECT (webview), XG_XWIDGET); - if (!NILP (script_callback) && !NILP (XCDR (script_callback))) - { - context = webkit_javascript_result_get_global_context (js_result); - value = webkit_javascript_result_get_value (js_result); - Lisp_Object lisp_value = webkit_js_to_lisp (context, value); - - /* Register an xwidget event here, which then runs the callback. - This ensures that the callback runs in sync with the Emacs - event loop. */ - store_xwidget_js_callback_event (xw, XCDR (script_callback), lisp_value); - } + ptrdiff_t script_idx = (intptr_t) arg; + Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx); + ASET (xw->script_callbacks, script_idx, Qnil); + if (!NILP (script_callback)) + xfree (xmint_pointer (XCAR (script_callback))); + + WebKitJavascriptResult *js_result = + webkit_web_view_run_javascript_finish + (WEBKIT_WEB_VIEW (webview), result, &error); + + if (!js_result) + { + g_warning ("Error running javascript: %s", error->message); + g_error_free (error); + return; + } + + if (!NILP (script_callback) && !NILP (XCDR (script_callback))) + { + JSCValue *value = webkit_javascript_result_get_js_value (js_result); + + Lisp_Object lisp_value = webkit_js_to_lisp (value); + + /* Register an xwidget event here, which then runs the callback. + This ensures that the callback runs in sync with the Emacs + event loop. */ + store_xwidget_js_callback_event (xw, XCDR (script_callback), lisp_value); + } - webkit_javascript_result_unref (js_result); + webkit_javascript_result_unref (js_result); } commit cbc10ec71e9f189e8d6fd5c6927aec4872e0fd96 Author: Tino Calancha Date: Tue Sep 17 18:07:50 2019 +0200 Fix an assignment to free variable warning It fixes a bug introduced by commit 'query-replace-regexp undo: Update next-replacement after undo' (30c4f35a6fc8a6507930923766c3126ac1c2063f) See https://lists.gnu.org/archive/html/emacs-devel/2019-09/msg00364.html * lisp/replace.el(perform-replace): Rename variable to next-replacement-replaced. diff --git a/lisp/replace.el b/lisp/replace.el index a82780fc47..5c0616e25f 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2711,7 +2711,7 @@ characters." search-string (nth (if replaced 4 3) elt) last-replacement (nth (if replaced 3 4) elt) search-string-replaced search-string - last-replacement-replaced last-replacement + next-replacement-replaced last-replacement last-was-act-and-show nil) (when (and (= stack-idx stack-len) commit 746b20c23733c36c26e8962d685b01385e58e94d Author: Juanma Barranquero Date: Tue Sep 17 16:29:23 2019 +0200 * src/w32fns.c (Fw32_read_registry): Doc fix diff --git a/src/w32fns.c b/src/w32fns.c index d6fd8f5349..34abd026f9 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10109,8 +10109,8 @@ KEY can use either forward- or back-slashes. To access the default value of KEY (if it is defined), use NAME that is an empty string. -If the the named KEY or its subkey called NAME don't exist, or cannot -be accessed by the current user, the function returns nil. Otherwise, +If the named KEY or its subkey called NAME don't exist, or cannot be +accessed by the current user, the function returns nil. Otherwise, the return value depends on the type of the data stored in Registry: If the data type is REG_NONE, the function returns t. commit 57fd3709b21da6b4281c4e96e3361e5cf2355957 Author: Lars Ingebrigtsen Date: Tue Sep 17 14:18:52 2019 +0200 Suppress some warnings about un-prefixed dynamic variables * lisp/mh-e/mh-mime.el (mh-insert-mime-security-button): Suppress warnings about un-prefixed dynamic variables. (mh-insert-mime-button): Ditto. diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index d74e79f1cb..c6b5aaec34 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -859,23 +859,24 @@ by commands like \"K v\" which operate on individual MIME parts." (if (string-match ".*/" name) (setq name (substring name (match-end 0)))) ;; These vars are passed by dynamic-scoping to ;; mh-mime-button-line-format-alist via gnus-eval-format. - (mh-dlet* ((index index) - (description (mail-decode-encoded-word-string - (or (mm-handle-description handle) ""))) - (dots (if (or displayed (mm-handle-displayed-p handle)) - " " "...")) - (long-type (concat type (and (not (equal name "")) - (concat "; " name))))) - (unless (equal description "") - (setq long-type (concat " --- " long-type))) - (unless (bolp) (insert "\n")) - (setq begin (point)) - (gnus-eval-format - mh-mime-button-line-format mh-mime-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-button-map) - mh-callback mh-mm-display-part - mh-part ,index - mh-data ,handle))) + (with-suppressed-warnings ((lexical index description dots)) + (mh-dlet* ((index index) + (description (mail-decode-encoded-word-string + (or (mm-handle-description handle) ""))) + (dots (if (or displayed (mm-handle-displayed-p handle)) + " " "...")) + (long-type (concat type (and (not (equal name "")) + (concat "; " name))))) + (unless (equal description "") + (setq long-type (concat " --- " long-type))) + (unless (bolp) (insert "\n")) + (setq begin (point)) + (gnus-eval-format + mh-mime-button-line-format mh-mime-button-line-format-alist + `(,@(mh-gnus-local-map-property mh-mime-button-map) + mh-callback mh-mm-display-part + mh-part ,index + mh-data ,handle)))) (setq end (point)) (widget-convert-button 'link begin end @@ -900,44 +901,45 @@ by commands like \"K v\" which operate on individual MIME parts." begin end face) ;; These vars are passed by dynamic-scoping to ;; mh-mime-security-button-line-format-alist via gnus-eval-format. - (mh-dlet* ((type (concat crypto-type - (if (equal (car handle) "multipart/signed") - " Signed" " Encrypted") - " Part")) - (info (or (mh-mm-handle-multipart-ctl-parameter - handle 'gnus-info) - "Undecided")) - (details (mh-mm-handle-multipart-ctl-parameter - handle 'gnus-details)) - pressed-details) - (setq details (if details (concat "\n" details) "")) - (setq pressed-details (if mh-mime-security-button-pressed details "")) - (setq face (mh-mime-security-button-face info)) - (unless (bolp) (insert "\n")) - (setq begin (point)) - (gnus-eval-format - mh-mime-security-button-line-format - mh-mime-security-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-security-button-map) - mh-button-pressed ,mh-mime-security-button-pressed - mh-callback mh-mime-security-press-button - mh-line-format ,mh-mime-security-button-line-format - mh-data ,handle)) - (setq end (point)) - (widget-convert-button 'link begin end - :mime-handle handle - :action 'mh-widget-press-button - :button-keymap mh-mime-security-button-map - :button-face face - :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") - (dolist (ov (mh-funcall-if-exists overlays-in begin end)) - (mh-funcall-if-exists overlay-put ov 'evaporate t)) - (when (equal info "Failed") - (let* ((type (if (equal (car handle) "multipart/signed") - "verification" "decryption")) - (warning (if (equal type "decryption") - "(passphrase may be incorrect)" ""))) - (message "%s %s failed %s" crypto-type type warning)))))) + (with-suppressed-warnings ((lexical type info details)) + (mh-dlet* ((type (concat crypto-type + (if (equal (car handle) "multipart/signed") + " Signed" " Encrypted") + " Part")) + (info (or (mh-mm-handle-multipart-ctl-parameter + handle 'gnus-info) + "Undecided")) + (details (mh-mm-handle-multipart-ctl-parameter + handle 'gnus-details)) + pressed-details) + (setq details (if details (concat "\n" details) "")) + (setq pressed-details (if mh-mime-security-button-pressed details "")) + (setq face (mh-mime-security-button-face info)) + (unless (bolp) (insert "\n")) + (setq begin (point)) + (gnus-eval-format + mh-mime-security-button-line-format + mh-mime-security-button-line-format-alist + `(,@(mh-gnus-local-map-property mh-mime-security-button-map) + mh-button-pressed ,mh-mime-security-button-pressed + mh-callback mh-mime-security-press-button + mh-line-format ,mh-mime-security-button-line-format + mh-data ,handle)) + (setq end (point)) + (widget-convert-button 'link begin end + :mime-handle handle + :action 'mh-widget-press-button + :button-keymap mh-mime-security-button-map + :button-face face + :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") + (dolist (ov (mh-funcall-if-exists overlays-in begin end)) + (mh-funcall-if-exists overlay-put ov 'evaporate t)) + (when (equal info "Failed") + (let* ((type (if (equal (car handle) "multipart/signed") + "verification" "decryption")) + (warning (if (equal type "decryption") + "(passphrase may be incorrect)" ""))) + (message "%s %s failed %s" crypto-type type warning))))))) (defun mh-mime-security-button-face (info) "Return the button face to use for encrypted/signed mail based on INFO." commit 4b73a937e08334a8304f876b598b662d6a0aaef5 Author: Lars Ingebrigtsen Date: Tue Sep 17 14:11:53 2019 +0200 Touch up naming of ipv6-expand * lisp/net/net-utils.el (nslookup--ipv6-expand): Rename to avoid make prefix more regular. (nslookup-host-ipv6): Rename call. diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 4f68e5db61..03ed4a5957 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -563,7 +563,7 @@ This command uses `nslookup-program' to look up DNS records." (apply #'vector (mapcar #'string-to-number (split-string ip "\\.")))) (t (error "Invalid format: %s" format))))) -(defun ipv6-expand (ipv6-vector) +(defun nslookup--ipv6-expand (ipv6-vector) (let ((len (length ipv6-vector))) (if (< len 8) (let* ((pivot (cl-position 0 ipv6-vector)) @@ -598,9 +598,10 @@ This command uses `nslookup-program' to look up DNS records." (cond ((memq format '(string nil)) ip) ((eq format 'vector) - (ipv6-expand (apply #'vector - (cl-loop for hextet in (split-string ip "[:]") - collect (string-to-number hextet 16))))) + (nslookup--ipv6-expand + (apply #'vector + (cl-loop for hextet in (split-string ip "[:]") + collect (string-to-number hextet 16))))) (t (error "Invalid format: %s" format))))) ;;;###autoload commit 0e5e816a09cddb0577e5d7c6187b872876b2f759 Author: W. Garrett Mitchener Date: Tue Sep 17 13:56:28 2019 +0200 Updated to match more recent versions of Praat. * lisp/leim/quail/ipa-praat.el ("ipa-praat"): Update to match more recent versions of Praat (bug#36198). - \rh was used for ram's horns (a vowel) and rhoticity hook (a diacritic). Praat uses \hr for the hook, so I made that changed. - \e3v for the slightly rounded diacritic seems to have been a typo related to the use of e in the example. Changed it to \3v to match Praat. - Added examples to the table of tone diacritics - Added \^h for superscript h - Added \^H for superscript h with hook - Added \^w for superscript w (labialization) - Added \^j for superscript j (palatalization) - Added \^g for superscript symbol (velarization) - Added \^9 for superscript symbol (pharyngealization) diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el index 74a2dccc06..169dbcf0e2 100644 --- a/lisp/leim/quail/ipa-praat.el +++ b/lisp/leim/quail/ipa-praat.el @@ -148,7 +148,14 @@ input | example | description \\'1 | ˈ | primary stress \\'2 | ˌ | secondary stress \\cn | t̚ | unreleased plosive -\\rh | ɜ˞ | rhotacized vowel +\\hr | ɜ˞ | rhotacized vowel +\\^h | ʰ | aspiration +\\^H | ʱ | voiced aspiration +\\^w | ʷ | labialized, rounded +\\^j | ʲ | palatalized +\\^g | ˠ | velarized +\\^9 | ˤ | pharyngealized + - Understrikes @@ -168,7 +175,7 @@ input | example | description \\Uv | d̺ | apical \\Dv | d̻ | laminal \\nv | u̯ | nonsyllabic -\\e3v | e̹ | slightly rounded +\\3v | e̹ | slightly rounded \\cv | u̜ | slightly unrounded - Overstrikes @@ -176,14 +183,14 @@ input | example | description input | example | description ------+---------+-------------------------------------------- \\0^ | ɣ̊ | voiceless -\\'^ | | high tone -\\`^ | | low tone -\\-^ | | mid tone -\\~^ | | nasalized -\\v^ | | rising tone -\\^^ | | falling tone -\\:^ | | centralized -\\N^ | | short +\\'^ | é | high tone +\\`^ | è | low tone +\\-^ | ē | mid tone +\\~^ | ẽ | nasalized +\\v^ | ě | rising tone +\\^^ | ê | falling tone +\\:^ | ë | centralized +\\N^ | ĕ | short \\li | k͡p | simultaneous articulation or single segment " nil t nil nil nil nil nil nil nil nil t) @@ -308,7 +315,13 @@ input | example | description ("\\'1" ?ˈ) ; primary stress ("\\'2" ?ˌ) ; secondary stress ("\\cn" #x031A) ; t̚ unreleased plosive - ("\\rh" #x02DE) ; ɜ˞ rhotacized vowel + ("\\hr" #x02DE) ; ɜ˞ rhotacized vowel + ("\\^h" ?ʰ) ; ʰ aspiration (usually following a plosive) + ("\\^H" ?ʱ) ; ʱ voiced aspiration (usually following a plosive) + ("\\^w" ?ʷ) ; labialized + ("\\^j" ?ʲ) ; palatalized + ("\\^g" ?ˠ) ; velarized + ("\\^9" ?ˤ) ; pharyngealized ("\\|v" #x0329) ; n̩ syllabic consonant ("\\0v" #x0325) ; b̥ voiceless @@ -324,7 +337,7 @@ input | example | description ("\\Uv" #x033A) ; d̺ apical ("\\Dv" #x033B) ; d̻ laminal ("\\nv" #x032F) ; u̯ nonsyllabic - ("\\e3v" #x0339) ; e̹ slightly rounded + ("\\3v" #x0339) ; e̹ slightly rounded ("\\cv" #x031C) ; u̜ slightly unrounded ("\\0^" #x030A) ; ɣ̊ voiceless commit f52c13ff8212e46e5b5f034eade316a733c9e4a4 Author: Lars Ingebrigtsen Date: Tue Sep 17 13:54:19 2019 +0200 Update doc marker -- smtpmail-retries is documented diff --git a/etc/NEWS b/etc/NEWS index 693a690f17..9aec8da566 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1165,7 +1165,7 @@ defining new 'cl-defmethod' of 'smtpmail-try-auth-method'. attempt when communicating with the SMTP server(s), the 'smtpmail-servers-requiring-authorization' variable can be used. ---- ++++ *** smtpmail will now try resending mail when getting a transient 4xx error message from the SMTP server. The new 'smtpmail-retries' variable says how many times to retry. commit 8054935c6130c88152387f8a35d436704dbde780 Author: Eli Zaretskii Date: Tue Sep 17 14:19:54 2019 +0300 Improve font lookup on MS-Windows * src/w32font.c (struct font_callback_data): New member 'known_fonts'. (w32font_list_internal, w32font_match_internal): Set up match_data.known_fonts if the font spec includes :script that names one of the non-USB scripts. (add_font_entity_to_list): If font_matches_spec returns zero for a font, and we have some fonts in match_data->known_fonts, consider the font to be a match if it is named in known_fonts. (font_supported_scripts): Update the Unicode Subranges. In particular, map bit 74 to 'burmese', as this is the name Emacs uses, not 'myanmar'. Add a list of scripts that have no USBs defined for them. (syms_of_w32font) : New symbols. * lisp/term/w32-win.el (w32-no-usb-subranges): New defconst. (w32--filter-USB-scripts, w32-find-non-USB-fonts): New functions. (w32-non-USB-fonts): New defvar. * lisp/international/fontset.el (setup-default-fontset): Add more scripts to automatic setup by representative characters. * doc/emacs/msdos.texi (Windows Fonts): Document 'w32-find-non-USB-fonts' and 'w32-non-USB-fonts'. * etc/NEWS: Mention 'w32-find-non-USB-fonts' and 'w32-non-USB-fonts'. diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index 6933130d5b..5377df91d1 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -1025,7 +1025,7 @@ symbols, as in @code{(uniscribe)} or @w{@code{(harfbuzz uniscribe gdi)}}. @cindex font properties (MS Windows) @noindent -Optional properties common to all font backends on MS-Windows are: +Optional font properties supported on MS-Windows are: @table @code @@ -1078,40 +1078,61 @@ Not used on Windows, but for informational purposes and to prevent problems with code that expects it to be set, is set internally to @code{raster} for bitmapped fonts, @code{outline} for scalable fonts, or @code{unknown} if the type cannot be determined as one of those. -@end table - -@cindex font properties (MS Windows gdi backend) -Options specific to @code{GDI} fonts: - -@table @code @cindex font scripts (MS Windows) @cindex font Unicode subranges (MS Windows) @item script Specifies a Unicode subrange the font should support. -The following scripts are recognized on Windows: @code{latin}, @code{greek}, -@code{coptic}, @code{cyrillic}, @code{armenian}, @code{hebrew}, @code{arabic}, -@code{syriac}, @code{nko}, @code{thaana}, @code{devanagari}, @code{bengali}, -@code{gurmukhi}, @code{gujarati}, @code{oriya}, @code{tamil}, @code{telugu}, -@code{kannada}, @code{malayam}, @code{sinhala}, @code{thai}, @code{lao}, -@code{tibetan}, @code{myanmar}, @code{georgian}, @code{hangul}, -@code{ethiopic}, @code{cherokee}, @code{canadian-aboriginal}, @code{ogham}, -@code{runic}, @code{khmer}, @code{mongolian}, @code{symbol}, @code{braille}, -@code{han}, @code{ideographic-description}, @code{cjk-misc}, @code{kana}, -@code{bopomofo}, @code{kanbun}, @code{yi}, @code{byzantine-musical-symbol}, -@code{musical-symbol}, and @code{mathematical}. +All the scripts known to Emacs (which generally means all the scripts +defined by the latest Unicode Standard) are recognized on MS-Windows. +However, @code{GDI} fonts support only a subset of the known scripts: +@code{greek}, @code{hangul}, @code{kana}, @code{kanbun}, +@code{bopomofo}, @code{tibetan}, @code{yi}, @code{mongolian}, +@code{hebrew}, @code{arabic}, and @code{thai}. @cindex font antialiasing (MS Windows) +@cindex Cleartype @item antialias Specifies the antialiasing method. The value @code{none} means no antialiasing, @code{standard} means use standard antialiasing, -@code{subpixel} means use subpixel antialiasing (known as Cleartype on -Windows), and @code{natural} means use subpixel antialiasing with -adjusted spacing between letters. If unspecified, the font will use -the system default antialiasing. +@code{subpixel} means use subpixel antialiasing (known as +@dfn{Cleartype} on Windows), and @code{natural} means use subpixel +antialiasing with adjusted spacing between letters. If unspecified, +the font will use the system default antialiasing. @end table +@cindex font lookup, MS-Windows +@findex w32-find-non-USB-fonts +The method used by Emacs on MS-Windows to look for fonts suitable for +displaying a given non-@sc{ascii} character might fail for some rare +scripts, specifically those added by Unicode relatively recently, even +if you have fonts installed on your system that support those scripts. +That is because these scripts have no Unicode Subrange Bits (USBs) +defined for them in the information used by Emacs on MS-Windows to +look for fonts. You can use the @code{w32-find-non-USB-fonts} +function to overcome these problems. It needs to be run once at the +beginning of the Emacs session, and again if you install new fonts. +You can add the following line to your init file to have this function +run every time you start Emacs: + +@lisp +(w32-find-non-USB-fonts) +@end lisp + +@noindent +@vindex w32-non-USB-fonts +Alternatively, you can run this function manually via @kbd{M-:} +(@pxref{Lisp Eval}) at any time. On a system that has many fonts +installed, running @code{w32-find-non-USB-fonts} might take a couple +of seconds; if you consider that to be too long to be run during +startup, and if you install new fonts only rarely, run this function +once via @kbd{M-:}, and then assign the value it returns, if +non-@code{nil}, to the variable @code{w32-non-USB-fonts} in your init +file. (If the function returns @code{nil}, you have no fonts +installed that can display characters from the scripts which need this +facility.) + @node Windows Misc @section Miscellaneous Windows-specific features diff --git a/etc/NEWS b/etc/NEWS index 2db5db3978..693a690f17 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2703,6 +2703,14 @@ corresponding encoding, instead of using 'w32-ansi-code-page'. Experience shows that compacting font caches causes more trouble on MS-Windows than it helps. ++++ +** Font lookup on MS-Windows was improved to support rare scripts. +To activate the improvement, run the new function +'w32-find-non-USB-fonts' once per Emacs session, or assign to the new +variable 'w32-non-USB-fonts' the list of scripts and the corresponding +fonts. See the documentation of this function and variable in the +Emacs manual for more details. + +++ ** On NS the behaviour of drag and drop can now be modified by use of modifier keys in line with Apples guidelines. This makes the drag and diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index f3ab81633d..1debec7f46 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -719,6 +719,7 @@ symbol braille yi + tai-viet aegean-number ancient-greek-number ancient-symbol @@ -731,18 +732,26 @@ deseret shavian osmanya + osage cypriot-syllabary phoenician lydian kharoshthi + manichaean + elymaic + makasar cuneiform-numbers-and-punctuation cuneiform egyptian + bassa-vah + pahawh-hmong + medefaidrin byzantine-musical-symbol musical-symbol ancient-greek-musical-notation tai-xuan-jing-symbol counting-rod-numeral + adlam mahjong-tile domino-tile)) (set-fontset-font "fontset-default" diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 198182fca7..e2c019fc54 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -485,6 +485,136 @@ numbers, and the build number." That includes all Windows systems except for 9X/Me." (getenv "SystemRoot")) +;; The value of the following variable was calculated using the table in +;; https://docs.microsoft.com/windows/desktop/Intl/unicode-subset-bitfields, +;; by looking for Unicode subranges for which no USB bits are defined. +(defconst w32-no-usb-subranges + '((#x000800 . #x0008ff) + (#x0018b0 . #x0018ff) + (#x001a20 . #x001aff) + (#x001bc0 . #x001bff) + (#x001c80 . #x001cff) + (#x002fe0 . #x002fef) + (#x00a4d0 . #x00a4ff) + (#x00a6a0 . #x00a6ff) + (#x00a830 . #x00a83f) + (#x00a8e0 . #x00a8ff) + (#x00a960 . #x00a9ff) + (#x00aa60 . #x00abff) + (#x00d7b0 . #x00d7ff) + (#x010200 . #x01027f) + (#x0102e0 . #x0102ff) + (#x010350 . #x01037f) + (#x0103e0 . #x0103ff) + (#x0104b0 . #x0107ff) + (#x010840 . #x0108ff) + (#x010940 . #x0109ff) + (#x010a60 . #x011fff) + (#x012480 . #x01cfff) + (#x01d250 . #x01d2ff) + (#x01d380 . #x01d3ff) + (#x01d800 . #x01efff) + (#x01f0a0 . #x01ffff) + (#x02a6e0 . #x02f7ff) + (#x02fa20 . #x0dffff) + (#x0e0080 . #x0e00ff) + (#x0e01f0 . #x0fefff)) + "List of Unicode subranges whose support cannot be announced by a font. +The FONTSIGNATURE structure reported by MS-Windows for a font +includes 123 Unicode Subset bits (USBs) to identify subranges of +the Unicode codepoint space supported by the font. Since the +number of bits is fixed, not every Unicode block can have a +corresponding USB bit; fonts that support characters from blocks +that have no USBs cannot communicate their support to Emacs, +unless the font is opened and physically tested for glyphs for +characters from these blocks.") + +(defun w32--filter-USB-scripts () + "Filter USB scripts out of `script-representative-chars'." + (let (val) + (dolist (elt script-representative-chars) + (let ((subranges w32-no-usb-subranges) + (chars (cdr elt)) + ch found subrange) + (while (and (consp chars) (not found)) + (setq ch (car chars) + chars (cdr chars)) + (while (and (consp subranges) (not found)) + (setq subrange (car subranges) + subranges (cdr subranges)) + (when (and (>= ch (car subrange)) (<= ch (cdr subrange))) + (setq found t) + (push elt val)))))) + (nreverse val))) + +(defvar w32-non-USB-fonts nil + "Alist of script symbols and corresponding fonts. +Each element of the alist has the form (SCRIPT FONTS...), where +SCRIPT is a symbol of a script and FONTS are one or more fonts installed +on the system that can display SCRIPT's characters. FONTS are +specified as symbols. +Only scripts that have no corresponding Unicode Subset Bits (USBs) can +be found in this alist. +This alist is used by w32font.c when it looks for fonts that can display +characters from scripts for which no USBs are defined.") + +(defun w32-find-non-USB-fonts (&optional frame size) + "Compute the value of `w32-non-USB-fonts' for specified SIZE and FRAME. +FRAME defaults to the selected frame. +SIZE is the required font size and defaults to the nominal size of the +default font on FRAME, or its best approximation." + (let* ((inhibit-compacting-font-caches t) + (all-fonts + (delete-dups + (x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1" + 'default frame))) + val) + (mapc (function + (lambda (script-desc) + (let* ((script (car script-desc)) + (script-chars (vconcat (cdr script-desc))) + (nchars (length script-chars)) + (fntlist all-fonts) + (entry (list script)) + fspec ffont font-obj glyphs idx) + ;; For each font in FNTLIST, determine whether it + ;; supports the representative character(s) of any + ;; scripts that have no USBs defined for it. + (dolist (fnt fntlist) + (setq fspec (ignore-errors (font-spec :name fnt))) + (if fspec + (setq ffont (find-font fspec frame))) + (when ffont + (setq font-obj + (open-font ffont size frame)) + ;; Ignore fonts for which open-font returns nil: + ;; they are buggy fonts that we cannot use anyway. + (setq glyphs + (if font-obj + (font-get-glyphs font-obj + 0 nchars script-chars) + '[nil])) + ;; Does this font support ALL of the script's + ;; representative characters? + (setq idx 0) + (while (and (< idx nchars) (not (null (aref glyphs idx)))) + (setq idx (1+ idx))) + (if (= idx nchars) + ;; It does; add this font to the script's entry in alist. + (let ((font-family (font-get font-obj :family))) + ;; Unifont is an ugly font, and it is already + ;; present in the default fontset. + (unless (string= (downcase (symbol-name font-family)) + "unifont") + (push font-family entry)))))) + (if (> (length entry) 1) + (push (nreverse entry) val))))) + (w32--filter-USB-scripts)) + ;; We've opened a lot of fonts, so clear the font caches to free + ;; some memory. + (clear-font-cache) + (and val (setq w32-non-USB-fonts val)))) + (provide 'w32-win) (provide 'term/w32-win) diff --git a/src/w32font.c b/src/w32font.c index 14d49b24d9..9a334717c1 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -90,6 +90,8 @@ struct font_callback_data Lisp_Object orig_font_spec; /* The frame the font is being loaded on. */ Lisp_Object frame; + /* Fonts known to support the font spec, or nil if none. */ + Lisp_Object known_fonts; /* The list to add matches to. */ Lisp_Object list; /* Whether to match only opentype fonts. */ @@ -841,6 +843,25 @@ w32font_list_internal (struct frame *f, Lisp_Object font_spec, match_data.opentype_only = opentype_only; if (opentype_only) match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; + match_data.known_fonts = Qnil; + Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val; + if (CONSP (vw32_non_USB_fonts)) + { + Lisp_Object extra; + for (extra = AREF (font_spec, FONT_EXTRA_INDEX); + CONSP (extra); extra = XCDR (extra)) + { + Lisp_Object tem = XCAR (extra); + if (CONSP (tem) + && EQ (XCAR (tem), QCscript) + && SYMBOLP (XCDR (tem)) + && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts))) + { + match_data.known_fonts = XCDR (val); + break; + } + } + } if (match_data.pattern.lfFaceName[0] == '\0') { @@ -890,6 +911,26 @@ w32font_match_internal (struct frame *f, Lisp_Object font_spec, if (opentype_only) match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; + match_data.known_fonts = Qnil; + Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val; + if (CONSP (vw32_non_USB_fonts)) + { + Lisp_Object extra; + for (extra = AREF (font_spec, FONT_EXTRA_INDEX); + CONSP (extra); extra = XCDR (extra)) + { + Lisp_Object tem = XCAR (extra); + if (CONSP (tem) + && EQ (XCAR (tem), QCscript) + && SYMBOLP (XCDR (tem)) + && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts))) + { + match_data.known_fonts = XCDR (val); + break; + } + } + } + /* Prevent quitting while EnumFontFamiliesEx runs and conses the list it will return. That's because get_frame_dc acquires the critical section, so we cannot quit before we release it in @@ -1511,9 +1552,13 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font, /* Ensure a match. */ if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern) - || !font_matches_spec (font_type, physical_font, - match_data->orig_font_spec, backend, - &logical_font->elfLogFont) + || !(font_matches_spec (font_type, physical_font, + match_data->orig_font_spec, backend, + &logical_font->elfLogFont) + || (!NILP (match_data->known_fonts) + && memq_no_quit + (intern_font_name (logical_font->elfLogFont.lfFaceName), + match_data->known_fonts))) || !w32font_coverage_ok (&physical_font->ntmFontSig, match_data->pattern.lfCharSet)) return 1; @@ -2214,8 +2259,9 @@ font_supported_scripts (FONTSIGNATURE * sig) || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \ supported = Fcons ((sym), supported) - SUBRANGE (0, Qlatin); - /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */ + /* 0: ASCII (a.k.a. "Basic Latin"), + 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B, + 29: Latin Extended Additional. */ /* Most fonts that support Latin will have good coverage of the Extended blocks, so in practice marking them below is not really needed, or useful: if a font claims support for, say, Latin @@ -2224,12 +2270,11 @@ font_supported_scripts (FONTSIGNATURE * sig) fontset to display those few characters. But we mark these subranges here anyway, for the marginal use cases where they might make a difference. */ - SUBRANGE (1, Qlatin); - SUBRANGE (2, Qlatin); - SUBRANGE (3, Qlatin); + MASK_ANY (0x2000000F, 0, 0, 0, Qlatin); SUBRANGE (4, Qphonetic); /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */ - SUBRANGE (7, Qgreek); + /* 7: Greek and Coptic, 30: Greek Extended. */ + MASK_ANY (0x40000080, 0, 0, 0, Qgreek); SUBRANGE (8, Qcoptic); SUBRANGE (9, Qcyrillic); SUBRANGE (10, Qarmenian); @@ -2246,7 +2291,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (16, Qbengali); SUBRANGE (17, Qgurmukhi); SUBRANGE (18, Qgujarati); - SUBRANGE (19, Qoriya); + SUBRANGE (19, Qoriya); /* a.k.a. "Odia" */ SUBRANGE (20, Qtamil); SUBRANGE (21, Qtelugu); SUBRANGE (22, Qkannada); @@ -2259,8 +2304,7 @@ font_supported_scripts (FONTSIGNATURE * sig) /* 29: Latin Extended, 30: Greek Extended -- covered above. */ /* 31: Supplemental Punctuation -- most probably be masked by Courier New, so fontset customization is needed. */ - SUBRANGE (31, Qsymbol); - /* 32-47: Symbols (defined below). */ + /* 31-47: Symbols (defined below). */ SUBRANGE (48, Qcjk_misc); /* Match either 49: katakana or 50: hiragana for kana. */ MASK_ANY (0, 0x00060000, 0, 0, Qkana); @@ -2286,7 +2330,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (71, Qsyriac); SUBRANGE (72, Qthaana); SUBRANGE (73, Qsinhala); - SUBRANGE (74, Qmyanmar); + SUBRANGE (74, Qburmese); /* a.k.a. "Myanmar" */ SUBRANGE (75, Qethiopic); SUBRANGE (76, Qcherokee); SUBRANGE (77, Qcanadian_aboriginal); @@ -2329,6 +2373,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (99, Qhan); SUBRANGE (100, Qsyloti_nagri); SUBRANGE (101, Qlinear_b); + SUBRANGE (101, Qaegean_number); SUBRANGE (102, Qancient_greek_number); SUBRANGE (103, Qugaritic); SUBRANGE (104, Qold_persian); @@ -2338,6 +2383,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (108, Qkharoshthi); SUBRANGE (109, Qtai_xuan_jing_symbol); SUBRANGE (110, Qcuneiform); + SUBRANGE (111, Qcuneiform_numbers_and_punctuation); SUBRANGE (111, Qcounting_rod_numeral); SUBRANGE (112, Qsundanese); SUBRANGE (113, Qlepcha); @@ -2357,9 +2403,52 @@ font_supported_scripts (FONTSIGNATURE * sig) /* There isn't really a main symbol range, so include symbol if any relevant range is set. */ - MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol); - - /* Missing: Tai Viet (U+AA80-U+AADF). */ + MASK_ANY (0x80000000, 0x0000FFFF, 0, 0, Qsymbol); + + /* Missing: + Tai Viet + Old Permic + Palmyrene + Nabatean + Manichean + Hanifi Rohingya + Sogdian + Elymaic + Mahajani + Khojki + Khudawadi + Grantha + Newa + Tirhuta + Siddham + Modi + Takri + Dogra + Warang Citi + Nandinagari + Zanabazar Square + Soyombo + Pau Cin Hau + Bhaiksuki + Marchen + Masaram Gondi + Makasar + Egyptian + Mro + Bassa-Vah + Pahawh Hmong + Medefaidrin + Tangut + Tangut Components + Nushu + Duployan Shorthand + Ancient Greek Musical Notation + Nyiakeng Puachue Hmong + Wancho + Mende Kikakui + Adlam + Indic Siyaq Number + Ottoman Siyaq Number. */ #undef SUBRANGE #undef MASK_ANY @@ -2698,7 +2787,7 @@ syms_of_w32font (void) DEFSYM (Qthai, "thai"); DEFSYM (Qlao, "lao"); DEFSYM (Qtibetan, "tibetan"); - DEFSYM (Qmyanmar, "myanmar"); + DEFSYM (Qburmese, "burmese"); DEFSYM (Qgeorgian, "georgian"); DEFSYM (Qhangul, "hangul"); DEFSYM (Qethiopic, "ethiopic"); @@ -2737,6 +2826,8 @@ syms_of_w32font (void) DEFSYM (Qbuginese, "buginese"); DEFSYM (Qbuhid, "buhid"); DEFSYM (Qcuneiform, "cuneiform"); + DEFSYM (Qcuneiform_numbers_and_punctuation, + "cuneiform-numbers-and-punctuation"); DEFSYM (Qcypriot, "cypriot"); DEFSYM (Qdeseret, "deseret"); DEFSYM (Qglagolitic, "glagolitic"); @@ -2745,6 +2836,7 @@ syms_of_w32font (void) DEFSYM (Qkharoshthi, "kharoshthi"); DEFSYM (Qlimbu, "limbu"); DEFSYM (Qlinear_b, "linear_b"); + DEFSYM (Qaegean_number, "aegean-number"); DEFSYM (Qold_italic, "old_italic"); DEFSYM (Qold_persian, "old_persian"); DEFSYM (Qosmanya, "osmanya"); @@ -2818,6 +2910,7 @@ versions of Windows) characters. */); DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese"); DEFSYM (Qw32_charset_thai, "w32-charset-thai"); DEFSYM (Qw32_charset_mac, "w32-charset-mac"); + DEFSYM (Qw32_non_USB_fonts, "w32-non-USB-fonts"); defsubr (&Sx_select_font); commit 01c929bc640b48674d98feae1e821fb4924bf520 Author: Paul Eggert Date: Tue Sep 17 04:01:00 2019 -0700 Pacify GCC -Wmaybe-uninitialized * src/dired.c (directory_files_internal): Pacify GCC 7.4.0-1ubuntu1~18.04.1 x86-64. diff --git a/src/dired.c b/src/dired.c index 5fc6ccd3ea..df03bc32ce 100644 --- a/src/dired.c +++ b/src/dired.c @@ -241,7 +241,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, && fast_string_match_internal (match, name, case_table) < 0) continue; - Lisp_Object fileattrs; + Lisp_Object fileattrs UNINIT; if (attrs) { fileattrs = file_attributes (fd, dp->d_name, directory, name, commit c108d8ecc65c8e9626ce782213764d5d12508b43 Author: Paul Eggert Date: Tue Sep 17 03:54:41 2019 -0700 Don’t round file-system-info counts * src/fileio.c (blocks_to_bytes): Convert the byte count to an integer, since we have bignums now. This avoids possible rounding errors for file systems containing more than 8 PiB or so. diff --git a/src/fileio.c b/src/fileio.c index c129f19872..81c29ca0cc 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6081,16 +6081,18 @@ effect except for flushing STREAM's data. */) #ifndef DOS_NT -/* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with - the result negated if NEGATE. */ +/* Yield a Lisp number equal to BLOCKSIZE * BLOCKS, with the result + negated if NEGATE. */ static Lisp_Object blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate) { - /* On typical platforms the following code is accurate to 53 bits, - which is close enough. BLOCKSIZE is invariably a power of 2, so - converting it to double does not lose information. */ - double bs = blocksize; - return make_float (negate ? -bs * -blocks : bs * blocks); + intmax_t n; + if (!INT_MULTIPLY_WRAPV (blocksize, blocks, &n)) + return make_int (negate ? -n : n); + Lisp_Object bs = make_uint (blocksize); + if (negate) + bs = CALLN (Fminus, bs); + return CALLN (Ftimes, bs, make_uint (blocks)); } DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, commit d27fb533ffe8aa40285daecd8e3eab0ca0b7484e Author: Mattias Engdegård Date: Tue Sep 17 12:01:15 2019 +0200 * doc/lispref/searching.texi (Rx Constructs): Fix typo. diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 2088f16e47..1286b63446 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -1183,7 +1183,7 @@ Match @var{rx}, with @code{zero-or-more}, @code{0+}, @cindex @code{maximal-match} in rx Match @var{rx}, with @code{zero-or-more}, @code{0+}, @code{one-or-more}, @code{1+}, @code{zero-or-one}, @code{opt} and -@code{optional} using non-greedy matching. This is the default. +@code{optional} using greedy matching. This is the default. @end table @subsubheading Matching single characters commit e80e037eec371e02e8160e4a9230e9a2822dd3e0 Author: Eli Zaretskii Date: Tue Sep 17 12:45:04 2019 +0300 ; * etc/NEWS: Minor copyedits. diff --git a/etc/NEWS b/etc/NEWS index 33a7d12b7e..2db5db3978 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1018,6 +1018,9 @@ only one hit. This can be altered by changing *** Xref buffers support refreshing the search results. A new command 'xref-revert-buffer' is bound to 'g'. +--- +*** Imenu support has been added to 'xref--xref-buffer-mode'. + ** Ecomplete *** The ecomplete sorting has changed to a decay-based algorithm. @@ -1912,11 +1915,6 @@ and 'gravatar-force-default'. *** The built-in ada-mode is now deleted. The GNU ELPA package is a good replacement, even in very large source files. -** xref - ---- -*** Imenu support has been added to 'xref--xref-buffer-mode'. - * New Modes and Packages in Emacs 27.1 @@ -1952,6 +1950,7 @@ long lines will (subject to configuration) cause the user's preferred major mode is replaced by 'so-long-mode'). In extreme cases this can prevent delays of several minutes, and make Emacs responsive almost immediately. Type 'M-x so-long-commentary' for full documentation. + * Incompatible Lisp Changes in Emacs 27.1