[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/tsdh-vc-list-files af0642a 2/2: Merge remote-track
|
From: |
Tassilo Horn |
|
Subject: |
[Emacs-diffs] scratch/tsdh-vc-list-files af0642a 2/2: Merge remote-tracking branch 'origin/master' into scratch/tsdh-vc-list-files |
|
Date: |
Sun, 22 Sep 2019 05:05:24 -0400 (EDT) |
branch: scratch/tsdh-vc-list-files
commit af0642a4cb220f33a43d1380be085bc0b7134bb8
Merge: 8992bc7 37a4233
Author: Tassilo Horn <address@hidden>
Commit: Tassilo Horn <address@hidden>
Merge remote-tracking branch 'origin/master' into scratch/tsdh-vc-list-files
---
admin/upload-manuals | 6 +-
doc/emacs/maintaining.texi | 6 +
doc/emacs/msdos.texi | 65 +++--
doc/emacs/mule.texi | 4 +
doc/emacs/search.texi | 10 +-
doc/lispref/debugging.texi | 3 +
doc/lispref/display.texi | 6 +-
doc/lispref/files.texi | 13 +-
doc/lispref/internals.texi | 13 +-
doc/lispref/searching.texi | 2 +-
doc/misc/efaq.texi | 2 +-
doc/misc/emacs-mime.texi | 17 +-
doc/misc/gnus.texi | 2 +-
doc/misc/smtpmail.texi | 7 +
doc/misc/tramp.texi | 29 ++
etc/HELLO | 4 +-
etc/NEWS | 63 ++++-
lib-src/emacsclient.c | 6 +-
lisp/calc/calc-prog.el | 2 +-
lisp/cus-edit.el | 7 +-
lisp/emacs-lisp/autoload.el | 3 +-
lisp/emacs-lisp/backtrace.el | 44 ++-
lisp/emacs-lisp/cl-print.el | 21 +-
lisp/emulation/viper.el | 6 +-
lisp/files.el | 10 +-
lisp/gnus/gnus-start.el | 5 +-
lisp/gnus/mm-decode.el | 8 +-
lisp/gnus/mm-view.el | 5 +-
lisp/help-mode.el | 2 +-
lisp/htmlfontify.el | 6 +-
lisp/imenu.el | 5 +-
lisp/international/fontset.el | 9 +
lisp/international/iso-transl.el | 2 +
lisp/isearch.el | 23 ++
lisp/language/tai-viet.el | 23 +-
lisp/leim/quail/ipa-praat.el | 37 ++-
lisp/mail/feedmail.el | 17 +-
lisp/mail/smtpmail.el | 28 +-
lisp/mh-e/mh-acros.el | 14 +-
lisp/net/eww.el | 32 ++-
lisp/net/net-utils.el | 9 +-
lisp/net/rfc2104.el | 2 -
lisp/net/shr.el | 16 ++
lisp/net/tramp-adb.el | 12 +-
lisp/net/tramp-gvfs.el | 4 +
lisp/net/tramp-rclone.el | 13 +-
lisp/net/tramp-sh.el | 45 +--
lisp/net/tramp-smb.el | 73 +++--
lisp/net/tramp-sudoedit.el | 25 +-
lisp/net/tramp.el | 71 +++--
lisp/play/gamegrid.el | 49 ++--
lisp/progmodes/python.el | 8 +-
lisp/progmodes/sh-script.el | 46 +--
lisp/replace.el | 14 +-
lisp/select.el | 9 +-
lisp/server.el | 6 +-
lisp/shadowfile.el | 16 +-
lisp/subr.el | 2 +-
lisp/term/w32-win.el | 130 +++++++++
lisp/textmodes/table.el | 4 -
lisp/tooltip.el | 5 +-
lisp/vc/vc-cvs.el | 2 +-
lisp/vc/vc-dir.el | 16 +-
lisp/vc/vc-svn.el | 5 +-
lisp/vc/vc.el | 13 +-
lisp/wid-browse.el | 6 +-
lisp/wid-edit.el | 1 +
src/alloc.c | 200 +++++++------
src/callint.c | 1 -
src/callproc.c | 40 +--
src/charset.c | 20 +-
src/cm.c | 1 -
src/dired.c | 149 ++++------
src/doc.c | 2 +-
src/emacs.c | 3 +-
src/eval.c | 9 -
src/fileio.c | 478 ++++++++++++++++++--------------
src/filelock.c | 86 +++---
src/fns.c | 3 -
src/lisp.h | 11 +-
src/lread.c | 21 +-
src/print.c | 100 +++----
src/profiler.c | 12 +-
src/term.c | 1 -
src/w32.c | 29 +-
src/w32fns.c | 4 +-
src/w32font.c | 127 +++++++--
src/xdisp.c | 8 +-
src/xwidget.c | 219 ++++++---------
test/lisp/emacs-lisp/backquote-tests.el | 47 ++++
test/lisp/emacs-lisp/backtrace-tests.el | 49 ++++
test/lisp/emacs-lisp/cl-print-tests.el | 115 +-------
test/lisp/net/tramp-tests.el | 21 +-
test/lisp/progmodes/python-tests.el | 13 +-
test/lisp/replace-tests.el | 18 +-
test/lisp/shadowfile-tests.el | 13 +-
test/src/print-tests.el | 259 ++++++++++++++++-
97 files changed, 2006 insertions(+), 1222 deletions(-)
diff --git a/admin/upload-manuals b/admin/upload-manuals
index 08b47d7..e37128a 100755
--- a/admin/upload-manuals
+++ b/admin/upload-manuals
@@ -87,6 +87,9 @@ OPTIND=1
[ $# -eq 1 ] || usage
+[ -e html_mono/emacs.html ] && [ -e html_node/emacs/index.html ] || \
+ die "Current directory does not look like the manual/ directory"
+
[ "$version$umessage" ] || \
die "Could not get version to use for commit message"
@@ -95,9 +98,6 @@ webdir=$1
[ -e $webdir/CVS/Entries ] && [ -e $webdir/refcards/pdf/refcard.pdf ] || \
die "$webdir does not look like a checkout of the Emacs webpages"
-[ -e html_mono/emacs.html ] && [ -e html_node/emacs/index.html ] || \
- die "Current directory does not like the manual/ directory"
-
echo "Doing refcards..."
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index e92a959..9a99570 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1281,6 +1281,12 @@ point is on a directory entry, mark all files in that
directory tree
(@code{vc-dir-mark-all-files}). With a prefix argument, mark all
listed files and directories.
+@item G
+Add the file under point to the list of files that the VC should
+ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it
+will append this file to the @file{.gitignore} file. If given a
+prefix, do this with all the marked files.
+
@item q
Quit the VC Directory buffer, and bury it (@code{quit-window}).
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index 6933130..5377df9 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/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 6a26667..dfd464c 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -497,6 +497,10 @@ one of them selects that alternative. The keys @kbd{C-f},
@kbd{C-b},
do the highlighting in the buffer showing the possible characters,
rather than in the echo area.
+ To enter characters according to the @dfn{pīnyīn} transliteration
+method instead, use the @code{chinese-sisheng} input method. This is
+a composition based method, where e.g. @kbd{pi1} results in @samp{pī}.
+
In Japanese input methods, first you input a whole word using
phonetic spelling; then, after the word is in the buffer, Emacs
converts it into one or more characters using a large dictionary. One
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 66af5d4..38ef49e 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -262,11 +262,19 @@ of whether to copy a character or a symbol is heuristic.)
@kindex M-s C-e @r{(Incremental search)}
@findex isearch-yank-line
- Similarly, @kbd{M-s C-e} (@code{isearch-yank-line}) appends the rest
+ @kbd{M-s C-e} (@code{isearch-yank-line}) appends the rest
of the current line to the search string. If point is already at the
end of a line, it appends the next line. With a prefix argument
@var{n}, it appends the next @var{n} lines.
+@kindex C-M-z @r{(Incremental search)}
+@findex isearch-yank-until-char
+ Similarly, @kbd{C-M-z} (@code{isearch-yank-until-char}) appends to
+the search string everything from point until the next occurence of
+a specified character (not including that character). This is especially
+useful for keyboard macros, for example in programming languages or
+markup languages in which that character marks a token boundary.
+
@kindex C-y @r{(Incremental search)}
@kindex M-y @r{(Incremental search)}
@kindex mouse-2 @r{in the minibuffer (Incremental search)}
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 12caeaf..71e767d 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -457,6 +457,9 @@ Collapse the top-level Lisp form at point back to a single
line.
@item #
Toggle @code{print-circle} for the frame at point.
+@item :
+Toggle @code{print-gensym} for the frame at point.
+
@item .
Expand all the forms abbreviated with ``...'' in the frame at point.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 7c0a56d..3c3ee1f 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -25,7 +25,7 @@ that Emacs presents to the user.
* Fringes:: Controlling window fringes.
* Scroll Bars:: Controlling scroll bars.
* Window Dividers:: Separating windows visually.
-* Display Property:: Enabling special display features.
+* Display Property:: Images, margins, text size, etc.
* Images:: Displaying images in Emacs buffers.
* Xwidgets:: Displaying native widgets in Emacs buffers.
* Buttons:: Adding clickable buttons to Emacs buffers.
@@ -5016,7 +5016,9 @@ means no right marginal area.
Setting these variables does not immediately affect the window. These
variables are checked when a new buffer is displayed in the window.
Thus, you can make changes take effect by calling
-@code{set-window-buffer}.
+@code{set-window-buffer}. Do not use these variables to try to
+determine the current width of the left or right margin. Instead, use
+the function @code{window-margins}.
You can also set the margin widths immediately.
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 18a1f49..fba9622 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/doc/lispref/internals.texi b/doc/lispref/internals.texi
index f85c266..c52999e 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -533,9 +533,6 @@ be allocated for Lisp objects after one garbage collection
in order to
trigger another garbage collection. You can use the result returned by
@code{garbage-collect} to get an information about size of the particular
object type; space allocated to the contents of buffers does not count.
-Note that the subsequent garbage collection does not happen immediately
-when the threshold is exhausted, but only the next time the Lisp interpreter
-is called.
The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in
@file{alloc.c}. Since it's defined in @code{word_size} units, the value
@@ -562,6 +559,16 @@ increases. Thus, it can be desirable to do them less
frequently in
proportion.
@end defopt
+ Control over the garbage collector via @code{gc-cons-threshold} and
+@code{gc-cons-percentage} is only approximate. Although Emacs checks
+for threshold exhaustion regularly, for efficiency reasons it does not
+do so immediately after every change to the heap or to
+@code{gc-cons-threshold} or @code{gc-cons-percentage}, so exhausting
+the threshold does not immediately trigger garbage collection. Also,
+for efficency in threshold calculations Emacs approximates the heap
+size, which counts the bytes used by currently-accessible objects in
+the heap.
+
The value returned by @code{garbage-collect} describes the amount of
memory used by Lisp data, broken down by data type. By contrast, the
function @code{memory-limit} provides information on the total amount of
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 2088f16..1286b63 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
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index e5673da..a591b88 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -21,7 +21,7 @@ Copyright @copyright{} 1990, 1991, 1992 Joseph Brian Wells@*
@quotation
This list of frequently asked questions about GNU Emacs with answers
(``FAQ'') may be translated into other languages, transformed into other
-formats (e.g., Texinfo, Info, WWW, WAIS), and updated with new information.
+formats (e.g., Texinfo, Info, HTML, PDF), and updated with new information.
The same conditions apply to any derivative of the FAQ as apply to the FAQ
itself. Every copy of the FAQ must include this notice or an approved
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 131a358..8a1ba96 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -375,16 +375,13 @@ message as follows:
@item mm-inline-large-images
@vindex mm-inline-large-images
-When displaying inline images that are larger than the window, Emacs
-does not enable scrolling, which means that you cannot see the whole
-image. To prevent this, the library tries to determine the image size
-before displaying it inline, and if it doesn't fit the window, the
-library will display it externally (e.g., with @samp{ImageMagick} or
-@samp{xv}). Setting this variable to @code{t} disables this check and
-makes the library display all inline images as inline, regardless of
-their size. If you set this variable to @code{resize}, the image will
-be displayed resized to fit in the window, if Emacs has the ability to
-resize images.
+This variable is @code{resize} by default, which means that images
+that are bigger than the Emacs window are resized so that they fit.
+If you set this to @code{nil}, large images are not displayed in
+Emacs, but can instead be displayed externally (e.g., with
+@samp{ImageMagick} or @samp{xv}). Setting this variable to @code{t}
+disables this check and makes the library display all inline images as
+inline, regardless of their size.
@item mm-inline-large-images-proportion
@vindex mm-inline-images-max-proportion
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 28a5ecc..fb9581f 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -23682,7 +23682,7 @@ point your Web browser at
@uref{http://www.cs.indiana.edu/picons/ftp/index.html}.
If you are using Debian GNU/Linux, saying @samp{apt-get install
-picons.*} will install the picons where Gnus can find them.
+picon-.*} will install the picons where Gnus can find them.
To enable displaying picons, simply make sure that
@code{gnus-picon-databases} points to the directory containing the
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index b2fc90a..7fa7b24 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -372,6 +372,13 @@ implement support for common requirements.
@table @code
+@item smtpmail-retries
+@vindex smtpmail-retries
+An SMTP server may return an error code saying that there's a
+transient error (a @samp{4xx} code). In that case, smtpmail will try
+to resend the message automatically, and the number of times it tries
+before giving up is determined by this variable, which defaults to 10.
+
@item smtpmail-local-domain
@vindex smtpmail-local-domain
The variable @code{smtpmail-local-domain} controls the hostname sent
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index e6a454b..1ed334b 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1591,6 +1591,7 @@ via the @command{CONNECT} command (conforming to RFC
2616, 2817
specifications). Proxy servers using HTTP 1.1 or later protocol
support this command.
+
@subsection Tunneling with ssh
With ssh, you could use the @code{ProxyCommand} entry in
@@ -1609,6 +1610,7 @@ Any other program with such a feature could be used as
well.
In the example, opening @file{@trampfn{ssh,host.your.domain,}} passes
the HTTP proxy server @samp{proxy.your.domain} on port 3128.
+
@subsection Tunneling with PuTTY
PuTTY does not need an external program, HTTP tunnel support is
@@ -2092,6 +2094,33 @@ be recomputed. To force @value{tramp} to recompute
afresh, call
@node Remote shell setup
@section Remote shell setup hints
+
+
+@subsection Changing the default remote shell
+@cindex zsh setup
+
+Per default, @value{tramp} uses the command @command{/bin/sh} for
+strting a shell on the remote host. This can be changed by setting
+the connection property @option{remote-shell}, see @xref{Predefined
+connection information}. Other properties might be adapted as well,
+like @option{remote-shell-login} or @option{remote-shell-args}. If
+you want, for example, use @command{/usr/bin/zsh} on a remote host,
+you might apply
+
+@lisp
+@group
+(add-to-list 'tramp-connection-properties
+ (list (regexp-quote "@trampfn{ssh,user@@host,}")
+ "remote-shell" "/usr/bin/zsh"))
+@end group
+@end lisp
+
+This approach has also the advantage, that settings in
+@code{tramp-sh-extra-args} will be applied. For zsh, the trouble
+with the shell prompt due to set zle options will be avoided.
+
+
+@subsection Other remote shell setup hints
@cindex remote shell setup
@cindex @file{.profile} file
@cindex @file{.login} file
diff --git a/etc/HELLO b/etc/HELLO
index 39c3965..5102c59 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -79,7 +79,9 @@ Spanish
(espa</x-charset><x-charset><param>latin-iso8859-1</param>ñol) ¡Hola!
Swedish (svenska) Hej / Goddag / Hallå
</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Tamil (தமிழ்)
வணக்கம்
Telugu (తెలుగు) నమస్కారం
-</x-charset><x-charset><param>thai-tis620</param>Thai (ภาษาไทย)
สวัสดีครับ / สวัสดีค่ะ
+</x-charset>TaiViet (ꪁꪫꪱꪣ ꪼꪕ) ꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ
+
+<x-charset><param>thai-tis620</param>Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ
</x-charset><x-charset><param>tibetan</param>Tibetan (བོད་སྐད་)
བཀྲ་ཤིས་བདེ་ལེགས༎
</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Tigrigna (ትግርኛ)
ሰላማት
</x-charset><x-charset><param>latin-iso8859-9</param>Turkish (Türkçe) Merhaba
diff --git a/etc/NEWS b/etc/NEWS
index 8766674..f832210 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -196,10 +196,6 @@ the new version of the file again.)
** emacsclient
-*** emacsclient no longer passes '--eval' arguments to an alternate editor.
-Previously, '--eval' arguments were passed as file names to any
-alternate editor started by '--alternate-editor'.
-
+++
*** emacsclient now supports an 'EMACS_SOCKET_NAME' environment variable.
The command-line argument '--socket-name' overrides it.
@@ -743,6 +739,10 @@ file.
*** New customizable variable 'vc-find-revision-no-save'.
With non-nil, 'vc-find-revision' doesn't write the created buffer to file.
+---
+*** 'vc-dir-ignore' now takes a prefix argument to ignore all marked
+files.
+
*** New customizable variable 'vc-git-grep-template'.
This new variable allows customizing the default arguments passed to
'git-grep' when 'vc-git-grep' is used.
@@ -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.
@@ -1063,6 +1066,11 @@ See the concept index in the Gnus manual for the
'match-list' entry.
*** nil is no longer an allowed value for 'mm-text-html-renderer'.
+++
+The default value of 'mm-inline-large-images' has changed from nil to
+'resize', which means that large images will be resized instead of
+displayed with an external program by default.
+
++++
*** A new Gnus summary mode command, 'S A'
('gnus-summary-attach-article') can be used to attach the current
article(s) to a pre-existing Message buffer, or create a new Message
@@ -1157,6 +1165,11 @@ 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.
+
** Footnote mode
*** Support Hebrew-style footnotes
@@ -1255,6 +1268,11 @@ highlight in one iteration while processing the full
buffer.
+++
*** New isearch bindings.
+'C-M-z' invokes new function 'isearch-yank-until-char', which yanks
+everything from point up to but not including the specified
+character into the search string. This is especially useful for
+keyboard macros.
+
'C-M-w' in isearch changed from 'isearch-del-char' to the new function
'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to
'C-M-d'.
@@ -1370,6 +1388,10 @@ the Elisp manual for documentation of the new mode and
its commands.
dimensions, instead of always using 16 pixels. As a result, Tetris,
Snake and Pong are more playable on HiDPI displays.
+---
+*** 'gamegrid-add-score' can now sort scores from lower to higher.
+This is useful for games where lower scores are better, like time-based games.
+
** Filecache
---
@@ -1890,14 +1912,9 @@ and 'gravatar-force-default'.
** ada-mode
-*** The built-in ada-mode is now deleted. The Gnu ELPA package is a
+*** 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
@@ -1933,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
@@ -1987,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 searching /etc/firewalld results in an I/O error,
+(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
@@ -2421,6 +2449,13 @@ remote systems, which support this check.
** 'memory-limit' now returns a better estimate of memory consumption.
+++
+** When interpreting 'gc-cons-percentage', Emacs now estimates the
+heap size more often and (we hope) more accurately. E.g., formerly
+(progn (let ((gc-cons-percentage 0.8)) BODY1) BODY2) continued to use
+the 0.8 value during BODY2 until the next garbage collection, but that
+is no longer true. Applications may need to re-tune their GC tricks.
+
++++
** New macro 'combine-change-calls' arranges to call the change hooks
('before-change-functions' and 'after-change-functions') just once
each around a sequence of lisp forms, given a region. This is
@@ -2679,6 +2714,14 @@ 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
drop behaviour more consistent, as previously the sending application
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index e9469f7..65effc6 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -700,11 +700,7 @@ fail (void)
{
if (alternate_editor)
{
- /* If the user has said --eval, then those aren't file name
- parameters, so don't put them on the alternate_editor command
- line. */
- size_t extra_args_size =
- (eval? 0: (main_argc - optind + 1) * sizeof (char *));
+ size_t extra_args_size = (main_argc - optind + 1) * sizeof (char *);
size_t new_argv_size = extra_args_size;
char **new_argv = xmalloc (new_argv_size);
char *s = xstrdup (alternate_editor);
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index ba8efd4..37e10e8 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1097,7 +1097,7 @@ Redefine the corresponding command."
(or func (setq func (and cmd (symbolp cmd) (fboundp cmd) cmd)))
(if (get func 'math-compose-forms)
(let ((pt (point)))
- (insert "(put '" (symbol-name cmd)
+ (insert "(put '" (symbol-name func)
" 'math-compose-forms '"
(prin1-to-string (get func 'math-compose-forms))
")\n")
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 8a8bad9..2496963 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -2212,7 +2212,12 @@ and `face'."
(unless (eq state 'modified)
(unless (memq state '(nil unknown hidden))
(widget-put widget :custom-state 'modified))
- (custom-magic-reset widget)
+ ;; Update the status text (usually from "STANDARD" to "EDITED
+ ;; bla bla" in the buffer after the command has run. Otherwise
+ ;; commands like `M-u' (that work on a region in the buffer)
+ ;; will upcase the wrong part of the buffer, since more text has
+ ;; been inserted before point.
+ (run-with-idle-timer 0.0 nil #'custom-magic-reset widget)
(apply 'widget-default-notify widget args))))
(defun custom-redraw (widget)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index a2dbd40..ce28271 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -398,9 +398,8 @@ FILE's name."
;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
;; which was designed to handle CVSREAD=1 and equivalent.
(and autoload-ensure-writable
- (file-exists-p file)
(let ((modes (file-modes file)))
- (if (zerop (logand modes #o0200))
+ (if (and modes (zerop (logand modes #o0200)))
;; Ignore any errors here, and let subsequent attempts
;; to write the file raise any real error.
(ignore-errors (set-file-modes file (logior modes #o0200))))))
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 60d146e..0c4c798 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -175,7 +175,8 @@ This should be a list of `backtrace-frame' objects.")
(defvar-local backtrace-view nil
"A plist describing how to render backtrace frames.
-Possible entries are :show-flags, :show-locals and :print-circle.")
+Possible entries are :show-flags, :show-locals, :print-circle
+and :print-gensym.")
(defvar-local backtrace-insert-header-function nil
"Function for inserting a header for the current Backtrace buffer.
@@ -205,6 +206,7 @@ frames where the source code location is known.")
(define-key map "p" 'backtrace-backward-frame)
(define-key map "v" 'backtrace-toggle-locals)
(define-key map "#" 'backtrace-toggle-print-circle)
+ (define-key map ":" 'backtrace-toggle-print-gensym)
(define-key map "s" 'backtrace-goto-source)
(define-key map "\C-m" 'backtrace-help-follow-symbol)
(define-key map "+" 'backtrace-multi-line)
@@ -224,6 +226,18 @@ frames where the source code location is known.")
:active (backtrace-get-index)
:selected (plist-get (backtrace-get-view) :show-locals)
:help "Show or hide the local variables for the frame at point"]
+ ["Show Circular Structures" backtrace-toggle-print-circle
+ :style toggle
+ :active (backtrace-get-index)
+ :selected (plist-get (backtrace-get-view) :print-circle)
+ :help
+ "Condense or expand shared or circular structures in the frame at
point"]
+ ["Show Uninterned Symbols" backtrace-toggle-print-gensym
+ :style toggle
+ :active (backtrace-get-index)
+ :selected (plist-get (backtrace-get-view) :print-gensym)
+ :help
+ "Toggle unique printing of uninterned symbols in the frame at point"]
["Expand \"...\"s" backtrace-expand-ellipses
:help "Expand all the abbreviated forms in the current frame"]
["Show on Multiple Lines" backtrace-multi-line
@@ -339,6 +353,7 @@ It runs `backtrace-revert-hook', then calls
`backtrace-print'."
`(let ((print-escape-control-characters t)
(print-escape-newlines t)
(print-circle (plist-get ,view :print-circle))
+ (print-gensym (plist-get ,view :print-gensym))
(standard-output (current-buffer)))
,@body))
@@ -420,12 +435,18 @@ Set it to VALUE unless the button is a
`backtrace-ellipsis' button."
(defun backtrace-toggle-print-circle (&optional all)
"Toggle `print-circle' for the backtrace frame at point.
-With prefix argument ALL, toggle the value of :print-circle in
-`backtrace-view', which affects all of the backtrace frames in
-the buffer."
+With prefix argument ALL, toggle the default value bound to
+`print-circle' for all the frames in the buffer."
(interactive "P")
(backtrace--toggle-feature :print-circle all))
+(defun backtrace-toggle-print-gensym (&optional all)
+ "Toggle `print-gensym' for the backtrace frame at point.
+With prefix argument ALL, toggle the default value bound to
+`print-gensym' for all the frames in the buffer."
+ (interactive "P")
+ (backtrace--toggle-feature :print-gensym all))
+
(defun backtrace--toggle-feature (feature all)
"Toggle FEATURE for the current backtrace frame or for the buffer.
FEATURE should be one of the options in `backtrace-view'. If ALL
@@ -450,12 +471,15 @@ position point at the start of the frame it was in
before."
(goto-char (point-min))
(while (and (not (eql index (backtrace-get-index)))
(< (point) (point-max)))
- (goto-char (backtrace-get-frame-end)))))
- (let ((index (backtrace-get-index)))
- (unless index
- (user-error "Not in a stack frame"))
- (backtrace--set-feature feature
- (not (plist-get (backtrace-get-view)
feature))))))
+ (goto-char (backtrace-get-frame-end))))
+ (message "%s is now %s for all frames"
+ (substring (symbol-name feature) 1) value))
+ (unless (backtrace-get-index)
+ (user-error "Not in a stack frame"))
+ (let ((value (not (plist-get (backtrace-get-view) feature))))
+ (backtrace--set-feature feature value)
+ (message "%s is now %s for this frame"
+ (substring (symbol-name feature) 1) value))))
(defun backtrace--set-feature (feature value)
"Set FEATURE in the view plist of the frame at point to VALUE.
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5fe3dd1..5307701 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -548,21 +548,22 @@ limit."
;; call_debugger (bug#31919).
(let* ((print-length (when limit (min limit 50)))
(print-level (when limit (min 8 (truncate (log limit)))))
- (delta (when limit
- (max 1 (truncate (/ print-length print-level))))))
+ (delta-length (when limit
+ (max 1 (truncate (/ print-length print-level))))))
(with-temp-buffer
(catch 'done
(while t
(erase-buffer)
(funcall print-function value (current-buffer))
- ;; Stop when either print-level is too low or the value is
- ;; successfully printed in the space allowed.
- (when (or (not limit)
- (< (- (point-max) (point-min)) limit)
- (= print-level 2))
- (throw 'done (buffer-string)))
- (cl-decf print-level)
- (cl-decf print-length delta))))))
+ (let ((result (- (point-max) (point-min))))
+ ;; Stop when either print-level is too low or the value is
+ ;; successfully printed in the space allowed.
+ (when (or (not limit) (< result limit) (<= print-level 2))
+ (throw 'done (buffer-string)))
+ (let* ((ratio (/ result limit))
+ (delta-level (max 1 (min (- print-level 2) ratio))))
+ (cl-decf print-level delta-level)
+ (cl-decf print-length (* delta-length delta-level)))))))))
(provide 'cl-print)
;;; cl-print.el ends here
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 521edbe..0f5c92c 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -1,4 +1,4 @@
-;;; viper.el --- A full-featured Vi emulator for Emacs and XEmacs,
-*-lexical-binding:t -*-
+;;; viper.el --- A full-featured Vi emulator for Emacs -*- lexical-binding:t
-*-
;; a VI Plan for Emacs Rescue,
;; and a venomous VI PERil.
;; Viper Is also a Package for Emacs Rebels.
@@ -34,7 +34,7 @@
;;; Commentary:
-;; Viper is a full-featured Vi emulator for Emacs and XEmacs. It emulates and
+;; Viper is a full-featured Vi emulator for Emacs. It emulates and
;; improves upon the standard features of Vi and, at the same time, allows
;; full access to all Emacs facilities. Viper supports multiple undo,
;; file name completion, command, file, and search history and it extends
@@ -541,7 +541,7 @@ If Viper is enabled, turn it off. Otherwise, turn it on."
"Viper Is a Package for Emacs Rebels,
a VI Plan for Emacs Rescue, and a venomous VI PERil.
-Incidentally, Viper emulates Vi under Emacs/XEmacs 20.
+Incidentally, Viper emulates Vi under Emacs.
It supports all of what is good in Vi and Ex, while extending
and improving upon much of it.
diff --git a/lisp/files.el b/lisp/files.el
index ce4dd99..5ceaacd 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2554,13 +2554,13 @@ unless NOMODES is non-nil."
(auto-save-mode 1)))
;; Make people do a little extra work (C-x C-q)
;; before altering a backup file.
- (when (backup-file-name-p buffer-file-name)
- (setq buffer-read-only t))
;; When a file is marked read-only,
;; make the buffer read-only even if root is looking at it.
- (when (and (file-modes (buffer-file-name))
- (zerop (logand (file-modes (buffer-file-name)) #o222)))
- (setq buffer-read-only t))
+ (unless buffer-read-only
+ (when (or (backup-file-name-p buffer-file-name)
+ (let ((modes (file-modes (buffer-file-name))))
+ (and modes (zerop (logand modes #o222)))))
+ (setq buffer-read-only t)))
(unless nomodes
(when (and view-read-only view-mode)
(view-mode -1))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index e8775c6..cb369f0 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -897,9 +897,8 @@ If REGEXP is given, lines that match it will be deleted."
(set-buffer-modified-p t))
;; Set the file modes to reflect the .newsrc file modes.
(save-buffer)
- (when (and (file-exists-p gnus-current-startup-file)
- (file-exists-p dribble-file)
- (setq modes (file-modes gnus-current-startup-file)))
+ (when (and (setq modes (file-modes gnus-current-startup-file))
+ (file-exists-p dribble-file))
(gnus-set-file-modes dribble-file modes))
(goto-char (point-min))
(when (search-forward "Gnus was exited on purpose" nil t)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index cba9633..5636b8e 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -381,9 +381,11 @@ enables you to choose manually one of two types those
mails include."
:type 'directory
:group 'mime-display)
-(defcustom mm-inline-large-images nil
- "If t, then all images fit in the buffer.
-If `resize', try to resize the images so they fit."
+(defcustom mm-inline-large-images 'resize
+ "If nil, images larger than the window aren't displayed in the buffer.
+If `resize', try to resize the images so they fit in the buffer.
+If t, show the images as they are without resizing."
+ :version "27.1"
:type '(radio
(const :tag "Inline large images as they are." t)
(const :tag "Resize large images." resize)
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 6ffa1fc..02d9920 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -65,8 +65,9 @@
:group 'mime-display)
(defcustom mm-inline-large-images-proportion 0.9
- "Maximum proportion of large image resized when
-`mm-inline-large-images' is set to resize."
+ "Maximum proportion large images can occupy in the buffer.
+This is only used if `mm-inline-large-images' is set to
+`resize'."
:type 'float
:version "24.1"
:group 'mime-display)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index fb29bd2..efc0b8f 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -59,7 +59,7 @@
["Next Topic" help-go-forward
:help "Go back to next topic in this help buffer"]
["Move to Previous Button" backward-button
- :help "Move to the Next Button in the help buffer"]
+ :help "Move to the Previous Button in the help buffer"]
["Move to Next Button" forward-button
:help "Move to the Next Button in the help buffer"]))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index b8442be..c1aaab5 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1938,9 +1938,9 @@ adding an extension of `hfy-extn'. Fontification is
actually done by
(set-buffer html)
(write-file (concat target hfy-extn))
(kill-buffer html))
- ;; #o0200 == 128, but emacs20 doesn't know that
- (if (and (file-exists-p target) (not (file-writable-p target)))
- (set-file-modes target (logior (file-modes target) 128)))
+ (let ((modes (file-modes target)))
+ (if (and modes (not (file-writable-p target)))
+ (set-file-modes target (logior modes #o0200))))
(copy-file (buffer-file-name source) target 'overwrite))
(kill-buffer source)) ))
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 5084fe6..9df597b 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -510,8 +510,9 @@ See `imenu--index-alist' for the format of the index alist."
"No items suitable for an index found in this buffer"))
(or imenu--index-alist
(setq imenu--index-alist (list nil)))
- ;; Add a rescan option to the index.
- (cons imenu--rescan-item imenu--index-alist))
+ (unless imenu-auto-rescan
+ ;; Add a rescan option to the index.
+ (cons imenu--rescan-item imenu--index-alist)))
(defvar imenu--cleanup-seen nil)
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index f3ab816..1debec7 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/international/iso-transl.el b/lisp/international/iso-transl.el
index b573e1e..3530e6f 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -177,6 +177,8 @@
("c" . [?¢])
("*o" . [?°])
("o" . [?°])
+ ("Oe" . [?œ])
+ ("OE" . [?Œ])
("*u" . [?µ])
("u" . [?µ])
("*m" . [?µ])
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 30f7fc7..9401e8c 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -514,6 +514,9 @@ This is like `describe-bindings', but displays only Isearch
keys."
(define-key map [isearch-yank-kill]
'(menu-item "Current kill" isearch-yank-kill
:help "Append current kill to search string"))
+ (define-key map [isearch-yank-until-char]
+ '(menu-item "Until char..." isearch-yank-until-char
+ :help "Yank from point to specified character into search
string"))
(define-key map [isearch-yank-line]
'(menu-item "Rest of line" isearch-yank-line
:help "Yank the rest of the current line on search string"))
@@ -705,6 +708,7 @@ This is like `describe-bindings', but displays only Isearch
keys."
(define-key map "\M-\C-d" 'isearch-del-char)
(define-key map "\M-\C-y" 'isearch-yank-char)
(define-key map "\C-y" 'isearch-yank-kill)
+ (define-key map "\M-\C-z" 'isearch-yank-until-char)
(define-key map "\M-s\C-e" 'isearch-yank-line)
(define-key map "\M-s\M-<" 'isearch-beginning-of-buffer)
@@ -998,6 +1002,8 @@ Type \\[isearch-yank-word-or-char] to yank next word or
character in buffer
Type \\[isearch-del-char] to delete character from end of search string.
Type \\[isearch-yank-char] to yank char from buffer onto end of search\
string and search for it.
+Type \\[isearch-yank-until-char] to yank from point until the next instance of
a
+ specified character onto end of search string and search for it.
Type \\[isearch-yank-line] to yank rest of line onto end of search string\
and search for it.
Type \\[isearch-yank-kill] to yank the last string of killed text.
@@ -2562,6 +2568,23 @@ If optional ARG is non-nil, pull in the next ARG words."
(interactive "p")
(isearch-yank-internal (lambda () (forward-word arg) (point))))
+(defun isearch-yank-until-char (char)
+ "Pull everything until next instance of CHAR from buffer into search string.
+Interactively, prompt for CHAR.
+This is often useful for keyboard macros, for example in programming
+languages or markup languages in which CHAR marks a token boundary."
+ (interactive "cYank until character: ")
+ (isearch-yank-internal
+ (lambda () (let ((inhibit-field-text-motion t))
+ (condition-case nil
+ (progn
+ (search-forward (char-to-string char))
+ (forward-char -1))
+ (search-failed
+ (message "`%c' not found" char)
+ (sit-for 2)))
+ (point)))))
+
(defun isearch-yank-line (&optional arg)
"Pull rest of line from buffer into search string.
If optional ARG is non-nil, yank the next ARG lines."
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index b202abf..086483d 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -39,21 +39,20 @@
(input-method . "tai-sonla")
(sample-text . "TaiViet (ꪁꪫꪱꪣ ꪼꪕ)\t\tꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ")
(documentation . "\
-TaiViet refers to the Tai language used by Tai people in
-Vietnam, and also refers to the script used for this language.
-Both the script and language have the same origin as that of Thai
+TaiViet refers to the Tai script, which is used to write several
+Tai languages of northwestern Vietnam and surrounding areas. These
+languages are Tai Dam (also known as Black Tai or Tai Noir),
+Tai Dón (also known as White Tai or Tai Blanc), Tày Tac,
+Tai Daeng (also known as Red Tai or Tai Rouge),
+and Thai Song (also known as Lao Song). However, some people
+consider Tai Dam, Tai Dón and Tai Daeng to be dialects of the
+same language, and call them collectively \"Tai Viet\".
+
+Both the script and languages have the same origin as that of Thai
language/script used in Thailand, but now they differ from each
other in a significant way (especially the scripts are).
The language name is spelled as \"ꪁꪫꪱꪣ ꪼꪕ\", and the script name is
-spelled as \"ꪎ ꪼꪕ\" in the modern form, \"ꪎꪳ ꪼꪕ\" in the traditional
-form.
-
-As the proposal for TaiViet script to the Unicode is still on
-the progress, we use the Private Use Area for TaiViet
-characters (U+F000..U+F07E). A TaiViet font encoded accordingly
-is available at this web page:
- http://www.m17n.org/viettai/
-")))
+spelled as \"ꪎꪳ ꪼꪕ\".")))
(provide 'tai-viet)
diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el
index 74a2dcc..169dbcf 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
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index babc3fc..b362614 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -17,15 +17,6 @@
;; ability to queue messages for later sending. This replaces
;; the standalone fakemail program that used to be distributed with Emacs.
-;; feedmail works with recent versions of Emacs (20.x series) and
-;; XEmacs (tested with 20.4 and later betas). It probably no longer
-;; works with Emacs v18, though I haven't tried that in a long
-;; time. address@hidden reports: "I have a report
-;; that with a help of APEL library, feedmail works fine under emacs
-;; 19.28. You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/.
-;; you need apel-10.2 or later to make feedmail work under emacs
-;; 19.28."
-
;; Sorry, no manual yet in this release. Look for one with the next
;; release. Or the one after that. Or maybe later.
@@ -437,9 +428,7 @@ shuttled robotically onward."
(defcustom feedmail-confirm-outgoing-timeout nil
"If non-nil, a timeout in seconds at the send confirmation prompt.
If a positive number, it's a timeout before sending. If a negative
-number, it's a timeout before not sending. This will not work if your
-version of Emacs doesn't include the function `y-or-n-p-with-timeout'
-\(e.g., some versions of XEmacs)."
+number, it's a timeout before not sending."
:version "24.1"
:group 'feedmail-misc
:type '(choice (const nil) integer)
@@ -2004,9 +1993,7 @@ backup file names and the like)."
((feedmail-fqm-p blobby)
(setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
(setq already-buffer
- (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
- (find-buffer-visiting maybe-file)
- (get-file-buffer maybe-file)))
+ (find-buffer-visiting maybe-file))
(if (and already-buffer (buffer-modified-p already-buffer))
(save-window-excursion
(display-buffer (set-buffer already-buffer))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index f6fd1cd..802c9ba 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -165,6 +165,13 @@ attempt."
:type '(choice regexp (const :tag "None" nil))
:version "27.1")
+(defcustom smtpmail-retries 10
+ "The number of times smtpmail will retry sending when getting transient
errors.
+These are errors with a code of 4xx from the SMTP server, which
+mean \"try again\"."
+ :type 'integer
+ :version "27.1")
+
;; End of customizable variables.
@@ -654,10 +661,12 @@ Returns an error if the server cannot be contacted."
user-mail-address))))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
- &optional ask-for-password)
+ &optional ask-for-password
+ send-attempts)
(unless smtpmail-smtp-server
(smtpmail-query-smtp-server))
(let ((process nil)
+ (send-attempts (or send-attempts 1))
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
(port smtpmail-smtp-service)
@@ -819,6 +828,23 @@ Returns an error if the server cannot be contacted."
((smtpmail-ok-p (setq result (smtpmail-read-response process)))
;; Success.
)
+ ((and (numberp (car result))
+ (<= 400 (car result) 499)
+ (< send-attempts smtpmail-retries))
+ (message "Got transient error code %s when sending; retrying
attempt %d..."
+ (car result) send-attempts)
+ ;; Retry on getting a transient 4xx code; see
+ ;; https://tools.ietf.org/html/rfc5321#section-4.2.1
+ (ignore-errors
+ (smtpmail-send-command process "QUIT")
+ (smtpmail-read-response process))
+ (delete-process process)
+ (sleep-for 1)
+ (setq process nil)
+ (throw 'done
+ (smtpmail-via-smtp recipient smtpmail-text-buffer
+ ask-for-password
+ (1+ send-attempts))))
((and auth-mechanisms
(not ask-for-password)
(eq (car result) 530))
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index c017419..0f15d3e 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -270,10 +270,16 @@ MH-E functions."
(declare (debug let) (indent 1))
;; Works in both lexical and non-lexical mode.
`(progn
- ,@(mapcar (lambda (binder)
- `(defvar ,(if (consp binder) (car binder) binder)))
- binders)
- (let* ,binders ,@body)))
+ (with-suppressed-warnings ((lexical
+ ,@(mapcar (lambda (binder)
+ (if (consp binder)
+ (car binder)
+ binder))
+ binders)))
+ ,@(mapcar (lambda (binder)
+ `(defvar ,(if (consp binder) (car binder) binder)))
+ binders)
+ (let* ,binders ,@body))))
(provide 'mh-acros)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 77e6cec..fb495a9 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -326,6 +326,18 @@ the default EWW buffer."
#'url-hexify-string (split-string url) "+"))))))
url)
+(defun eww--preprocess-html (start end)
+ "Translate all < characters that do not look like start of tags into <."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (let ((case-fold-search t))
+ (while (re-search-forward "<[^0-9a-z!/]" nil t)
+ (goto-char (match-beginning 0))
+ (delete-region (point) (1+ (point)))
+ (insert "<"))))))
+
;;;###autoload (defalias 'browse-web 'eww)
;;;###autoload
@@ -479,6 +491,7 @@ Currently this means either text/html or
application/xhtml+xml."
;; Remove CRLF and replace NUL with � before parsing.
(while (re-search-forward "\\(\r$\\)\\|\0" nil t)
(replace-match (if (match-beginning 1) "" "�") t t)))
+ (eww--preprocess-html (point) (point-max))
(libxml-parse-html-region (point) (point-max))))))
(source (and (null document)
(buffer-substring (point) (point-max)))))
@@ -716,6 +729,7 @@ the like."
(condition-case nil
(decode-coding-region (point-min) (point-max) 'utf-8)
(coding-system-error nil))
+ (eww--preprocess-html (point-min) (point-max))
(libxml-parse-html-region (point-min) (point-max))))
(base (plist-get eww-data :url)))
(eww-score-readability dom)
@@ -1433,15 +1447,15 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(push (cons name (plist-get input :value))
values)))
((equal (plist-get input :type) "file")
- (push (cons "file"
- (list (cons "filedata"
- (with-temp-buffer
- (insert-file-contents
- (plist-get input :filename))
- (buffer-string)))
- (cons "name" (plist-get input :name))
- (cons "filename" (plist-get input :filename))))
- values))
+ (when-let ((file (plist-get input :filename)))
+ (push (list "file"
+ (cons "filedata"
+ (with-temp-buffer
+ (insert-file-contents file)
+ (buffer-string)))
+ (cons "name" name)
+ (cons "filename" file))
+ values)))
((equal (plist-get input :type) "submit")
;; We want the values from buttons if we hit a button if
;; we hit enter on it, or if it's the first button after
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 4f68e5d..03ed4a5 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
diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el
index 5de8401..fadc979 100644
--- a/lisp/net/rfc2104.el
+++ b/lisp/net/rfc2104.el
@@ -37,8 +37,6 @@
;; 64 is block length of hash function (64 for MD5 and SHA), 16 is
;; resulting hash length (16 for MD5, 20 for SHA).
;;
-;; Tested with Emacs 20.2 and XEmacs 20.3.
-;;
;; Test case reference: RFC 2202.
;;; History:
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 81c3fb4..1dff129 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1180,8 +1180,24 @@ Return a string with image data."
;; so glitches may occur during this transformation.
(shr-dom-to-xml
(libxml-parse-xml-region (point) (point-max)))))
+ ;; SVG images often do not have a specified foreground/background
+ ;; color, so wrap them in styles.
+ (when (eq content-type 'image/svg+xml)
+ (setq data (svg--wrap-svg data)))
(list data content-type)))
+(defun svg--wrap-svg (data)
+ "Add a default foreground colour to SVG images."
+ (with-temp-buffer
+ (insert "<svg xmlns:xlink=\"http://www.w3.org/1999/xlink\"; "
+ "xmlns:xi=\"http://www.w3.org/2001/XInclude\"; "
+ "style=\"color: "
+ (face-foreground 'default) ";\">"
+ "<xi:include href=\"data:image/svg+xml;base64,"
+ (base64-encode-string data t)
+ "\"></xi:include></svg>")
+ (buffer-string)))
+
(defun shr-image-displayer (content-function)
"Return a function to display an image.
CONTENT-FUNCTION is a function to retrieve an image for a cid url that
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index df4778c..982522b 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1191,6 +1191,10 @@ FMT and ARGS are passed to `error'."
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
(let* ((buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf))
(host (tramp-file-name-host vec))
@@ -1204,14 +1208,6 @@ connection if a previous connection has died for some
reason."
(tramp-error vec 'file-error "Cannot switch to user `%s'" user))
(unless (process-live-p p)
- ;; During completion, don't reopen a new connection. We check
- ;; this for the process related to `tramp-buffer-name';
- ;; otherwise `start-file-process' wouldn't run ever when
- ;; `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
(save-match-data
(when (and p (processp p)) (delete-process p))
(if (zerop (length device))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index b9b6b4b..1036865 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1787,6 +1787,10 @@ This is relevant for GNOME Online Accounts."
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
;; We set the file name, in case there are incoming D-Bus signals or
;; D-Bus errors.
(setq tramp-gvfs-dbus-event-vector vec)
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 866e779..1f0c7ea 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -520,19 +520,14 @@ file names."
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
(let ((host (tramp-file-name-host vec)))
(when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
(if (zerop (length host))
(tramp-error vec 'file-error "Storage %s not connected" host))
-
- ;; During completion, don't reopen a new connection. We check
- ;; this for the process related to `tramp-buffer-name';
- ;; otherwise `start-file-process' wouldn't run ever when
- ;; `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
;; We need a process bound to the connection buffer. Therefore,
;; we create a dummy process. Maybe there is a better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index bcfac78..8092f6a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -525,7 +525,9 @@ based on the Tramp and Emacs versions, and should not be
set here."
:type '(repeat string))
;;;###tramp-autoload
-(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
+(defcustom tramp-sh-extra-args
+ '(("/bash\\'" . "-norc -noprofile")
+ ("/zsh\\'" . "-f +Z"))
"Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
matching the shell file name and ARGS is a string specifying the
@@ -1198,18 +1200,22 @@ component is used as the target of the symlink."
(defun tramp-sh-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-exists-p"
- (or (not (null (tramp-get-file-property
- v localname "file-attributes-integer" nil)))
- (not (null (tramp-get-file-property
- v localname "file-attributes-string" nil)))
- (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (tramp-get-file-exists-command v)
- (tramp-shell-quote-argument localname)))))))
+ ;; `file-exists-p' is used as predicate in file name completion.
+ ;; We don't want to run it when `non-essential' is t, or there is
+ ;; no connection process yet.
+ (when (tramp-connectable-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (or (not (null (tramp-get-file-property
+ v localname "file-attributes-integer" nil)))
+ (not (null (tramp-get-file-property
+ v localname "file-attributes-string" nil)))
+ (tramp-send-command-and-check
+ v
+ (format
+ "%s %s"
+ (tramp-get-file-exists-command v)
+ (tramp-shell-quote-argument localname))))))))
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -4762,6 +4768,10 @@ If there is just some editing, retry it after 5 seconds."
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
(let ((p (tramp-get-connection-process vec))
(process-name (tramp-get-connection-property vec "process-name" nil))
(process-environment (copy-sequence process-environment))
@@ -4806,15 +4816,6 @@ connection if a previous connection has died for some
reason."
;; New connection must be opened.
(condition-case err
(unless (process-live-p p)
-
- ;; During completion, don't reopen a new connection. We
- ;; check this for the process related to
- ;; `tramp-buffer-name'; otherwise `start-file-process'
- ;; wouldn't run ever when `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
(with-tramp-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 5df26a1..b008e6b 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -832,12 +832,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Implement `file-attributes' for Tramp files using stat command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (let* (size id link uid gid atime mtime ctime mode inode)
- (when (tramp-smb-send-command
- vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
+ (let* (size id link uid gid atime mtime ctime mode inode)
+ (when (tramp-smb-send-command
+ vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
- ;; Loop the listing.
+ ;; Loop the listing.
+ (with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(unless (re-search-forward tramp-smb-errors nil t)
(while (not (eobp))
@@ -1628,40 +1628,40 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME
YEAR)."
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
(with-tramp-file-property v localname "file-entries"
- (with-current-buffer (tramp-get-connection-buffer v)
- (let* ((share (tramp-smb-get-share v))
- (cache (tramp-get-connection-property v "share-cache" nil))
- res entry)
-
- (if (and (not share) cache)
- ;; Return cached shares.
- (setq res cache)
-
- ;; Read entries.
- (if share
- (tramp-smb-send-command
- v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
- ;; `tramp-smb-maybe-open-connection' lists also the share names.
- (tramp-smb-maybe-open-connection v))
-
- ;; Loop the listing.
+ (let* ((share (tramp-smb-get-share v))
+ (cache (tramp-get-connection-property v "share-cache" nil))
+ res entry)
+
+ (if (and (not share) cache)
+ ;; Return cached shares.
+ (setq res cache)
+
+ ;; Read entries.
+ (if share
+ (tramp-smb-send-command
+ v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
+ ;; `tramp-smb-maybe-open-connection' lists also the share names.
+ (tramp-smb-maybe-open-connection v))
+
+ ;; Loop the listing.
+ (with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(if (re-search-forward tramp-smb-errors nil t)
(tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
(while (not (eobp))
(setq entry (tramp-smb-read-file-entry share))
(forward-line)
- (when entry (push entry res))))
+ (when entry (push entry res)))))
- ;; Cache share entries.
- (unless share
- (tramp-set-connection-property v "share-cache" res)))
+ ;; Cache share entries.
+ (unless share
+ (tramp-set-connection-property v "share-cache" res)))
- ;; Add directory itself.
- (push '("" "drwxrwxrwx" 0 (0 0)) res)
+ ;; Add directory itself.
+ (push '("" "drwxrwxrwx" 0 (0 0)) res)
- ;; Return entries.
- (delq nil res))))))
+ ;; Return entries.
+ (delq nil res)))))
;; Return either a share name (if SHARE is nil), or a file name.
;;
@@ -1855,6 +1855,10 @@ Does not do anything if a connection is already open,
but re-opens the
connection if a previous connection has died for some reason.
If ARGUMENT is non-nil, use it as argument for
`tramp-smb-winexe-program', and suppress any checks."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
(let* ((share (tramp-smb-get-share vec))
(buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf)))
@@ -1909,15 +1913,6 @@ If ARGUMENT is non-nil, use it as argument for
(string-equal
share
(tramp-get-connection-property p "smb-share" ""))))
-
- ;; During completion, don't reopen a new connection. We
- ;; check this for the process related to
- ;; `tramp-buffer-name'; otherwise `start-file-process'
- ;; wouldn't run ever when `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
(save-match-data
;; There might be unread output from checking for share names.
(when buf (with-current-buffer buf (erase-buffer)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 80ce8f7..bfc9b3b 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -424,10 +424,14 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-exists-p"
- (tramp-sudoedit-send-command
- v "test" "-e" (tramp-compat-file-name-unquote localname)))))
+ ;; `file-exists-p' is used as predicate in file name completion.
+ ;; We don't want to run it when `non-essential' is t, or there is
+ ;; no connection process yet.
+ (when (tramp-connectable-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (tramp-sudoedit-send-command
+ v "test" "-e" (tramp-compat-file-name-unquote localname))))))
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@@ -760,18 +764,13 @@ Remove unneeded output."
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
;; We need a process bound to the connection buffer. Therefore, we
;; create a dummy process. Maybe there is a better solution?
(unless (tramp-get-connection-process vec)
-
- ;; During completion, don't reopen a new connection. We check
- ;; this for the process related to `tramp-buffer-name'; otherwise
- ;; `start-file-process' wouldn't run ever when `non-essential' is
- ;; non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
(let ((p (make-network-process
:name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index ed0f1de..aefb84b 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1566,25 +1566,27 @@ necessary only. This function will be used in file
name completion."
tramp-postfix-host-format))
(when localname localname)))
-(defun tramp-get-buffer (vec)
+(defun tramp-get-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC."
(or (get-buffer (tramp-buffer-name vec))
- (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
- ;; We use the existence of connection property "process-buffer"
- ;; as indication, whether a connection is active.
- (tramp-set-connection-property
- vec "process-buffer"
- (tramp-get-connection-property vec "process-buffer" nil))
- (setq buffer-undo-list t
- default-directory (tramp-make-tramp-file-name vec 'noloc 'nohop))
- (current-buffer))))
-
-(defun tramp-get-connection-buffer (vec)
+ (unless dont-create
+ (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
+ ;; We use the existence of connection property "process-buffer"
+ ;; as indication, whether a connection is active.
+ (tramp-set-connection-property
+ vec "process-buffer"
+ (tramp-get-connection-property vec "process-buffer" nil))
+ (setq buffer-undo-list t
+ default-directory
+ (tramp-make-tramp-file-name vec 'noloc 'nohop))
+ (current-buffer)))))
+
+(defun tramp-get-connection-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC.
In case a second asynchronous communication has been started, it is different
from `tramp-get-buffer'."
(or (tramp-get-connection-property vec "process-buffer" nil)
- (tramp-get-buffer vec)))
+ (tramp-get-buffer vec dont-create)))
(defun tramp-get-connection-name (vec)
"Get the connection name to be used for VEC.
@@ -1770,14 +1772,15 @@ applicable)."
;; Log only when there is a minimum level.
(when (>= tramp-verbose 4)
(let ((tramp-verbose 0))
- ;; Append connection buffer for error messages.
+ ;; Append connection buffer for error messages, if exists.
(when (= level 1)
- (with-current-buffer
- (if (processp vec-or-proc)
- (process-buffer vec-or-proc)
- (tramp-get-connection-buffer vec-or-proc))
- (setq fmt-string (concat fmt-string "\n%s")
- arguments (append arguments (list (buffer-string))))))
+ (ignore-errors
+ (with-current-buffer
+ (if (processp vec-or-proc)
+ (process-buffer vec-or-proc)
+ (tramp-get-connection-buffer vec-or-proc 'dont-create))
+ (setq fmt-string (concat fmt-string "\n%s")
+ arguments (append arguments (list (buffer-string)))))))
;; Translate proc to vec.
(when (processp vec-or-proc)
(setq vec-or-proc (process-get vec-or-proc 'vector))))
@@ -2517,16 +2520,21 @@ Add operations defined in `HANDLER-alist' to
`tramp-file-name-handler'."
;; This variable has been obsoleted in Emacs 26.
tramp-completion-mode))
-(defun tramp-connectable-p (filename)
+(defun tramp-connectable-p (vec-or-filename)
"Check, whether it is possible to connect the remote host w/o side-effects.
This is true, if either the remote host is already connected, or if we are
not in completion mode."
- (let (tramp-verbose)
- (and (tramp-tramp-file-p filename)
- (or (not (tramp-completion-mode-p))
- (process-live-p
- (tramp-get-connection-process
- (tramp-dissect-file-name filename)))))))
+ (let (tramp-verbose
+ (vec
+ (cond
+ ((tramp-file-name-p vec-or-filename) vec-or-filename)
+ ((tramp-tramp-file-p vec-or-filename)
+ (tramp-dissect-file-name vec-or-filename)))))
+ (or ;; We check this for the process related to
+ ;; `tramp-buffer-name'; otherwise `start-file-process'
+ ;; wouldn't run ever when `non-essential' is non-nil.
+ (and vec (process-live-p (get-process (tramp-buffer-name vec))))
+ (not (tramp-completion-mode-p)))))
;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of
@@ -2606,8 +2614,7 @@ not in completion mode."
(try-completion
filename
(mapcar #'list (file-name-all-completions filename directory))
- (when (and predicate
- (tramp-connectable-p (expand-file-name filename directory)))
+ (when (and predicate (tramp-connectable-p directory))
(lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
;; I misuse a little bit the `tramp-file-name' structure in order to
@@ -3096,7 +3103,11 @@ User is always nil."
(defun tramp-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
- (not (null (file-attributes filename))))
+ ;; `file-exists-p' is used as predicate in file name completion.
+ ;; We don't want to run it when `non-essential' is t, or there is
+ ;; no connection process yet.
+ (when (tramp-connectable-p filename)
+ (not (null (file-attributes filename)))))
(defun tramp-handle-file-in-directory-p (filename directory)
"Like `file-in-directory-p' for Tramp files."
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index be09a73..df9b135 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -505,9 +505,12 @@ format."
;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun gamegrid-add-score (file score)
+(defun gamegrid-add-score (file score &optional reverse)
"Add the current score to the high score file.
+If REVERSE is non-nil, treat lower scores as better than higher
+scores. This is useful for games where lower scores are better.
+
On POSIX systems there may be a shared game directory for all users in
which the scorefiles are kept. On such systems Emacs doesn't create
the score file FILE in this directory, if it doesn't already exist.
@@ -525,9 +528,9 @@ specified by the variable `temporary-file-directory'. If
necessary,
FILE is created there."
(pcase system-type
((or 'ms-dos 'windows-nt)
- (gamegrid-add-score-insecure file score))
+ (gamegrid-add-score-insecure file score reverse))
(_
- (gamegrid-add-score-with-update-game-score file score))))
+ (gamegrid-add-score-with-update-game-score file score reverse))))
;; On POSIX systems there are four cases to distinguish:
@@ -556,20 +559,21 @@ FILE is created there."
(defvar gamegrid-shared-game-dir)
-(defun gamegrid-add-score-with-update-game-score (file score)
+(defun gamegrid-add-score-with-update-game-score (file score &optional reverse)
(let* ((update-game-score-modes
(file-modes (expand-file-name "update-game-score" exec-directory)))
(gamegrid-shared-game-dir
(not (zerop (logand #o6000 (or update-game-score-modes 0))))))
(cond ((or (not update-game-score-modes) (file-name-absolute-p file))
(gamegrid-add-score-insecure file score
- gamegrid-user-score-file-directory))
+ gamegrid-user-score-file-directory
+ reverse))
((and gamegrid-shared-game-dir
(file-exists-p (expand-file-name file
shared-game-score-directory)))
;; Use the setgid (or setuid) "update-game-score" program
;; to update a system-wide score file.
(gamegrid-add-score-with-update-game-score-1 file
- (expand-file-name file shared-game-score-directory) score))
+ (expand-file-name file shared-game-score-directory) score reverse))
;; Else: Add the score to a score file in the user's home
;; directory.
(gamegrid-shared-game-dir
@@ -579,7 +583,8 @@ FILE is created there."
(directory-file-name gamegrid-user-score-file-directory))
(make-directory gamegrid-user-score-file-directory t))
(gamegrid-add-score-insecure file score
- gamegrid-user-score-file-directory))
+ gamegrid-user-score-file-directory
+ reverse))
(t
(unless (file-exists-p
(directory-file-name gamegrid-user-score-file-directory))
@@ -588,9 +593,9 @@ FILE is created there."
gamegrid-user-score-file-directory)))
(unless (file-exists-p f)
(write-region "" nil f nil 'silent nil 'excl))
- (gamegrid-add-score-with-update-game-score-1 file f score))))))
+ (gamegrid-add-score-with-update-game-score-1 file f score
reverse))))))
-(defun gamegrid-add-score-with-update-game-score-1 (file target score)
+(defun gamegrid-add-score-with-update-game-score-1 (file target score
&optional reverse)
(let ((default-directory "/")
(errbuf (generate-new-buffer " *update-game-score loss*"))
(marker-string (concat
@@ -601,17 +606,16 @@ FILE is created there."
(with-local-quit
(apply
'call-process
- (append
- (list
- (expand-file-name "update-game-score" exec-directory)
- nil errbuf nil
- "-m" (int-to-string gamegrid-score-file-length)
- "-d" (if gamegrid-shared-game-dir
- (expand-file-name shared-game-score-directory)
- (file-name-directory target))
- file
- (int-to-string score)
- marker-string))))
+ `(,(expand-file-name "update-game-score" exec-directory)
+ nil ,errbuf nil
+ "-m" ,(int-to-string gamegrid-score-file-length)
+ "-d" ,(if gamegrid-shared-game-dir
+ (expand-file-name shared-game-score-directory)
+ (file-name-directory target))
+ ,@(if reverse '("-r"))
+ ,file
+ ,(int-to-string score)
+ ,marker-string)))
(if (buffer-modified-p errbuf)
(progn
(display-buffer errbuf)
@@ -632,7 +636,7 @@ FILE is created there."
marker-string) nil t)
(beginning-of-line)))))
-(defun gamegrid-add-score-insecure (file score &optional directory)
+(defun gamegrid-add-score-insecure (file score &optional directory reverse)
(save-excursion
(setq file (expand-file-name file (or directory
temporary-file-directory)))
@@ -645,7 +649,8 @@ FILE is created there."
(user-full-name)
user-mail-address))
(sort-fields 1 (point-min) (point-max))
- (reverse-region (point-min) (point-max))
+ (unless reverse
+ (reverse-region (point-min) (point-max)))
(goto-char (point-min))
(forward-line gamegrid-score-file-length)
(delete-region (point) (point-max))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 14b6566..ec5d8c5 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4084,6 +4084,12 @@ JUSTIFY should be used (if applicable) as in
`fill-paragraph'."
(goto-char (line-end-position))))
t)
+(defun python-do-auto-fill ()
+ "Like `do-auto-fill', but bind `fill-indent-according-to-mode'."
+ ;; See Bug#36056.
+ (let ((fill-indent-according-to-mode t))
+ (do-auto-fill)))
+
;;; Skeletons
@@ -5379,7 +5385,7 @@ REPORT-FN is Flymake's callback function."
(set (make-local-variable 'paragraph-start) "\\s-*$")
(set (make-local-variable 'fill-paragraph-function)
#'python-fill-paragraph)
- (set (make-local-variable 'fill-indent-according-to-mode) t) ; Bug#36056.
+ (set (make-local-variable 'normal-auto-fill-function) #'python-do-auto-fill)
(set (make-local-variable 'beginning-of-defun-function)
#'python-nav-beginning-of-defun)
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index aad38b9..cbc0ac7 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -112,7 +112,7 @@
;; would make this unnecessary; simply learn the values when you visit
;; the buffer.
;; You can do this automatically like this:
-;; (add-hook 'sh-set-shell-hook 'sh-learn-buffer-indent)
+;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent)
;;
;; However... `sh-learn-buffer-indent' is extremely slow,
;; especially on large-ish buffer. Also, if there are conflicts the
@@ -480,7 +480,6 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c>" 'sh-learn-buffer-indent)
(define-key map "\C-c\C-\\" 'sh-backslash-region)
- (define-key map "=" 'sh-assignment)
(define-key map "\C-c+" 'sh-add)
(define-key map "\C-\M-x" 'sh-execute-region)
(define-key map "\C-c\C-x" 'executable-interpret)
@@ -1059,7 +1058,7 @@ subshells can nest."
(when (< startpos (line-beginning-position))
(put-text-property startpos (point) 'syntax-multiline t)
(add-hook 'syntax-propertize-extend-region-functions
- 'syntax-propertize-multiline nil t))
+ #'syntax-propertize-multiline nil t))
)))
@@ -1603,25 +1602,25 @@ with your script for an edit-interpret-debug cycle."
(setq-local local-abbrev-table sh-mode-abbrev-table)
(setq-local comint-dynamic-complete-functions
sh-dynamic-complete-functions)
- (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)
+ (add-hook 'completion-at-point-functions #'comint-completion-at-point nil t)
;; we can't look if previous line ended with `\'
(setq-local comint-prompt-regexp "^[ \t]*")
(setq-local imenu-case-fold-search nil)
(setq font-lock-defaults
- '((sh-font-lock-keywords
+ `((sh-font-lock-keywords
sh-font-lock-keywords-1 sh-font-lock-keywords-2)
nil nil
((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
(font-lock-syntactic-face-function
- . sh-font-lock-syntactic-face-function)))
+ . ,#'sh-font-lock-syntactic-face-function)))
(setq-local syntax-propertize-function #'sh-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
(setq-local skeleton-pair-alist '((?` _ ?`)))
- (setq-local skeleton-pair-filter-function 'sh-quoted-p)
+ (setq-local skeleton-pair-filter-function #'sh-quoted-p)
(setq-local skeleton-further-elements
'((< '(- (min sh-basic-offset (current-column))))))
- (setq-local skeleton-filter-function 'sh-feature)
+ (setq-local skeleton-filter-function #'sh-feature)
(setq-local skeleton-newline-indent-rigidly t)
(setq-local defun-prompt-regexp
(concat
@@ -2408,12 +2407,12 @@ whose value is the shell name (don't quote it)."
(message "setting up indent stuff")
;; sh-mode has already made indent-line-function local
;; but do it in case this is called before that.
- (setq-local indent-line-function 'sh-indent-line))
+ (setq-local indent-line-function #'sh-indent-line))
(if sh-make-vars-local
(sh-make-vars-local))
(message "Indentation setup for shell type %s" sh-shell))
(message "No indentation for this shell type.")
- (setq-local indent-line-function 'sh-basic-indent-line))
+ (setq-local indent-line-function #'sh-basic-indent-line))
(when font-lock-mode
(setq font-lock-set-defaults nil)
(font-lock-set-defaults)
@@ -3586,7 +3585,7 @@ so that `occur-next' and `occur-prev' will work."
;; (insert ")\n")
;; )))
;;
-;; (add-hook 'sh-learned-buffer-hook 'what-i-learned)
+;; (add-hook 'sh-learned-buffer-hook #'what-i-learned)
;; Originally this was sh-learn-region-indent (beg end)
@@ -4055,7 +4054,8 @@ Add these variables to `sh-shell-variables'."
(goto-char (point-min))
(setq sh-shell-variables-initialized t)
(while (search-forward "=" nil t)
- (sh-assignment 0)))
+ (sh--assignment-collect)))
+ (add-hook 'post-self-insert-hook #'sh--assignment-collect nil t)
(message "Scanning buffer `%s' for variable assignments...done"
(buffer-name)))
@@ -4328,20 +4328,24 @@ option followed by a colon `:' if the option accepts an
argument."
+(put 'sh-assignment 'delete-selection t)
(defun sh-assignment (arg)
"Remember preceding identifier for future completion and do self-insert."
(interactive "p")
+ (declare (obsolete nil "27.1"))
(self-insert-command arg)
- (if (<= arg 1)
- (sh-remember-variable
- (save-excursion
- (if (re-search-forward (sh-feature sh-assignment-regexp)
- (prog1 (point)
- (beginning-of-line 1))
- t)
- (match-string 1))))))
+ (sh--assignment-collect))
+
+(defun sh--assignment-collect ()
+ (sh-remember-variable
+ (when (eq ?= (char-before))
+ (save-excursion
+ (if (re-search-forward (sh-feature sh-assignment-regexp)
+ (prog1 (point)
+ (beginning-of-line 1))
+ t)
+ (match-string 1))))))
-(put 'sh-assignment 'delete-selection t)
(defun sh-maybe-here-document (arg)
"Insert self. Without prefix, following unquoted `<' inserts here document.
diff --git a/lisp/replace.el b/lisp/replace.el
index ad9be77..5c0616e 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2698,7 +2698,7 @@ characters."
(num-replacements 0)
(nocasify t) ; Undo must preserve case
(Bug#31073).
search-string
- next-replacement)
+ last-replacement)
(while (and (< stack-idx stack-len)
stack
(or (null replaced)
last-was-act-and-show))
@@ -2709,9 +2709,9 @@ characters."
;; Bind swapped values
;; (search-string <--> replacement)
search-string (nth (if replaced 4 3) elt)
- next-replacement (nth (if replaced 3 4) elt)
+ last-replacement (nth (if replaced 3 4) elt)
search-string-replaced search-string
- next-replacement-replaced next-replacement
+ next-replacement-replaced last-replacement
last-was-act-and-show nil)
(when (and (= stack-idx stack-len)
@@ -2733,16 +2733,18 @@ characters."
(match-data t (nth 2 elt)))
noedit
(replace-match-maybe-edit
- next-replacement nocasify literal
+ last-replacement nocasify literal
noedit real-match-data backward)
replace-count (1- replace-count)
real-match-data
(save-excursion
(goto-char (match-beginning 0))
(if regexp-flag
- (looking-at next-replacement)
- (looking-at (regexp-quote
next-replacement)))
+ (looking-at last-replacement)
+ (looking-at (regexp-quote
last-replacement)))
(match-data t (nth 2 elt))))
+ (when regexp-flag
+ (setq next-replacement (nth 4 elt)))
;; Set replaced nil to keep in loop
(when (eq def 'undo-all)
(setq replaced nil
diff --git a/lisp/select.el b/lisp/select.el
index 59bcf7d..334e10f 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -160,12 +160,11 @@ The value nil is the same as the list (UTF8_STRING
COMPOUND_TEXT STRING)."
(const TEXT)))
:group 'killing)
-;; Get a selection value of type TYPE by calling gui-get-selection with
-;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
-;; The return value is already decoded. If gui-get-selection causes an
-;; error, this function return nil.
-
(defun gui--selection-value-internal (type)
+ "Get a selection value of type TYPE.
+Call `gui-get-selection' with an appropriate DATA-TYPE argument
+decided by `x-select-request-type'. The return value is already
+decoded. If `gui-get-selection' signals an error, return nil."
(let ((request-type (if (eq window-system 'x)
(or x-select-request-type
'(UTF8_STRING COMPOUND_TEXT STRING))
diff --git a/lisp/server.el b/lisp/server.el
index ac81cdb..45fa55a 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -563,9 +563,9 @@ See variable `server-auth-dir' for details."
(format "it is not owned by you (owner = %s (%d))"
(user-full-name uid) uid))
(w32 nil) ; on NTFS?
- ((/= 0 (logand ?\077 (file-modes dir)))
- (format "it is accessible by others (%03o)"
- (file-modes dir)))
+ ((let ((modes (file-modes dir)))
+ (unless (zerop (logand (or modes 0) #o077))
+ (format "it is accessible by others (%03o)" modes))))
(t nil))))
(when unsafe
(error "`%s' is not a safe directory because %s"
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 2778e58..72491b9 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -207,7 +207,7 @@ PREFIX."
;;; I use the term `site' to refer to a string which may be the
;;; cluster identification "/name:", a remote identification
-;;; "/method:user@host:", or "/system-name:' (the value of
+;;; "/method:user@host:", or "/system-name:" (the value of
;;; `shadow-system-name') for the location of local files. All
;;; user-level commands should accept either.
@@ -607,6 +607,11 @@ and to are absolute file names."
canonical-file shadow-literal-groups nil)
(shadow-shadows-of-1
canonical-file shadow-regexp-groups t)))))
+ (when shadow-debug
+ (message
+ "shadow-shadows-of: %s %s %s %s %s"
+ file (shadow-local-file file) shadow-homedir
+ absolute-file canonical-file))
(set (intern file shadow-hashtable) shadows))))
(defun shadow-shadows-of-1 (file groups regexp)
@@ -621,6 +626,10 @@ Consider them as regular expressions if third arg REGEXP
is true."
(let ((realname
(tramp-file-name-localname
(shadow-parse-name file))))
+ (when shadow-debug
+ (message
+ "shadow-shadows-of-1: %s %s %s"
+ file (shadow-parse-name file) realname))
(mapcar
(function
(lambda (x)
@@ -631,6 +640,11 @@ Consider them as regular expressions if third arg REGEXP
is true."
(defun shadow-add-to-todo ()
"If current buffer has shadows, add them to the list needing to be copied."
+ (when shadow-debug
+ (message
+ "shadow-add-to-todo: %s %s"
+ (buffer-file-name (current-buffer))
+ (shadow-expand-file-name (buffer-file-name (current-buffer)))))
(let ((shadows (shadow-shadows-of
(shadow-expand-file-name
(buffer-file-name (current-buffer))))))
diff --git a/lisp/subr.el b/lisp/subr.el
index 0d7bffb..0b47da8 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2045,7 +2045,7 @@ Uses the `derived-mode-parent' property of the symbol to
trace backwards."
(put 'major-mode--suspended 'permanent-local t)
(defun major-mode-suspend ()
- "Exit current major, remembering it."
+ "Exit current major mode, remembering it."
(let* ((prev-major-mode (or major-mode--suspended
(unless (eq major-mode 'fundamental-mode)
major-mode))))
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 198182f..e2c019f 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/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 1f185e0..f684f4e 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -567,10 +567,6 @@
;; Consider the use of `:box' face attribute under Emacs 21
;; Consider the use of `modification-hooks' text property instead of
;; rebinding the keymap
-;; Maybe provide complete XEmacs support in the future however the
-;; "extent" is the single largest obstacle lying ahead, read the
-;; document in Emacs info.
-;; (progn (require 'info) (Info-find-node "elisp" "Not Intervals"))
;;
;;
;; ---------------
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index b1c69ae..eac510b 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -365,7 +365,10 @@ It is also called if Tooltip mode is on, for text-only
displays."
(let ((message-log-max nil))
(message "%s" tooltip-previous-message)
(setq tooltip-previous-message nil)))
- (t
+ ;; Only stop displaying the message when the current message is our own.
+ ;; This has the advantage of not clearing the echo area when
+ ;; running after an error message was displayed (Bug#3192).
+ ((equal-including-properties tooltip-help-message (current-message))
(message nil)))))
(defun tooltip-show-help (msg)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index d84700f..a9e79d7 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -440,7 +440,7 @@ REV is the revision to check out."
(if vc-cvs-use-edit
(vc-cvs-command nil 0 file "unedit")
;; Make the file read-only by switching off all w-bits
- (set-file-modes file (logand (file-modes file) 3950)))))
+ (set-file-modes file (logand (file-modes file) #o7555)))))
(defun vc-cvs-merge-file (file)
"Accept a file merge request, prompting for revisions."
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 9a6f6bb..e225978 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -864,10 +864,18 @@ with the command \\[tags-loop-continue]."
delimited)
(fileloop-continue))
-(defun vc-dir-ignore ()
- "Ignore the current file."
- (interactive)
- (vc-ignore (vc-dir-current-file)))
+(defun vc-dir-ignore (&optional arg)
+ "Ignore the current file.
+If a prefix argument is given, ignore all marked files."
+ (interactive "P")
+ (if arg
+ (ewoc-map
+ (lambda (filearg)
+ (when (vc-dir-fileinfo->marked filearg)
+ (vc-ignore (vc-dir-fileinfo->name filearg))
+ t))
+ vc-ewoc)
+ (vc-ignore (vc-dir-current-file))))
(defun vc-dir-current-file ()
(let ((node (ewoc-locate vc-ewoc)))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 4d7b4c4..db09aa4 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -366,8 +366,9 @@ FILE is a file wildcard, relative to the root directory of
DIRECTORY."
(defun vc-svn-ignore-completion-table (directory)
"Return the list of ignored files in DIRECTORY."
(with-temp-buffer
- (vc-svn-command t t nil "propget" "svn:ignore" (expand-file-name
directory))
- (split-string (buffer-string))))
+ (when (zerop (vc-svn-command
+ t t nil "propget" "svn:ignore" (expand-file-name directory)))
+ (split-string (buffer-string) "\n"))))
(defun vc-svn-find-admin-dir (file)
"Return the administrative directory of FILE."
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 90899d2..9d2eada 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1417,17 +1417,22 @@ remove from the list of ignored files."
(defun vc-default-ignore (backend file &optional directory remove)
"Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
-FILE is a file wildcard, relative to the root directory of DIRECTORY.
+FILE is a wildcard specification, either relative to
+DIRECTORY or absolute.
When called from Lisp code, if DIRECTORY is non-nil, the
repository to use will be deduced by DIRECTORY; if REMOVE is
non-nil, remove FILE from ignored files.
Argument BACKEND is the backend you are using."
(let ((ignore
(vc-call-backend backend 'find-ignore-file (or directory
default-directory)))
- (pattern (file-relative-name
- (expand-file-name file) (file-name-directory file))))
+ file-path root-dir pattern)
+ (setq file-path (expand-file-name file directory))
+ (setq root-dir (file-name-directory ignore))
+ (when (not (string= (substring file-path 0 (length root-dir)) root-dir))
+ (error "Ignore spec %s is not below project root %s" file-path root-dir))
+ (setq pattern (substring file-path (length root-dir)))
(if remove
- (vc--remove-regexp pattern ignore)
+ (vc--remove-regexp (concat "^" (regexp-quote pattern ) "\\(\n\\|$\\)")
ignore)
(vc--add-line pattern ignore))))
(defun vc-default-ignore-completion-table (backend file)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index dbc4100..3124a9c 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -89,7 +89,11 @@ if that value is non-nil."
(defun widget-browse-at (pos)
"Browse the widget under point."
(interactive "d")
- (let* ((field (get-char-property pos 'field))
+ (let* ((field (or
+ ;; See comments in `widget-specify-field' to know why we
+ ;; need this.
+ (get-char-property pos 'real-field)
+ (get-char-property pos 'field)))
(button (get-char-property pos 'button))
(doc (get-char-property pos 'widget-doc))
(text (cond (field "This is an editable text area.")
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 9bc7a07..7ed7b81 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -414,6 +414,7 @@ the :notify function can't know the new value.")
(defmacro widget-specify-insert (&rest form)
"Execute FORM without inheriting any text properties."
+ (declare (debug body))
`(save-restriction
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
diff --git a/src/alloc.c b/src/alloc.c
index 2d490f3..9fbd0d0 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -224,7 +224,7 @@ struct emacs_globals globals;
/* maybe_gc collects garbage if this goes negative. */
-intmax_t consing_until_gc;
+EMACS_INT consing_until_gc;
#ifdef HAVE_PDUMPER
/* Number of finalizers run: used to loop over GC until we stop
@@ -238,10 +238,17 @@ bool gc_in_progress;
/* System byte and object counts reported by GC. */
+/* Assume byte counts fit in uintptr_t and object counts fit into
+ intptr_t. */
typedef uintptr_t byte_ct;
typedef intptr_t object_ct;
-/* Number of live and free conses etc. */
+/* Large-magnitude value for a threshold count, which fits in EMACS_INT.
+ Using only half the EMACS_INT range avoids overflow hassles.
+ There is no need to fit these counts into fixnums. */
+#define HI_THRESHOLD (EMACS_INT_MAX / 2)
+
+/* Number of live and free conses etc. counted by the most-recent GC. */
static struct gcstat
{
@@ -299,7 +306,7 @@ static intptr_t garbage_collection_inhibited;
/* The GC threshold in bytes, the last time it was calculated
from gc-cons-threshold and gc-cons-percentage. */
-static intmax_t gc_threshold;
+static EMACS_INT gc_threshold;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
@@ -536,6 +543,15 @@ XFLOAT_INIT (Lisp_Object f, double n)
XFLOAT (f)->u.data = n;
}
+/* Account for allocation of NBYTES in the heap. This is a separate
+ function to avoid hassles with implementation-defined conversion
+ from unsigned to signed types. */
+static void
+tally_consing (ptrdiff_t nbytes)
+{
+ consing_until_gc -= nbytes;
+}
+
#ifdef DOUG_LEA_MALLOC
static bool
pointers_fit_in_lispobj_p (void)
@@ -560,7 +576,7 @@ struct Lisp_Finalizer finalizers;
/* Head of a circularly-linked list of finalizers that must be invoked
because we deemed them unreachable. This list must be global, and
- not a local inside garbage_collect_1, in case we GC again while
+ not a local inside garbage_collect, in case we GC again while
running finalizers. */
struct Lisp_Finalizer doomed_finalizers;
@@ -1366,16 +1382,14 @@ make_interval (void)
newi->next = interval_block;
interval_block = newi;
interval_block_index = 0;
- gcstat.total_free_intervals += INTERVAL_BLOCK_SIZE;
}
val = &interval_block->intervals[interval_block_index++];
}
MALLOC_UNBLOCK_INPUT;
- consing_until_gc -= sizeof (struct interval);
+ tally_consing (sizeof (struct interval));
intervals_consed++;
- gcstat.total_free_intervals--;
RESET_INTERVAL (val);
val->gcmarkbit = 0;
return val;
@@ -1730,8 +1744,6 @@ allocate_string (void)
NEXT_FREE_LISP_STRING (s) = string_free_list;
string_free_list = ptr_bounds_clip (s, sizeof *s);
}
-
- gcstat.total_free_strings += STRING_BLOCK_SIZE;
}
check_string_free_list ();
@@ -1742,10 +1754,8 @@ allocate_string (void)
MALLOC_UNBLOCK_INPUT;
- gcstat.total_free_strings--;
- gcstat.total_strings++;
++strings_consed;
- consing_until_gc -= sizeof *s;
+ tally_consing (sizeof *s);
#ifdef GC_CHECK_STRING_BYTES
if (!noninteractive)
@@ -1865,7 +1875,7 @@ allocate_string_data (struct Lisp_String *s,
old_data->string = NULL;
}
- consing_until_gc -= needed;
+ tally_consing (needed);
}
@@ -2461,7 +2471,6 @@ make_float (double float_value)
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
float_block = new;
float_block_index = 0;
- gcstat.total_free_floats += FLOAT_BLOCK_SIZE;
}
XSETFLOAT (val, &float_block->floats[float_block_index]);
float_block_index++;
@@ -2471,9 +2480,8 @@ make_float (double float_value)
XFLOAT_INIT (val, float_value);
eassert (!XFLOAT_MARKED_P (XFLOAT (val)));
- consing_until_gc -= sizeof (struct Lisp_Float);
+ tally_consing (sizeof (struct Lisp_Float));
floats_consed++;
- gcstat.total_free_floats--;
return val;
}
@@ -2543,9 +2551,8 @@ free_cons (struct Lisp_Cons *ptr)
ptr->u.s.u.chain = cons_free_list;
ptr->u.s.car = dead_object ();
cons_free_list = ptr;
- if (INT_ADD_WRAPV (consing_until_gc, sizeof *ptr, &consing_until_gc))
- consing_until_gc = INTMAX_MAX;
- gcstat.total_free_conses++;
+ ptrdiff_t nbytes = sizeof *ptr;
+ tally_consing (-nbytes);
}
DEFUN ("cons", Fcons, Scons, 2, 2, 0,
@@ -2565,26 +2572,12 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
{
if (cons_block_index == CONS_BLOCK_SIZE)
{
- /* Maximum number of conses that should be active at any
- given time, so that list lengths fit into a ptrdiff_t and
- into a fixnum. */
- ptrdiff_t max_conses = min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM);
-
- /* This check is typically optimized away, as a runtime
- check is needed only on weird platforms where a count of
- distinct conses might not fit. */
- if (max_conses < INTPTR_MAX / sizeof (struct Lisp_Cons)
- && (max_conses - CONS_BLOCK_SIZE
- < gcstat.total_free_conses + gcstat.total_conses))
- memory_full (sizeof (struct cons_block));
-
struct cons_block *new
= lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
new->next = cons_block;
cons_block = new;
cons_block_index = 0;
- gcstat.total_free_conses += CONS_BLOCK_SIZE;
}
XSETCONS (val, &cons_block->conses[cons_block_index]);
cons_block_index++;
@@ -2596,7 +2589,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
XSETCDR (val, cdr);
eassert (!XCONS_MARKED_P (XCONS (val)));
consing_until_gc -= sizeof (struct Lisp_Cons);
- gcstat.total_free_conses--;
cons_cells_consed++;
return val;
}
@@ -2855,7 +2847,6 @@ setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t
nbytes)
eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX);
set_next_vector (v, vector_free_lists[vindex]);
vector_free_lists[vindex] = v;
- gcstat.total_free_vector_slots += nbytes / word_size;
}
/* Get a new vector block. */
@@ -2903,7 +2894,6 @@ allocate_vector_from_block (ptrdiff_t nbytes)
{
vector = vector_free_lists[index];
vector_free_lists[index] = next_vector (vector);
- gcstat.total_free_vector_slots -= nbytes / word_size;
return vector;
}
@@ -2917,7 +2907,6 @@ allocate_vector_from_block (ptrdiff_t nbytes)
/* This vector is larger than requested. */
vector = vector_free_lists[index];
vector_free_lists[index] = next_vector (vector);
- gcstat.total_free_vector_slots -= nbytes / word_size;
/* Excess bytes are used for the smaller vector,
which should be set on an appropriate free list. */
@@ -3092,7 +3081,10 @@ sweep_vectors (void)
space was coalesced into the only free vector. */
free_this_block = true;
else
- setup_on_free_list (vector, total_bytes);
+ {
+ setup_on_free_list (vector, total_bytes);
+ gcstat.total_free_vector_slots += total_bytes / word_size;
+ }
}
}
@@ -3177,7 +3169,7 @@ allocate_vectorlike (ptrdiff_t len)
if (find_suspicious_object_in_range (p, (char *) p + nbytes))
emacs_abort ();
- consing_until_gc -= nbytes;
+ tally_consing (nbytes);
vector_cells_consed += len;
MALLOC_UNBLOCK_INPUT;
@@ -3454,7 +3446,6 @@ Its value is void, and its function definition and
property list are nil. */)
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
- gcstat.total_free_symbols += SYMBOL_BLOCK_SIZE;
}
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
symbol_block_index++;
@@ -3463,9 +3454,8 @@ Its value is void, and its function definition and
property list are nil. */)
MALLOC_UNBLOCK_INPUT;
init_symbol (val, name);
- consing_until_gc -= sizeof (struct Lisp_Symbol);
+ tally_consing (sizeof (struct Lisp_Symbol));
symbols_consed++;
- gcstat.total_free_symbols--;
return val;
}
@@ -5503,7 +5493,7 @@ staticpro (Lisp_Object const *varaddress)
static void
allow_garbage_collection (intmax_t consing)
{
- consing_until_gc = consing - (INTMAX_MAX - consing_until_gc);
+ consing_until_gc = consing - (HI_THRESHOLD - consing_until_gc);
garbage_collection_inhibited--;
}
@@ -5513,7 +5503,7 @@ inhibit_garbage_collection (void)
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc);
garbage_collection_inhibited++;
- consing_until_gc = INTMAX_MAX;
+ consing_until_gc = HI_THRESHOLD;
return count;
}
@@ -5723,7 +5713,7 @@ visit_buffer_root (struct gc_root_visitor visitor,
There are other GC roots of course, but these roots are dynamic
runtime data structures that pdump doesn't care about and so we can
- continue to mark those directly in garbage_collect_1. */
+ continue to mark those directly in garbage_collect. */
void
visit_static_gc_roots (struct gc_root_visitor visitor)
{
@@ -5753,8 +5743,7 @@ mark_object_root_visitor (Lisp_Object const *root_ptr,
}
/* List of weak hash tables we found during marking the Lisp heap.
- Will be NULL on entry to garbage_collect_1 and after it
- returns. */
+ NULL on entry to garbage_collect and after it returns. */
static struct Lisp_Hash_Table *weak_hash_tables;
NO_INLINE /* For better stack traces */
@@ -5788,11 +5777,13 @@ mark_and_sweep_weak_table_contents (void)
}
}
-/* Return the number of bytes to cons between GCs, assuming
- gc-cons-threshold is THRESHOLD and gc-cons-percentage is
- PERCENTAGE. */
-static intmax_t
-consing_threshold (intmax_t threshold, Lisp_Object percentage)
+/* Return the number of bytes to cons between GCs, given THRESHOLD and
+ PERCENTAGE. When calculating a threshold based on PERCENTAGE,
+ assume SINCE_GC bytes have been allocated since the most recent GC.
+ The returned value is positive and no greater than HI_THRESHOLD. */
+static EMACS_INT
+consing_threshold (intmax_t threshold, Lisp_Object percentage,
+ intmax_t since_gc)
{
if (!NILP (Vmemory_full))
return memory_full_cons_threshold;
@@ -5802,42 +5793,33 @@ consing_threshold (intmax_t threshold, Lisp_Object
percentage)
if (FLOATP (percentage))
{
double tot = (XFLOAT_DATA (percentage)
- * total_bytes_of_live_objects ());
+ * (total_bytes_of_live_objects () + since_gc));
if (threshold < tot)
{
- if (tot < INTMAX_MAX)
- threshold = tot;
+ if (tot < HI_THRESHOLD)
+ return tot;
else
- threshold = INTMAX_MAX;
+ return HI_THRESHOLD;
}
}
- return threshold;
+ return min (threshold, HI_THRESHOLD);
}
}
-/* Adjust consing_until_gc, assuming gc-cons-threshold is THRESHOLD and
- gc-cons-percentage is PERCENTAGE. */
-static Lisp_Object
+/* Adjust consing_until_gc and gc_threshold, given THRESHOLD and PERCENTAGE.
+ Return the updated consing_until_gc. */
+
+static EMACS_INT
bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage)
{
- /* If consing_until_gc is negative leave it alone, since this prevents
- negative integer overflow and a GC would have been done soon anyway. */
- if (0 <= consing_until_gc)
- {
- threshold = consing_threshold (threshold, percentage);
- intmax_t sum;
- if (INT_ADD_WRAPV (consing_until_gc, threshold - gc_threshold, &sum))
- {
- /* Scale the threshold down so that consing_until_gc does
- not overflow. */
- sum = INTMAX_MAX;
- threshold = INTMAX_MAX - consing_until_gc + gc_threshold;
- }
- consing_until_gc = sum;
- gc_threshold = threshold;
- }
-
- return Qnil;
+ /* Guesstimate that half the bytes allocated since the most
+ recent GC are still in use. */
+ EMACS_INT since_gc = (gc_threshold - consing_until_gc) >> 1;
+ EMACS_INT new_gc_threshold = consing_threshold (threshold, percentage,
+ since_gc);
+ consing_until_gc += new_gc_threshold - gc_threshold;
+ gc_threshold = new_gc_threshold;
+ return consing_until_gc;
}
/* Watch changes to gc-cons-threshold. */
@@ -5848,7 +5830,8 @@ watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object
newval,
intmax_t threshold;
if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold)))
return Qnil;
- return bump_consing_until_gc (threshold, Vgc_cons_percentage);
+ bump_consing_until_gc (threshold, Vgc_cons_percentage);
+ return Qnil;
}
/* Watch changes to gc-cons-percentage. */
@@ -5856,24 +5839,34 @@ static Lisp_Object
watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
Lisp_Object operation, Lisp_Object where)
{
- return bump_consing_until_gc (gc_cons_threshold, newval);
+ bump_consing_until_gc (gc_cons_threshold, newval);
+ return Qnil;
+}
+
+/* It may be time to collect garbage. Recalculate consing_until_gc,
+ since it might depend on current usage, and do the garbage
+ collection if the recalculation says so. */
+void
+maybe_garbage_collect (void)
+{
+ if (bump_consing_until_gc (gc_cons_threshold, Vgc_cons_percentage) < 0)
+ garbage_collect ();
}
/* Subroutine of Fgarbage_collect that does most of the work. */
-static bool
-garbage_collect_1 (struct gcstat *gcst)
+void
+garbage_collect (void)
{
struct buffer *nextb;
char stack_top_variable;
bool message_p;
ptrdiff_t count = SPECPDL_INDEX ();
struct timespec start;
- byte_ct tot_before = 0;
eassert (weak_hash_tables == NULL);
if (garbage_collection_inhibited)
- return false;
+ return;
/* Record this function, so it appears on the profiler's backtraces. */
record_in_backtrace (QAutomatic_GC, 0, 0);
@@ -5883,14 +5876,15 @@ garbage_collect_1 (struct gcstat *gcst)
FOR_EACH_BUFFER (nextb)
compact_buffer (nextb);
- if (profiler_memory_running)
- tot_before = total_bytes_of_live_objects ();
+ byte_ct tot_before = (profiler_memory_running
+ ? total_bytes_of_live_objects ()
+ : (byte_ct) -1);
start = current_timespec ();
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
- consing_until_gc = INTMAX_MAX;
+ consing_until_gc = HI_THRESHOLD;
/* Save what's currently displayed in the echo area. Don't do that
if we are GC'ing because we've run out of memory, since
@@ -6002,7 +5996,7 @@ garbage_collect_1 (struct gcstat *gcst)
unblock_input ();
consing_until_gc = gc_threshold
- = consing_threshold (gc_cons_threshold, Vgc_cons_percentage);
+ = consing_threshold (gc_cons_threshold, Vgc_cons_percentage, 0);
if (garbage_collection_messages && NILP (Vmemory_full))
{
@@ -6014,8 +6008,6 @@ garbage_collect_1 (struct gcstat *gcst)
unbind_to (count, Qnil);
- *gcst = gcstat;
-
/* GC is complete: now we can run our finalizer callbacks. */
run_finalizers (&doomed_finalizers);
@@ -6029,29 +6021,21 @@ garbage_collect_1 (struct gcstat *gcst)
/* Accumulate statistics. */
if (FLOATP (Vgc_elapsed))
{
- struct timespec since_start = timespec_sub (current_timespec (), start);
- Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
- + timespectod (since_start));
+ static struct timespec gc_elapsed;
+ gc_elapsed = timespec_add (gc_elapsed,
+ timespec_sub (current_timespec (), start));
+ Vgc_elapsed = make_float (timespectod (gc_elapsed));
}
gcs_done++;
/* Collect profiling data. */
- if (profiler_memory_running)
+ if (tot_before != (byte_ct) -1)
{
byte_ct tot_after = total_bytes_of_live_objects ();
- byte_ct swept = tot_before <= tot_after ? 0 : tot_before - tot_after;
- malloc_probe (min (swept, SIZE_MAX));
+ if (tot_after < tot_before)
+ malloc_probe (min (tot_before - tot_after, SIZE_MAX));
}
-
- return true;
-}
-
-void
-garbage_collect (void)
-{
- struct gcstat gcst;
- garbage_collect_1 (&gcst);
}
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
@@ -6071,10 +6055,12 @@ returns nil, because real GC can't be done.
See Info node `(elisp)Garbage Collection'. */)
(void)
{
- struct gcstat gcst;
- if (!garbage_collect_1 (&gcst))
+ if (garbage_collection_inhibited)
return Qnil;
+ garbage_collect ();
+ struct gcstat gcst = gcstat;
+
Lisp_Object total[] = {
list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
make_int (gcst.total_conses),
diff --git a/src/callint.c b/src/callint.c
index d76836f..449b504 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -35,7 +35,6 @@ static Lisp_Object point_marker;
/* String for the prompt text used in Fcall_interactively. */
static Lisp_Object callint_message;
-/* ARGSUSED */
DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
doc: /* Specify a way of parsing arguments for interactive use of a
function.
For example, write
diff --git a/src/callproc.c b/src/callproc.c
index b296bdb..dbbf15c 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -108,11 +108,8 @@ static Lisp_Object call_process (ptrdiff_t, Lisp_Object *,
int, ptrdiff_t);
Lisp_Object
encode_current_directory (void)
{
- Lisp_Object dir;
-
- dir = BVAR (current_buffer, directory);
-
- dir = Funhandled_file_name_directory (dir);
+ Lisp_Object curdir = BVAR (current_buffer, directory);
+ Lisp_Object dir = Funhandled_file_name_directory (curdir);
/* If the file name handler says that dir is unreachable, use
a sensible default. */
@@ -120,17 +117,10 @@ encode_current_directory (void)
dir = build_string ("~");
dir = expand_and_dir_to_file (dir);
-
- if (NILP (Ffile_accessible_directory_p (dir)))
- report_file_error ("Setting current directory",
- BVAR (current_buffer, directory));
-
- /* Remove "/:" from DIR and encode it. */
dir = ENCODE_FILE (remove_slash_colon (dir));
if (! file_accessible_directory_p (dir))
- report_file_error ("Setting current directory",
- BVAR (current_buffer, directory));
+ report_file_error ("Setting current directory", curdir);
return dir;
}
@@ -1570,20 +1560,19 @@ init_callproc (void)
source directory. */
if (data_dir == 0)
{
- Lisp_Object tem, tem1, srcdir;
+ Lisp_Object tem, srcdir;
Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
+ if (!NILP (Fequal (srcdir, Vinvocation_directory))
+ || !file_access_p (SSDATA (tem), F_OK))
{
Lisp_Object newdir;
newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
tem = Fexpand_file_name (build_string ("NEWS"), newdir);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
+ if (file_access_p (SSDATA (tem), F_OK))
Vdata_directory = newdir;
}
}
@@ -1605,9 +1594,22 @@ init_callproc (void)
Lisp_Object gamedir = Qnil;
if (PATH_GAME)
{
- Lisp_Object path_game = build_unibyte_string (PATH_GAME);
+ const char *cpath_game = PATH_GAME;
+#ifdef WINDOWSNT
+ /* On MS-Windows, PATH_GAME normally starts with a literal
+ "%emacs_dir%", so it will never work without some tweaking. */
+ cpath_game = w32_relocate (cpath_game);
+#endif
+ Lisp_Object path_game = build_unibyte_string (cpath_game);
if (file_accessible_directory_p (path_game))
gamedir = path_game;
+ else if (errno != ENOENT && errno != ENOTDIR
+#ifdef DOS_NT
+ /* DOS/Windows sometimes return EACCES for bad file names */
+ && errno != EACCES
+#endif
+ )
+ dir_warning ("game dir", path_game);
}
Vshared_game_score_directory = gamedir;
}
diff --git a/src/charset.c b/src/charset.c
index 8c54381..93206aa 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -2292,14 +2292,18 @@ init_charset (void)
{
/* This used to be non-fatal (dir_warning), but it should not
happen, and if it does sooner or later it will cause some
- obscure problem (eg bug#6401), so better abort. */
- fprintf (stderr, "Error: charsets directory not found:\n\
-%s\n\
-Emacs will not function correctly without the character map files.\n%s\
-Please check your installation!\n",
- SDATA (tempdir),
- egetenv("EMACSDATA") ? "The EMACSDATA environment \
-variable is set, maybe it has the wrong value?\n" : "");
+ obscure problem (eg bug#6401), so better exit. */
+ fprintf (stderr,
+ ("Error: %s: %s\n"
+ "Emacs will not function correctly "
+ "without the character map files.\n"
+ "%s"
+ "Please check your installation!\n"),
+ SDATA (tempdir), strerror (errno),
+ (egetenv ("EMACSDATA")
+ ? ("The EMACSDATA environment variable is set. "
+ "Maybe it has the wrong value?\n")
+ : ""));
exit (1);
}
diff --git a/src/cm.c b/src/cm.c
index e09216a..7947d35 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -30,7 +30,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
int cost; /* sums up costs */
-/* ARGSUSED */
int
evalcost (int c)
{
diff --git a/src/dired.c b/src/dired.c
index 7bc4b83..3768b6d 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -79,9 +79,9 @@ dirent_type (struct dirent *dp)
}
static DIR *
-open_directory (Lisp_Object dirname, int *fdp)
+open_directory (Lisp_Object dirname, Lisp_Object encoded_dirname, int *fdp)
{
- char *name = SSDATA (dirname);
+ char *name = SSDATA (encoded_dirname);
DIR *d;
int fd, opendir_errno;
@@ -167,38 +167,31 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
Lisp_Object match, Lisp_Object nosort, bool attrs,
Lisp_Object id_format)
{
- ptrdiff_t directory_nbytes;
- Lisp_Object list, dirfilename, encoded_directory;
- bool needsep = 0;
- ptrdiff_t count = SPECPDL_INDEX ();
-#ifdef WINDOWSNT
- Lisp_Object w32_save = Qnil;
-#endif
+ if (!NILP (match))
+ CHECK_STRING (match);
/* Don't let the compiler optimize away all copies of DIRECTORY,
which would break GC; see Bug#16986. */
Lisp_Object volatile directory_volatile = directory;
- /* Because of file name handlers, these functions might call
- Ffuncall, and cause a GC. */
- list = encoded_directory = dirfilename = Qnil;
- dirfilename = Fdirectory_file_name (directory);
+ Lisp_Object dirfilename = Fdirectory_file_name (directory);
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
- dirfilename = ENCODE_FILE (dirfilename);
- encoded_directory = ENCODE_FILE (directory);
+ Lisp_Object encoded_dirfilename = ENCODE_FILE (dirfilename);
int fd;
- DIR *d = open_directory (dirfilename, &fd);
+ DIR *d = open_directory (dirfilename, encoded_dirfilename, &fd);
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect_ptr (directory_files_internal_unwind, d);
#ifdef WINDOWSNT
+ Lisp_Object w32_save = Qnil;
if (attrs)
{
/* Do this only once to avoid doing it (in w32.c:stat) for each
@@ -210,7 +203,7 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
- if (is_slow_fs (SSDATA (dirfilename)))
+ if (is_slow_fs (SSDATA (encoded_dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
@@ -218,88 +211,63 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
}
#endif
- directory_nbytes = SBYTES (directory);
+ ptrdiff_t directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
- if (directory_nbytes == 0
- || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
- needsep = 1;
+ bool needsep = (directory_nbytes == 0
+ || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)));
/* Windows users want case-insensitive wildcards. */
- Lisp_Object case_table =
+ Lisp_Object case_table = Qnil;
#ifdef WINDOWSNT
- BVAR (&buffer_defaults, case_canon_table)
-#else
- Qnil
+ case_table = BVAR (&buffer_defaults, case_canon_table);
#endif
- ;
- if (!NILP (match))
- CHECK_STRING (match);
-
- /* Loop reading directory entries. */
+ /* Read directory entries and accumulate them into LIST. */
+ Lisp_Object list = Qnil;
for (struct dirent *dp; (dp = read_dirent (d, directory)); )
{
ptrdiff_t len = dirent_namelen (dp);
Lisp_Object name = make_unibyte_string (dp->d_name, len);
Lisp_Object finalname = name;
- /* Note: DECODE_FILE can GC; it should protect its argument,
- though. */
+ /* This can GC. */
name = DECODE_FILE (name);
- len = SBYTES (name);
- /* Now that we have unwind_protect in place, we might as well
- allow matching to be interrupted. */
maybe_quit ();
- bool wanted = (NILP (match) ||
- fast_string_match_internal (
- match, name, case_table) >= 0);
+ if (!NILP (match)
+ && fast_string_match_internal (match, name, case_table) < 0)
+ continue;
- if (wanted)
+ Lisp_Object fileattrs UNINIT;
+ if (attrs)
{
- if (!NILP (full))
- {
- Lisp_Object fullname;
- ptrdiff_t nbytes = len + directory_nbytes + needsep;
- ptrdiff_t nchars;
-
- fullname = make_uninit_multibyte_string (nbytes, nbytes);
- memcpy (SDATA (fullname), SDATA (directory),
- directory_nbytes);
-
- if (needsep)
- SSET (fullname, directory_nbytes, DIRECTORY_SEP);
-
- memcpy (SDATA (fullname) + directory_nbytes + needsep,
- SDATA (name), len);
-
- nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
-
- /* Some bug somewhere. */
- if (nchars > nbytes)
- emacs_abort ();
-
- STRING_SET_CHARS (fullname, nchars);
- if (nchars == nbytes)
- STRING_SET_UNIBYTE (fullname);
-
- finalname = fullname;
- }
- else
- finalname = name;
+ fileattrs = file_attributes (fd, dp->d_name, directory, name,
+ id_format);
+ if (NILP (fileattrs))
+ continue;
+ }
- if (attrs)
- {
- Lisp_Object fileattrs
- = file_attributes (fd, dp->d_name, directory, name, id_format);
- list = Fcons (Fcons (finalname, fileattrs), list);
- }
- else
- list = Fcons (finalname, list);
+ if (!NILP (full))
+ {
+ ptrdiff_t name_nbytes = SBYTES (name);
+ ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes;
+ ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name);
+ finalname = make_uninit_multibyte_string (nchars, nbytes);
+ if (nchars == nbytes)
+ STRING_SET_UNIBYTE (finalname);
+ memcpy (SDATA (finalname), SDATA (directory), directory_nbytes);
+ if (needsep)
+ SSET (finalname, directory_nbytes, DIRECTORY_SEP);
+ memcpy (SDATA (finalname) + directory_nbytes + needsep,
+ SDATA (name), name_nbytes);
}
+ else
+ finalname = name;
+
+ list = Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, list);
}
closedir (d);
@@ -329,14 +297,14 @@ If MATCH is non-nil, mention only file names that match
the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
Otherwise, the list returned is sorted with `string-lessp'.
NOSORT is useful if you plan to sort the result yourself. */)
- (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object
nosort)
+ (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
+ Lisp_Object nosort)
{
- Lisp_Object handler;
directory = Fexpand_file_name (directory, Qnil);
/* If the file name has special constructs in it,
call the corresponding file name handler. */
- handler = Ffind_file_name_handler (directory, Qdirectory_files);
+ Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files);
if (!NILP (handler))
return call5 (handler, Qdirectory_files, directory,
full, match, nosort);
@@ -364,14 +332,15 @@ ID-FORMAT specifies the preferred format of attributes
uid and gid, see
`file-attributes' for further documentation.
On MS-Windows, performance depends on `w32-get-true-file-attributes',
which see. */)
- (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object
nosort, Lisp_Object id_format)
+ (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
+ Lisp_Object nosort, Lisp_Object id_format)
{
- Lisp_Object handler;
directory = Fexpand_file_name (directory, Qnil);
/* If the file name has special constructs in it,
call the corresponding file name handler. */
- handler = Ffind_file_name_handler (directory,
Qdirectory_files_and_attributes);
+ Lisp_Object handler
+ = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
if (!NILP (handler))
return call6 (handler, Qdirectory_files_and_attributes,
directory, full, match, nosort, id_format);
@@ -508,7 +477,7 @@ file_name_completion (Lisp_Object file, Lisp_Object
dirname, bool all_flag,
}
}
int fd;
- DIR *d = open_directory (encoded_dir, &fd);
+ DIR *d = open_directory (dirname, encoded_dir, &fd);
record_unwind_protect_ptr (directory_files_internal_unwind, d);
/* Loop reading directory entries. */
@@ -850,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
@@ -970,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))
@@ -987,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);
}
@@ -1031,7 +999,8 @@ file_attributes (int fd, char const *name,
INT_TO_INTEGER (s.st_dev));
}
-DEFUN ("file-attributes-lessp", Ffile_attributes_lessp,
Sfile_attributes_lessp, 2, 2, 0,
+DEFUN ("file-attributes-lessp", Ffile_attributes_lessp,
+ Sfile_attributes_lessp, 2, 2, 0,
doc: /* Return t if first arg file attributes list is less than second.
Comparison is in lexicographic order and case is significant. */)
(Lisp_Object f1, Lisp_Object f2)
diff --git a/src/doc.c b/src/doc.c
index 247be79..b06b87c 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -136,7 +136,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool
definition)
}
if (fd < 0)
{
- if (errno == EMFILE || errno == ENFILE)
+ if (errno != ENOENT && errno != ENOTDIR)
report_file_error ("Read error on documentation file", file);
SAFE_FREE ();
diff --git a/src/emacs.c b/src/emacs.c
index 5a52668..eb73281 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';
@@ -923,7 +923,6 @@ load_pdump (int argc, char **argv)
}
#endif /* HAVE_PDUMPER */
-/* ARGSUSED */
int
main (int argc, char **argv)
{
diff --git a/src/eval.c b/src/eval.c
index 06d5c63..2bfc16e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1890,7 +1890,6 @@ verror (const char *m, va_list ap)
/* Dump an error message; called like printf. */
-/* VARARGS 1 */
void
error (const char *m, ...)
{
@@ -2649,7 +2648,6 @@ call0 (Lisp_Object fn)
}
/* Call function fn with 1 argument arg1. */
-/* ARGSUSED */
Lisp_Object
call1 (Lisp_Object fn, Lisp_Object arg1)
{
@@ -2657,7 +2655,6 @@ call1 (Lisp_Object fn, Lisp_Object arg1)
}
/* Call function fn with 2 arguments arg1, arg2. */
-/* ARGSUSED */
Lisp_Object
call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
{
@@ -2665,7 +2662,6 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
}
/* Call function fn with 3 arguments arg1, arg2, arg3. */
-/* ARGSUSED */
Lisp_Object
call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
@@ -2673,7 +2669,6 @@ call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object
arg2, Lisp_Object arg3)
}
/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
-/* ARGSUSED */
Lisp_Object
call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
Lisp_Object arg4)
@@ -2682,7 +2677,6 @@ call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object
arg2, Lisp_Object arg3,
}
/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
-/* ARGSUSED */
Lisp_Object
call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
Lisp_Object arg4, Lisp_Object arg5)
@@ -2691,7 +2685,6 @@ call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object
arg2, Lisp_Object arg3,
}
/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
-/* ARGSUSED */
Lisp_Object
call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6)
@@ -2700,7 +2693,6 @@ call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object
arg2, Lisp_Object arg3,
}
/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7.
*/
-/* ARGSUSED */
Lisp_Object
call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7)
@@ -2710,7 +2702,6 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object
arg2, Lisp_Object arg3,
/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5,
arg6, arg7, arg8. */
-/* ARGSUSED */
Lisp_Object
call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7,
diff --git a/src/fileio.c b/src/fileio.c
index cbc0c89..5337ea5 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -134,60 +134,45 @@ static dev_t timestamp_file_system;
is added here. */
static Lisp_Object Vwrite_region_annotation_buffers;
+static Lisp_Object file_name_directory (Lisp_Object);
static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
Lisp_Object *, struct coding_system *);
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,
@@ -250,6 +235,44 @@ 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);
+}
+
+/* In theory, EACCES errors for predicates like file-readable-p should
+ be checked further because they may be problems with an ancestor
+ directory instead of with the file itself, which means that we
+ don't have reliable info about the requested file. In practice,
+ though, such errors are common enough that signaling them can be
+ annoying even if the errors are real (e.g., Bug#37445). So return
+ nil for EACCES unless compiling with -DPICKY_EACCES, which is off
+ by default. */
+#ifndef PICKY_EACCES
+enum { PICKY_EACCES = false };
+#endif
+
+Lisp_Object
+file_test_errno (Lisp_Object file, int err)
+{
+ if (!PICKY_EACCES && err == EACCES)
+ return Qnil;
+ return file_metadata_errno ("Testing file", file, err);
+}
+
void
close_file_unwind (int fd)
{
@@ -356,6 +379,15 @@ Given a Unix syntax file name, returns a string ending in
slash. */)
return STRINGP (handled_name) ? handled_name : Qnil;
}
+ return file_name_directory (filename);
+}
+
+/* Return the directory component of FILENAME, or nil if FILENAME does
+ not contain a directory component. */
+
+static Lisp_Object
+file_name_directory (Lisp_Object filename)
+{
char *beg = SSDATA (filename);
char const *p = beg + SBYTES (filename);
@@ -2369,41 +2401,48 @@ internal_delete_file (Lisp_Object filename)
return NILP (tem);
}
-/* Filesystems are case-sensitive on all supported systems except
- MS-Windows, MS-DOS, Cygwin, and Mac OS X. They are always
- case-insensitive on the first two, but they may or may not be
- case-insensitive on Cygwin and OS X. The following function
- attempts to provide a runtime test on those two systems. If the
- test is not conclusive, we assume case-insensitivity on Cygwin and
- case-sensitivity on Mac OS X.
-
- FIXME: Mounted filesystems on Posix hosts, like Samba shares or
- NFS-mounted Windows volumes, might be case-insensitive. Can we
- detect this? */
+/* Return -1 if FILE is a case-insensitive file name, 0 if not,
+ and a positive errno value if the result cannot be determined. */
-static bool
-file_name_case_insensitive_p (const char *filename)
+static int
+file_name_case_insensitive_err (Lisp_Object file)
{
- /* Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
- those flags are available. As of this writing (2017-05-20),
+ /* Filesystems are case-sensitive on all supported systems except
+ MS-Windows, MS-DOS, Cygwin, and macOS. They are always
+ case-insensitive on the first two, but they may or may not be
+ case-insensitive on Cygwin and macOS so do a runtime test on
+ those two systems. If the test is not conclusive, assume
+ case-insensitivity on Cygwin and case-sensitivity on macOS.
+
+ FIXME: Mounted filesystems on Posix hosts, like Samba shares or
+ NFS-mounted Windows volumes, might be case-insensitive. Can we
+ detect this?
+
+ Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
+ those flags are available. As of this writing (2019-09-15),
Cygwin is the only platform known to support the former (starting
with Cygwin-2.6.1), and macOS is the only platform known to
support the latter. */
-#ifdef _PC_CASE_INSENSITIVE
- int res = pathconf (filename, _PC_CASE_INSENSITIVE);
+#if defined _PC_CASE_INSENSITIVE || defined _PC_CASE_SENSITIVE
+ char *filename = SSDATA (ENCODE_FILE (file));
+# ifdef _PC_CASE_INSENSITIVE
+ long int res = pathconf (filename, _PC_CASE_INSENSITIVE);
if (res >= 0)
- return res > 0;
-#elif defined _PC_CASE_SENSITIVE
- int res = pathconf (filename, _PC_CASE_SENSITIVE);
+ return - (res > 0);
+# else
+ long int res = pathconf (filename, _PC_CASE_SENSITIVE);
if (res >= 0)
- return res == 0;
+ return - (res == 0);
+# endif
+ if (errno != EINVAL)
+ return errno;
#endif
#if defined CYGWIN || defined DOS_NT
- return true;
+ return -1;
#else
- return false;
+ return 0;
#endif
}
@@ -2426,21 +2465,22 @@ The arg must be a string. */)
/* If the file doesn't exist, move up the filesystem tree until we
reach an existing directory or the root. */
- if (NILP (Ffile_exists_p (filename)))
+ while (true)
{
- filename = Ffile_name_directory (filename);
- while (NILP (Ffile_exists_p (filename)))
+ int err = file_name_case_insensitive_err (filename);
+ switch (err)
{
- Lisp_Object newname = expand_and_dir_to_file (filename);
- /* Avoid infinite loop if the root is reported as non-existing
- (impossible?). */
- if (!NILP (Fstring_equal (newname, filename)))
- break;
- filename = newname;
+ 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?). */
+ if (!NILP (Fstring_equal (parent, filename)))
+ return Qnil;
+ filename = parent;
}
- filename = ENCODE_FILE (filename);
- return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil;
}
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
@@ -2546,7 +2586,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);
@@ -2694,32 +2734,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
+ || (PICKY_EACCES && 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,
@@ -2729,21 +2785,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,
@@ -2751,21 +2793,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,
@@ -2775,7 +2803,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,
@@ -2785,25 +2812,34 @@ 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;
- dir = Ffile_name_directory (absname);
+ dir = file_name_directory (absname);
eassert (!NILP (dir));
#ifdef MSDOS
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
}
@@ -2835,8 +2871,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 =
@@ -2855,6 +2891,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.
@@ -2874,9 +2931,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,
@@ -2893,9 +2949,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.
@@ -2905,7 +2961,10 @@ file_directory_p (Lisp_Object file)
{
#ifdef DOS_NT
/* This is cheaper than 'stat'. */
- return faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0;
+ bool retval = faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0;
+ if (!retval && errno == EACCES)
+ errno = ENOTDIR; /* like the non-DOS_NT branch below does */
+ return retval;
#else
# ifdef O_PATH
/* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */
@@ -2920,7 +2979,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
@@ -2976,8 +3035,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
@@ -3029,7 +3093,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;
@@ -3053,27 +3117,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,
@@ -3083,7 +3141,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)
{
@@ -3097,13 +3155,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);
@@ -3118,6 +3174,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
@@ -3213,8 +3272,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;
@@ -3229,20 +3287,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);
@@ -3313,7 +3373,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;
@@ -3325,11 +3385,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);
}
@@ -3473,14 +3530,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);
@@ -3612,7 +3682,7 @@ file_offset (Lisp_Object val)
static struct timespec
time_error_value (int errnum)
{
- int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
+ int ns = (errnum == ENOENT || errnum == ENOTDIR
? NONEXISTENT_MODTIME_NSECS
: UNKNOWN_MODTIME_NSECS);
return make_timespec (0, ns);
@@ -5672,13 +5742,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;
@@ -5822,7 +5892,7 @@ A non-nil CURRENT-ONLY argument means save only current
buffer. */)
if (!NILP (Vrun_hooks))
{
Lisp_Object dir;
- dir = Ffile_name_directory (listfile);
+ dir = file_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
internal_condition_case_1 (do_auto_save_make_dir,
dir, Qt,
@@ -6067,16 +6137,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,
@@ -6087,22 +6159,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 46349a6..ff25d64 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 address@hidden:BOOT_TIME. If can't parse, return -1. */
+ /* Parse address@hidden: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 <https://bugzilla.redhat.com/show_bug.cgi?id=1384153>. */
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/fns.c b/src/fns.c
index df921e2..f45c729 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -532,14 +532,12 @@ Do NOT use this function to compare file names for
equality. */)
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
enum Lisp_Type target_type, bool last_special);
-/* ARGSUSED */
Lisp_Object
concat2 (Lisp_Object s1, Lisp_Object s2)
{
return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0);
}
-/* ARGSUSED */
Lisp_Object
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
{
@@ -2577,7 +2575,6 @@ This makes STRING unibyte and may change its length. */)
return Qnil;
}
-/* ARGSUSED */
Lisp_Object
nconc2 (Lisp_Object s1, Lisp_Object s2)
{
diff --git a/src/lisp.h b/src/lisp.h
index 024e5ed..b081ae1 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3824,9 +3824,10 @@ extern void mark_maybe_objects (Lisp_Object const *,
ptrdiff_t);
extern void mark_stack (char const *, char const *);
extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
extern void garbage_collect (void);
+extern void maybe_garbage_collect (void);
extern const char *pending_malloc_warning;
extern Lisp_Object zero_vector;
-extern intmax_t consing_until_gc;
+extern EMACS_INT consing_until_gc;
#ifdef HAVE_PDUMPER
extern int number_finalizers_run;
#endif
@@ -4298,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);
@@ -4309,12 +4309,15 @@ 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 Lisp_Object file_test_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);
@@ -5056,7 +5059,7 @@ INLINE void
maybe_gc (void)
{
if (consing_until_gc < 0)
- garbage_collect ();
+ maybe_garbage_collect ();
}
INLINE_HEADER_END
diff --git a/src/lread.c b/src/lread.c
index 6ae7a0d..ab0fab4 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_test_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
diff --git a/src/print.c b/src/print.c
index 7c3da68..7e5aed8 100644
--- a/src/print.c
+++ b/src/print.c
@@ -81,7 +81,7 @@ static ptrdiff_t print_buffer_pos_byte;
-N the object will be printed several times and will take number N.
N the object has been printed so we can refer to it as #N#.
print_number_index holds the largest N already used.
- N has to be striclty larger than 0 since we need to distinguish -N. */
+ N has to be strictly larger than 0 since we need to distinguish -N. */
static ptrdiff_t print_number_index;
static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
@@ -1120,8 +1120,8 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool
escapeflag)
Vprint_number_table = Qnil;
}
- /* Construct Vprint_number_table for print-gensym and print-circle. */
- if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
+ /* Construct Vprint_number_table for print-circle. */
+ if (!NILP (Vprint_circle))
{
/* Construct Vprint_number_table.
This increments print_number_index for the objects added. */
@@ -1149,7 +1149,11 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool
escapeflag)
}
#define PRINT_CIRCLE_CANDIDATE_P(obj) \
- (STRINGP (obj) || CONSP (obj) \
+ ((STRINGP (obj) \
+ && (string_intervals (obj) \
+ || print_depth > 1 \
+ || !NILP (Vprint_continuous_numbering))) \
+ || CONSP (obj) \
|| (VECTORLIKEP (obj) \
&& (VECTORP (obj) || COMPILEDP (obj) \
|| CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
@@ -1159,13 +1163,14 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool
escapeflag)
&& SYMBOLP (obj) \
&& !SYMBOL_INTERNED_P (obj)))
-/* Construct Vprint_number_table according to the structure of OBJ.
- OBJ itself and all its elements will be added to Vprint_number_table
- recursively if it is a list, vector, compiled function, char-table,
- string (its text properties will be traced), or a symbol that has
- no obarray (this is for the print-gensym feature).
- The status fields of Vprint_number_table mean whether each object appears
- more than once in OBJ: Qnil at the first time, and Qt after that. */
+/* Construct Vprint_number_table for the print-circle feature
+ according to the structure of OBJ. OBJ itself and all its elements
+ will be added to Vprint_number_table recursively if it is a list,
+ vector, compiled function, char-table, string (its text properties
+ will be traced), or a symbol that has no obarray (this is for the
+ print-gensym feature). The status fields of Vprint_number_table
+ mean whether each object appears more than once in OBJ: Qnil at the
+ first time, and Qt after that. */
static void
print_preprocess (Lisp_Object obj)
{
@@ -1174,20 +1179,7 @@ print_preprocess (Lisp_Object obj)
int loop_count = 0;
Lisp_Object halftail;
- /* Avoid infinite recursion for circular nested structure
- in the case where Vprint_circle is nil. */
- if (NILP (Vprint_circle))
- {
- /* Give up if we go so deep that print_object will get an error. */
- /* See similar code in print_object. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
- for (i = 0; i < print_depth; i++)
- if (EQ (obj, being_printed[i]))
- return;
- being_printed[print_depth] = obj;
- }
+ eassert (!NILP (Vprint_circle));
print_depth++;
halftail = obj;
@@ -1198,33 +1190,28 @@ print_preprocess (Lisp_Object obj)
if (!HASH_TABLE_P (Vprint_number_table))
Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq);
- /* In case print-circle is nil and print-gensym is t,
- add OBJ to Vprint_number_table only when OBJ is a symbol. */
- if (! NILP (Vprint_circle) || SYMBOLP (obj))
- {
- Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
- if (!NILP (num)
- /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
- always print the gensym with a number. This is a special for
- the lisp function byte-compile-output-docform. */
- || (!NILP (Vprint_continuous_numbering)
- && SYMBOLP (obj)
- && !SYMBOL_INTERNED_P (obj)))
- { /* OBJ appears more than once. Let's remember that. */
- if (!FIXNUMP (num))
- {
- print_number_index++;
- /* Negative number indicates it hasn't been printed yet. */
- Fputhash (obj, make_fixnum (- print_number_index),
- Vprint_number_table);
- }
- print_depth--;
- return;
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (!NILP (num)
+ /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
+ always print the gensym with a number. This is a special for
+ the lisp function byte-compile-output-docform. */
+ || (!NILP (Vprint_continuous_numbering)
+ && SYMBOLP (obj)
+ && !SYMBOL_INTERNED_P (obj)))
+ { /* OBJ appears more than once. Let's remember that. */
+ if (!FIXNUMP (num))
+ {
+ print_number_index++;
+ /* Negative number indicates it hasn't been printed yet. */
+ Fputhash (obj, make_fixnum (- print_number_index),
+ Vprint_number_table);
}
- else
- /* OBJ is not yet recorded. Let's add to the table. */
- Fputhash (obj, Qt, Vprint_number_table);
+ print_depth--;
+ return;
}
+ else
+ /* OBJ is not yet recorded. Let's add to the table. */
+ Fputhash (obj, Qt, Vprint_number_table);
switch (XTYPE (obj))
{
@@ -1271,11 +1258,15 @@ print_preprocess (Lisp_Object obj)
DEFUN ("print--preprocess", Fprint_preprocess, Sprint_preprocess, 1, 1, 0,
doc: /* Extract sharing info from OBJECT needed to print it.
-Fills `print-number-table'. */)
- (Lisp_Object object)
+Fills `print-number-table' if `print-circle' is non-nil. Does nothing
+if `print-circle' is nil. */)
+ (Lisp_Object object)
{
- print_number_index = 0;
- print_preprocess (object);
+ if (!NILP (Vprint_circle))
+ {
+ print_number_index = 0;
+ print_preprocess (object);
+ }
return Qnil;
}
@@ -1860,7 +1851,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
/* Simple but incomplete way. */
int i;
- /* See similar code in print_preprocess. */
if (print_depth >= PRINT_CIRCLE)
error ("Apparently circular structure being printed");
diff --git a/src/profiler.c b/src/profiler.c
index 6943905..84583ce 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -66,11 +66,11 @@ make_log (void)
Qnil, false);
struct Lisp_Hash_Table *h = XHASH_TABLE (log);
- /* What is special about our hash-tables is that the keys are pre-filled
- with the vectors we'll put in them. */
+ /* What is special about our hash-tables is that the values are pre-filled
+ with the vectors we'll use as keys. */
ptrdiff_t i = ASIZE (h->key_and_value) >> 1;
while (i > 0)
- set_hash_key_slot (h, --i, make_nil_vector (max_stack_depth));
+ set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth));
return log;
}
@@ -132,13 +132,14 @@ static void evict_lower_half (log_t *log)
XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */
Fremhash (key, tmp);
}
+ eassert (EQ (Qunbound, HASH_KEY (log, i)));
eassert (log->next_free == i);
eassert (VECTORP (key));
for (ptrdiff_t j = 0; j < ASIZE (key); j++)
ASET (key, j, Qnil);
- set_hash_key_slot (log, i, key);
+ set_hash_value_slot (log, i, key);
}
}
@@ -156,7 +157,8 @@ record_backtrace (log_t *log, EMACS_INT count)
ptrdiff_t index = log->next_free;
/* Get a "working memory" vector. */
- Lisp_Object backtrace = HASH_KEY (log, index);
+ Lisp_Object backtrace = HASH_VALUE (log, index);
+ eassert (EQ (Qunbound, HASH_KEY (log, index)));
get_backtrace (backtrace);
{ /* We basically do a `gethash+puthash' here, except that we have to be
diff --git a/src/term.c b/src/term.c
index a88d47f..5f70c7a 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1084,7 +1084,6 @@ int *char_ins_del_vector;
#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS ((f))])
-/* ARGSUSED */
static void
calculate_ins_del_char_costs (struct frame *f)
{
diff --git a/src/w32.c b/src/w32.c
index d7a9169..88e9aef 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -4151,13 +4151,36 @@ w32_accessible_directory_p (const char *dirname,
ptrdiff_t dirlen)
/* In case DIRNAME cannot be expressed in characters from the
current ANSI codepage. */
if (_mbspbrk (pat_a, "?"))
- dh = INVALID_HANDLE_VALUE;
- else
- dh = FindFirstFileA (pat_a, &dfd_a);
+ {
+ errno = ENOENT;
+ return 0;
+ }
+ dh = FindFirstFileA (pat_a, &dfd_a);
}
if (dh == INVALID_HANDLE_VALUE)
+ {
+ DWORD w32err = GetLastError ();
+
+ switch (w32err)
+ {
+ case ERROR_INVALID_NAME:
+ case ERROR_BAD_PATHNAME:
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ case ERROR_NO_MORE_FILES:
+ case ERROR_BAD_NETPATH:
+ errno = ENOENT;
+ break;
+ case ERROR_NOT_READY:
+ errno = ENODEV;
+ break;
+ default:
+ errno = EACCES;
+ break;
+ }
return 0;
+ }
FindClose (dh);
return 1;
}
diff --git a/src/w32fns.c b/src/w32fns.c
index d6fd8f5..34abd02 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.
diff --git a/src/w32font.c b/src/w32font.c
index 14d49b2..9a33471 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);
diff --git a/src/xdisp.c b/src/xdisp.c
index 94f969f..6626fbc 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -12907,7 +12907,8 @@ tool_bar_height (struct frame *f, int *n_rows, bool
pixelwise)
temp_row->reversed_p = false;
it.first_visible_x = 0;
it.last_visible_x = WINDOW_PIXEL_WIDTH (w);
- reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1);
+ reseat_to_string (&it, NULL, f->desired_tool_bar_string,
+ 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string));
it.paragraph_embedding = L2R;
while (!ITERATOR_AT_END_P (&it))
@@ -12994,7 +12995,8 @@ redisplay_tool_bar (struct frame *f)
/* Build a string that represents the contents of the tool-bar. */
build_desired_tool_bar_string (f);
- reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1);
+ reseat_to_string (&it, NULL, f->desired_tool_bar_string,
+ 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string));
/* FIXME: This should be controlled by a user option. But it
doesn't make sense to have an R2L tool bar if the menu bar cannot
be drawn also R2L, and making the menu bar R2L is tricky due
@@ -23531,7 +23533,7 @@ display_menu_bar (struct window *w)
/* Display the item, pad with one space. */
if (it.current_x < it.last_visible_x)
display_string (NULL, string, Qnil, 0, 0, &it,
- SCHARS (string) + 1, 0, 0, -1);
+ SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string));
}
/* Fill out the line with spaces. */
diff --git a/src/xwidget.c b/src/xwidget.c
index 121510e..ecb3793 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -31,14 +31,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <webkit2/webkit2.h>
#include <JavaScriptCore/JavaScript.h>
-/* 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);
}
diff --git a/test/lisp/emacs-lisp/backquote-tests.el
b/test/lisp/emacs-lisp/backquote-tests.el
new file mode 100644
index 0000000..01f2c4a
--- /dev/null
+++ b/test/lisp/emacs-lisp/backquote-tests.el
@@ -0,0 +1,47 @@
+;;; backquote-tests.el --- Tests for backquote.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest backquote-test-basic ()
+ (let ((lst '(ba bb bc))
+ (vec [ba bb bc]))
+ (should (equal 3 `,(eval '(+ x y) '((x . 1) (y . 2)))))
+ (should (equal vec `[,@lst]))
+ (should (equal `(a lst c) '(a lst c)))
+ (should (equal `(a ,lst c) '(a (ba bb bc) c)))
+ (should (equal `(a ,@lst c) '(a ba bb bc c)))
+ ;; Vectors work just like lists.
+ (should (equal `(a vec c) '(a vec c)))
+ (should (equal `(a ,vec c) '(a [ba bb bc] c)))
+ (should (equal `(a ,@vec c) '(a ba bb bc c)))))
+
+(ert-deftest backquote-test-nested ()
+ "Test nested backquotes."
+ (let ((lst '(ba bb bc))
+ (vec [ba bb bc]))
+ (should (equal `(a ,`(,@lst) c) `(a ,lst c)))
+ (should (equal `(a ,`[,@lst] c) `(a ,vec c)))
+ (should (equal `(a ,@`[,@lst] c) `(a ,@lst c)))))
+
+;;; backquote-tests.el ends here
diff --git a/test/lisp/emacs-lisp/backtrace-tests.el
b/test/lisp/emacs-lisp/backtrace-tests.el
index ce827e0..be15495 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -335,6 +335,55 @@ line contains the strings \"lambda\" and \"number\"."
(should (string-match-p results
(backtrace-tests--get-substring (point-min)
(point-max)))))))
+(ert-deftest backtrace-tests--print-gensym ()
+ "Backtrace buffers can toggle `print-gensym' syntax."
+ (ert-with-test-buffer (:name "print-gensym")
+ (let* ((print-gensym nil)
+ (arg (list (gensym "first") (gensym) (gensym "last")))
+ (results (backtrace-tests--make-regexp
+ (backtrace-tests--result arg)))
+ (results-gensym (regexp-quote (let ((print-gensym t))
+ (backtrace-tests--result arg))))
+ (last-frame (backtrace-tests--make-regexp
+ (format (nth (1- backtrace-tests--line-count)
+ (backtrace-tests--backtrace-lines))
+ arg)))
+ (last-frame-gensym (regexp-quote
+ (let ((print-gensym t))
+ (format (nth (1- backtrace-tests--line-count)
+
(backtrace-tests--backtrace-lines))
+ arg)))))
+ (backtrace-tests--make-backtrace arg)
+ (backtrace-print)
+ (should (string-match-p results
+ (backtrace-tests--get-substring (point-min)
(point-max))))
+ ;; Go to the last frame.
+ (goto-char (point-max))
+ (forward-line -1)
+ ;; Turn on print-gensym for that frame.
+ (backtrace-toggle-print-gensym)
+ (should (string-match-p last-frame-gensym
+ (backtrace-tests--get-substring (point)
(point-max))))
+ ;; Turn off print-gensym for the frame.
+ (backtrace-toggle-print-gensym)
+ (should (string-match-p last-frame
+ (backtrace-tests--get-substring (point)
(point-max))))
+ (should (string-match-p results
+ (backtrace-tests--get-substring (point-min)
(point-max))))
+ ;; Turn print-gensym on for the buffer.
+ (backtrace-toggle-print-gensym '(4))
+ (should (string-match-p last-frame-gensym
+ (backtrace-tests--get-substring (point)
(point-max))))
+ (should (string-match-p results-gensym
+ (backtrace-tests--get-substring (point-min)
(point-max))))
+ ;; Turn print-gensym off.
+ (backtrace-toggle-print-gensym '(4))
+ (should (string-match-p last-frame
+ (backtrace-tests--get-substring
+ (point) (+ (point) (length last-frame)))))
+ (should (string-match-p results
+ (backtrace-tests--get-substring (point-min)
(point-max)))))))
+
(defun backtrace-tests--make-regexp (str)
"Make regexp from STR for `backtrace-tests--print-circle'.
Used for results of printing circular objects without
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el
b/test/lisp/emacs-lisp/cl-print-tests.el
index 406c528..31d79df 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -19,109 +19,17 @@
;;; Commentary:
+;; See test/src/print-tests.el for tests which apply to both
+;; cl-print.el and src/print.c.
+
;;; Code:
(require 'ert)
-(cl-defstruct cl-print--test a b)
-
-(ert-deftest cl-print-tests-1 ()
- "Test cl-print code."
- (let ((x (make-cl-print--test :a 1 :b 2)))
- (let ((print-circle nil))
- (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
- "((x . #s(cl-print--test :a 1 :b 2)) (y .
#s(cl-print--test :a 1 :b 2)))")))
- (let ((print-circle t))
- (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
- "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))")))
- (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^)]*)\\'"
- (cl-prin1-to-string (symbol-function #'caar))))))
-
-(ert-deftest cl-print-tests-2 ()
- (let ((x (record 'foo 1 2 3)))
- (should (equal
- x
- (car (read-from-string (with-output-to-string (prin1 x))))))
- (let ((print-circle t))
- (should (string-match
- "\\`(#1=#s(foo 1 2 3) #1#)\\'"
- (cl-prin1-to-string (list x x)))))))
-
(cl-defstruct (cl-print-tests-struct
(:constructor cl-print-tests-con))
a b c d e)
-(ert-deftest cl-print-tests-3 ()
- "CL printing observes `print-length'."
- (let ((long-list (make-list 5 'a))
- (long-vec (make-vector 5 'b))
- (long-struct (cl-print-tests-con))
- (long-string (make-string 5 ?a))
- (print-length 4))
- (should (equal "(a a a a ...)" (cl-prin1-to-string long-list)))
- (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec)))
- (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)"
- (cl-prin1-to-string long-struct)))
- (should (equal "\"aaaa...\"" (cl-prin1-to-string long-string)))))
-
-(ert-deftest cl-print-tests-4 ()
- "CL printing observes `print-level'."
- (let* ((deep-list '(a (b (c (d (e))))))
- (buried-vector '(a (b (c (d [e])))))
- (deep-struct (cl-print-tests-con))
- (buried-struct `(a (b (c (d ,deep-struct)))))
- (buried-string '(a (b (c (d #("hello" 0 5 (cl-print-test t)))))))
- (buried-simple-string '(a (b (c (d "hello")))))
- (print-level 4))
- (setf (cl-print-tests-struct-a deep-struct) deep-list)
- (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list)))
- (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector)))
- (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct)))
- (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-string)))
- (should (equal "(a (b (c (d \"hello\"))))"
- (cl-prin1-to-string buried-simple-string)))
- (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil
:d nil :e nil)"
- (cl-prin1-to-string deep-struct)))))
-
-(ert-deftest cl-print-tests-5 ()
- "CL printing observes `print-quoted'."
- (let ((quoted-stuff '('a #'b `(,c ,@d))))
- (let ((print-quoted t))
- (should (equal "('a #'b `(,c ,@d))"
- (cl-prin1-to-string quoted-stuff))))
- (let ((print-quoted nil))
- (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
- (cl-prin1-to-string quoted-stuff))))))
-
-(ert-deftest cl-print-tests-strings ()
- "CL printing prints strings and propertized strings."
- (let* ((str1 "abcdefghij")
- (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t)))
- (str3 #("abcdefghij" 0 10 (test t)))
- (obj '(a b))
- ;; Since the byte compiler reuses string literals,
- ;; and the put-text-property call is destructive, use
- ;; copy-sequence to make a new string.
- (str4 (copy-sequence "abcdefghij")))
- (put-text-property 0 5 'test obj str4)
- (put-text-property 7 10 'test obj str4)
-
- (should (equal "\"abcdefghij\"" (cl-prin1-to-string str1)))
- (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))"
- (cl-prin1-to-string str2)))
- (should (equal "#(\"abcdefghij\" 0 10 (test t))"
- (cl-prin1-to-string str3)))
- (let ((print-circle nil))
- (should
- (equal
- "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))"
- (cl-prin1-to-string str4))))
- (let ((print-circle t))
- (should
- (equal
- "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))"
- (cl-prin1-to-string str4))))))
-
(ert-deftest cl-print-tests-ellipsis-cons ()
"Ellipsis expansion works in conses."
(let ((print-length 4)
@@ -216,23 +124,6 @@
(should (string-match expanded (with-output-to-string
(cl-print-expand-ellipsis value nil))))))
-(ert-deftest cl-print-circle ()
- (let ((x '(#1=(a . #1#) #1#)))
- (let ((print-circle nil))
- (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'"
- (cl-prin1-to-string x))))
- (let ((print-circle t))
- (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x))))))
-
-(ert-deftest cl-print-circle-2 ()
- ;; Bug#31146.
- (let ((x '(0 . #1=(0 . #1#))))
- (let ((print-circle nil))
- (should (string-match "\\`(0 0 . #[0-9])\\'"
- (cl-prin1-to-string x))))
- (let ((print-circle t))
- (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x))))))
-
(ert-deftest cl-print-tests-print-to-string-with-limit ()
(let* ((thing10 (make-list 10 'a))
(thing100 (make-list 100 'a))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index dd6b9ed..d7e0a04 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2412,9 +2412,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
;; FIXME: This fails on my QNAP server, see
;; /share/Web/owncloud/data/owncloud.log
- (unless (and (tramp--test-nextcloud-p)
- (or (not (file-remote-p source))
- (not (file-remote-p target))))
+ (unless (tramp--test-nextcloud-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2437,8 +2435,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
;; FIXME: This fails on my QNAP server, see
;; /share/Web/owncloud/data/owncloud.log
- (unless
- (and (tramp--test-nextcloud-p) (not (file-remote-p source)))
+ (unless (tramp--test-nextcloud-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -4407,7 +4404,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"foo"
(funcall
this-shell-command-to-string
- (format "echo -n ${%s:?bla}" envvar))))))
+ (format "echo -n ${%s:-bla}" envvar))))))
(unwind-protect
;; Set the empty value.
@@ -4419,7 +4416,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"bla"
(funcall
this-shell-command-to-string
- (format "echo -n ${%s:?bla}" envvar))))
+ (format "echo -n ${%s:-bla}" envvar))))
;; Variable is set.
(should
(string-match
@@ -4441,7 +4438,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"foo"
(funcall
this-shell-command-to-string
- (format "echo -n ${%s:?bla}" envvar))))
+ (format "echo -n ${%s:-bla}" envvar))))
(let ((process-environment
(cons envvar process-environment)))
;; Variable is unset.
@@ -4450,12 +4447,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
"bla"
(funcall
this-shell-command-to-string
- (format "echo -n ${%s:?bla}" envvar))))
+ (format "echo -n ${%s:-bla}" envvar))))
;; Variable is unset.
(should-not
(string-match
(regexp-quote envvar)
- (funcall this-shell-command-to-string "env")))))))))
+ ;; We must remove PS1, the output is truncated otherwise.
+ (funcall
+ this-shell-command-to-string "printenv | grep -v PS1")))))))))
;; This test is inspired by Bug#27009.
(ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -5303,7 +5302,7 @@ This requires restrictions of file name syntax."
;; of process output. So we unset it temporarily.
(setenv "PS1")
(with-temp-buffer
- (should (zerop (process-file "env" nil t nil)))
+ (should (zerop (process-file "printenv" nil t nil)))
(goto-char (point-min))
(should
(re-search-forward
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index b1cf7e8..c5ad1df 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1351,7 +1351,7 @@ this is an arbitrarily
expected)))))
-;;; Autofill
+;;; Filling
(ert-deftest python-auto-fill-docstring ()
(python-tests-with-temp-buffer
@@ -1368,6 +1368,17 @@ def some_function(arg1,
(forward-line 1)
(should (= docindent (current-indentation))))))
+(ert-deftest python-fill-docstring ()
+ (python-tests-with-temp-buffer
+ "\
+r'''aaa
+
+this is a test this is a test this is a test this is a test this is a test
this is a test.
+'''"
+ (search-forward "test.")
+ (fill-paragraph)
+ (should (= (current-indentation) 0))))
+
;;; Mark
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index f7bf2d9..f42d47c 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -514,7 +514,9 @@ Return the last evalled form in BODY."
(should
(replace-tests-with-undo
input "theorem \\([0-9]+\\)"
- "theorem \\\\ref{theo_\\1}"
+ '(replace-eval-replacement
+ replace-quote
+ (format "theorem \\\\ref{theo_%d}" (1+ (string-to-number
(match-string 1)))))
((?\s . (1 2)) (?U . (3)))
?q
(string= input (buffer-string)))))
@@ -530,4 +532,18 @@ Return the last evalled form in BODY."
?q
(string= expected (buffer-string))))))
+(ert-deftest query-replace-undo-bug37287 ()
+ "Test for https://debbugs.gnu.org/37287 ."
+ (let ((input "foo-1\nfoo-2\nfoo-3")
+ (expected "foo-2\nfoo-2\nfoo-3"))
+ (should
+ (replace-tests-with-undo
+ input "\\([0-9]\\)"
+ '(replace-eval-replacement
+ replace-quote
+ (format "%d" (1+ (string-to-number (match-string 1)))))
+ ((?\s . (1 2 4)) (?U . (3)))
+ ?q
+ (string= expected (buffer-string))))))
+
;;; replace-tests.el ends here
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index a93664f..7caddc5 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -64,9 +64,14 @@
"Temporary directory for Tramp tests.")
(setq password-cache-expiry nil
- shadow-debug t
+ shadow-debug nil
tramp-verbose 0
- tramp-message-show-message nil)
+ tramp-message-show-message nil
+ ;; On macOS, `temporary-file-directory' is a symlinked directory.
+ temporary-file-directory (file-truename temporary-file-directory)
+ shadow-test-remote-temporary-file-directory
+ (ignore-errors
+ (file-truename shadow-test-remote-temporary-file-directory)))
;; This should happen on hydra only.
(when (getenv "EMACS_HYDRA_CI")
@@ -718,8 +723,6 @@ guaranteed by the originator of a cluster definition."
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
- (shadow-test-remote-temporary-file-directory
- (file-truename shadow-test-remote-temporary-file-directory))
shadow-clusters shadow-literal-groups shadow-regexp-groups
shadow-files-to-copy
cluster1 cluster2 primary regexp file)
@@ -858,8 +861,6 @@ guaranteed by the originator of a cluster definition."
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
- (shadow-test-remote-temporary-file-directory
- (file-truename shadow-test-remote-temporary-file-directory))
(shadow-noquery t)
shadow-clusters shadow-files-to-copy
cluster1 cluster2 primary regexp file mocked-input)
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 8e377d7..26d49a5 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -21,42 +21,86 @@
(require 'ert)
-(ert-deftest print-hex-backslash ()
+;; Support sharing test code with cl-print-tests.
+
+(defalias 'print-tests--prin1-to-string #'identity
+ "The function to print to a string which is under test.")
+
+(defmacro print-tests--deftest (name arg &rest docstring-keys-and-body)
+ "Test both print.c and cl-print.el at once."
+ (declare (debug ert-deftest)
+ (doc-string 3)
+ (indent 2))
+ (let ((clname (intern (concat (symbol-name name) "-cl-print")))
+ (doc (when (stringp (car-safe docstring-keys-and-body))
+ (list (pop docstring-keys-and-body))))
+ (keys-and-values nil))
+ (while (keywordp (car-safe docstring-keys-and-body))
+ (let ((key (pop docstring-keys-and-body))
+ (val (pop docstring-keys-and-body)))
+ (push val keys-and-values)
+ (push key keys-and-values)))
+ `(progn
+ ;; Set print-tests--prin1-to-string at both declaration and
+ ;; runtime, so that it can be used by the :expected-result
+ ;; keyword.
+ (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+ #'prin1-to-string))
+ (ert-deftest ,name ,arg
+ ,@doc
+ ,@keys-and-values
+ (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+ #'prin1-to-string))
+ ,@docstring-keys-and-body)))
+ (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+ #'cl-prin1-to-string))
+ (ert-deftest ,clname ,arg
+ ,@doc
+ ,@keys-and-values
+ (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+ #'cl-prin1-to-string))
+ ,@docstring-keys-and-body))))))
+
+(print-tests--deftest print-hex-backslash ()
(should (string= (let ((print-escape-multibyte t)
(print-escape-newlines t))
- (prin1-to-string "\u00A2\ff"))
+ (print-tests--prin1-to-string "\u00A2\ff"))
"\"\\x00a2\\ff\"")))
(defun print-tests--prints-with-charset-p (ch odd-charset)
- "Return t if `prin1-to-string' prints CH with the `charset' property.
+ "Return t if print function being tested prints CH with the `charset'
property.
CH is propertized with a `charset' value according to
ODD-CHARSET: if nil, then use the one returned by `char-charset',
otherwise, use a different charset."
(integerp
(string-match
"charset"
- (prin1-to-string
+ (print-tests--prin1-to-string
(propertize (string ch)
'charset
(if odd-charset
(cl-find (char-charset ch) charset-list :test-not #'eq)
(char-charset ch)))))))
-(ert-deftest print-charset-text-property-nil ()
+(print-tests--deftest print-charset-text-property-nil ()
+ :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+ #'cl-prin1-to-string) :failed :passed)
(let ((print-charset-text-property nil))
(should-not (print-tests--prints-with-charset-p ?\xf6 t)) ; Bug#31376.
(should-not (print-tests--prints-with-charset-p ?a t))
(should-not (print-tests--prints-with-charset-p ?\xf6 nil))
(should-not (print-tests--prints-with-charset-p ?a nil))))
-(ert-deftest print-charset-text-property-default ()
+(print-tests--deftest print-charset-text-property-default ()
+ :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+ #'cl-prin1-to-string) :failed :passed)
(let ((print-charset-text-property 'default))
(should (print-tests--prints-with-charset-p ?\xf6 t))
(should-not (print-tests--prints-with-charset-p ?a t))
(should-not (print-tests--prints-with-charset-p ?\xf6 nil))
(should-not (print-tests--prints-with-charset-p ?a nil))))
-(ert-deftest print-charset-text-property-t ()
+(print-tests--deftest print-charset-text-property-t ()
(let ((print-charset-text-property t))
(should (print-tests--prints-with-charset-p ?\xf6 t))
(should (print-tests--prints-with-charset-p ?a t))
@@ -94,7 +138,7 @@ otherwise, use a different charset."
(buffer-string))
"--------\n"))))
-(ert-deftest print-read-roundtrip ()
+(print-tests--deftest print-read-roundtrip ()
(let ((syms (list '## '& '* '+ '- '/ '0E '0e '< '= '> 'E 'E0 'NaN '\"
'\# '\#x0 '\' '\'\' '\( '\) '\+00 '\, '\-0 '\. '\.0
'\0 '\0.0 '\0E0 '\0e0 '\1E+ '\1E+NaN '\1e+ '\1e+NaN
@@ -105,16 +149,207 @@ otherwise, use a different charset."
(intern "\N{ZERO WIDTH SPACE}")
(intern "\0"))))
(dolist (sym syms)
- (should (eq (read (prin1-to-string sym)) sym))
+ (should (eq (read (print-tests--prin1-to-string sym)) sym))
(dolist (sym1 syms)
(let ((sym2 (intern (concat (symbol-name sym) (symbol-name sym1)))))
- (should (eq (read (prin1-to-string sym2)) sym2)))))))
+ (should (eq (read (print-tests--prin1-to-string sym2)) sym2)))))))
-(ert-deftest print-bignum ()
+(print-tests--deftest print-bignum ()
(let* ((str "999999999999999999999999999999999")
(val (read str)))
(should (> val most-positive-fixnum))
- (should (equal (prin1-to-string val) str))))
+ (should (equal (print-tests--prin1-to-string val) str))))
+
+(print-tests--deftest print-tests-print-gensym ()
+ "Printing observes `print-gensym'."
+ (let* ((sym1 (gensym))
+ (syms (list sym1 (gensym "x") (make-symbol "y") sym1)))
+ (let* ((print-circle nil)
+ (printed-with (let ((print-gensym t))
+ (print-tests--prin1-to-string syms)))
+ (printed-without (let ((print-gensym nil))
+ (print-tests--prin1-to-string syms))))
+ (should (string-match
+ "(#:\\(g[[:digit:]]+\\) #:x[[:digit:]]+ #:y
#:\\(g[[:digit:]]+\\))$"
+ printed-with))
+ (should (string= (match-string 1 printed-with)
+ (match-string 2 printed-with)))
+ (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$"
+ printed-without)))
+ (let* ((print-circle t)
+ (printed-with (let ((print-gensym t))
+ (print-tests--prin1-to-string syms)))
+ (printed-without (let ((print-gensym nil))
+ (print-tests--prin1-to-string syms))))
+ (should (string-match "(#1=#:g[[:digit:]]+ #:x[[:digit:]]+ #:y #1#)$"
+ printed-with))
+ (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$"
+ printed-without)))))
+
+(print-tests--deftest print-tests-continuous-numbering ()
+ "Printing observes `print-continuous-numbering'."
+ ;; cl-print does not support print-continuous-numbering.
+ :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+ #'cl-prin1-to-string) :failed :passed)
+ (let* ((x (list 1))
+ (y "hello")
+ (g (gensym))
+ (g2 (gensym))
+ (print-circle t)
+ (print-gensym t))
+ (let ((print-continuous-numbering t)
+ (print-number-table nil))
+ (should (string-match
+ "(#1=(1) #1# #2=\"hello\" #2#)(#3=#:g[[:digit:]]+ #3#)(#1# #2#
#3#)#2#$"
+ (mapconcat #'print-tests--prin1-to-string `((,x ,x ,y ,y) (,g
,g) (,x ,y ,g) ,y) ""))))
+
+ ;; This is the special case for byte-compile-output-docform
+ ;; mentioned in a comment in print_preprocess. When
+ ;; print-continuous-numbering and print-circle and print-gensym
+ ;; are all non-nil, print all gensyms with numbers even if they
+ ;; only occur once.
+ (let ((print-continuous-numbering t)
+ (print-number-table nil))
+ (should (string-match
+ "(#1=#:g[[:digit:]]+ #2=#:g[[:digit:]]+)$"
+ (print-tests--prin1-to-string (list g g2)))))))
+
+(cl-defstruct print--test a b)
+
+(print-tests--deftest print-tests-1 ()
+ "Test print code."
+ (let ((x (make-print--test :a 1 :b 2))
+ (rec (cond
+ ((eq (symbol-function #'print-tests--prin1-to-string)
'prin1-to-string)
+ "#s(print--test 1 2)")
+ ((eq (symbol-function #'print-tests--prin1-to-string)
'cl-prin1-to-string)
+ "#s(print--test :a 1 :b 2)")
+ (t (cl-assert nil)))))
+
+ (let ((print-circle nil))
+ (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x)))
+ (format "((x . %s) (y . %s))" rec rec))))
+ (let ((print-circle t))
+ (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x)))
+ (format "((x . #1=%s) (y . #1#))" rec))))))
+
+(print-tests--deftest print-tests-2 ()
+ (let ((x (record 'foo 1 2 3)))
+ (should (equal
+ x
+ (car (read-from-string (with-output-to-string (prin1 x))))))
+ (let ((print-circle t))
+ (should (string-match
+ "\\`(#1=#s(foo 1 2 3) #1#)\\'"
+ (print-tests--prin1-to-string (list x x)))))))
+
+(cl-defstruct (print-tests-struct
+ (:constructor print-tests-con))
+ a b c d e)
+
+(print-tests--deftest print-tests-3 ()
+ "Printing observes `print-length'."
+ (let ((long-list (make-list 5 'a))
+ (long-vec (make-vector 5 'b))
+ ;; (long-struct (print-tests-con))
+ ;; (long-string (make-string 5 ?a))
+ (print-length 4))
+ (should (equal "(a a a a ...)" (print-tests--prin1-to-string long-list)))
+ (should (equal "[b b b b ...]" (print-tests--prin1-to-string long-vec)))
+ ;; This one only prints 3 nils. Should it print 4?
+ ;; (should (equal "#s(print-tests-struct nil nil nil nil ...)"
+ ;; (print-tests--prin1-to-string long-struct)))
+ ;; This one is only supported by cl-print
+ ;; (should (equal "\"aaaa...\"" (cl-print-tests--prin1-to-string
long-string)))
+ ))
+
+(print-tests--deftest print-tests-4 ()
+ "Printing observes `print-level'."
+ (let* ((deep-list '(a (b (c (d (e))))))
+ (buried-vector '(a (b (c (d [e])))))
+ (deep-struct (print-tests-con))
+ (buried-struct `(a (b (c (d ,deep-struct)))))
+ (buried-string '(a (b (c (d #("hello" 0 5 (print-test t)))))))
+ (buried-simple-string '(a (b (c (d "hello")))))
+ (print-level 4))
+ (setf (print-tests-struct-a deep-struct) deep-list)
+ (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string
deep-list)))
+ (should (equal "(a (b (c (d \"hello\"))))"
+ (print-tests--prin1-to-string buried-simple-string)))
+ (cond
+ ((eq (symbol-function #'print-tests--prin1-to-string) #'prin1-to-string)
+ (should (equal "(a (b (c (d [e]))))" (print-tests--prin1-to-string
buried-vector)))
+ (should (equal "(a (b (c (d #s(print-tests-struct ... nil nil nil
nil)))))"
+ (print-tests--prin1-to-string buried-struct)))
+ (should (equal "(a (b (c (d #(\"hello\" 0 5 ...)))))"
+ (print-tests--prin1-to-string buried-string)))
+ (should (equal "#s(print-tests-struct (a (b (c ...))) nil nil nil nil)"
+ (print-tests--prin1-to-string deep-struct))))
+
+ ((eq (symbol-function #'print-tests--prin1-to-string)
#'cl-prin1-to-string)
+ (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string
buried-vector)))
+ (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string
buried-struct)))
+ (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string
buried-string)))
+ (should (equal "#s(print-tests-struct :a (a (b (c ...))) :b nil :c nil
:d nil :e nil)"
+ (print-tests--prin1-to-string deep-struct))))
+ (t (cl-assert nil)))))
+
+(print-tests--deftest print-tests-5 ()
+ "Printing observes `print-quoted'."
+ (let ((quoted-stuff '('a #'b `(,c ,@d))))
+ (let ((print-quoted t))
+ (should (equal "('a #'b `(,c ,@d))"
+ (print-tests--prin1-to-string quoted-stuff))))
+ (let ((print-quoted nil))
+ (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
+ (print-tests--prin1-to-string quoted-stuff))))))
+
+(print-tests--deftest print-tests-strings ()
+ "Can print strings and propertized strings."
+ (let* ((str1 "abcdefghij")
+ (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t)))
+ (str3 #("abcdefghij" 0 10 (test t)))
+ (obj '(a b))
+ ;; Since the byte compiler reuses string literals,
+ ;; and the put-text-property call is destructive, use
+ ;; copy-sequence to make a new string.
+ (str4 (copy-sequence "abcdefghij")))
+ (put-text-property 0 5 'test obj str4)
+ (put-text-property 7 10 'test obj str4)
+
+ (should (equal "\"abcdefghij\"" (print-tests--prin1-to-string str1)))
+ (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))"
+ (print-tests--prin1-to-string str2)))
+ (should (equal "#(\"abcdefghij\" 0 10 (test t))"
+ (print-tests--prin1-to-string str3)))
+ (let ((print-circle nil))
+ (should
+ (equal
+ "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))"
+ (print-tests--prin1-to-string str4))))
+ (let ((print-circle t))
+ (should
+ (equal
+ "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))"
+ (print-tests--prin1-to-string str4))))))
+
+(print-tests--deftest print-circle ()
+ (let ((x '(#1=(a . #1#) #1#)))
+ (let ((print-circle nil))
+ (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'"
+ (print-tests--prin1-to-string x))))
+ (let ((print-circle t))
+ (should (equal "(#1=(a . #1#) #1#)" (print-tests--prin1-to-string x))))))
+
+(print-tests--deftest print-circle-2 ()
+ ;; Bug#31146.
+ (let ((x '(0 . #1=(0 . #1#))))
+ (let ((print-circle nil))
+ (should (string-match "\\`(0 0 . #[0-9])\\'"
+ (print-tests--prin1-to-string x))))
+ (let ((print-circle t))
+ (should (equal "(0 . #1=(0 . #1#))" (print-tests--prin1-to-string x))))))
+
(provide 'print-tests)
;;; print-tests.el ends here