aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xadmin/merge-gnulib2
-rw-r--r--admin/unidata/unidata-gen.el94
-rw-r--r--configure.ac2
-rw-r--r--doc/emacs/dired.texi26
-rw-r--r--doc/emacs/help.texi7
-rw-r--r--doc/emacs/killing.texi4
-rw-r--r--doc/emacs/mule.texi8
-rw-r--r--doc/lispref/display.texi71
-rw-r--r--doc/lispref/elisp.texi2
-rw-r--r--doc/lispref/frames.texi510
-rw-r--r--doc/lispref/modes.texi4
-rw-r--r--doc/lispref/objects.texi35
-rw-r--r--doc/lispref/windows.texi145
-rw-r--r--doc/misc/emacs-mime.texi2
-rw-r--r--doc/misc/tramp.texi42
-rw-r--r--doc/misc/trampver.texi2
-rw-r--r--etc/NEWS89
-rw-r--r--lib-src/ebrowse.c8
-rw-r--r--lib-src/emacsclient.c3
-rw-r--r--lib-src/etags.c1
-rw-r--r--lib-src/hexl.c2
-rw-r--r--lib-src/make-docfile.c10
-rw-r--r--lib-src/movemail.c4
-rw-r--r--lib-src/profile.c2
-rw-r--r--lib-src/update-game-score.c3
-rw-r--r--lib/gnulib.mk.in11
-rw-r--r--lib/unlocked-io.h136
-rw-r--r--lisp/autorevert.el56
-rw-r--r--lisp/calc/calc-units.el72
-rw-r--r--lisp/descr-text.el14
-rw-r--r--lisp/dired-aux.el254
-rw-r--r--lisp/dired.el27
-rw-r--r--lisp/electric.el66
-rw-r--r--lisp/emacs-lisp/cl-extra.el39
-rw-r--r--lisp/emacs-lisp/cl-print.el11
-rw-r--r--lisp/emacs-lisp/debug.el188
-rw-r--r--lisp/emacs-lisp/eieio-core.el10
-rw-r--r--lisp/emacs-lisp/ert.el87
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el7
-rw-r--r--lisp/epg.el2
-rw-r--r--lisp/eshell/esh-cmd.el32
-rw-r--r--lisp/frame.el32
-rw-r--r--lisp/help-fns.el103
-rw-r--r--lisp/help.el257
-rw-r--r--lisp/ldefs-boot.el18
-rw-r--r--lisp/minibuffer.el2
-rw-r--r--lisp/mouse.el433
-rw-r--r--lisp/net/eww.el16
-rw-r--r--lisp/net/shr.el87
-rw-r--r--lisp/net/tramp-adb.el49
-rw-r--r--lisp/net/tramp-compat.el3
-rw-r--r--lisp/net/tramp-sh.el19
-rw-r--r--lisp/net/tramp.el91
-rw-r--r--lisp/net/trampver.el6
-rw-r--r--lisp/obsolete/html2text.el (renamed from lisp/net/html2text.el)3
-rw-r--r--lisp/progmodes/cc-cmds.el2
-rw-r--r--lisp/progmodes/cc-defs.el91
-rw-r--r--lisp/progmodes/cc-engine.el4
-rw-r--r--lisp/progmodes/cc-fonts.el47
-rw-r--r--lisp/progmodes/cc-langs.el24
-rw-r--r--lisp/progmodes/cc-mode.el298
-rw-r--r--lisp/progmodes/cc-styles.el1
-rw-r--r--lisp/progmodes/tcl.el5
-rw-r--r--lisp/select.el3
-rw-r--r--lisp/ses.el49
-rw-r--r--lisp/subr.el4
-rw-r--r--lisp/term/w32-win.el2
-rw-r--r--lisp/tooltip.el6
-rw-r--r--lisp/url/url-history.el9
-rw-r--r--lisp/window.el615
-rw-r--r--m4/gnulib-comp.m44
-rw-r--r--m4/unlocked-io.m441
-rw-r--r--src/charset.c6
-rw-r--r--src/cm.c14
-rw-r--r--src/dispextern.h36
-rw-r--r--src/dispnew.c32
-rw-r--r--src/emacs-module.c6
-rw-r--r--src/emacs-module.h.in3
-rw-r--r--src/emacs.c8
-rw-r--r--src/fileio.c16
-rw-r--r--src/frame.c783
-rw-r--r--src/frame.h63
-rw-r--r--src/gtkutil.c2
-rw-r--r--src/image.c11
-rw-r--r--src/intervals.h12
-rw-r--r--src/keyboard.c71
-rw-r--r--src/lread.c11
-rw-r--r--src/minibuf.c34
-rw-r--r--src/module-env-25.h2
-rw-r--r--src/nsfns.m12
-rw-r--r--src/nsterm.h15
-rw-r--r--src/nsterm.m26
-rw-r--r--src/print.c55
-rw-r--r--src/process.c13
-rw-r--r--src/sysdep.c15
-rw-r--r--src/sysstdio.h41
-rw-r--r--src/systhread.c11
-rw-r--r--src/term.c47
-rw-r--r--src/w32fns.c41
-rw-r--r--src/w32term.c63
-rw-r--r--src/w32term.h8
-rw-r--r--src/window.c213
-rw-r--r--src/window.h200
-rw-r--r--src/xdisp.c190
-rw-r--r--src/xfaces.c2
-rw-r--r--src/xfns.c101
-rw-r--r--src/xterm.c16
-rw-r--r--src/xterm.h8
-rw-r--r--test/Makefile.in3
-rw-r--r--test/lisp/electric-tests.el116
-rw-r--r--test/lisp/emacs-lisp/cl-print-tests.el2
-rw-r--r--test/lisp/emacs-lisp/ert-tests.el8
-rw-r--r--test/lisp/net/tramp-tests.el255
113 files changed, 4945 insertions, 2040 deletions
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index d4bbf17cb3d..85921ba1ba6 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -40,7 +40,7 @@ GNULIB_MODULES='
40 sig2str socklen stat-time std-gnu11 stdalign stddef stdio 40 sig2str socklen stat-time std-gnu11 stdalign stddef stdio
41 stpcpy strftime strtoimax symlink sys_stat 41 stpcpy strftime strtoimax symlink sys_stat
42 sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub 42 sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub
43 update-copyright utimens 43 update-copyright unlocked-io utimens
44 vla warnings 44 vla warnings
45' 45'
46 46
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index e1e896ce29c..478099c831a 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -1346,50 +1346,56 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
1346 (generator (unidata-prop-generator proplist)) 1346 (generator (unidata-prop-generator proplist))
1347 (default-value (unidata-prop-default proplist)) 1347 (default-value (unidata-prop-default proplist))
1348 (val-list (unidata-prop-val-list proplist)) 1348 (val-list (unidata-prop-val-list proplist))
1349 (table (progn 1349 (check #x400)
1350 (message "Generating %S table..." prop) 1350 table decoder alist)
1351 (funcall generator prop index default-value val-list))) 1351 ;; We compare values in unidata.txt with the ones returned by various
1352 (decoder (char-table-extra-slot table 1)) 1352 ;; generator functions. However, SpecialCasing.txt is read directly by
1353 (alist (and (functionp index) 1353 ;; unidata-gen-table-special-casing--do-load and there is no other file
1354 (funcall index))) 1354 ;; to compare those values with. This is why we’re skipping the check
1355 (check #x400)) 1355 ;; for special casing properties.
1356 (dolist (e unidata-list) 1356 (unless (eq generator 'unidata-gen-table-special-casing)
1357 (let* ((char (car e)) 1357 (setq table (progn
1358 (val1 1358 (message "Generating %S table..." prop)
1359 (if alist (nth 1 (assoc char alist)) 1359 (funcall generator prop index default-value val-list))
1360 (nth index e))) 1360 decoder (char-table-extra-slot table 1))
1361 val2) 1361 (unless (integerp decoder)
1362 (if (and (stringp val1) (= (length val1) 0)) 1362 (setq alist (and (functionp index) (funcall index)))
1363 (setq val1 nil)) 1363 (dolist (e unidata-list)
1364 (unless (or (consp char) 1364 (let ((char (car e)) val1 val2)
1365 (integerp decoder)) 1365 (unless (consp char)
1366 (setq val2 1366 (setq val1 (if alist
1367 (cond ((functionp decoder) 1367 (nth 1 (assoc char alist))
1368 (funcall decoder char (aref table char) table)) 1368 (nth index e)))
1369 (t ; must be nil 1369 (and (stringp val1)
1370 (aref table char)))) 1370 (= (length val1) 0)
1371 (if val1 1371 (setq val1 nil))
1372 (cond ((eq generator 'unidata-gen-table-symbol) 1372 (if val1
1373 (setq val1 (intern val1))) 1373 (cond ((eq generator 'unidata-gen-table-symbol)
1374 ((eq generator 'unidata-gen-table-integer) 1374 (setq val1 (intern val1)))
1375 (setq val1 (string-to-number val1))) 1375 ((eq generator 'unidata-gen-table-integer)
1376 ((eq generator 'unidata-gen-table-character) 1376 (setq val1 (string-to-number val1)))
1377 (setq val1 (string-to-number val1 16))) 1377 ((eq generator 'unidata-gen-table-character)
1378 ((eq generator 'unidata-gen-table-decomposition) 1378 (setq val1 (string-to-number val1 16)))
1379 (setq val1 (unidata-split-decomposition val1)))) 1379 ((eq generator 'unidata-gen-table-decomposition)
1380 (cond ((eq prop 'decomposition) 1380 (setq val1 (unidata-split-decomposition val1))))
1381 (setq val1 (list char))) 1381 (cond ((eq prop 'decomposition)
1382 ((eq prop 'bracket-type) 1382 (setq val1 (list char)))
1383 (setq val1 'n)))) 1383 ((eq prop 'bracket-type)
1384 (when (>= char check) 1384 (setq val1 'n))))
1385 (message "%S %04X" prop check) 1385 (setq val2 (aref table char))
1386 (setq check (+ check #x400))) 1386 (when decoder
1387 (or (equal val1 val2) 1387 (setq val2 (funcall decoder char val2 table)))
1388 ;; <control> characters get a 'name' property of nil 1388 (when (>= char check)
1389 (and (eq prop 'name) (string= val1 "<control>") (null val2)) 1389 (message "%S %04X" prop check)
1390 (insert (format "> %04X %S\n< %04X %S\n" 1390 (setq check (+ check #x400)))
1391 char val1 char val2))) 1391 (or (equal val1 val2)
1392 (sit-for 0)))))))) 1392 ;; <control> characters get a 'name' property of nil
1393 (and (eq prop 'name)
1394 (string= val1 "<control>")
1395 (null val2))
1396 (insert (format "> %04X %S\n< %04X %S\n"
1397 char val1 char val2)))
1398 (sit-for 0))))))))))
1393 1399
1394;; The entry functions. They generate files described in the header 1400;; The entry functions. They generate files described in the header
1395;; comment of this file. 1401;; comment of this file.
diff --git a/configure.ac b/configure.ac
index 65c5f9268ad..ef61107b025 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4240,7 +4240,7 @@ AC_CHECK_HEADERS(valgrind/valgrind.h)
4240 4240
4241AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]]) 4241AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
4242 4242
4243AC_CHECK_FUNCS_ONCE([getc_unlocked sbrk]) 4243AC_CHECK_FUNCS_ONCE([sbrk])
4244 4244
4245ok_so_far=yes 4245ok_so_far=yes
4246AC_CHECK_FUNC(socket, , ok_so_far=no) 4246AC_CHECK_FUNC(socket, , ok_so_far=no)
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 22b0fcd4676..28cb51d88bb 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -875,27 +875,33 @@ treat it specially.
875 875
876@item 876@item
877Otherwise, if the command string contains @samp{?} surrounded by 877Otherwise, if the command string contains @samp{?} surrounded by
878whitespace, Emacs runs the shell command once @emph{for each file}, 878whitespace or @samp{`?`}, Emacs runs the shell command once
879substituting the current file name for @samp{?} each time. You can 879@emph{for each file}, substituting the current file name for @samp{?}
880use @samp{?} more than once in the command; the same file name 880and @samp{`?`} each time. You can use both @samp{?} or @samp{`?`} more
881replaces each occurrence. 881than once in the command; the same file name replaces each occurrence.
882If you mix them with @samp{*} the command signals an error.
882 883
883@item 884@item
884If the command string contains neither @samp{*} nor @samp{?}, Emacs 885If the command string contains neither @samp{*} nor @samp{?} nor @samp{`?`},
885runs the shell command once for each file, adding the file name at the 886Emacs runs the shell command once for each file, adding the file name at the
886end. For example, @kbd{! uudecode @key{RET}} runs @code{uudecode} on 887end. For example, @kbd{! uudecode @key{RET}} runs @code{uudecode} on
887each file. 888each file.
888@end itemize 889@end itemize
889 890
890 To iterate over the file names in a more complicated fashion, use an 891 To iterate over the file names in a more complicated fashion, you might
891explicit shell loop. For example, here is how to uuencode each file, 892prefer to use an explicit shell loop. For example, here is how to uuencode
892making the output file name by appending @samp{.uu} to the input file 893each file, making the output file name by appending @samp{.uu} to the input
893name: 894file name:
894 895
895@example 896@example
896for file in * ; do uuencode "$file" "$file" >"$file".uu; done 897for file in * ; do uuencode "$file" "$file" >"$file".uu; done
897@end example 898@end example
898 899
900The same example with @samp{`?`} notation:
901@example
902uuencode ? ? > `?`.uu
903@end example
904
899 The @kbd{!} and @kbd{&} commands do not attempt to update the Dired 905 The @kbd{!} and @kbd{&} commands do not attempt to update the Dired
900buffer to show new or modified files, because they don't know what 906buffer to show new or modified files, because they don't know what
901files will be changed. Use the @kbd{g} command to update the Dired 907files will be changed. Use the @kbd{g} command to update the Dired
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 548ca6a1b48..fd6df1c7e53 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -203,9 +203,10 @@ string}, which describes exactly what the command does.
203describes the command corresponding to @var{key}. 203describes the command corresponding to @var{key}.
204 204
205 @kbd{C-h c}, @kbd{C-h k} and @kbd{C-h K} work for any sort of key 205 @kbd{C-h c}, @kbd{C-h k} and @kbd{C-h K} work for any sort of key
206sequences, including function keys, menus, and mouse events. For 206sequences, including function keys, menus, and mouse events (except
207instance, after @kbd{C-h k} you can select a menu item from the menu 207that @kbd{C-h c} ignores mouse movement events). For instance, after
208bar, to view the documentation string of the command it runs. 208@kbd{C-h k} you can select a menu item from the menu bar, to view the
209documentation string of the command it runs.
209 210
210@kindex C-h w 211@kindex C-h w
211@findex where-is 212@findex where-is
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 47de0531292..0b5efd04a18 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -519,6 +519,10 @@ when exiting Emacs; if you wish to prevent Emacs from transferring
519data to the clipboard manager, change the variable 519data to the clipboard manager, change the variable
520@code{x-select-enable-clipboard-manager} to @code{nil}. 520@code{x-select-enable-clipboard-manager} to @code{nil}.
521 521
522 Since strings containing NUL bytes are usually truncated when passed
523through the clipboard, Emacs replaces such characters with ``\0''
524before transfering them to the system's clipboard.
525
522@vindex select-enable-primary 526@vindex select-enable-primary
523@findex clipboard-kill-region 527@findex clipboard-kill-region
524@findex clipboard-kill-ring-save 528@findex clipboard-kill-ring-save
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 13407f6f07b..8edf2640cfe 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1795,8 +1795,12 @@ of the first character you read precedes that of the next character.
1795Reordering of bidirectional text into the @dfn{visual} order happens 1795Reordering of bidirectional text into the @dfn{visual} order happens
1796at display time. As result, character positions no longer increase 1796at display time. As result, character positions no longer increase
1797monotonically with their positions on display. Emacs implements the 1797monotonically with their positions on display. Emacs implements the
1798Unicode Bidirectional Algorithm described in the Unicode Standard 1798Unicode Bidirectional Algorithm (UBA) described in the Unicode
1799Annex #9, for reordering of bidirectional text for display. 1799Standard Annex #9, for reordering of bidirectional text for display.
1800It deviates from the UBA only in how continuation lines are displayed
1801when text direction is opposite to the base paragraph direction,
1802e.g. when a long line of English text appears in a right-to-left
1803paragraph.
1800 1804
1801@vindex bidi-display-reordering 1805@vindex bidi-display-reordering
1802 The buffer-local variable @code{bidi-display-reordering} controls 1806 The buffer-local variable @code{bidi-display-reordering} controls
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 4de55fd3fb2..2ebe872c362 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1974,6 +1974,71 @@ line, if present, in the return value. If it is @code{t}, include the
1974height of both, if present, in the return value. 1974height of both, if present, in the return value.
1975@end defun 1975@end defun
1976 1976
1977@code{window-text-pixel-size} treats the text displayed in a window as a
1978whole and does not care about the size of individual lines. The
1979following function does.
1980
1981@defun window-lines-pixel-dimensions &optional window first last body inverse
1982This function calculates the pixel dimensions of each line displayed in
1983the specified @var{window}. It does so by walking @var{window}'s
1984current glyph matrix---a matrix storing the glyph (@pxref{Glyphs}) of
1985each buffer character currently displayed in @var{window}. If
1986successful, it returns a list of cons pairs representing the x- and
1987y-coordinates of the lower right corner of the last character of each
1988line. Coordinates are measured in pixels from an origin (0, 0) at the
1989top-left corner of @var{window}. @var{window} must be a live window and
1990defaults to the selected one.
1991
1992If the optional argument @var{first} is an integer, it denotes the index
1993(starting with 0) of the first line of @var{window}'s glyph matrix to be
1994returned. Note that if @var{window} has a header line, the line with
1995index 0 is that header line. If @var{first} is nil, the first line to
1996be considered is determined by the value of the optional argument
1997@var{body}: If @var{body} is non-@code{nil}, this means to start with
1998the first line of @var{window}'s body, skipping any header line, if
1999present. Otherwise, this function will start with the first line of
2000@var{window}'s glyph matrix, possibly the header line.
2001
2002If the optional argument @var{last} is an integer, it denotes the index
2003of the last line of @var{window}'s glyph matrix that shall be returned.
2004If @var{last} is nil, the last line to be considered is determined by
2005the value of @var{body}: If @var{body} is non-@code{nil}, this means to
2006use the last line of @var{window}'s body, omitting @var{window}'s mode
2007line, if present. Otherwise, this means to use the last line of
2008@var{window} which may be the mode line.
2009
2010The optional argument @var{inverse}, if @code{nil}, means that the
2011y-pixel value returned for any line specifies the distance in pixels
2012from the left edge (body edge if @var{body} is non-@code{nil}) of
2013@var{window} to the right edge of the last glyph of that line.
2014@var{inverse} non-@code{nil} means that the y-pixel value returned for
2015any line specifies the distance in pixels from the right edge of the
2016last glyph of that line to the right edge (body edge if @var{body} is
2017non-@code{nil}) of @var{window}. This is useful for determining the
2018amount of slack space at the end of each line.
2019
2020The optional argument @var{left}, if non-@code{nil} means to return the
2021x- and y-coordinates of the lower left corner of the leftmost character
2022on each line. This is the value that should be used for windows that
2023mostly display text from right to left.
2024
2025If @var{left} is non-@code{nil} and @var{inverse} is @code{nil}, this
2026means that the y-pixel value returned for any line specifies the
2027distance in pixels from the left edge of the last (leftmost) glyph of
2028that line to the right edge (body edge if @var{body} is non-@code{nil})
2029of @var{window}. If @var{left} and @var{inverse} are both
2030non-@code{nil}, the y-pixel value returned for any line specifies the
2031distance in pixels from the left edge (body edge if @var{body} is
2032non-@code{nil}) of @var{window} to the left edge of the last (leftmost)
2033glyph of that line.
2034
2035This function returns @code{nil} if the current glyph matrix of
2036@var{window} is not up-to-date which usually happens when Emacs is busy,
2037for example, when processing a command. The value should be retrievable
2038though when this function is run from an idle timer with a delay of zero
2039seconds.
2040@end defun
2041
1977@defun line-pixel-height 2042@defun line-pixel-height
1978This function returns the height in pixels of the line at point in the 2043This function returns the height in pixels of the line at point in the
1979selected window. The value includes the line spacing of the line 2044selected window. The value includes the line spacing of the line
@@ -7297,7 +7362,11 @@ follows the Unicode Bidirectional Algorithm (a.k.a.@: @acronym{UBA}),
7297which is described in Annex #9 of the Unicode standard 7362which is described in Annex #9 of the Unicode standard
7298(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full 7363(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full
7299Bidirectionality'' class implementation of the @acronym{UBA}, 7364Bidirectionality'' class implementation of the @acronym{UBA},
7300consistent with the requirements of the Unicode Standard v8.0. 7365consistent with the requirements of the Unicode Standard v9.0. Note,
7366however, that the way Emacs displays continuation lines when text
7367direction is opposite to the base paragraph direction deviates from
7368the UBA, which requires to perform line wrapping before reordering
7369text for display.
7301 7370
7302@defvar bidi-display-reordering 7371@defvar bidi-display-reordering
7303If the value of this buffer-local variable is non-@code{nil} (the 7372If the value of this buffer-local variable is non-@code{nil} (the
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 7cc91a8f7e3..4bedea3bdd1 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1130,6 +1130,8 @@ Window Frame Parameters
1130* Buffer Parameters:: Which buffers have been or should be shown. 1130* Buffer Parameters:: Which buffers have been or should be shown.
1131* Frame Interaction Parameters:: Parameters for interacting with other 1131* Frame Interaction Parameters:: Parameters for interacting with other
1132 frames. 1132 frames.
1133* Mouse Dragging Parameters:: Parameters for resizing and moving
1134 frames with the mouse.
1133* Management Parameters:: Communicating with the window manager. 1135* Management Parameters:: Communicating with the window manager.
1134* Cursor Parameters:: Controlling the cursor appearance. 1136* Cursor Parameters:: Controlling the cursor appearance.
1135* Font and Color Parameters:: Fonts and colors for the frame text. 1137* Font and Color Parameters:: Fonts and colors for the frame text.
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 50467d1dfd5..b430f7c6fad 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -974,14 +974,7 @@ Parameters}). The text size of the initial frame can be also set with
974the help of an X-style geometry specification. @xref{Emacs Invocation,, 974the help of an X-style geometry specification. @xref{Emacs Invocation,,
975Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs 975Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs
976Manual}. Below we list some functions to access and set the size of an 976Manual}. Below we list some functions to access and set the size of an
977existing, visible frame. 977existing, visible frame, by default the selected one.
978
979@defun frame-text-height &optional frame
980@defunx frame-text-width &optional frame
981These functions return the height and width of the text area of
982@var{frame} (@pxref{Frame Layout}), measured in pixels. For a text
983terminal, the results are in characters rather than pixels.
984@end defun
985 978
986@defun frame-height &optional frame 979@defun frame-height &optional frame
987@defunx frame-width &optional frame 980@defunx frame-width &optional frame
@@ -997,11 +990,33 @@ rounded down to the number of characters of the default font that fully
997fit into the text area. 990fit into the text area.
998@end defun 991@end defun
999 992
1000@defun frame-pixel-height &optional frame 993The functions following next return the pixel widths and heights of the
1001@defunx frame-pixel-width &optional frame 994native, outer and inner frame and the text area (@pxref{Frame Layout})
1002These functions return the native width and height, see @ref{Frame 995of a given frame. For a text terminal, the results are in characters
1003Layout}) of @var{frame} in pixels. For a text terminal, the results are 996rather than pixels.
1004in characters rather than pixels. 997
998@defun frame-outer-width &optional frame
999@defunx frame-outer-height &optional frame
1000These functions return the outer width and height of @var{frame} in
1001pixels.
1002@end defun
1003
1004@defun frame-native-height &optional frame
1005@defunx frame-native-width &optional frame
1006These functions return the native width and height of @var{frame} in
1007pixels.
1008@end defun
1009
1010@defun frame-inner-width &optional frame
1011@defunx frame-inner-height &optional frame
1012These functions return the inner width and height of @var{frame} in
1013pixels.
1014@end defun
1015
1016@defun frame-text-width &optional frame
1017@defunx frame-text-height &optional frame
1018These functions return the width and height of the text area of
1019@var{frame} in pixels.
1005@end defun 1020@end defun
1006 1021
1007On window systems that support it, Emacs tries by default to make the 1022On window systems that support it, Emacs tries by default to make the
@@ -1345,6 +1360,8 @@ text terminals.
1345* Buffer Parameters:: Which buffers have been or should be shown. 1360* Buffer Parameters:: Which buffers have been or should be shown.
1346* Frame Interaction Parameters:: Parameters for interacting with other 1361* Frame Interaction Parameters:: Parameters for interacting with other
1347 frames. 1362 frames.
1363* Mouse Dragging Parameters:: Parameters for resizing and moving
1364 frames with the mouse.
1348* Management Parameters:: Communicating with the window manager. 1365* Management Parameters:: Communicating with the window manager.
1349* Cursor Parameters:: Controlling the cursor appearance. 1366* Cursor Parameters:: Controlling the cursor appearance.
1350* Font and Color Parameters:: Fonts and colors for the frame text. 1367* Font and Color Parameters:: Fonts and colors for the frame text.
@@ -1404,18 +1421,19 @@ named, this parameter will be @code{nil}.
1404@cindex frame position 1421@cindex frame position
1405 1422
1406Parameters describing the X- and Y-offsets of a frame are always 1423Parameters describing the X- and Y-offsets of a frame are always
1407measured in pixels. For normal, non-child frames they specify the 1424measured in pixels. For a normal, non-child frame they specify the
1408frame's absolute outer position (@pxref{Frame Geometry}) with respect to 1425frame's outer position (@pxref{Frame Geometry}) relative to its
1409its display's origin. For a child frame (@pxref{Child Frames}) they 1426display's origin. For a child frame (@pxref{Child Frames}) they specify
1410specify the frame's outer position relative to the native position of 1427the frame's outer position relative to the native position of the
1411the frame's parent frame. (Note that none of these parameters is 1428frame's parent frame. (Note that none of these parameters is meaningful
1412meaningful on TTY frames.) 1429on TTY frames.)
1413 1430
1414@table @code 1431@table @code
1415@vindex left, a frame parameter 1432@vindex left, a frame parameter
1416@item left 1433@item left
1417The position, in pixels, of the left outer edge of the frame with 1434The position, in pixels, of the left outer edge of the frame with
1418respect to the left edge of the frame's display or parent frame. 1435respect to the left edge of the frame's display or parent frame. It can
1436be specified in one of the following ways.
1419 1437
1420@table @asis 1438@table @asis
1421@item an integer 1439@item an integer
@@ -1436,6 +1454,30 @@ right edge of the display or parent frame. The integer @var{pos} may be
1436positive or negative; a negative value specifies a position outside the 1454positive or negative; a negative value specifies a position outside the
1437screen or parent frame or on a monitor other than the primary one (for 1455screen or parent frame or on a monitor other than the primary one (for
1438multi-monitor displays). 1456multi-monitor displays).
1457
1458@cindex left position ratio
1459@cindex top position ratio
1460@item a floating-point value
1461A floating-point value in the range 0.0 to 1.0 specifies the left edge's
1462offset via the @dfn{left position ratio} of the frame---the ratio of the
1463left edge of its outer frame to the width of the frame's workarea
1464(@pxref{Multiple Terminals}) or its parent's native frame (@pxref{Child
1465Frames}) minus the width of the outer frame. Thus, a left position
1466ratio of 0.0 flushes a frame to the left, a ratio of 0.5 centers it and
1467a ratio of 1.0 flushes it to the right of its display or parent frame.
1468Similarly, the @dfn{top position ratio} of a frame is the ratio of the
1469frame's top position to the height of its workarea or parent frame minus
1470the height of the frame.
1471
1472Emacs will try to keep the position ratios of a child frame unaltered if
1473that frame has a non-@code{nil} @code{keep-ratio} parameter
1474(@pxref{Frame Interaction Parameters}) and its parent frame is resized.
1475
1476Since the outer size of a frame (@pxref{Frame Geometry}) is usually
1477unavailable before a frame has been made visible, it is generally not
1478advisable to use floating-point values when creating decorated frames.
1479Floating-point values are more suited for ensuring that an (undecorated)
1480child frame is positioned nicely within the area of its parent frame.
1439@end table 1481@end table
1440 1482
1441Some window managers ignore program-specified positions. If you want to 1483Some window managers ignore program-specified positions. If you want to
@@ -1448,17 +1490,19 @@ following example:
1448 nil '((user-position . t) (left . (+ -4)))) 1490 nil '((user-position . t) (left . (+ -4))))
1449@end example 1491@end example
1450 1492
1451In general, it is not a good idea to specify negative offsets to 1493In general, it is not a good idea to position a frame relative to the
1452position a frame relative to the right or bottom edge of its display. 1494right or bottom edge of its display. Positioning the initial or a new
1453Positioning the initial or a new frame is either not accurate (because 1495frame is either not accurate (because the size of the outer frame is not
1454the size of the outer frame is not yet fully known before the frame has 1496yet fully known before the frame has been made visible) or will cause
1455been made visible) or will cause additional flicker (if the frame is 1497additional flicker (if the frame has to be repositioned after becoming
1456repositioned after becoming visible). 1498visible).
1457 1499
1458 Note also, that negative offsets are not stored internally and are not 1500 Note also, that positions specified relative to the right/bottom edge
1459returned by the function @code{frame-parameters}. This means that the 1501of a display, workarea or parent frame as well as floating-point offsets
1460desktop saving routines will restore the frame from the positive offsets 1502are stored internally as integer offsets relative to the left/top edge
1461obtained by that function. 1503of the display, workarea or parent frame edge. They are also returned
1504as such by functions like @code{frame-parameters} and restored as such
1505by the desktop saving routines.
1462 1506
1463@vindex top, a frame parameter 1507@vindex top, a frame parameter
1464@item top 1508@item top
@@ -1523,24 +1567,61 @@ function @code{frame-restack} (@pxref{Raising and Lowering}).
1523@subsubsection Size Parameters 1567@subsubsection Size Parameters
1524@cindex window size on display 1568@cindex window size on display
1525 1569
1526 Frame parameters specify frame sizes in character units. On 1570Frame parameters usually specify frame sizes in character units. On
1527graphical displays, the @code{default} face determines the actual 1571graphical displays, the @code{default} face determines the actual pixel
1528pixel sizes of these character units (@pxref{Face Attributes}). 1572sizes of these character units (@pxref{Face Attributes}).
1529 1573
1530@table @code 1574@table @code
1531@vindex width, a frame parameter 1575@vindex width, a frame parameter
1532@item width 1576@item width
1533The width of the frame's text area (@pxref{Frame Geometry}), in 1577This parameter specifies the width of the frame. It can be specified as
1534characters. The value can be also a cons cell of the symbol 1578in the following ways:
1535@code{text-pixels} and an integer denoting the width of the text area in 1579
1536pixels. 1580@table @asis
1581@item an integer
1582A positive integer specifies the width of the frame's text area
1583(@pxref{Frame Geometry}) in characters.
1584
1585@item a cons cell
1586If this is a cons cell with the symbol @code{text-pixels} in its
1587@sc{car}, the @sc{cdr} of that cell specifies the width of the frame's
1588text area in pixels.
1589
1590@cindex frame width ratio
1591@cindex frame height ratio
1592@item a floating-point value
1593A floating-point number between 0.0 and 1.0 can be used to specify the
1594width of a frame via its @dfn{width ratio}---the ratio of its outer
1595width (@pxref{Frame Geometry}) to the width of the frame's workarea
1596(@pxref{Multiple Terminals}) or its parent frame's (@pxref{Child
1597Frames}) native frame. Thus, a value of 0.5 makes the frame occupy half
1598of the width of its workarea or parent frame, a value of 1.0 the full
1599width. Similarly, the @dfn{height ratio} of a frame is the ratio of its
1600outer height to the height of its workarea or its parent's native frame.
1601
1602Emacs will try to keep the width and height ratio of a child frame
1603unaltered if that frame has a non-@code{nil} @code{keep-ratio} parameter
1604(@pxref{Frame Interaction Parameters}) and its parent frame is resized.
1605
1606Since the outer size of a frame is usually unavailable before a frame
1607has been made visible, it is generally not advisable to use
1608floating-point values when creating decorated frames. Floating-point
1609values are more suited to ensure that a child frame always fits within
1610the area of its parent frame as, for example, when customizing
1611@code{display-buffer-alist} (@pxref{Choosing Window}) via
1612@code{display-buffer-in-child-frame}.
1613@end table
1614
1615Regardless of how this parameter was specified, functions reporting the
1616value of this parameter like @code{frame-parameters} always report the
1617width of the frame's text area in characters as an integer rounded, if
1618necessary, to a multiple of the frame's default character width. That
1619value is also used by the desktop saving routines.
1537 1620
1538@vindex height, a frame parameter 1621@vindex height, a frame parameter
1539@item height 1622@item height
1540The height of the frame's text area (@pxref{Frame Geometry}), in 1623This parameter specifies the height of the frame. It works just like
1541characters. The value can be also a cons cell of the symbol 1624@code{width}, except vertically instead of horizontally.
1542@code{text-pixels} and an integer denoting the height of the text area
1543in pixels.
1544 1625
1545@vindex user-size, a frame parameter 1626@vindex user-size, a frame parameter
1546@item user-size 1627@item user-size
@@ -1551,25 +1632,25 @@ user-position}) does for the position parameters @code{top} and
1551 1632
1552@vindex min-width, a frame parameter 1633@vindex min-width, a frame parameter
1553@item min-width 1634@item min-width
1554This parameter specifies the minimum native width of the frame 1635This parameter specifies the minimum native width (@pxref{Frame
1555(@pxref{Frame Geometry}), in characters. Normally, the functions that 1636Geometry}) of the frame, in characters. Normally, the functions that
1556establish a frame's initial width or resize a frame horizontally make 1637establish a frame's initial width or resize a frame horizontally make
1557sure that all the frame's windows, vertical scroll bars, fringes, 1638sure that all the frame's windows, vertical scroll bars, fringes,
1558margins and vertical dividers can be displayed. This parameter, if 1639margins and vertical dividers can be displayed. This parameter, if
1559non-@code{nil} allows to make a frame narrower than that with the 1640non-@code{nil} allows to make a frame narrower than that with the
1560consequence that any components that do not fit on the frame will be 1641consequence that any components that do not fit will be clipped by the
1561clipped by the window manager. 1642window manager.
1562 1643
1563@vindex min-height, a frame parameter 1644@vindex min-height, a frame parameter
1564@item min-height 1645@item min-height
1565This parameter specifies the minimum height of the native (@pxref{Frame 1646This parameter specifies the minimum native height (@pxref{Frame
1566Geometry}), in characters. Normally, the functions that establish a 1647Geometry}) of the frame, in characters. Normally, the functions that
1567frame's initial size or resize a frame make sure that all the frame's 1648establish a frame's initial size or resize a frame make sure that all
1568windows, horizontal scroll bars and dividers, mode and header lines, the 1649the frame's windows, horizontal scroll bars and dividers, mode and
1569echo area and the internal menu and tool bar can be displayed. This 1650header lines, the echo area and the internal menu and tool bar can be
1570parameter, if non-@code{nil} allows to make a frame smaller than that 1651displayed. This parameter, if non-@code{nil} allows to make a frame
1571with the consequence that any components that do not fit on the frame 1652smaller than that with the consequence that any components that do not
1572will be clipped by the window-system or window manager. 1653fit will be clipped by the window manager.
1573 1654
1574@cindex fullboth frames 1655@cindex fullboth frames
1575@cindex fullheight frames 1656@cindex fullheight frames
@@ -1623,6 +1704,20 @@ file as, for example
1623 1704
1624This will give a new frame full height after typing in it @key{F11} for 1705This will give a new frame full height after typing in it @key{F11} for
1625the first time. 1706the first time.
1707
1708@vindex fit-frame-to-buffer-margins, a frame parameter
1709@item fit-frame-to-buffer-margins
1710This parameter allows to override the value of the option
1711@code{fit-frame-to-buffer-margins} when fitting this frame to the buffer
1712of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing
1713Windows}).
1714
1715@vindex fit-frame-to-buffer-sizes, a frame parameter
1716@item fit-frame-to-buffer-sizes
1717This parameter allows to override the value of the option
1718@code{fit-frame-to-buffer-sizes} when fitting this frame to the buffer
1719of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing
1720Windows}).
1626@end table 1721@end table
1627 1722
1628 1723
@@ -1646,9 +1741,9 @@ Geometry}).
1646 1741
1647@vindex vertical-scroll-bars, a frame parameter 1742@vindex vertical-scroll-bars, a frame parameter
1648@item vertical-scroll-bars 1743@item vertical-scroll-bars
1649Whether the frame has scroll bars for vertical scrolling, and which side 1744Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical
1650of the frame they should be on. The possible values are @code{left}, 1745scrolling, and which side of the frame they should be on. The possible
1651@code{right}, and @code{nil} for no scroll bars. 1746values are @code{left}, @code{right}, and @code{nil} for no scroll bars.
1652 1747
1653@vindex horizontal-scroll-bars, a frame parameter 1748@vindex horizontal-scroll-bars, a frame parameter
1654@item horizontal-scroll-bars 1749@item horizontal-scroll-bars
@@ -1692,30 +1787,40 @@ to not draw bottom dividers.
1692 1787
1693@vindex menu-bar-lines frame parameter 1788@vindex menu-bar-lines frame parameter
1694@item menu-bar-lines 1789@item menu-bar-lines
1695The number of lines to allocate at the top of the frame for a menu bar. 1790The number of lines to allocate at the top of the frame for a menu bar
1696The default is one if Menu Bar mode is enabled and zero otherwise. 1791(@pxref{Menu Bar}). The default is one if Menu Bar mode is enabled and
1697@xref{Menu Bars,,,emacs, The GNU Emacs Manual}. For an external menu 1792zero otherwise. @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. For an
1698bar, this value remains unchanged even when the menu bar wraps to two or 1793external menu bar (@pxref{Frame Layout}), this value remains unchanged
1699more lines. In that case, the @code{menu-bar-size} value returned by 1794even when the menu bar wraps to two or more lines. In that case, the
1700@code{frame-geometry} (@pxref{Frame Geometry}) allows to derive whether 1795@code{menu-bar-size} value returned by @code{frame-geometry}
1701the menu bar actually occupies one or more lines. 1796(@pxref{Frame Geometry}) allows to derive whether the menu bar actually
1797occupies one or more lines.
1702 1798
1703@vindex tool-bar-lines frame parameter 1799@vindex tool-bar-lines frame parameter
1704@item tool-bar-lines 1800@item tool-bar-lines
1705The number of lines to use for the tool bar. The default is one if Tool 1801The number of lines to use for the tool bar (@pxref{Tool Bar}). The
1706Bar mode is enabled and zero otherwise. @xref{Tool Bars,,,emacs, The 1802default is one if Tool Bar mode is enabled and zero otherwise.
1707GNU Emacs Manual}. This value may change whenever the tool bar wraps. 1803@xref{Tool Bars,,,emacs, The GNU Emacs Manual}. This value may change
1804whenever the tool bar wraps (@pxref{Frame Layout}).
1708 1805
1709@vindex tool-bar-position frame parameter 1806@vindex tool-bar-position frame parameter
1710@item tool-bar-position 1807@item tool-bar-position
1711The position of the tool bar. Currently only for the GTK tool bar. 1808The position of the tool bar when Emacs was built with GTK+. Its value
1712Value can be one of @code{top}, @code{bottom} @code{left}, @code{right}. 1809can be one of @code{top}, @code{bottom} @code{left}, @code{right}. The
1713The default is @code{top}. 1810default is @code{top}.
1714 1811
1715@vindex line-spacing, a frame parameter 1812@vindex line-spacing, a frame parameter
1716@item line-spacing 1813@item line-spacing
1717Additional space to leave below each text line, in pixels (a positive 1814Additional space to leave below each text line, in pixels (a positive
1718integer). @xref{Line Height}, for more information. 1815integer). @xref{Line Height}, for more information.
1816
1817@vindex no-special-glyphs, a frame parameter
1818@item no-special-glyphs
1819If this is non-@code{nil}, it suppresses the display of any truncation
1820and continuation glyphs (@pxref{Truncation}) for all buffers displayed
1821by this frame. This is useful to eliminate such glyphs when fitting a
1822frame to its buffer via @code{fit-frame-to-buffer} (@pxref{Resizing
1823Windows}).
1719@end table 1824@end table
1720 1825
1721 1826
@@ -1781,15 +1886,115 @@ Frames}.
1781@item mouse-wheel-frame 1886@item mouse-wheel-frame
1782If non-@code{nil}, this parameter specifies the frame whose windows will 1887If non-@code{nil}, this parameter specifies the frame whose windows will
1783be scrolled whenever the mouse wheel is scrolled with the mouse pointer 1888be scrolled whenever the mouse wheel is scrolled with the mouse pointer
1784hovering over this frame (@pxref{Mouse Commands,,, emacs, The GNU Emacs 1889hovering over this frame, see @ref{Mouse Commands,,, emacs, The GNU
1785Manual}). 1890Emacs Manual}.
1786 1891
1787@vindex no-other-frame, a frame parameter 1892@vindex no-other-frame, a frame parameter
1788@item no-other-frame 1893@item no-other-frame
1789If this is non-@code{nil}, then this frame is not eligible as candidate 1894If this is non-@code{nil}, then this frame is not eligible as candidate
1790for the functions @code{next-frame}, @code{previous-frame} 1895for the functions @code{next-frame}, @code{previous-frame}
1791(@pxref{Finding All Frames}) and @code{other-frame} (@pxref{Frame 1896(@pxref{Finding All Frames}) and @code{other-frame}, see @ref{Frame
1792Commands,,, emacs, The GNU Emacs Manual}). 1897Commands,,, emacs, The GNU Emacs Manual}.
1898
1899@vindex auto-hide-function, a frame parameter
1900@item auto-hide-function
1901When this parameter specifies a function, that function will be called
1902instead of the function specified by the variable
1903@code{frame-auto-hide-function} when quitting the frame's only window
1904(@pxref{Quitting Windows}) and there are other frames left.
1905
1906@vindex minibuffer-exit, a frame parameter
1907@item minibuffer-exit
1908When this parameter is non-@code{nil}, Emacs will by default make this
1909frame invisible whenever the minibuffer (@pxref{Minibuffers}) is exited.
1910Alternatively, it can specify the functions @code{iconify-frame} and
1911@code{delete-frame}. This parameter is useful to make a child frame
1912disappear automatically (similar to how Emacs deals with a window) when
1913exiting the minibuffer.
1914
1915@vindex keep-ratio, a frame parameter
1916@item keep-ratio
1917This parameter is currently meaningful for child frames (@pxref{Child
1918Frames}) only. If it is non-@code{nil}, then Emacs will try to keep the
1919frame's size (width and height) ratios (@pxref{Size Parameters}) as well
1920as its left and right position ratios (@pxref{Position Parameters})
1921unaltered whenever its parent frame is resized.
1922
1923If the value of this parameter is @code{nil}, the frame's position and
1924size remain unaltered when the parent frame is resized, so the position
1925and size ratios may change. If the value of this parameter is @code{t},
1926Emacs will try to preserve the frame's size and position ratios, hence
1927the frame's size and position relative to its parent frame may change.
1928
1929More individual control is possible by using a cons cell: In that case
1930the frame's width ratio is preserved if the @sc{car} of the cell is
1931either @code{t} or @code{width-only}. The height ratio is preserved if
1932the @sc{car} of the cell is either @code{t} or @code{height-only}. The
1933left position ratio is preserved if the @sc{cdr} of the cell is either
1934@code{t} or @code{left-only}. The top position ratio is preserved if
1935the @sc{cdr} of the cell is either @code{t} or @code{top-only}.
1936@end table
1937
1938
1939@node Mouse Dragging Parameters
1940@subsubsection Mouse Dragging Parameters
1941@cindex mouse dragging parameters
1942@cindex parameters for resizing frames with the mouse
1943@cindex parameters for moving frames with the mouse
1944
1945The parameters described below provide support for resizing a frame by
1946dragging its internal borders with the mouse. They also allow moving a
1947frame with the mouse by dragging the header line of its topmost or the
1948mode line of its bottommost window.
1949
1950These parameters are mostly useful for child frames (@pxref{Child
1951Frames}) that come without window manager decorations. If necessary,
1952they can be used for undecorated top-level frames as well.
1953
1954@table @code
1955@vindex drag-internal-border, a frame parameter
1956@item drag-internal-border
1957If non-@code{nil}, the frame can be resized by dragging its internal
1958borders, if present, with the mouse.
1959
1960@vindex drag-with-header-line, a frame parameter
1961@item drag-with-header-line
1962If non-@code{nil}, the frame can be moved with the mouse by dragging the
1963header line of its topmost window.
1964
1965@vindex drag-with-mode-line, a frame parameter
1966@item drag-with-mode-line
1967If non-@code{nil}, the frame can be moved with the mouse by dragging the
1968mode line of its bottommost window. Note that such a frame is not
1969allowed to have its own minibuffer window.
1970
1971@vindex snap-width, a frame parameter
1972@item snap-width
1973A frame that is moved with the mouse will ``snap'' at the border(s) of
1974the display or its parent frame whenever it is dragged as near to such
1975an edge as the number of pixels specified by this parameter.
1976
1977@vindex top-visible, a frame parameter
1978@item top-visible
1979If this parameter is a number, the top edge of the frame never appears
1980above the top edge of its display or parent frame. Moreover, as many
1981pixels of the frame as specified by that number will remain visible when
1982the frame is moved against any of the remaining edges of its display or
1983parent frame. Setting this parameter is useful to guard against
1984dragging a child frame with a non-@code{nil}
1985@code{drag-with-header-line} parameter completely out of the area
1986of its parent frame.
1987
1988@vindex bottom-visible, a frame parameter
1989@item bottom-visible
1990If this parameter is a number, the bottom edge of the frame never
1991appears below the bottom edge of its display or parent frame. Moreover,
1992as many pixels of the frame as specified by that number will remain
1993visible when the frame is moved against any of the remaining edges of
1994its display or parent frame. Setting this parameter is useful to guard
1995against dragging a child frame with a non-@code{nil}
1996@code{drag-with-mode-line} parameter completely out of the area of
1997its parent frame.
1793@end table 1998@end table
1794 1999
1795 2000
@@ -1797,9 +2002,9 @@ Commands,,, emacs, The GNU Emacs Manual}).
1797@subsubsection Window Management Parameters 2002@subsubsection Window Management Parameters
1798@cindex window manager interaction, and frame parameters 2003@cindex window manager interaction, and frame parameters
1799 2004
1800 The following frame parameters control various aspects of the 2005 The following frame parameters control various aspects of the frame's
1801frame's interaction with the window manager. They have no effect on 2006interaction with the window manager or window system. They have no
1802text terminals. 2007effect on text terminals.
1803 2008
1804@table @code 2009@table @code
1805@vindex visibility, a frame parameter 2010@vindex visibility, a frame parameter
@@ -1908,7 +2113,8 @@ If non-@code{nil}, this means that this is an @dfn{override redirect}
1908frame---a frame not handled by window managers under X. Override 2113frame---a frame not handled by window managers under X. Override
1909redirect frames have no window manager decorations, can be positioned 2114redirect frames have no window manager decorations, can be positioned
1910and resized only via Emacs' positioning and resizing functions and are 2115and resized only via Emacs' positioning and resizing functions and are
1911usually drawn on top of all other frames. 2116usually drawn on top of all other frames. Setting this parameter has
2117no effect on MS-Windows.
1912 2118
1913@ignore 2119@ignore
1914@vindex parent-id, a frame parameter 2120@vindex parent-id, a frame parameter
@@ -2080,6 +2286,9 @@ The @code{alpha} frame parameter can also be a cons cell
2080@code{(@var{active} . @var{inactive})}, where @var{active} is the 2286@code{(@var{active} . @var{inactive})}, where @var{active} is the
2081opacity of the frame when it is selected, and @var{inactive} is the 2287opacity of the frame when it is selected, and @var{inactive} is the
2082opacity when it is not selected. 2288opacity when it is not selected.
2289
2290Some window systems do not support the @code{alpha} parameter for child
2291frames (@pxref{Child Frames}).
2083@end table 2292@end table
2084 2293
2085The following frame parameters are semi-obsolete in that they are 2294The following frame parameters are semi-obsolete in that they are
@@ -2824,57 +3033,78 @@ unwanted frames are iconified instead.
2824@cindex child frames 3033@cindex child frames
2825@cindex parent frames 3034@cindex parent frames
2826 3035
2827On some window-systems the @code{parent-frame} parameter (@pxref{Frame 3036Child frames are objects halfway between windows (@pxref{Windows}) and
2828Interaction Parameters}) can be used to make a frame a child of the 3037``normal'' frames. Like windows, they are attached to an owning frame.
2829frame specified by that parameter. The frame specified by that 3038Unlike windows, they may overlap each other---changing the size or
2830parameter will then be the frame's parent frame as long as the parameter 3039position of one child frame does not change the size or position of any
2831is not changed or reset. Technically, this makes the child frame's 3040of its sibling child frames.
2832window-system window a child window of the parent frame's window-system 3041
2833window. 3042 By design, operations to make or modify child frames are implemented
3043with the help of frame parameters (@pxref{Frame Parameters}) without any
3044specialized functions or customizable variables. Note that child frames
3045are meaningful on graphical terminals only.
3046
3047 To create a new child frame or to convert a normal frame into a child
3048frame, set that frame's @code{parent-frame} parameter (@pxref{Frame
3049Interaction Parameters}) to that of an already existing frame. The
3050frame specified by that parameter will then be the frame's parent frame
3051as long as the parameter is not changed or reset. Technically, this
3052makes the child frame's window-system window a child window of the
3053parent frame's window-system window.
2834 3054
3055@cindex top-level frame
3056@cindex reparent frame
3057@cindex nest frame
2835 The @code{parent-frame} parameter can be changed at any time. Setting 3058 The @code{parent-frame} parameter can be changed at any time. Setting
2836it to another frame ``reparents'' the child frame. Setting it to 3059it to another frame @dfn{reparents} the child frame. Setting it to
2837another child frame makes the frame a ``nested'' child frame. Setting 3060another child frame makes the frame a @dfn{nested} child frame. Setting
2838it to @code{nil} restores the frame's status as a top-level frame---one 3061it to @code{nil} restores the frame's status as a @dfn{top-level
2839whose window-system window is a child of its display's root window. 3062frame}---a frame whose window-system window is a child of its display's
3063root window.
2840 3064
2841 Since child frames can be arbitrarily nested, a frame can be both a 3065 Since child frames can be arbitrarily nested, a frame can be both a
2842child and a parent frame. Also, the relative roles of child and parent 3066child and a parent frame. Also, the relative roles of child and parent
2843frame may be reversed at any time (though it's usually a good idea to 3067frame may be reversed at any time (though it's usually a good idea to
2844keep the size of child frames sufficiently smaller than that of their 3068keep the size of a child frame sufficiently smaller than that of its
2845parent). An error will be signaled for the attempt to make a frame an 3069parent). An error will be signaled for the attempt to make a frame an
2846ancestor of itself. 3070ancestor of itself.
2847 3071
2848 A child frame is clipped at the native edges (@pxref{Frame Geometry}) 3072 Most window-systems clip a child frame at the native edges
2849of its parent frame---everything outside these edges is invisible. Its 3073(@pxref{Frame Geometry}) of its parent frame---everything outside these
2850@code{left} and @code{top} parameters specify positions relative to the 3074edges is usually invisible. A child frame's @code{left} and @code{top}
2851top-left corner of its parent's native frame. When either of the frames 3075parameters specify a position relative to the top-left corner of its
2852is resized, the relative position of the child frame remains unaltered. 3076parent's native frame. When the parent frame is resized, this position
2853Hence, resizing either of these frames can hide or reveal parts of the 3077remains conceptually unaltered.
2854child frame.
2855 3078
2856 NS builds do not clip child frames at the parent frame's edges, 3079 NS builds do not clip child frames at the parent frame's edges,
2857allowing them to be positioned so they do not obscure the parent 3080allowing them to be positioned so they do not obscure the parent frame
2858frame while still being visible themselves. 3081while still being visible themselves.
2859 3082
2860 Usually, moving a parent frame moves along all its child frames and 3083 Usually, moving a parent frame moves along all its child frames and
2861their descendants as well, keeping their relative positions unaltered. 3084their descendants as well, keeping their relative positions unaltered.
2862The hook @code{move-frame-functions} (@pxref{Frame Position}) is run for 3085Note that the hook @code{move-frame-functions} (@pxref{Frame Position})
2863a child frame only when the position of the child frame relative to its 3086is run for a child frame only when the position of the child frame
2864parent frame changes. When a parent frame is resized, the child frame 3087relative to its parent frame changes. It is not run for a child frame
2865retains its position respective to the left and upper native edges of 3088when the position of the parent frame changes.
2866its parent. In this case, the position respective to the lower or right 3089
2867native edge of the parent frame is usually lost. 3090 When a parent frame is resized, its child frames conceptually retain
3091their previous sizes and their positions relative to the left upper
3092corner of the parent. This means that a child frame may become
3093(partially) invisible when its parent frame shrinks. The parameter
3094@code{keep-ratio} (@pxref{Frame Interaction Parameters}) can be used to
3095resize and reposition a child frame proportionally whenever its parent
3096frame is resized. This may avoid obscuring parts of a frame when its
3097parent frame is shrunk.
2868 3098
2869 A visible child frame always appears on top of its parent frame thus 3099 A visible child frame always appears on top of its parent frame thus
2870obscuring parts of it, except on NS builds where it may be positioned 3100obscuring parts of it, except on NS builds where it may be positioned
2871beneath the parent. This is comparable to the window-system window of 3101beneath the parent. This is comparable to the window-system window of a
2872a top-level frame which also always appears on top of its parent 3102top-level frame which also always appears on top of its parent
2873window---the desktop's root window. When a parent frame is iconified 3103window---the desktop's root window. When a parent frame is iconified or
2874or made invisible (@pxref{Visibility of Frames}), its child frames are 3104made invisible (@pxref{Visibility of Frames}), its child frames are made
2875made invisible. When a parent frame is deiconified or made visible, 3105invisible. When a parent frame is deiconified or made visible, its
2876its child frames are made visible. When a parent frame is about to be 3106child frames are made visible. When a parent frame is about to be
2877deleted, (@pxref{Deleting Frames}) its child frames are recursively 3107deleted (@pxref{Deleting Frames}), its child frames are recursively
2878deleted before it. 3108deleted before it.
2879 3109
2880 Whether a child frame can have a menu or tool bar is window-system or 3110 Whether a child frame can have a menu or tool bar is window-system or
@@ -2892,7 +3122,55 @@ outer border can be used. On MS-Windows, specifying a non-zero outer
2892border width will show a one-pixel wide external border. Under all 3122border width will show a one-pixel wide external border. Under all
2893window-systems, the internal border can be used. In either case, it's 3123window-systems, the internal border can be used. In either case, it's
2894advisable to disable a child frame's window manager decorations with the 3124advisable to disable a child frame's window manager decorations with the
2895@code{undecorated} frame parameter @pxref{Management Parameters}). 3125@code{undecorated} frame parameter (@pxref{Management Parameters}).
3126
3127 To resize or move an undecorated child frame with the mouse, special
3128frame parameters (@pxref{Mouse Dragging Parameters}) have to be used.
3129The internal border of a child frame, if present, can be used to resize
3130the frame with the mouse, provided that frame has a non-@code{nil}
3131@code{drag-internal-border} parameter. If set, the @code{snap-width}
3132parameter indicates the number of pixels where the frame @dfn{snaps} at
3133the respective edge or corner of its parent frame.
3134
3135 There are two ways to drag an entire child frame with the mouse: The
3136@code{drag-with-mode-line} parameter, if non-@code{nil}, allows to drag
3137a frame without minibuffer window (@pxref{Minibuffer Windows}) via the
3138mode line area of its bottommost window. The
3139@code{drag-with-header-line} parameter, if non-@code{nil}, allows to
3140drag the frame via the header line area of its topmost window.
3141
3142 In order to give a child frame a draggable header or mode line, the
3143window parameters @code{mode-line-format} and @code{header-line-format}
3144are handy (@pxref{Window Parameters}). These allow to remove an
3145unwanted mode line (when @code{drag-with-header-line} is chosen) and to
3146remove mouse-sensitive areas which might interfere with frame dragging.
3147
3148 To avoid that dragging moves a frame completely out of its parent's
3149native frame, something which might happen when the mouse cursor
3150overshoots and makes the frame difficult to retrieve once the mouse
3151button has been released, it is advisable to set the frame's
3152@code{top-visible} or @code{bottom-visible} parameter correspondingly.
3153
3154 The @code{top-visible} parameter specifies the number of pixels at the
3155top of the frame that always remain visible within the parent's native
3156frame during dragging and should be set when specifying a non-@code{nil}
3157@code{drag-with-header-line} parameter. The @code{bottom-visible}
3158parameter specifies the number of pixels at the bottom of the frame that
3159always remain visible within the parent's native frame during dragging
3160and should be preferred when specifying a non-@code{nil}
3161@code{drag-with-mode-line} parameter.
3162
3163 When a child frame is used for displaying a buffer via
3164@code{display-buffer-in-child-frame} (@pxref{Display Action Functions}),
3165the frame's @code{auto-hide-function} parameter (@pxref{Frame
3166Interaction Parameters}) can be set to a function, in order to
3167appropriately deal with the frame when the window displaying the buffer
3168shall be quit.
3169
3170 When a child frame is used during minibuffer interaction, for example,
3171to display completions in a separate window, the @code{minibuffer-exit}
3172parameter (@pxref{Frame Interaction Parameters}) is useful in order to
3173deal with the frame when the minibuffer is exited.
2896 3174
2897 The behavior of child frames deviates from that of top-level frames in 3175 The behavior of child frames deviates from that of top-level frames in
2898a number of other ways as well. Here we sketch a few of them: 3176a number of other ways as well. Here we sketch a few of them:
@@ -2930,7 +3208,7 @@ work on all window-systems. Some will drop the object on the parent
2930frame or on some ancestor instead. 3208frame or on some ancestor instead.
2931@end itemize 3209@end itemize
2932 3210
2933 The following two functions may be useful when working with child and 3211 The following two functions can be useful when working with child and
2934parent frames: 3212parent frames:
2935 3213
2936@defun frame-parent &optional frame 3214@defun frame-parent &optional frame
@@ -2951,6 +3229,12 @@ of @var{descendant}'s parent frame. Both, @var{ancestor} and
2951frame. 3229frame.
2952@end defun 3230@end defun
2953 3231
3232Note also the function @code{window-largest-empty-rectangle}
3233(@pxref{Coordinates and Windows}) which can be used to inscribe a child
3234frame in the largest empty area of an existing window. This can be
3235useful to avoid that a child frame obscures any text shown in that
3236window.
3237
2954 3238
2955@node Mouse Tracking 3239@node Mouse Tracking
2956@section Mouse Tracking 3240@section Mouse Tracking
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 0e476b47a31..f7013da9433 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1737,7 +1737,9 @@ holds a @dfn{mode line construct}: a template that controls what is
1737displayed on the buffer's mode line. The value of 1737displayed on the buffer's mode line. The value of
1738@code{header-line-format} specifies the buffer's header line in the same 1738@code{header-line-format} specifies the buffer's header line in the same
1739way. All windows for the same buffer use the same 1739way. All windows for the same buffer use the same
1740@code{mode-line-format} and @code{header-line-format}. 1740@code{mode-line-format} and @code{header-line-format} unless a
1741@code{mode-line-format} or @code{header-line-format} parameter has been
1742specified for that window (@pxref{Window Parameters}).
1741 1743
1742 For efficiency, Emacs does not continuously recompute each window's 1744 For efficiency, Emacs does not continuously recompute each window's
1743mode line and header line. It does so when circumstances appear to call 1745mode line and header line. It does so when circumstances appear to call
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 1f4c378df18..daa397175c3 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -283,11 +283,11 @@ character @kbd{a}.
283?Q @result{} 81 ?q @result{} 113 283?Q @result{} 81 ?q @result{} 113
284@end example 284@end example
285 285
286 You can use the same syntax for punctuation characters, but it is 286 You can use the same syntax for punctuation characters. However, if
287often a good idea to add a @samp{\} so that the Emacs commands for 287the punctuation character has a special syntactic meaning in Lisp, you
288editing Lisp code don't get confused. For example, @samp{?\(} is the 288must quote it with a @samp{\}. For example, @samp{?\(} is the way to
289way to write the open-paren character. If the character is @samp{\}, 289write the open-paren character. Likewise, if the character is
290you @emph{must} use a second @samp{\} to quote it: @samp{?\\}. 290@samp{\}, you must use a second @samp{\} to quote it: @samp{?\\}.
291 291
292@cindex whitespace 292@cindex whitespace
293@cindex bell character 293@cindex bell character
@@ -336,18 +336,19 @@ escape character; this has nothing to do with the
336character @key{ESC}. @samp{\s} is meant for use in character 336character @key{ESC}. @samp{\s} is meant for use in character
337constants; in string constants, just write the space. 337constants; in string constants, just write the space.
338 338
339 A backslash is allowed, and harmless, preceding any character without 339 A backslash is allowed, and harmless, preceding any character
340a special escape meaning; thus, @samp{?\+} is equivalent to @samp{?+}. 340without a special escape meaning; thus, @samp{?\+} is equivalent to
341There is no reason to add a backslash before most characters. However, 341@samp{?+}. There is no reason to add a backslash before most
342you should add a backslash before any of the characters 342characters. However, you must add a backslash before any of the
343@samp{()\|;'`"#.,} to avoid confusing the Emacs commands for editing 343characters @samp{()[]\;"}, and you should add a backslash before any
344Lisp code. You can also add a backslash before whitespace characters such as 344of the characters @samp{|'`#.,} to avoid confusing the Emacs commands
345space, tab, newline and formfeed. However, it is cleaner to use one of 345for editing Lisp code. You can also add a backslash before whitespace
346the easily readable escape sequences, such as @samp{\t} or @samp{\s}, 346characters such as space, tab, newline and formfeed. However, it is
347instead of an actual whitespace character such as a tab or a space. 347cleaner to use one of the easily readable escape sequences, such as
348(If you do write backslash followed by a space, you should write 348@samp{\t} or @samp{\s}, instead of an actual whitespace character such
349an extra space after the character constant to separate it from the 349as a tab or a space. (If you do write backslash followed by a space,
350following text.) 350you should write an extra space after the character constant to
351separate it from the following text.)
351 352
352@node General Escape Syntax 353@node General Escape Syntax
353@subsubsection General Escape Syntax 354@subsubsection General Escape Syntax
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index d9b4b743a3b..eb5c2fc46be 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -752,6 +752,7 @@ The optional argument @var{pixelwise} non-@code{nil} means to return the
752minimum size of @var{window} counted in pixels. 752minimum size of @var{window} counted in pixels.
753@end defun 753@end defun
754 754
755
755@node Resizing Windows 756@node Resizing Windows
756@section Resizing Windows 757@section Resizing Windows
757@cindex window resizing 758@cindex window resizing
@@ -943,7 +944,8 @@ help of the two options listed next.
943@defopt fit-frame-to-buffer-margins 944@defopt fit-frame-to-buffer-margins
944This option can be used to specify margins around frames to be fit by 945This option can be used to specify margins around frames to be fit by
945@code{fit-frame-to-buffer}. Such margins can be useful to avoid, for 946@code{fit-frame-to-buffer}. Such margins can be useful to avoid, for
946example, that such frames overlap the taskbar. 947example, that the resized frame overlaps the taskbar or parts of its
948parent frame.
947 949
948It specifies the numbers of pixels to be left free on the left, above, 950It specifies the numbers of pixels to be left free on the left, above,
949the right, and below a frame that shall be fit. The default specifies 951the right, and below a frame that shall be fit. The default specifies
@@ -2484,6 +2486,25 @@ the function specified in @code{pop-up-frame-function}
2484is added to the newly created frame's parameters. 2486is added to the newly created frame's parameters.
2485@end defun 2487@end defun
2486 2488
2489@defun display-buffer-in-child-frame buffer alist
2490This function tries to display @var{buffer} in a child frame
2491(@pxref{Child Frames}) of the selected frame, either reusing an existing
2492child frame or by making a new one. If @var{alist} has a non-@code{nil}
2493@code{child-frame-parameters} entry, the corresponding value is an alist
2494of frame parameters to give the new frame. A @code{parent-frame}
2495parameter specifying the selected frame is provided by default. If the
2496child frame should be or become the child of another frame, a
2497corresponding entry must be added to @var{alist}.
2498
2499The appearance of child frames is largely dependent on the parameters
2500provided via @var{alist}. It is advisable to use at least ratios to
2501specify the size (@pxref{Size Parameters}) and the position
2502(@pxref{Position Parameters}) of the child frame and to add the
2503@code{keep-ratio} in order to make sure that the child frame remains
2504visible. For other parameters that should be considered see @ref{Child
2505Frames}.
2506@end defun
2507
2487@defun display-buffer-use-some-frame buffer alist 2508@defun display-buffer-use-some-frame buffer alist
2488This function tries to display @var{buffer} by trying to find a 2509This function tries to display @var{buffer} by trying to find a
2489frame that meets a predicate (by default any frame other than the 2510frame that meets a predicate (by default any frame other than the
@@ -3124,12 +3145,17 @@ killed.
3124The default is to call @code{iconify-frame} (@pxref{Visibility of 3145The default is to call @code{iconify-frame} (@pxref{Visibility of
3125Frames}). Alternatively, you may specify either @code{delete-frame} 3146Frames}). Alternatively, you may specify either @code{delete-frame}
3126(@pxref{Deleting Frames}) to remove the frame from its display, 3147(@pxref{Deleting Frames}) to remove the frame from its display,
3127@code{ignore} to leave the frame unchanged, or any other function that 3148@code{make-frame-invisible} to make the frame invisible, @code{ignore}
3128can take a frame as its sole argument. 3149to leave the frame unchanged, or any other function that can take a
3150frame as its sole argument.
3129 3151
3130Note that the function specified by this option is called only if the 3152Note that the function specified by this option is called only if the
3131specified frame contains just one live window and there is at least one 3153specified frame contains just one live window and there is at least one
3132other frame on the same terminal. 3154other frame on the same terminal.
3155
3156For a particular frame, the value specified here may be overridden by
3157that frame's @code{auto-hide-function} frame parameter (@pxref{Frame
3158Interaction Parameters}).
3133@end defopt 3159@end defopt
3134 3160
3135 3161
@@ -4364,13 +4390,12 @@ is off the screen due to horizontal scrolling:
4364@cindex coordinate, relative to frame 4390@cindex coordinate, relative to frame
4365@cindex window position 4391@cindex window position
4366 4392
4367This section describes functions that report the position of a window. 4393This section describes functions that report positions of and within a
4368Most of these functions report positions relative to an origin at the 4394window. Most of these functions report positions relative to an origin
4369native position of the window's frame (@pxref{Frame Geometry}). Some 4395at the native position of the window's frame (@pxref{Frame Geometry}).
4370functions report positions relative to the origin of the display of the 4396Some functions report positions relative to the origin of the display of
4371window's frame. In any case, the origin has the coordinates (0, 0) and 4397the window's frame. In any case, the origin has the coordinates (0, 0)
4372X and Y coordinates increase rightward and downward 4398and X and Y coordinates increase rightward and downward respectively.
4373respectively.
4374 4399
4375 For the following functions, X and Y coordinates are reported in 4400 For the following functions, X and Y coordinates are reported in
4376integer character units, i.e., numbers of lines and columns 4401integer character units, i.e., numbers of lines and columns
@@ -4608,6 +4633,49 @@ point in the selected window, it's sufficient to write:
4608@end example 4633@end example
4609@end defun 4634@end defun
4610 4635
4636The following function returns the largest rectangle that can be
4637inscribed in a window without covering text displayed in that window.
4638
4639@defun window-largest-empty-rectangle &optional window count min-width min-height positions left
4640This function calculates the dimensions of the largest empty rectangle
4641that can be inscribed in the specified @var{window}'s text area.
4642@var{window} must be a live window and defaults to the selected one.
4643
4644The return value is a triple of the width and the start and end
4645y-coordinates of the largest rectangle that can be inscribed into the
4646empty space (space not displaying any text) of the text area of
4647@var{window}. No x-coordinates are returned by this function---any such
4648rectangle is assumed to end at the right edge of @var{window}'s text
4649area. If no empty space can be found, the return value is @code{nil}.
4650
4651The optional argument @var{count}, if non-@code{nil}, specifies a
4652maximum number of rectangles to return. This means that the return
4653value is a list of triples specifying rectangles with the largest
4654rectangle first. @var{count} can be also a cons cell whose car
4655specifies the number of rectangles to return and whose @sc{cdr}, if
4656non-@code{nil}, states that all rectangles returned must be disjoint.
4657
4658The optional arguments @var{min-width} and @var{min-height}, if
4659non-@code{nil}, specify the minimum width and height of any rectangle
4660returned.
4661
4662The optional argument @var{positions}, if non-@code{nil}, is a cons cell
4663whose @sc{car} specifies the uppermost and whose @sc{cdr} specifies the
4664lowermost pixel position that must be covered by any rectangle returned.
4665These positions measure from the start of the text area of @var{window}.
4666
4667The optional argument @var{left}, if non-@code{nil}, means to return
4668values suitable for buffers displaying right to left text. In that
4669case, any rectangle returned is assumed to start at the left edge of
4670@var{window}'s text area.
4671
4672Note that this function has to retrieve the dimensions of each line of
4673@var{window}'s glyph matrix via @code{window-lines-pixel-dimensions}
4674(@pxref{Size of Displayed Text}). Hence, this function may also return
4675@code{nil} when the current glyph matrix of @var{window} is not
4676up-to-date.
4677@end defun
4678
4611 4679
4612@node Mouse Window Auto-selection 4680@node Mouse Window Auto-selection
4613@section Mouse Window Auto-selection 4681@section Mouse Window Auto-selection
@@ -4911,37 +4979,45 @@ windows when exiting that function.
4911The following parameters are currently used by the window management 4979The following parameters are currently used by the window management
4912code: 4980code:
4913 4981
4914@table @asis 4982@table @code
4915@item @code{delete-window} 4983@item delete-window
4984@vindex delete-window, a window parameter
4916This parameter affects the execution of @code{delete-window} 4985This parameter affects the execution of @code{delete-window}
4917(@pxref{Deleting Windows}). 4986(@pxref{Deleting Windows}).
4918 4987
4919@item @code{delete-other-windows} 4988@item delete-other-windows
4989@vindex delete-other-windows, a window parameter
4920This parameter affects the execution of @code{delete-other-windows} 4990This parameter affects the execution of @code{delete-other-windows}
4921(@pxref{Deleting Windows}). 4991(@pxref{Deleting Windows}).
4922 4992
4923@item @code{no-delete-other-window} 4993@item no-delete-other-window
4994@vindex no-delete-other-window, a window parameter
4924This parameter marks the window as not deletable by 4995This parameter marks the window as not deletable by
4925@code{delete-other-windows} (@pxref{Deleting Windows}). 4996@code{delete-other-windows} (@pxref{Deleting Windows}).
4926 4997
4927@item @code{split-window} 4998@item split-window
4999@vindex split-window, a window parameter
4928This parameter affects the execution of @code{split-window} 5000This parameter affects the execution of @code{split-window}
4929(@pxref{Splitting Windows}). 5001(@pxref{Splitting Windows}).
4930 5002
4931@item @code{other-window} 5003@item other-window
5004@vindex other-window, a window parameter
4932This parameter affects the execution of @code{other-window} 5005This parameter affects the execution of @code{other-window}
4933(@pxref{Cyclic Window Ordering}). 5006(@pxref{Cyclic Window Ordering}).
4934 5007
4935@item @code{no-other-window} 5008@item no-other-window
5009@vindex no-other-window, a window parameter
4936This parameter marks the window as not selectable by @code{other-window} 5010This parameter marks the window as not selectable by @code{other-window}
4937(@pxref{Cyclic Window Ordering}). 5011(@pxref{Cyclic Window Ordering}).
4938 5012
4939@item @code{clone-of} 5013@item clone-of
5014@vindex clone-of, a window parameter
4940This parameter specifies the window that this one has been cloned 5015This parameter specifies the window that this one has been cloned
4941from. It is installed by @code{window-state-get} (@pxref{Window 5016from. It is installed by @code{window-state-get} (@pxref{Window
4942Configurations}). 5017Configurations}).
4943 5018
4944@item @code{preserved-size} 5019@item preserved-size
5020@vindex preserved-size, a window parameter
4945This parameter specifies a buffer, a direction where @code{nil} means 5021This parameter specifies a buffer, a direction where @code{nil} means
4946vertical and @code{t} horizontal, and a size in pixels. If this window 5022vertical and @code{t} horizontal, and a size in pixels. If this window
4947displays the specified buffer and its size in the indicated direction 5023displays the specified buffer and its size in the indicated direction
@@ -4950,7 +5026,8 @@ preserve the size of this window in the indicated direction. This
4950parameter is installed and updated by the function 5026parameter is installed and updated by the function
4951@code{window-preserve-size} (@pxref{Preserving Window Sizes}). 5027@code{window-preserve-size} (@pxref{Preserving Window Sizes}).
4952 5028
4953@item @code{quit-restore} 5029@item quit-restore
5030@vindex quit-restore, a window parameter
4954This parameter is installed by the buffer display functions 5031This parameter is installed by the buffer display functions
4955(@pxref{Choosing Window}) and consulted by @code{quit-restore-window} 5032(@pxref{Choosing Window}) and consulted by @code{quit-restore-window}
4956(@pxref{Quitting Windows}). It contains four elements: 5033(@pxref{Quitting Windows}). It contains four elements:
@@ -4981,15 +5058,37 @@ only if it still shows that buffer.
4981See the description of @code{quit-restore-window} in @ref{Quitting 5058See the description of @code{quit-restore-window} in @ref{Quitting
4982Windows} for details. 5059Windows} for details.
4983 5060
4984@item @code{window-side} @code{window-slot} 5061@item window-side window-slot
5062@vindex window-side, a window parameter
5063@vindex window-slot, a window parameter
4985These parameters are used for implementing side windows (@pxref{Side 5064These parameters are used for implementing side windows (@pxref{Side
4986Windows}). 5065Windows}).
4987 5066
4988@item @code{window-atom} 5067@item window-atom
5068@vindex window-atom, a window parameter
4989This parameter is used for implementing atomic windows, see @ref{Atomic 5069This parameter is used for implementing atomic windows, see @ref{Atomic
4990Windows}. 5070Windows}.
4991 5071
4992@item @code{min-margins} 5072@item mode-line-format
5073@vindex mode-line-format, a window parameter
5074This parameter replaces the value of the buffer-local variable
5075@code{mode-line-format} (@pxref{Mode Line Basics}) of this window's
5076buffer whenever this window is displayed. The symbol @code{none} means
5077to suppress display of a mode line for this window. Display and
5078contents of the mode line on other windows showing this buffer are not
5079affected.
5080
5081@item header-line-format
5082@vindex header-line-format, a window parameter
5083This parameter replaces the value of the buffer-local variable
5084@code{header-line-format} (@pxref{Mode Line Basics}) of this window's
5085buffer whenever this window is displayed. The symbol @code{none} means
5086to suppress display of a header line for this window. Display and
5087contents of the header line on other windows showing this buffer are not
5088affected.
5089
5090@item min-margins
5091@vindex min-margins, a window parameter
4993The value of this parameter is a cons cell whose @sc{car} and @sc{cdr}, 5092The value of this parameter is a cons cell whose @sc{car} and @sc{cdr},
4994if non-@code{nil}, specify the minimum values (in columns) for the left 5093if non-@code{nil}, specify the minimum values (in columns) for the left
4995and right margin of this window. When present, Emacs will use these 5094and right margin of this window. When present, Emacs will use these
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index b0cfbc9d3c0..069d6b3389b 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -405,7 +405,7 @@ variable will cause @samp{text/html} parts to be treated as attachments.
405@item mm-text-html-renderer 405@item mm-text-html-renderer
406@vindex mm-text-html-renderer 406@vindex mm-text-html-renderer
407This selects the function used to render @acronym{HTML}. The predefined 407This selects the function used to render @acronym{HTML}. The predefined
408renderers are selected by the symbols @code{gnus-article-html}, 408renderers are selected by the symbols @code{shr}, @code{gnus-w3m},
409@code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more 409@code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more
410information about emacs-w3m}, @code{links}, @code{lynx}, 410information about emacs-w3m}, @code{links}, @code{lynx},
411@code{w3m-standalone} or @code{html2text}. If @code{nil} use an 411@code{w3m-standalone} or @code{html2text}. If @code{nil} use an
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index a42dc6ed3c0..6209e02ebc5 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -72,21 +72,21 @@ local and the remote host, whereas @value{tramp} uses a combination of
72@command{ssh}/@command{scp}. 72@command{ssh}/@command{scp}.
73 73
74You can find the latest version of this document on the web at 74You can find the latest version of this document on the web at
75@uref{http://www.gnu.org/software/tramp/}. 75@uref{https://www.gnu.org/software/tramp/}.
76 76
77@ifhtml 77@ifhtml
78The latest release of @value{tramp} is available for 78The latest release of @value{tramp} is available for
79@uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see 79@uref{https://ftp.gnu.org/gnu/tramp/, download}, or you may see
80@ref{Obtaining Tramp} for more details, including the Git server 80@ref{Obtaining Tramp} for more details, including the Git server
81details. 81details.
82 82
83@value{tramp} also has a @uref{http://savannah.gnu.org/projects/tramp/, 83@value{tramp} also has a @uref{https://savannah.gnu.org/projects/tramp/,
84Savannah Project Page}. 84Savannah Project Page}.
85@end ifhtml 85@end ifhtml
86 86
87There is a mailing list for @value{tramp}, available at 87There is a mailing list for @value{tramp}, available at
88@email{tramp-devel@@gnu.org}, and archived at 88@email{tramp-devel@@gnu.org}, and archived at
89@uref{http://lists.gnu.org/archive/html/tramp-devel/, the 89@uref{https://lists.gnu.org/archive/html/tramp-devel/, the
90@value{tramp} Mail Archive}. 90@value{tramp} Mail Archive}.
91 91
92@page 92@page
@@ -321,7 +321,7 @@ behind the scenes when you open a file with @value{tramp}.
321@value{tramp} is included as part of Emacs (since Emacs version 22.1). 321@value{tramp} is included as part of Emacs (since Emacs version 22.1).
322 322
323@value{tramp} is also freely packaged for download on the Internet at 323@value{tramp} is also freely packaged for download on the Internet at
324@uref{ftp://ftp.gnu.org/gnu/tramp/}. 324@uref{https://ftp.gnu.org/gnu/tramp/}.
325 325
326@value{tramp} development versions are available on Git servers. 326@value{tramp} development versions are available on Git servers.
327Development versions contain new and incomplete features. 327Development versions contain new and incomplete features.
@@ -331,7 +331,7 @@ page at the following URL and then clicking on the Git link in the
331navigation bar at the top. 331navigation bar at the top.
332 332
333@noindent 333@noindent
334@uref{http://savannah.gnu.org/projects/tramp/} 334@uref{https://savannah.gnu.org/projects/tramp/}
335 335
336@noindent 336@noindent
337Another way is to follow the terminal session below: 337Another way is to follow the terminal session below:
@@ -349,7 +349,7 @@ From behind a firewall:
349@example 349@example
350@group 350@group
351] @strong{git config --global http.proxy http://user:pwd@@proxy.server.com:8080} 351] @strong{git config --global http.proxy http://user:pwd@@proxy.server.com:8080}
352] @strong{git clone http://git.savannah.gnu.org/r/tramp.git} 352] @strong{git clone https://git.savannah.gnu.org/r/tramp.git}
353@end group 353@end group
354@end example 354@end example
355 355
@@ -917,7 +917,7 @@ numbers are not applicable to Android devices connected through USB@.
917@cindex dbus 917@cindex dbus
918 918
919GVFS is the virtual file system for the Gnome Desktop, 919GVFS is the virtual file system for the Gnome Desktop,
920@uref{http://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are 920@uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are
921mounted locally through FUSE and @value{tramp} uses this locally 921mounted locally through FUSE and @value{tramp} uses this locally
922mounted directory internally. 922mounted directory internally.
923 923
@@ -1896,12 +1896,16 @@ where @samp{192.168.0.1} is the remote host IP address
1896@value{tramp} uses the @option{adb} method to access Android devices. 1896@value{tramp} uses the @option{adb} method to access Android devices.
1897Android devices provide a restricted shell access through an USB 1897Android devices provide a restricted shell access through an USB
1898connection. The local host must have the @command{adb} program 1898connection. The local host must have the @command{adb} program
1899installed. 1899installed. Usually, it is sufficient to open the file
1900@file{@trampfn{adb,,/}}. Then you can navigate in the filesystem via
1901@code{dired}.
1900 1902
1901Applications such as @code{SSHDroid} that run @command{sshd} process 1903Alternatively, applications such as @code{SSHDroid} that run
1902on the Android device can accept any @option{ssh}-based methods 1904@command{sshd} process on the Android device can accept any
1903provided these settings are adjusted: 1905@option{ssh}-based methods provided these settings are adjusted:
1904 1906
1907@itemize
1908@item
1905@command{sh} must be specified for remote shell since Android devices 1909@command{sh} must be specified for remote shell since Android devices
1906do not provide @command{/bin/sh}. @command{sh} will then invoke 1910do not provide @command{/bin/sh}. @command{sh} will then invoke
1907whatever shell is installed on the device with this setting: 1911whatever shell is installed on the device with this setting:
@@ -1917,6 +1921,7 @@ whatever shell is installed on the device with this setting:
1917where @samp{192.168.0.26} is the Android device's IP address. 1921where @samp{192.168.0.26} is the Android device's IP address.
1918(@pxref{Predefined connection information}). 1922(@pxref{Predefined connection information}).
1919 1923
1924@item
1920@value{tramp} requires preserving @env{PATH} environment variable from 1925@value{tramp} requires preserving @env{PATH} environment variable from
1921user settings. Android devices prefer @file{/system/xbin} path over 1926user settings. Android devices prefer @file{/system/xbin} path over
1922@file{/system/bin}. Both of these are set as follows: 1927@file{/system/bin}. Both of these are set as follows:
@@ -1928,7 +1933,7 @@ user settings. Android devices prefer @file{/system/xbin} path over
1928@end group 1933@end group
1929@end lisp 1934@end lisp
1930 1935
1931@noindent 1936@item
1932When the Android device is not @samp{rooted}, specify a writable 1937When the Android device is not @samp{rooted}, specify a writable
1933directory for temporary files: 1938directory for temporary files:
1934 1939
@@ -1936,7 +1941,7 @@ directory for temporary files:
1936(add-to-list 'tramp-remote-process-environment "TMPDIR=$HOME") 1941(add-to-list 'tramp-remote-process-environment "TMPDIR=$HOME")
1937@end lisp 1942@end lisp
1938 1943
1939@noindent 1944@item
1940Open a remote connection with the command @kbd{C-x C-f 1945Open a remote connection with the command @kbd{C-x C-f
1941@trampfn{ssh,192.168.0.26#2222,}}, where @command{sshd} is listening 1946@trampfn{ssh,192.168.0.26#2222,}}, where @command{sshd} is listening
1942on port @samp{2222}. 1947on port @samp{2222}.
@@ -1967,6 +1972,7 @@ the previous example, fix the connection properties as follows:
1967@noindent 1972@noindent
1968Open a remote connection with a more concise command @kbd{C-x C-f 1973Open a remote connection with a more concise command @kbd{C-x C-f
1969@trampfn{ssh,android,}}. 1974@trampfn{ssh,android,}}.
1975@end itemize
1970 1976
1971 1977
1972@node Auto-save and Backup 1978@node Auto-save and Backup
@@ -2083,7 +2089,7 @@ Pseudo-terminal will not be allocated because stdin is not a terminal.
2083 2089
2084Some older versions of Cygwin's @command{ssh} work with the 2090Some older versions of Cygwin's @command{ssh} work with the
2085@option{sshx} access method. Consult Cygwin's FAQ at 2091@option{sshx} access method. Consult Cygwin's FAQ at
2086@uref{http://cygwin.com/faq/} for details. 2092@uref{https://cygwin.com/faq/} for details.
2087 2093
2088@cindex Cygwin and fakecygpty 2094@cindex Cygwin and fakecygpty
2089@cindex fakecygpty and Cygwin 2095@cindex fakecygpty and Cygwin
@@ -2797,7 +2803,7 @@ this address go to all the subscribers. This is @emph{not} the
2797address to send subscription requests to. 2803address to send subscription requests to.
2798 2804
2799To subscribe to the mailing list, visit: 2805To subscribe to the mailing list, visit:
2800@uref{http://lists.gnu.org/mailman/listinfo/tramp-devel/, the 2806@uref{https://lists.gnu.org/mailman/listinfo/tramp-devel/, the
2801@value{tramp} Mail Subscription Page}. 2807@value{tramp} Mail Subscription Page}.
2802 2808
2803@ifset installchapter 2809@ifset installchapter
@@ -2849,13 +2855,13 @@ Where is the latest @value{tramp}?
2849@value{tramp} is available at the GNU URL: 2855@value{tramp} is available at the GNU URL:
2850 2856
2851@noindent 2857@noindent
2852@uref{ftp://ftp.gnu.org/gnu/tramp/} 2858@uref{https://ftp.gnu.org/gnu/tramp/}
2853 2859
2854@noindent 2860@noindent
2855@value{tramp}'s GNU project page is located here: 2861@value{tramp}'s GNU project page is located here:
2856 2862
2857@noindent 2863@noindent
2858@uref{http://savannah.gnu.org/projects/tramp/} 2864@uref{https://savannah.gnu.org/projects/tramp/}
2859 2865
2860 2866
2861@item 2867@item
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index f1cb60b9d25..05b577da005 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
8@c In the Tramp GIT, the version number is auto-frobbed from 8@c In the Tramp GIT, the version number is auto-frobbed from
9@c configure.ac, so you should edit that file and run 9@c configure.ac, so you should edit that file and run
10@c "autoconf && ./configure" to change the version number. 10@c "autoconf && ./configure" to change the version number.
11@set trampver 2.3.2-pre 11@set trampver 2.3.2
12 12
13@c Other flags from configuration 13@c Other flags from configuration
14@set instprefix /usr/local 14@set instprefix /usr/local
diff --git a/etc/NEWS b/etc/NEWS
index 78d374840aa..39c88c60e77 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -129,6 +129,22 @@ given file is on a case-insensitive filesystem.
129of curved quotes for 'electric-quote-mode', allowing user to choose 129of curved quotes for 'electric-quote-mode', allowing user to choose
130the types of quotes to be used. 130the types of quotes to be used.
131 131
132** The new user option 'electric-quote-context-sensitive' makes
133'electric-quote-mode' context sensitive. If it is non-nil, you can
134type an ASCII apostrophe to insert an opening or closing quote,
135depending on context. Emacs will replace the apostrophe by an opening
136quote character at the beginning of the buffer, the beginning of a
137line, after a whitespace character, and after an opening parenthesis;
138and it will replace the apostrophe by a closing quote character in all
139other cases.
140
141** The new variable 'electric-quote-code-faces' controls when to
142disable electric quoting in text modes. Major modes can add faces to
143this list; Emacs will temporarily disable 'electric-quote-mode'
144whenever point is before a character having such a face. This is
145intended for major modes that derive from 'text-mode' but allow inline
146code segments, such as 'markdown-mode'.
147
132+++ 148+++
133** The new user variable 'dired-omit-case-fold' allows the user to 149** The new user variable 'dired-omit-case-fold' allows the user to
134customize the case-sensitivity of dired-omit-mode. It defaults to 150customize the case-sensitivity of dired-omit-mode. It defaults to
@@ -320,6 +336,15 @@ questions, with a handy way to display help texts.
320all call stack frames in a Lisp backtrace buffer as lists. Both 336all call stack frames in a Lisp backtrace buffer as lists. Both
321debug.el and edebug.el have been updated to heed to this variable. 337debug.el and edebug.el have been updated to heed to this variable.
322 338
339---
340** Values in call stack frames are now displayed using 'cl-prin1'.
341The old behaviour of using 'prin1' can be restored by customizing the
342new option 'debugger-print-function'.
343
344+++
345** NUL bytes in strings copied to the system clipboard are now
346replaced with "\0".
347
323+++ 348+++
324** The new variable 'x-ctrl-keysym' has been added to the existing 349** The new variable 'x-ctrl-keysym' has been added to the existing
325roster of X keysyms. It can be used in combination with another 350roster of X keysyms. It can be used in combination with another
@@ -364,6 +389,9 @@ use the local Emacs to edit remote files via Tramp. See the node
364"emacsclient Options" in the user manual for the details. 389"emacsclient Options" in the user manual for the details.
365 390
366+++ 391+++
392** 'describe-key-briefly' now ignores mouse movement events.
393
394+++
367** The new variable 'eval-expression-print-maximum-character' prevents 395** The new variable 'eval-expression-print-maximum-character' prevents
368large integers from being displayed as characters. 396large integers from being displayed as characters.
369 397
@@ -471,6 +499,12 @@ properties as intact as possible.
471 499
472* Changes in Specialized Modes and Packages in Emacs 26.1 500* Changes in Specialized Modes and Packages in Emacs 26.1
473 501
502** Dired
503You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced
504by the current file name.
505
506*** html2text is now marked obsolete.
507
474*** smerge-refine-regions can refine regions in separate buffers 508*** smerge-refine-regions can refine regions in separate buffers
475 509
476*** Info menu and index completion uses substring completion by default. 510*** Info menu and index completion uses substring completion by default.
@@ -642,6 +676,13 @@ replaced by the real images asynchronously, which will also now
642respect width/height HTML specs (unless they specify widths/heights 676respect width/height HTML specs (unless they specify widths/heights
643bigger than the current window). 677bigger than the current window).
644 678
679---
680*** The 'w' command on links is now 'shr-maybe-probe-and-copy-url'.
681'shr-copy-url' now only copies the url at point; users who wish to
682avoid accidentally accessing remote links may rebind 'w' and 'u' in
683'eww-link-keymap' to it.
684
685
645** Ido 686** Ido
646 687
647*** The commands 'find-alternate-file-other-window', 688*** The commands 'find-alternate-file-other-window',
@@ -1203,7 +1244,7 @@ run.
1203frame's outer border. 1244frame's outer border.
1204 1245
1205+++ 1246+++
1206*** New frame parameters 1247*** New frame parameters and changed semantics for older ones
1207 1248
1208+++ 1249+++
1209**** 'z-group' positions a frame above or below all others. 1250**** 'z-group' positions a frame above or below all others.
@@ -1248,10 +1289,32 @@ focus via the mouse.
1248frame. 1289frame.
1249 1290
1250+++ 1291+++
1251*** The 'width' and 'height' frame parameters allow to specify pixel 1292**** 'width' and 'height' allow to specify pixel values and ratios now.
1252values now. 1293
1294+++
1295**** 'left' and 'top' allow to specify ratios now.
1296
1297+++
1298**** 'keep-ratio' preserves size and position of child frames when their
1299parent frame is resized.
1253 1300
1254+++ 1301+++
1302**** 'no-special-glyphs' suppresses display of truncation and
1303continuation glyphs in a frame.
1304
1305+++
1306**** 'auto-hide-function' and 'minibuffer-exit' handle auto hiding of
1307frames and exiting from minibuffer individually.
1308
1309+++
1310**** 'fit-frame-to-buffer-margins' and 'fit-frame-to-buffer-sizes'
1311handle fitting a frame to its buffer individually.
1312
1313+++
1314**** 'drag-internal-border', 'drag-with-header-line',
1315'drag-with-mode-line', 'snap-width', 'top-visible' and 'bottom-visible'
1316allow to drag and resize frames with the mouse.
1317
1255*** The new function 'frame-list-z-order' returns a list of all frames 1318*** The new function 'frame-list-z-order' returns a list of all frames
1256in Z (stacking) order. 1319in Z (stacking) order.
1257 1320
@@ -1310,6 +1373,10 @@ a new window when opening man pages when there's already one, use
1310its window gets deleted by 'delete-other-windows'. 1373its window gets deleted by 'delete-other-windows'.
1311 1374
1312+++ 1375+++
1376*** New window parameters 'mode-line-format' and 'header-line-format'
1377allow to override the buffer-local formats for this window.
1378
1379+++
1313*** New command 'window-swap-states' swaps the states of two live 1380*** New command 'window-swap-states' swaps the states of two live
1314windows. 1381windows.
1315 1382
@@ -1319,9 +1386,23 @@ windows.
1319window changed size when 'window-size-change-functions' are run. 1386window changed size when 'window-size-change-functions' are run.
1320 1387
1321+++ 1388+++
1389*** The new function 'window-lines-pixel-dimensions' returns the pixel
1390dimensions of a window's text lines.
1391
1392+++
1393*** The new function 'window-largest-empty-rectangle' returns the
1394dimensions of the largest rectangular area not occupying any text in a
1395window's body.
1396
1397+++
1322*** The semantics of 'mouse-autoselect-window' has changed slightly. 1398*** The semantics of 'mouse-autoselect-window' has changed slightly.
1323For details see the section "Mouse Window Auto-selection" in the Elisp 1399For details see the section "Mouse Window Auto-selection" in the Elisp
1324manual. 1400manual.
1401
1402---
1403** 'tcl-auto-fill-mode' is now declared obsolete. It's functionality
1404can be replicated simply by setting 'comment-auto-fill-only-comments'.
1405
1325 1406
1326* Changes in Emacs 26.1 on Non-Free Operating Systems 1407* Changes in Emacs 26.1 on Non-Free Operating Systems
1327 1408
@@ -1364,7 +1445,7 @@ This is in contrast to the default action on POSIX Systems, where it
1364causes the receiving process to terminate with a core dump if no 1445causes the receiving process to terminate with a core dump if no
1365debugger has been attached to it. 1446debugger has been attached to it.
1366 1447
1367** `set-mouse-position' and `set-mouse-absolute-pixel-position' work 1448** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work
1368on macOS. 1449on macOS.
1369 1450
1370 1451
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 51d181997b1..e77b7c94cca 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -20,21 +20,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 20
21#include <config.h> 21#include <config.h>
22#include <stddef.h> 22#include <stddef.h>
23#include <stdio.h>
24#include <stdlib.h> 23#include <stdlib.h>
25#include <string.h> 24#include <string.h>
26#include <ctype.h> 25#include <ctype.h>
27#include <assert.h> 26#include <assert.h>
28#include <getopt.h> 27#include <getopt.h>
29 28
29#include <flexmember.h>
30#include <min-max.h>
31#include <unlocked-io.h>
32
30/* The SunOS compiler doesn't have SEEK_END. */ 33/* The SunOS compiler doesn't have SEEK_END. */
31#ifndef SEEK_END 34#ifndef SEEK_END
32#define SEEK_END 2 35#define SEEK_END 2
33#endif 36#endif
34 37
35#include <flexmember.h>
36#include <min-max.h>
37
38/* Files are read in chunks of this number of bytes. */ 38/* Files are read in chunks of this number of bytes. */
39 39
40enum { READ_CHUNK_SIZE = 100 * 1024 }; 40enum { READ_CHUNK_SIZE = 100 * 1024 };
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 8828b7652de..f1d4e8976da 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -73,7 +73,6 @@ char *w32_getenv (const char *);
73 73
74#include <stdarg.h> 74#include <stdarg.h>
75#include <ctype.h> 75#include <ctype.h>
76#include <stdio.h>
77#include <stdlib.h> 76#include <stdlib.h>
78#include <string.h> 77#include <string.h>
79#include <getopt.h> 78#include <getopt.h>
@@ -84,6 +83,8 @@ char *w32_getenv (const char *);
84#include <signal.h> 83#include <signal.h>
85#include <errno.h> 84#include <errno.h>
86 85
86#include <unlocked-io.h>
87
87#ifndef VERSION 88#ifndef VERSION
88#define VERSION "unspecified" 89#define VERSION "unspecified"
89#endif 90#endif
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 6f280d8ab40..e5ff7bd10fc 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -123,6 +123,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
123#include <errno.h> 123#include <errno.h>
124#include <fcntl.h> 124#include <fcntl.h>
125#include <binary-io.h> 125#include <binary-io.h>
126#include <unlocked-io.h>
126#include <c-ctype.h> 127#include <c-ctype.h>
127#include <c-strcase.h> 128#include <c-strcase.h>
128 129
diff --git a/lib-src/hexl.c b/lib-src/hexl.c
index 319ce8bc890..d949af08902 100644
--- a/lib-src/hexl.c
+++ b/lib-src/hexl.c
@@ -22,11 +22,11 @@ along with this program. If not, see <http://www.gnu.org/licenses/>. */
22#include <config.h> 22#include <config.h>
23 23
24#include <inttypes.h> 24#include <inttypes.h>
25#include <stdio.h>
26#include <stdlib.h> 25#include <stdlib.h>
27#include <string.h> 26#include <string.h>
28 27
29#include <binary-io.h> 28#include <binary-io.h>
29#include <unlocked-io.h>
30 30
31static char *progname; 31static char *progname;
32 32
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 9470bd635f5..6b2cc110403 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -39,10 +39,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
39#include <stdarg.h> 39#include <stdarg.h>
40#include <stddef.h> 40#include <stddef.h>
41#include <stdint.h> 41#include <stdint.h>
42#include <stdio.h>
43#include <stdlib.h> 42#include <stdlib.h>
44#include <string.h> 43#include <string.h>
45 44
45#include <binary-io.h>
46#include <intprops.h>
47#include <min-max.h>
48#include <unlocked-io.h>
49
46#ifdef WINDOWSNT 50#ifdef WINDOWSNT
47/* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this 51/* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this
48 is really just insurance. */ 52 is really just insurance. */
@@ -50,10 +54,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
50#include <direct.h> 54#include <direct.h>
51#endif /* WINDOWSNT */ 55#endif /* WINDOWSNT */
52 56
53#include <binary-io.h>
54#include <intprops.h>
55#include <min-max.h>
56
57#ifdef DOS_NT 57#ifdef DOS_NT
58/* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this 58/* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this
59 is really just insurance. 59 is really just insurance.
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index cd12c48ed36..e5ca0b16611 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -59,7 +59,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
59#include <sys/types.h> 59#include <sys/types.h>
60#include <sys/stat.h> 60#include <sys/stat.h>
61#include <sys/file.h> 61#include <sys/file.h>
62#include <stdio.h>
63#include <stdlib.h> 62#include <stdlib.h>
64#include <errno.h> 63#include <errno.h>
65#include <time.h> 64#include <time.h>
@@ -69,6 +68,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
69#include <fcntl.h> 68#include <fcntl.h>
70#include <signal.h> 69#include <signal.h>
71#include <string.h> 70#include <string.h>
71
72#include <unlocked-io.h>
73
72#include "syswait.h" 74#include "syswait.h"
73#ifdef MAIL_USE_POP 75#ifdef MAIL_USE_POP
74#include "pop.h" 76#include "pop.h"
diff --git a/lib-src/profile.c b/lib-src/profile.c
index 253f00e2d80..f4ab45c1718 100644
--- a/lib-src/profile.c
+++ b/lib-src/profile.c
@@ -34,11 +34,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
34#include <config.h> 34#include <config.h>
35 35
36#include <inttypes.h> 36#include <inttypes.h>
37#include <stdio.h>
38#include <stdlib.h> 37#include <stdlib.h>
39 38
40#include <intprops.h> 39#include <intprops.h>
41#include <systime.h> 40#include <systime.h>
41#include <unlocked-io.h>
42 42
43static struct timespec TV1; 43static struct timespec TV1;
44static int watch_not_started = 1; /* flag */ 44static int watch_not_started = 1; /* flag */
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c
index 5edc8e79569..942aeeb399d 100644
--- a/lib-src/update-game-score.c
+++ b/lib-src/update-game-score.c
@@ -39,7 +39,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
39#include <limits.h> 39#include <limits.h>
40#include <string.h> 40#include <string.h>
41#include <stdlib.h> 41#include <stdlib.h>
42#include <stdio.h>
43#include <time.h> 42#include <time.h>
44#include <pwd.h> 43#include <pwd.h>
45#include <ctype.h> 44#include <ctype.h>
@@ -47,6 +46,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
47#include <sys/stat.h> 46#include <sys/stat.h>
48#include <getopt.h> 47#include <getopt.h>
49 48
49#include <unlocked-io.h>
50
50#ifdef WINDOWSNT 51#ifdef WINDOWSNT
51#include "ntlib.h" 52#include "ntlib.h"
52#endif 53#endif
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 509089e6391..fd0f9e5c780 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -21,7 +21,7 @@
21# the same distribution terms as the rest of that program. 21# the same distribution terms as the rest of that program.
22# 22#
23# Generated by gnulib-tool. 23# Generated by gnulib-tool.
24# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright utimens vla warnings 24# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings
25 25
26 26
27MOSTLYCLEANFILES += core *.stackdump 27MOSTLYCLEANFILES += core *.stackdump
@@ -2996,6 +2996,15 @@ EXTRA_DIST += unistd.in.h
2996endif 2996endif
2997## end gnulib module unistd 2997## end gnulib module unistd
2998 2998
2999## begin gnulib module unlocked-io
3000ifeq (,$(OMIT_GNULIB_MODULE_unlocked-io))
3001
3002
3003EXTRA_DIST += unlocked-io.h
3004
3005endif
3006## end gnulib module unlocked-io
3007
2999## begin gnulib module update-copyright 3008## begin gnulib module update-copyright
3000ifeq (,$(OMIT_GNULIB_MODULE_update-copyright)) 3009ifeq (,$(OMIT_GNULIB_MODULE_update-copyright))
3001 3010
diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h
new file mode 100644
index 00000000000..aaf60a0fb4e
--- /dev/null
+++ b/lib/unlocked-io.h
@@ -0,0 +1,136 @@
1/* Prefer faster, non-thread-safe stdio functions if available.
2
3 Copyright (C) 2001-2004, 2009-2017 Free Software Foundation, Inc.
4
5 This program is free software: you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 3 of the License, or
8 (at your option) any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program. If not, see <http://www.gnu.org/licenses/>. */
17
18/* Written by Jim Meyering. */
19
20#ifndef UNLOCKED_IO_H
21# define UNLOCKED_IO_H 1
22
23/* These are wrappers for functions/macros from the GNU C library, and
24 from other C libraries supporting POSIX's optional thread-safe functions.
25
26 The standard I/O functions are thread-safe. These *_unlocked ones are
27 more efficient but not thread-safe. That they're not thread-safe is
28 fine since all of the applications in this package are single threaded.
29
30 Also, some code that is shared with the GNU C library may invoke
31 the *_unlocked functions directly. On hosts that lack those
32 functions, invoke the non-thread-safe versions instead. */
33
34# include <stdio.h>
35
36# if HAVE_DECL_CLEARERR_UNLOCKED
37# undef clearerr
38# define clearerr(x) clearerr_unlocked (x)
39# else
40# define clearerr_unlocked(x) clearerr (x)
41# endif
42
43# if HAVE_DECL_FEOF_UNLOCKED
44# undef feof
45# define feof(x) feof_unlocked (x)
46# else
47# define feof_unlocked(x) feof (x)
48# endif
49
50# if HAVE_DECL_FERROR_UNLOCKED
51# undef ferror
52# define ferror(x) ferror_unlocked (x)
53# else
54# define ferror_unlocked(x) ferror (x)
55# endif
56
57# if HAVE_DECL_FFLUSH_UNLOCKED
58# undef fflush
59# define fflush(x) fflush_unlocked (x)
60# else
61# define fflush_unlocked(x) fflush (x)
62# endif
63
64# if HAVE_DECL_FGETS_UNLOCKED
65# undef fgets
66# define fgets(x,y,z) fgets_unlocked (x,y,z)
67# else
68# define fgets_unlocked(x,y,z) fgets (x,y,z)
69# endif
70
71# if HAVE_DECL_FPUTC_UNLOCKED
72# undef fputc
73# define fputc(x,y) fputc_unlocked (x,y)
74# else
75# define fputc_unlocked(x,y) fputc (x,y)
76# endif
77
78# if HAVE_DECL_FPUTS_UNLOCKED
79# undef fputs
80# define fputs(x,y) fputs_unlocked (x,y)
81# else
82# define fputs_unlocked(x,y) fputs (x,y)
83# endif
84
85# if HAVE_DECL_FREAD_UNLOCKED
86# undef fread
87# define fread(w,x,y,z) fread_unlocked (w,x,y,z)
88# else
89# define fread_unlocked(w,x,y,z) fread (w,x,y,z)
90# endif
91
92# if HAVE_DECL_FWRITE_UNLOCKED
93# undef fwrite
94# define fwrite(w,x,y,z) fwrite_unlocked (w,x,y,z)
95# else
96# define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z)
97# endif
98
99# if HAVE_DECL_GETC_UNLOCKED
100# undef getc
101# define getc(x) getc_unlocked (x)
102# else
103# define getc_unlocked(x) getc (x)
104# endif
105
106# if HAVE_DECL_GETCHAR_UNLOCKED
107# undef getchar
108# define getchar() getchar_unlocked ()
109# else
110# define getchar_unlocked() getchar ()
111# endif
112
113# if HAVE_DECL_PUTC_UNLOCKED
114# undef putc
115# define putc(x,y) putc_unlocked (x,y)
116# else
117# define putc_unlocked(x,y) putc (x,y)
118# endif
119
120# if HAVE_DECL_PUTCHAR_UNLOCKED
121# undef putchar
122# define putchar(x) putchar_unlocked (x)
123# else
124# define putchar_unlocked(x) putchar (x)
125# endif
126
127# undef flockfile
128# define flockfile(x) ((void) 0)
129
130# undef ftrylockfile
131# define ftrylockfile(x) 0
132
133# undef funlockfile
134# define funlockfile(x) ((void) 0)
135
136#endif /* UNLOCKED_IO_H */
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 79291624523..a15386aa1af 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -319,10 +319,12 @@ the list of old buffers.")
319(defvar auto-revert-tail-pos 0 319(defvar auto-revert-tail-pos 0
320 "Position of last known end of file.") 320 "Position of last known end of file.")
321 321
322(defun auto-revert-find-file-function ()
323 (setq-local auto-revert-tail-pos
324 (nth 7 (file-attributes buffer-file-name))))
325
322(add-hook 'find-file-hook 326(add-hook 'find-file-hook
323 (lambda () 327 #'auto-revert-find-file-function)
324 (setq-local auto-revert-tail-pos
325 (nth 7 (file-attributes buffer-file-name)))))
326 328
327(defvar auto-revert-notify-watch-descriptor-hash-list 329(defvar auto-revert-notify-watch-descriptor-hash-list
328 (make-hash-table :test 'equal) 330 (make-hash-table :test 'equal)
@@ -341,6 +343,11 @@ This has been reported by a file notification event.")
341 343
342;; Functions: 344;; Functions:
343 345
346(defun auto-revert-remove-current-buffer ()
347 "Remove dead buffer from `auto-revert-buffer-list'."
348 (setq auto-revert-buffer-list
349 (delq (current-buffer) auto-revert-buffer-list)))
350
344;;;###autoload 351;;;###autoload
345(define-minor-mode auto-revert-mode 352(define-minor-mode auto-revert-mode
346 "Toggle reverting buffer when the file changes (Auto-Revert Mode). 353 "Toggle reverting buffer when the file changes (Auto-Revert Mode).
@@ -364,13 +371,10 @@ without being changed in the part that is already in the buffer."
364 (push (current-buffer) auto-revert-buffer-list) 371 (push (current-buffer) auto-revert-buffer-list)
365 (add-hook 372 (add-hook
366 'kill-buffer-hook 373 'kill-buffer-hook
367 (lambda () 374 #'auto-revert-remove-current-buffer
368 (setq auto-revert-buffer-list
369 (delq (current-buffer) auto-revert-buffer-list)))
370 nil t)) 375 nil t))
371 (when auto-revert-use-notify (auto-revert-notify-rm-watch)) 376 (when auto-revert-use-notify (auto-revert-notify-rm-watch))
372 (setq auto-revert-buffer-list 377 (auto-revert-remove-current-buffer))
373 (delq (current-buffer) auto-revert-buffer-list)))
374 (auto-revert-set-timer) 378 (auto-revert-set-timer)
375 (when auto-revert-mode 379 (when auto-revert-mode
376 (auto-revert-buffers) 380 (auto-revert-buffers)
@@ -786,24 +790,24 @@ the timer when no buffers need to be checked."
786 (not (and auto-revert-stop-on-user-input 790 (not (and auto-revert-stop-on-user-input
787 (input-pending-p)))) 791 (input-pending-p))))
788 (let ((buf (car bufs))) 792 (let ((buf (car bufs)))
789 (if (buffer-live-p buf) 793 (with-current-buffer buf
790 (with-current-buffer buf 794 (if (buffer-live-p buf)
791 ;; Test if someone has turned off Auto-Revert Mode in a 795 (progn
792 ;; non-standard way, for example by changing major mode. 796 ;; Test if someone has turned off Auto-Revert Mode
793 (if (and (not auto-revert-mode) 797 ;; in a non-standard way, for example by changing
794 (not auto-revert-tail-mode) 798 ;; major mode.
795 (memq buf auto-revert-buffer-list)) 799 (if (and (not auto-revert-mode)
796 (setq auto-revert-buffer-list 800 (not auto-revert-tail-mode)
797 (delq buf auto-revert-buffer-list))) 801 (memq buf auto-revert-buffer-list))
798 (when (auto-revert-active-p) 802 (auto-revert-remove-current-buffer))
799 ;; Enable file notification. 803 (when (auto-revert-active-p)
800 (when (and auto-revert-use-notify 804 ;; Enable file notification.
801 (not auto-revert-notify-watch-descriptor)) 805 (when (and auto-revert-use-notify
802 (auto-revert-notify-add-watch)) 806 (not auto-revert-notify-watch-descriptor))
803 (auto-revert-handler))) 807 (auto-revert-notify-add-watch))
804 ;; Remove dead buffer from `auto-revert-buffer-list'. 808 (auto-revert-handler)))
805 (setq auto-revert-buffer-list 809 ;; Remove dead buffer from `auto-revert-buffer-list'.
806 (delq buf auto-revert-buffer-list)))) 810 (auto-revert-remove-current-buffer))))
807 (setq bufs (cdr bufs))) 811 (setq bufs (cdr bufs)))
808 (setq auto-revert-remaining-buffers bufs) 812 (setq auto-revert-remaining-buffers bufs)
809 ;; Check if we should cancel the timer. 813 ;; Check if we should cancel the timer.
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 0e3715eb4cf..a8074eaeb20 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -825,21 +825,18 @@ If COMP or STD is non-nil, put that in the units table instead."
825 (forward-char -1)) 825 (forward-char -1))
826 (insert ";;; Custom units stored by Calc on " (current-time-string) "\n") 826 (insert ";;; Custom units stored by Calc on " (current-time-string) "\n")
827 (if math-additional-units 827 (if math-additional-units
828 (progn 828 (let (expr)
829 (insert "(setq math-additional-units '(\n") 829 (insert "(setq math-additional-units '(\n")
830 (let ((list math-additional-units)) 830 (dolist (u math-additional-units)
831 (while list 831 (insert " (" (symbol-name (car u)) " "
832 (insert " (" (symbol-name (car (car list))) " " 832 (if (setq expr (nth 1 u))
833 (if (nth 1 (car list)) 833 (if (stringp expr)
834 (if (stringp (nth 1 (car list))) 834 (prin1-to-string expr)
835 (prin1-to-string (nth 1 (car list))) 835 (prin1-to-string (math-format-flat-expr expr 0)))
836 (prin1-to-string (math-format-flat-expr 836 "nil")
837 (nth 1 (car list)) 0))) 837 " "
838 "nil") 838 (prin1-to-string (nth 2 u))
839 " " 839 ")\n"))
840 (prin1-to-string (nth 2 (car list)))
841 ")\n")
842 (setq list (cdr list))))
843 (insert "))\n")) 840 (insert "))\n"))
844 (insert ";;; (no custom units defined)\n")) 841 (insert ";;; (no custom units defined)\n"))
845 (insert ";;; End of custom units\n") 842 (insert ";;; End of custom units\n")
@@ -916,15 +913,13 @@ If COMP or STD is non-nil, put that in the units table instead."
916(defun math-find-base-units-rec (expr pow) 913(defun math-find-base-units-rec (expr pow)
917 (let ((u (math-check-unit-name expr))) 914 (let ((u (math-check-unit-name expr)))
918 (cond (u 915 (cond (u
919 (let ((ulist (math-find-base-units u))) 916 (dolist (x (math-find-base-units u))
920 (while ulist 917 (let ((p (* (cdr x) pow))
921 (let ((p (* (cdr (car ulist)) pow)) 918 (old (assq (car x) math-fbu-base)))
922 (old (assq (car (car ulist)) math-fbu-base))) 919 (if old
923 (if old 920 (setcdr old (+ (cdr old) p))
924 (setcdr old (+ (cdr old) p)) 921 (setq math-fbu-base
925 (setq math-fbu-base 922 (cons (cons (car x) p) math-fbu-base))))))
926 (cons (cons (car (car ulist)) p) math-fbu-base))))
927 (setq ulist (cdr ulist)))))
928 ((math-scalarp expr)) 923 ((math-scalarp expr))
929 ((and (eq (car expr) '^) 924 ((and (eq (car expr) '^)
930 (integerp (nth 2 expr))) 925 (integerp (nth 2 expr)))
@@ -1377,20 +1372,15 @@ If COMP or STD is non-nil, put that in the units table instead."
1377 (if (eq pow1 1) 1372 (if (eq pow1 1)
1378 (math-to-standard-units (list '/ n d) nil) 1373 (math-to-standard-units (list '/ n d) nil)
1379 (list '^ (math-to-standard-units (list '/ n d) nil) pow1)) 1374 (list '^ (math-to-standard-units (list '/ n d) nil) pow1))
1380 (let (ud1) 1375 (setq un (nth 4 un)
1381 (setq un (nth 4 un) 1376 ud (nth 4 ud))
1382 ud (nth 4 ud)) 1377 (dolist (x un)
1383 (while un 1378 (dolist (y ud)
1384 (setq ud1 ud) 1379 (when (eq (car x) (car y))
1385 (while ud1 1380 (setq math-try-cancel-units
1386 (and (eq (car (car un)) (car (car ud1))) 1381 (+ math-try-cancel-units
1387 (setq math-try-cancel-units 1382 (- (* (cdr x) pow1)
1388 (+ math-try-cancel-units 1383 (* (cdr (car ud)) pow2))))))))))))
1389 (- (* (cdr (car un)) pow1)
1390 (* (cdr (car ud)) pow2)))))
1391 (setq ud1 (cdr ud1)))
1392 (setq un (cdr un)))
1393 nil))))))
1394 1384
1395(math-defsimplify ^ 1385(math-defsimplify ^
1396 (and math-simplifying-units 1386 (and math-simplifying-units
@@ -1578,9 +1568,8 @@ If COMP or STD is non-nil, put that in the units table instead."
1578 (insert "Calculator Units Table:\n\n") 1568 (insert "Calculator Units Table:\n\n")
1579 (insert "(All definitions are exact unless marked with an asterisk (*).)\n\n") 1569 (insert "(All definitions are exact unless marked with an asterisk (*).)\n\n")
1580 (insert "Unit Type Definition Description\n\n") 1570 (insert "Unit Type Definition Description\n\n")
1581 (while uptr 1571 (dolist (u uptr)
1582 (setq u (car uptr) 1572 (setq name (nth 2 u))
1583 name (nth 2 u))
1584 (when (eq (car u) 'm) 1573 (when (eq (car u) 'm)
1585 (setq std t)) 1574 (setq std t))
1586 (setq shadowed (and std (assq (car u) math-additional-units))) 1575 (setq shadowed (and std (assq (car u) math-additional-units)))
@@ -1618,8 +1607,7 @@ If COMP or STD is non-nil, put that in the units table instead."
1618 (insert " (redefined above)") 1607 (insert " (redefined above)")
1619 (unless (nth 1 u) 1608 (unless (nth 1 u)
1620 (insert " (base unit)"))) 1609 (insert " (base unit)")))
1621 (insert "\n") 1610 (insert "\n"))
1622 (setq uptr (cdr uptr)))
1623 (insert "\n\nUnit Prefix Table:\n\n") 1611 (insert "\n\nUnit Prefix Table:\n\n")
1624 (setq uptr math-unit-prefixes) 1612 (setq uptr math-unit-prefixes)
1625 (while uptr 1613 (while uptr
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 6a6a8ea4479..6f36bbed680 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -413,12 +413,11 @@ relevant to POS."
413 (multibyte-p enable-multibyte-characters) 413 (multibyte-p enable-multibyte-characters)
414 (overlays (mapcar (lambda (o) (overlay-properties o)) 414 (overlays (mapcar (lambda (o) (overlay-properties o))
415 (overlays-at pos))) 415 (overlays-at pos)))
416 (char-description (if (not multibyte-p) 416 (char-description (if (< char 128)
417 (single-key-description char) 417 (single-key-description char)
418 (if (< char 128) 418 (string (if (not multibyte-p)
419 (single-key-description char) 419 (decode-char 'eight-bit char)
420 (string-to-multibyte 420 char))))
421 (char-to-string char)))))
422 (text-props-desc 421 (text-props-desc
423 (let ((tmp-buf (generate-new-buffer " *text-props*"))) 422 (let ((tmp-buf (generate-new-buffer " *text-props*")))
424 (unwind-protect 423 (unwind-protect
@@ -635,7 +634,9 @@ relevant to POS."
635 ("buffer code" 634 ("buffer code"
636 ,(if multibyte-p 635 ,(if multibyte-p
637 (encoded-string-description 636 (encoded-string-description
638 (string-as-unibyte (char-to-string char)) nil) 637 (encode-coding-string (char-to-string char)
638 'emacs-internal)
639 nil)
639 (format "#x%02X" char))) 640 (format "#x%02X" char)))
640 ("file code" 641 ("file code"
641 ,@(if multibyte-p 642 ,@(if multibyte-p
@@ -704,7 +705,6 @@ relevant to POS."
704 (called-interactively-p 'interactive)) 705 (called-interactively-p 'interactive))
705 (with-help-window (help-buffer) 706 (with-help-window (help-buffer)
706 (with-current-buffer standard-output 707 (with-current-buffer standard-output
707 (set-buffer-multibyte multibyte-p)
708 (let ((formatter (format "%%%ds:" max-width))) 708 (let ((formatter (format "%%%ds:" max-width)))
709 (dolist (elt item-list) 709 (dolist (elt item-list)
710 (when (cadr elt) 710 (when (cadr elt)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index ec07f9bf735..12a97f8457e 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -51,6 +51,33 @@ into this list; they also should call `dired-log' to log the errors.")
51 51
52(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)") 52(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
53(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)") 53(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
54(make-obsolete-variable 'dired-star-subst-regexp nil "26.1")
55(make-obsolete-variable 'dired-quark-subst-regexp nil "26.1")
56
57(defun dired-isolated-string-re (string)
58 "Return a regexp to match STRING isolated.
59Isolated means that STRING is surrounded by spaces or at the beginning/end
60of a string followed/prefixed with an space.
61The regexp capture the preceding blank, STRING and the following blank as
62the groups 1, 2 and 3 respectively."
63 (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
64
65(defun dired--star-or-qmark-p (string match &optional keep)
66 "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
67MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter
68means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
69If optional arg KEEP is non-nil, then preserve the match data. Otherwise,
70this function changes it and saves MATCH as the second match group.
71
72Isolated means that MATCH is surrounded by spaces or at the beginning/end
73of STRING followed/prefixed with an space. A match to `\\=`?\\=`',
74isolated or not, is also valid."
75 (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))))
76 (when (or (null match) (equal match "?"))
77 (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
78 (cl-some (lambda (x)
79 (funcall (if keep #'string-match-p #'string-match) x string))
80 regexps)))
54 81
55;;;###autoload 82;;;###autoload
56(defun dired-diff (file &optional switches) 83(defun dired-diff (file &optional switches)
@@ -308,7 +335,7 @@ List has a form of (file-name full-file-name (attribute-list))."
308 failures) 335 failures)
309 (setq failures 336 (setq failures
310 (dired-bunch-files 10000 337 (dired-bunch-files 10000
311 (function dired-check-process) 338 #'dired-check-process
312 (append 339 (append
313 (list operation program) 340 (list operation program)
314 (unless (or (string-equal new-attribute "") 341 (unless (or (string-equal new-attribute "")
@@ -512,7 +539,7 @@ with a prefix argument."
512 ;; If the file has numeric backup versions, 539 ;; If the file has numeric backup versions,
513 ;; put on dired-file-version-alist an element of the form 540 ;; put on dired-file-version-alist an element of the form
514 ;; (FILENAME . VERSION-NUMBER-LIST) 541 ;; (FILENAME . VERSION-NUMBER-LIST)
515 (dired-map-dired-file-lines (function dired-collect-file-versions)) 542 (dired-map-dired-file-lines #'dired-collect-file-versions)
516 ;; Sort each VERSION-NUMBER-LIST, 543 ;; Sort each VERSION-NUMBER-LIST,
517 ;; and remove the versions not to be deleted. 544 ;; and remove the versions not to be deleted.
518 (let ((fval dired-file-version-alist)) 545 (let ((fval dired-file-version-alist))
@@ -528,7 +555,7 @@ with a prefix argument."
528 (setq fval (cdr fval)))) 555 (setq fval (cdr fval))))
529 ;; Look at each file. If it is a numeric backup file, 556 ;; Look at each file. If it is a numeric backup file,
530 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion. 557 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
531 (dired-map-dired-file-lines (function dired-trample-file-versions)) 558 (dired-map-dired-file-lines #'dired-trample-file-versions)
532 (message "Cleaning numerical backups...done"))) 559 (message "Cleaning numerical backups...done")))
533 560
534;;; Subroutines of dired-clean-directory. 561;;; Subroutines of dired-clean-directory.
@@ -658,13 +685,13 @@ If there is a `*' in COMMAND, surrounded by whitespace, this runs
658COMMAND just once with the entire file list substituted there. 685COMMAND just once with the entire file list substituted there.
659 686
660If there is no `*', but there is a `?' in COMMAND, surrounded by 687If there is no `*', but there is a `?' in COMMAND, surrounded by
661whitespace, this runs COMMAND on each file individually with the 688whitespace, or a `\\=`?\\=`' this runs COMMAND on each file
662file name substituted for `?'. 689individually with the file name substituted for `?' or `\\=`?\\=`'.
663 690
664Otherwise, this runs COMMAND on each file individually with the 691Otherwise, this runs COMMAND on each file individually with the
665file name added at the end of COMMAND (separated by a space). 692file name added at the end of COMMAND (separated by a space).
666 693
667`*' and `?' when not surrounded by whitespace have no special 694`*' and `?' when not surrounded by whitespace nor `\\=`' have no special
668significance for `dired-do-shell-command', and are passed through 695significance for `dired-do-shell-command', and are passed through
669normally to the shell, but you must confirm first. 696normally to the shell, but you must confirm first.
670 697
@@ -704,32 +731,40 @@ can be produced by `dired-get-marked-files', for example."
704 (dired-read-shell-command "! on %s: " current-prefix-arg files) 731 (dired-read-shell-command "! on %s: " current-prefix-arg files)
705 current-prefix-arg 732 current-prefix-arg
706 files))) 733 files)))
707 (let* ((on-each (not (string-match-p dired-star-subst-regexp command))) 734 (cl-flet ((need-confirm-p
708 (no-subst (not (string-match-p dired-quark-subst-regexp command))) 735 (cmd str)
709 (star (string-match-p "\\*" command)) 736 (let ((res cmd)
710 (qmark (string-match-p "\\?" command))) 737 (regexp (regexp-quote str)))
711 ;; Get confirmation for wildcards that may have been meant 738 ;; Drop all ? and * surrounded by spaces and `?`.
712 ;; to control substitution of a file name or the file name list. 739 (while (and (string-match regexp res)
713 (if (cond ((not (or on-each no-subst)) 740 (dired--star-or-qmark-p res str))
714 (error "You can not combine `*' and `?' substitution marks")) 741 (setq res (replace-match "" t t res 0)))
715 ((and star on-each) 742 (string-match regexp res))))
716 (y-or-n-p (format-message 743 (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
717 "Confirm--do you mean to use `*' as a wildcard? "))) 744 (no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
718 ((and qmark no-subst) 745 (star (string-match "\\*" command))
719 (y-or-n-p (format-message 746 (qmark (string-match "\\?" command))
720 "Confirm--do you mean to use `?' as a wildcard? "))) 747 ;; Get confirmation for wildcards that may have been meant
721 (t)) 748 ;; to control substitution of a file name or the file name list.
722 (if on-each 749 (ok (cond ((not (or on-each no-subst))
723 (dired-bunch-files 750 (error "You can not combine `*' and `?' substitution marks"))
724 (- 10000 (length command)) 751 ((need-confirm-p command "*")
725 (function (lambda (&rest files) 752 (y-or-n-p (format-message
726 (dired-run-shell-command 753 "Confirm--do you mean to use `*' as a wildcard? ")))
727 (dired-shell-stuff-it command files t arg)))) 754 ((need-confirm-p command "?")
728 nil 755 (y-or-n-p (format-message
729 file-list) 756 "Confirm--do you mean to use `?' as a wildcard? ")))
730 ;; execute the shell command 757 (t))))
731 (dired-run-shell-command 758 (when ok
732 (dired-shell-stuff-it command file-list nil arg)))))) 759 (if on-each
760 (dired-bunch-files (- 10000 (length command))
761 (lambda (&rest files)
762 (dired-run-shell-command
763 (dired-shell-stuff-it command files t arg)))
764 nil file-list)
765 ;; execute the shell command
766 (dired-run-shell-command
767 (dired-shell-stuff-it command file-list nil arg)))))))
733 768
734;; Might use {,} for bash or csh: 769;; Might use {,} for bash or csh:
735(defvar dired-mark-prefix "" 770(defvar dired-mark-prefix ""
@@ -769,12 +804,10 @@ can be produced by `dired-get-marked-files', for example."
769 ";" 804 ";"
770 "&")) 805 "&"))
771 (stuff-it 806 (stuff-it
772 (if (or (string-match-p dired-star-subst-regexp command) 807 (if (dired--star-or-qmark-p command nil 'keep)
773 (string-match-p dired-quark-subst-regexp command))
774 (lambda (x) 808 (lambda (x)
775 (let ((retval (concat cmd-prefix command))) 809 (let ((retval (concat cmd-prefix command)))
776 (while (string-match 810 (while (dired--star-or-qmark-p retval nil)
777 "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
778 (setq retval (replace-match x t t retval 2))) 811 (setq retval (replace-match x t t retval 2)))
779 retval)) 812 retval))
780 (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) 813 (lambda (x) (concat cmd-prefix command dired-mark-separator x)))))
@@ -1122,7 +1155,7 @@ Return nil if no change in files."
1122 (let ((files (dired-get-marked-files t arg nil t)) 1155 (let ((files (dired-get-marked-files t arg nil t))
1123 (string (if (eq op-symbol 'compress) "Compress or uncompress" 1156 (string (if (eq op-symbol 'compress) "Compress or uncompress"
1124 (capitalize (symbol-name op-symbol))))) 1157 (capitalize (symbol-name op-symbol)))))
1125 (dired-mark-pop-up nil op-symbol files (function y-or-n-p) 1158 (dired-mark-pop-up nil op-symbol files #'y-or-n-p
1126 (concat string " " 1159 (concat string " "
1127 (dired-mark-prompt arg files) "? "))))) 1160 (dired-mark-prompt arg files) "? ")))))
1128 1161
@@ -1190,7 +1223,7 @@ return t; if SYM is q or ESC, return nil."
1190(defun dired-do-compress (&optional arg) 1223(defun dired-do-compress (&optional arg)
1191 "Compress or uncompress marked (or next ARG) files." 1224 "Compress or uncompress marked (or next ARG) files."
1192 (interactive "P") 1225 (interactive "P")
1193 (dired-map-over-marks-check (function dired-compress) arg 'compress t)) 1226 (dired-map-over-marks-check #'dired-compress arg 'compress t))
1194 1227
1195;; Commands for Emacs Lisp files - load and byte compile 1228;; Commands for Emacs Lisp files - load and byte compile
1196 1229
@@ -1218,7 +1251,7 @@ return t; if SYM is q or ESC, return nil."
1218(defun dired-do-byte-compile (&optional arg) 1251(defun dired-do-byte-compile (&optional arg)
1219 "Byte compile marked (or next ARG) Emacs Lisp files." 1252 "Byte compile marked (or next ARG) Emacs Lisp files."
1220 (interactive "P") 1253 (interactive "P")
1221 (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t)) 1254 (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t))
1222 1255
1223(defun dired-load () 1256(defun dired-load ()
1224 ;; Return nil for success, offending file name else. 1257 ;; Return nil for success, offending file name else.
@@ -1235,7 +1268,7 @@ return t; if SYM is q or ESC, return nil."
1235(defun dired-do-load (&optional arg) 1268(defun dired-do-load (&optional arg)
1236 "Load the marked (or next ARG) Emacs Lisp files." 1269 "Load the marked (or next ARG) Emacs Lisp files."
1237 (interactive "P") 1270 (interactive "P")
1238 (dired-map-over-marks-check (function dired-load) arg 'load t)) 1271 (dired-map-over-marks-check #'dired-load arg 'load t))
1239 1272
1240;;;###autoload 1273;;;###autoload
1241(defun dired-do-redisplay (&optional arg test-for-subdir) 1274(defun dired-do-redisplay (&optional arg test-for-subdir)
@@ -1308,7 +1341,7 @@ See Info node `(emacs)Subdir switches' for more details."
1308(defun dired-add-file (filename &optional marker-char) 1341(defun dired-add-file (filename &optional marker-char)
1309 (dired-fun-in-all-buffers 1342 (dired-fun-in-all-buffers
1310 (file-name-directory filename) (file-name-nondirectory filename) 1343 (file-name-directory filename) (file-name-nondirectory filename)
1311 (function dired-add-entry) filename marker-char)) 1344 #'dired-add-entry filename marker-char))
1312 1345
1313(defvar dired-omit-mode) 1346(defvar dired-omit-mode)
1314(declare-function dired-omit-regexp "dired-x" ()) 1347(declare-function dired-omit-regexp "dired-x" ())
@@ -1445,7 +1478,7 @@ files matching `dired-omit-regexp'."
1445(defun dired-remove-file (file) 1478(defun dired-remove-file (file)
1446 (dired-fun-in-all-buffers 1479 (dired-fun-in-all-buffers
1447 (file-name-directory file) (file-name-nondirectory file) 1480 (file-name-directory file) (file-name-nondirectory file)
1448 (function dired-remove-entry) file)) 1481 #'dired-remove-entry file))
1449 1482
1450(defun dired-remove-entry (file) 1483(defun dired-remove-entry (file)
1451 (save-excursion 1484 (save-excursion
@@ -1459,7 +1492,7 @@ files matching `dired-omit-regexp'."
1459 "Create or update the line for FILE in all Dired buffers it would belong in." 1492 "Create or update the line for FILE in all Dired buffers it would belong in."
1460 (dired-fun-in-all-buffers (file-name-directory file) 1493 (dired-fun-in-all-buffers (file-name-directory file)
1461 (file-name-nondirectory file) 1494 (file-name-nondirectory file)
1462 (function dired-relist-entry) file)) 1495 #'dired-relist-entry file))
1463 1496
1464(defun dired-relist-entry (file) 1497(defun dired-relist-entry (file)
1465 ;; Relist the line for FILE, or just add it if it did not exist. 1498 ;; Relist the line for FILE, or just add it if it did not exist.
@@ -1553,7 +1586,7 @@ Special value `always' suppresses confirmation."
1553 (setq from-dir (file-name-as-directory from-dir) 1586 (setq from-dir (file-name-as-directory from-dir)
1554 to-dir (file-name-as-directory to-dir)) 1587 to-dir (file-name-as-directory to-dir))
1555 (dired-fun-in-all-buffers from-dir nil 1588 (dired-fun-in-all-buffers from-dir nil
1556 (function dired-rename-subdir-1) from-dir to-dir) 1589 #'dired-rename-subdir-1 from-dir to-dir)
1557 ;; Update visited file name of all affected buffers 1590 ;; Update visited file name of all affected buffers
1558 (let ((expanded-from-dir (expand-file-name from-dir)) 1591 (let ((expanded-from-dir (expand-file-name from-dir))
1559 (blist (buffer-list))) 1592 (blist (buffer-list)))
@@ -1788,7 +1821,7 @@ Optional arg HOW-TO determines how to treat the target.
1788 For any other return value, TARGET is treated as a directory." 1821 For any other return value, TARGET is treated as a directory."
1789 (or op1 (setq op1 operation)) 1822 (or op1 (setq op1 operation))
1790 (let* ((fn-list (dired-get-marked-files nil arg)) 1823 (let* ((fn-list (dired-get-marked-files nil arg))
1791 (rfn-list (mapcar (function dired-make-relative) fn-list)) 1824 (rfn-list (mapcar #'dired-make-relative fn-list))
1792 (dired-one-file ; fluid variable inside dired-create-files 1825 (dired-one-file ; fluid variable inside dired-create-files
1793 (and (consp fn-list) (null (cdr fn-list)) (car fn-list))) 1826 (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
1794 (target-dir (dired-dwim-target-directory)) 1827 (target-dir (dired-dwim-target-directory))
@@ -1838,10 +1871,9 @@ Optional arg HOW-TO determines how to treat the target.
1838 (if into-dir ; target is a directory 1871 (if into-dir ; target is a directory
1839 ;; This function uses fluid variable target when called 1872 ;; This function uses fluid variable target when called
1840 ;; inside dired-create-files: 1873 ;; inside dired-create-files:
1841 (function 1874 (lambda (from)
1842 (lambda (from) 1875 (expand-file-name (file-name-nondirectory from) target))
1843 (expand-file-name (file-name-nondirectory from) target))) 1876 (lambda (_from) target))
1844 (function (lambda (_from) target)))
1845 marker-char)))) 1877 marker-char))))
1846 1878
1847;; Read arguments for a marked-files command that wants a file name, 1879;; Read arguments for a marked-files command that wants a file name,
@@ -1857,7 +1889,7 @@ Optional arg HOW-TO determines how to treat the target.
1857 &optional default) 1889 &optional default)
1858 (dired-mark-pop-up 1890 (dired-mark-pop-up
1859 nil op-symbol files 1891 nil op-symbol files
1860 (function read-file-name) 1892 #'read-file-name
1861 (format prompt (dired-mark-prompt arg files)) dir default)) 1893 (format prompt (dired-mark-prompt arg files)) dir default))
1862 1894
1863(defun dired-dwim-target-directory () 1895(defun dired-dwim-target-directory ()
@@ -1985,7 +2017,7 @@ This command copies symbolic links by creating new ones, similar
1985to the \"-d\" option for the \"cp\" shell command." 2017to the \"-d\" option for the \"cp\" shell command."
1986 (interactive "P") 2018 (interactive "P")
1987 (let ((dired-recursive-copies dired-recursive-copies)) 2019 (let ((dired-recursive-copies dired-recursive-copies))
1988 (dired-do-create-files 'copy (function dired-copy-file) 2020 (dired-do-create-files 'copy #'dired-copy-file
1989 "Copy" 2021 "Copy"
1990 arg dired-keep-marker-copy 2022 arg dired-keep-marker-copy
1991 nil dired-copy-how-to-fn))) 2023 nil dired-copy-how-to-fn)))
@@ -2002,7 +2034,7 @@ suggested for the target directory depends on the value of
2002 2034
2003For relative symlinks, use \\[dired-do-relsymlink]." 2035For relative symlinks, use \\[dired-do-relsymlink]."
2004 (interactive "P") 2036 (interactive "P")
2005 (dired-do-create-files 'symlink (function make-symbolic-link) 2037 (dired-do-create-files 'symlink #'make-symbolic-link
2006 "Symlink" arg dired-keep-marker-symlink)) 2038 "Symlink" arg dired-keep-marker-symlink))
2007 2039
2008;;;###autoload 2040;;;###autoload
@@ -2015,7 +2047,7 @@ with the same names that the files currently have. The default
2015suggested for the target directory depends on the value of 2047suggested for the target directory depends on the value of
2016`dired-dwim-target', which see." 2048`dired-dwim-target', which see."
2017 (interactive "P") 2049 (interactive "P")
2018 (dired-do-create-files 'hardlink (function dired-hardlink) 2050 (dired-do-create-files 'hardlink #'dired-hardlink
2019 "Hardlink" arg dired-keep-marker-hardlink)) 2051 "Hardlink" arg dired-keep-marker-hardlink))
2020 2052
2021(defun dired-hardlink (file newname &optional ok-if-already-exists) 2053(defun dired-hardlink (file newname &optional ok-if-already-exists)
@@ -2034,7 +2066,7 @@ This command also renames any buffers that are visiting the files.
2034The default suggested for the target directory depends on the value 2066The default suggested for the target directory depends on the value
2035of `dired-dwim-target', which see." 2067of `dired-dwim-target', which see."
2036 (interactive "P") 2068 (interactive "P")
2037 (dired-do-create-files 'move (function dired-rename-file) 2069 (dired-do-create-files 'move #'dired-rename-file
2038 "Move" arg dired-keep-marker-rename "Rename")) 2070 "Move" arg dired-keep-marker-rename "Rename"))
2039;;;###end dired-cp.el 2071;;;###end dired-cp.el
2040 2072
@@ -2062,37 +2094,35 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next,
2062 (regexp-name-constructor 2094 (regexp-name-constructor
2063 ;; Function to construct new filename using REGEXP and NEWNAME: 2095 ;; Function to construct new filename using REGEXP and NEWNAME:
2064 (if whole-name ; easy (but rare) case 2096 (if whole-name ; easy (but rare) case
2065 (function 2097 (lambda (from)
2066 (lambda (from) 2098 (let ((to (dired-string-replace-match regexp from newname))
2067 (let ((to (dired-string-replace-match regexp from newname)) 2099 ;; must bind help-form directly around call to
2068 ;; must bind help-form directly around call to 2100 ;; dired-query
2069 ;; dired-query
2070 (help-form rename-regexp-help-form))
2071 (if to
2072 (and (dired-query 'rename-regexp-query
2073 operation-prompt
2074 from
2075 to)
2076 to)
2077 (dired-log "%s: %s did not match regexp %s\n"
2078 operation from regexp)))))
2079 ;; not whole-name, replace non-directory part only
2080 (function
2081 (lambda (from)
2082 (let* ((new (dired-string-replace-match
2083 regexp (file-name-nondirectory from) newname))
2084 (to (and new ; nil means there was no match
2085 (expand-file-name new
2086 (file-name-directory from))))
2087 (help-form rename-regexp-help-form)) 2101 (help-form rename-regexp-help-form))
2088 (if to 2102 (if to
2089 (and (dired-query 'rename-regexp-query 2103 (and (dired-query 'rename-regexp-query
2090 operation-prompt 2104 operation-prompt
2091 (dired-make-relative from) 2105 from
2092 (dired-make-relative to)) 2106 to)
2093 to) 2107 to)
2094 (dired-log "%s: %s did not match regexp %s\n" 2108 (dired-log "%s: %s did not match regexp %s\n"
2095 operation (file-name-nondirectory from) regexp))))))) 2109 operation from regexp))))
2110 ;; not whole-name, replace non-directory part only
2111 (lambda (from)
2112 (let* ((new (dired-string-replace-match
2113 regexp (file-name-nondirectory from) newname))
2114 (to (and new ; nil means there was no match
2115 (expand-file-name new
2116 (file-name-directory from))))
2117 (help-form rename-regexp-help-form))
2118 (if to
2119 (and (dired-query 'rename-regexp-query
2120 operation-prompt
2121 (dired-make-relative from)
2122 (dired-make-relative to))
2123 to)
2124 (dired-log "%s: %s did not match regexp %s\n"
2125 operation (file-name-nondirectory from) regexp))))))
2096 rename-regexp-query) 2126 rename-regexp-query)
2097 (dired-create-files 2127 (dired-create-files
2098 file-creator operation fn-list regexp-name-constructor marker-char))) 2128 file-creator operation fn-list regexp-name-constructor marker-char)))
@@ -2130,7 +2160,7 @@ With a zero prefix arg, renaming by regexp affects the absolute file name.
2130Normally, only the non-directory part of the file name is used and changed." 2160Normally, only the non-directory part of the file name is used and changed."
2131 (interactive (dired-mark-read-regexp "Rename")) 2161 (interactive (dired-mark-read-regexp "Rename"))
2132 (dired-do-create-files-regexp 2162 (dired-do-create-files-regexp
2133 (function dired-rename-file) 2163 #'dired-rename-file
2134 "Rename" arg regexp newname whole-name dired-keep-marker-rename)) 2164 "Rename" arg regexp newname whole-name dired-keep-marker-rename))
2135 2165
2136;;;###autoload 2166;;;###autoload
@@ -2140,7 +2170,7 @@ See function `dired-do-rename-regexp' for more info."
2140 (interactive (dired-mark-read-regexp "Copy")) 2170 (interactive (dired-mark-read-regexp "Copy"))
2141 (let ((dired-recursive-copies nil)) ; No recursive copies. 2171 (let ((dired-recursive-copies nil)) ; No recursive copies.
2142 (dired-do-create-files-regexp 2172 (dired-do-create-files-regexp
2143 (function dired-copy-file) 2173 #'dired-copy-file
2144 (if dired-copy-preserve-time "Copy [-p]" "Copy") 2174 (if dired-copy-preserve-time "Copy [-p]" "Copy")
2145 arg regexp newname whole-name dired-keep-marker-copy))) 2175 arg regexp newname whole-name dired-keep-marker-copy)))
2146 2176
@@ -2150,7 +2180,7 @@ See function `dired-do-rename-regexp' for more info."
2150See function `dired-do-rename-regexp' for more info." 2180See function `dired-do-rename-regexp' for more info."
2151 (interactive (dired-mark-read-regexp "HardLink")) 2181 (interactive (dired-mark-read-regexp "HardLink"))
2152 (dired-do-create-files-regexp 2182 (dired-do-create-files-regexp
2153 (function add-name-to-file) 2183 #'add-name-to-file
2154 "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink)) 2184 "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink))
2155 2185
2156;;;###autoload 2186;;;###autoload
@@ -2159,7 +2189,7 @@ See function `dired-do-rename-regexp' for more info."
2159See function `dired-do-rename-regexp' for more info." 2189See function `dired-do-rename-regexp' for more info."
2160 (interactive (dired-mark-read-regexp "SymLink")) 2190 (interactive (dired-mark-read-regexp "SymLink"))
2161 (dired-do-create-files-regexp 2191 (dired-do-create-files-regexp
2162 (function make-symbolic-link) 2192 #'make-symbolic-link
2163 "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) 2193 "SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
2164 2194
2165(defvar rename-non-directory-query) 2195(defvar rename-non-directory-query)
@@ -2174,39 +2204,38 @@ See function `dired-do-rename-regexp' for more info."
2174 file-creator 2204 file-creator
2175 operation 2205 operation
2176 (dired-get-marked-files nil arg) 2206 (dired-get-marked-files nil arg)
2177 (function 2207 (lambda (from)
2178 (lambda (from) 2208 (let ((to (concat (file-name-directory from)
2179 (let ((to (concat (file-name-directory from) 2209 (funcall basename-constructor
2180 (funcall basename-constructor 2210 (file-name-nondirectory from)))))
2181 (file-name-nondirectory from))))) 2211 (and (let ((help-form (format-message "\
2182 (and (let ((help-form (format-message "\
2183Type SPC or `y' to %s one file, DEL or `n' to skip to next, 2212Type SPC or `y' to %s one file, DEL or `n' to skip to next,
2184`!' to %s all remaining matches with no more questions." 2213`!' to %s all remaining matches with no more questions."
2185 (downcase operation) 2214 (downcase operation)
2186 (downcase operation)))) 2215 (downcase operation))))
2187 (dired-query 'rename-non-directory-query 2216 (dired-query 'rename-non-directory-query
2188 (concat operation " `%s' to `%s'") 2217 (concat operation " `%s' to `%s'")
2189 (dired-make-relative from) 2218 (dired-make-relative from)
2190 (dired-make-relative to))) 2219 (dired-make-relative to)))
2191 to)))) 2220 to)))
2192 dired-keep-marker-rename))) 2221 dired-keep-marker-rename)))
2193 2222
2194(defun dired-rename-non-directory (basename-constructor operation arg) 2223(defun dired-rename-non-directory (basename-constructor operation arg)
2195 (dired-create-files-non-directory 2224 (dired-create-files-non-directory
2196 (function dired-rename-file) 2225 #'dired-rename-file
2197 basename-constructor operation arg)) 2226 basename-constructor operation arg))
2198 2227
2199;;;###autoload 2228;;;###autoload
2200(defun dired-upcase (&optional arg) 2229(defun dired-upcase (&optional arg)
2201 "Rename all marked (or next ARG) files to upper case." 2230 "Rename all marked (or next ARG) files to upper case."
2202 (interactive "P") 2231 (interactive "P")
2203 (dired-rename-non-directory (function upcase) "Rename upcase" arg)) 2232 (dired-rename-non-directory #'upcase "Rename upcase" arg))
2204 2233
2205;;;###autoload 2234;;;###autoload
2206(defun dired-downcase (&optional arg) 2235(defun dired-downcase (&optional arg)
2207 "Rename all marked (or next ARG) files to lower case." 2236 "Rename all marked (or next ARG) files to lower case."
2208 (interactive "P") 2237 (interactive "P")
2209 (dired-rename-non-directory (function downcase) "Rename downcase" arg)) 2238 (dired-rename-non-directory #'downcase "Rename downcase" arg))
2210 2239
2211;;;###end dired-re.el 2240;;;###end dired-re.el
2212 2241
@@ -2316,12 +2345,11 @@ This function takes some pains to conform to `ls -lR' output."
2316 (when real-switches 2345 (when real-switches
2317 (let (case-fold-search) 2346 (let (case-fold-search)
2318 (mapcar 2347 (mapcar
2319 (function 2348 (lambda (x)
2320 (lambda (x) 2349 (or (eq (null (string-match-p x real-switches))
2321 (or (eq (null (string-match-p x real-switches)) 2350 (null (string-match-p x dired-actual-switches)))
2322 (null (string-match-p x dired-actual-switches))) 2351 (error
2323 (error 2352 "Can't have dirs with and without -%s switches together" x)))
2324 "Can't have dirs with and without -%s switches together" x))))
2325 ;; all switches that make a difference to dired-get-filename: 2353 ;; all switches that make a difference to dired-get-filename:
2326 '("F" "b")))))) 2354 '("F" "b"))))))
2327 2355
@@ -2334,9 +2362,9 @@ This function takes some pains to conform to `ls -lR' output."
2334 ;; Keep the alist sorted on buffer position. 2362 ;; Keep the alist sorted on buffer position.
2335 (setq dired-subdir-alist 2363 (setq dired-subdir-alist
2336 (sort dired-subdir-alist 2364 (sort dired-subdir-alist
2337 (function (lambda (elt1 elt2) 2365 (lambda (elt1 elt2)
2338 (> (dired-get-subdir-min elt1) 2366 (> (dired-get-subdir-min elt1)
2339 (dired-get-subdir-min elt2))))))) 2367 (dired-get-subdir-min elt2))))))
2340 2368
2341(defun dired-kill-tree (dirname &optional remember-marks kill-root) 2369(defun dired-kill-tree (dirname &optional remember-marks kill-root)
2342 "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself. 2370 "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
diff --git a/lisp/dired.el b/lisp/dired.el
index 909735a3b54..0c1f3e4af64 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -335,9 +335,8 @@ The directory name must be absolute, but need not be fully expanded.")
335(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]")) 335(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
336(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]")) 336(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
337(defvar dired-re-exe;; match ls permission string of an executable file 337(defvar dired-re-exe;; match ls permission string of an executable file
338 (mapconcat (function 338 (mapconcat (lambda (x)
339 (lambda (x) 339 (concat dired-re-maybe-mark dired-re-inode-size x))
340 (concat dired-re-maybe-mark dired-re-inode-size x)))
341 '("-[-r][-w][xs][-r][-w].[-r][-w]." 340 '("-[-r][-w][xs][-r][-w].[-r][-w]."
342 "-[-r][-w].[-r][-w][xs][-r][-w]." 341 "-[-r][-w].[-r][-w][xs][-r][-w]."
343 "-[-r][-w].[-r][-w].[-r][-w][xst]") 342 "-[-r][-w].[-r][-w].[-r][-w][xst]")
@@ -607,9 +606,9 @@ marked file, return (t FILENAME) instead of (FILENAME)."
607 (progn ;; no save-excursion, want to move point. 606 (progn ;; no save-excursion, want to move point.
608 (dired-repeat-over-lines 607 (dired-repeat-over-lines
609 ,arg 608 ,arg
610 (function (lambda () 609 (lambda ()
611 (if ,show-progress (sit-for 0)) 610 (if ,show-progress (sit-for 0))
612 (setq results (cons ,body results))))) 611 (setq results (cons ,body results))))
613 (if (< ,arg 0) 612 (if (< ,arg 0)
614 (nreverse results) 613 (nreverse results)
615 results)) 614 results))
@@ -1995,8 +1994,8 @@ Keybindings:
1995 ;; Ignore dired-hide-details-* value of invisible text property by default. 1994 ;; Ignore dired-hide-details-* value of invisible text property by default.
1996 (when (eq buffer-invisibility-spec t) 1995 (when (eq buffer-invisibility-spec t)
1997 (setq buffer-invisibility-spec (list t))) 1996 (setq buffer-invisibility-spec (list t)))
1998 (setq-local revert-buffer-function (function dired-revert)) 1997 (setq-local revert-buffer-function #'dired-revert)
1999 (setq-local buffer-stale-function (function dired-buffer-stale-p)) 1998 (setq-local buffer-stale-function #'dired-buffer-stale-p)
2000 (setq-local page-delimiter "\n\n") 1999 (setq-local page-delimiter "\n\n")
2001 (setq-local dired-directory (or dirname default-directory)) 2000 (setq-local dired-directory (or dirname default-directory))
2002 ;; list-buffers uses this to display the dir being edited in this buffer. 2001 ;; list-buffers uses this to display the dir being edited in this buffer.
@@ -2469,7 +2468,7 @@ You can then feed the file name(s) to other commands with \\[yank]."
2469 (interactive "P") 2468 (interactive "P")
2470 (let ((string 2469 (let ((string
2471 (or (dired-get-subdir) 2470 (or (dired-get-subdir)
2472 (mapconcat (function identity) 2471 (mapconcat #'identity
2473 (if arg 2472 (if arg
2474 (cond ((zerop (prefix-numeric-value arg)) 2473 (cond ((zerop (prefix-numeric-value arg))
2475 (dired-get-marked-files)) 2474 (dired-get-marked-files))
@@ -2971,12 +2970,12 @@ non-empty directories is allowed."
2971 ;; lines still to be changed, so the (point) values in L stay valid. 2970 ;; lines still to be changed, so the (point) values in L stay valid.
2972 ;; Also, for subdirs in natural order, a subdir's files are deleted 2971 ;; Also, for subdirs in natural order, a subdir's files are deleted
2973 ;; before the subdir itself - the other way around would not work. 2972 ;; before the subdir itself - the other way around would not work.
2974 (let* ((files (mapcar (function car) l)) 2973 (let* ((files (mapcar #'car l))
2975 (count (length l)) 2974 (count (length l))
2976 (succ 0) 2975 (succ 0)
2977 (trashing (and trash delete-by-moving-to-trash))) 2976 (trashing (and trash delete-by-moving-to-trash)))
2978 ;; canonicalize file list for pop up 2977 ;; canonicalize file list for pop up
2979 (setq files (nreverse (mapcar (function dired-make-relative) files))) 2978 (setq files (nreverse (mapcar #'dired-make-relative files)))
2980 (if (dired-mark-pop-up 2979 (if (dired-mark-pop-up
2981 " *Deletions*" 'delete files dired-deletion-confirmer 2980 " *Deletions*" 'delete files dired-deletion-confirmer
2982 (format "%s %s " 2981 (format "%s %s "
@@ -2999,7 +2998,7 @@ non-empty directories is allowed."
2999 (progress-reporter-update progress-reporter succ) 2998 (progress-reporter-update progress-reporter succ)
3000 (dired-fun-in-all-buffers 2999 (dired-fun-in-all-buffers
3001 (file-name-directory fn) (file-name-nondirectory fn) 3000 (file-name-directory fn) (file-name-nondirectory fn)
3002 (function dired-delete-entry) fn)) 3001 #'dired-delete-entry fn))
3003 (error ;; catch errors from failed deletions 3002 (error ;; catch errors from failed deletions
3004 (dired-log "%s\n" err) 3003 (dired-log "%s\n" err)
3005 (setq failures (cons (car (car l)) failures))))) 3004 (setq failures (cons (car (car l)) failures)))))
@@ -3293,7 +3292,7 @@ this subdir."
3293 (let ((inhibit-read-only t)) 3292 (let ((inhibit-read-only t))
3294 (dired-repeat-over-lines 3293 (dired-repeat-over-lines
3295 (prefix-numeric-value arg) 3294 (prefix-numeric-value arg)
3296 (function (lambda () (delete-char 1) (insert dired-marker-char)))))))) 3295 (lambda () (delete-char 1) (insert dired-marker-char)))))))
3297 3296
3298(defun dired-unmark (arg &optional interactive) 3297(defun dired-unmark (arg &optional interactive)
3299 "Unmark the file at point in the Dired buffer. 3298 "Unmark the file at point in the Dired buffer.
@@ -3928,7 +3927,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
3928 (cdr 3927 (cdr
3929 (nreverse 3928 (nreverse
3930 (mapcar 3929 (mapcar
3931 (function (lambda (f) (desktop-file-name (car f) dirname))) 3930 (lambda (f) (desktop-file-name (car f) dirname))
3932 dired-subdir-alist))))) 3931 dired-subdir-alist)))))
3933 3932
3934(defun dired-restore-desktop-buffer (_file-name 3933(defun dired-restore-desktop-buffer (_file-name
diff --git a/lisp/electric.el b/lisp/electric.el
index 4078ef8193e..1564df5949c 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -443,11 +443,24 @@ quote, left double quote, and right double quote, respectively."
443 :version "25.1" 443 :version "25.1"
444 :type 'boolean :safe 'booleanp :group 'electricity) 444 :type 'boolean :safe 'booleanp :group 'electricity)
445 445
446(defcustom electric-quote-context-sensitive nil
447 "Non-nil means to replace \\=' with an electric quote depending on context.
448If `electric-quote-context-sensitive' is non-nil, Emacs replaces
449\\=' and \\='\\=' with an opening quote after a line break,
450whitespace, opening parenthesis, or quote and leaves \\=` alone."
451 :version "26.1"
452 :type 'boolean :safe #'booleanp :group 'electricity)
453
454(defvar electric-quote-code-faces ()
455 "List of faces to treat as inline code in `text-mode'.")
456
446(defun electric-quote-post-self-insert-function () 457(defun electric-quote-post-self-insert-function ()
447 "Function that `electric-quote-mode' adds to `post-self-insert-hook'. 458 "Function that `electric-quote-mode' adds to `post-self-insert-hook'.
448This requotes when a quoting key is typed." 459This requotes when a quoting key is typed."
449 (when (and electric-quote-mode 460 (when (and electric-quote-mode
450 (memq last-command-event '(?\' ?\`))) 461 (or (eq last-command-event ?\')
462 (and (not electric-quote-context-sensitive)
463 (eq last-command-event ?\`))))
451 (let ((start 464 (let ((start
452 (if (and comment-start comment-use-syntax) 465 (if (and comment-start comment-use-syntax)
453 (when (or electric-quote-comment electric-quote-string) 466 (when (or electric-quote-comment electric-quote-string)
@@ -462,30 +475,45 @@ This requotes when a quoting key is typed."
462 (syntax-ppss (1- (point))))))))) 475 (syntax-ppss (1- (point)))))))))
463 (and electric-quote-paragraph 476 (and electric-quote-paragraph
464 (derived-mode-p 'text-mode) 477 (derived-mode-p 'text-mode)
478 ;; FIXME: There should be a ‘cl-disjoint’ function.
479 (null (cl-intersection (face-at-point nil 'multiple)
480 electric-quote-code-faces
481 :test #'eq))
482 ;; FIXME: Why is the next form there? It’s never
483 ;; nil.
465 (or (eq last-command-event ?\`) 484 (or (eq last-command-event ?\`)
466 (save-excursion (backward-paragraph) (point))))))) 485 (save-excursion (backward-paragraph) (point)))))))
467 (pcase electric-quote-chars 486 (pcase electric-quote-chars
468 (`(,q< ,q> ,q<< ,q>>) 487 (`(,q< ,q> ,q<< ,q>>)
469 (when start 488 (when start
470 (save-excursion 489 (save-excursion
471 (if (eq last-command-event ?\`) 490 (let ((backtick ?\`))
472 (cond ((search-backward (string q< ?`) (- (point) 2) t) 491 (if (or (eq last-command-event ?\`)
473 (replace-match (string q<<)) 492 (and electric-quote-context-sensitive
474 (when (and electric-pair-mode 493 (save-excursion
475 (eq (cdr-safe 494 (backward-char)
476 (assq q< electric-pair-text-pairs)) 495 (or (bobp) (bolp)
477 (char-after))) 496 (memq (char-before) (list q< q<<))
478 (delete-char 1)) 497 (memq (char-syntax (char-before))
479 (setq last-command-event q<<)) 498 '(?\s ?\())))
480 ((search-backward "`" (1- (point)) t) 499 (setq backtick ?\')))
481 (replace-match (string q<)) 500 (cond ((search-backward (string q< backtick) (- (point) 2) t)
482 (setq last-command-event q<))) 501 (replace-match (string q<<))
483 (cond ((search-backward (string q> ?') (- (point) 2) t) 502 (when (and electric-pair-mode
484 (replace-match (string q>>)) 503 (eq (cdr-safe
485 (setq last-command-event q>>)) 504 (assq q< electric-pair-text-pairs))
486 ((search-backward "'" (1- (point)) t) 505 (char-after)))
487 (replace-match (string q>)) 506 (delete-char 1))
488 (setq last-command-event q>))))))))))) 507 (setq last-command-event q<<))
508 ((search-backward (string backtick) (1- (point)) t)
509 (replace-match (string q<))
510 (setq last-command-event q<)))
511 (cond ((search-backward (string q> ?') (- (point) 2) t)
512 (replace-match (string q>>))
513 (setq last-command-event q>>))
514 ((search-backward "'" (1- (point)) t)
515 (replace-match (string q>))
516 (setq last-command-event q>))))))))))))
489 517
490(put 'electric-quote-post-self-insert-function 'priority 10) 518(put 'electric-quote-post-self-insert-function 'priority 10)
491 519
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 3852ceb6c31..99df209d1a2 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -437,22 +437,38 @@ as an integer unless JUNK-ALLOWED is non-nil."
437 437
438;; Random numbers. 438;; Random numbers.
439 439
440(defun cl--random-time ()
441 (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
442 (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
443 v))
444
445;;;###autoload (autoload 'cl-random-state-p "cl-extra")
446(cl-defstruct (cl--random-state
447 (:copier nil)
448 (:predicate cl-random-state-p)
449 (:constructor nil)
450 (:constructor cl--make-random-state (vec)))
451 (i -1) (j 30) vec)
452
453(defvar cl--random-state (cl--make-random-state (cl--random-time)))
454
440;;;###autoload 455;;;###autoload
441(defun cl-random (lim &optional state) 456(defun cl-random (lim &optional state)
442 "Return a random nonnegative number less than LIM, an integer or float. 457 "Return a random nonnegative number less than LIM, an integer or float.
443Optional second arg STATE is a random-state object." 458Optional second arg STATE is a random-state object."
444 (or state (setq state cl--random-state)) 459 (or state (setq state cl--random-state))
445 ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. 460 ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method.
446 (let ((vec (aref state 3))) 461 (let ((vec (cl--random-state-vec state)))
447 (if (integerp vec) 462 (if (integerp vec)
448 (let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1)) 463 (let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1))
449 (aset state 3 (setq vec (make-vector 55 nil))) 464 (setf (cl--random-state-vec state)
465 (setq vec (make-vector 55 nil)))
450 (aset vec 0 j) 466 (aset vec 0 j)
451 (while (> (setq i (% (+ i 21) 55)) 0) 467 (while (> (setq i (% (+ i 21) 55)) 0)
452 (aset vec i (setq j (prog1 k (setq k (- j k)))))) 468 (aset vec i (setq j (prog1 k (setq k (- j k))))))
453 (while (< (setq i (1+ i)) 200) (cl-random 2 state)))) 469 (while (< (setq i (1+ i)) 200) (cl-random 2 state))))
454 (let* ((i (aset state 1 (% (1+ (aref state 1)) 55))) 470 (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state)))
455 (j (aset state 2 (% (1+ (aref state 2)) 55))) 471 (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state)))
456 (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) 472 (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
457 (if (integerp lim) 473 (if (integerp lim)
458 (if (<= lim 512) (% n lim) 474 (if (<= lim 512) (% n lim)
@@ -466,17 +482,10 @@ Optional second arg STATE is a random-state object."
466(defun cl-make-random-state (&optional state) 482(defun cl-make-random-state (&optional state)
467 "Return a copy of random-state STATE, or of the internal state if omitted. 483 "Return a copy of random-state STATE, or of the internal state if omitted.
468If STATE is t, return a new state object seeded from the time of day." 484If STATE is t, return a new state object seeded from the time of day."
469 (cond ((null state) (cl-make-random-state cl--random-state)) 485 (unless state (setq state cl--random-state))
470 ((vectorp state) (copy-tree state t)) 486 (if (cl-random-state-p state)
471 ((integerp state) (vector 'cl--random-state-tag -1 30 state)) 487 (copy-tree state t)
472 (t (cl-make-random-state (cl--random-time))))) 488 (cl--make-random-state (if (integerp state) state (cl--random-time)))))
473
474;;;###autoload
475(defun cl-random-state-p (object)
476 "Return t if OBJECT is a random-state object."
477 (and (vectorp object) (= (length object) 4)
478 (eq (aref object 0) 'cl--random-state-tag)))
479
480 489
481;; Implementation limits. 490;; Implementation limits.
482 491
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 89a71d1b6c5..e9ca0412848 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -90,7 +90,7 @@ call other entry points instead, such as `cl-prin1'."
90- `disassemble' to print the disassembly of the code. 90- `disassemble' to print the disassembly of the code.
91- nil to skip printing any details about the code.") 91- nil to skip printing any details about the code.")
92 92
93(defvar cl-print-compiled-button nil 93(defvar cl-print-compiled-button t
94 "Control how to print byte-compiled functions into buffers. 94 "Control how to print byte-compiled functions into buffers.
95When the stream is a buffer, make the bytecode part of the output 95When the stream is a buffer, make the bytecode part of the output
96into a button whose action shows the function's disassembly.") 96into a button whose action shows the function's disassembly.")
@@ -105,10 +105,11 @@ into a button whose action shows the function's disassembly.")
105 (if args 105 (if args
106 (prin1 args stream) 106 (prin1 args stream)
107 (princ "()" stream))) 107 (princ "()" stream)))
108 (let ((doc (documentation object 'raw))) 108 (pcase (help-split-fundoc (documentation object 'raw) object)
109 (when doc 109 ;; Drop args which `help-function-arglist' already printed.
110 (princ " " stream) 110 (`(,_usage . ,(and doc (guard (stringp doc))))
111 (prin1 doc stream))) 111 (princ " " stream)
112 (prin1 doc stream)))
112 (let ((inter (interactive-form object))) 113 (let ((inter (interactive-form object)))
113 (when inter 114 (when inter
114 (princ " " stream) 115 (princ " " stream)
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 83456fc31a2..2b8782590c4 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -49,6 +49,12 @@ the middle is discarded, and just the beginning and end are displayed."
49 :group 'debugger 49 :group 'debugger
50 :version "21.1") 50 :version "21.1")
51 51
52(defcustom debugger-print-function #'cl-prin1
53 "Function used to print values in the debugger backtraces."
54 :type 'function
55 :options '(cl-prin1 prin1)
56 :version "26.1")
57
52(defcustom debugger-bury-or-kill 'bury 58(defcustom debugger-bury-or-kill 'bury
53 "What to do with the debugger buffer when exiting `debug'. 59 "What to do with the debugger buffer when exiting `debug'.
54The value affects the behavior of operations on any window 60The value affects the behavior of operations on any window
@@ -264,6 +270,40 @@ first will be printed into the backtrace buffer."
264 (setq debug-on-next-call debugger-step-after-exit) 270 (setq debug-on-next-call debugger-step-after-exit)
265 debugger-value))) 271 debugger-value)))
266 272
273
274(defun debugger-insert-backtrace (frames do-xrefs)
275 "Format and insert the backtrace FRAMES at point.
276Make functions into cross-reference buttons if DO-XREFS is non-nil."
277 (let ((standard-output (current-buffer))
278 (eval-buffers eval-buffer-list))
279 (require 'help-mode) ; Define `help-function-def' button type.
280 (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
281 (insert (if (plist-get flags :debug-on-exit)
282 "* " " "))
283 (let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
284 (fun-pt (point)))
285 (cond
286 ((and evald (not debugger-stack-frame-as-list))
287 (funcall debugger-print-function fun)
288 (if args (funcall debugger-print-function args) (princ "()")))
289 (t
290 (funcall debugger-print-function (cons fun args))
291 (cl-incf fun-pt)))
292 (when fun-file
293 (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
294 :type 'help-function-def
295 'help-args (list fun fun-file))))
296 ;; After any frame that uses eval-buffer, insert a line that
297 ;; states the buffer position it's reading at.
298 (when (and eval-buffers (memq fun '(eval-buffer eval-region)))
299 (insert (format " ; Reading at buffer position %d"
300 ;; This will get the wrong result if there are
301 ;; two nested eval-region calls for the same
302 ;; buffer. That's not a very useful case.
303 (with-current-buffer (pop eval-buffers)
304 (point)))))
305 (insert "\n"))))
306
267(defun debugger-setup-buffer (args) 307(defun debugger-setup-buffer (args)
268 "Initialize the `*Backtrace*' buffer for entry to the debugger. 308 "Initialize the `*Backtrace*' buffer for entry to the debugger.
269That buffer should be current already." 309That buffer should be current already."
@@ -271,27 +311,20 @@ That buffer should be current already."
271 (erase-buffer) 311 (erase-buffer)
272 (set-buffer-multibyte t) ;Why was it nil ? -stef 312 (set-buffer-multibyte t) ;Why was it nil ? -stef
273 (setq buffer-undo-list t) 313 (setq buffer-undo-list t)
274 (let ((standard-output (current-buffer))
275 (print-escape-newlines t)
276 (print-level 8)
277 (print-length 50))
278 ;; FIXME the debugger could pass a custom callback to mapbacktrace
279 ;; instead of manipulating printed results.
280 (mapbacktrace #'backtrace--print-frame 'debug))
281 (goto-char (point-min))
282 (delete-region (point)
283 (progn
284 (forward-line (if (eq (car args) 'debug)
285 ;; Remove debug--implement-debug-on-entry
286 ;; and the advice's `apply' frame.
287 3
288 1))
289 (point)))
290 (insert "Debugger entered") 314 (insert "Debugger entered")
291 ;; lambda is for debug-on-call when a function call is next. 315 (let ((frames (nthcdr
292 ;; debug is for debug-on-entry function called. 316 ;; Remove debug--implement-debug-on-entry and the
293 (let ((pos (point))) 317 ;; advice's `apply' frame.
318 (if (eq (car args) 'debug) 3 1)
319 (backtrace-frames 'debug)))
320 (print-escape-newlines t)
321 (print-escape-control-characters t)
322 (print-level 8)
323 (print-length 50)
324 (pos (point)))
294 (pcase (car args) 325 (pcase (car args)
326 ;; lambda is for debug-on-call when a function call is next.
327 ;; debug is for debug-on-entry function called.
295 ((or `lambda `debug) 328 ((or `lambda `debug)
296 (insert "--entering a function:\n") 329 (insert "--entering a function:\n")
297 (setq pos (1- (point)))) 330 (setq pos (1- (point))))
@@ -300,11 +333,9 @@ That buffer should be current already."
300 (insert "--returning value: ") 333 (insert "--returning value: ")
301 (setq pos (point)) 334 (setq pos (point))
302 (setq debugger-value (nth 1 args)) 335 (setq debugger-value (nth 1 args))
303 (prin1 debugger-value (current-buffer)) 336 (funcall debugger-print-function debugger-value (current-buffer))
304 (insert ?\n) 337 (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
305 (delete-char 1) 338 (insert ?\n))
306 (insert ? )
307 (beginning-of-line))
308 ;; Watchpoint triggered. 339 ;; Watchpoint triggered.
309 ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) 340 ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
310 (insert 341 (insert
@@ -327,7 +358,7 @@ That buffer should be current already."
327 (`error 358 (`error
328 (insert "--Lisp error: ") 359 (insert "--Lisp error: ")
329 (setq pos (point)) 360 (setq pos (point))
330 (prin1 (nth 1 args) (current-buffer)) 361 (funcall debugger-print-function (nth 1 args) (current-buffer))
331 (insert ?\n)) 362 (insert ?\n))
332 ;; debug-on-call, when the next thing is an eval. 363 ;; debug-on-call, when the next thing is an eval.
333 (`t 364 (`t
@@ -337,98 +368,15 @@ That buffer should be current already."
337 (_ 368 (_
338 (insert ": ") 369 (insert ": ")
339 (setq pos (point)) 370 (setq pos (point))
340 (prin1 (if (eq (car args) 'nil) 371 (funcall debugger-print-function
341 (cdr args) args) 372 (if (eq (car args) 'nil)
342 (current-buffer)) 373 (cdr args) args)
374 (current-buffer))
343 (insert ?\n))) 375 (insert ?\n)))
376 (debugger-insert-backtrace frames t)
344 ;; Place point on "stack frame 0" (bug#15101). 377 ;; Place point on "stack frame 0" (bug#15101).
345 (goto-char pos)) 378 (goto-char pos)))
346 ;; After any frame that uses eval-buffer, 379
347 ;; insert a line that states the buffer position it's reading at.
348 (save-excursion
349 (let ((tem eval-buffer-list))
350 (while (and tem
351 (re-search-forward "^ eval-\\(buffer\\|region\\)(" nil t))
352 (end-of-line)
353 (insert (format " ; Reading at buffer position %d"
354 ;; This will get the wrong result
355 ;; if there are two nested eval-region calls
356 ;; for the same buffer. That's not a very useful case.
357 (with-current-buffer (car tem)
358 (point))))
359 (pop tem))))
360 (debugger-make-xrefs))
361
362(defun debugger-make-xrefs (&optional buffer)
363 "Attach cross-references to function names in the `*Backtrace*' buffer."
364 (interactive "b")
365 (with-current-buffer (or buffer (current-buffer))
366 (save-excursion
367 (setq buffer (current-buffer))
368 (let ((inhibit-read-only t)
369 (old-end (point-min)) (new-end (point-min)))
370 ;; If we saved an old backtrace, find the common part
371 ;; between the new and the old.
372 ;; Compare line by line, starting from the end,
373 ;; because that's the part that is likely to be unchanged.
374 (if debugger-previous-backtrace
375 (let (old-start new-start (all-match t))
376 (goto-char (point-max))
377 (with-temp-buffer
378 (insert debugger-previous-backtrace)
379 (while (and all-match (not (bobp)))
380 (setq old-end (point))
381 (forward-line -1)
382 (setq old-start (point))
383 (with-current-buffer buffer
384 (setq new-end (point))
385 (forward-line -1)
386 (setq new-start (point)))
387 (if (not (zerop
388 (let ((case-fold-search nil))
389 (compare-buffer-substrings
390 (current-buffer) old-start old-end
391 buffer new-start new-end))))
392 (setq all-match nil))))
393 ;; Now new-end is the position of the start of the
394 ;; unchanged part in the current buffer, and old-end is
395 ;; the position of that same text in the saved old
396 ;; backtrace. But we must subtract (point-min) since strings are
397 ;; indexed in origin 0.
398
399 ;; Replace the unchanged part of the backtrace
400 ;; with the text from debugger-previous-backtrace,
401 ;; since that already has the proper xrefs.
402 ;; With this optimization, we only need to scan
403 ;; the changed part of the backtrace.
404 (delete-region new-end (point-max))
405 (goto-char (point-max))
406 (insert (substring debugger-previous-backtrace
407 (- old-end (point-min))))
408 ;; Make the unchanged part of the backtrace inaccessible
409 ;; so it won't be scanned.
410 (narrow-to-region (point-min) new-end)))
411
412 ;; Scan the new part of the backtrace, inserting xrefs.
413 (goto-char (point-min))
414 (while (progn
415 (goto-char (+ (point) 2))
416 (skip-syntax-forward "^w_")
417 (not (eobp)))
418 (let* ((beg (point))
419 (end (progn (skip-syntax-forward "w_") (point)))
420 (sym (intern-soft (buffer-substring-no-properties
421 beg end)))
422 (file (and sym (symbol-file sym 'defun))))
423 (when file
424 (goto-char beg)
425 ;; help-xref-button needs to operate on something matched
426 ;; by a regexp, so set that up for it.
427 (re-search-forward "\\(\\sw\\|\\s_\\)+")
428 (help-xref-button 0 'help-function-def sym file)))
429 (forward-line 1))
430 (widen))
431 (setq debugger-previous-backtrace (buffer-string)))))
432 380
433(defun debugger-step-through () 381(defun debugger-step-through ()
434 "Proceed, stepping through subexpressions of this expression. 382 "Proceed, stepping through subexpressions of this expression.
@@ -866,9 +814,13 @@ To specify a nil argument interactively, exit with an empty minibuffer."
866 'type 'help-function 814 'type 'help-function
867 'help-args (list fun)) 815 'help-args (list fun))
868 (terpri)) 816 (terpri))
869 (terpri) 817 ;; Now that debug--function-list uses advice-member-p, its
870 (princ "Note: if you have redefined a function, then it may no longer\n") 818 ;; output should be reliable (except for bugs and the exceptional
871 (princ "be set to debug on entry, even if it is in the list.")))))) 819 ;; case where some other advice ends up overriding ours).
820 ;;(terpri)
821 ;;(princ "Note: if you have redefined a function, then it may no longer\n")
822 ;;(princ "be set to debug on entry, even if it is in the list.")
823 )))))
872 824
873(defun debug--implement-debug-watch (symbol newval op where) 825(defun debug--implement-debug-watch (symbol newval op where)
874 "Conditionally call the debugger. 826 "Conditionally call the debugger.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index dfe1c06bfaf..9d618e1dc81 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -84,7 +84,7 @@ Currently under control of this var:
84(progn 84(progn
85 ;; Arrange for field access not to bother checking if the access is indeed 85 ;; Arrange for field access not to bother checking if the access is indeed
86 ;; made to an eieio--class object. 86 ;; made to an eieio--class object.
87 (cl-declaim (optimize (safety 0))) 87 (eval-when-compile (cl-declaim (optimize (safety 0))))
88 88
89(cl-defstruct (eieio--class 89(cl-defstruct (eieio--class
90 (:constructor nil) 90 (:constructor nil)
@@ -103,8 +103,12 @@ Currently under control of this var:
103 options ;; storage location of tagged class option 103 options ;; storage location of tagged class option
104 ; Stored outright without modifications or stripping 104 ; Stored outright without modifications or stripping
105 ) 105 )
106 ;; Set it back to the default value. 106 ;; Set it back to the default value. NOTE: Using the default
107 (cl-declaim (optimize (safety 1)))) 107 ;; `safety' value does NOT give the default
108 ;; `byte-compile-delete-errors' value. Therefore limit this (and
109 ;; the above `cl-declaim') to compile time so that we don't affect
110 ;; code which only loads this library.
111 (eval-when-compile (cl-declaim (optimize (safety 1)))))
108 112
109 113
110(eval-and-compile 114(eval-and-compile
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 2c49a634e35..eb2b2e3e11b 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -670,48 +670,12 @@ and is displayed in front of the value of MESSAGE-FORM."
670(cl-defstruct (ert-test-aborted-with-non-local-exit 670(cl-defstruct (ert-test-aborted-with-non-local-exit
671 (:include ert-test-result))) 671 (:include ert-test-result)))
672 672
673 673(defun ert--print-backtrace (backtrace do-xrefs)
674(defun ert--record-backtrace ()
675 "Record the current backtrace (as a list) and return it."
676 ;; Since the backtrace is stored in the result object, result
677 ;; objects must only be printed with appropriate limits
678 ;; (`print-level' and `print-length') in place. For interactive
679 ;; use, the cost of ensuring this possibly outweighs the advantage
680 ;; of storing the backtrace for
681 ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
682 ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
683 ;; For batch use, however, printing the backtrace may be useful.
684 (cl-loop
685 ;; 6 is the number of frames our own debugger adds (when
686 ;; compiled; more when interpreted). FIXME: Need to describe a
687 ;; procedure for determining this constant.
688 for i from 6
689 for frame = (backtrace-frame i)
690 while frame
691 collect frame))
692
693(defun ert--print-backtrace (backtrace)
694 "Format the backtrace BACKTRACE to the current buffer." 674 "Format the backtrace BACKTRACE to the current buffer."
695 ;; This is essentially a reimplementation of Fbacktrace
696 ;; (src/eval.c), but for a saved backtrace, not the current one.
697 (let ((print-escape-newlines t) 675 (let ((print-escape-newlines t)
698 (print-level 8) 676 (print-level 8)
699 (print-length 50)) 677 (print-length 50))
700 (dolist (frame backtrace) 678 (debugger-insert-backtrace backtrace do-xrefs)))
701 (pcase-exhaustive frame
702 (`(nil ,special-operator . ,arg-forms)
703 ;; Special operator.
704 (insert
705 (format " %S\n" (cons special-operator arg-forms))))
706 (`(t ,fn . ,args)
707 ;; Function call.
708 (insert (format " %S(" fn))
709 (cl-loop for firstp = t then nil
710 for arg in args do
711 (unless firstp
712 (insert " "))
713 (insert (format "%S" arg)))
714 (insert ")\n"))))))
715 679
716;; A container for the state of the execution of a single test and 680;; A container for the state of the execution of a single test and
717;; environment data needed during its execution. 681;; environment data needed during its execution.
@@ -750,7 +714,19 @@ run. ARGS are the arguments to `debugger'."
750 ((quit) 'quit) 714 ((quit) 'quit)
751 ((ert-test-skipped) 'skipped) 715 ((ert-test-skipped) 'skipped)
752 (otherwise 'failed))) 716 (otherwise 'failed)))
753 (backtrace (ert--record-backtrace)) 717 ;; We store the backtrace in the result object for
718 ;; `ert-results-pop-to-backtrace-for-test-at-point'.
719 ;; This means we have to limit `print-level' and
720 ;; `print-length' when printing result objects. That
721 ;; might not be worth while when we can also use
722 ;; `ert-results-rerun-test-debugging-errors-at-point',
723 ;; (i.e., when running interactively) but having the
724 ;; backtrace ready for printing is important for batch
725 ;; use.
726 ;;
727 ;; Grab the frames starting from `signal', frames below
728 ;; that are all from the debugger.
729 (backtrace (backtrace-frames 'signal))
754 (infos (reverse ert--infos))) 730 (infos (reverse ert--infos)))
755 (setf (ert--test-execution-info-result info) 731 (setf (ert--test-execution-info-result info)
756 (cl-ecase type 732 (cl-ecase type
@@ -1409,8 +1385,9 @@ Returns the stats object."
1409 (ert-test-result-with-condition 1385 (ert-test-result-with-condition
1410 (message "Test %S backtrace:" (ert-test-name test)) 1386 (message "Test %S backtrace:" (ert-test-name test))
1411 (with-temp-buffer 1387 (with-temp-buffer
1412 (ert--print-backtrace (ert-test-result-with-condition-backtrace 1388 (ert--print-backtrace
1413 result)) 1389 (ert-test-result-with-condition-backtrace result)
1390 nil)
1414 (goto-char (point-min)) 1391 (goto-char (point-min))
1415 (while (not (eobp)) 1392 (while (not (eobp))
1416 (let ((start (point)) 1393 (let ((start (point))
@@ -1491,7 +1468,7 @@ this exits Emacs, with status as per `ert-run-tests-batch-and-exit'."
1491 (with-temp-buffer 1468 (with-temp-buffer
1492 (while (setq logfile (pop command-line-args-left)) 1469 (while (setq logfile (pop command-line-args-left))
1493 (erase-buffer) 1470 (erase-buffer)
1494 (insert-file-contents logfile) 1471 (when (file-readable-p logfile) (insert-file-contents logfile))
1495 (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t)) 1472 (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t))
1496 (push logfile notests) 1473 (push logfile notests)
1497 (setq ntests (+ ntests (string-to-number (match-string 1)))) 1474 (setq ntests (+ ntests (string-to-number (match-string 1))))
@@ -1828,12 +1805,23 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'."
1828 1805
1829BEGIN and END specify a region in the current buffer." 1806BEGIN and END specify a region in the current buffer."
1830 (save-excursion 1807 (save-excursion
1831 (save-restriction 1808 (goto-char begin)
1832 (narrow-to-region begin end) 1809 (while (progn
1833 ;; Inhibit optimization in `debugger-make-xrefs' that would 1810 (goto-char (+ (point) 2))
1834 ;; sometimes insert unrelated backtrace info into our buffer. 1811 (skip-syntax-forward "^w_")
1835 (let ((debugger-previous-backtrace nil)) 1812 (< (point) end))
1836 (debugger-make-xrefs))))) 1813 (let* ((beg (point))
1814 (end (progn (skip-syntax-forward "w_") (point)))
1815 (sym (intern-soft (buffer-substring-no-properties
1816 beg end)))
1817 (file (and sym (symbol-file sym 'defun))))
1818 (when file
1819 (goto-char beg)
1820 ;; help-xref-button needs to operate on something matched
1821 ;; by a regexp, so set that up for it.
1822 (re-search-forward "\\(\\sw\\|\\s_\\)+")
1823 (help-xref-button 0 'help-function-def sym file)))
1824 (forward-line 1))))
1837 1825
1838(defun ert--string-first-line (s) 1826(defun ert--string-first-line (s)
1839 "Return the first line of S, or S if it contains no newlines. 1827 "Return the first line of S, or S if it contains no newlines.
@@ -2420,8 +2408,7 @@ To be used in the ERT results buffer."
2420 ;; Use unibyte because `debugger-setup-buffer' also does so. 2408 ;; Use unibyte because `debugger-setup-buffer' also does so.
2421 (set-buffer-multibyte nil) 2409 (set-buffer-multibyte nil)
2422 (setq truncate-lines t) 2410 (setq truncate-lines t)
2423 (ert--print-backtrace backtrace) 2411 (ert--print-backtrace backtrace t)
2424 (debugger-make-xrefs)
2425 (goto-char (point-min)) 2412 (goto-char (point-min))
2426 (insert (substitute-command-keys "Backtrace for test `")) 2413 (insert (substitute-command-keys "Backtrace for test `"))
2427 (ert-insert-test-name-button (ert-test-name test)) 2414 (ert-insert-test-name-button (ert-test-name test))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index fc3caf3359a..a1c5b6977f8 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -326,12 +326,13 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")"
326 (start (point)) 326 (start (point))
327 (end (line-end-position))) 327 (end (line-end-position)))
328 ;; Cope with multi-line copyright `lines'. Assume the second 328 ;; Cope with multi-line copyright `lines'. Assume the second
329 ;; line is indented (with the same commenting style). 329 ;; line is indented at least as much as the original, with the
330 ;; same commenting style.
330 (save-excursion 331 (save-excursion
331 (beginning-of-line 2) 332 (beginning-of-line 2)
332 (let ((str (concat (match-string-no-properties 1) "[ \t]+"))) 333 (let ((str (match-string-no-properties 1)))
333 (beginning-of-line) 334 (beginning-of-line)
334 (while (looking-at str) 335 (while (and (looking-at str) (not (looking-at lm-copyright-prefix)))
335 (setq end (line-end-position)) 336 (setq end (line-end-position))
336 (beginning-of-line 2)))) 337 (beginning-of-line 2))))
337 ;; Make a single line and parse that. 338 ;; Make a single line and parse that.
diff --git a/lisp/epg.el b/lisp/epg.el
index 587271b0003..1e24b8d1169 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1047,7 +1047,7 @@ callback data (if any)."
1047(defun epg--status-TRUST_MARGINAL (context _string) 1047(defun epg--status-TRUST_MARGINAL (context _string)
1048 (let ((signature (car (epg-context-result-for context 'verify)))) 1048 (let ((signature (car (epg-context-result-for context 'verify))))
1049 (if (and signature 1049 (if (and signature
1050 (eq (epg-signature-status signature) 'marginal)) 1050 (eq (epg-signature-status signature) 'good))
1051 (setf (epg-signature-validity signature) 'marginal)))) 1051 (setf (epg-signature-validity signature) 'marginal))))
1052 1052
1053(defun epg--status-TRUST_FULLY (context _string) 1053(defun epg--status-TRUST_FULLY (context _string)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 86e7b83c281..24342208771 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1148,6 +1148,8 @@ be finished later after the completion of an asynchronous subprocess."
1148 1148
1149;; command invocation 1149;; command invocation
1150 1150
1151(declare-function help-fns-function-description-header "help-fns")
1152
1151(defun eshell/which (command &rest names) 1153(defun eshell/which (command &rest names)
1152 "Identify the COMMAND, and where it is located." 1154 "Identify the COMMAND, and where it is located."
1153 (dolist (name (cons command names)) 1155 (dolist (name (cons command names))
@@ -1164,25 +1166,17 @@ be finished later after the completion of an asynchronous subprocess."
1164 (concat name " is an alias, defined as \"" 1166 (concat name " is an alias, defined as \""
1165 (cadr alias) "\""))) 1167 (cadr alias) "\"")))
1166 (unless program 1168 (unless program
1167 (setq program (eshell-search-path name)) 1169 (setq program
1168 (let* ((esym (eshell-find-alias-function name)) 1170 (let* ((esym (eshell-find-alias-function name))
1169 (sym (or esym (intern-soft name)))) 1171 (sym (or esym (intern-soft name))))
1170 (if (and (or esym (and sym (fboundp sym))) 1172 (if (and (or esym (and sym (fboundp sym)))
1171 (or eshell-prefer-lisp-functions (not direct))) 1173 (or eshell-prefer-lisp-functions (not direct)))
1172 (let ((desc (let ((inhibit-redisplay t)) 1174 (or (with-output-to-string
1173 (save-window-excursion 1175 (require 'help-fns)
1174 (prog1 1176 (princ (format "%s is " sym))
1175 (describe-function sym) 1177 (help-fns-function-description-header sym))
1176 (message nil)))))) 1178 name)
1177 (setq desc (if desc (substring desc 0 1179 (eshell-search-path name)))))
1178 (1- (or (string-match "\n" desc)
1179 (length desc))))
1180 ;; This should not happen.
1181 (format "%s is defined, \
1182but no documentation was found" name)))
1183 (if (buffer-live-p (get-buffer "*Help*"))
1184 (kill-buffer "*Help*"))
1185 (setq program (or desc name))))))
1186 (if (not program) 1180 (if (not program)
1187 (eshell-error (format "which: no %s in (%s)\n" 1181 (eshell-error (format "which: no %s in (%s)\n"
1188 name (getenv "PATH"))) 1182 name (getenv "PATH")))
diff --git a/lisp/frame.el b/lisp/frame.el
index b7a55169281..b54df6fa160 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1110,6 +1110,38 @@ differing font heights."
1110If FRAME is omitted, describe the currently selected frame." 1110If FRAME is omitted, describe the currently selected frame."
1111 (cdr (assq 'width (frame-parameters frame)))) 1111 (cdr (assq 'width (frame-parameters frame))))
1112 1112
1113(defalias 'frame-border-width 'frame-internal-border-width)
1114(defalias 'frame-pixel-width 'frame-native-width)
1115(defalias 'frame-pixel-height 'frame-native-height)
1116
1117(defun frame-inner-width (&optional frame)
1118 "Return inner width of FRAME in pixels.
1119FRAME defaults to the selected frame."
1120 (setq frame (window-normalize-frame frame))
1121 (- (frame-native-width frame)
1122 (* 2 (frame-internal-border-width frame))))
1123
1124(defun frame-inner-height (&optional frame)
1125 "Return inner height of FRAME in pixels.
1126FRAME defaults to the selected frame."
1127 (setq frame (window-normalize-frame frame))
1128 (- (frame-native-height frame)
1129 (* 2 (frame-internal-border-width frame))))
1130
1131(defun frame-outer-width (&optional frame)
1132 "Return outer width of FRAME in pixels.
1133FRAME defaults to the selected frame."
1134 (setq frame (window-normalize-frame frame))
1135 (let ((edges (frame-edges frame 'outer-edges)))
1136 (- (nth 2 edges) (nth 0 edges))))
1137
1138(defun frame-outer-height (&optional frame)
1139 "Return outer height of FRAME in pixels.
1140FRAME defaults to the selected frame."
1141 (setq frame (window-normalize-frame frame))
1142 (let ((edges (frame-edges frame 'outer-edges)))
1143 (- (nth 3 edges) (nth 1 edges))))
1144
1113(declare-function x-list-fonts "xfaces.c" 1145(declare-function x-list-fonts "xfaces.c"
1114 (pattern &optional face frame maximum width)) 1146 (pattern &optional face frame maximum width))
1115 1147
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 2c635ffa500..32324ae3bcb 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -560,8 +560,9 @@ FILE is the file where FUNCTION was probably defined."
560 (setq short rel)))) 560 (setq short rel))))
561 short)) 561 short))
562 562
563;;;###autoload 563(defun help-fns--analyse-function (function)
564(defun describe-function-1 (function) 564 "Return information about FUNCTION.
565Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
565 (let* ((advised (and (symbolp function) 566 (let* ((advised (and (symbolp function)
566 (featurep 'nadvice) 567 (featurep 'nadvice)
567 (advice--p (advice--symbol-function function)))) 568 (advice--p (advice--symbol-function function))))
@@ -594,22 +595,24 @@ FILE is the file where FUNCTION was probably defined."
594 (setq f (symbol-function f))) 595 (setq f (symbol-function f)))
595 f)) 596 f))
596 ((subrp def) (intern (subr-name def))) 597 ((subrp def) (intern (subr-name def)))
597 (t def))) 598 (t def))))
598 (sig-key (if (subrp def) 599 (list real-function def aliased real-def)))
599 (indirect-function real-def) 600
600 real-def)) 601(defun help-fns-function-description-header (function)
601 (file-name (find-lisp-object-file-name function (if aliased 'defun 602 "Print a line describing FUNCTION to `standard-output'."
602 def))) 603 (pcase-let* ((`(,_real-function ,def ,aliased ,real-def)
603 (pt1 (with-current-buffer (help-buffer) (point))) 604 (help-fns--analyse-function function))
604 (beg (if (and (or (byte-code-function-p def) 605 (file-name (find-lisp-object-file-name function (if aliased 'defun
605 (keymapp def) 606 def)))
606 (memq (car-safe def) '(macro lambda closure))) 607 (beg (if (and (or (byte-code-function-p def)
607 (stringp file-name) 608 (keymapp def)
608 (help-fns--autoloaded-p function file-name)) 609 (memq (car-safe def) '(macro lambda closure)))
609 (if (commandp def) 610 (stringp file-name)
610 "an interactive autoloaded " 611 (help-fns--autoloaded-p function file-name))
611 "an autoloaded ") 612 (if (commandp def)
612 (if (commandp def) "an interactive " "a ")))) 613 "an interactive autoloaded "
614 "an autoloaded ")
615 (if (commandp def) "an interactive " "a "))))
613 616
614 ;; Print what kind of function-like object FUNCTION is. 617 ;; Print what kind of function-like object FUNCTION is.
615 (princ (cond ((or (stringp def) (vectorp def)) 618 (princ (cond ((or (stringp def) (vectorp def))
@@ -676,34 +679,42 @@ FILE is the file where FUNCTION was probably defined."
676 (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") 679 (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
677 nil t) 680 nil t)
678 (help-xref-button 1 'help-function-def function file-name)))) 681 (help-xref-button 1 'help-function-def function file-name))))
679 (princ ".") 682 (princ "."))))
680 (with-current-buffer (help-buffer) 683
681 (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) 684;;;###autoload
682 (point))) 685(defun describe-function-1 (function)
683 (terpri)(terpri) 686 (let ((pt1 (with-current-buffer (help-buffer) (point))))
684 687 (help-fns-function-description-header function)
685 (let ((doc-raw (documentation function t)) 688 (with-current-buffer (help-buffer)
686 (key-bindings-buffer (current-buffer))) 689 (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
687 690 (point))))
688 ;; If the function is autoloaded, and its docstring has 691 (terpri)(terpri)
689 ;; key substitution constructs, load the library. 692
690 (and (autoloadp real-def) doc-raw 693 (pcase-let ((`(,real-function ,def ,_aliased ,real-def)
691 help-enable-auto-load 694 (help-fns--analyse-function function))
692 (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) 695 (doc-raw (documentation function t))
693 (autoload-do-load real-def)) 696 (key-bindings-buffer (current-buffer)))
694 697
695 (help-fns--key-bindings function) 698 ;; If the function is autoloaded, and its docstring has
696 (with-current-buffer standard-output 699 ;; key substitution constructs, load the library.
697 (let ((doc (help-fns--signature function doc-raw sig-key 700 (and (autoloadp real-def) doc-raw
698 real-function key-bindings-buffer))) 701 help-enable-auto-load
699 (run-hook-with-args 'help-fns-describe-function-functions function) 702 (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
700 (insert "\n" 703 (autoload-do-load real-def))
701 (or doc "Not documented.")) 704
702 ;; Avoid asking the user annoying questions if she decides 705 (help-fns--key-bindings function)
703 ;; to save the help buffer, when her locale's codeset 706 (with-current-buffer standard-output
704 ;; isn't UTF-8. 707 (let ((doc (help-fns--signature
705 (unless (memq text-quoting-style '(straight grave)) 708 function doc-raw
706 (set-buffer-file-coding-system 'utf-8)))))))) 709 (if (subrp def) (indirect-function real-def) real-def)
710 real-function key-bindings-buffer)))
711 (run-hook-with-args 'help-fns-describe-function-functions function)
712 (insert "\n" (or doc "Not documented.")))
713 ;; Avoid asking the user annoying questions if she decides
714 ;; to save the help buffer, when her locale's codeset
715 ;; isn't UTF-8.
716 (unless (memq text-quoting-style '(straight grave))
717 (set-buffer-file-coding-system 'utf-8)))))
707 718
708;; Add defaults to `help-fns-describe-function-functions'. 719;; Add defaults to `help-fns-describe-function-functions'.
709(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) 720(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
diff --git a/lisp/help.el b/lisp/help.el
index 361ab2a01ee..0fb1c2dab77 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -593,6 +593,39 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
593 string 593 string
594 (format "%s (translated from %s)" string otherstring)))))) 594 (format "%s (translated from %s)" string otherstring))))))
595 595
596(defun help--analyze-key (key untranslated)
597 "Get information about KEY its corresponding UNTRANSLATED events.
598Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)."
599 (if (numberp untranslated)
600 (setq untranslated (this-single-command-raw-keys)))
601 (let* ((event (aref key (if (and (symbolp (aref key 0))
602 (> (length key) 1)
603 (consp (aref key 1)))
604 1
605 0)))
606 (modifiers (event-modifiers event))
607 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
608 (memq 'drag modifiers)) " at that spot" ""))
609 (defn (key-binding key t)))
610 ;; Handle the case where we faked an entry in "Select and Paste" menu.
611 (when (and (eq defn nil)
612 (stringp (aref key (1- (length key))))
613 (eq (key-binding (substring key 0 -1)) 'yank-menu))
614 (setq defn 'menu-bar-select-yank))
615 ;; Don't bother user with strings from (e.g.) the select-paste menu.
616 (when (stringp (aref key (1- (length key))))
617 (aset key (1- (length key)) "(any string)"))
618 (when (and untranslated
619 (stringp (aref untranslated (1- (length untranslated)))))
620 (aset untranslated (1- (length untranslated)) "(any string)"))
621 (list
622 ;; Now describe the key, perhaps as changed.
623 (let ((key-desc (help-key-description key untranslated)))
624 (if (or (null defn) (integerp defn) (equal defn 'undefined))
625 (format "%s%s is undefined" key-desc mouse-msg)
626 (format "%s%s runs the command %S" key-desc mouse-msg defn)))
627 defn event mouse-msg)))
628
596(defun describe-key-briefly (&optional key insert untranslated) 629(defun describe-key-briefly (&optional key insert untranslated)
597 "Print the name of the function KEY invokes. KEY is a string. 630 "Print the name of the function KEY invokes. KEY is a string.
598If INSERT (the prefix arg) is non-nil, insert the message in the buffer. 631If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
@@ -603,73 +636,12 @@ the last key hit are used.
603If KEY is a menu item or a tool-bar button that is disabled, this command 636If KEY is a menu item or a tool-bar button that is disabled, this command
604temporarily enables it to allow getting help on disabled items and buttons." 637temporarily enables it to allow getting help on disabled items and buttons."
605 (interactive 638 (interactive
606 (let ((enable-disabled-menus-and-buttons t) 639 ;; Ignore mouse movement events because it's too easy to miss the
607 (cursor-in-echo-area t) 640 ;; message while moving the mouse.
608 saved-yank-menu) 641 (pcase-let ((`(,key ,_up-event) (help-read-key-sequence 'no-mouse-movement)))
609 (unwind-protect 642 `(,key ,current-prefix-arg 1)))
610 (let (key) 643 (princ (car (help--analyze-key key untranslated))
611 ;; If yank-menu is empty, populate it temporarily, so that 644 (if insert (current-buffer) standard-output)))
612 ;; "Select and Paste" menu can generate a complete event.
613 (when (null (cdr yank-menu))
614 (setq saved-yank-menu (copy-sequence yank-menu))
615 (menu-bar-update-yank-menu "(any string)" nil))
616 (while
617 (progn
618 (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: "))
619 (and (vectorp key)
620 (consp (aref key 0))
621 (symbolp (car (aref key 0)))
622 (string-match "\\(mouse\\|down\\|click\\|drag\\)"
623 (symbol-name (car (aref key 0))))
624 (not (sit-for (/ double-click-time 1000.0) t)))))
625 ;; Clear the echo area message (Bug#7014).
626 (message nil)
627 ;; If KEY is a down-event, read and discard the
628 ;; corresponding up-event. Note that there are also
629 ;; down-events on scroll bars and mode lines: the actual
630 ;; event then is in the second element of the vector.
631 (and (vectorp key)
632 (let ((last-idx (1- (length key))))
633 (and (eventp (aref key last-idx))
634 (memq 'down (event-modifiers (aref key last-idx)))))
635 (read-event))
636 (list
637 key
638 (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
639 1))
640 ;; Put yank-menu back as it was, if we changed it.
641 (when saved-yank-menu
642 (setq yank-menu (copy-sequence saved-yank-menu))
643 (fset 'yank-menu (cons 'keymap yank-menu))))))
644 (if (numberp untranslated)
645 (setq untranslated (this-single-command-raw-keys)))
646 (let* ((event (if (and (symbolp (aref key 0))
647 (> (length key) 1)
648 (consp (aref key 1)))
649 (aref key 1)
650 (aref key 0)))
651 (modifiers (event-modifiers event))
652 (standard-output (if insert (current-buffer) standard-output))
653 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
654 (memq 'drag modifiers)) " at that spot" ""))
655 (defn (key-binding key t))
656 key-desc)
657 ;; Handle the case where we faked an entry in "Select and Paste" menu.
658 (if (and (eq defn nil)
659 (stringp (aref key (1- (length key))))
660 (eq (key-binding (substring key 0 -1)) 'yank-menu))
661 (setq defn 'menu-bar-select-yank))
662 ;; Don't bother user with strings from (e.g.) the select-paste menu.
663 (if (stringp (aref key (1- (length key))))
664 (aset key (1- (length key)) "(any string)"))
665 (if (and (> (length untranslated) 0)
666 (stringp (aref untranslated (1- (length untranslated)))))
667 (aset untranslated (1- (length untranslated)) "(any string)"))
668 ;; Now describe the key, perhaps as changed.
669 (setq key-desc (help-key-description key untranslated))
670 (if (or (null defn) (integerp defn) (equal defn 'undefined))
671 (princ (format "%s%s is undefined" key-desc mouse-msg))
672 (princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
673 645
674(defun help--key-binding-keymap (key &optional accept-default no-remap position) 646(defun help--key-binding-keymap (key &optional accept-default no-remap position)
675 "Return a keymap holding a binding for KEY within current keymaps. 647 "Return a keymap holding a binding for KEY within current keymaps.
@@ -734,6 +706,59 @@ function `key-binding'."
734 (throw 'found x)))) 706 (throw 'found x))))
735 nil))))) 707 nil)))))
736 708
709(defun help-read-key-sequence (&optional no-mouse-movement)
710 "Reads a key sequence from the user.
711Returns a list of the form (KEY UP-EVENT), where KEY is the key
712sequence, and UP-EVENT is the up-event that was discarded by
713reading KEY, or nil.
714If NO-MOUSE-MOVEMENT is non-nil, ignore key sequences starting
715with `mouse-movement' events."
716 (let ((enable-disabled-menus-and-buttons t)
717 (cursor-in-echo-area t)
718 saved-yank-menu)
719 (unwind-protect
720 (let (key)
721 ;; If yank-menu is empty, populate it temporarily, so that
722 ;; "Select and Paste" menu can generate a complete event.
723 (when (null (cdr yank-menu))
724 (setq saved-yank-menu (copy-sequence yank-menu))
725 (menu-bar-update-yank-menu "(any string)" nil))
726 (while
727 (pcase (setq key (read-key-sequence "\
728Describe the following key, mouse click, or menu item: "))
729 ((and (pred vectorp) (let `(,key0 . ,_) (aref key 0))
730 (guard (symbolp key0)) (let keyname (symbol-name key0)))
731 (if no-mouse-movement
732 (string-match "mouse-movement" keyname)
733 (and (string-match "\\(mouse\\|down\\|click\\|drag\\)"
734 keyname)
735 (not (sit-for (/ double-click-time 1000.0) t)))))))
736 (list
737 key
738 ;; If KEY is a down-event, read and include the
739 ;; corresponding up-event. Note that there are also
740 ;; down-events on scroll bars and mode lines: the actual
741 ;; event then is in the second element of the vector.
742 (and (vectorp key)
743 (let ((last-idx (1- (length key))))
744 (and (eventp (aref key last-idx))
745 (memq 'down (event-modifiers (aref key last-idx)))))
746 (or (and (eventp (aref key 0))
747 (memq 'down (event-modifiers (aref key 0)))
748 ;; However, for the C-down-mouse-2 popup
749 ;; menu, there is no subsequent up-event. In
750 ;; this case, the up-event is the next
751 ;; element in the supplied vector.
752 (= (length key) 1))
753 (and (> (length key) 1)
754 (eventp (aref key 1))
755 (memq 'down (event-modifiers (aref key 1)))))
756 (read-event))))
757 ;; Put yank-menu back as it was, if we changed it.
758 (when saved-yank-menu
759 (setq yank-menu (copy-sequence saved-yank-menu))
760 (fset 'yank-menu (cons 'keymap yank-menu))))))
761
737(defun describe-key (&optional key untranslated up-event) 762(defun describe-key (&optional key untranslated up-event)
738 "Display documentation of the function invoked by KEY. 763 "Display documentation of the function invoked by KEY.
739KEY can be any kind of a key sequence; it can include keyboard events, 764KEY can be any kind of a key sequence; it can include keyboard events,
@@ -748,83 +773,20 @@ UP-EVENT is the up-event that was discarded by reading KEY, or nil.
748If KEY is a menu item or a tool-bar button that is disabled, this command 773If KEY is a menu item or a tool-bar button that is disabled, this command
749temporarily enables it to allow getting help on disabled items and buttons." 774temporarily enables it to allow getting help on disabled items and buttons."
750 (interactive 775 (interactive
751 (let ((enable-disabled-menus-and-buttons t) 776 (pcase-let ((`(,key ,up-event) (help-read-key-sequence)))
752 (cursor-in-echo-area t) 777 `(,key ,(prefix-numeric-value current-prefix-arg) ,up-event)))
753 saved-yank-menu) 778 (pcase-let ((`(,brief-desc ,defn ,event ,mouse-msg)
754 (unwind-protect 779 (help--analyze-key key untranslated))
755 (let (key) 780 (defn-up nil) (defn-up-tricky nil)
756 ;; If yank-menu is empty, populate it temporarily, so that 781 (key-locus-up nil) (key-locus-up-tricky nil)
757 ;; "Select and Paste" menu can generate a complete event. 782 (mouse-1-remapped nil) (mouse-1-tricky nil)
758 (when (null (cdr yank-menu)) 783 (ev-type nil))
759 (setq saved-yank-menu (copy-sequence yank-menu)) 784 (if (or (null defn)
760 (menu-bar-update-yank-menu "(any string)" nil)) 785 (integerp defn)
761 (while 786 (equal defn 'undefined))
762 (progn 787 (message "%s" brief-desc)
763 (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: "))
764 (and (vectorp key)
765 (consp (aref key 0))
766 (symbolp (car (aref key 0)))
767 (string-match "\\(mouse\\|down\\|click\\|drag\\)"
768 (symbol-name (car (aref key 0))))
769 (not (sit-for (/ double-click-time 1000.0) t)))))
770 (list
771 key
772 (prefix-numeric-value current-prefix-arg)
773 ;; If KEY is a down-event, read and include the
774 ;; corresponding up-event. Note that there are also
775 ;; down-events on scroll bars and mode lines: the actual
776 ;; event then is in the second element of the vector.
777 (and (vectorp key)
778 (let ((last-idx (1- (length key))))
779 (and (eventp (aref key last-idx))
780 (memq 'down (event-modifiers (aref key last-idx)))))
781 (or (and (eventp (aref key 0))
782 (memq 'down (event-modifiers (aref key 0)))
783 ;; However, for the C-down-mouse-2 popup
784 ;; menu, there is no subsequent up-event. In
785 ;; this case, the up-event is the next
786 ;; element in the supplied vector.
787 (= (length key) 1))
788 (and (> (length key) 1)
789 (eventp (aref key 1))
790 (memq 'down (event-modifiers (aref key 1)))))
791 (read-event))))
792 ;; Put yank-menu back as it was, if we changed it.
793 (when saved-yank-menu
794 (setq yank-menu (copy-sequence saved-yank-menu))
795 (fset 'yank-menu (cons 'keymap yank-menu))))))
796 (if (numberp untranslated)
797 (setq untranslated (this-single-command-raw-keys)))
798 (let* ((event (aref key (if (and (symbolp (aref key 0))
799 (> (length key) 1)
800 (consp (aref key 1)))
801 1
802 0)))
803 (modifiers (event-modifiers event))
804 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
805 (memq 'drag modifiers)) " at that spot" ""))
806 (defn (key-binding key t))
807 key-locus key-locus-up key-locus-up-tricky
808 defn-up defn-up-tricky ev-type
809 mouse-1-remapped mouse-1-tricky)
810
811 ;; Handle the case where we faked an entry in "Select and Paste" menu.
812 (when (and (eq defn nil)
813 (stringp (aref key (1- (length key))))
814 (eq (key-binding (substring key 0 -1)) 'yank-menu))
815 (setq defn 'menu-bar-select-yank))
816 (if (or (null defn) (integerp defn) (equal defn 'undefined))
817 (message "%s%s is undefined"
818 (help-key-description key untranslated) mouse-msg)
819 (help-setup-xref (list #'describe-function defn) 788 (help-setup-xref (list #'describe-function defn)
820 (called-interactively-p 'interactive)) 789 (called-interactively-p 'interactive))
821 ;; Don't bother user with strings from (e.g.) the select-paste menu.
822 (when (stringp (aref key (1- (length key))))
823 (aset key (1- (length key)) "(any string)"))
824 (when (and untranslated
825 (stringp (aref untranslated (1- (length untranslated)))))
826 (aset untranslated (1- (length untranslated))
827 "(any string)"))
828 ;; Need to do this before erasing *Help* buffer in case event 790 ;; Need to do this before erasing *Help* buffer in case event
829 ;; is a mouse click in an existing *Help* buffer. 791 ;; is a mouse click in an existing *Help* buffer.
830 (when up-event 792 (when up-event
@@ -849,13 +811,12 @@ temporarily enables it to allow getting help on disabled items and buttons."
849 (aset sequence 0 'mouse-1) 811 (aset sequence 0 'mouse-1)
850 (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))) 812 (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))
851 (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event)))))) 813 (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event))))))
852 (setq key-locus (help--binding-locus key (event-start event)))
853 (with-help-window (help-buffer) 814 (with-help-window (help-buffer)
854 (princ (help-key-description key untranslated)) 815 (princ brief-desc)
855 (princ (format "%s runs the command %S%s, which is " 816 (let ((key-locus (help--binding-locus key (event-start event))))
856 mouse-msg defn (if key-locus 817 (when key-locus
857 (format " (found in %s)" key-locus) 818 (princ (format " (found in %s)" key-locus))))
858 ""))) 819 (princ ", which is ")
859 (describe-function-1 defn) 820 (describe-function-1 defn)
860 (when up-event 821 (when up-event
861 (unless (or (null defn-up) 822 (unless (or (null defn-up)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index ae28ba93e61..dababdb4fa6 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -4952,7 +4952,7 @@ call other entry points instead, such as `cl-prin1'.
4952 4952
4953\(fn OBJECT)" nil nil) 4953\(fn OBJECT)" nil nil)
4954 4954
4955(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-"))) 4955(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code")))
4956 4956
4957;;;*** 4957;;;***
4958 4958
@@ -16544,18 +16544,6 @@ The optional LABEL is used to label the buffer created.
16544 16544
16545;;;*** 16545;;;***
16546 16546
16547;;;### (autoloads nil "html2text" "net/html2text.el" (0 0 0 0))
16548;;; Generated autoloads from net/html2text.el
16549
16550(autoload 'html2text "html2text" "\
16551Convert HTML to plain text in the current buffer.
16552
16553\(fn)" t nil)
16554
16555(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "html2text" '("html2text-")))
16556
16557;;;***
16558
16559;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0)) 16547;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0))
16560;;; Generated autoloads from htmlfontify.el 16548;;; Generated autoloads from htmlfontify.el
16561(push (purecopy '(htmlfontify 0 21)) package--builtin-versions) 16549(push (purecopy '(htmlfontify 0 21)) package--builtin-versions)
@@ -30399,7 +30387,7 @@ then `snmpv2-mode-hook'.
30399 30387
30400;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) 30388;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0))
30401;;; Generated autoloads from net/soap-client.el 30389;;; Generated autoloads from net/soap-client.el
30402(push (purecopy '(soap-client 3 1 2)) package--builtin-versions) 30390(push (purecopy '(soap-client 3 1 3)) package--builtin-versions)
30403 30391
30404(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-"))) 30392(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-")))
30405 30393
@@ -34165,7 +34153,7 @@ Reenable Ange-FTP, when Tramp is unloaded.
34165 34153
34166;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) 34154;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
34167;;; Generated autoloads from net/trampver.el 34155;;; Generated autoloads from net/trampver.el
34168(push (purecopy '(tramp 2 3 2 -1)) package--builtin-versions) 34156(push (purecopy '(tramp 2 3 2)) package--builtin-versions)
34169 34157
34170(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) 34158(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-")))
34171 34159
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index c3480cd6c64..e5b1029c01f 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -746,7 +746,7 @@ If the current buffer is not a minibuffer, erase its entire contents."
746 746
747(defcustom completion-auto-help t 747(defcustom completion-auto-help t
748 "Non-nil means automatically provide help for invalid completion input. 748 "Non-nil means automatically provide help for invalid completion input.
749If the value is t the *Completion* buffer is displayed whenever completion 749If the value is t the *Completions* buffer is displayed whenever completion
750is requested but cannot be done. 750is requested but cannot be done.
751If the value is `lazy', the *Completions* buffer is only displayed after 751If the value is `lazy', the *Completions* buffer is only displayed after
752the second failed attempt to complete." 752the second failed attempt to complete."
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 9b6b169e568..e0794435d7a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -380,7 +380,7 @@ This command must be bound to a mouse click."
380 380
381(defun mouse-drag-line (start-event line) 381(defun mouse-drag-line (start-event line)
382 "Drag a mode line, header line, or vertical line with the mouse. 382 "Drag a mode line, header line, or vertical line with the mouse.
383START-EVENT is the starting mouse-event of the drag action. LINE 383START-EVENT is the starting mouse event of the drag action. LINE
384must be one of the symbols `header', `mode', or `vertical'." 384must be one of the symbols `header', `mode', or `vertical'."
385 ;; Give temporary modes such as isearch a chance to turn off. 385 ;; Give temporary modes such as isearch a chance to turn off.
386 (run-hooks 'mouse-leave-buffer-hook) 386 (run-hooks 'mouse-leave-buffer-hook)
@@ -405,29 +405,15 @@ must be one of the symbols `header', `mode', or `vertical'."
405 ;; window's edge we drag. 405 ;; window's edge we drag.
406 (cond 406 (cond
407 ((eq line 'header) 407 ((eq line 'header)
408 (if (window-at-side-p window 'top) 408 ;; Drag bottom edge of window above the header line.
409 ;; We can't drag the header line of a topmost window. 409 (setq window (window-in-direction 'above window t)))
410 (setq draggable nil) 410 ((eq line 'mode))
411 ;; Drag bottom edge of window above the header line.
412 (setq window (window-in-direction 'above window t))))
413 ((eq line 'mode)
414 (if (and (window-at-side-p window 'bottom)
415 ;; Allow resizing the minibuffer window if it's on the
416 ;; same frame as and immediately below `window', and it's
417 ;; either active or `resize-mini-windows' is nil.
418 (let ((minibuffer-window (minibuffer-window frame)))
419 (not (and (eq (window-frame minibuffer-window) frame)
420 (or (not resize-mini-windows)
421 (eq minibuffer-window
422 (active-minibuffer-window)))))))
423 (setq draggable nil)))
424 ((eq line 'vertical) 411 ((eq line 'vertical)
425 (let ((divider-width (frame-right-divider-width frame))) 412 (let ((divider-width (frame-right-divider-width frame)))
426 (when (and (or (not (numberp divider-width)) 413 (when (and (or (not (numberp divider-width))
427 (zerop divider-width)) 414 (zerop divider-width))
428 (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) 415 (eq (frame-parameter frame 'vertical-scroll-bars) 'left))
429 (setq window (window-in-direction 'left window t)))))) 416 (setq window (window-in-direction 'left window t))))))
430
431 (let* ((exitfun nil) 417 (let* ((exitfun nil)
432 (move 418 (move
433 (lambda (event) (interactive "e") 419 (lambda (event) (interactive "e")
@@ -530,20 +516,405 @@ must be one of the symbols `header', `mode', or `vertical'."
530 t (lambda () (setq track-mouse old-track-mouse))))))) 516 t (lambda () (setq track-mouse old-track-mouse)))))))
531 517
532(defun mouse-drag-mode-line (start-event) 518(defun mouse-drag-mode-line (start-event)
533 "Change the height of a window by dragging on the mode line." 519 "Change the height of a window by dragging on its mode line.
520START-EVENT is the starting mouse event of the drag action.
521
522If the drag happens in a mode line on the bottom of a frame and
523that frame's `drag-with-mode-line' parameter is non-nil, drag the
524frame instead."
534 (interactive "e") 525 (interactive "e")
535 (mouse-drag-line start-event 'mode)) 526 (let* ((start (event-start start-event))
527 (window (posn-window start))
528 (frame (window-frame window)))
529 (cond
530 ((not (window-live-p window)))
531 ((or (not (window-at-side-p window 'bottom))
532 ;; Allow resizing the minibuffer window if it's on the
533 ;; same frame as and immediately below `window', and it's
534 ;; either active or `resize-mini-windows' is nil.
535 (let ((minibuffer-window (minibuffer-window frame)))
536 (and (eq (window-frame minibuffer-window) frame)
537 (or (not resize-mini-windows)
538 (eq minibuffer-window
539 (active-minibuffer-window))))))
540 (mouse-drag-line start-event 'mode))
541 ((and (frame-parameter frame 'drag-with-mode-line)
542 (window-at-side-p window 'bottom)
543 (let ((minibuffer-window (minibuffer-window frame)))
544 (not (eq (window-frame minibuffer-window) frame))))
545 ;; Drag frame when the window is on the bottom of its frame and
546 ;; there is no minibuffer window below.
547 (mouse-drag-frame start-event 'move)))))
536 548
537(defun mouse-drag-header-line (start-event) 549(defun mouse-drag-header-line (start-event)
538 "Change the height of a window by dragging on the header line." 550 "Change the height of a window by dragging on its header line.
551START-EVENT is the starting mouse event of the drag action.
552
553If the drag happens in a header line on the top of a frame and
554that frame's `drag-with-header-line' parameter is non-nil, drag
555the frame instead."
539 (interactive "e") 556 (interactive "e")
540 (mouse-drag-line start-event 'header)) 557 (let* ((start (event-start start-event))
558 (window (posn-window start)))
559 (if (and (window-live-p window)
560 (not (window-at-side-p window 'top)))
561 (mouse-drag-line start-event 'header)
562 (let ((frame (window-frame window)))
563 (when (frame-parameter frame 'drag-with-header-line)
564 (mouse-drag-frame start-event 'move))))))
541 565
542(defun mouse-drag-vertical-line (start-event) 566(defun mouse-drag-vertical-line (start-event)
543 "Change the width of a window by dragging on the vertical line." 567 "Change the width of a window by dragging on a vertical line.
568START-EVENT is the starting mouse event of the drag action."
544 (interactive "e") 569 (interactive "e")
545 (mouse-drag-line start-event 'vertical)) 570 (mouse-drag-line start-event 'vertical))
546 571
572(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
573 "Helper function for `mouse-drag-frame'."
574 (let* ((frame-x-y (frame-position frame))
575 (frame-x (car frame-x-y))
576 (frame-y (cdr frame-x-y))
577 alist)
578 (if (> x-diff 0)
579 (when x-move
580 (setq x-diff (min x-diff frame-x))
581 (setq x-move (- frame-x x-diff)))
582 (let* ((min-width (frame-windows-min-size frame t nil t))
583 (min-diff (max 0 (- (frame-inner-width frame) min-width))))
584 (setq x-diff (max x-diff (- min-diff)))
585 (when x-move
586 (setq x-move (+ frame-x (- x-diff))))))
587
588 (if (> y-diff 0)
589 (when y-move
590 (setq y-diff (min y-diff frame-y))
591 (setq y-move (- frame-y y-diff)))
592 (let* ((min-height (frame-windows-min-size frame nil nil t))
593 (min-diff (max 0 (- (frame-inner-height frame) min-height))))
594 (setq y-diff (max y-diff (- min-diff)))
595 (when y-move
596 (setq y-move (+ frame-y (- y-diff))))))
597
598 (unless (zerop x-diff)
599 (when x-move
600 (push `(left . ,x-move) alist))
601 (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
602 alist))
603 (unless (zerop y-diff)
604 (when y-move
605 (push `(top . ,y-move) alist))
606 (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
607 alist))
608 (when alist
609 (modify-frame-parameters frame alist))))
610
611(defun mouse-drag-frame (start-event part)
612 "Drag a frame or one of its edges with the mouse.
613START-EVENT is the starting mouse event of the drag action. Its
614position window denotes the frame that will be dragged.
615
616PART specifies the part that has been dragged and must be one of
617the symbols 'left', 'top', 'right', 'bottom', 'top-left',
618'top-right', 'bottom-left', 'bottom-right' to drag an internal
619border or edge. If PART equals 'move', this means to move the
620frame with the mouse."
621 ;; Give temporary modes such as isearch a chance to turn off.
622 (run-hooks 'mouse-leave-buffer-hook)
623 (let* ((echo-keystrokes 0)
624 (start (event-start start-event))
625 (window (posn-window start))
626 ;; FRAME is the frame to drag.
627 (frame (if (window-live-p window)
628 (window-frame window)
629 window))
630 (width (frame-native-width frame))
631 (height (frame-native-height frame))
632 ;; PARENT is the parent frame of FRAME or, if FRAME is a
633 ;; top-level frame, FRAME's workarea.
634 (parent (frame-parent frame))
635 (parent-edges
636 (if parent
637 `(0 0 ,(frame-native-width parent) ,(frame-native-height parent))
638 (let* ((attributes
639 (car (display-monitor-attributes-list)))
640 (workarea (assq 'workarea attributes)))
641 (and workarea
642 `(,(nth 1 workarea) ,(nth 2 workarea)
643 ,(+ (nth 1 workarea) (nth 3 workarea))
644 ,(+ (nth 2 workarea) (nth 4 workarea)))))))
645 (parent-left (and parent-edges (nth 0 parent-edges)))
646 (parent-top (and parent-edges (nth 1 parent-edges)))
647 (parent-right (and parent-edges (nth 2 parent-edges)))
648 (parent-bottom (and parent-edges (nth 3 parent-edges)))
649 ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
650 ;; last sampled mouse position. Note that we sample absolute
651 ;; mouse positions to avoid that moving the mouse from one
652 ;; frame into another gets into our way. `last-x' and `last-y'
653 ;; records the x- and y-coordinates of the previously sampled
654 ;; position. The differences between `last-x' and `pos-x' as
655 ;; well as `last-y' and `pos-y' determine the amount the mouse
656 ;; has been dragged between the last two samples.
657 pos-x-y pos-x pos-y
658 (last-x-y (mouse-absolute-pixel-position))
659 (last-x (car last-x-y))
660 (last-y (cdr last-x-y))
661 ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
662 ;; mouse position when FRAME snapped. As soon as the
663 ;; difference between `pos-x' and `snap-x' (or `pos-y' and
664 ;; `snap-y') exceeds the value of FRAME's `snap-width'
665 ;; parameter, unsnap FRAME (at the respective side). `snap-x'
666 ;; and `snap-y' nil mean FRAME is curerntly not snapped.
667 snap-x snap-y
668 (exitfun nil)
669 (move
670 (lambda (event)
671 (interactive "e")
672 (when (consp event)
673 (setq pos-x-y (mouse-absolute-pixel-position))
674 (setq pos-x (car pos-x-y))
675 (setq pos-y (cdr pos-x-y))
676 (cond
677 ((eq part 'left)
678 (mouse-resize-frame frame (- last-x pos-x) 0 t))
679 ((eq part 'top)
680 (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
681 ((eq part 'right)
682 (mouse-resize-frame frame (- pos-x last-x) 0))
683 ((eq part 'bottom)
684 (mouse-resize-frame frame 0 (- pos-y last-y)))
685 ((eq part 'top-left)
686 (mouse-resize-frame
687 frame (- last-x pos-x) (- last-y pos-y) t t))
688 ((eq part 'top-right)
689 (mouse-resize-frame
690 frame (- pos-x last-x) (- last-y pos-y) nil t))
691 ((eq part 'bottom-left)
692 (mouse-resize-frame
693 frame (- last-x pos-x) (- pos-y last-y) t))
694 ((eq part 'bottom-right)
695 (mouse-resize-frame
696 frame (- pos-x last-x) (- pos-y last-y)))
697 ((eq part 'move)
698 (let* ((old-position (frame-position frame))
699 (old-left (car old-position))
700 (old-top (cdr old-position))
701 (left (+ old-left (- pos-x last-x)))
702 (top (+ old-top (- pos-y last-y)))
703 right bottom
704 ;; `snap-width' (maybe also a yet to be provided
705 ;; `snap-height') could become floats to handle
706 ;; proportionality wrt PARENT. We don't do any
707 ;; checks on this parameter so far.
708 (snap-width (frame-parameter frame 'snap-width)))
709 ;; Docking and constraining.
710 (when (and (numberp snap-width) parent-edges)
711 (cond
712 ;; Docking at the left parent edge.
713 ((< pos-x last-x)
714 (cond
715 ((and (> left parent-left)
716 (<= (- left parent-left) snap-width))
717 ;; Snap when the mouse moved leftward and
718 ;; FRAME's left edge would end up within
719 ;; `snap-width' pixels from PARENT's left edge.
720 (setq snap-x pos-x)
721 (setq left parent-left))
722 ((and (<= left parent-left)
723 (<= (- parent-left left) snap-width)
724 snap-x (<= (- snap-x pos-x) snap-width))
725 ;; Stay snapped when the mouse moved leftward
726 ;; but not more than `snap-width' pixels from
727 ;; the time FRAME snapped.
728 (setq left parent-left))
729 (t
730 ;; Unsnap when the mouse moved more than
731 ;; `snap-width' pixels leftward from the time
732 ;; FRAME snapped.
733 (setq snap-x nil))))
734 ((> pos-x last-x)
735 (setq right (+ left width))
736 (cond
737 ((and (< right parent-right)
738 (<= (- parent-right right) snap-width))
739 ;; Snap when the mouse moved rightward and
740 ;; FRAME's right edge would end up within
741 ;; `snap-width' pixels from PARENT's right edge.
742 (setq snap-x pos-x)
743 (setq left (- parent-right width)))
744 ((and (>= right parent-right)
745 (<= (- right parent-right) snap-width)
746 snap-x (<= (- pos-x snap-x) snap-width))
747 ;; Stay snapped when the mouse moved rightward
748 ;; but not more more than `snap-width' pixels
749 ;; from the time FRAME snapped.
750 (setq left (- parent-right width)))
751 (t
752 ;; Unsnap when the mouse moved rightward more
753 ;; than `snap-width' pixels from the time FRAME
754 ;; snapped.
755 (setq snap-x nil)))))
756
757 (cond
758 ((< pos-y last-y)
759 (cond
760 ((and (> top parent-top)
761 (<= (- top parent-top) snap-width))
762 ;; Snap when the mouse moved upward and FRAME's
763 ;; top edge would end up within `snap-width'
764 ;; pixels from PARENT's top edge.
765 (setq snap-y pos-y)
766 (setq top parent-top))
767 ((and (<= top parent-top)
768 (<= (- parent-top top) snap-width)
769 snap-y (<= (- snap-y pos-y) snap-width))
770 ;; Stay snapped when the mouse moved upward but
771 ;; not more more than `snap-width' pixels from
772 ;; the time FRAME snapped.
773 (setq top parent-top))
774 (t
775 ;; Unsnap when the mouse moved upward more than
776 ;; `snap-width' pixels from the time FRAME
777 ;; snapped.
778 (setq snap-y nil))))
779 ((> pos-y last-y)
780 (setq bottom (+ top height))
781 (cond
782 ((and (< bottom parent-bottom)
783 (<= (- parent-bottom bottom) snap-width))
784 ;; Snap when the mouse moved downward and
785 ;; FRAME's bottom edge would end up within
786 ;; `snap-width' pixels from PARENT's bottom
787 ;; edge.
788 (setq snap-y pos-y)
789 (setq top (- parent-bottom height)))
790 ((and (>= bottom parent-bottom)
791 (<= (- bottom parent-bottom) snap-width)
792 snap-y (<= (- pos-y snap-y) snap-width))
793 ;; Stay snapped when the mouse moved downward
794 ;; but not more more than `snap-width' pixels
795 ;; from the time FRAME snapped.
796 (setq top (- parent-bottom height)))
797 (t
798 ;; Unsnap when the mouse moved downward more
799 ;; than `snap-width' pixels from the time FRAME
800 ;; snapped.
801 (setq snap-y nil))))))
802
803 ;; If requested, constrain FRAME's draggable areas to
804 ;; PARENT's edges. The `top-visible' parameter should
805 ;; be set when FRAME has a draggable header-line. If
806 ;; set to a number, it ascertains that the top of
807 ;; FRAME is always constrained to the top of PARENT
808 ;; and that at least as many pixels of FRAME as
809 ;; specified by that number are visible on each of the
810 ;; three remaining sides of PARENT.
811 ;;
812 ;; The `bottom-visible' parameter should be set when
813 ;; FRAME has a draggable mode-line. If set to a
814 ;; number, it ascertains that the bottom of FRAME is
815 ;; always constrained to the bottom of PARENT and that
816 ;; at least as many pixels of FRAME as specified by
817 ;; that number are visible on each of the three
818 ;; remaining sides of PARENT.
819 (let ((par (frame-parameter frame 'top-visible))
820 bottom-visible)
821 (unless par
822 (setq par (frame-parameter frame 'bottom-visible))
823 (setq bottom-visible t))
824 (when (and (numberp par) parent-edges)
825 (setq left
826 (max (min (- parent-right par) left)
827 (+ (- parent-left width) par)))
828 (setq top
829 (if bottom-visible
830 (min (max top (- parent-top (- height par)))
831 (- parent-bottom height))
832 (min (max top parent-top)
833 (- parent-bottom par))))))
834
835 ;; Use `modify-frame-parameters' since `left' and
836 ;; `top' may want to move FRAME out of its PARENT.
837 (modify-frame-parameters
838 frame
839 `((left . (+ ,left)) (top . (+ ,top)))))))
840 (setq last-x pos-x)
841 (setq last-y pos-y))))
842 (old-track-mouse track-mouse))
843 ;; Start tracking. The special value 'dragging' signals the
844 ;; display engine to freeze the mouse pointer shape for as long
845 ;; as we drag.
846 (setq track-mouse 'dragging)
847 ;; Loop reading events and sampling the position of the mouse.
848 (setq exitfun
849 (set-transient-map
850 (let ((map (make-sparse-keymap)))
851 (define-key map [switch-frame] #'ignore)
852 (define-key map [select-window] #'ignore)
853 (define-key map [scroll-bar-movement] #'ignore)
854 (define-key map [mouse-movement] move)
855 ;; Swallow drag-mouse-1 events to avoid selecting some other window.
856 (define-key map [drag-mouse-1]
857 (lambda () (interactive) (funcall exitfun)))
858 ;; Some of the events will of course end up looked up
859 ;; with a mode-line, header-line or vertical-line prefix ...
860 (define-key map [mode-line] map)
861 (define-key map [header-line] map)
862 (define-key map [vertical-line] map)
863 ;; ... and some maybe even with a right- or bottom-divider
864 ;; prefix.
865 (define-key map [right-divider] map)
866 (define-key map [bottom-divider] map)
867 map)
868 t (lambda () (setq track-mouse old-track-mouse))))))
869
870(defun mouse-drag-left-edge (start-event)
871 "Drag left edge of a frame with the mouse.
872START-EVENT is the starting mouse event of the drag action."
873 (interactive "e")
874 (mouse-drag-frame start-event 'left))
875
876(defun mouse-drag-top-left-corner (start-event)
877 "Drag top left corner of a frame with the mouse.
878START-EVENT is the starting mouse event of the drag action."
879 (interactive "e")
880 (mouse-drag-frame start-event 'top-left))
881
882(defun mouse-drag-top-edge (start-event)
883 "Drag top edge of a frame with the mouse.
884START-EVENT is the starting mouse event of the drag action."
885 (interactive "e")
886 (mouse-drag-frame start-event 'top))
887
888(defun mouse-drag-top-right-corner (start-event)
889 "Drag top right corner of a frame with the mouse.
890START-EVENT is the starting mouse event of the drag action."
891 (interactive "e")
892 (mouse-drag-frame start-event 'top-right))
893
894(defun mouse-drag-right-edge (start-event)
895 "Drag right edge of a frame with the mouse.
896START-EVENT is the starting mouse event of the drag action."
897 (interactive "e")
898 (mouse-drag-frame start-event 'right))
899
900(defun mouse-drag-bottom-right-corner (start-event)
901 "Drag bottom right corner of a frame with the mouse.
902START-EVENT is the starting mouse event of the drag action."
903 (interactive "e")
904 (mouse-drag-frame start-event 'bottom-right))
905
906(defun mouse-drag-bottom-edge (start-event)
907 "Drag bottom edge of a frame with the mouse.
908START-EVENT is the starting mouse event of the drag action."
909 (interactive "e")
910 (mouse-drag-frame start-event 'bottom))
911
912(defun mouse-drag-bottom-left-corner (start-event)
913 "Drag bottom left corner of a frame with the mouse.
914START-EVENT is the starting mouse event of the drag action."
915 (interactive "e")
916 (mouse-drag-frame start-event 'bottom-left))
917
547(defcustom mouse-select-region-move-to-beginning nil 918(defcustom mouse-select-region-move-to-beginning nil
548 "Effect of selecting a region extending backward from double click. 919 "Effect of selecting a region extending backward from double click.
549Nil means keep point at the position clicked (region end); 920Nil means keep point at the position clicked (region end);
@@ -2078,6 +2449,22 @@ is copied instead of being cut."
2078(global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line) 2449(global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
2079(global-set-key [bottom-divider mouse-1] 'ignore) 2450(global-set-key [bottom-divider mouse-1] 'ignore)
2080(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally) 2451(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
2452(global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge)
2453(global-set-key [left-edge mouse-1] 'ignore)
2454(global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner)
2455(global-set-key [top-left-corner mouse-1] 'ignore)
2456(global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge)
2457(global-set-key [top-edge mouse-1] 'ignore)
2458(global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner)
2459(global-set-key [top-right-corner mouse-1] 'ignore)
2460(global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge)
2461(global-set-key [right-edge mouse-1] 'ignore)
2462(global-set-key [bottom-right-corner down-mouse-1] 'mouse-drag-bottom-right-corner)
2463(global-set-key [bottom-right-corner mouse-1] 'ignore)
2464(global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge)
2465(global-set-key [bottom-edge mouse-1] 'ignore)
2466(global-set-key [bottom-left-corner down-mouse-1] 'mouse-drag-bottom-left-corner)
2467(global-set-key [bottom-left-corner mouse-1] 'ignore)
2081 2468
2082(provide 'mouse) 2469(provide 'mouse)
2083 2470
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index fe316579142..2fc36e180ee 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -312,11 +312,19 @@ word(s) will be searched for via `eww-search-prefix'."
312 (expand-file-name file)))) 312 (expand-file-name file))))
313 313
314;;;###autoload 314;;;###autoload
315(defun eww-search-words (&optional beg end) 315(defun eww-search-words ()
316 "Search the web for the text between BEG and END. 316 "Search the web for the text between BEG and END.
317See the `eww-search-prefix' variable for the search engine used." 317If region is active (and not whitespace), search the web for
318 (interactive "r") 318the text between BEG and END. Else, prompt the user for a search
319 (eww (buffer-substring beg end))) 319string. See the `eww-search-prefix' variable for the search
320engine used."
321 (interactive)
322 (if (use-region-p)
323 (let ((region-string (buffer-substring (region-beginning) (region-end))))
324 (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
325 (eww region-string)
326 (call-interactively 'eww)))
327 (call-interactively 'eww)))
320 328
321(defun eww-open-in-new-buffer () 329(defun eww-open-in-new-buffer ()
322 "Fetch link at point in a new EWW buffer." 330 "Fetch link at point in a new EWW buffer."
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 2a6b3960c46..4d4e8a809e1 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -185,8 +185,8 @@ and other things:
185 (define-key map [follow-link] 'mouse-face) 185 (define-key map [follow-link] 'mouse-face)
186 (define-key map [mouse-2] 'shr-browse-url) 186 (define-key map [mouse-2] 'shr-browse-url)
187 (define-key map "I" 'shr-insert-image) 187 (define-key map "I" 'shr-insert-image)
188 (define-key map "w" 'shr-copy-url) 188 (define-key map "w" 'shr-maybe-probe-and-copy-url)
189 (define-key map "u" 'shr-copy-url) 189 (define-key map "u" 'shr-maybe-probe-and-copy-url)
190 (define-key map "v" 'shr-browse-url) 190 (define-key map "v" 'shr-browse-url)
191 (define-key map "O" 'shr-save-contents) 191 (define-key map "O" 'shr-save-contents)
192 (define-key map "\r" 'shr-browse-url) 192 (define-key map "\r" 'shr-browse-url)
@@ -290,43 +290,59 @@ DOM should be a parse tree as generated by
290 (forward-line 1) 290 (forward-line 1)
291 (delete-region (point) (point-max)))))) 291 (delete-region (point) (point-max))))))
292 292
293(defun shr-copy-url (&optional image-url) 293(defun shr-url-at-point (image-url)
294 "Return the URL under point as a string.
295If IMAGE-URL is non-nil, or there is no link under point, but
296there is an image under point then copy the URL of the image
297under point instead."
298 (if image-url
299 (get-text-property (point) 'image-url)
300 (or (get-text-property (point) 'shr-url)
301 (get-text-property (point) 'image-url))))
302
303(defun shr-copy-url (url)
294 "Copy the URL under point to the kill ring. 304 "Copy the URL under point to the kill ring.
295If IMAGE-URL (the prefix) is non-nil, or there is no link under 305If IMAGE-URL (the prefix) is non-nil, or there is no link under
296point, but there is an image under point then copy the URL of the 306point, but there is an image under point then copy the URL of the
297image under point instead. 307image under point instead."
298If called twice, then try to fetch the URL and see whether it 308 (interactive (list (shr-url-at-point current-prefix-arg)))
299redirects somewhere else." 309 (if (not url)
310 (message "No URL under point")
311 (setq url (url-encode-url url))
312 (kill-new url)
313 (message "Copied %s" url)))
314
315(defun shr-probe-url (url cont)
316 "Pass URL's redirect destination to CONT, if it has one.
317CONT should be a function of one argument, the redirect
318destination URL. If URL is not redirected, then CONT is never
319called."
300 (interactive "P") 320 (interactive "P")
301 (let ((url (if image-url 321 (url-retrieve
302 (get-text-property (point) 'image-url) 322 url (lambda (a)
303 (or (get-text-property (point) 'shr-url) 323 (pcase a
304 (get-text-property (point) 'image-url))))) 324 (`(:redirect ,destination . ,_)
305 (cond 325 ;; Remove common tracking junk from the URL.
306 ((not url) 326 (funcall cont (replace-regexp-in-string
307 (message "No URL under point")) 327 ".utm_.*" "" destination)))))
308 ;; Resolve redirected URLs. 328 nil t))
309 ((equal url (car kill-ring)) 329
310 (url-retrieve 330(defun shr-probe-and-copy-url (url)
311 url 331 "Copy the URL under point to the kill ring.
312 (lambda (a) 332Like `shr-copy-url', but additionally fetch URL and use its
313 (when (and (consp a) 333redirection destination if it has one."
314 (eq (car a) :redirect)) 334 (interactive (list (shr-url-at-point current-prefix-arg)))
315 (with-temp-buffer 335 (if url (shr-probe-url url #'shr-copy-url)
316 (insert (cadr a)) 336 (shr-copy-url url)))
317 (goto-char (point-min)) 337
318 ;; Remove common tracking junk from the URL. 338(defun shr-maybe-probe-and-copy-url (url)
319 (when (re-search-forward ".utm_.*" nil t) 339 "Copy the URL under point to the kill ring.
320 (replace-match "" t t)) 340If the URL is already at the front of the kill ring act like
321 (message "Copied %s" (buffer-string)) 341`shr-probe-and-copy-url', otherwise like `shr-copy-url'."
322 (copy-region-as-kill (point-min) (point-max))))) 342 (interactive (list (shr-url-at-point current-prefix-arg)))
323 nil t)) 343 (if (equal url (car kill-ring))
324 ;; Copy the URL to the kill ring. 344 (shr-probe-and-copy-url url)
325 (t 345 (shr-copy-url url)))
326 (with-temp-buffer
327 (insert (url-encode-url url))
328 (copy-region-as-kill (point-min) (point-max))
329 (message "Copied %s" (buffer-string)))))))
330 346
331(defun shr-next-link () 347(defun shr-next-link ()
332 "Skip to the next link." 348 "Skip to the next link."
@@ -512,6 +528,7 @@ size, and full-buffer size."
512 (* (frame-char-width) 2) 528 (* (frame-char-width) 2)
513 0)))) 529 0))))
514 (shr-insert text) 530 (shr-insert text)
531 (shr-fill-lines (point-min) (point-max))
515 (buffer-string))))) 532 (buffer-string)))))
516 533
517(define-inline shr-char-breakable-p (char) 534(define-inline shr-char-breakable-p (char)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 23aa90186a6..346979000f5 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -72,7 +72,7 @@ It is used for TCP/IP devices."
72(defconst tramp-adb-ls-toolbox-regexp 72(defconst tramp-adb-ls-toolbox-regexp
73 (concat 73 (concat
74 "^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions 74 "^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions
75 "\\(?:[[:space:]][[:digit:]]+\\)?" ; links (Android 7/ToolBox) 75 "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox)
76 "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username 76 "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
77 "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group 77 "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
78 "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size 78 "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
@@ -411,15 +411,17 @@ pass to the OPERATION."
411 (tramp-adb-get-ls-command v) 411 (tramp-adb-get-ls-command v)
412 (tramp-shell-quote-argument localname))) 412 (tramp-shell-quote-argument localname)))
413 ;; We insert also filename/. and filename/.., because "ls" doesn't. 413 ;; We insert also filename/. and filename/.., because "ls" doesn't.
414 (narrow-to-region (point) (point)) 414 ;; Looks like it does include them in toybox, since Android 6.
415 (tramp-adb-send-command 415 (unless (re-search-backward "\\.$" nil t)
416 v (format "%s -d -a -l %s %s" 416 (narrow-to-region (point-max) (point-max))
417 (tramp-adb-get-ls-command v) 417 (tramp-adb-send-command
418 (tramp-shell-quote-argument 418 v (format "%s -d -a -l %s %s"
419 (concat (file-name-as-directory localname) ".")) 419 (tramp-adb-get-ls-command v)
420 (tramp-shell-quote-argument 420 (tramp-shell-quote-argument
421 (concat (file-name-as-directory localname) "..")))) 421 (concat (file-name-as-directory localname) "."))
422 (widen)) 422 (tramp-shell-quote-argument
423 (concat (file-name-as-directory localname) ".."))))
424 (widen)))
423 (tramp-adb-sh-fix-ls-output) 425 (tramp-adb-sh-fix-ls-output)
424 (let ((result (tramp-do-parse-file-attributes-with-ls 426 (let ((result (tramp-do-parse-file-attributes-with-ls
425 v (or id-format 'integer)))) 427 v (or id-format 'integer))))
@@ -443,11 +445,12 @@ pass to the OPERATION."
443 (with-tramp-connection-property vec "ls" 445 (with-tramp-connection-property vec "ls"
444 (tramp-message vec 5 "Finding a suitable `ls' command") 446 (tramp-message vec 5 "Finding a suitable `ls' command")
445 (cond 447 (cond
446 ;; Can't disable coloring explicitly for toybox ls command 448 ;; Can't disable coloring explicitly for toybox ls command. We
447 ((tramp-adb-send-command-and-check vec "toybox") "ls") 449 ;; must force "ls" to print just one column.
450 ((tramp-adb-send-command-and-check vec "toybox") "env COLUMNS=1 ls")
448 ;; On CyanogenMod based system BusyBox is used and "ls" output 451 ;; On CyanogenMod based system BusyBox is used and "ls" output
449 ;; coloring is enabled by default. So we try to disable it 452 ;; coloring is enabled by default. So we try to disable it when
450 ;; when possible. 453 ;; possible.
451 ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null") 454 ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null")
452 "ls --color=never") 455 "ls --color=never")
453 (t "ls")))) 456 (t "ls"))))
@@ -569,13 +572,17 @@ Emacs dired can't find files."
569 (file-name-as-directory f) 572 (file-name-as-directory f)
570 f)) 573 f))
571 (with-current-buffer (tramp-get-buffer v) 574 (with-current-buffer (tramp-get-buffer v)
572 (append 575 (delete-dups
573 '("." "..") 576 (append
574 (delq 577 ;; In older Android versions, "." and ".." are not
575 nil 578 ;; included. In newer versions (toybox, since Android
576 (mapcar 579 ;; 6) they are. We fix this by `delete-dups'.
577 (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l)) 580 '("." "..")
578 (split-string (buffer-string) "\n"))))))))))) 581 (delq
582 nil
583 (mapcar
584 (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
585 (split-string (buffer-string) "\n"))))))))))))
579 586
580(defun tramp-adb-handle-file-local-copy (filename) 587(defun tramp-adb-handle-file-local-copy (filename)
581 "Like `file-local-copy' for Tramp files." 588 "Like `file-local-copy' for Tramp files."
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index c998df814c1..b2df4d6324b 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -252,7 +252,8 @@ If NAME is a remote file name, the local part of NAME is unquoted."
252(eval-after-load 'tramp 252(eval-after-load 'tramp
253 '(unless 253 '(unless
254 (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values))) 254 (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
255 (tramp-change-syntax (tramp-compat-tramp-syntax)))) 255 (tramp-compat-funcall
256 (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
256 257
257(provide 'tramp-compat) 258(provide 'tramp-compat)
258 259
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index f7b457ebf04..94518d0d359 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3500,21 +3500,10 @@ the result will be a local, non-Tramp, file name."
3500(defun tramp-sh-file-name-handler (operation &rest args) 3500(defun tramp-sh-file-name-handler (operation &rest args)
3501 "Invoke remote-shell Tramp file name handler. 3501 "Invoke remote-shell Tramp file name handler.
3502Fall back to normal file name handler if no Tramp handler exists." 3502Fall back to normal file name handler if no Tramp handler exists."
3503 (when (and tramp-locked (not tramp-locker)) 3503 (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
3504 (setq tramp-locked nil) 3504 (if fn
3505 (tramp-error 3505 (save-match-data (apply (cdr fn) args))
3506 (car-safe tramp-current-connection) 'file-error 3506 (tramp-run-real-handler operation args))))
3507 "Forbidden reentrant call of Tramp"))
3508 (let ((tl tramp-locked))
3509 (setq tramp-locked t)
3510 (unwind-protect
3511 (let ((tramp-locker t))
3512 (save-match-data
3513 (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
3514 (if fn
3515 (apply (cdr fn) args)
3516 (tramp-run-real-handler operation args)))))
3517 (setq tramp-locked tl))))
3518 3507
3519;; This must be the last entry, because `identity' always matches. 3508;; This must be the last entry, because `identity' always matches.
3520;;;###tramp-autoload 3509;;;###tramp-autoload
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 8d81ac64aa2..9c327c410a7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2053,6 +2053,33 @@ ARGS are the arguments OPERATION has been called with."
2053 `(let ((debug-on-error tramp-debug-on-error)) 2053 `(let ((debug-on-error tramp-debug-on-error))
2054 (condition-case-unless-debug ,var ,bodyform ,@handlers))) 2054 (condition-case-unless-debug ,var ,bodyform ,@handlers)))
2055 2055
2056;; In Emacs, there is some concurrency due to timers. If a timer
2057;; interrupts Tramp and wishes to use the same connection buffer as
2058;; the "main" Emacs, then garbage might occur in the connection
2059;; buffer. Therefore, we need to make sure that a timer does not use
2060;; the same connection buffer as the "main" Emacs. We implement a
2061;; cheap global lock, instead of locking each connection buffer
2062;; separately. The global lock is based on two variables,
2063;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
2064;; (with setq) to indicate a lock. But Tramp also calls itself during
2065;; processing of a single file operation, so we need to allow
2066;; recursive calls. That's where the `tramp-locker' variable comes in
2067;; -- it is let-bound to t during the execution of the current
2068;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
2069;; then we should just proceed because we have been called
2070;; recursively. But if `tramp-locker' is nil, then we are a timer
2071;; interrupting the "main" Emacs, and then we signal an error.
2072
2073(defvar tramp-locked nil
2074 "If non-nil, then Tramp is currently busy.
2075Together with `tramp-locker', this implements a locking mechanism
2076preventing reentrant calls of Tramp.")
2077
2078(defvar tramp-locker nil
2079 "If non-nil, then a caller has locked Tramp.
2080Together with `tramp-locked', this implements a locking mechanism
2081preventing reentrant calls of Tramp.")
2082
2056;; Main function. 2083;; Main function.
2057(defun tramp-file-name-handler (operation &rest args) 2084(defun tramp-file-name-handler (operation &rest args)
2058 "Invoke Tramp file name handler. 2085 "Invoke Tramp file name handler.
@@ -2090,7 +2117,20 @@ Falls back to normal file name handler if no Tramp file name handler exists."
2090 (setq result 2117 (setq result
2091 (catch 'non-essential 2118 (catch 'non-essential
2092 (catch 'suppress 2119 (catch 'suppress
2093 (apply foreign operation args)))) 2120 (when (and tramp-locked (not tramp-locker))
2121 (setq tramp-locked nil)
2122 (tramp-error
2123 (car-safe tramp-current-connection)
2124 'file-error
2125 "Forbidden reentrant call of Tramp"))
2126 (let ((tl tramp-locked))
2127 (setq tramp-locked t)
2128 (unwind-protect
2129 (let ((tramp-locker t))
2130 (apply foreign operation args))
2131 ;; Give timers a chance.
2132 (unless (setq tramp-locked tl)
2133 (sit-for 0.001 'nodisp)))))))
2094 (cond 2134 (cond
2095 ((eq result 'non-essential) 2135 ((eq result 'non-essential)
2096 (tramp-message 2136 (tramp-message
@@ -2145,33 +2185,6 @@ Falls back to normal file name handler if no Tramp file name handler exists."
2145 ;; we don't do anything. 2185 ;; we don't do anything.
2146 (tramp-run-real-handler operation args)))) 2186 (tramp-run-real-handler operation args))))
2147 2187
2148;; In Emacs, there is some concurrency due to timers. If a timer
2149;; interrupts Tramp and wishes to use the same connection buffer as
2150;; the "main" Emacs, then garbage might occur in the connection
2151;; buffer. Therefore, we need to make sure that a timer does not use
2152;; the same connection buffer as the "main" Emacs. We implement a
2153;; cheap global lock, instead of locking each connection buffer
2154;; separately. The global lock is based on two variables,
2155;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
2156;; (with setq) to indicate a lock. But Tramp also calls itself during
2157;; processing of a single file operation, so we need to allow
2158;; recursive calls. That's where the `tramp-locker' variable comes in
2159;; -- it is let-bound to t during the execution of the current
2160;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
2161;; then we should just proceed because we have been called
2162;; recursively. But if `tramp-locker' is nil, then we are a timer
2163;; interrupting the "main" Emacs, and then we signal an error.
2164
2165(defvar tramp-locked nil
2166 "If non-nil, then Tramp is currently busy.
2167Together with `tramp-locker', this implements a locking mechanism
2168preventing reentrant calls of Tramp.")
2169
2170(defvar tramp-locker nil
2171 "If non-nil, then a caller has locked Tramp.
2172Together with `tramp-locked', this implements a locking mechanism
2173preventing reentrant calls of Tramp.")
2174
2175;;;###autoload 2188;;;###autoload
2176(defun tramp-completion-file-name-handler (operation &rest args) 2189(defun tramp-completion-file-name-handler (operation &rest args)
2177 "Invoke Tramp file name completion handler. 2190 "Invoke Tramp file name completion handler.
@@ -3631,31 +3644,17 @@ connection buffer."
3631 "Like `accept-process-output' for Tramp processes. 3644 "Like `accept-process-output' for Tramp processes.
3632This is needed in order to hide `last-coding-system-used', which is set 3645This is needed in order to hide `last-coding-system-used', which is set
3633for process communication also." 3646for process communication also."
3634 ;; FIXME: There are problems, when an asynchronous process runs in
3635 ;; parallel, and also timers are active. See
3636 ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>.
3637 (when (and timer-event-last
3638 (string-prefix-p "*tramp/" (process-name proc))
3639 (let (result)
3640 (maphash
3641 (lambda (key _value)
3642 (and (processp key)
3643 (not (string-prefix-p "*tramp/" (process-name key)))
3644 (process-live-p key)
3645 (setq result t)))
3646 tramp-cache-data)
3647 result))
3648 (sit-for 0.01 'nodisp))
3649 (with-current-buffer (process-buffer proc) 3647 (with-current-buffer (process-buffer proc)
3650 (let (buffer-read-only last-coding-system-used) 3648 (let (buffer-read-only last-coding-system-used)
3651 ;; Under Windows XP, accept-process-output doesn't return 3649 ;; Under Windows XP, `accept-process-output' doesn't return
3652 ;; sometimes. So we add an additional timeout. JUST-THIS-ONE 3650 ;; sometimes. So we add an additional timeout. JUST-THIS-ONE
3653 ;; is set due to Bug#12145. 3651 ;; is set due to Bug#12145. It is an integer, in order to avoid
3652 ;; running timers as well.
3654 (tramp-message 3653 (tramp-message
3655 proc 10 "%s %s %s\n%s" 3654 proc 10 "%s %s %s\n%s"
3656 proc (process-status proc) 3655 proc (process-status proc)
3657 (with-timeout (timeout) 3656 (with-timeout (timeout)
3658 (accept-process-output proc timeout nil t)) 3657 (accept-process-output proc timeout nil 0))
3659 (buffer-string))))) 3658 (buffer-string)))))
3660 3659
3661(defun tramp-check-for-regexp (proc regexp) 3660(defun tramp-check-for-regexp (proc regexp)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 387a3c8bb36..4be487e1f4f 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
7;; Maintainer: Michael Albinus <michael.albinus@gmx.de> 7;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
8;; Keywords: comm, processes 8;; Keywords: comm, processes
9;; Package: tramp 9;; Package: tramp
10;; Version: 2.3.2-pre 10;; Version: 2.3.2
11 11
12;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
13 13
@@ -33,7 +33,7 @@
33;; should be changed only there. 33;; should be changed only there.
34 34
35;;;###tramp-autoload 35;;;###tramp-autoload
36(defconst tramp-version "2.3.2-pre" 36(defconst tramp-version "2.3.2"
37 "This version of Tramp.") 37 "This version of Tramp.")
38 38
39;;;###tramp-autoload 39;;;###tramp-autoload
@@ -55,7 +55,7 @@
55;; Check for Emacs version. 55;; Check for Emacs version.
56(let ((x (if (>= emacs-major-version 24) 56(let ((x (if (>= emacs-major-version 24)
57 "ok" 57 "ok"
58 (format "Tramp 2.3.2-pre is not fit for %s" 58 (format "Tramp 2.3.2 is not fit for %s"
59 (when (string-match "^.*$" (emacs-version)) 59 (when (string-match "^.*$" (emacs-version))
60 (match-string 0 (emacs-version))))))) 60 (match-string 0 (emacs-version)))))))
61 (unless (string-match "\\`ok\\'" x) (error "%s" x))) 61 (unless (string-match "\\`ok\\'" x) (error "%s" x)))
diff --git a/lisp/net/html2text.el b/lisp/obsolete/html2text.el
index 87c71dc504a..27560a70c63 100644
--- a/lisp/net/html2text.el
+++ b/lisp/obsolete/html2text.el
@@ -3,6 +3,7 @@
3;; Copyright (C) 2002-2017 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
4 4
5;; Author: Joakim Hove <hove@phys.ntnu.no> 5;; Author: Joakim Hove <hove@phys.ntnu.no>
6;; Obsolete-since: 26.1
6 7
7;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
8 9
@@ -29,6 +30,8 @@
29;; 30;;
30;; The main function is `html2text'. 31;; The main function is `html2text'.
31 32
33;; This package was obsoleted by shr.el.
34
32;;; Code: 35;;; Code:
33 36
34;; 37;;
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index c05200b3898..de2543951b9 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1915,7 +1915,7 @@ with a brace block."
1915 (save-restriction 1915 (save-restriction
1916 (let ((start (point)) 1916 (let ((start (point))
1917 (paren-state (c-parse-state)) 1917 (paren-state (c-parse-state))
1918 lim pos end-pos encl-decl-block where) 1918 lim pos end-pos where)
1919 ;; Narrow enclosing brace blocks out, as required by the values of 1919 ;; Narrow enclosing brace blocks out, as required by the values of
1920 ;; `c-defun-tactic', `near', and the position of point. 1920 ;; `c-defun-tactic', `near', and the position of point.
1921 (when (eq c-defun-tactic 'go-outward) 1921 (when (eq c-defun-tactic 'go-outward)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index dd8f8afc6a3..85a4085e490 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -44,19 +44,12 @@
44 (load "cc-bytecomp" nil t))) 44 (load "cc-bytecomp" nil t)))
45 45
46(eval-and-compile 46(eval-and-compile
47 (defvar c--mapcan-status 47 (defvar c--cl-library
48 (cond ((and (fboundp 'mapcan) 48 (if (locate-library "cl-lib")
49 (subrp (symbol-function 'mapcan))) 49 'cl-lib
50 ;; XEmacs 50 'cl)))
51 'mapcan) 51
52 ((locate-file "cl-lib.elc" load-path) 52(cc-external-require c--cl-library)
53 ;; Emacs >= 24.3
54 'cl-mapcan)
55 (t
56 ;; Emacs <= 24.2
57 nil))))
58
59(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
60; was (cc-external-require 'cl). ACM 2005/11/29. 53; was (cc-external-require 'cl). ACM 2005/11/29.
61; Changed from (eval-when-compile (require 'cl)) back to 54; Changed from (eval-when-compile (require 'cl)) back to
62; cc-external-require, 2015-08-12. 55; cc-external-require, 2015-08-12.
@@ -182,9 +175,12 @@ This variant works around bugs in `eval-when-compile' in various
182 ;; The motivation for this macro is to avoid the irritating message 175 ;; The motivation for this macro is to avoid the irritating message
183 ;; "function `mapcan' from cl package called at runtime" produced by Emacs. 176 ;; "function `mapcan' from cl package called at runtime" produced by Emacs.
184 (cond 177 (cond
185 ((eq c--mapcan-status 'mapcan) 178 ((and (fboundp 'mapcan)
179 (subrp (symbol-function 'mapcan)))
180 ;; XEmacs and Emacs >= 26.
186 `(mapcan ,fun ,liszt)) 181 `(mapcan ,fun ,liszt))
187 ((eq c--mapcan-status 'cl-mapcan) 182 ((eq c--cl-library 'cl-lib)
183 ;; Emacs >= 24.3, < 26.
188 `(cl-mapcan ,fun ,liszt)) 184 `(cl-mapcan ,fun ,liszt))
189 (t 185 (t
190 ;; Emacs <= 24.2. It would be nice to be able to distinguish between 186 ;; Emacs <= 24.2. It would be nice to be able to distinguish between
@@ -193,13 +189,13 @@ This variant works around bugs in `eval-when-compile' in various
193 189
194(defmacro c--set-difference (liszt1 liszt2 &rest other-args) 190(defmacro c--set-difference (liszt1 liszt2 &rest other-args)
195 ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3. 191 ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3.
196 (if (eq c--mapcan-status 'cl-mapcan) 192 (if (eq c--cl-library 'cl-lib)
197 `(cl-set-difference ,liszt1 ,liszt2 ,@other-args) 193 `(cl-set-difference ,liszt1 ,liszt2 ,@other-args)
198 `(set-difference ,liszt1 ,liszt2 ,@other-args))) 194 `(set-difference ,liszt1 ,liszt2 ,@other-args)))
199 195
200(defmacro c--intersection (liszt1 liszt2 &rest other-args) 196(defmacro c--intersection (liszt1 liszt2 &rest other-args)
201 ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3. 197 ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3.
202 (if (eq c--mapcan-status 'cl-mapcan) 198 (if (eq c--cl-library 'cl-lib)
203 `(cl-intersection ,liszt1 ,liszt2 ,@other-args) 199 `(cl-intersection ,liszt1 ,liszt2 ,@other-args)
204 `(intersection ,liszt1 ,liszt2 ,@other-args))) 200 `(intersection ,liszt1 ,liszt2 ,@other-args)))
205 201
@@ -212,7 +208,7 @@ This variant works around bugs in `eval-when-compile' in various
212 208
213 (defmacro c--delete-duplicates (cl-seq &rest cl-keys) 209 (defmacro c--delete-duplicates (cl-seq &rest cl-keys)
214 ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3. 210 ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3.
215 (if (eq c--mapcan-status 'cl-mapcan) 211 (if (eq c--cl-library 'cl-lib)
216 `(cl-delete-duplicates ,cl-seq ,@cl-keys) 212 `(cl-delete-duplicates ,cl-seq ,@cl-keys)
217 `(delete-duplicates ,cl-seq ,@cl-keys)))) 213 `(delete-duplicates ,cl-seq ,@cl-keys))))
218 214
@@ -1175,6 +1171,63 @@ been put there by c-put-char-property. POINT remains unchanged."
1175 nil ,from ,to ,value nil -property-)) 1171 nil ,from ,to ,value nil -property-))
1176 ;; GNU Emacs 1172 ;; GNU Emacs
1177 `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) 1173 `(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
1174
1175(defun c-clear-char-property-with-value-on-char-function (from to property
1176 value char)
1177 "Remove all text-properties PROPERTY with value VALUE on
1178characters with value CHAR from the region [FROM, TO), as tested
1179by `equal'. These properties are assumed to be over individual
1180characters, having been put there by c-put-char-property. POINT
1181remains unchanged."
1182 (let ((place from)
1183 )
1184 (while ; loop round occurrences of (PROPERTY VALUE)
1185 (progn
1186 (while ; loop round changes in PROPERTY till we find VALUE
1187 (and
1188 (< place to)
1189 (not (equal (get-text-property place property) value)))
1190 (setq place (c-next-single-property-change place property nil to)))
1191 (< place to))
1192 (if (eq (char-after place) char)
1193 (remove-text-properties place (1+ place) (cons property nil)))
1194 ;; Do we have to do anything with stickiness here?
1195 (setq place (1+ place)))))
1196
1197(defmacro c-clear-char-property-with-value-on-char (from to property value char)
1198 "Remove all text-properties PROPERTY with value VALUE on
1199characters with value CHAR from the region [FROM, TO), as tested
1200by `equal'. These properties are assumed to be over individual
1201characters, having been put there by c-put-char-property. POINT
1202remains unchanged."
1203 (if c-use-extents
1204 ;; XEmacs
1205 `(let ((-property- ,property)
1206 (-char- ,char))
1207 (map-extents (lambda (ext val)
1208 (if (and (equal (extent-property ext -property-) val)
1209 (eq (char-after
1210 (extent-start-position ext))
1211 -char-))
1212 (delete-extent ext)))
1213 nil ,from ,to ,value nil -property-))
1214 ;; Gnu Emacs
1215 `(c-clear-char-property-with-value-on-char-function ,from ,to ,property
1216 ,value ,char)))
1217
1218(defmacro c-put-char-properties-on-char (from to property value char)
1219 ;; This needs to be a macro because `property' passed to
1220 ;; `c-put-char-property' must be a constant.
1221 "Put the text property PROPERTY with value VALUE on characters
1222with value CHAR in the region [FROM to)."
1223 `(let ((skip-string (concat "^" (list ,char)))
1224 (-to- ,to))
1225 (save-excursion
1226 (goto-char ,from)
1227 (while (progn (skip-chars-forward skip-string -to-)
1228 (< (point) -to-))
1229 (c-put-char-property (point) ,property ,value)
1230 (forward-char)))))
1178 1231
1179;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. 1232;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
1180;; For our purposes, these are characterized by being possible to 1233;; For our purposes, these are characterized by being possible to
@@ -1232,6 +1285,8 @@ been put there by c-put-char-property. POINT remains unchanged."
1232(def-edebug-spec c-put-char-property t) 1285(def-edebug-spec c-put-char-property t)
1233(def-edebug-spec c-get-char-property t) 1286(def-edebug-spec c-get-char-property t)
1234(def-edebug-spec c-clear-char-property t) 1287(def-edebug-spec c-clear-char-property t)
1288(def-edebug-spec c-clear-char-property-with-value-on-char t)
1289(def-edebug-spec c-put-char-properties-on-char t)
1235(def-edebug-spec c-clear-char-properties t) 1290(def-edebug-spec c-clear-char-properties t)
1236(def-edebug-spec c-put-overlay t) 1291(def-edebug-spec c-put-overlay t)
1237(def-edebug-spec c-delete-overlay t) 1292(def-edebug-spec c-delete-overlay t)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index aa84ade083c..955e1ebb08d 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -4809,7 +4809,6 @@ comment at the start of cc-engine.el for more info."
4809 4809
4810 (c-self-bind-state-cache 4810 (c-self-bind-state-cache
4811 (let ((start (point)) 4811 (let ((start (point))
4812 state-2
4813 ;; A list of syntactically relevant positions in descending 4812 ;; A list of syntactically relevant positions in descending
4814 ;; order. It's used to avoid scanning repeatedly over 4813 ;; order. It's used to avoid scanning repeatedly over
4815 ;; potentially large regions with `parse-partial-sexp' to verify 4814 ;; potentially large regions with `parse-partial-sexp' to verify
@@ -7809,8 +7808,7 @@ comment at the start of cc-engine.el for more info."
7809 ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of 7808 ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of
7810 ;; this construct and return t. If the parsing fails, return nil, leaving 7809 ;; this construct and return t. If the parsing fails, return nil, leaving
7811 ;; point unchanged. 7810 ;; point unchanged.
7812 (let ((here (point)) 7811 (let (end)
7813 end)
7814 (if (not (c-on-identifier)) 7812 (if (not (c-on-identifier))
7815 nil 7813 nil
7816 (c-simple-skip-symbol-backward) 7814 (c-simple-skip-symbol-backward)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 9bae7d9aa2f..66f2575f49f 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -702,6 +702,36 @@ stuff. Used on level 1 and higher."
702 t) 702 t)
703 (c-put-font-lock-face start (1+ start) 'font-lock-warning-face))))) 703 (c-put-font-lock-face start (1+ start) 'font-lock-warning-face)))))
704 704
705(defun c-font-lock-invalid-single-quotes (limit)
706 ;; This function will be called from font-lock for a region bounded by POINT
707 ;; and LIMIT, as though it were to identify a keyword for
708 ;; font-lock-keyword-face. It always returns NIL to inhibit this and
709 ;; prevent a repeat invocation. See elisp/lispref page "Search-based
710 ;; Fontification".
711 ;;
712 ;; This function fontifies invalid single quotes with
713 ;; `font-lock-warning-face'. These are the single quotes which
714 ;; o - aren't inside a literal;
715 ;; o - are marked with a syntax-table text property value '(1); and
716 ;; o - are NOT marked with a non-null c-digit-separator property.
717 (let ((limits (c-literal-limits))
718 state beg end)
719 (if limits
720 (goto-char (cdr limits))) ; Even for being in a ' '
721 (while (< (point) limit)
722 (setq beg (point))
723 (setq state (parse-partial-sexp (point) limit nil nil nil 'syntax-table))
724 (setq end (point))
725 (goto-char beg)
726 (while (progn (skip-chars-forward "^'" end)
727 (< (point) end))
728 (if (and (equal (c-get-char-property (point) 'syntax-table) '(1))
729 (not (c-get-char-property (point) 'c-digit-separator)))
730 (c-put-font-lock-face (point) (1+ (point)) font-lock-warning-face))
731 (forward-char))
732 (parse-partial-sexp end limit nil nil state 'syntax-table)))
733 nil)
734
705(c-lang-defconst c-basic-matchers-before 735(c-lang-defconst c-basic-matchers-before
706 "Font lock matchers for basic keywords, labels, references and various 736 "Font lock matchers for basic keywords, labels, references and various
707other easily recognizable things that should be fontified before generic 737other easily recognizable things that should be fontified before generic
@@ -723,6 +753,9 @@ casts and declarations are fontified. Used on level 2 and higher."
723 (concat ".\\(" c-string-limit-regexp "\\)") 753 (concat ".\\(" c-string-limit-regexp "\\)")
724 '((c-font-lock-invalid-string))) 754 '((c-font-lock-invalid-string)))
725 755
756 ;; Invalid single quotes.
757 c-font-lock-invalid-single-quotes
758
726 ;; Fontify C++ raw strings. 759 ;; Fontify C++ raw strings.
727 ,@(when (c-major-mode-is 'c++-mode) 760 ,@(when (c-major-mode-is 'c++-mode)
728 '(c-font-lock-raw-strings)) 761 '(c-font-lock-raw-strings))
@@ -777,7 +810,8 @@ casts and declarations are fontified. Used on level 2 and higher."
777 (c-backward-syntactic-ws) 810 (c-backward-syntactic-ws)
778 (setq id-end (point)) 811 (setq id-end (point))
779 (< (skip-chars-backward 812 (< (skip-chars-backward
780 ,(c-lang-const c-symbol-chars)) 0)) 813 ,(c-lang-const c-symbol-chars))
814 0))
781 (not (get-text-property (point) 'face))) 815 (not (get-text-property (point) 'face)))
782 (c-put-font-lock-face (point) id-end 816 (c-put-font-lock-face (point) id-end
783 c-reference-face-name) 817 c-reference-face-name)
@@ -1013,13 +1047,11 @@ casts and declarations are fontified. Used on level 2 and higher."
1013 1047
1014 ;;(message "c-font-lock-declarators from %s to %s" (point) limit) 1048 ;;(message "c-font-lock-declarators from %s to %s" (point) limit)
1015 (c-fontify-types-and-refs 1049 (c-fontify-types-and-refs
1016 ((pos (point)) next-pos id-start id-end 1050 ((pos (point)) next-pos id-start
1017 decl-res 1051 decl-res
1018 paren-depth
1019 id-face got-type got-init 1052 id-face got-type got-init
1020 c-last-identifier-range 1053 c-last-identifier-range
1021 (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)) 1054 (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)))
1022 brackets-after-id)
1023 1055
1024 ;; The following `while' fontifies a single declarator id each time round. 1056 ;; The following `while' fontifies a single declarator id each time round.
1025 ;; It loops only when LIST is non-nil. 1057 ;; It loops only when LIST is non-nil.
@@ -1036,7 +1068,7 @@ casts and declarations are fontified. Used on level 2 and higher."
1036 (forward-char) 1068 (forward-char)
1037 (c-forward-syntactic-ws) 1069 (c-forward-syntactic-ws)
1038 (looking-at "[*&]"))) 1070 (looking-at "[*&]")))
1039 (not (car (cddr decl-res))) ; brackets-after-id 1071 (not (car (cddr decl-res)))
1040 (or (not (c-major-mode-is 'c++-mode)) 1072 (or (not (c-major-mode-is 'c++-mode))
1041 (save-excursion 1073 (save-excursion
1042 (let (c-last-identifier-range) 1074 (let (c-last-identifier-range)
@@ -1375,7 +1407,6 @@ casts and declarations are fontified. Used on level 2 and higher."
1375 ;; it finds any. That's necessary so that we later will 1407 ;; it finds any. That's necessary so that we later will
1376 ;; stop inside them to fontify types there. 1408 ;; stop inside them to fontify types there.
1377 (c-parse-and-markup-<>-arglists t) 1409 (c-parse-and-markup-<>-arglists t)
1378 lbrace ; position of some {.
1379 ;; The font-lock package in Emacs is known to clobber 1410 ;; The font-lock package in Emacs is known to clobber
1380 ;; `parse-sexp-lookup-properties' (when it exists). 1411 ;; `parse-sexp-lookup-properties' (when it exists).
1381 (parse-sexp-lookup-properties 1412 (parse-sexp-lookup-properties
@@ -2503,7 +2534,7 @@ need for `c++-font-lock-extra-types'.")
2503 limit 2534 limit
2504 "[-+]" 2535 "[-+]"
2505 nil 2536 nil
2506 (lambda (match-pos inside-macro &optional top-level) 2537 (lambda (_match-pos _inside-macro &optional _top-level)
2507 (forward-char) 2538 (forward-char)
2508 (c-font-lock-objc-method)))) 2539 (c-font-lock-objc-method))))
2509 nil) 2540 nil)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index a9d5ac34ad4..8be806094cd 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -130,7 +130,7 @@
130 130
131 131
132;; This file is not always loaded. See note above. 132;; This file is not always loaded. See note above.
133(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl)) 133(cc-external-require (if (eq c--cl-library 'cl-lib) 'cl-lib 'cl))
134 134
135 135
136;;; Setup for the `c-lang-defvar' system. 136;;; Setup for the `c-lang-defvar' system.
@@ -474,18 +474,19 @@ so that all identifiers are recognized as words.")
474 ;; The value here may be a list of functions or a single function. 474 ;; The value here may be a list of functions or a single function.
475 t nil 475 t nil
476 c++ '(c-extend-region-for-CPP 476 c++ '(c-extend-region-for-CPP
477; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed.
478 c-before-change-check-raw-strings 477 c-before-change-check-raw-strings
479 c-before-change-check-<>-operators 478 c-before-change-check-<>-operators
480 c-depropertize-CPP 479 c-depropertize-CPP
481 c-before-after-change-digit-quote
482 c-invalidate-macro-cache 480 c-invalidate-macro-cache
483 c-truncate-bs-cache) 481 c-truncate-bs-cache
482 c-parse-quotes-before-change)
484 (c objc) '(c-extend-region-for-CPP 483 (c objc) '(c-extend-region-for-CPP
485 c-depropertize-CPP 484 c-depropertize-CPP
486 c-invalidate-macro-cache 485 c-invalidate-macro-cache
487 c-truncate-bs-cache) 486 c-truncate-bs-cache
488 ;; java 'c-before-change-check-<>-operators 487 c-parse-quotes-before-change)
488 java 'c-parse-quotes-before-change
489 ;; 'c-before-change-check-<>-operators
489 awk 'c-awk-record-region-clear-NL) 490 awk 'c-awk-record-region-clear-NL)
490(c-lang-defvar c-get-state-before-change-functions 491(c-lang-defvar c-get-state-before-change-functions
491 (let ((fs (c-lang-const c-get-state-before-change-functions))) 492 (let ((fs (c-lang-const c-get-state-before-change-functions)))
@@ -515,18 +516,19 @@ parameters \(point-min) and \(point-max).")
515 t '(c-depropertize-new-text 516 t '(c-depropertize-new-text
516 c-change-expand-fl-region) 517 c-change-expand-fl-region)
517 (c objc) '(c-depropertize-new-text 518 (c objc) '(c-depropertize-new-text
519 c-parse-quotes-after-change
518 c-extend-font-lock-region-for-macros 520 c-extend-font-lock-region-for-macros
519 c-neutralize-syntax-in-and-mark-CPP 521 c-neutralize-syntax-in-and-mark-CPP
520 c-change-expand-fl-region) 522 c-change-expand-fl-region)
521 c++ '(c-depropertize-new-text 523 c++ '(c-depropertize-new-text
524 c-parse-quotes-after-change
522 c-extend-font-lock-region-for-macros 525 c-extend-font-lock-region-for-macros
523; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed.
524 c-before-after-change-digit-quote
525 c-after-change-re-mark-raw-strings 526 c-after-change-re-mark-raw-strings
526 c-neutralize-syntax-in-and-mark-CPP 527 c-neutralize-syntax-in-and-mark-CPP
527 c-restore-<>-properties 528 c-restore-<>-properties
528 c-change-expand-fl-region) 529 c-change-expand-fl-region)
529 java '(c-depropertize-new-text 530 java '(c-depropertize-new-text
531 c-parse-quotes-after-change
530 c-restore-<>-properties 532 c-restore-<>-properties
531 c-change-expand-fl-region) 533 c-change-expand-fl-region)
532 awk '(c-depropertize-new-text 534 awk '(c-depropertize-new-text
@@ -609,6 +611,12 @@ EOL terminated statements."
609 (c c++ objc) t) 611 (c c++ objc) t)
610(c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields)) 612(c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields))
611 613
614(c-lang-defconst c-has-quoted-numbers
615 "Whether the language has numbers quoted like 4'294'967'295."
616 t nil
617 c++ t)
618(c-lang-defvar c-has-quoted-numbers (c-lang-const c-has-quoted-numbers))
619
612(c-lang-defconst c-modified-constant 620(c-lang-defconst c-modified-constant
613 "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\", 621 "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\",
614a “long character”. In particular, this recognizes forms of constant 622a “long character”. In particular, this recognizes forms of constant
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index a501ebba256..ef93f75c5f3 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1083,101 +1083,219 @@ Note that the style variables are always made local to the buffer."
1083 (forward-line)) ; no infinite loop with, e.g., "#//" 1083 (forward-line)) ; no infinite loop with, e.g., "#//"
1084 ))))) 1084 )))))
1085 1085
1086(defun c-before-after-change-digit-quote (beg end &optional old-len) 1086;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1087 ;; This function either removes or applies the punctuation value ('(1)) of 1087;; Parsing of quotes.
1088 ;; the `syntax-table' text property on single quote marks which are 1088;;
1089 ;; separator characters in long integer literals, e.g. "4'294'967'295". It 1089;; Valid digit separators in numbers will get the syntax-table "punctuation"
1090 ;; applies to both decimal/octal and hex literals. (FIXME (2016-06-10): it 1090;; property, '(1), and also the text property `c-digit-separator' value t.
1091 ;; should also apply to binary literals.) 1091;;
1092;; Invalid other quotes (i.e. those not validly bounding a single character,
1093;; or escaped character) will get the syntax-table "punctuation" property,
1094;; '(1), too.
1095;;
1096;; Note that, for convenience, these properties are applied even inside
1097;; comments and strings.
1098
1099(defconst c-maybe-quoted-number-head
1100 (concat
1101 "\\(0\\("
1102 "\\([Xx]\\([0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*'?\\)?\\)"
1103 "\\|"
1104 "\\([Bb]\\([01]\\('[01]\\|[01]\\)*'?\\)?\\)"
1105 "\\|"
1106 "\\('[0-7]\\|[0-7]\\)*'?"
1107 "\\)"
1108 "\\|"
1109 "[1-9]\\('[0-9]\\|[0-9]\\)*'?"
1110 "\\)")
1111 "Regexp matching the head of a numeric literal, including with digit separators.")
1112
1113(defun c-quoted-number-head-before-point ()
1114 ;; Return non-nil when the head of a possibly quoted number is found
1115 ;; immediately before point. The value returned in this case is the buffer
1116 ;; position of the start of the head. That position is also in
1117 ;; (match-beginning 0).
1118 (when c-has-quoted-numbers
1119 (save-excursion
1120 (let ((here (point))
1121 found)
1122 (skip-chars-backward "0-9a-fA-F'")
1123 (if (and (memq (char-before) '(?x ?X))
1124 (eq (char-before (1- (point))) ?0))
1125 (backward-char 2))
1126 (while
1127 (and
1128 (setq found
1129 (search-forward-regexp c-maybe-quoted-number-head here t))
1130 (< found here)))
1131 (and (eq found here) (match-beginning 0))))))
1132
1133(defconst c-maybe-quoted-number-tail
1134 (concat
1135 "\\("
1136 "\\([xX']?[0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)"
1137 "\\|"
1138 "\\([bB']?[01]\\('[01]\\|[01]\\)*\\)"
1139 "\\|"
1140 "\\('?[0-9]\\('[0-9]\\|[0-9]\\)*\\)"
1141 "\\)")
1142 "Regexp matching the tail of a numeric literal, including with digit separators.
1143Note that this is a strict tail, so won't match, e.g. \"0x....\".")
1144
1145(defun c-quoted-number-tail-after-point ()
1146 ;; Return non-nil when a proper tail of a possibly quoted number is found
1147 ;; immediately after point. The value returned in this case is the buffer
1148 ;; position of the end of the tail. That position is also in (match-end 0).
1149 (when c-has-quoted-numbers
1150 (and (looking-at c-maybe-quoted-number-tail)
1151 (match-end 0))))
1152
1153(defconst c-maybe-quoted-number
1154 (concat
1155 "\\(0\\("
1156 "\\([Xx][0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)"
1157 "\\|"
1158 "\\([Bb][01]\\('[01]\\|[01]\\)*\\)"
1159 "\\|"
1160 "\\('[0-7]\\|[0-7]\\)*"
1161 "\\)"
1162 "\\|"
1163 "[1-9]\\('[0-9]\\|[0-9]\\)*"
1164 "\\)")
1165 "Regexp matching a numeric literal, including with digit separators.")
1166
1167(defun c-quoted-number-straddling-point ()
1168 ;; Return non-nil if a definitely quoted number starts before point and ends
1169 ;; after point. In this case the number is bounded by (match-beginning 0)
1170 ;; and (match-end 0).
1171 (when c-has-quoted-numbers
1172 (save-excursion
1173 (let ((here (point))
1174 (bound (progn (skip-chars-forward "0-9a-fA-F'") (point))))
1175 (goto-char here)
1176 (when (< (skip-chars-backward "0-9a-fA-F'") 0)
1177 (if (and (memq (char-before) '(?x ?X))
1178 (eq (char-before (1- (point))) ?0))
1179 (backward-char 2))
1180 (while (and (search-forward-regexp c-maybe-quoted-number bound t)
1181 (<= (match-end 0) here)))
1182 (and (< (match-beginning 0) here)
1183 (> (match-end 0) here)
1184 (save-match-data
1185 (goto-char (match-beginning 0))
1186 (save-excursion (search-forward "'" (match-end 0) t)))))))))
1187
1188(defun c-parse-quotes-before-change (beg end)
1189 ;; This function analyzes 's near the region (c-new-BEG c-new-END), amending
1190 ;; those two variables as needed to include 's into that region when they
1191 ;; might be syntactically relevant to the change in progress.
1092 ;; 1192 ;;
1093 ;; In both uses of the function, the `syntax-table' properties are 1193 ;; Having amended that region, the function removes pertinent text
1094 ;; removed/applied only on quote marks which appear to be digit separators. 1194 ;; properties (syntax-table properties with value '(1) and c-digit-separator
1195 ;; props with value t) from 's in it. This operation is performed even
1196 ;; within strings and comments.
1095 ;; 1197 ;;
1096 ;; Point is undefined on both entry and exit to this function, and the 1198 ;; This function is called exclusively as a before-change function via the
1097 ;; return value has no significance. The function is called solely as a 1199 ;; variable `c-get-state-before-change-functions'.
1098 ;; before-change function (see `c-get-state-before-change-functions') and as 1200 (c-save-buffer-state (p-limit limits found)
1099 ;; an after change function (see `c-before-font-lock-functions', with the 1201 ;; Special consideraton for deleting \ from '\''.
1100 ;; parameters BEG, END, and (optionally) OLD-LEN being given the standard 1202 (if (and (> end beg)
1101 ;; values for before/after-change functions. 1203 (eq (char-before end) ?\\)
1102 (c-save-buffer-state ((num-begin c-new-BEG) digit-re try-end) 1204 (<= c-new-END end))
1205 (setq c-new-END (min (1+ end) (point-max))))
1206
1207 ;; Do we have a ' (or something like ',',',',',') within range of
1208 ;; c-new-BEG?
1209 (goto-char c-new-BEG)
1210 (setq p-limit (max (- (point) 2) (point-min)))
1211 (while (and (skip-chars-backward "^\\\\'" p-limit)
1212 (> (point) p-limit))
1213 (when (eq (char-before) ?\\)
1214 (setq p-limit (max (1- p-limit) (point-min))))
1215 (backward-char)
1216 (setq c-new-BEG (point)))
1217 (beginning-of-line)
1218 (while (and
1219 (setq found (search-forward-regexp "\\('\\([^'\\]\\|\\\\.\\)\\)*'"
1220 c-new-BEG 'limit))
1221 (< (point) (1- c-new-BEG))))
1222 (if found
1223 (setq c-new-BEG
1224 (if (and (eq (point) (1- c-new-BEG))
1225 (eq (char-after) ?')) ; "''" before c-new-BEG.
1226 (1- c-new-BEG)
1227 (match-beginning 0))))
1228
1229 ;; Check for a number with quote separators straddling c-new-BEG
1230 (when c-has-quoted-numbers
1231 (goto-char c-new-BEG)
1232 (when ;; (c-quoted-number-straddling-point)
1233 (c-quoted-number-head-before-point)
1234 (setq c-new-BEG (match-beginning 0))))
1235
1236 ;; Do we have a ' (or something like ',',',',...,',') within range of
1237 ;; c-new-END?
1103 (goto-char c-new-END) 1238 (goto-char c-new-END)
1104 (when (looking-at "\\(x\\)?[0-9a-fA-F']+") 1239 (setq p-limit (min (+ (point) 2) (point-max)))
1105 (setq c-new-END (match-end 0))) 1240 (while (and (skip-chars-forward "^\\\\'" p-limit)
1241 (< (point) p-limit))
1242 (when (eq (char-after) ?\\)
1243 (setq p-limit (min (1+ p-limit) (point-max))))
1244 (forward-char)
1245 (setq c-new-END (point)))
1246 (if (looking-at "[^']?\\('\\([^'\\]\\|\\\\.\\)\\)*'")
1247 (setq c-new-END (match-end 0)))
1248
1249 ;; Check for a number with quote separators straddling c-new-END.
1250 (when c-has-quoted-numbers
1251 (goto-char c-new-END)
1252 (when ;; (c-quoted-number-straddling-point)
1253 (c-quoted-number-tail-after-point)
1254 (setq c-new-END (match-end 0))))
1255
1256 ;; Remove the '(1) syntax-table property from all "'"s within (c-new-BEG
1257 ;; c-new-END).
1258 (c-clear-char-property-with-value-on-char
1259 c-new-BEG c-new-END
1260 'syntax-table '(1)
1261 ?')
1262 ;; Remove the c-digit-separator text property from the same "'"s.
1263 (when c-has-quoted-numbers
1264 (c-clear-char-property-with-value-on-char
1265 c-new-BEG c-new-END
1266 'c-digit-separator t
1267 ?'))))
1268
1269(defun c-parse-quotes-after-change (beg end old-len)
1270 ;; This function applies syntax-table properties (value '(1)) and
1271 ;; c-digit-separator properties as needed to 's within the range (c-new-BEG
1272 ;; c-new-END). This operation is performed even within strings and
1273 ;; comments.
1274 ;;
1275 ;; This function is called exclusively as an after-change function via the
1276 ;; variable `c-before-font-lock-functions'.
1277 (c-save-buffer-state (p-limit limits num-beg num-end clear-from-BEG-to)
1278 ;; Apply the needed syntax-table and c-digit-separator text properties to
1279 ;; quotes.
1106 (goto-char c-new-BEG) 1280 (goto-char c-new-BEG)
1107 (when (looking-at "\\(x?\\)[0-9a-fA-F']") 1281 (while (and (< (point) c-new-END)
1108 (if (re-search-backward "\\(0x\\)?[0-9a-fA-F]*\\=" nil t) 1282 (search-forward "'" c-new-END 'limit))
1109 (setq c-new-BEG (point)))) 1283 (cond ((and (eq (char-before (1- (point))) ?\\)
1110 1284 ;; Check we've got an odd number of \s, here.
1111 (while
1112 (re-search-forward "[0-9a-fA-F]'[0-9a-fA-F]" c-new-END t)
1113 (setq try-end (1- (point)))
1114 (re-search-backward "[^0-9a-fA-F']" num-begin t)
1115 (setq digit-re
1116 (cond
1117 ((and (not (bobp)) (eq (char-before) ?0) (memq (char-after) '(?x ?X)))
1118 "[0-9a-fA-F]")
1119 ((and (eq (char-after (1+ (point))) ?0)
1120 (memq (char-after (+ 2 (point))) '(?b ?B)))
1121 "[01]")
1122 ((memq (char-after (1+ (point))) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
1123 "[0-9]")
1124 (t nil)))
1125 (when digit-re
1126 (cond ((eq (char-after) ?x) (forward-char))
1127 ((looking-at ".?0[Bb]") (goto-char (match-end 0)))
1128 ((looking-at digit-re))
1129 (t (forward-char)))
1130 (when (not (c-in-literal))
1131 (let ((num-end ; End of valid sequence of digits/quotes.
1132 (save-excursion
1133 (re-search-forward
1134 (concat "\\=\\(" digit-re "+'\\)*" digit-re "+") nil t)
1135 (point))))
1136 (setq try-end ; End of sequence of digits/quotes
1137 (save-excursion 1285 (save-excursion
1138 (re-search-forward 1286 (backward-char)
1139 (concat "\\=\\(" digit-re "\\|'\\)+") nil t) 1287 (eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '.
1140 (point))) 1288 ((c-quoted-number-straddling-point)
1141 (while (re-search-forward 1289 (setq num-beg (match-beginning 0)
1142 (concat digit-re "\\('\\)" digit-re) num-end t) 1290 num-end (match-end 0))
1143 (if old-len ; i.e. are we in an after-change function? 1291 (c-put-char-properties-on-char num-beg num-end
1144 (c-put-char-property (match-beginning 1) 'syntax-table '(1)) 1292 'syntax-table '(1) ?')
1145 (c-clear-char-property (match-beginning 1) 'syntax-table)) 1293 (c-put-char-properties-on-char num-beg num-end
1146 (backward-char))))) 1294 'c-digit-separator t ?')
1147 (goto-char try-end) 1295 (goto-char num-end))
1148 (setq num-begin (point))))) 1296 ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression.
1149 1297 (goto-char (match-end 0)))
1150;; The following doesn't seem needed at the moment (2016-08-15). 1298 (t (c-put-char-property (1- (point)) 'syntax-table '(1)))))))
1151;; (defun c-before-after-change-extend-region-for-lambda-capture
1152;; (_beg _end &optional _old-len)
1153;; ;; In C++ Mode, extend the region (c-new-BEG c-new-END) to cover any lambda
1154;; ;; function capture lists we happen to be inside. This function is expected
1155;; ;; to be called both as a before-change and after change function.
1156;; ;;
1157;; ;; Note that these things _might_ be nested, with a capture list looking
1158;; ;; like:
1159;; ;;
1160;; ;; [ ...., &foo = [..](){...}(..), ... ]
1161;; ;;
1162;; ;; . What a wonderful language is C++. ;-)
1163;; (c-save-buffer-state (paren-state pos)
1164;; (goto-char c-new-BEG)
1165;; (setq paren-state (c-parse-state))
1166;; (while (setq pos (c-pull-open-brace paren-state))
1167;; (goto-char pos)
1168;; (when (c-looking-at-c++-lambda-capture-list)
1169;; (setq c-new-BEG (min c-new-BEG pos))
1170;; (if (c-go-list-forward)
1171;; (setq c-new-END (max c-new-END (point))))))
1172
1173;; (goto-char c-new-END)
1174;; (setq paren-state (c-parse-state))
1175;; (while (setq pos (c-pull-open-brace paren-state))
1176;; (goto-char pos)
1177;; (when (c-looking-at-c++-lambda-capture-list)
1178;; (setq c-new-BEG (min c-new-BEG pos))
1179;; (if (c-go-list-forward)
1180;; (setq c-new-END (max c-new-END (point))))))))
1181 1299
1182(defun c-before-change (beg end) 1300(defun c-before-change (beg end)
1183 ;; Function to be put on `before-change-functions'. Primarily, this calls 1301 ;; Function to be put on `before-change-functions'. Primarily, this calls
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index b3848a74f97..b1c94c3bc6a 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -47,6 +47,7 @@
47;; `c-add-style' often contains references to functions defined there. 47;; `c-add-style' often contains references to functions defined there.
48 48
49;; Silence the compiler. 49;; Silence the compiler.
50(cc-bytecomp-defun c-guess-basic-syntax)
50(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs 51(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
51 52
52 53
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 902a5aace08..de0cd50911a 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -353,8 +353,6 @@ information):
353 Quotes all \"#\" characters that don't correspond to actual 353 Quotes all \"#\" characters that don't correspond to actual
354 Tcl comments. (Useful when editing code not originally created 354 Tcl comments. (Useful when editing code not originally created
355 with this mode). 355 with this mode).
356 `tcl-auto-fill-mode'
357 Auto-filling of Tcl comments.
358 356
359Add functions to the hook with `add-hook': 357Add functions to the hook with `add-hook':
360 358
@@ -1413,6 +1411,9 @@ Prefix argument means switch to the Tcl buffer afterwards."
1413 1411
1414(defun tcl-auto-fill-mode (&optional arg) 1412(defun tcl-auto-fill-mode (&optional arg)
1415 "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'." 1413 "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'."
1414 (declare
1415 (obsolete
1416 "Use `auto-fill-mode' with `comment-auto-fill-only-comments'." "26.1"))
1416 (interactive "P") 1417 (interactive "P")
1417 (auto-fill-mode arg) 1418 (auto-fill-mode arg)
1418 (if auto-fill-function 1419 (if auto-fill-function
diff --git a/lisp/select.el b/lisp/select.el
index 4849d7d515e..579c5c7e2ee 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -475,6 +475,9 @@ two markers or an overlay. Otherwise, it is nil."
475 (t 475 (t
476 (error "Unknown selection type: %S" type))))) 476 (error "Unknown selection type: %S" type)))))
477 477
478 ;; Most programs are unable to handle NUL bytes in strings.
479 (setq str (replace-regexp-in-string "\0" "\\0" str t t))
480
478 (setq next-selection-coding-system nil) 481 (setq next-selection-coding-system nil)
479 (cons type str)))) 482 (cons type str))))
480 483
diff --git a/lisp/ses.el b/lisp/ses.el
index fd7174d383d..97bade380ec 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -437,7 +437,7 @@ is nil if SYM is not a symbol that names a cell."
437 (declare (debug t)) 437 (declare (debug t))
438 `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) 438 `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
439 (if (eq rc :ses-named) 439 (if (eq rc :ses-named)
440 (gethash ,sym ses--named-cell-hashmap) 440 (and ses--named-cell-hashmap (gethash ,sym ses--named-cell-hashmap))
441 rc))) 441 rc)))
442 442
443(defun ses-cell-p (cell) 443(defun ses-cell-p (cell)
@@ -868,27 +868,39 @@ means Emacs will crash if FORMULA contains a circular list."
868 (oldref (ses-formula-references old)) 868 (oldref (ses-formula-references old))
869 (newref (ses-formula-references formula)) 869 (newref (ses-formula-references formula))
870 (inhibit-quit t) 870 (inhibit-quit t)
871 not-a-cell-ref-list
871 x xrow xcol) 872 x xrow xcol)
872 (cl-pushnew sym ses--deferred-recalc) 873 (cl-pushnew sym ses--deferred-recalc)
873 ;;Delete old references from this cell. Skip the ones that are also 874 ;;Delete old references from this cell. Skip the ones that are also
874 ;;in the new list. 875 ;;in the new list.
875 (dolist (ref oldref) 876 (dolist (ref oldref)
876 (unless (memq ref newref) 877 (unless (memq ref newref)
877 (setq x (ses-sym-rowcol ref) 878 ;; because we do not cancel edit when the user provides a
878 xrow (car x) 879 ;; false reference in it, then we need to check that ref
879 xcol (cdr x)) 880 ;; points to a cell that is within the spreadsheet.
880 (ses-set-cell xrow xcol 'references 881 (setq x (ses-sym-rowcol ref))
881 (delq sym (ses-cell-references xrow xcol))))) 882 (and x
883 (< (setq xrow (car x)) ses--numrows)
884 (< (setq xcol (cdr x)) ses--numcols)
885 (ses-set-cell xrow xcol 'references
886 (delq sym (ses-cell-references xrow xcol))))))
882 ;;Add new ones. Skip ones left over from old list 887 ;;Add new ones. Skip ones left over from old list
883 (dolist (ref newref) 888 (dolist (ref newref)
884 (setq x (ses-sym-rowcol ref) 889 (setq x (ses-sym-rowcol ref))
885 xrow (car x) 890 ;;Do not trust the user, the reference may be outside the spreadsheet
886 xcol (cdr x) 891 (if (and
887 x (ses-cell-references xrow xcol)) 892 x
888 (or (memq sym x) 893 (< (setq xrow (car x)) ses--numrows)
889 (ses-set-cell xrow xcol 'references (cons sym x)))) 894 (< (setq xcol (cdr x)) ses--numcols))
895 (progn
896 (setq x (ses-cell-references xrow xcol))
897 (or (memq sym x)
898 (ses-set-cell xrow xcol 'references (cons sym x))))
899 (cl-pushnew ref not-a-cell-ref-list)))
890 (ses-formula-record formula) 900 (ses-formula-record formula)
891 (ses-set-cell row col 'formula formula)))) 901 (ses-set-cell row col 'formula formula)
902 (and not-a-cell-ref-list
903 (error "Found in formula cells not in spreadsheet: %S" not-a-cell-ref-list)))))
892 904
893 905
894(defun ses-repair-cell-reference-all () 906(defun ses-repair-cell-reference-all ()
@@ -1529,7 +1541,13 @@ by (ROWINCR,COLINCR)."
1529 ;;Relocate this variable, unless it is a named cell 1541 ;;Relocate this variable, unless it is a named cell
1530 (if (eq (get sym 'ses-cell) :ses-named) 1542 (if (eq (get sym 'ses-cell) :ses-named)
1531 sym 1543 sym
1532 (ses-create-cell-symbol row col)) 1544 ;; otherwise, we create the relocated cell symbol because
1545 ;; ses-cell-symbol gives the old symbols, however since
1546 ;; renamed cell are not relocated we keep the relocated
1547 ;; cell old symbol in this case.
1548 (if (eq (get (setq sym (ses-cell-symbol row col)) 'ses-cell) :ses-named)
1549 sym
1550 (ses-create-cell-symbol row col)))
1533 ;;Delete reference to a deleted cell 1551 ;;Delete reference to a deleted cell
1534 nil)))) 1552 nil))))
1535 1553
@@ -2337,7 +2355,8 @@ to are recalculated first."
2337 "Recalculate and reprint all cells." 2355 "Recalculate and reprint all cells."
2338 (interactive "*") 2356 (interactive "*")
2339 (let ((startcell (ses--cell-at-pos (point))) 2357 (let ((startcell (ses--cell-at-pos (point)))
2340 (ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows) 2358 (ses--curcell (cons (ses-cell-symbol 0 0)
2359 (ses-cell-symbol (1- ses--numrows)
2341 (1- ses--numcols))))) 2360 (1- ses--numcols)))))
2342 (ses-recalculate-cell ses--curcell) 2361 (ses-recalculate-cell ses--curcell)
2343 (ses-jump-safe startcell))) 2362 (ses-jump-safe startcell)))
diff --git a/lisp/subr.el b/lisp/subr.el
index ef00286b341..a9edff6166f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -121,6 +121,7 @@ BODY should be a list of Lisp expressions.
121(defmacro setq-local (var val) 121(defmacro setq-local (var val)
122 "Set variable VAR to value VAL in current buffer." 122 "Set variable VAR to value VAL in current buffer."
123 ;; Can't use backquote here, it's too early in the bootstrap. 123 ;; Can't use backquote here, it's too early in the bootstrap.
124 (declare (debug (symbolp form)))
124 (list 'set (list 'make-local-variable (list 'quote var)) val)) 125 (list 'set (list 'make-local-variable (list 'quote var)) val))
125 126
126(defmacro defvar-local (var val &optional docstring) 127(defmacro defvar-local (var val &optional docstring)
@@ -4513,7 +4514,8 @@ EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
4513(defun backtrace () 4514(defun backtrace ()
4514 "Print a trace of Lisp function calls currently active. 4515 "Print a trace of Lisp function calls currently active.
4515Output stream used is value of `standard-output'." 4516Output stream used is value of `standard-output'."
4516 (let ((print-level (or print-level 8))) 4517 (let ((print-level (or print-level 8))
4518 (print-escape-control-characters t))
4517 (mapbacktrace #'backtrace--print-frame 'backtrace))) 4519 (mapbacktrace #'backtrace--print-frame 'backtrace)))
4518 4520
4519(defun backtrace-frames (&optional base) 4521(defun backtrace-frames (&optional base)
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index fda93884c40..be895a040da 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -396,7 +396,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
396;;; Fix interface to (X-specific) mouse.el 396;;; Fix interface to (X-specific) mouse.el
397(defun w32--set-selection (type value) 397(defun w32--set-selection (type value)
398 (if (eq type 'CLIPBOARD) 398 (if (eq type 'CLIPBOARD)
399 (w32-set-clipboard-data value) 399 (w32-set-clipboard-data (replace-regexp-in-string "\0" "\\0" value t t))
400 (put 'x-selections (or type 'PRIMARY) value))) 400 (put 'x-selections (or type 'PRIMARY) value)))
401 401
402(defun w32--get-selection (&optional type data-type) 402(defun w32--get-selection (&optional type data-type)
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 367114b83f5..c011f1b01bc 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -119,7 +119,8 @@ the value of `tooltip-y-offset' is ignored."
119(defcustom tooltip-frame-parameters 119(defcustom tooltip-frame-parameters
120 '((name . "tooltip") 120 '((name . "tooltip")
121 (internal-border-width . 2) 121 (internal-border-width . 2)
122 (border-width . 1)) 122 (border-width . 1)
123 (no-special-glyphs . t))
123 "Frame parameters used for tooltips. 124 "Frame parameters used for tooltips.
124 125
125If `left' or `top' parameters are included, they specify the absolute 126If `left' or `top' parameters are included, they specify the absolute
@@ -130,7 +131,8 @@ of the `tooltip' face are used instead."
130 :type '(repeat (cons :format "%v" 131 :type '(repeat (cons :format "%v"
131 (symbol :tag "Parameter") 132 (symbol :tag "Parameter")
132 (sexp :tag "Value"))) 133 (sexp :tag "Value")))
133 :group 'tooltip) 134 :group 'tooltip
135 :version "26.1")
134 136
135(defface tooltip 137(defface tooltip
136 '((((class color)) 138 '((((class color))
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 1fa085400d8..8657d19da8c 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,4 +1,4 @@
1;;; url-history.el --- Global history tracking for URL package 1;;; url-history.el --- Global history tracking for URL package -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc.
4 4
@@ -106,7 +106,7 @@ to run the `url-history-setup-save-timer' function manually."
106 106
107(defun url-history-update-url (url time) 107(defun url-history-update-url (url time)
108 (setq url-history-changed-since-last-save t) 108 (setq url-history-changed-since-last-save t)
109 (puthash (if (vectorp url) (url-recreate-url url) url) time 109 (puthash (if (url-p url) (url-recreate-url url) url) time
110 url-history-hash-table)) 110 url-history-hash-table))
111 111
112(autoload 'url-make-private-file "url-util") 112(autoload 'url-make-private-file "url-util")
@@ -157,6 +157,7 @@ user for what type to save as."
157 (gethash url url-history-hash-table nil)) 157 (gethash url url-history-hash-table nil))
158 158
159(defun url-completion-function (string predicate function) 159(defun url-completion-function (string predicate function)
160 (declare (obsolete url-history-hash-table "26.1"))
160 ;; Completion function to complete urls from the history. 161 ;; Completion function to complete urls from the history.
161 ;; This is obsolete since we can now pass the hash-table directly as a 162 ;; This is obsolete since we can now pass the hash-table directly as a
162 ;; completion table. 163 ;; completion table.
@@ -164,7 +165,7 @@ user for what type to save as."
164 (cond 165 (cond
165 ((eq function nil) 166 ((eq function nil)
166 (let ((list nil)) 167 (let ((list nil))
167 (maphash (lambda (key val) (push key list)) 168 (maphash (lambda (key _) (push key list))
168 url-history-hash-table) 169 url-history-hash-table)
169 ;; Not sure why we bother reversing the list. --Stef 170 ;; Not sure why we bother reversing the list. --Stef
170 (try-completion string (nreverse list) predicate))) 171 (try-completion string (nreverse list) predicate)))
@@ -172,7 +173,7 @@ user for what type to save as."
172 (let ((stub (concat "\\`" (regexp-quote string))) 173 (let ((stub (concat "\\`" (regexp-quote string)))
173 (retval nil)) 174 (retval nil))
174 (maphash 175 (maphash
175 (lambda (url time) 176 (lambda (url _)
176 (if (string-match stub url) (push url retval))) 177 (if (string-match stub url) (push url retval)))
177 url-history-hash-table) 178 url-history-hash-table)
178 retval)) 179 retval))
diff --git a/lisp/window.el b/lisp/window.el
index 8b07ed462c9..c933996a72f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -3703,7 +3703,7 @@ are one more than the actual value of these edges. Note that if
3703ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too." 3703ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
3704 (let* ((window (window-normalize-window window body)) 3704 (let* ((window (window-normalize-window window body))
3705 (frame (window-frame window)) 3705 (frame (window-frame window))
3706 (border-width (frame-border-width frame)) 3706 (border-width (frame-internal-border-width frame))
3707 (char-width (frame-char-width frame)) 3707 (char-width (frame-char-width frame))
3708 (char-height (frame-char-height frame)) 3708 (char-height (frame-char-height frame))
3709 (left (if pixelwise 3709 (left (if pixelwise
@@ -4572,12 +4572,13 @@ The function is called with one argument - a frame.
4572Functions affected by this option are those that bury a buffer 4572Functions affected by this option are those that bury a buffer
4573shown in a separate frame like `quit-window' and `bury-buffer'." 4573shown in a separate frame like `quit-window' and `bury-buffer'."
4574 :type '(choice (const :tag "Iconify" iconify-frame) 4574 :type '(choice (const :tag "Iconify" iconify-frame)
4575 (const :tag "Make invisible" make-frame-invisible)
4575 (const :tag "Delete" delete-frame) 4576 (const :tag "Delete" delete-frame)
4576 (const :tag "Do nothing" ignore) 4577 (const :tag "Do nothing" ignore)
4577 function) 4578 function)
4578 :group 'windows 4579 :group 'windows
4579 :group 'frames 4580 :group 'frames
4580 :version "24.1") 4581 :version "26.1")
4581 4582
4582(defun window--delete (&optional window dedicated-only kill) 4583(defun window--delete (&optional window dedicated-only kill)
4583 "Delete WINDOW if possible. 4584 "Delete WINDOW if possible.
@@ -4595,7 +4596,9 @@ if WINDOW gets deleted or its frame is auto-hidden."
4595 (cond 4596 (cond
4596 (kill 4597 (kill
4597 (delete-frame frame)) 4598 (delete-frame frame))
4598 ((functionp frame-auto-hide-function) 4599 ((functionp (frame-parameter frame 'auto-hide-function))
4600 (funcall (frame-parameter frame 'auto-hide-function)))
4601 ((functionp frame-auto-hide-function)
4599 (funcall frame-auto-hide-function frame)))) 4602 (funcall frame-auto-hide-function frame))))
4600 'frame) 4603 'frame)
4601 (deletable 4604 (deletable
@@ -6734,15 +6737,17 @@ live."
6734 window)) 6737 window))
6735 6738
6736(defun window--maybe-raise-frame (frame) 6739(defun window--maybe-raise-frame (frame)
6737 (let ((visible (frame-visible-p frame))) 6740 (make-frame-visible frame)
6738 (unless (or (not visible) 6741 (unless (or (frame-parameter frame 'no-focus-on-map)
6739 ;; Assume the selected frame is already visible enough. 6742 ;; Don't raise frames that should not get focus.
6740 (eq frame (selected-frame)) 6743 (frame-parameter frame 'no-accept-focus)
6741 ;; Assume the frame from which we invoked the 6744 ;; Assume the selected frame is already visible enough.
6742 ;; minibuffer is visible. 6745 (eq frame (selected-frame))
6743 (and (minibuffer-window-active-p (selected-window)) 6746 ;; Assume the frame from which we invoked the
6744 (eq frame (window-frame (minibuffer-selected-window))))) 6747 ;; minibuffer is visible.
6745 (raise-frame frame)))) 6748 (and (minibuffer-window-active-p (selected-window))
6749 (eq frame (window-frame (minibuffer-selected-window)))))
6750 (raise-frame frame)))
6746 6751
6747;; FIXME: Not implemented. 6752;; FIXME: Not implemented.
6748;; FIXME: By the way, there could be more levels of dedication: 6753;; FIXME: By the way, there could be more levels of dedication:
@@ -6762,6 +6767,7 @@ The actual non-nil value of this variable will be copied to the
6762 (const display-buffer-pop-up-window) 6767 (const display-buffer-pop-up-window)
6763 (const display-buffer-same-window) 6768 (const display-buffer-same-window)
6764 (const display-buffer-pop-up-frame) 6769 (const display-buffer-pop-up-frame)
6770 (const display-buffer-in-child-frame)
6765 (const display-buffer-below-selected) 6771 (const display-buffer-below-selected)
6766 (const display-buffer-at-bottom) 6772 (const display-buffer-at-bottom)
6767 (const display-buffer-in-previous-window) 6773 (const display-buffer-in-previous-window)
@@ -6908,6 +6914,7 @@ Available action functions include:
6908 `display-buffer-same-window' 6914 `display-buffer-same-window'
6909 `display-buffer-reuse-window' 6915 `display-buffer-reuse-window'
6910 `display-buffer-pop-up-frame' 6916 `display-buffer-pop-up-frame'
6917 `display-buffer-in-child-frame'
6911 `display-buffer-pop-up-window' 6918 `display-buffer-pop-up-window'
6912 `display-buffer-in-previous-window' 6919 `display-buffer-in-previous-window'
6913 `display-buffer-use-some-window' 6920 `display-buffer-use-some-window'
@@ -7239,6 +7246,7 @@ raising the frame."
7239 (get-largest-window frame t) alist) 7246 (get-largest-window frame t) alist)
7240 (window--try-to-split-window 7247 (window--try-to-split-window
7241 (get-lru-window frame t) alist)))) 7248 (get-lru-window frame t) alist))))
7249
7242 (prog1 (window--display-buffer 7250 (prog1 (window--display-buffer
7243 buffer window 'window alist display-buffer-mark-dedicated) 7251 buffer window 'window alist display-buffer-mark-dedicated)
7244 (unless (cdr (assq 'inhibit-switch-frame alist)) 7252 (unless (cdr (assq 'inhibit-switch-frame alist))
@@ -7258,6 +7266,47 @@ again with `display-buffer-pop-up-window'."
7258 (and pop-up-windows 7266 (and pop-up-windows
7259 (display-buffer-pop-up-window buffer alist)))) 7267 (display-buffer-pop-up-window buffer alist))))
7260 7268
7269(defun display-buffer-in-child-frame (buffer alist)
7270 "Display BUFFER in a child frame.
7271By default, this either reuses a child frame of the selected
7272frame or makes a new child frame of the selected frame. If
7273successful, return the window used; otherwise return nil.
7274
7275If ALIST has a non-nil 'child-frame-parameters' entry, the
7276corresponding value is an alist of frame parameters to give the
7277new frame. A 'parent-frame' parameter specifying the selected
7278frame is provided by default. If the child frame should be or
7279become the child of any other frame, a corresponding entry must
7280be added to ALIST."
7281 (let* ((parameters
7282 (append
7283 (cdr (assq 'child-frame-parameters alist))
7284 `((parent-frame . ,(selected-frame)))))
7285 (parent (or (assq 'parent-frame parameters)
7286 (selected-frame)))
7287 (share (assq 'share-child-frame parameters))
7288 share1 frame window)
7289 (with-current-buffer buffer
7290 (when (frame-live-p parent)
7291 (catch 'frame
7292 (dolist (frame1 (frame-list))
7293 (when (eq (frame-parent frame1) parent)
7294 (setq share1 (assq 'share-child-frame
7295 (frame-parameters frame1)))
7296 (when (eq share share1)
7297 (setq frame frame1)
7298 (throw 'frame t))))))
7299
7300 (if frame
7301 (setq window (frame-selected-window frame))
7302 (setq frame (make-frame parameters))
7303 (setq window (frame-selected-window frame))))
7304
7305 (prog1 (window--display-buffer
7306 buffer window 'frame alist display-buffer-mark-dedicated)
7307 (unless (cdr (assq 'inhibit-switch-frame alist))
7308 (window--maybe-raise-frame frame)))))
7309
7261(defun display-buffer-below-selected (buffer alist) 7310(defun display-buffer-below-selected (buffer alist)
7262 "Try displaying BUFFER in a window below the selected window. 7311 "Try displaying BUFFER in a window below the selected window.
7263If there is a window below the selected one and that window 7312If there is a window below the selected one and that window
@@ -7272,7 +7321,8 @@ below the selected one, use that window."
7272 (and (not (frame-parameter nil 'unsplittable)) 7321 (and (not (frame-parameter nil 'unsplittable))
7273 (let ((split-height-threshold 0) 7322 (let ((split-height-threshold 0)
7274 split-width-threshold) 7323 split-width-threshold)
7275 (setq window (window--try-to-split-window (selected-window) alist))) 7324 (setq window (window--try-to-split-window
7325 (selected-window) alist)))
7276 (window--display-buffer 7326 (window--display-buffer
7277 buffer window 'window alist display-buffer-mark-dedicated)) 7327 buffer window 'window alist display-buffer-mark-dedicated))
7278 (and (setq window (window-in-direction 'below)) 7328 (and (setq window (window-in-direction 'below))
@@ -7885,10 +7935,12 @@ See also `fit-frame-to-buffer-margins'."
7885(declare-function x-display-pixel-height "xfns.c" (&optional terminal)) 7935(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
7886 7936
7887(defun window--sanitize-margin (margin left right) 7937(defun window--sanitize-margin (margin left right)
7888 "Return MARGIN if it's a number between LEFT and RIGHT." 7938 "Return MARGIN if it's a number between LEFT and RIGHT.
7889 (when (and (numberp margin) 7939Return 0 otherwise."
7890 (<= left (- right margin)) (<= margin right)) 7940 (if (and (numberp margin)
7891 margin)) 7941 (<= left (- right margin)) (<= margin right))
7942 margin
7943 0))
7892 7944
7893(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) 7945(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
7894 7946
@@ -7906,190 +7958,197 @@ horizontally only.
7906 7958
7907The new position and size of FRAME can be additionally determined 7959The new position and size of FRAME can be additionally determined
7908by customizing the options `fit-frame-to-buffer-sizes' and 7960by customizing the options `fit-frame-to-buffer-sizes' and
7909`fit-frame-to-buffer-margins' or the corresponding parameters of 7961`fit-frame-to-buffer-margins' or setting the corresponding
7910FRAME." 7962parameters of FRAME."
7911 (interactive) 7963 (interactive)
7912 (unless (and (fboundp 'x-display-pixel-height) 7964 (unless (fboundp 'display-monitor-attributes-list)
7913 ;; We need the respective sizes now.
7914 (fboundp 'display-monitor-attributes-list))
7915 (user-error "Cannot resize frame in non-graphic Emacs")) 7965 (user-error "Cannot resize frame in non-graphic Emacs"))
7916 (setq frame (window-normalize-frame frame)) 7966 (setq frame (window-normalize-frame frame))
7917 (when (window-live-p (frame-root-window frame)) 7967 (when (window-live-p (frame-root-window frame))
7918 (with-selected-window (frame-root-window frame) 7968 (let* ((char-width (frame-char-width frame))
7919 (let* ((char-width (frame-char-width)) 7969 (char-height (frame-char-height frame))
7920 (char-height (frame-char-height)) 7970 ;; WINDOW is FRAME's root window.
7921 (monitor-attributes (car (display-monitor-attributes-list 7971 (window (frame-root-window frame))
7922 (frame-parameter frame 'display)))) 7972 (parent (frame-parent frame))
7923 (geometry (cdr (assq 'geometry monitor-attributes))) 7973 (monitor-attributes
7924 (display-width (- (nth 2 geometry) (nth 0 geometry))) 7974 (unless parent
7925 (display-height (- (nth 3 geometry) (nth 1 geometry))) 7975 (car (display-monitor-attributes-list
7926 (workarea (cdr (assq 'workarea monitor-attributes))) 7976 (frame-parameter frame 'display)))))
7927 ;; Handle margins. 7977 ;; FRAME'S parent or display sizes. Used in connection
7928 (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins) 7978 ;; with margins.
7929 fit-frame-to-buffer-margins)) 7979 (geometry
7930 (left-margin (if (nth 0 margins) 7980 (unless parent
7931 (or (window--sanitize-margin 7981 (cdr (assq 'geometry monitor-attributes))))
7932 (nth 0 margins) 0 display-width) 7982 (parent-or-display-width
7933 0) 7983 (if parent
7934 (nth 0 workarea))) 7984 (frame-native-width parent)
7935 (top-margin (if (nth 1 margins) 7985 (- (nth 2 geometry) (nth 0 geometry))))
7936 (or (window--sanitize-margin 7986 (parent-or-display-height
7937 (nth 1 margins) 0 display-height) 7987 (if parent
7938 0) 7988 (frame-native-height parent)
7939 (nth 1 workarea))) 7989 (- (nth 3 geometry) (nth 1 geometry))))
7940 (workarea-width (nth 2 workarea)) 7990 ;; FRAME'S parent or workarea sizes. Used when no margins
7941 (right-margin (if (nth 2 margins) 7991 ;; are specified.
7942 (- display-width 7992 (parent-or-workarea
7943 (or (window--sanitize-margin 7993 (if parent
7944 (nth 2 margins) left-margin display-width) 7994 `(0 0 ,parent-or-display-width ,parent-or-display-height)
7945 0)) 7995 (cdr (assq 'workarea monitor-attributes))))
7946 (nth 2 workarea))) 7996 ;; The outer size of FRAME. Needed to calculate the
7947 (workarea-height (nth 3 workarea)) 7997 ;; margins around the root window's body that have to
7948 (bottom-margin (if (nth 3 margins) 7998 ;; remain untouched by fitting.
7949 (- display-height 7999 (outer-edges (frame-edges frame 'outer-edges))
7950 (or (window--sanitize-margin 8000 (outer-width (if outer-edges
7951 (nth 3 margins) top-margin display-height) 8001 (- (nth 2 outer-edges) (nth 0 outer-edges))
7952 0)) 8002 ;; A poor guess.
7953 (nth 3 workarea))) 8003 (frame-pixel-width frame)))
7954 ;; The pixel width of FRAME (which does not include the 8004 (outer-height (if outer-edges
7955 ;; window manager's decorations). 8005 (- (nth 3 outer-edges) (nth 1 outer-edges))
7956 (frame-width (frame-pixel-width)) 8006 ;; Another poor guess.
7957 ;; The pixel width of the body of FRAME's root window. 8007 (frame-pixel-height frame)))
7958 (window-body-width (window-body-width nil t)) 8008 ;; The text size of of FRAME. Needed to specify FRAME's
7959 ;; The difference in pixels between total and body width of 8009 ;; text size after the root window's body's new sizes have
7960 ;; FRAME's window. 8010 ;; been calculated.
7961 (window-extra-width (- (window-pixel-width) window-body-width)) 8011 (text-width (frame-text-width frame))
7962 ;; The difference in pixels between the frame's pixel width 8012 (text-height (frame-text-height frame))
7963 ;; and the window's body width. This is the space we can't 8013 ;; WINDOW's body size.
7964 ;; use for fitting. 8014 (body-width (window-body-width window t))
7965 (extra-width (- frame-width window-body-width)) 8015 (body-height (window-body-height window t))
7966 ;; The pixel position of FRAME's left border. We usually 8016 ;; The difference between FRAME's outer size and WINDOW's
7967 ;; try to leave this alone. 8017 ;; body size.
7968 (left 8018 (outer-minus-body-width (- outer-width body-width))
7969 (let ((left (frame-parameter nil 'left))) 8019 (outer-minus-body-height (- outer-height body-height))
7970 (if (consp left) 8020 ;; The difference between FRAME's text size and WINDOW's
7971 (funcall (car left) (cadr left)) 8021 ;; body size (these values "should" be positive).
7972 left))) 8022 (text-minus-body-width (- text-width body-width))
7973 ;; The pixel height of FRAME (which does not include title 8023 (text-minus-body-height (- text-height body-height))
7974 ;; line, decorations, and sometimes neither the menu nor 8024 ;; The current position of FRAME.
7975 ;; the toolbar). 8025 (position (frame-position frame))
7976 (frame-height (frame-pixel-height)) 8026 (left (car position))
7977 ;; The pixel height of FRAME's root window (we don't care 8027 (top (cdr position))
7978 ;; about the window's body height since the return value of 8028 ;; The margins specified for FRAME. These represent pixel
7979 ;; `window-text-pixel-size' includes header and mode line). 8029 ;; offsets from the left, top, right and bottom edge of the
7980 (window-height (window-pixel-height)) 8030 ;; display or FRAME's parent's native rectangle and have to
7981 ;; The difference in pixels between the frame's pixel 8031 ;; take care of the display's taskbar and other obstacles.
7982 ;; height and the window's height. 8032 ;; If they are unspecified, constrain the resulting frame
7983 (extra-height (- frame-height window-height)) 8033 ;; to its workarea or the parent frame's native rectangle.
7984 ;; The pixel position of FRAME's top border. 8034 (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
7985 (top 8035 fit-frame-to-buffer-margins))
7986 (let ((top (frame-parameter nil 'top))) 8036 ;; Convert margins intto pixel offsets from the left-top
7987 (if (consp top) 8037 ;; corner of FRAME's display or parent.
7988 (funcall (car top) (cadr top)) 8038 (left-margin (if (nth 0 margins)
7989 top))) 8039 (window--sanitize-margin
7990 ;; Sanitize minimum and maximum sizes. 8040 (nth 0 margins) 0 parent-or-display-width)
7991 (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes) 8041 (nth 0 parent-or-workarea)))
7992 fit-frame-to-buffer-sizes)) 8042 (top-margin (if (nth 1 margins)
7993 (max-height 8043 (window--sanitize-margin
7994 (cond 8044 (nth 1 margins) 0 parent-or-display-height)
7995 ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height)) 8045 (nth 1 parent-or-workarea)))
7996 ((numberp max-height) (* max-height char-height)) 8046 (right-margin (if (nth 2 margins)
7997 (t display-height))) 8047 (- parent-or-display-width
7998 (min-height 8048 (window--sanitize-margin
7999 (cond 8049 (nth 2 margins) left-margin
8000 ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height)) 8050 parent-or-display-width))
8001 ((numberp min-height) (* min-height char-height)) 8051 (nth 2 parent-or-workarea)))
8002 (t (* window-min-height char-height)))) 8052 (bottom-margin (if (nth 3 margins)
8003 (max-width 8053 (- parent-or-display-height
8004 (cond 8054 (window--sanitize-margin
8005 ((numberp (nth 2 sizes)) 8055 (nth 3 margins) top-margin
8006 (- (* (nth 2 sizes) char-width) window-extra-width)) 8056 parent-or-display-height))
8007 ((numberp max-width) 8057 (nth 3 parent-or-workarea)))
8008 (- (* max-width char-width) window-extra-width)) 8058 ;; Minimum and maximum sizes specified for FRAME.
8009 (t display-width))) 8059 (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
8010 (min-width 8060 fit-frame-to-buffer-sizes))
8011 (cond 8061 ;; Calculate the minimum and maximum pixel sizes of FRAME
8012 ((numberp (nth 3 sizes)) 8062 ;; from the values provided by the MAX-HEIGHT, MIN-HEIGHT,
8013 (- (* (nth 3 sizes) char-width) window-extra-width)) 8063 ;; MAX-WIDTH and MIN-WIDTH arguments or, if these are nil,
8014 ((numberp min-width) 8064 ;; from those provided by `fit-frame-to-buffer-sizes'.
8015 (- (* min-width char-width) window-extra-width)) 8065 (max-height
8016 (t (* window-min-width char-width)))) 8066 (min
8017 ;; Note: Currently, for a new frame the sizes of the header 8067 (cond
8018 ;; and mode line may be estimated incorrectly 8068 ((numberp max-height) (* max-height char-height))
8019 (value (window-text-pixel-size 8069 ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
8020 nil t t workarea-width workarea-height t)) 8070 (t parent-or-display-height))
8021 (width (+ (car value) (window-right-divider-width))) 8071 ;; The following is the maximum height that fits into the
8022 (height 8072 ;; top and bottom margins.
8023 (+ (cdr value) 8073 (max (- bottom-margin top-margin outer-minus-body-height))))
8024 (window-bottom-divider-width) 8074 (min-height
8025 (window-scroll-bar-height)))) 8075 (cond
8026 ;; Don't change height or width when the window's size is fixed 8076 ((numberp min-height) (* min-height char-height))
8027 ;; in either direction or ONLY forbids it. 8077 ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
8028 (cond 8078 (t (window-min-size window nil nil t))))
8029 ((or (eq window-size-fixed 'width) (eq only 'vertically)) 8079 (max-width
8030 (setq width nil)) 8080 (min
8031 ((or (eq window-size-fixed 'height) (eq only 'horizontally)) 8081 (cond
8032 (setq height nil))) 8082 ((numberp max-width) (* max-width char-width))
8033 ;; Fit width to constraints. 8083 ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width))
8034 (when width 8084 (t parent-or-display-width))
8035 (unless frame-resize-pixelwise 8085 ;; The following is the maximum width that fits into the
8036 ;; Round to character sizes. 8086 ;; left and right margins.
8037 (setq width (* (/ (+ width char-width -1) char-width) 8087 (max (- right-margin left-margin outer-minus-body-width))))
8038 char-width))) 8088 (min-width
8039 ;; Fit to maximum and minimum widths. 8089 (cond
8040 (setq width (max (min width max-width) min-width)) 8090 ((numberp min-width) (* min-width char-width))
8041 ;; Add extra width. 8091 ((numberp (nth 3 sizes)) (nth 3 sizes))
8042 (setq width (+ width extra-width)) 8092 (t (window-min-size window t nil t))))
8043 ;; Preserve margins. 8093 ;; Note: Currently, for a new frame the sizes of the header
8044 (let ((right (+ left width))) 8094 ;; and mode line may be estimated incorrectly
8045 (cond 8095 (size
8046 ((> right right-margin) 8096 (window-text-pixel-size window t t max-width max-height))
8047 ;; Move frame to left (we don't know its real width). 8097 (width (max (car size) min-width))
8048 (setq left (max left-margin (- left (- right right-margin))))) 8098 (height (max (cdr size) min-height)))
8049 ((< left left-margin) 8099 ;; Don't change height or width when the window's size is fixed
8050 ;; Move frame to right. 8100 ;; in either direction or ONLY forbids it.
8051 (setq left left-margin))))) 8101 (cond
8052 ;; Fit height to constraints. 8102 ((or (eq window-size-fixed 'width) (eq only 'vertically))
8053 (when height 8103 (setq width nil))
8054 (unless frame-resize-pixelwise 8104 ((or (eq window-size-fixed 'height) (eq only 'horizontally))
8055 (setq height (* (/ (+ height char-height -1) char-height) 8105 (setq height nil)))
8056 char-height))) 8106 ;; Fit width to constraints.
8057 ;; Fit to maximum and minimum heights. 8107 (when width
8058 (setq height (max (min height max-height) min-height)) 8108 (unless frame-resize-pixelwise
8059 ;; Add extra height. 8109 ;; Round to character sizes.
8060 (setq height (+ height extra-height)) 8110 (setq width (* (/ (+ width char-width -1) char-width)
8061 ;; Preserve margins. 8111 char-width)))
8062 (let ((bottom (+ top height))) 8112 ;; The new outer width (in pixels).
8063 (cond 8113 (setq outer-width (+ width outer-minus-body-width))
8064 ((> bottom bottom-margin) 8114 ;; Maybe move FRAME to preserve margins.
8065 ;; Move frame up (we don't know its real height). 8115 (let ((right (+ left outer-width)))
8066 (setq top (max top-margin (- top (- bottom bottom-margin))))) 8116 (cond
8067 ((< top top-margin) 8117 ((> right right-margin)
8068 ;; Move frame down. 8118 ;; Move frame to left.
8069 (setq top top-margin))))) 8119 (setq left (max left-margin (- left (- right right-margin)))))
8070 ;; Apply changes. 8120 ((< left left-margin)
8071 (set-frame-position frame left top) 8121 ;; Move frame to right.
8072 ;; Clumsily try to translate our calculations to what 8122 (setq left left-margin)))))
8073 ;; `set-frame-size' wants. 8123 ;; Fit height to constraints.
8074 (when width 8124 (when height
8075 (setq width (- (+ (frame-text-width) width) 8125 (unless frame-resize-pixelwise
8076 extra-width window-body-width))) 8126 (setq height (* (/ (+ height char-height -1) char-height)
8077 (when height 8127 char-height)))
8078 (setq height (- (+ (frame-text-height) height) 8128 ;; The new outer height.
8079 extra-height window-height))) 8129 (setq outer-height (+ height outer-minus-body-height))
8080 (set-frame-size 8130 ;; Preserve margins.
8081 frame 8131 (let ((bottom (+ top outer-height)))
8082 (if width 8132 (cond
8083 (if frame-resize-pixelwise 8133 ((> bottom bottom-margin)
8084 width 8134 ;; Move frame up.
8085 (/ width char-width)) 8135 (setq top (max top-margin (- top (- bottom bottom-margin)))))
8086 (frame-text-width)) 8136 ((< top top-margin)
8087 (if height 8137 ;; Move frame down.
8088 (if frame-resize-pixelwise 8138 (setq top top-margin)))))
8089 height 8139 ;; Apply our changes.
8090 (/ height char-height)) 8140 (setq text-width
8091 (frame-text-height)) 8141 (if width
8092 frame-resize-pixelwise))))) 8142 (+ width text-minus-body-width)
8143 (frame-text-width frame)))
8144 (setq text-height
8145 (if height
8146 (+ height text-minus-body-height)
8147 (frame-text-height frame)))
8148 (modify-frame-parameters
8149 frame `((left . ,left) (top . ,top)
8150 (width . (text-pixels . ,text-width))
8151 (height . (text-pixels . ,text-height)))))))
8093 8152
8094(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size) 8153(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size)
8095 "Adjust size of WINDOW to display its buffer's contents exactly. 8154 "Adjust size of WINDOW to display its buffer's contents exactly.
@@ -8286,6 +8345,168 @@ Return non-nil if the window was shrunk, nil otherwise."
8286 (when (and (window-combined-p window) 8345 (when (and (window-combined-p window)
8287 (pos-visible-in-window-p (point-min) window)) 8346 (pos-visible-in-window-p (point-min) window))
8288 (fit-window-to-buffer window (window-total-height window)))) 8347 (fit-window-to-buffer window (window-total-height window))))
8348
8349(defun window-largest-empty-rectangle--maximums-1 (quad maximums)
8350 "Support function for `window-largest-empty-rectangle'."
8351 (cond
8352 ((null maximums)
8353 (list quad))
8354 ((> (car quad) (caar maximums))
8355 (cons quad maximums))
8356 (t
8357 (cons (car maximums)
8358 (window-largest-empty-rectangle--maximums-1 quad (cdr maximums))))))
8359
8360(defun window-largest-empty-rectangle--maximums (quad maximums count)
8361 "Support function for `window-largest-empty-rectangle'."
8362 (setq maximums (window-largest-empty-rectangle--maximums-1 quad maximums))
8363 (if (> (length maximums) count)
8364 (nbutlast maximums)
8365 maximums))
8366
8367(defun window-largest-empty-rectangle--disjoint-maximums (maximums count)
8368 "Support function for `window-largest-empty-rectangle'."
8369 (setq maximums (sort maximums (lambda (x y) (> (car x) (car y)))))
8370 (let ((new-length 0)
8371 new-maximums)
8372 (while (and maximums (< new-length count))
8373 (let* ((maximum (car maximums))
8374 (at (nth 2 maximum))
8375 (to (nth 3 maximum)))
8376 (catch 'drop
8377 (dolist (new-maximum new-maximums)
8378 (let ((new-at (nth 2 new-maximum))
8379 (new-to (nth 3 new-maximum)))
8380 (when (if (< at new-at) (> to new-at) (< at new-to))
8381 ;; Intersection -> drop.
8382 (throw 'drop nil))))
8383 (setq new-maximums (cons maximum new-maximums))
8384 (setq new-length (1+ new-length)))
8385 (setq maximums (cdr maximums))))
8386
8387 (nreverse new-maximums)))
8388
8389(defun window-largest-empty-rectangle (&optional window count min-width min-height positions left)
8390 "Return dimensions of largest empty rectangle in WINDOW.
8391WINDOW must be a live window and defaults to the selected one.
8392
8393The return value is a triple of the width and the start and end
8394Y-coordinates of the largest rectangle that can be inscribed into
8395the empty space (the space not displaying any text) of WINDOW's
8396text area. The return value is nil if the current glyph matrix
8397of WINDOW is not up-to-date.
8398
8399Optional argument COUNT, if non-nil, specifies the maximum number
8400of rectangles to return. This means that the return value is a
8401list of triples specifying rectangles with the largest rectangle
8402first. COUNT can be also a cons cell whose car specifies the
8403number of rectangles to return and whose cdr, if non-nil, states
8404that all rectangles returned must be disjoint.
8405
8406Note that the right edge of any rectangle returned by this
8407function is the right edge of WINDOW (the left edge if its buffer
8408displays RTL text).
8409
8410Optional arguments MIN-WIDTH and MIN-HEIGHT, if non-nil, specify
8411the minimum width and height of any rectangle returned.
8412
8413Optional argument POSITIONS, if non-nil, is a cons cell whose car
8414specifies the uppermost and whose cdr specifies the lowermost
8415pixel position that must be covered by any rectangle returned.
8416Note that positions are counted from the start of the text area
8417of WINDOW.
8418
8419Optional argument LEFT, if non-nil, means to return values suitable for
8420buffers displaying right to left text."
8421 ;; Process lines as returned by ‘window-lines-pixel-dimensions’.
8422 ;; STACK is a stack that contains rows that have to be processed yet.
8423 (let* ((window (window-normalize-window window t))
8424 (disjoint (and (consp count) (cdr count)))
8425 (count (or (and (numberp count) count)
8426 (and (consp count) (numberp (car count)) (car count))))
8427 (rows (window-lines-pixel-dimensions window nil nil t t left))
8428 (rows-at 0)
8429 (max-size 0)
8430 row stack stack-at stack-to
8431 top top-width top-at top-to top-size
8432 max-width max-at max-to maximums)
8433 ;; ROWS-AT is the position where the first element of ROWS starts.
8434 ;; STACK-AT is the position where the first element of STACK starts.
8435 (while rows
8436 (setq row (car rows))
8437 (if (or (not stack) (>= (car row) (caar stack)))
8438 (progn
8439 (unless stack
8440 (setq stack-at rows-at))
8441 (setq stack (cons row stack))
8442 ;; Set ROWS-AT to where the first element of ROWS ends
8443 ;; which, after popping ROW, makes it the start position of
8444 ;; the next ROW.
8445 (setq rows-at (cdr row))
8446 (setq rows (cdr rows)))
8447 (setq top (car stack))
8448 (setq stack (cdr stack))
8449 (setq top-width (car top))
8450 (setq top-at (if stack (cdar stack) stack-at))
8451 (setq top-to (cdr top))
8452 (setq top-size (* top-width (- top-to top-at)))
8453 (unless (or (and min-width (< top-width min-width))
8454 (and min-height (< (- top-to top-at) min-height))
8455 (and positions
8456 (or (> top-at (car positions))
8457 (< top-to (cdr positions)))))
8458 (if count
8459 (if disjoint
8460 (setq maximums (cons (list top-size top-width top-at top-to)
8461 maximums))
8462 (setq maximums (window-largest-empty-rectangle--maximums
8463 (list top-size top-width top-at top-to)
8464 maximums count)))
8465 (when (> top-size max-size)
8466 (setq max-size top-size)
8467 (setq max-width top-width)
8468 (setq max-at top-at)
8469 (setq max-to top-to))))
8470 (if (and stack (> (caar stack) (car row)))
8471 ;; Have new top element of stack include old top.
8472 (setq stack (cons (cons (caar stack) (cdr top)) (cdr stack)))
8473 ;; Move rows-at backwards to top-at.
8474 (setq rows-at top-at))))
8475
8476 (when stack
8477 ;; STACK-TO is the position where the stack ends.
8478 (setq stack-to (cdar stack))
8479 (while stack
8480 (setq top (car stack))
8481 (setq stack (cdr stack))
8482 (setq top-width (car top))
8483 (setq top-at (if stack (cdar stack) stack-at))
8484 (setq top-size (* top-width (- stack-to top-at)))
8485 (unless (or (and min-width (< top-width min-width))
8486 (and min-height (< (- stack-to top-at) min-height))
8487 (and positions
8488 (or (> top-at (car positions))
8489 (< stack-to (cdr positions)))))
8490 (if count
8491 (if disjoint
8492 (setq maximums (cons (list top-size top-width top-at stack-to)
8493 maximums))
8494 (setq maximums (window-largest-empty-rectangle--maximums
8495 (list top-size top-width top-at stack-to)
8496 maximums count)))
8497 (when (> top-size max-size)
8498 (setq max-size top-size)
8499 (setq max-width top-width)
8500 (setq max-at top-at)
8501 (setq max-to stack-to))))))
8502
8503 (cond
8504 (maximums
8505 (if disjoint
8506 (window-largest-empty-rectangle--disjoint-maximums maximums count)
8507 maximums))
8508 ((> max-size 0)
8509 (list max-width max-at max-to)))))
8289 8510
8290(defun kill-buffer-and-window () 8511(defun kill-buffer-and-window ()
8291 "Kill the current buffer and delete the selected window." 8512 "Kill the current buffer and delete the selected window."
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 1ac58e871cc..107645df4fd 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -158,6 +158,7 @@ AC_DEFUN([gl_EARLY],
158 # Code from module timespec-sub: 158 # Code from module timespec-sub:
159 # Code from module u64: 159 # Code from module u64:
160 # Code from module unistd: 160 # Code from module unistd:
161 # Code from module unlocked-io:
161 # Code from module update-copyright: 162 # Code from module update-copyright:
162 # Code from module utimens: 163 # Code from module utimens:
163 # Code from module vararrays: 164 # Code from module vararrays:
@@ -399,6 +400,7 @@ AC_DEFUN([gl_INIT],
399 gl_TIMER_TIME 400 gl_TIMER_TIME
400 gl_TIMESPEC 401 gl_TIMESPEC
401 gl_UNISTD_H 402 gl_UNISTD_H
403 gl_FUNC_GLIBC_UNLOCKED_IO
402 gl_UTIMENS 404 gl_UTIMENS
403 AC_C_VARARRAYS 405 AC_C_VARARRAYS
404 gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false 406 gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
@@ -940,6 +942,7 @@ AC_DEFUN([gl_FILE_LIST], [
940 lib/u64.h 942 lib/u64.h
941 lib/unistd.c 943 lib/unistd.c
942 lib/unistd.in.h 944 lib/unistd.in.h
945 lib/unlocked-io.h
943 lib/utimens.c 946 lib/utimens.c
944 lib/utimens.h 947 lib/utimens.h
945 lib/verify.h 948 lib/verify.h
@@ -1044,6 +1047,7 @@ AC_DEFUN([gl_FILE_LIST], [
1044 m4/timespec.m4 1047 m4/timespec.m4
1045 m4/tm_gmtoff.m4 1048 m4/tm_gmtoff.m4
1046 m4/unistd_h.m4 1049 m4/unistd_h.m4
1050 m4/unlocked-io.m4
1047 m4/utimens.m4 1051 m4/utimens.m4
1048 m4/utimes.m4 1052 m4/utimes.m4
1049 m4/vararrays.m4 1053 m4/vararrays.m4
diff --git a/m4/unlocked-io.m4 b/m4/unlocked-io.m4
new file mode 100644
index 00000000000..448ccac2f0e
--- /dev/null
+++ b/m4/unlocked-io.m4
@@ -0,0 +1,41 @@
1# unlocked-io.m4 serial 15
2
3# Copyright (C) 1998-2006, 2009-2017 Free Software Foundation, Inc.
4#
5# This file is free software; the Free Software Foundation
6# gives unlimited permission to copy and/or distribute it,
7# with or without modifications, as long as this notice is preserved.
8
9dnl From Jim Meyering.
10dnl
11dnl See if the glibc *_unlocked I/O macros or functions are available.
12dnl Use only those *_unlocked macros or functions that are declared
13dnl (because some of them were declared in Solaris 2.5.1 but were removed
14dnl in Solaris 2.6, whereas we want binaries built on Solaris 2.5.1 to run
15dnl on Solaris 2.6).
16
17AC_DEFUN([gl_FUNC_GLIBC_UNLOCKED_IO],
18[
19 AC_DEFINE([USE_UNLOCKED_IO], [1],
20 [Define to 1 if you want getc etc. to use unlocked I/O if available.
21 Unlocked I/O can improve performance in unithreaded apps,
22 but it is not safe for multithreaded apps.])
23
24 dnl Persuade glibc and Solaris <stdio.h> to declare
25 dnl fgets_unlocked(), fputs_unlocked() etc.
26 AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
27
28 AC_CHECK_DECLS_ONCE([clearerr_unlocked])
29 AC_CHECK_DECLS_ONCE([feof_unlocked])
30 AC_CHECK_DECLS_ONCE([ferror_unlocked])
31 AC_CHECK_DECLS_ONCE([fflush_unlocked])
32 AC_CHECK_DECLS_ONCE([fgets_unlocked])
33 AC_CHECK_DECLS_ONCE([fputc_unlocked])
34 AC_CHECK_DECLS_ONCE([fputs_unlocked])
35 AC_CHECK_DECLS_ONCE([fread_unlocked])
36 AC_CHECK_DECLS_ONCE([fwrite_unlocked])
37 AC_CHECK_DECLS_ONCE([getc_unlocked])
38 AC_CHECK_DECLS_ONCE([getchar_unlocked])
39 AC_CHECK_DECLS_ONCE([putc_unlocked])
40 AC_CHECK_DECLS_ONCE([putchar_unlocked])
41])
diff --git a/src/charset.c b/src/charset.c
index 9d15375dd79..d0840f7d2a9 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -29,7 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
29#include <config.h> 29#include <config.h>
30 30
31#include <errno.h> 31#include <errno.h>
32#include <stdio.h>
33#include <stdlib.h> 32#include <stdlib.h>
34#include <unistd.h> 33#include <unistd.h>
35#include <limits.h> 34#include <limits.h>
@@ -40,6 +39,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
40#include "charset.h" 39#include "charset.h"
41#include "coding.h" 40#include "coding.h"
42#include "buffer.h" 41#include "buffer.h"
42#include "sysstdio.h"
43 43
44/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) *** 44/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
45 45
@@ -198,10 +198,6 @@ static struct
198 198
199#define GET_TEMP_CHARSET_WORK_DECODER(CODE) \ 199#define GET_TEMP_CHARSET_WORK_DECODER(CODE) \
200 (temp_charset_work->table.decoder[(CODE)]) 200 (temp_charset_work->table.decoder[(CODE)])
201
202#ifndef HAVE_GETC_UNLOCKED
203#define getc_unlocked getc
204#endif
205 201
206 202
207/* Set to 1 to warn that a charset map is loaded and thus a buffer 203/* Set to 1 to warn that a charset map is loaded and thus a buffer
diff --git a/src/cm.c b/src/cm.c
index efa50b0f58d..9a90f37445c 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -19,10 +19,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 19
20 20
21#include <config.h> 21#include <config.h>
22#include <stdio.h>
23 22
24#include "lisp.h" 23#include "lisp.h"
25#include "cm.h" 24#include "cm.h"
25#include "sysstdio.h"
26#include "termchar.h" 26#include "termchar.h"
27#include "tparam.h" 27#include "tparam.h"
28 28
@@ -45,8 +45,8 @@ int
45cmputc (int c) 45cmputc (int c)
46{ 46{
47 if (current_tty->termscript) 47 if (current_tty->termscript)
48 putc (c & 0177, current_tty->termscript); 48 putc_unlocked (c & 0177, current_tty->termscript);
49 putc (c & 0177, current_tty->output); 49 putc_unlocked (c & 0177, current_tty->output);
50 return c; 50 return c;
51} 51}
52 52
@@ -117,11 +117,11 @@ cmcheckmagic (struct tty_display_info *tty)
117 if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1) 117 if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1)
118 emacs_abort (); 118 emacs_abort ();
119 if (tty->termscript) 119 if (tty->termscript)
120 putc ('\r', tty->termscript); 120 putc_unlocked ('\r', tty->termscript);
121 putc ('\r', tty->output); 121 putc_unlocked ('\r', tty->output);
122 if (tty->termscript) 122 if (tty->termscript)
123 putc ('\n', tty->termscript); 123 putc_unlocked ('\n', tty->termscript);
124 putc ('\n', tty->output); 124 putc_unlocked ('\n', tty->output);
125 curX (tty) = 0; 125 curX (tty) = 0;
126 curY (tty)++; 126 curY (tty)++;
127 } 127 }
diff --git a/src/dispextern.h b/src/dispextern.h
index d1e4715c329..8644ce26d13 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1106,7 +1106,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
1106#define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \ 1106#define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \
1107 ((MATRIX)->rows \ 1107 ((MATRIX)->rows \
1108 + (MATRIX)->nrows \ 1108 + (MATRIX)->nrows \
1109 - (WINDOW_WANTS_MODELINE_P ((W)) ? 1 : 0)) 1109 - (window_wants_mode_line ((W)) ? 1 : 0))
1110 1110
1111/* Non-zero if the face of the last glyph in ROW's text area has 1111/* Non-zero if the face of the last glyph in ROW's text area has
1112 to be drawn to the end of the text area. */ 1112 to be drawn to the end of the text area. */
@@ -1469,40 +1469,6 @@ struct glyph_string
1469#define DESIRED_HEADER_LINE_HEIGHT(W) \ 1469#define DESIRED_HEADER_LINE_HEIGHT(W) \
1470 MATRIX_HEADER_LINE_HEIGHT ((W)->desired_matrix) 1470 MATRIX_HEADER_LINE_HEIGHT ((W)->desired_matrix)
1471 1471
1472/* PXW: The height checks below serve to show at least one text line
1473 instead of a mode- and/or header line when a window gets very small.
1474 But (1) the check fails when the mode- or header-line is taller than
1475 the associated frame's line height and (2) we don't care much about
1476 text visibility anyway when shrinking a frame containing a toolbar.
1477
1478 So maybe these checks should be removed and any clipping left to the
1479 window manager. */
1480
1481/* Value is true if window W wants a mode line and is large enough
1482 to accommodate it. */
1483#define WINDOW_WANTS_MODELINE_P(W) \
1484 (BUFFERP ((W)->contents) \
1485 ? (!MINI_WINDOW_P (W) \
1486 && !(W)->pseudo_window_p \
1487 && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \
1488 && !NILP (BVAR (XBUFFER ((W)->contents), mode_line_format)) \
1489 && WINDOW_PIXEL_HEIGHT (W) > WINDOW_FRAME_LINE_HEIGHT (W)) \
1490 : false)
1491
1492/* Value is true if window W wants a header line and is large enough
1493 to accommodate it. */
1494#define WINDOW_WANTS_HEADER_LINE_P(W) \
1495 (BUFFERP ((W)->contents) \
1496 ? (!MINI_WINDOW_P (W) \
1497 && !(W)->pseudo_window_p \
1498 && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \
1499 && !NILP (BVAR (XBUFFER ((W)->contents), header_line_format)) \
1500 && (WINDOW_PIXEL_HEIGHT (W) \
1501 > (WINDOW_WANTS_MODELINE_P (W) \
1502 ? (2 * WINDOW_FRAME_LINE_HEIGHT (W)) \
1503 : WINDOW_FRAME_LINE_HEIGHT (W)))) \
1504 : false)
1505
1506/* Return proper value to be used as baseline offset of font that has 1472/* Return proper value to be used as baseline offset of font that has
1507 ASCENT and DESCENT to draw characters by the font at the vertical 1473 ASCENT and DESCENT to draw characters by the font at the vertical
1508 center of the line of frame F. 1474 center of the line of frame F.
diff --git a/src/dispnew.c b/src/dispnew.c
index 27c69bde831..93ef6a55a2e 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -377,7 +377,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
377 { 377 {
378 window_box (w, ANY_AREA, 0, 0, &window_width, &window_height); 378 window_box (w, ANY_AREA, 0, 0, &window_width, &window_height);
379 379
380 header_line_p = WINDOW_WANTS_HEADER_LINE_P (w); 380 header_line_p = window_wants_header_line (w);
381 header_line_changed_p = header_line_p != matrix->header_line_p; 381 header_line_changed_p = header_line_p != matrix->header_line_p;
382 } 382 }
383 matrix->header_line_p = header_line_p; 383 matrix->header_line_p = header_line_p;
@@ -446,7 +446,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
446 446
447 if (w == NULL 447 if (w == NULL
448 || (row == matrix->rows + dim.height - 1 448 || (row == matrix->rows + dim.height - 1
449 && WINDOW_WANTS_MODELINE_P (w)) 449 && window_wants_mode_line (w))
450 || (row == matrix->rows && matrix->header_line_p)) 450 || (row == matrix->rows && matrix->header_line_p))
451 { 451 {
452 row->glyphs[TEXT_AREA] 452 row->glyphs[TEXT_AREA]
@@ -491,7 +491,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
491 491
492 /* The mode line, if displayed, never has marginal areas. */ 492 /* The mode line, if displayed, never has marginal areas. */
493 if ((row == matrix->rows + dim.height - 1 493 if ((row == matrix->rows + dim.height - 1
494 && !(w && WINDOW_WANTS_MODELINE_P (w))) 494 && !(w && window_wants_mode_line (w)))
495 || (row == matrix->rows && matrix->header_line_p)) 495 || (row == matrix->rows && matrix->header_line_p))
496 { 496 {
497 row->glyphs[TEXT_AREA] 497 row->glyphs[TEXT_AREA]
@@ -570,7 +570,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
570 the mode line, if any, since otherwise it will remain 570 the mode line, if any, since otherwise it will remain
571 disabled in the current matrix, and expose events won't 571 disabled in the current matrix, and expose events won't
572 redraw it. */ 572 redraw it. */
573 if (WINDOW_WANTS_MODELINE_P (w)) 573 if (window_wants_mode_line (w))
574 w->update_mode_line = 1; 574 w->update_mode_line = 1;
575 } 575 }
576 else if (matrix == w->desired_matrix) 576 else if (matrix == w->desired_matrix)
@@ -3126,9 +3126,9 @@ update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p)
3126 if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) 3126 if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
3127 { 3127 {
3128 if (FRAME_TTY (f)->termscript) 3128 if (FRAME_TTY (f)->termscript)
3129 fflush (FRAME_TTY (f)->termscript); 3129 fflush_unlocked (FRAME_TTY (f)->termscript);
3130 if (FRAME_TERMCAP_P (f)) 3130 if (FRAME_TERMCAP_P (f))
3131 fflush (FRAME_TTY (f)->output); 3131 fflush_unlocked (FRAME_TTY (f)->output);
3132 } 3132 }
3133 3133
3134 /* Check window matrices for lost pointers. */ 3134 /* Check window matrices for lost pointers. */
@@ -3181,8 +3181,8 @@ update_frame_with_menu (struct frame *f, int row, int col)
3181 update_end (f); 3181 update_end (f);
3182 3182
3183 if (FRAME_TTY (f)->termscript) 3183 if (FRAME_TTY (f)->termscript)
3184 fflush (FRAME_TTY (f)->termscript); 3184 fflush_unlocked (FRAME_TTY (f)->termscript);
3185 fflush (FRAME_TTY (f)->output); 3185 fflush_unlocked (FRAME_TTY (f)->output);
3186 /* Check window matrices for lost pointers. */ 3186 /* Check window matrices for lost pointers. */
3187#if GLYPH_DEBUG 3187#if GLYPH_DEBUG
3188#if 0 3188#if 0
@@ -4531,7 +4531,7 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p,
4531 ptrdiff_t outq = __fpending (display_output); 4531 ptrdiff_t outq = __fpending (display_output);
4532 if (outq > 900 4532 if (outq > 900
4533 || (outq > 20 && ((i - 1) % preempt_count == 0))) 4533 || (outq > 20 && ((i - 1) % preempt_count == 0)))
4534 fflush (display_output); 4534 fflush_unlocked (display_output);
4535 } 4535 }
4536 } 4536 }
4537 4537
@@ -5188,7 +5188,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
5188 start position, i.e. it excludes the header-line row, but 5188 start position, i.e. it excludes the header-line row, but
5189 MATRIX_ROW includes the header-line row. Adjust for a possible 5189 MATRIX_ROW includes the header-line row. Adjust for a possible
5190 header-line row. */ 5190 header-line row. */
5191 it_vpos = it.vpos + WINDOW_WANTS_HEADER_LINE_P (w); 5191 it_vpos = it.vpos + window_wants_header_line (w);
5192 if (it_vpos < w->current_matrix->nrows 5192 if (it_vpos < w->current_matrix->nrows
5193 && (row = MATRIX_ROW (w->current_matrix, it_vpos), 5193 && (row = MATRIX_ROW (w->current_matrix, it_vpos),
5194 row->enabled_p)) 5194 row->enabled_p))
@@ -5615,13 +5615,13 @@ when TERMINAL is nil. */)
5615 5615
5616 if (tty->termscript) 5616 if (tty->termscript)
5617 { 5617 {
5618 fwrite (SDATA (string), 1, SBYTES (string), tty->termscript); 5618 fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->termscript);
5619 fflush (tty->termscript); 5619 fflush_unlocked (tty->termscript);
5620 } 5620 }
5621 out = tty->output; 5621 out = tty->output;
5622 } 5622 }
5623 fwrite (SDATA (string), 1, SBYTES (string), out); 5623 fwrite_unlocked (SDATA (string), 1, SBYTES (string), out);
5624 fflush (out); 5624 fflush_unlocked (out);
5625 unblock_input (); 5625 unblock_input ();
5626 return Qnil; 5626 return Qnil;
5627} 5627}
@@ -5636,7 +5636,7 @@ terminate any keyboard macro currently executing. */)
5636 if (!NILP (arg)) 5636 if (!NILP (arg))
5637 { 5637 {
5638 if (noninteractive) 5638 if (noninteractive)
5639 putchar (07); 5639 putchar_unlocked (07);
5640 else 5640 else
5641 ring_bell (XFRAME (selected_frame)); 5641 ring_bell (XFRAME (selected_frame));
5642 } 5642 }
@@ -5650,7 +5650,7 @@ void
5650bitch_at_user (void) 5650bitch_at_user (void)
5651{ 5651{
5652 if (noninteractive) 5652 if (noninteractive)
5653 putchar (07); 5653 putchar_unlocked (07);
5654 else if (!INTERACTIVE) /* Stop executing a keyboard macro. */ 5654 else if (!INTERACTIVE) /* Stop executing a keyboard macro. */
5655 { 5655 {
5656 const char *msg 5656 const char *msg
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 2693a4529d6..7b1a402eeff 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -575,6 +575,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
575 MODULE_FUNCTION_BEGIN (module_nil); 575 MODULE_FUNCTION_BEGIN (module_nil);
576 if (! (0 <= length && length <= STRING_BYTES_BOUND)) 576 if (! (0 <= length && length <= STRING_BYTES_BOUND))
577 xsignal0 (Qoverflow_error); 577 xsignal0 (Qoverflow_error);
578 /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated,
579 but we shouldn’t require that. */
578 AUTO_STRING_WITH_LEN (lstr, str, length); 580 AUTO_STRING_WITH_LEN (lstr, str, length);
579 return lisp_to_value (env, 581 return lisp_to_value (env,
580 code_convert_string_norecord (lstr, Qutf_8, false)); 582 code_convert_string_norecord (lstr, Qutf_8, false));
@@ -599,7 +601,6 @@ module_get_user_ptr (emacs_env *env, emacs_value uptr)
599static void 601static void
600module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) 602module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
601{ 603{
602 /* FIXME: This function should return bool because it can fail. */
603 MODULE_FUNCTION_BEGIN (); 604 MODULE_FUNCTION_BEGIN ();
604 Lisp_Object lisp = value_to_lisp (uptr); 605 Lisp_Object lisp = value_to_lisp (uptr);
605 CHECK_USER_PTR (lisp); 606 CHECK_USER_PTR (lisp);
@@ -619,7 +620,6 @@ static void
619module_set_user_finalizer (emacs_env *env, emacs_value uptr, 620module_set_user_finalizer (emacs_env *env, emacs_value uptr,
620 emacs_finalizer_function fin) 621 emacs_finalizer_function fin)
621{ 622{
622 /* FIXME: This function should return bool because it can fail. */
623 MODULE_FUNCTION_BEGIN (); 623 MODULE_FUNCTION_BEGIN ();
624 Lisp_Object lisp = value_to_lisp (uptr); 624 Lisp_Object lisp = value_to_lisp (uptr);
625 CHECK_USER_PTR (lisp); 625 CHECK_USER_PTR (lisp);
@@ -638,7 +638,6 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i)
638static void 638static void
639module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) 639module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
640{ 640{
641 /* FIXME: This function should return bool because it can fail. */
642 MODULE_FUNCTION_BEGIN (); 641 MODULE_FUNCTION_BEGIN ();
643 Lisp_Object lvec = value_to_lisp (vec); 642 Lisp_Object lvec = value_to_lisp (vec);
644 check_vec_index (lvec, i); 643 check_vec_index (lvec, i);
@@ -657,7 +656,6 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
657static ptrdiff_t 656static ptrdiff_t
658module_vec_size (emacs_env *env, emacs_value vec) 657module_vec_size (emacs_env *env, emacs_value vec)
659{ 658{
660 /* FIXME: Return a sentinel value (e.g., -1) on error. */
661 MODULE_FUNCTION_BEGIN (0); 659 MODULE_FUNCTION_BEGIN (0);
662 Lisp_Object lvec = value_to_lisp (vec); 660 Lisp_Object lvec = value_to_lisp (vec);
663 CHECK_VECTOR (lvec); 661 CHECK_VECTOR (lvec);
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 339234fdb51..40b6448d27e 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -80,7 +80,7 @@ enum emacs_funcall_exit
80 emacs_funcall_exit_signal = 1, 80 emacs_funcall_exit_signal = 1,
81 81
82 /* Function has exit using `throw'. */ 82 /* Function has exit using `throw'. */
83 emacs_funcall_exit_throw = 2, 83 emacs_funcall_exit_throw = 2
84}; 84};
85 85
86struct emacs_env_25 86struct emacs_env_25
@@ -97,6 +97,7 @@ struct emacs_env_26
97 97
98/* Every module should define a function as follows. */ 98/* Every module should define a function as follows. */
99extern int emacs_module_init (struct emacs_runtime *ert) 99extern int emacs_module_init (struct emacs_runtime *ert)
100 EMACS_NOEXCEPT
100 EMACS_ATTRIBUTE_NONNULL(1); 101 EMACS_ATTRIBUTE_NONNULL(1);
101 102
102#ifdef __cplusplus 103#ifdef __cplusplus
diff --git a/src/emacs.c b/src/emacs.c
index da8df1bf1c7..0fec7167588 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 23
24#include <errno.h> 24#include <errno.h>
25#include <fcntl.h> 25#include <fcntl.h>
26#include <stdio.h>
27#include <stdlib.h> 26#include <stdlib.h>
28 27
29#include <sys/file.h> 28#include <sys/file.h>
@@ -33,6 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
33 32
34#define MAIN_PROGRAM 33#define MAIN_PROGRAM
35#include "lisp.h" 34#include "lisp.h"
35#include "sysstdio.h"
36 36
37#ifdef WINDOWSNT 37#ifdef WINDOWSNT
38#include <fcntl.h> 38#include <fcntl.h>
@@ -885,7 +885,7 @@ main (int argc, char **argv)
885 } 885 }
886#endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */ 886#endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */
887 887
888 clearerr (stdin); 888 clearerr_unlocked (stdin);
889 889
890 emacs_backtrace (-1); 890 emacs_backtrace (-1);
891 891
@@ -983,7 +983,7 @@ main (int argc, char **argv)
983 int i; 983 int i;
984 printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]); 984 printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]);
985 for (i = 0; i < ARRAYELTS (usage_message); i++) 985 for (i = 0; i < ARRAYELTS (usage_message); i++)
986 fputs (usage_message[i], stdout); 986 fputs_unlocked (usage_message[i], stdout);
987 exit (0); 987 exit (0);
988 } 988 }
989 989
@@ -2197,7 +2197,7 @@ You must run Emacs in batch mode in order to dump it. */)
2197 } 2197 }
2198#endif 2198#endif
2199 2199
2200 fflush (stdout); 2200 fflush_unlocked (stdout);
2201 /* Tell malloc where start of impure now is. */ 2201 /* Tell malloc where start of impure now is. */
2202 /* Also arrange for warnings when nearly out of space. */ 2202 /* Also arrange for warnings when nearly out of space. */
2203#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC 2203#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
diff --git a/src/fileio.c b/src/fileio.c
index cb070029a9b..a57d50b24e0 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5643,14 +5643,12 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
5643 { 5643 {
5644 block_input (); 5644 block_input ();
5645 if (!NILP (BVAR (b, filename))) 5645 if (!NILP (BVAR (b, filename)))
5646 { 5646 fwrite_unlocked (SDATA (BVAR (b, filename)), 1,
5647 fwrite (SDATA (BVAR (b, filename)), 1, 5647 SBYTES (BVAR (b, filename)), stream);
5648 SBYTES (BVAR (b, filename)), stream); 5648 putc_unlocked ('\n', stream);
5649 } 5649 fwrite_unlocked (SDATA (BVAR (b, auto_save_file_name)), 1,
5650 putc ('\n', stream); 5650 SBYTES (BVAR (b, auto_save_file_name)), stream);
5651 fwrite (SDATA (BVAR (b, auto_save_file_name)), 1, 5651 putc_unlocked ('\n', stream);
5652 SBYTES (BVAR (b, auto_save_file_name)), stream);
5653 putc ('\n', stream);
5654 unblock_input (); 5652 unblock_input ();
5655 } 5653 }
5656 5654
@@ -5841,7 +5839,7 @@ effect except for flushing STREAM's data. */)
5841 5839
5842 binmode = NILP (mode) ? O_TEXT : O_BINARY; 5840 binmode = NILP (mode) ? O_TEXT : O_BINARY;
5843 if (fp != stdin) 5841 if (fp != stdin)
5844 fflush (fp); 5842 fflush_unlocked (fp);
5845 5843
5846 return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil; 5844 return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
5847} 5845}
diff --git a/src/frame.c b/src/frame.c
index 4d17a071dc7..1e5e4bbdb48 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -328,8 +328,8 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
328 * frame_windows_min_size: 328 * frame_windows_min_size:
329 * 329 *
330 * Return the minimum number of lines (columns if HORIZONTAL is non-nil) 330 * Return the minimum number of lines (columns if HORIZONTAL is non-nil)
331 * of FRAME. If PIXELWISE is non-nil, return the minimum height (width) 331 * of FRAME. If PIXELWISE is non-nil, return the minimum inner height
332 * in pixels. 332 * (width) of FRAME in pixels.
333 * 333 *
334 * This value is calculated by the function `frame-windows-min-size' in 334 * This value is calculated by the function `frame-windows-min-size' in
335 * window.el unless the `min-height' (`min-width' if HORIZONTAL is 335 * window.el unless the `min-height' (`min-width' if HORIZONTAL is
@@ -341,7 +341,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
341 * of `window-min-height' (`window-min-width' if HORIZONTAL is non-nil). 341 * of `window-min-height' (`window-min-width' if HORIZONTAL is non-nil).
342 * With IGNORE non-nil the values of these variables are ignored. 342 * With IGNORE non-nil the values of these variables are ignored.
343 * 343 *
344 * In either case never return a value less than 1. 344 * In either case, never return a value less than 1.
345 */ 345 */
346static int 346static int
347frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, 347frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
@@ -373,46 +373,173 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
373} 373}
374 374
375 375
376/* Make sure windows sizes of frame F are OK. new_width and new_height 376#ifdef HAVE_WINDOW_SYSTEM
377 are in pixels. A value of -1 means no change is requested for that 377/**
378 size (but the frame may still have to be resized to accommodate 378 * keep_ratio:
379 windows with their minimum sizes). This can either issue a request 379 *
380 to resize the frame externally (via x_set_window_size), to resize the 380 * Preserve ratios of frame F which usually happens after its parent
381 frame internally (via resize_frame_windows) or do nothing at all. 381 * frame P got resized. OLD_WIDTH, OLD_HEIGHT specifies the old native
382 * size of F's parent, NEW_WIDTH and NEW_HEIGHT its new size.
383 *
384 * Adjust F's width if F's 'keep_ratio' parameter is non-nil and, if
385 * it is a cons, its car is not 'height-only'. Adjust F's height if F's
386 * 'keep_ratio' parameter is non-nil and, if it is a cons, its car
387 * is not 'width-only'.
388 *
389 * Adjust F's left position if F's 'keep_ratio' parameter is non-nil
390 * and, if its is a cons, its cdr is non-nil and not 'top-only'. Adjust
391 * F's top position if F's 'keep_ratio' parameter is non-nil and, if
392 * its is a cons, its cdr is non-nil and not 'left-only'.
393 *
394 * Note that when positional adjustment is requested but the size of F
395 * should remain unaltered in the corresponding direction, this routine
396 * tries to constrain F to its parent frame - something which usually
397 * happens when the parent frame shrinks. This means, however, that
398 * when the parent frame is re-enlarged later, the child's original
399 * position will not get restored to its pre-shrinking value.
400 *
401 * This routine is currently useful for child frames only. It might be
402 * eventually useful when moving non-child frames between monitors with
403 * different resolutions.
404 */
405static void
406keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height,
407 int new_width, int new_height)
408{
409 Lisp_Object keep_ratio = get_frame_param (f, Qkeep_ratio);
410
411
412 if (!NILP (keep_ratio))
413 {
414 double width_factor = (double)new_width / (double)old_width;
415 double height_factor = (double)new_height / (double)old_height;
416 int pixel_width, pixel_height, pos_x, pos_y;
417
418 if (!CONSP (keep_ratio) || !NILP (Fcdr (keep_ratio)))
419 {
420 if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qtop_only))
421 pos_x = f->left_pos;
422 else
423 {
424 pos_x = (int)(f->left_pos * width_factor + 0.5);
382 425
383 The argument INHIBIT can assume the following values: 426 if (CONSP (keep_ratio)
427 && (NILP (Fcar (keep_ratio))
428 || EQ (Fcar (keep_ratio), Qheight_only))
429 && p->pixel_width - f->pixel_width < pos_x)
430 {
431 int p_f_width = p->pixel_width - f->pixel_width;
384 432
385 0 means to unconditionally call x_set_window_size even if sizes 433 if (p_f_width <= 0)
386 apparently do not change. Fx_create_frame uses this to pass the 434 pos_x = 0;
387 initial size to the window manager. 435 else
436 pos_x = (int)(p_f_width * width_factor * 0.5 + 0.5);
437 }
388 438
389 1 means to call x_set_window_size if the outer frame size really 439 f->left_pos = pos_x;
390 changes. Fset_frame_size, Fset_frame_height, ... use this. 440 }
391 441
392 2 means to call x_set_window_size provided frame_inhibit_resize 442 if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qleft_only))
393 allows it. The menu and tool bar code use this ("3" won't work 443 pos_y = f->top_pos;
394 here in general because menu and tool bar are often not counted in 444 else
395 the frame's text height). 445 {
446 pos_y = (int)(f->top_pos * height_factor + 0.5);
447
448 if (CONSP (keep_ratio)
449 && (NILP (Fcar (keep_ratio))
450 || EQ (Fcar (keep_ratio), Qwidth_only))
451 && p->pixel_height - f->pixel_height < pos_y)
452 /* When positional adjustment was requested and the
453 width of F should remain unaltered, try to constrain
454 F to its parent. This means that when the parent
455 frame is enlarged later the child's original position
456 won't get restored. */
457 {
458 int p_f_height = p->pixel_height - f->pixel_height;
396 459
397 3 means call x_set_window_size if window minimum sizes must be 460 if (p_f_height <= 0)
398 preserved or frame_inhibit_resize allows it. x_set_left_fringe, 461 pos_y = 0;
399 x_set_scroll_bar_width, x_new_font ... use (or should use) this. 462 else
463 pos_y = (int)(p_f_height * height_factor * 0.5 + 0.5);
464 }
400 465
401 4 means call x_set_window_size only if window minimum sizes must be 466 f->top_pos = pos_y;
402 preserved. x_set_right_divider_width, x_set_border_width and the 467 }
403 code responsible for wrapping the tool bar use this.
404 468
405 5 means to never call x_set_window_size. change_frame_size uses 469 x_set_offset (f, pos_x, pos_y, -1);
406 this. 470 }
407 471
408 Note that even when x_set_window_size is not called, individual 472 if (!CONSP (keep_ratio) || !NILP (Fcar (keep_ratio)))
409 windows may have to be resized (via `window--sanitize-window-sizes') 473 {
410 in order to support minimum size constraints. 474 if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qheight_only))
475 pixel_width = -1;
476 else
477 {
478 pixel_width = (int)(f->pixel_width * width_factor + 0.5);
479 pixel_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, pixel_width);
480 }
411 481
412 PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the 482 if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qwidth_only))
413 symbol of the parameter changed (like `menu-bar-lines', `font', ...). 483 pixel_height = -1;
414 This is passed on to frame_inhibit_resize to let the latter decide on 484 else
415 a case-by-case basis whether the frame may be resized externally. */ 485 {
486 pixel_height = (int)(f->pixel_height * height_factor + 0.5);
487 pixel_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixel_height);
488 }
489
490 adjust_frame_size (f, pixel_width, pixel_height, 1, 0,
491 Qkeep_ratio);
492 }
493 }
494}
495#endif
496
497
498/**
499 * adjust_frame_size:
500 *
501 * Adjust size of frame F. NEW_WIDTH and NEW_HEIGHT specify the new
502 * text size of F in pixels. A value of -1 means no change is requested
503 * for that direction (but the frame may still have to be resized to
504 * accommodate windows with their minimum sizes). This can either issue
505 * a request to resize the frame externally (via x_set_window_size), to
506 * resize the frame internally (via resize_frame_windows) or do nothing
507 * at all.
508 *
509 * The argument INHIBIT can assume the following values:
510 *
511 * 0 means to unconditionally call x_set_window_size even if sizes
512 * apparently do not change. Fx_create_frame uses this to pass the
513 * initial size to the window manager.
514 *
515 * 1 means to call x_set_window_size if the native frame size really
516 * changes. Fset_frame_size, Fset_frame_height, ... use this.
517 *
518 * 2 means to call x_set_window_size provided frame_inhibit_resize
519 * allows it. The menu and tool bar code use this ("3" won't work
520 * here in general because menu and tool bar are often not counted in
521 * the frame's text height).
522 *
523 * 3 means call x_set_window_size if window minimum sizes must be
524 * preserved or frame_inhibit_resize allows it. x_set_left_fringe,
525 * x_set_scroll_bar_width, x_new_font ... use (or should use) this.
526 *
527 * 4 means call x_set_window_size only if window minimum sizes must be
528 * preserved. x_set_right_divider_width, x_set_border_width and the
529 * code responsible for wrapping the tool bar use this.
530 *
531 * 5 means to never call x_set_window_size. change_frame_size uses
532 * this.
533 *
534 * Note that even when x_set_window_size is not called, individual
535 * windows may have to be resized (via `window--sanitize-window-sizes')
536 * in order to support minimum size constraints.
537 *
538 * PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the
539 * symbol of the parameter changed (like `menu-bar-lines', `font', ...).
540 * This is passed on to frame_inhibit_resize to let the latter decide on
541 * a case-by-case basis whether the frame may be resized externally.
542 */
416void 543void
417adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, 544adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
418 bool pretend, Lisp_Object parameter) 545 bool pretend, Lisp_Object parameter)
@@ -636,6 +763,18 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
636 || new_pixel_height != old_pixel_height); 763 || new_pixel_height != old_pixel_height);
637 764
638 unblock_input (); 765 unblock_input ();
766
767#ifdef HAVE_WINDOW_SYSTEM
768 {
769 /* Adjust size of F's child frames. */
770 Lisp_Object frames, frame1;
771
772 FOR_EACH_FRAME (frames, frame1)
773 if (FRAME_PARENT_FRAME (XFRAME (frame1)) == f)
774 keep_ratio (XFRAME (frame1), f, old_pixel_width, old_pixel_height,
775 new_pixel_width, new_pixel_height);
776 }
777#endif
639} 778}
640 779
641/* Allocate basically initialized frame. */ 780/* Allocate basically initialized frame. */
@@ -684,6 +823,7 @@ make_frame (bool mini_p)
684 f->horizontal_scroll_bars = false; 823 f->horizontal_scroll_bars = false;
685 f->want_fullscreen = FULLSCREEN_NONE; 824 f->want_fullscreen = FULLSCREEN_NONE;
686 f->undecorated = false; 825 f->undecorated = false;
826 f->no_special_glyphs = false;
687#ifndef HAVE_NTGUI 827#ifndef HAVE_NTGUI
688 f->override_redirect = false; 828 f->override_redirect = false;
689#endif 829#endif
@@ -2004,8 +2144,101 @@ The functions are run with one argument, the frame to be deleted. */)
2004{ 2144{
2005 return delete_frame (frame, !NILP (force) ? Qt : Qnil); 2145 return delete_frame (frame, !NILP (force) ? Qt : Qnil);
2006} 2146}
2007
2008 2147
2148#ifdef HAVE_WINDOW_SYSTEM
2149/**
2150 * frame_internal_border_part:
2151 *
2152 * Return part of internal border the coordinates X and Y relative to
2153 * frame F are on. Return nil if the coordinates are not on the
2154 * internal border of F.
2155 *
2156 * Return one of INTERNAL_BORDER_LEFT_EDGE, INTERNAL_BORDER_TOP_EDGE,
2157 * INTERNAL_BORDER_RIGHT_EDGE or INTERNAL_BORDER_BOTTOM_EDGE when the
2158 * mouse cursor is on the corresponding border with an offset of at
2159 * least one canonical character height from that border's edges.
2160 *
2161 * If no border part could be found this way, return one of
2162 * INTERNAL_BORDER_TOP_LEFT_CORNER, INTERNAL_BORDER_TOP_RIGHT_CORNER,
2163 * INTERNAL_BORDER_BOTTOM_LEFT_CORNER or
2164 * INTERNAL_BORDER_BOTTOM_RIGHT_CORNER to indicate that the mouse is in
2165 * one of the corresponding corners. This means that for very small
2166 * frames an `edge' return value is preferred.
2167 */
2168enum internal_border_part
2169frame_internal_border_part (struct frame *f, int x, int y)
2170{
2171 int border = FRAME_INTERNAL_BORDER_WIDTH (f);
2172 int offset = FRAME_LINE_HEIGHT (f);
2173 int width = FRAME_PIXEL_WIDTH (f);
2174 int height = FRAME_PIXEL_HEIGHT (f);
2175 enum internal_border_part part = INTERNAL_BORDER_NONE;
2176
2177 if (offset < border)
2178 /* For very wide borders make offset at least as large as
2179 border. */
2180 offset = border;
2181
2182 if (offset < x && x < width - offset)
2183 /* Top or bottom border. */
2184 {
2185 if (0 <= y && y <= border)
2186 part = INTERNAL_BORDER_TOP_EDGE;
2187 else if (height - border <= y && y <= height)
2188 part = INTERNAL_BORDER_BOTTOM_EDGE;
2189 }
2190 else if (offset < y && y < height - offset)
2191 /* Left or right border. */
2192 {
2193 if (0 <= x && x <= border)
2194 part = INTERNAL_BORDER_LEFT_EDGE;
2195 else if (width - border <= x && x <= width)
2196 part = INTERNAL_BORDER_RIGHT_EDGE;
2197 }
2198 else
2199 {
2200 /* An edge. */
2201 int half_width = width / 2;
2202 int half_height = height / 2;
2203
2204 if (0 <= x && x <= border)
2205 {
2206 /* A left edge. */
2207 if (0 <= y && y <= half_height)
2208 part = INTERNAL_BORDER_TOP_LEFT_CORNER;
2209 else if (half_height < y && y <= height)
2210 part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER;
2211 }
2212 else if (width - border <= x && x <= width)
2213 {
2214 /* A right edge. */
2215 if (0 <= y && y <= half_height)
2216 part = INTERNAL_BORDER_TOP_RIGHT_CORNER;
2217 else if (half_height < y && y <= height)
2218 part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER;
2219 }
2220 else if (0 <= y && y <= border)
2221 {
2222 /* A top edge. */
2223 if (0 <= x && x <= half_width)
2224 part = INTERNAL_BORDER_TOP_LEFT_CORNER;
2225 else if (half_width < x && x <= width)
2226 part = INTERNAL_BORDER_TOP_RIGHT_CORNER;
2227 }
2228 else if (height - border <= y && y <= height)
2229 {
2230 /* A bottom edge. */
2231 if (0 <= x && x <= half_width)
2232 part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER;
2233 else if (half_width < x && x <= width)
2234 part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER;
2235 }
2236 }
2237
2238 return part;
2239}
2240#endif
2241
2009/* Return mouse position in character cell units. */ 2242/* Return mouse position in character cell units. */
2010 2243
2011DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0, 2244DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
@@ -2962,49 +3195,47 @@ For a terminal screen, the value is always 1. */)
2962 return make_number (1); 3195 return make_number (1);
2963} 3196}
2964 3197
2965DEFUN ("frame-pixel-height", Fframe_pixel_height, 3198DEFUN ("frame-native-width", Fframe_native_width,
2966 Sframe_pixel_height, 0, 1, 0, 3199 Sframe_native_width, 0, 1, 0,
2967 doc: /* Return a FRAME's height in pixels. 3200 doc: /* Return FRAME's native width in pixels.
2968If FRAME is omitted or nil, the selected frame is used. The exact value 3201For a terminal frame, the result really gives the width in characters.
2969of the result depends on the window-system and toolkit in use: 3202If FRAME is omitted or nil, the selected frame is used. */)
2970
2971In the Gtk+ version of Emacs, it includes only any window (including
2972the minibuffer or echo area), mode line, and header line. It does not
2973include the tool bar or menu bar.
2974
2975With other graphical versions, it also includes the tool bar and the
2976menu bar.
2977
2978For a text terminal, it includes the menu bar. In this case, the
2979result is really in characters rather than pixels (i.e., is identical
2980to `frame-height'). */)
2981 (Lisp_Object frame) 3203 (Lisp_Object frame)
2982{ 3204{
2983 struct frame *f = decode_any_frame (frame); 3205 struct frame *f = decode_any_frame (frame);
2984 3206
2985#ifdef HAVE_WINDOW_SYSTEM 3207#ifdef HAVE_WINDOW_SYSTEM
2986 if (FRAME_WINDOW_P (f)) 3208 if (FRAME_WINDOW_P (f))
2987 return make_number (FRAME_PIXEL_HEIGHT (f)); 3209 return make_number (FRAME_PIXEL_WIDTH (f));
2988 else 3210 else
2989#endif 3211#endif
2990 return make_number (FRAME_TOTAL_LINES (f)); 3212 return make_number (FRAME_TOTAL_COLS (f));
2991} 3213}
2992 3214
2993DEFUN ("frame-pixel-width", Fframe_pixel_width, 3215DEFUN ("frame-native-height", Fframe_native_height,
2994 Sframe_pixel_width, 0, 1, 0, 3216 Sframe_native_height, 0, 1, 0,
2995 doc: /* Return FRAME's width in pixels. 3217 doc: /* Return FRAME's native height in pixels.
2996For a terminal frame, the result really gives the width in characters. 3218If FRAME is omitted or nil, the selected frame is used. The exact value
2997If FRAME is omitted or nil, the selected frame is used. */) 3219of the result depends on the window-system and toolkit in use:
3220
3221In the Gtk+ and NS versions, it includes only any window (including the
3222minibuffer or echo area), mode line, and header line. It does not
3223include the tool bar or menu bar. With other graphical versions, it may
3224also include the tool bar and the menu bar.
3225
3226For a text terminal, it includes the menu bar. In this case, the
3227result is really in characters rather than pixels (i.e., is identical
3228to `frame-height'). */)
2998 (Lisp_Object frame) 3229 (Lisp_Object frame)
2999{ 3230{
3000 struct frame *f = decode_any_frame (frame); 3231 struct frame *f = decode_any_frame (frame);
3001 3232
3002#ifdef HAVE_WINDOW_SYSTEM 3233#ifdef HAVE_WINDOW_SYSTEM
3003 if (FRAME_WINDOW_P (f)) 3234 if (FRAME_WINDOW_P (f))
3004 return make_number (FRAME_PIXEL_WIDTH (f)); 3235 return make_number (FRAME_PIXEL_HEIGHT (f));
3005 else 3236 else
3006#endif 3237#endif
3007 return make_number (FRAME_TOTAL_COLS (f)); 3238 return make_number (FRAME_TOTAL_LINES (f));
3008} 3239}
3009 3240
3010DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width, 3241DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
@@ -3087,8 +3318,8 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0,
3087 return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame))); 3318 return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
3088} 3319}
3089 3320
3090DEFUN ("frame-border-width", Fborder_width, Sborder_width, 0, 1, 0, 3321DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0,
3091 doc: /* Return border width of FRAME in pixels. */) 3322 doc: /* Return width of FRAME's internal border in pixels. */)
3092 (Lisp_Object frame) 3323 (Lisp_Object frame)
3093{ 3324{
3094 return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame))); 3325 return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame)));
@@ -3224,7 +3455,6 @@ bottom edge of FRAME's display. */)
3224 3455
3225 return Qt; 3456 return Qt;
3226} 3457}
3227
3228 3458
3229/*********************************************************************** 3459/***********************************************************************
3230 Frame Parameters 3460 Frame Parameters
@@ -3289,10 +3519,193 @@ static const struct frame_parm_table frame_parms[] =
3289 {"no-accept-focus", SYMBOL_INDEX (Qno_accept_focus)}, 3519 {"no-accept-focus", SYMBOL_INDEX (Qno_accept_focus)},
3290 {"z-group", SYMBOL_INDEX (Qz_group)}, 3520 {"z-group", SYMBOL_INDEX (Qz_group)},
3291 {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, 3521 {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)},
3522 {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)},
3292}; 3523};
3293 3524
3294#ifdef HAVE_WINDOW_SYSTEM 3525#ifdef HAVE_WINDOW_SYSTEM
3295 3526
3527/* Enumeration type for switch in frame_float. */
3528enum frame_float_type
3529{
3530 FRAME_FLOAT_WIDTH,
3531 FRAME_FLOAT_HEIGHT,
3532 FRAME_FLOAT_LEFT,
3533 FRAME_FLOAT_TOP
3534};
3535
3536/**
3537 * frame_float:
3538 *
3539 * Process the value VAL of the float type frame parameter 'width',
3540 * 'height', 'left', or 'top' specified via a frame_float_type
3541 * enumeration type WHAT for frame F. Such parameters relate the outer
3542 * size or position of F to the size of the F's display or parent frame
3543 * which have to be both available in some way.
3544 *
3545 * The return value is a size or position value in pixels. VAL must be
3546 * in the range 0.0 to 1.0 where a width/height of 0.0 means to return 0
3547 * and 1.0 means to return the full width/height of the display/parent.
3548 * For positions, 0.0 means position in the left/top corner of the
3549 * display/parent while 1.0 means to position at the right/bottom corner
3550 * of the display/parent frame.
3551 *
3552 * Set PARENT_DONE and OUTER_DONE to avoid recalculation of the outer
3553 * size or parent or display attributes when more float parameters are
3554 * calculated in a row: -1 means not processed yet, 0 means processing
3555 * failed, 1 means processing succeeded.
3556 *
3557 * Return DEFAULT_VALUE when processing fails for whatever reason with
3558 * one exception: When calculating F's outer edges fails (probably
3559 * because F has not been created yet) return the difference between F's
3560 * native and text size.
3561 */
3562static int
3563frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what,
3564 int *parent_done, int *outer_done, int default_value)
3565{
3566 double d_val = XFLOAT_DATA (val);
3567
3568 if (d_val < 0.0 || d_val > 1.0)
3569 /* Invalid VAL. */
3570 return default_value;
3571 else
3572 {
3573 static unsigned parent_width, parent_height;
3574 static int parent_left, parent_top;
3575 static unsigned outer_minus_text_width, outer_minus_text_height;
3576 struct frame *p = FRAME_PARENT_FRAME (f);
3577
3578 if (*parent_done == 1)
3579 ;
3580 else if (p)
3581 {
3582 parent_width = FRAME_PIXEL_WIDTH (p);
3583 parent_height = FRAME_PIXEL_HEIGHT (p);
3584 *parent_done = 1;
3585 }
3586 else
3587 {
3588 if (*parent_done == 0)
3589 /* No workarea available. */
3590 return default_value;
3591 else if (*parent_done == -1)
3592 {
3593 Lisp_Object monitor_attributes;
3594 Lisp_Object workarea;
3595 Lisp_Object frame;
3596
3597 XSETFRAME (frame, f);
3598 monitor_attributes = Fcar (call1 (Qdisplay_monitor_attributes_list, frame));
3599 if (NILP (monitor_attributes))
3600 {
3601 /* No monitor attributes available. */
3602 *parent_done = 0;
3603
3604 return default_value;
3605 }
3606
3607 workarea = Fcdr (Fassq (Qworkarea, monitor_attributes));
3608 if (NILP (workarea))
3609 {
3610 /* No workarea available. */
3611 *parent_done = 0;
3612
3613 return default_value;
3614 }
3615
3616 /* Workarea available. */
3617 parent_left = XINT (Fnth (make_number (0), workarea));
3618 parent_top = XINT (Fnth (make_number (1), workarea));
3619 parent_width = XINT (Fnth (make_number (2), workarea));
3620 parent_height = XINT (Fnth (make_number (3), workarea));
3621 *parent_done = 1;
3622 }
3623 }
3624
3625 if (*outer_done == 1)
3626 ;
3627 else if (FRAME_UNDECORATED (f))
3628 {
3629 outer_minus_text_width
3630 = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f);
3631 outer_minus_text_height
3632 = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f);
3633 *outer_done = 1;
3634 }
3635 else if (*outer_done == 0)
3636 /* No outer size available. */
3637 return default_value;
3638 else if (*outer_done == -1)
3639 {
3640 Lisp_Object frame, outer_edges;
3641
3642 XSETFRAME (frame, f);
3643 outer_edges = call2 (Qframe_edges, frame, Qouter_edges);
3644
3645 if (!NILP (outer_edges))
3646 {
3647 outer_minus_text_width
3648 = (XINT (Fnth (make_number (2), outer_edges))
3649 - XINT (Fnth (make_number (0), outer_edges))
3650 - FRAME_TEXT_WIDTH (f));
3651 outer_minus_text_height
3652 = (XINT (Fnth (make_number (3), outer_edges))
3653 - XINT (Fnth (make_number (1), outer_edges))
3654 - FRAME_TEXT_HEIGHT (f));
3655 }
3656 else
3657 {
3658 /* If we can't get any outer edges, proceed as if the frame
3659 were undecorated. */
3660 outer_minus_text_width
3661 = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f);
3662 outer_minus_text_height
3663 = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f);
3664 }
3665
3666 *outer_done = 1;
3667 }
3668
3669 switch (what)
3670 {
3671 case FRAME_FLOAT_WIDTH:
3672 return parent_width * d_val - outer_minus_text_width;
3673
3674 case FRAME_FLOAT_HEIGHT:
3675 return parent_height * d_val - outer_minus_text_height;
3676
3677 case FRAME_FLOAT_LEFT:
3678 {
3679 int rest_width = (parent_width
3680 - FRAME_TEXT_WIDTH (f)
3681 - outer_minus_text_width);
3682
3683 if (p)
3684 return (rest_width <= 0 ? 0 : d_val * rest_width);
3685 else
3686 return (rest_width <= 0
3687 ? parent_left
3688 : parent_left + d_val * rest_width);
3689 }
3690 case FRAME_FLOAT_TOP:
3691 {
3692 int rest_height = (parent_height
3693 - FRAME_TEXT_HEIGHT (f)
3694 - outer_minus_text_height);
3695
3696 if (p)
3697 return (rest_height <= 0 ? 0 : d_val * rest_height);
3698 else
3699 return (rest_height <= 0
3700 ? parent_top
3701 : parent_top + d_val * rest_height);
3702 }
3703 default:
3704 emacs_abort ();
3705 }
3706 }
3707}
3708
3296/* Change the parameters of frame F as specified by ALIST. 3709/* Change the parameters of frame F as specified by ALIST.
3297 If a parameter is not specially recognized, do nothing special; 3710 If a parameter is not specially recognized, do nothing special;
3298 otherwise call the `x_set_...' function for that parameter. 3711 otherwise call the `x_set_...' function for that parameter.
@@ -3302,7 +3715,8 @@ static const struct frame_parm_table frame_parms[] =
3302void 3715void
3303x_set_frame_parameters (struct frame *f, Lisp_Object alist) 3716x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3304{ 3717{
3305 Lisp_Object tail; 3718 Lisp_Object tail, frame;
3719
3306 3720
3307 /* If both of these parameters are present, it's more efficient to 3721 /* If both of these parameters are present, it's more efficient to
3308 set them both at once. So we wait until we've looked at the 3722 set them both at once. So we wait until we've looked at the
@@ -3327,7 +3741,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3327#ifdef HAVE_X_WINDOWS 3741#ifdef HAVE_X_WINDOWS
3328 bool icon_left_no_change = 0, icon_top_no_change = 0; 3742 bool icon_left_no_change = 0, icon_top_no_change = 0;
3329#endif 3743#endif
3744 int parent_done = -1, outer_done = -1;
3330 3745
3746 XSETFRAME (frame, f);
3331 for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail)) 3747 for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
3332 size++; 3748 size++;
3333 CHECK_LIST_END (tail, alist); 3749 CHECK_LIST_END (tail, alist);
@@ -3388,6 +3804,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3388 else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) 3804 else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
3389 && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) 3805 && RANGED_INTEGERP (0, XCDR (val), INT_MAX))
3390 width = XFASTINT (XCDR (val)); 3806 width = XFASTINT (XCDR (val));
3807 else if (FLOATP (val))
3808 width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done,
3809 &outer_done, -1);
3391 } 3810 }
3392 else if (EQ (prop, Qheight)) 3811 else if (EQ (prop, Qheight))
3393 { 3812 {
@@ -3396,6 +3815,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3396 else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) 3815 else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
3397 && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) 3816 && RANGED_INTEGERP (0, XCDR (val), INT_MAX))
3398 height = XFASTINT (XCDR (val)); 3817 height = XFASTINT (XCDR (val));
3818 else if (FLOATP (val))
3819 height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done,
3820 &outer_done, -1);
3399 } 3821 }
3400 else if (EQ (prop, Qtop)) 3822 else if (EQ (prop, Qtop))
3401 top = val; 3823 top = val;
@@ -3472,105 +3894,100 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3472 Don't set these parameters unless they actually differ from the 3894 Don't set these parameters unless they actually differ from the
3473 window's current parameters; the window may not actually exist 3895 window's current parameters; the window may not actually exist
3474 yet. */ 3896 yet. */
3475 { 3897 if ((width != -1 && width != FRAME_TEXT_WIDTH (f))
3476 Lisp_Object frame; 3898 || (height != -1 && height != FRAME_TEXT_HEIGHT (f)))
3477 3899 /* We could consider checking f->after_make_frame here, but I
3478 XSETFRAME (frame, f); 3900 don't have the faintest idea why the following is needed at
3479 3901 all. With the old setting it can get a Heisenbug when
3480 if ((width != -1 && width != FRAME_TEXT_WIDTH (f)) 3902 EmacsFrameResize intermittently provokes a delayed
3481 || (height != -1 && height != FRAME_TEXT_HEIGHT (f))) 3903 change_frame_size in the middle of adjust_frame_size. */
3482 /* We could consider checking f->after_make_frame here, but I 3904 /** || (f->can_x_set_window_size && (f->new_height || f->new_width))) **/
3483 don't have the faintest idea why the following is needed at 3905 adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters);
3484 all. With the old setting it can get a Heisenbug when 3906
3485 EmacsFrameResize intermittently provokes a delayed 3907 if ((!NILP (left) || !NILP (top))
3486 change_frame_size in the middle of adjust_frame_size. */ 3908 && ! (left_no_change && top_no_change)
3487 /** || (f->can_x_set_window_size && (f->new_height || f->new_width))) **/ 3909 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3488 adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters); 3910 && NUMBERP (top) && XINT (top) == f->top_pos))
3489 3911 {
3490 if ((!NILP (left) || !NILP (top)) 3912 int leftpos = 0;
3491 && ! (left_no_change && top_no_change) 3913 int toppos = 0;
3492 && ! (NUMBERP (left) && XINT (left) == f->left_pos
3493 && NUMBERP (top) && XINT (top) == f->top_pos))
3494 {
3495 int leftpos = 0;
3496 int toppos = 0;
3497 3914
3498 /* Record the signs. */ 3915 /* Record the signs. */
3499 f->size_hint_flags &= ~ (XNegative | YNegative); 3916 f->size_hint_flags &= ~ (XNegative | YNegative);
3500 if (EQ (left, Qminus)) 3917 if (EQ (left, Qminus))
3501 f->size_hint_flags |= XNegative; 3918 f->size_hint_flags |= XNegative;
3502 else if (TYPE_RANGED_INTEGERP (int, left)) 3919 else if (TYPE_RANGED_INTEGERP (int, left))
3503 { 3920 {
3504 leftpos = XINT (left); 3921 leftpos = XINT (left);
3505 if (leftpos < 0) 3922 if (leftpos < 0)
3506 f->size_hint_flags |= XNegative;
3507 }
3508 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3509 && CONSP (XCDR (left))
3510 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
3511 {
3512 leftpos = - XINT (XCAR (XCDR (left)));
3513 f->size_hint_flags |= XNegative; 3923 f->size_hint_flags |= XNegative;
3514 } 3924 }
3515 else if (CONSP (left) && EQ (XCAR (left), Qplus) 3925 else if (CONSP (left) && EQ (XCAR (left), Qminus)
3516 && CONSP (XCDR (left)) 3926 && CONSP (XCDR (left))
3517 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left)))) 3927 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
3518 { 3928 {
3519 leftpos = XINT (XCAR (XCDR (left))); 3929 leftpos = - XINT (XCAR (XCDR (left)));
3520 } 3930 f->size_hint_flags |= XNegative;
3931 }
3932 else if (CONSP (left) && EQ (XCAR (left), Qplus)
3933 && CONSP (XCDR (left))
3934 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
3935 leftpos = XINT (XCAR (XCDR (left)));
3936 else if (FLOATP (left))
3937 leftpos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
3938 &outer_done, 0);
3521 3939
3522 if (EQ (top, Qminus)) 3940 if (EQ (top, Qminus))
3523 f->size_hint_flags |= YNegative; 3941 f->size_hint_flags |= YNegative;
3524 else if (TYPE_RANGED_INTEGERP (int, top)) 3942 else if (TYPE_RANGED_INTEGERP (int, top))
3525 { 3943 {
3526 toppos = XINT (top); 3944 toppos = XINT (top);
3527 if (toppos < 0) 3945 if (toppos < 0)
3528 f->size_hint_flags |= YNegative;
3529 }
3530 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3531 && CONSP (XCDR (top))
3532 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
3533 {
3534 toppos = - XINT (XCAR (XCDR (top)));
3535 f->size_hint_flags |= YNegative; 3946 f->size_hint_flags |= YNegative;
3536 } 3947 }
3537 else if (CONSP (top) && EQ (XCAR (top), Qplus) 3948 else if (CONSP (top) && EQ (XCAR (top), Qminus)
3538 && CONSP (XCDR (top)) 3949 && CONSP (XCDR (top))
3539 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top)))) 3950 && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
3540 { 3951 {
3541 toppos = XINT (XCAR (XCDR (top))); 3952 toppos = - XINT (XCAR (XCDR (top)));
3542 } 3953 f->size_hint_flags |= YNegative;
3543 3954 }
3955 else if (CONSP (top) && EQ (XCAR (top), Qplus)
3956 && CONSP (XCDR (top))
3957 && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
3958 toppos = XINT (XCAR (XCDR (top)));
3959 else if (FLOATP (top))
3960 toppos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
3961 &outer_done, 0);
3544 3962
3545 /* Store the numeric value of the position. */ 3963 /* Store the numeric value of the position. */
3546 f->top_pos = toppos; 3964 f->top_pos = toppos;
3547 f->left_pos = leftpos; 3965 f->left_pos = leftpos;
3548 3966
3549 f->win_gravity = NorthWestGravity; 3967 f->win_gravity = NorthWestGravity;
3550 3968
3551 /* Actually set that position, and convert to absolute. */ 3969 /* Actually set that position, and convert to absolute. */
3552 x_set_offset (f, leftpos, toppos, -1); 3970 x_set_offset (f, leftpos, toppos, -1);
3553 } 3971 }
3554 3972
3555 if (fullscreen_change) 3973 if (fullscreen_change)
3556 { 3974 {
3557 Lisp_Object old_value = get_frame_param (f, Qfullscreen); 3975 Lisp_Object old_value = get_frame_param (f, Qfullscreen);
3558 3976
3559 frame_size_history_add 3977 frame_size_history_add
3560 (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen)); 3978 (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen));
3561 3979
3562 store_frame_param (f, Qfullscreen, fullscreen); 3980 store_frame_param (f, Qfullscreen, fullscreen);
3563 if (!EQ (fullscreen, old_value)) 3981 if (!EQ (fullscreen, old_value))
3564 x_set_fullscreen (f, fullscreen, old_value); 3982 x_set_fullscreen (f, fullscreen, old_value);
3565 } 3983 }
3566 3984
3567 3985
3568#ifdef HAVE_X_WINDOWS 3986#ifdef HAVE_X_WINDOWS
3569 if ((!NILP (icon_left) || !NILP (icon_top)) 3987 if ((!NILP (icon_left) || !NILP (icon_top))
3570 && ! (icon_left_no_change && icon_top_no_change)) 3988 && ! (icon_left_no_change && icon_top_no_change))
3571 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top)); 3989 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
3572#endif /* HAVE_X_WINDOWS */ 3990#endif /* HAVE_X_WINDOWS */
3573 }
3574 3991
3575 SAFE_FREE (); 3992 SAFE_FREE ();
3576} 3993}
@@ -3990,7 +4407,6 @@ x_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
3990 adjust_frame_glyphs (f); 4407 adjust_frame_glyphs (f);
3991 SET_FRAME_GARBAGED (f); 4408 SET_FRAME_GARBAGED (f);
3992 } 4409 }
3993
3994} 4410}
3995 4411
3996void 4412void
@@ -4204,6 +4620,22 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
4204 return; 4620 return;
4205} 4621}
4206 4622
4623
4624/**
4625 * x_set_no_special_glyphs:
4626 *
4627 * Set frame F's `no-special-glyphs' parameter which, if non-nil,
4628 * suppresses the display of truncation and continuation glyphs
4629 * outside fringes.
4630 */
4631void
4632x_set_no_special_glyphs (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
4633{
4634 if (!EQ (new_value, old_value))
4635 FRAME_NO_SPECIAL_GLYPHS (f) = !NILP (new_value);
4636}
4637
4638
4207#ifndef HAVE_NS 4639#ifndef HAVE_NS
4208 4640
4209/* Non-zero if mouse is grabbed on DPYINFO 4641/* Non-zero if mouse is grabbed on DPYINFO
@@ -4759,6 +5191,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
4759 Lisp_Object height, width, user_size, top, left, user_position; 5191 Lisp_Object height, width, user_size, top, left, user_position;
4760 long window_prompting = 0; 5192 long window_prompting = 0;
4761 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); 5193 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
5194 int parent_done = -1, outer_done = -1;
4762 5195
4763 /* Default values if we fall through. 5196 /* Default values if we fall through.
4764 Actually, if that happens we should get 5197 Actually, if that happens we should get
@@ -4823,6 +5256,21 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
4823 f->inhibit_horizontal_resize = true; 5256 f->inhibit_horizontal_resize = true;
4824 *x_width = XINT (XCDR (width)); 5257 *x_width = XINT (XCDR (width));
4825 } 5258 }
5259 else if (FLOATP (width))
5260 {
5261 double d_width = XFLOAT_DATA (width);
5262
5263 if (d_width < 0.0 || d_width > 1.0)
5264 xsignal1 (Qargs_out_of_range, width);
5265 else
5266 {
5267 int new_width = frame_float (f, width, FRAME_FLOAT_WIDTH,
5268 &parent_done, &outer_done, -1);
5269
5270 if (new_width > -1)
5271 SET_FRAME_WIDTH (f, new_width);
5272 }
5273 }
4826 else 5274 else
4827 { 5275 {
4828 CHECK_NUMBER (width); 5276 CHECK_NUMBER (width);
@@ -4845,6 +5293,21 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
4845 f->inhibit_vertical_resize = true; 5293 f->inhibit_vertical_resize = true;
4846 *x_height = XINT (XCDR (height)); 5294 *x_height = XINT (XCDR (height));
4847 } 5295 }
5296 else if (FLOATP (height))
5297 {
5298 double d_height = XFLOAT_DATA (height);
5299
5300 if (d_height < 0.0 || d_height > 1.0)
5301 xsignal1 (Qargs_out_of_range, height);
5302 else
5303 {
5304 int new_height = frame_float (f, height, FRAME_FLOAT_HEIGHT,
5305 &parent_done, &outer_done, -1);
5306
5307 if (new_height > -1)
5308 SET_FRAME_HEIGHT (f, new_height);
5309 }
5310 }
4848 else 5311 else
4849 { 5312 {
4850 CHECK_NUMBER (height); 5313 CHECK_NUMBER (height);
@@ -4885,6 +5348,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
4885 { 5348 {
4886 f->top_pos = XINT (XCAR (XCDR (top))); 5349 f->top_pos = XINT (XCAR (XCDR (top)));
4887 } 5350 }
5351 else if (FLOATP (top))
5352 f->top_pos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
5353 &outer_done, 0);
4888 else if (EQ (top, Qunbound)) 5354 else if (EQ (top, Qunbound))
4889 f->top_pos = 0; 5355 f->top_pos = 0;
4890 else 5356 else
@@ -4913,6 +5379,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
4913 { 5379 {
4914 f->left_pos = XINT (XCAR (XCDR (left))); 5380 f->left_pos = XINT (XCAR (XCDR (left)));
4915 } 5381 }
5382 else if (FLOATP (left))
5383 f->left_pos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
5384 &outer_done, 0);
4916 else if (EQ (left, Qunbound)) 5385 else if (EQ (left, Qunbound))
4917 f->left_pos = 0; 5386 f->left_pos = 0;
4918 else 5387 else
@@ -5071,12 +5540,14 @@ syms_of_frame (void)
5071 DEFSYM (Qframep, "framep"); 5540 DEFSYM (Qframep, "framep");
5072 DEFSYM (Qframe_live_p, "frame-live-p"); 5541 DEFSYM (Qframe_live_p, "frame-live-p");
5073 DEFSYM (Qframe_windows_min_size, "frame-windows-min-size"); 5542 DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
5543 DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list");
5074 DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total"); 5544 DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
5075 DEFSYM (Qexplicit_name, "explicit-name"); 5545 DEFSYM (Qexplicit_name, "explicit-name");
5076 DEFSYM (Qheight, "height"); 5546 DEFSYM (Qheight, "height");
5077 DEFSYM (Qicon, "icon"); 5547 DEFSYM (Qicon, "icon");
5078 DEFSYM (Qminibuffer, "minibuffer"); 5548 DEFSYM (Qminibuffer, "minibuffer");
5079 DEFSYM (Qundecorated, "undecorated"); 5549 DEFSYM (Qundecorated, "undecorated");
5550 DEFSYM (Qno_special_glyphs, "no-special-glyphs");
5080 DEFSYM (Qparent_frame, "parent-frame"); 5551 DEFSYM (Qparent_frame, "parent-frame");
5081 DEFSYM (Qskip_taskbar, "skip-taskbar"); 5552 DEFSYM (Qskip_taskbar, "skip-taskbar");
5082 DEFSYM (Qno_focus_on_map, "no-focus-on-map"); 5553 DEFSYM (Qno_focus_on_map, "no-focus-on-map");
@@ -5129,6 +5600,7 @@ syms_of_frame (void)
5129 DEFSYM (Qframes, "frames"); 5600 DEFSYM (Qframes, "frames");
5130 DEFSYM (Qsource, "source"); 5601 DEFSYM (Qsource, "source");
5131 5602
5603 DEFSYM (Qframe_edges, "frame-edges");
5132 DEFSYM (Qouter_edges, "outer-edges"); 5604 DEFSYM (Qouter_edges, "outer-edges");
5133 DEFSYM (Qouter_position, "outer-position"); 5605 DEFSYM (Qouter_position, "outer-position");
5134 DEFSYM (Qouter_size, "outer-size"); 5606 DEFSYM (Qouter_size, "outer-size");
@@ -5220,6 +5692,11 @@ syms_of_frame (void)
5220 DEFSYM (Qmin_width, "min-width"); 5692 DEFSYM (Qmin_width, "min-width");
5221 DEFSYM (Qmin_height, "min-height"); 5693 DEFSYM (Qmin_height, "min-height");
5222 DEFSYM (Qmouse_wheel_frame, "mouse-wheel-frame"); 5694 DEFSYM (Qmouse_wheel_frame, "mouse-wheel-frame");
5695 DEFSYM (Qkeep_ratio, "keep-ratio");
5696 DEFSYM (Qwidth_only, "width-only");
5697 DEFSYM (Qheight_only, "height-only");
5698 DEFSYM (Qleft_only, "left-only");
5699 DEFSYM (Qtop_only, "top-only");
5223 5700
5224 { 5701 {
5225 int i; 5702 int i;
@@ -5564,8 +6041,8 @@ Gtk+ tooltips are not used) and on Windows. */);
5564 defsubr (&Smodify_frame_parameters); 6041 defsubr (&Smodify_frame_parameters);
5565 defsubr (&Sframe_char_height); 6042 defsubr (&Sframe_char_height);
5566 defsubr (&Sframe_char_width); 6043 defsubr (&Sframe_char_width);
5567 defsubr (&Sframe_pixel_height); 6044 defsubr (&Sframe_native_height);
5568 defsubr (&Sframe_pixel_width); 6045 defsubr (&Sframe_native_width);
5569 defsubr (&Sframe_text_cols); 6046 defsubr (&Sframe_text_cols);
5570 defsubr (&Sframe_text_lines); 6047 defsubr (&Sframe_text_lines);
5571 defsubr (&Sframe_total_cols); 6048 defsubr (&Sframe_total_cols);
@@ -5575,7 +6052,7 @@ Gtk+ tooltips are not used) and on Windows. */);
5575 defsubr (&Sscroll_bar_width); 6052 defsubr (&Sscroll_bar_width);
5576 defsubr (&Sscroll_bar_height); 6053 defsubr (&Sscroll_bar_height);
5577 defsubr (&Sfringe_width); 6054 defsubr (&Sfringe_width);
5578 defsubr (&Sborder_width); 6055 defsubr (&Sframe_internal_border_width);
5579 defsubr (&Sright_divider_width); 6056 defsubr (&Sright_divider_width);
5580 defsubr (&Sbottom_divider_width); 6057 defsubr (&Sbottom_divider_width);
5581 defsubr (&Stool_bar_pixel_width); 6058 defsubr (&Stool_bar_pixel_width);
diff --git a/src/frame.h b/src/frame.h
index 4aa7c34a29a..154dc9a3bb4 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -52,6 +52,19 @@ enum z_group
52 z_group_below, 52 z_group_below,
53 z_group_above_suspended, 53 z_group_above_suspended,
54}; 54};
55
56enum internal_border_part
57 {
58 INTERNAL_BORDER_NONE,
59 INTERNAL_BORDER_LEFT_EDGE,
60 INTERNAL_BORDER_TOP_LEFT_CORNER,
61 INTERNAL_BORDER_TOP_EDGE,
62 INTERNAL_BORDER_TOP_RIGHT_CORNER,
63 INTERNAL_BORDER_RIGHT_EDGE,
64 INTERNAL_BORDER_BOTTOM_RIGHT_CORNER,
65 INTERNAL_BORDER_BOTTOM_EDGE,
66 INTERNAL_BORDER_BOTTOM_LEFT_CORNER,
67 };
55#endif /* HAVE_WINDOW_SYSTEM */ 68#endif /* HAVE_WINDOW_SYSTEM */
56 69
57/* The structure representing a frame. */ 70/* The structure representing a frame. */
@@ -354,7 +367,11 @@ struct frame
354 367
355 /* The z-group this frame's window belongs to. */ 368 /* The z-group this frame's window belongs to. */
356 ENUM_BF (z_group) z_group : 2; 369 ENUM_BF (z_group) z_group : 2;
357#endif /* HAVE_WINDOW_SYSTEM and not HAVE_NS */ 370
371 /* Non-zero if display of truncation and continuation glyphs outside
372 the fringes is suppressed. */
373 bool_bf no_special_glyphs : 1;
374#endif /* HAVE_WINDOW_SYSTEM */
358 375
359 /* Whether new_height and new_width shall be interpreted 376 /* Whether new_height and new_width shall be interpreted
360 in pixels. */ 377 in pixels. */
@@ -824,7 +841,7 @@ default_pixels_per_inch_y (void)
824#ifdef USE_GTK 841#ifdef USE_GTK
825#define FRAME_TOOL_BAR_POSITION(f) (f)->tool_bar_position 842#define FRAME_TOOL_BAR_POSITION(f) (f)->tool_bar_position
826#else 843#else
827#define FRAME_TOOL_BAR_POSITION(f) ((void) f, Qtop) 844#define FRAME_TOOL_BAR_POSITION(f) ((void) (f), Qtop)
828#endif 845#endif
829 846
830/* Number of lines of frame F used for the tool-bar. */ 847/* Number of lines of frame F used for the tool-bar. */
@@ -908,16 +925,17 @@ default_pixels_per_inch_y (void)
908 ((f)->vertical_scroll_bar_type == vertical_scroll_bar_right) 925 ((f)->vertical_scroll_bar_type == vertical_scroll_bar_right)
909#else /* not HAVE_WINDOW_SYSTEM */ 926#else /* not HAVE_WINDOW_SYSTEM */
910/* If there is no window system, there are no scroll bars. */ 927/* If there is no window system, there are no scroll bars. */
911#define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) ((void) f, vertical_scroll_bar_none) 928#define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) \
912#define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) f, 0) 929 ((void) (f), vertical_scroll_bar_none)
913#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) f, 0) 930#define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) (f), 0)
914#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) f, 0) 931#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) (f), 0)
932#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) (f), 0)
915#endif /* HAVE_WINDOW_SYSTEM */ 933#endif /* HAVE_WINDOW_SYSTEM */
916 934
917#if defined (HAVE_WINDOW_SYSTEM) 935#if defined (HAVE_WINDOW_SYSTEM)
918#define FRAME_UNDECORATED(f) ((f)->undecorated) 936#define FRAME_UNDECORATED(f) ((f)->undecorated)
919#ifdef HAVE_NTGUI 937#ifdef HAVE_NTGUI
920#define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0) 938#define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0)
921#else 939#else
922#define FRAME_OVERRIDE_REDIRECT(f) ((f)->override_redirect) 940#define FRAME_OVERRIDE_REDIRECT(f) ((f)->override_redirect)
923#endif 941#endif
@@ -928,6 +946,7 @@ default_pixels_per_inch_y (void)
928#define FRAME_SKIP_TASKBAR(f) ((f)->skip_taskbar) 946#define FRAME_SKIP_TASKBAR(f) ((f)->skip_taskbar)
929#define FRAME_NO_FOCUS_ON_MAP(f) ((f)->no_focus_on_map) 947#define FRAME_NO_FOCUS_ON_MAP(f) ((f)->no_focus_on_map)
930#define FRAME_NO_ACCEPT_FOCUS(f) ((f)->no_accept_focus) 948#define FRAME_NO_ACCEPT_FOCUS(f) ((f)->no_accept_focus)
949#define FRAME_NO_SPECIAL_GLYPHS(f) ((f)->no_special_glyphs)
931#define FRAME_Z_GROUP(f) ((f)->z_group) 950#define FRAME_Z_GROUP(f) ((f)->z_group)
932#define FRAME_Z_GROUP_NONE(f) ((f)->z_group == z_group_none) 951#define FRAME_Z_GROUP_NONE(f) ((f)->z_group == z_group_none)
933#define FRAME_Z_GROUP_ABOVE(f) ((f)->z_group == z_group_above) 952#define FRAME_Z_GROUP_ABOVE(f) ((f)->z_group == z_group_above)
@@ -935,16 +954,17 @@ default_pixels_per_inch_y (void)
935 ((f)->z_group == z_group_above_suspended) 954 ((f)->z_group == z_group_above_suspended)
936#define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below) 955#define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below)
937#else /* not HAVE_WINDOW_SYSTEM */ 956#else /* not HAVE_WINDOW_SYSTEM */
938#define FRAME_UNDECORATED(f) ((void) f, 0) 957#define FRAME_UNDECORATED(f) ((void) (f), 0)
939#define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0) 958#define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0)
940#define FRAME_PARENT_FRAME(f) ((void) f, NULL) 959#define FRAME_PARENT_FRAME(f) ((void) (f), NULL)
941#define FRAME_SKIP_TASKBAR(f) ((void) f, 0) 960#define FRAME_SKIP_TASKBAR(f) ((void) (f), 0)
942#define FRAME_NO_FOCUS_ON_MAP(f) ((void) f, 0) 961#define FRAME_NO_FOCUS_ON_MAP(f) ((void) (f), 0)
943#define FRAME_NO_ACCEPT_FOCUS(f) ((void) f, 0) 962#define FRAME_NO_ACCEPT_FOCUS(f) ((void) (f), 0)
944#define FRAME_Z_GROUP(f) ((void) f, z_group_none) 963#define FRAME_NO_SPECIAL_GLYPHS(f) ((void) (f), 0)
945#define FRAME_Z_GROUP_NONE(f) ((void) f, true) 964#define FRAME_Z_GROUP(f) ((void) (f), z_group_none)
946#define FRAME_Z_GROUP_ABOVE(f) ((void) f, false) 965#define FRAME_Z_GROUP_NONE(f) ((void) (f), true)
947#define FRAME_Z_GROUP_BELOW(f) ((void) f, false) 966#define FRAME_Z_GROUP_ABOVE(f) ((void) (f), false)
967#define FRAME_Z_GROUP_BELOW(f) ((void) (f), false)
948#endif /* HAVE_WINDOW_SYSTEM */ 968#endif /* HAVE_WINDOW_SYSTEM */
949 969
950/* Whether horizontal scroll bars are currently enabled for frame F. */ 970/* Whether horizontal scroll bars are currently enabled for frame F. */
@@ -952,7 +972,7 @@ default_pixels_per_inch_y (void)
952#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) \ 972#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) \
953 ((f)->horizontal_scroll_bars) 973 ((f)->horizontal_scroll_bars)
954#else 974#else
955#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) f, 0) 975#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) (f), 0)
956#endif 976#endif
957 977
958/* Width that a scroll bar in frame F should have, if there is one. 978/* Width that a scroll bar in frame F should have, if there is one.
@@ -1288,19 +1308,20 @@ FRAME_TOTAL_FRINGE_WIDTH (struct frame *f)
1288 return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f); 1308 return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f);
1289} 1309}
1290 1310
1291/* Pixel-width of internal border lines */ 1311/* Pixel-width of internal border lines. */
1292INLINE int 1312INLINE int
1293FRAME_INTERNAL_BORDER_WIDTH (struct frame *f) 1313FRAME_INTERNAL_BORDER_WIDTH (struct frame *f)
1294{ 1314{
1295 return frame_dimension (f->internal_border_width); 1315 return frame_dimension (f->internal_border_width);
1296} 1316}
1297 1317
1298/* Pixel-size of window divider lines */ 1318/* Pixel-size of window divider lines. */
1299INLINE int 1319INLINE int
1300FRAME_RIGHT_DIVIDER_WIDTH (struct frame *f) 1320FRAME_RIGHT_DIVIDER_WIDTH (struct frame *f)
1301{ 1321{
1302 return frame_dimension (f->right_divider_width); 1322 return frame_dimension (f->right_divider_width);
1303} 1323}
1324
1304INLINE int 1325INLINE int
1305FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) 1326FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
1306{ 1327{
@@ -1498,6 +1519,7 @@ extern void x_set_scroll_bar_height (struct frame *, Lisp_Object, Lisp_Object);
1498extern long x_figure_window_size (struct frame *, Lisp_Object, bool, int *, int *); 1519extern long x_figure_window_size (struct frame *, Lisp_Object, bool, int *, int *);
1499 1520
1500extern void x_set_alpha (struct frame *, Lisp_Object, Lisp_Object); 1521extern void x_set_alpha (struct frame *, Lisp_Object, Lisp_Object);
1522extern void x_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object);
1501 1523
1502extern void validate_x_resource_name (void); 1524extern void validate_x_resource_name (void);
1503 1525
@@ -1521,6 +1543,7 @@ extern void x_real_positions (struct frame *, int *, int *);
1521extern void free_frame_menubar (struct frame *); 1543extern void free_frame_menubar (struct frame *);
1522extern void x_free_frame_resources (struct frame *); 1544extern void x_free_frame_resources (struct frame *);
1523extern bool frame_ancestor_p (struct frame *af, struct frame *df); 1545extern bool frame_ancestor_p (struct frame *af, struct frame *df);
1546extern enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y);
1524 1547
1525#if defined HAVE_X_WINDOWS 1548#if defined HAVE_X_WINDOWS
1526extern void x_wm_set_icon_position (struct frame *, int, int); 1549extern void x_wm_set_icon_position (struct frame *, int, int);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 16eb284d7c7..2d4abefa969 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1503,6 +1503,7 @@ xg_set_undecorated (struct frame *f, Lisp_Object undecorated)
1503void 1503void
1504xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) 1504xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
1505{ 1505{
1506#if GTK_CHECK_VERSION (2, 18, 0)
1506 block_input (); 1507 block_input ();
1507 if (FRAME_GTK_OUTER_WIDGET (f1) && FRAME_GTK_OUTER_WIDGET (f2)) 1508 if (FRAME_GTK_OUTER_WIDGET (f1) && FRAME_GTK_OUTER_WIDGET (f2))
1508 { 1509 {
@@ -1517,6 +1518,7 @@ xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
1517 x_sync (f1); 1518 x_sync (f1);
1518 } 1519 }
1519 unblock_input (); 1520 unblock_input ();
1521#endif
1520} 1522}
1521 1523
1522 1524
diff --git a/src/image.c b/src/image.c
index aedec7954ee..07c4769e9e3 100644
--- a/src/image.c
+++ b/src/image.c
@@ -20,7 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20#include <config.h> 20#include <config.h>
21 21
22#include <fcntl.h> 22#include <fcntl.h>
23#include <stdio.h>
24#include <unistd.h> 23#include <unistd.h>
25 24
26/* Include this before including <setjmp.h> to work around bugs with 25/* Include this before including <setjmp.h> to work around bugs with
@@ -41,6 +40,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
41#include "buffer.h" 40#include "buffer.h"
42#include "dispextern.h" 41#include "dispextern.h"
43#include "blockinput.h" 42#include "blockinput.h"
43#include "sysstdio.h"
44#include "systime.h" 44#include "systime.h"
45#include <epaths.h> 45#include <epaths.h>
46#include "coding.h" 46#include "coding.h"
@@ -2361,7 +2361,7 @@ slurp_file (int fd, ptrdiff_t *size)
2361 This can happen if the file grows as we read it. */ 2361 This can happen if the file grows as we read it. */
2362 ptrdiff_t buflen = st.st_size; 2362 ptrdiff_t buflen = st.st_size;
2363 buf = xmalloc (buflen + 1); 2363 buf = xmalloc (buflen + 1);
2364 if (fread (buf, 1, buflen + 1, fp) == buflen) 2364 if (fread_unlocked (buf, 1, buflen + 1, fp) == buflen)
2365 *size = buflen; 2365 *size = buflen;
2366 else 2366 else
2367 { 2367 {
@@ -5890,7 +5890,7 @@ png_read_from_file (png_structp png_ptr, png_bytep data, png_size_t length)
5890{ 5890{
5891 FILE *fp = png_get_io_ptr (png_ptr); 5891 FILE *fp = png_get_io_ptr (png_ptr);
5892 5892
5893 if (fread (data, 1, length, fp) < length) 5893 if (fread_unlocked (data, 1, length, fp) < length)
5894 png_error (png_ptr, "Read error"); 5894 png_error (png_ptr, "Read error");
5895} 5895}
5896 5896
@@ -5959,7 +5959,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
5959 } 5959 }
5960 5960
5961 /* Check PNG signature. */ 5961 /* Check PNG signature. */
5962 if (fread (sig, 1, sizeof sig, fp) != sizeof sig 5962 if (fread_unlocked (sig, 1, sizeof sig, fp) != sizeof sig
5963 || png_sig_cmp (sig, 0, sizeof sig)) 5963 || png_sig_cmp (sig, 0, sizeof sig))
5964 { 5964 {
5965 fclose (fp); 5965 fclose (fp);
@@ -6598,7 +6598,8 @@ our_stdio_fill_input_buffer (j_decompress_ptr cinfo)
6598 { 6598 {
6599 ptrdiff_t bytes; 6599 ptrdiff_t bytes;
6600 6600
6601 bytes = fread (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE, src->file); 6601 bytes = fread_unlocked (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE,
6602 src->file);
6602 if (bytes > 0) 6603 if (bytes > 0)
6603 src->mgr.bytes_in_buffer = bytes; 6604 src->mgr.bytes_in_buffer = bytes;
6604 else 6605 else
diff --git a/src/intervals.h b/src/intervals.h
index db91b3f21a0..a0da6f37801 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -85,10 +85,10 @@ struct interval
85#define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL) 85#define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL)
86 86
87/* True if this interval has no parent and is therefore the root. */ 87/* True if this interval has no parent and is therefore the root. */
88#define ROOT_INTERVAL_P(i) (NULL_PARENT (i)) 88#define ROOT_INTERVAL_P(i) NULL_PARENT (i)
89 89
90/* True if this interval is the only interval in the interval tree. */ 90/* True if this interval is the only interval in the interval tree. */
91#define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P ((i)) && LEAF_INTERVAL_P ((i))) 91#define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P (i) && LEAF_INTERVAL_P (i))
92 92
93/* True if this interval has both left and right children. */ 93/* True if this interval has both left and right children. */
94#define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL) 94#define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL)
@@ -98,13 +98,13 @@ struct interval
98#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length) 98#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length)
99 99
100/* The size of text represented by this interval alone. */ 100/* The size of text represented by this interval alone. */
101#define LENGTH(i) ((i) == NULL ? 0 : (TOTAL_LENGTH ((i)) \ 101#define LENGTH(i) ((i)->total_length \
102 - TOTAL_LENGTH ((i)->right) \ 102 - TOTAL_LENGTH ((i)->right) \
103 - TOTAL_LENGTH ((i)->left))) 103 - TOTAL_LENGTH ((i)->left))
104 104
105/* The position of the character just past the end of I. Note that 105/* The position of the character just past the end of I. Note that
106 the position cache i->position must be valid for this to work. */ 106 the position cache i->position must be valid for this to work. */
107#define INTERVAL_LAST_POS(i) ((i)->position + LENGTH ((i))) 107#define INTERVAL_LAST_POS(i) ((i)->position + LENGTH (i))
108 108
109/* The total size of the left subtree of this interval. */ 109/* The total size of the left subtree of this interval. */
110#define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0) 110#define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0)
diff --git a/src/keyboard.c b/src/keyboard.c
index 55486c6d9ab..9e90899c569 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -39,6 +39,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
39#include "intervals.h" 39#include "intervals.h"
40#include "keymap.h" 40#include "keymap.h"
41#include "blockinput.h" 41#include "blockinput.h"
42#include "sysstdio.h"
42#include "systime.h" 43#include "systime.h"
43#include "atimer.h" 44#include "atimer.h"
44#include "process.h" 45#include "process.h"
@@ -3290,7 +3291,7 @@ record_char (Lisp_Object c)
3290 if (INTEGERP (c)) 3291 if (INTEGERP (c))
3291 { 3292 {
3292 if (XUINT (c) < 0x100) 3293 if (XUINT (c) < 0x100)
3293 putc (XUINT (c), dribble); 3294 putc_unlocked (XUINT (c), dribble);
3294 else 3295 else
3295 fprintf (dribble, " 0x%"pI"x", XUINT (c)); 3296 fprintf (dribble, " 0x%"pI"x", XUINT (c));
3296 } 3297 }
@@ -3303,15 +3304,15 @@ record_char (Lisp_Object c)
3303 3304
3304 if (SYMBOLP (dribblee)) 3305 if (SYMBOLP (dribblee))
3305 { 3306 {
3306 putc ('<', dribble); 3307 putc_unlocked ('<', dribble);
3307 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char), 3308 fwrite_unlocked (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3308 SBYTES (SYMBOL_NAME (dribblee)), 3309 SBYTES (SYMBOL_NAME (dribblee)),
3309 dribble); 3310 dribble);
3310 putc ('>', dribble); 3311 putc_unlocked ('>', dribble);
3311 } 3312 }
3312 } 3313 }
3313 3314
3314 fflush (dribble); 3315 fflush_unlocked (dribble);
3315 unblock_input (); 3316 unblock_input ();
3316 } 3317 }
3317} 3318}
@@ -3769,7 +3770,7 @@ kbd_buffer_get_event (KBOARD **kbp,
3769 detaching from the terminal. */ 3770 detaching from the terminal. */
3770 || (IS_DAEMON && DAEMON_RUNNING)) 3771 || (IS_DAEMON && DAEMON_RUNNING))
3771 { 3772 {
3772 int c = getchar (); 3773 int c = getchar_unlocked ();
3773 XSETINT (obj, c); 3774 XSETINT (obj, c);
3774 *kbp = current_kboard; 3775 *kbp = current_kboard;
3775 return obj; 3776 return obj;
@@ -5126,6 +5127,17 @@ static short const scroll_bar_parts[] = {
5126 SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) 5127 SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio)
5127}; 5128};
5128 5129
5130/* An array of symbol indexes of internal border parts, indexed by an enum
5131 internal_border_part value. Note that Qnil corresponds to
5132 internal_border_part_none and should not appear in Lisp events. */
5133static short const internal_border_parts[] = {
5134 SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qleft_edge),
5135 SYMBOL_INDEX (Qtop_left_corner), SYMBOL_INDEX (Qtop_edge),
5136 SYMBOL_INDEX (Qtop_right_corner), SYMBOL_INDEX (Qright_edge),
5137 SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge),
5138 SYMBOL_INDEX (Qbottom_left_corner)
5139};
5140
5129/* A vector, indexed by button number, giving the down-going location 5141/* A vector, indexed by button number, giving the down-going location
5130 of currently depressed buttons, both scroll bar and non-scroll bar. 5142 of currently depressed buttons, both scroll bar and non-scroll bar.
5131 5143
@@ -5163,15 +5175,15 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
5163 Lisp_Object extra_info = Qnil; 5175 Lisp_Object extra_info = Qnil;
5164 /* Coordinate pixel positions to return. */ 5176 /* Coordinate pixel positions to return. */
5165 int xret = 0, yret = 0; 5177 int xret = 0, yret = 0;
5166 /* The window under frame pixel coordinates (x,y) */ 5178 /* The window or frame under frame pixel coordinates (x,y) */
5167 Lisp_Object window = f 5179 Lisp_Object window_or_frame = f
5168 ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0) 5180 ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0)
5169 : Qnil; 5181 : Qnil;
5170 5182
5171 if (WINDOWP (window)) 5183 if (WINDOWP (window_or_frame))
5172 { 5184 {
5173 /* It's a click in window WINDOW at frame coordinates (X,Y) */ 5185 /* It's a click in window WINDOW at frame coordinates (X,Y) */
5174 struct window *w = XWINDOW (window); 5186 struct window *w = XWINDOW (window_or_frame);
5175 Lisp_Object string_info = Qnil; 5187 Lisp_Object string_info = Qnil;
5176 ptrdiff_t textpos = 0; 5188 ptrdiff_t textpos = 0;
5177 int col = -1, row = -1; 5189 int col = -1, row = -1;
@@ -5360,17 +5372,31 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
5360 make_number (row)), 5372 make_number (row)),
5361 extra_info))); 5373 extra_info)));
5362 } 5374 }
5363 else if (f != 0) 5375
5376#ifdef HAVE_WINDOW_SYSTEM
5377 else if (f)
5364 { 5378 {
5365 /* Return mouse pixel coordinates here. */ 5379 /* Return mouse pixel coordinates here. */
5366 XSETFRAME (window, f); 5380 XSETFRAME (window_or_frame, f);
5367 xret = XINT (x); 5381 xret = XINT (x);
5368 yret = XINT (y); 5382 yret = XINT (y);
5383
5384 if (FRAME_LIVE_P (f)
5385 && FRAME_INTERNAL_BORDER_WIDTH (f) > 0
5386 && !NILP (get_frame_param (f, Qdrag_internal_border)))
5387 {
5388 enum internal_border_part part
5389 = frame_internal_border_part (f, xret, yret);
5390
5391 posn = builtin_lisp_symbol (internal_border_parts[part]);
5392 }
5369 } 5393 }
5394#endif
5395
5370 else 5396 else
5371 window = Qnil; 5397 window_or_frame = Qnil;
5372 5398
5373 return Fcons (window, 5399 return Fcons (window_or_frame,
5374 Fcons (posn, 5400 Fcons (posn,
5375 Fcons (Fcons (make_number (xret), 5401 Fcons (Fcons (make_number (xret),
5376 make_number (yret)), 5402 make_number (yret)),
@@ -10377,7 +10403,7 @@ handle_interrupt (bool in_signal_handler)
10377 sigemptyset (&blocked); 10403 sigemptyset (&blocked);
10378 sigaddset (&blocked, SIGINT); 10404 sigaddset (&blocked, SIGINT);
10379 pthread_sigmask (SIG_BLOCK, &blocked, 0); 10405 pthread_sigmask (SIG_BLOCK, &blocked, 0);
10380 fflush (stdout); 10406 fflush_unlocked (stdout);
10381 } 10407 }
10382 10408
10383 reset_all_sys_modes (); 10409 reset_all_sys_modes ();
@@ -11158,6 +11184,17 @@ syms_of_keyboard (void)
11158 Fset (Qinput_method_exit_on_first_char, Qnil); 11184 Fset (Qinput_method_exit_on_first_char, Qnil);
11159 Fset (Qinput_method_use_echo_area, Qnil); 11185 Fset (Qinput_method_use_echo_area, Qnil);
11160 11186
11187 /* Symbols for dragging internal borders. */
11188 DEFSYM (Qdrag_internal_border, "drag-internal-border");
11189 DEFSYM (Qleft_edge, "left-edge");
11190 DEFSYM (Qtop_left_corner, "top-left-corner");
11191 DEFSYM (Qtop_edge, "top-edge");
11192 DEFSYM (Qtop_right_corner, "top-right-corner");
11193 DEFSYM (Qright_edge, "right-edge");
11194 DEFSYM (Qbottom_right_corner, "bottom-right-corner");
11195 DEFSYM (Qbottom_edge, "bottom-edge");
11196 DEFSYM (Qbottom_left_corner, "bottom-left-corner");
11197
11161 /* Symbols to head events. */ 11198 /* Symbols to head events. */
11162 DEFSYM (Qmouse_movement, "mouse-movement"); 11199 DEFSYM (Qmouse_movement, "mouse-movement");
11163 DEFSYM (Qscroll_bar_movement, "scroll-bar-movement"); 11200 DEFSYM (Qscroll_bar_movement, "scroll-bar-movement");
diff --git a/src/lread.c b/src/lread.c
index 8716b86e9bf..182f96223a5 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -72,10 +72,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
72#define file_tell ftell 72#define file_tell ftell
73#endif 73#endif
74 74
75#ifndef HAVE_GETC_UNLOCKED
76#define getc_unlocked getc
77#endif
78
79/* The objects or placeholders read with the #n=object form. 75/* The objects or placeholders read with the #n=object form.
80 76
81 A hash table maps a number to either a placeholder (while the 77 A hash table maps a number to either a placeholder (while the
@@ -474,16 +470,15 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
474 } 470 }
475 471
476 block_input (); 472 block_input ();
477 c = getc_unlocked (instream);
478 473
479 /* Interrupted reads have been observed while reading over the network. */ 474 /* Interrupted reads have been observed while reading over the network. */
480 while (c == EOF && ferror (instream) && errno == EINTR) 475 while ((c = getc_unlocked (instream)) == EOF && errno == EINTR
476 && ferror_unlocked (instream))
481 { 477 {
482 unblock_input (); 478 unblock_input ();
483 maybe_quit (); 479 maybe_quit ();
484 block_input (); 480 block_input ();
485 clearerr (instream); 481 clearerr_unlocked (instream);
486 c = getc_unlocked (instream);
487 } 482 }
488 483
489 unblock_input (); 484 unblock_input ();
diff --git a/src/minibuf.c b/src/minibuf.c
index 1bbe276776e..d4128ce01c1 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -20,7 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 20
21#include <config.h> 21#include <config.h>
22#include <errno.h> 22#include <errno.h>
23#include <stdio.h>
24 23
25#include <binary-io.h> 24#include <binary-io.h>
26 25
@@ -31,6 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31#include "frame.h" 30#include "frame.h"
32#include "window.h" 31#include "window.h"
33#include "keymap.h" 32#include "keymap.h"
33#include "sysstdio.h"
34#include "systty.h" 34#include "systty.h"
35 35
36/* List of buffers for use as minibuffers. 36/* List of buffers for use as minibuffers.
@@ -209,15 +209,15 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
209 suppress_echo_on_tty (STDIN_FILENO); 209 suppress_echo_on_tty (STDIN_FILENO);
210 } 210 }
211 211
212 fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout); 212 fwrite_unlocked (SDATA (prompt), 1, SBYTES (prompt), stdout);
213 fflush (stdout); 213 fflush_unlocked (stdout);
214 214
215 val = Qnil; 215 val = Qnil;
216 size = 100; 216 size = 100;
217 len = 0; 217 len = 0;
218 line = xmalloc (size); 218 line = xmalloc (size);
219 219
220 while ((c = getchar ()) != '\n' && c != '\r') 220 while ((c = getchar_unlocked ()) != '\n' && c != '\r')
221 { 221 {
222 if (c == EOF) 222 if (c == EOF)
223 { 223 {
@@ -874,6 +874,30 @@ read_minibuf_unwind (void)
874 if (minibuf_level == 0) 874 if (minibuf_level == 0)
875 resize_mini_window (XWINDOW (window), 0); 875 resize_mini_window (XWINDOW (window), 0);
876 876
877 /* Deal with frames that should be removed when exiting the
878 minibuffer. */
879 {
880 Lisp_Object frames, frame1, val;
881 struct frame *f1;
882
883 FOR_EACH_FRAME (frames, frame1)
884 {
885 f1 = XFRAME (frame1);
886
887 if ((FRAME_PARENT_FRAME (f1)
888 || !NILP (get_frame_param (f1, Qdelete_before)))
889 && !NILP (val = (get_frame_param (f1, Qminibuffer_exit))))
890 {
891 if (EQ (val, Qiconify_frame))
892 Ficonify_frame (frame1);
893 else if (EQ (val, Qdelete_frame))
894 Fdelete_frame (frame1, Qnil);
895 else
896 Fmake_frame_invisible (frame1, Qnil);
897 }
898 }
899 }
900
877 /* In case the previous minibuffer displayed in this miniwindow is 901 /* In case the previous minibuffer displayed in this miniwindow is
878 dead, we may keep displaying this buffer (tho it's inactive), so reset it, 902 dead, we may keep displaying this buffer (tho it's inactive), so reset it,
879 to make sure we don't leave around bindings and stuff which only 903 to make sure we don't leave around bindings and stuff which only
@@ -1930,6 +1954,8 @@ syms_of_minibuf (void)
1930 DEFSYM (Qactivate_input_method, "activate-input-method"); 1954 DEFSYM (Qactivate_input_method, "activate-input-method");
1931 DEFSYM (Qcase_fold_search, "case-fold-search"); 1955 DEFSYM (Qcase_fold_search, "case-fold-search");
1932 DEFSYM (Qmetadata, "metadata"); 1956 DEFSYM (Qmetadata, "metadata");
1957 /* A frame parameter. */
1958 DEFSYM (Qminibuffer_exit, "minibuffer-exit");
1933 1959
1934 DEFVAR_LISP ("read-expression-history", Vread_expression_history, 1960 DEFVAR_LISP ("read-expression-history", Vread_expression_history,
1935 doc: /* A history list for arguments that are Lisp expressions to evaluate. 1961 doc: /* A history list for arguments that are Lisp expressions to evaluate.
diff --git a/src/module-env-25.h b/src/module-env-25.h
index 17e67004b24..675010b995b 100644
--- a/src/module-env-25.h
+++ b/src/module-env-25.h
@@ -92,7 +92,7 @@
92 92
93 SIZE must point to the total size of the buffer. If BUFFER is 93 SIZE must point to the total size of the buffer. If BUFFER is
94 NULL or if SIZE is not big enough, write the required buffer size 94 NULL or if SIZE is not big enough, write the required buffer size
95 to SIZE and return false. 95 to SIZE and return true.
96 96
97 Note that SIZE must include the last null byte (e.g. "abc" needs 97 Note that SIZE must include the last null byte (e.g. "abc" needs
98 a buffer of size 4). 98 a buffer of size 4).
diff --git a/src/nsfns.m b/src/nsfns.m
index dbce279da63..68eba8b6a2e 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -984,6 +984,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
984 x_set_no_accept_focus, 984 x_set_no_accept_focus,
985 x_set_z_group, /* x_set_z_group */ 985 x_set_z_group, /* x_set_z_group */
986 0, /* x_set_override_redirect */ 986 0, /* x_set_override_redirect */
987 x_set_no_special_glyphs,
987}; 988};
988 989
989 990
@@ -1256,6 +1257,8 @@ This function is an internal primitive--use `make-frame' instead. */)
1256 "leftFringe", "LeftFringe", RES_TYPE_NUMBER); 1257 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1257 x_default_parameter (f, parms, Qright_fringe, Qnil, 1258 x_default_parameter (f, parms, Qright_fringe, Qnil,
1258 "rightFringe", "RightFringe", RES_TYPE_NUMBER); 1259 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1260 x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
1261 NULL, NULL, RES_TYPE_BOOLEAN);
1259 1262
1260 init_frame_faces (f); 1263 init_frame_faces (f);
1261 1264
@@ -1325,6 +1328,15 @@ This function is an internal primitive--use `make-frame' instead. */)
1325 f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor]; 1328 f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1326 f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor]; 1329 f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1327 f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor]; 1330 f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1331 f->output_data.ns->left_edge_cursor = [NSCursor resizeLeftRightCursor];
1332 f->output_data.ns->top_left_corner_cursor = [NSCursor arrowCursor];
1333 f->output_data.ns->top_edge_cursor = [NSCursor resizeUpDownCursor];
1334 f->output_data.ns->top_right_corner_cursor = [NSCursor arrowCursor];
1335 f->output_data.ns->right_edge_cursor = [NSCursor resizeLeftRightCursor];
1336 f->output_data.ns->bottom_right_corner_cursor = [NSCursor arrowCursor];
1337 f->output_data.ns->bottom_edge_cursor = [NSCursor resizeUpDownCursor];
1338 f->output_data.ns->bottom_left_corner_cursor = [NSCursor arrowCursor];
1339
1328 FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor 1340 FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1329 = [NSCursor arrowCursor]; 1341 = [NSCursor arrowCursor];
1330 FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor 1342 FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
diff --git a/src/nsterm.h b/src/nsterm.h
index bed0b92c796..0f1b36db7b2 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -957,6 +957,14 @@ struct ns_output
957 Cursor hourglass_cursor; 957 Cursor hourglass_cursor;
958 Cursor horizontal_drag_cursor; 958 Cursor horizontal_drag_cursor;
959 Cursor vertical_drag_cursor; 959 Cursor vertical_drag_cursor;
960 Cursor left_edge_cursor;
961 Cursor top_left_corner_cursor;
962 Cursor top_edge_cursor;
963 Cursor top_right_corner_cursor;
964 Cursor right_edge_cursor;
965 Cursor bottom_right_corner_cursor;
966 Cursor bottom_edge_cursor;
967 Cursor bottom_left_corner_cursor;
960 968
961 /* NS-specific */ 969 /* NS-specific */
962 Cursor current_pointer; 970 Cursor current_pointer;
@@ -1225,8 +1233,11 @@ extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value,
1225extern void x_set_z_group (struct frame *f, Lisp_Object new_value, 1233extern void x_set_z_group (struct frame *f, Lisp_Object new_value,
1226 Lisp_Object old_value); 1234 Lisp_Object old_value);
1227extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds, 1235extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds,
1228 fd_set *exceptfds, struct timespec const *timeout, 1236 fd_set *exceptfds, struct timespec *timeout,
1229 sigset_t const *sigmask); 1237 sigset_t *sigmask);
1238#ifdef HAVE_PTHREAD
1239extern void ns_run_loop_break (void);
1240#endif
1230extern unsigned long ns_get_rgb_color (struct frame *f, 1241extern unsigned long ns_get_rgb_color (struct frame *f,
1231 float r, float g, float b, float a); 1242 float r, float g, float b, float a);
1232 1243
diff --git a/src/nsterm.m b/src/nsterm.m
index e05dbf45fbc..bf83550b3d7 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -4068,7 +4068,7 @@ ns_send_appdefined (int value)
4068 app->nextappdefined = value; 4068 app->nextappdefined = value;
4069 [app performSelectorOnMainThread:@selector (sendFromMainThread:) 4069 [app performSelectorOnMainThread:@selector (sendFromMainThread:)
4070 withObject:nil 4070 withObject:nil
4071 waitUntilDone:YES]; 4071 waitUntilDone:NO];
4072 return; 4072 return;
4073 } 4073 }
4074 4074
@@ -4293,8 +4293,8 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
4293 4293
4294int 4294int
4295ns_select (int nfds, fd_set *readfds, fd_set *writefds, 4295ns_select (int nfds, fd_set *readfds, fd_set *writefds,
4296 fd_set *exceptfds, struct timespec const *timeout, 4296 fd_set *exceptfds, struct timespec *timeout,
4297 sigset_t const *sigmask) 4297 sigset_t *sigmask)
4298/* -------------------------------------------------------------------------- 4298/* --------------------------------------------------------------------------
4299 Replacement for select, checking for events 4299 Replacement for select, checking for events
4300 -------------------------------------------------------------------------- */ 4300 -------------------------------------------------------------------------- */
@@ -4327,7 +4327,13 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
4327 if (NSApp == nil 4327 if (NSApp == nil
4328 || ![NSThread isMainThread] 4328 || ![NSThread isMainThread]
4329 || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) 4329 || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0))
4330 return pselect (nfds, readfds, writefds, exceptfds, timeout, sigmask); 4330 return thread_select(pselect, nfds, readfds, writefds,
4331 exceptfds, timeout, sigmask);
4332 else
4333 {
4334 struct timespec t = {0, 0};
4335 thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask);
4336 }
4331 4337
4332 [outerpool release]; 4338 [outerpool release];
4333 outerpool = [[NSAutoreleasePool alloc] init]; 4339 outerpool = [[NSAutoreleasePool alloc] init];
@@ -4430,6 +4436,18 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
4430 return result; 4436 return result;
4431} 4437}
4432 4438
4439#ifdef HAVE_PTHREAD
4440void
4441ns_run_loop_break ()
4442/* Break out of the NS run loop in ns_select or ns_read_socket. */
4443{
4444 NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_run_loop_break");
4445
4446 /* If we don't have a GUI, don't send the event. */
4447 if (NSApp != NULL)
4448 ns_send_appdefined(-1);
4449}
4450#endif
4433 4451
4434 4452
4435/* ========================================================================== 4453/* ==========================================================================
diff --git a/src/print.c b/src/print.c
index aaec5b04956..50c75d7712c 100644
--- a/src/print.c
+++ b/src/print.c
@@ -228,7 +228,7 @@ printchar_to_stream (unsigned int ch, FILE *stream)
228 { 228 {
229 if (ASCII_CHAR_P (ch)) 229 if (ASCII_CHAR_P (ch))
230 { 230 {
231 putc (ch, stream); 231 putc_unlocked (ch, stream);
232#ifdef WINDOWSNT 232#ifdef WINDOWSNT
233 /* Send the output to a debugger (nothing happens if there 233 /* Send the output to a debugger (nothing happens if there
234 isn't one). */ 234 isn't one). */
@@ -246,7 +246,7 @@ printchar_to_stream (unsigned int ch, FILE *stream)
246 if (encode_p) 246 if (encode_p)
247 encoded_ch = code_convert_string_norecord (encoded_ch, 247 encoded_ch = code_convert_string_norecord (encoded_ch,
248 coding_system, true); 248 coding_system, true);
249 fwrite (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream); 249 fwrite_unlocked (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream);
250#ifdef WINDOWSNT 250#ifdef WINDOWSNT
251 if (print_output_debug_flag && stream == stderr) 251 if (print_output_debug_flag && stream == stderr)
252 OutputDebugString (SSDATA (encoded_ch)); 252 OutputDebugString (SSDATA (encoded_ch));
@@ -298,7 +298,7 @@ printchar (unsigned int ch, Lisp_Object fun)
298 if (DISP_TABLE_P (Vstandard_display_table)) 298 if (DISP_TABLE_P (Vstandard_display_table))
299 printchar_to_stream (ch, stdout); 299 printchar_to_stream (ch, stdout);
300 else 300 else
301 fwrite (str, 1, len, stdout); 301 fwrite_unlocked (str, 1, len, stdout);
302 noninteractive_need_newline = 1; 302 noninteractive_need_newline = 1;
303 } 303 }
304 else 304 else
@@ -350,7 +350,7 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
350 } 350 }
351 } 351 }
352 else 352 else
353 fwrite (ptr, 1, size_byte, stdout); 353 fwrite_unlocked (ptr, 1, size_byte, stdout);
354 354
355 noninteractive_need_newline = 1; 355 noninteractive_need_newline = 1;
356 } 356 }
@@ -801,7 +801,7 @@ append to existing target file. */)
801 report_file_error ("Cannot open debugging output stream", file); 801 report_file_error ("Cannot open debugging output stream", file);
802 } 802 }
803 803
804 fflush (stderr); 804 fflush_unlocked (stderr);
805 if (dup2 (fd, STDERR_FILENO) < 0) 805 if (dup2 (fd, STDERR_FILENO) < 0)
806 report_file_error ("dup2", file); 806 report_file_error ("dup2", file);
807 if (fd != stderr_dup) 807 if (fd != stderr_dup)
@@ -1870,21 +1870,36 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1870 } 1870 }
1871 else 1871 else
1872 { 1872 {
1873 bool still_need_nonhex = false;
1873 /* If we just had a hex escape, and this character 1874 /* If we just had a hex escape, and this character
1874 could be taken as part of it, 1875 could be taken as part of it,
1875 output `\ ' to prevent that. */ 1876 output `\ ' to prevent that. */
1876 if (need_nonhex && c_isxdigit (c)) 1877 if (c_isxdigit (c))
1877 print_c_string ("\\ ", printcharfun); 1878 {
1878 1879 if (need_nonhex)
1879 if (c == '\n' && print_escape_newlines 1880 print_c_string ("\\ ", printcharfun);
1880 ? (c = 'n', true) 1881 printchar (c, printcharfun);
1881 : c == '\f' && print_escape_newlines 1882 }
1882 ? (c = 'f', true) 1883 else if (c == '\n' && print_escape_newlines
1883 : c == '\"' || c == '\\') 1884 ? (c = 'n', true)
1884 printchar ('\\', printcharfun); 1885 : c == '\f' && print_escape_newlines
1885 1886 ? (c = 'f', true)
1886 printchar (c, printcharfun); 1887 : c == '\0' && print_escape_control_characters
1887 need_nonhex = false; 1888 ? (c = '0', still_need_nonhex = true)
1889 : c == '\"' || c == '\\')
1890 {
1891 printchar ('\\', printcharfun);
1892 printchar (c, printcharfun);
1893 }
1894 else if (print_escape_control_characters && c_iscntrl (c))
1895 {
1896 char outbuf[1 + 3 + 1];
1897 int len = sprintf (outbuf, "\\%03o", c + 0u);
1898 strout (outbuf, len, len, printcharfun);
1899 }
1900 else
1901 printchar (c, printcharfun);
1902 need_nonhex = still_need_nonhex;
1888 } 1903 }
1889 } 1904 }
1890 printchar ('\"', printcharfun); 1905 printchar ('\"', printcharfun);
@@ -2329,6 +2344,11 @@ A value of nil means no limit. See also `eval-expression-print-level'. */);
2329Also print formfeeds as `\\f'. */); 2344Also print formfeeds as `\\f'. */);
2330 print_escape_newlines = 0; 2345 print_escape_newlines = 0;
2331 2346
2347 DEFVAR_BOOL ("print-escape-control-characters", print_escape_control_characters,
2348 doc: /* Non-nil means print control characters in strings as `\\OOO'.
2349\(OOO is the octal representation of the character code.)*/);
2350 print_escape_control_characters = 0;
2351
2332 DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii, 2352 DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
2333 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO. 2353 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2334\(OOO is the octal representation of the character code.) 2354\(OOO is the octal representation of the character code.)
@@ -2418,6 +2438,7 @@ priorities. */);
2418 DEFSYM (Qprint_escape_newlines, "print-escape-newlines"); 2438 DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
2419 DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte"); 2439 DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
2420 DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii"); 2440 DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
2441 DEFSYM (Qprint_escape_control_characters, "print-escape-control-characters");
2421 2442
2422 print_prune_charset_plist = Qnil; 2443 print_prune_charset_plist = Qnil;
2423 staticpro (&print_prune_charset_plist); 2444 staticpro (&print_prune_charset_plist);
diff --git a/src/process.c b/src/process.c
index 2a1c2eecde3..abd017bb907 100644
--- a/src/process.c
+++ b/src/process.c
@@ -5371,14 +5371,13 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
5371 nfds = xg_select (max_desc + 1, 5371 nfds = xg_select (max_desc + 1,
5372 &Available, (check_write ? &Writeok : 0), 5372 &Available, (check_write ? &Writeok : 0),
5373 NULL, &timeout, NULL); 5373 NULL, &timeout, NULL);
5374#elif defined HAVE_NS
5375 /* And NS builds call thread_select in ns_select. */
5376 nfds = ns_select (max_desc + 1,
5377 &Available, (check_write ? &Writeok : 0),
5378 NULL, &timeout, NULL);
5374#else /* !HAVE_GLIB */ 5379#else /* !HAVE_GLIB */
5375 nfds = thread_select ( 5380 nfds = thread_select (pselect, max_desc + 1,
5376# ifdef HAVE_NS
5377 ns_select
5378# else
5379 pselect
5380# endif
5381 , max_desc + 1,
5382 &Available, 5381 &Available,
5383 (check_write ? &Writeok : 0), 5382 (check_write ? &Writeok : 0),
5384 NULL, &timeout, NULL); 5383 NULL, &timeout, NULL);
diff --git a/src/sysdep.c b/src/sysdep.c
index 70f4a9dd7ea..b52236769e0 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1408,7 +1408,7 @@ reset_sys_modes (struct tty_display_info *tty_out)
1408{ 1408{
1409 if (noninteractive) 1409 if (noninteractive)
1410 { 1410 {
1411 fflush (stdout); 1411 fflush_unlocked (stdout);
1412 return; 1412 return;
1413 } 1413 }
1414 if (!tty_out->term_initted) 1414 if (!tty_out->term_initted)
@@ -1428,17 +1428,14 @@ reset_sys_modes (struct tty_display_info *tty_out)
1428 } 1428 }
1429 else 1429 else
1430 { /* have to do it the hard way */ 1430 { /* have to do it the hard way */
1431 int i;
1432 tty_turn_off_insert (tty_out); 1431 tty_turn_off_insert (tty_out);
1433 1432
1434 for (i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++) 1433 for (int i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++)
1435 { 1434 fputc_unlocked (' ', tty_out->output);
1436 fputc (' ', tty_out->output);
1437 }
1438 } 1435 }
1439 1436
1440 cmgoto (tty_out, FrameRows (tty_out) - 1, 0); 1437 cmgoto (tty_out, FrameRows (tty_out) - 1, 0);
1441 fflush (tty_out->output); 1438 fflush_unlocked (tty_out->output);
1442 1439
1443 if (tty_out->terminal->reset_terminal_modes_hook) 1440 if (tty_out->terminal->reset_terminal_modes_hook)
1444 tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal); 1441 tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal);
@@ -3079,7 +3076,7 @@ procfs_ttyname (int rdev)
3079 char minor[25]; /* 2 32-bit numbers + dash */ 3076 char minor[25]; /* 2 32-bit numbers + dash */
3080 char *endp; 3077 char *endp;
3081 3078
3082 for (; !feof (fdev) && !ferror (fdev); name[0] = 0) 3079 for (; !feof_unlocked (fdev) && !ferror_unlocked (fdev); name[0] = 0)
3083 { 3080 {
3084 if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3 3081 if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3
3085 && major == MAJOR (rdev)) 3082 && major == MAJOR (rdev))
@@ -3129,7 +3126,7 @@ procfs_get_total_memory (void)
3129 break; 3126 break;
3130 3127
3131 case 0: 3128 case 0:
3132 while ((c = getc (fmem)) != EOF && c != '\n') 3129 while ((c = getc_unlocked (fmem)) != EOF && c != '\n')
3133 continue; 3130 continue;
3134 done = c == EOF; 3131 done = c == EOF;
3135 break; 3132 break;
diff --git a/src/sysstdio.h b/src/sysstdio.h
index 45ee33f5580..7fbcefcdad9 100644
--- a/src/sysstdio.h
+++ b/src/sysstdio.h
@@ -33,4 +33,45 @@ extern FILE *emacs_fopen (char const *, char const *);
33# define FOPEN_TEXT "" 33# define FOPEN_TEXT ""
34#endif 34#endif
35 35
36/* These are compatible with unlocked-io.h, if both files are included. */
37#if !HAVE_DECL_CLEARERR_UNLOCKED
38# define clearerr_unlocked(x) clearerr (x)
39#endif
40#if !HAVE_DECL_FEOF_UNLOCKED
41# define feof_unlocked(x) feof (x)
42#endif
43#if !HAVE_DECL_FERROR_UNLOCKED
44# define ferror_unlocked(x) ferror (x)
45#endif
46#if !HAVE_DECL_FFLUSH_UNLOCKED
47# define fflush_unlocked(x) fflush (x)
48#endif
49#if !HAVE_DECL_FGETS_UNLOCKED
50# define fgets_unlocked(x,y,z) fgets (x,y,z)
51#endif
52#if !HAVE_DECL_FPUTC_UNLOCKED
53# define fputc_unlocked(x,y) fputc (x,y)
54#endif
55#if !HAVE_DECL_FPUTS_UNLOCKED
56# define fputs_unlocked(x,y) fputs (x,y)
57#endif
58#if !HAVE_DECL_FREAD_UNLOCKED
59# define fread_unlocked(w,x,y,z) fread (w,x,y,z)
60#endif
61#if !HAVE_DECL_FWRITE_UNLOCKED
62# define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z)
63#endif
64#if !HAVE_DECL_GETC_UNLOCKED
65# define getc_unlocked(x) getc (x)
66#endif
67#if !HAVE_DECL_GETCHAR_UNLOCKED
68# define getchar_unlocked() getchar ()
69#endif
70#if !HAVE_DECL_PUTC_UNLOCKED
71# define putc_unlocked(x,y) putc (x,y)
72#endif
73#if !HAVE_DECL_PUTCHAR_UNLOCKED
74# define putchar_unlocked(x) putchar (x)
75#endif
76
36#endif /* EMACS_SYSSTDIO_H */ 77#endif /* EMACS_SYSSTDIO_H */
diff --git a/src/systhread.c b/src/systhread.c
index a84060c18f0..aee12a9b482 100644
--- a/src/systhread.c
+++ b/src/systhread.c
@@ -20,6 +20,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20#include <setjmp.h> 20#include <setjmp.h>
21#include "lisp.h" 21#include "lisp.h"
22 22
23#ifdef HAVE_NS
24#include "nsterm.h"
25#endif
26
23#ifndef THREADS_ENABLED 27#ifndef THREADS_ENABLED
24 28
25void 29void
@@ -130,6 +134,13 @@ void
130sys_cond_broadcast (sys_cond_t *cond) 134sys_cond_broadcast (sys_cond_t *cond)
131{ 135{
132 pthread_cond_broadcast (cond); 136 pthread_cond_broadcast (cond);
137#ifdef HAVE_NS
138 /* Send an app defined event to break out of the NS run loop.
139 It seems that if ns_select is running the NS run loop, this
140 broadcast has no effect until the loop is done, breaking a couple
141 of tests in thread-tests.el. */
142 ns_run_loop_break ();
143#endif
133} 144}
134 145
135void 146void
diff --git a/src/term.c b/src/term.c
index 8770aff8a92..3d7f4ada0b9 100644
--- a/src/term.c
+++ b/src/term.c
@@ -22,7 +22,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22#include <config.h> 22#include <config.h>
23#include <errno.h> 23#include <errno.h>
24#include <fcntl.h> 24#include <fcntl.h>
25#include <stdio.h>
26#include <stdlib.h> 25#include <stdlib.h>
27#include <sys/file.h> 26#include <sys/file.h>
28#include <sys/time.h> 27#include <sys/time.h>
@@ -45,6 +44,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
45#include "keymap.h" 44#include "keymap.h"
46#include "blockinput.h" 45#include "blockinput.h"
47#include "syssignal.h" 46#include "syssignal.h"
47#include "sysstdio.h"
48#ifdef MSDOS 48#ifdef MSDOS
49#include "msdos.h" 49#include "msdos.h"
50static int been_here = -1; 50static int been_here = -1;
@@ -146,7 +146,7 @@ tty_ring_bell (struct frame *f)
146 OUTPUT (tty, (tty->TS_visible_bell && visible_bell 146 OUTPUT (tty, (tty->TS_visible_bell && visible_bell
147 ? tty->TS_visible_bell 147 ? tty->TS_visible_bell
148 : tty->TS_bell)); 148 : tty->TS_bell));
149 fflush (tty->output); 149 fflush_unlocked (tty->output);
150 } 150 }
151} 151}
152 152
@@ -167,9 +167,10 @@ tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym)
167 Lisp_Object string = XCAR (extra_codes); 167 Lisp_Object string = XCAR (extra_codes);
168 if (STRINGP (string)) 168 if (STRINGP (string))
169 { 169 {
170 fwrite (SDATA (string), 1, SBYTES (string), tty->output); 170 fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->output);
171 if (tty->termscript) 171 if (tty->termscript)
172 fwrite (SDATA (string), 1, SBYTES (string), tty->termscript); 172 fwrite_unlocked (SDATA (string), 1, SBYTES (string),
173 tty->termscript);
173 } 174 }
174 } 175 }
175} 176}
@@ -197,7 +198,7 @@ tty_set_terminal_modes (struct terminal *terminal)
197 OUTPUT_IF (tty, tty->TS_keypad_mode); 198 OUTPUT_IF (tty, tty->TS_keypad_mode);
198 losecursor (tty); 199 losecursor (tty);
199 tty_send_additional_strings (terminal, Qtty_mode_set_strings); 200 tty_send_additional_strings (terminal, Qtty_mode_set_strings);
200 fflush (tty->output); 201 fflush_unlocked (tty->output);
201 } 202 }
202} 203}
203 204
@@ -220,7 +221,7 @@ tty_reset_terminal_modes (struct terminal *terminal)
220 /* Output raw CR so kernel can track the cursor hpos. */ 221 /* Output raw CR so kernel can track the cursor hpos. */
221 current_tty = tty; 222 current_tty = tty;
222 cmputc ('\r'); 223 cmputc ('\r');
223 fflush (tty->output); 224 fflush_unlocked (tty->output);
224 } 225 }
225} 226}
226 227
@@ -235,7 +236,7 @@ tty_update_end (struct frame *f)
235 tty_show_cursor (tty); 236 tty_show_cursor (tty);
236 tty_turn_off_insert (tty); 237 tty_turn_off_insert (tty);
237 tty_background_highlight (tty); 238 tty_background_highlight (tty);
238 fflush (tty->output); 239 fflush_unlocked (tty->output);
239} 240}
240 241
241/* The implementation of set_terminal_window for termcap frames. */ 242/* The implementation of set_terminal_window for termcap frames. */
@@ -497,8 +498,8 @@ tty_clear_end_of_line (struct frame *f, int first_unused_hpos)
497 for (i = curX (tty); i < first_unused_hpos; i++) 498 for (i = curX (tty); i < first_unused_hpos; i++)
498 { 499 {
499 if (tty->termscript) 500 if (tty->termscript)
500 fputc (' ', tty->termscript); 501 fputc_unlocked (' ', tty->termscript);
501 fputc (' ', tty->output); 502 fputc_unlocked (' ', tty->output);
502 } 503 }
503 cmplus (tty, first_unused_hpos - curX (tty)); 504 cmplus (tty, first_unused_hpos - curX (tty));
504 } 505 }
@@ -771,11 +772,11 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len)
771 if (coding->produced > 0) 772 if (coding->produced > 0)
772 { 773 {
773 block_input (); 774 block_input ();
774 fwrite (conversion_buffer, 1, coding->produced, tty->output); 775 fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
775 if (ferror (tty->output)) 776 clearerr_unlocked (tty->output);
776 clearerr (tty->output);
777 if (tty->termscript) 777 if (tty->termscript)
778 fwrite (conversion_buffer, 1, coding->produced, tty->termscript); 778 fwrite_unlocked (conversion_buffer, 1, coding->produced,
779 tty->termscript);
779 unblock_input (); 780 unblock_input ();
780 } 781 }
781 string += n; 782 string += n;
@@ -832,11 +833,11 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str
832 if (coding->produced > 0) 833 if (coding->produced > 0)
833 { 834 {
834 block_input (); 835 block_input ();
835 fwrite (conversion_buffer, 1, coding->produced, tty->output); 836 fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
836 if (ferror (tty->output)) 837 clearerr_unlocked (tty->output);
837 clearerr (tty->output);
838 if (tty->termscript) 838 if (tty->termscript)
839 fwrite (conversion_buffer, 1, coding->produced, tty->termscript); 839 fwrite_unlocked (conversion_buffer, 1, coding->produced,
840 tty->termscript);
840 unblock_input (); 841 unblock_input ();
841 } 842 }
842 843
@@ -918,11 +919,11 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len)
918 if (coding->produced > 0) 919 if (coding->produced > 0)
919 { 920 {
920 block_input (); 921 block_input ();
921 fwrite (conversion_buffer, 1, coding->produced, tty->output); 922 fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
922 if (ferror (tty->output)) 923 clearerr_unlocked (tty->output);
923 clearerr (tty->output);
924 if (tty->termscript) 924 if (tty->termscript)
925 fwrite (conversion_buffer, 1, coding->produced, tty->termscript); 925 fwrite_unlocked (conversion_buffer, 1, coding->produced,
926 tty->termscript);
926 unblock_input (); 927 unblock_input ();
927 } 928 }
928 929
@@ -3327,7 +3328,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
3327 which calls tty_show_cursor. Re-hide it, so it doesn't show 3328 which calls tty_show_cursor. Re-hide it, so it doesn't show
3328 through the menus. */ 3329 through the menus. */
3329 tty_hide_cursor (tty); 3330 tty_hide_cursor (tty);
3330 fflush (tty->output); 3331 fflush_unlocked (tty->output);
3331 } 3332 }
3332 3333
3333 sf->mouse_moved = 0; 3334 sf->mouse_moved = 0;
@@ -3335,7 +3336,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
3335 while (statecount--) 3336 while (statecount--)
3336 free_saved_screen (state[statecount].screen_behind); 3337 free_saved_screen (state[statecount].screen_behind);
3337 tty_show_cursor (tty); /* Turn cursor back on. */ 3338 tty_show_cursor (tty); /* Turn cursor back on. */
3338 fflush (tty->output); 3339 fflush_unlocked (tty->output);
3339 3340
3340/* Clean up any mouse events that are waiting inside Emacs event queue. 3341/* Clean up any mouse events that are waiting inside Emacs event queue.
3341 These events are likely to be generated before the menu was even 3342 These events are likely to be generated before the menu was even
diff --git a/src/w32fns.c b/src/w32fns.c
index e490588d01b..b0842b5ee6c 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -5889,6 +5889,8 @@ This function is an internal primitive--use `make-frame' instead. */)
5889 NULL, NULL, RES_TYPE_BOOLEAN); 5889 NULL, NULL, RES_TYPE_BOOLEAN);
5890 x_default_parameter (f, parameters, Qno_accept_focus, Qnil, 5890 x_default_parameter (f, parameters, Qno_accept_focus, Qnil,
5891 NULL, NULL, RES_TYPE_BOOLEAN); 5891 NULL, NULL, RES_TYPE_BOOLEAN);
5892 x_default_parameter (f, parameters, Qno_special_glyphs, Qnil,
5893 NULL, NULL, RES_TYPE_BOOLEAN);
5892 5894
5893 /* Process alpha here (Bug#16619). On XP this fails with child 5895 /* Process alpha here (Bug#16619). On XP this fails with child
5894 frames. For `no-focus-on-map' frames delay processing of alpha 5896 frames. For `no-focus-on-map' frames delay processing of alpha
@@ -5957,6 +5959,14 @@ This function is an internal primitive--use `make-frame' instead. */)
5957 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT); 5959 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
5958 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE); 5960 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
5959 f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS); 5961 f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS);
5962 f->output_data.w32->left_edge_cursor = w32_load_cursor (IDC_SIZEWE);
5963 f->output_data.w32->top_left_corner_cursor = w32_load_cursor (IDC_SIZENWSE);
5964 f->output_data.w32->top_edge_cursor = w32_load_cursor (IDC_SIZENS);
5965 f->output_data.w32->top_right_corner_cursor = w32_load_cursor (IDC_SIZENESW);
5966 f->output_data.w32->right_edge_cursor = w32_load_cursor (IDC_SIZEWE);
5967 f->output_data.w32->bottom_right_corner_cursor = w32_load_cursor (IDC_SIZENWSE);
5968 f->output_data.w32->bottom_edge_cursor = w32_load_cursor (IDC_SIZENS);
5969 f->output_data.w32->bottom_left_corner_cursor = w32_load_cursor (IDC_SIZENESW);
5960 5970
5961 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor; 5971 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
5962 5972
@@ -7049,6 +7059,8 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
7049 "cursorColor", "Foreground", RES_TYPE_STRING); 7059 "cursorColor", "Foreground", RES_TYPE_STRING);
7050 x_default_parameter (f, parms, Qborder_color, build_string ("black"), 7060 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
7051 "borderColor", "BorderColor", RES_TYPE_STRING); 7061 "borderColor", "BorderColor", RES_TYPE_STRING);
7062 x_default_parameter (f, parms, Qno_special_glyphs, Qt,
7063 NULL, NULL, RES_TYPE_BOOLEAN);
7052 7064
7053 /* Init faces before x_default_parameter is called for the 7065 /* Init faces before x_default_parameter is called for the
7054 scroll-bar-width parameter because otherwise we end up in 7066 scroll-bar-width parameter because otherwise we end up in
@@ -8950,33 +8962,47 @@ menu bar or tool bar of FRAME. */)
8950 if (EQ (type, Qouter_edges)) 8962 if (EQ (type, Qouter_edges))
8951 { 8963 {
8952 RECT rectangle; 8964 RECT rectangle;
8965 BOOL success = false;
8953 8966
8954 block_input (); 8967 block_input ();
8955 /* Outer frame rectangle, including outer borders and title bar. */ 8968 /* Outer frame rectangle, including outer borders and title bar. */
8956 GetWindowRect (FRAME_W32_WINDOW (f), &rectangle); 8969 success = GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
8957 unblock_input (); 8970 unblock_input ();
8958 8971
8959 return list4 (make_number (rectangle.left), 8972 if (success)
8960 make_number (rectangle.top), 8973 return list4 (make_number (rectangle.left),
8961 make_number (rectangle.right), 8974 make_number (rectangle.top),
8962 make_number (rectangle.bottom)); 8975 make_number (rectangle.right),
8976 make_number (rectangle.bottom));
8977 else
8978 return Qnil;
8963 } 8979 }
8964 else 8980 else
8965 { 8981 {
8966 RECT rectangle; 8982 RECT rectangle;
8967 POINT pt; 8983 POINT pt;
8968 int left, top, right, bottom; 8984 int left, top, right, bottom;
8985 BOOL success;
8969 8986
8970 block_input (); 8987 block_input ();
8971 /* Inner frame rectangle, excluding borders and title bar. */ 8988 /* Inner frame rectangle, excluding borders and title bar. */
8972 GetClientRect (FRAME_W32_WINDOW (f), &rectangle); 8989 success = GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
8973 /* Get top-left corner of native rectangle in screen 8990 /* Get top-left corner of native rectangle in screen
8974 coordinates. */ 8991 coordinates. */
8992 if (!success)
8993 {
8994 unblock_input ();
8995 return Qnil;
8996 }
8997
8975 pt.x = 0; 8998 pt.x = 0;
8976 pt.y = 0; 8999 pt.y = 0;
8977 ClientToScreen (FRAME_W32_WINDOW (f), &pt); 9000 success = ClientToScreen (FRAME_W32_WINDOW (f), &pt);
8978 unblock_input (); 9001 unblock_input ();
8979 9002
9003 if (!success)
9004 return Qnil;
9005
8980 left = pt.x; 9006 left = pt.x;
8981 top = pt.y; 9007 top = pt.y;
8982 right = left + rectangle.right; 9008 right = left + rectangle.right;
@@ -10330,6 +10356,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
10330 x_set_no_accept_focus, 10356 x_set_no_accept_focus,
10331 x_set_z_group, 10357 x_set_z_group,
10332 0, /* x_set_override_redirect */ 10358 0, /* x_set_override_redirect */
10359 x_set_no_special_glyphs,
10333}; 10360};
10334 10361
10335void 10362void
diff --git a/src/w32term.c b/src/w32term.c
index 712bdae5fc3..c37805cb6ca 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -5086,6 +5086,51 @@ w32_read_socket (struct terminal *terminal,
5086 } 5086 }
5087 5087
5088 case WM_WINDOWPOSCHANGED: 5088 case WM_WINDOWPOSCHANGED:
5089 f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
5090
5091 if (f)
5092 {
5093 RECT rect;
5094 int /* rows, columns, */ width, height, text_width, text_height;
5095
5096 if (GetClientRect (msg.msg.hwnd, &rect)
5097 /* GetClientRect evidently returns (0, 0, 0, 0) if
5098 called on a minimized frame. Such "dimensions"
5099 aren't useful anyway. */
5100 && !(rect.bottom == 0
5101 && rect.top == 0
5102 && rect.left == 0
5103 && rect.right == 0))
5104 {
5105 height = rect.bottom - rect.top;
5106 width = rect.right - rect.left;
5107 text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, width);
5108 text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, height);
5109 /* rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, height); */
5110 /* columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, width); */
5111
5112 /* TODO: Clip size to the screen dimensions. */
5113
5114 /* Even if the number of character rows and columns
5115 has not changed, the font size may have changed,
5116 so we need to check the pixel dimensions as well. */
5117
5118 if (width != FRAME_PIXEL_WIDTH (f)
5119 || height != FRAME_PIXEL_HEIGHT (f)
5120 || text_width != FRAME_TEXT_WIDTH (f)
5121 || text_height != FRAME_TEXT_HEIGHT (f))
5122 {
5123 change_frame_size (f, text_width, text_height, 0, 1, 0, 1);
5124 SET_FRAME_GARBAGED (f);
5125 cancel_mouse_face (f);
5126 f->win_gravity = NorthWestGravity;
5127 }
5128 }
5129 }
5130
5131 check_visibility = 1;
5132 break;
5133
5089 case WM_ACTIVATE: 5134 case WM_ACTIVATE:
5090 case WM_ACTIVATEAPP: 5135 case WM_ACTIVATEAPP:
5091 f = x_window_to_frame (dpyinfo, msg.msg.hwnd); 5136 f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
@@ -6052,7 +6097,7 @@ x_calc_absolute_position (struct frame *f)
6052 int display_top = 0; 6097 int display_top = 0;
6053 struct frame *p = FRAME_PARENT_FRAME (f); 6098 struct frame *p = FRAME_PARENT_FRAME (f);
6054 6099
6055 if (flags & (XNegative | YNegative)) 6100 if (!p && flags & (XNegative | YNegative))
6056 { 6101 {
6057 Lisp_Object list; 6102 Lisp_Object list;
6058 6103
@@ -6078,20 +6123,26 @@ x_calc_absolute_position (struct frame *f)
6078 } 6123 }
6079 6124
6080 /* Treat negative positions as relative to the rightmost bottommost 6125 /* Treat negative positions as relative to the rightmost bottommost
6081 position that fits on the screen. */ 6126 position that fits on the screen or parent frame.
6127
6128 I see no need for subtracting 1 from the border widths - is there
6129 any on the remaining platforms? Here these subtractions did put
6130 the last pixel line/column of a frame off-display when, for
6131 example, a (set-frame-parameter nil 'left '(- 0)) specification was
6132 used - martin 20017-05-05. */
6082 if (flags & XNegative) 6133 if (flags & XNegative)
6083 { 6134 {
6084 if (p) 6135 if (p)
6085 f->left_pos = (FRAME_PIXEL_WIDTH (p) 6136 f->left_pos = (FRAME_PIXEL_WIDTH (p)
6086 - FRAME_PIXEL_WIDTH (f) 6137 - FRAME_PIXEL_WIDTH (f)
6087 + f->left_pos 6138 + f->left_pos
6088 - (left_right_borders_width - 1)); 6139 - left_right_borders_width);
6089 else 6140 else
6090 f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) 6141 f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f))
6091 + display_left 6142 + display_left
6092 - FRAME_PIXEL_WIDTH (f) 6143 - FRAME_PIXEL_WIDTH (f)
6093 + f->left_pos 6144 + f->left_pos
6094 - (left_right_borders_width - 1)); 6145 - left_right_borders_width);
6095 } 6146 }
6096 6147
6097 if (flags & YNegative) 6148 if (flags & YNegative)
@@ -6100,13 +6151,13 @@ x_calc_absolute_position (struct frame *f)
6100 f->top_pos = (FRAME_PIXEL_HEIGHT (p) 6151 f->top_pos = (FRAME_PIXEL_HEIGHT (p)
6101 - FRAME_PIXEL_HEIGHT (f) 6152 - FRAME_PIXEL_HEIGHT (f)
6102 + f->top_pos 6153 + f->top_pos
6103 - (top_bottom_borders_height - 1)); 6154 - top_bottom_borders_height);
6104 else 6155 else
6105 f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) 6156 f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f))
6106 + display_top 6157 + display_top
6107 - FRAME_PIXEL_HEIGHT (f) 6158 - FRAME_PIXEL_HEIGHT (f)
6108 + f->top_pos 6159 + f->top_pos
6109 - (top_bottom_borders_height - 1)); 6160 - top_bottom_borders_height);
6110 } 6161 }
6111 6162
6112 /* The left_pos and top_pos are now relative to the top and left 6163 /* The left_pos and top_pos are now relative to the top and left
diff --git a/src/w32term.h b/src/w32term.h
index 371cf9005bc..9956682c5cd 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -345,6 +345,14 @@ struct w32_output
345 Cursor hourglass_cursor; 345 Cursor hourglass_cursor;
346 Cursor horizontal_drag_cursor; 346 Cursor horizontal_drag_cursor;
347 Cursor vertical_drag_cursor; 347 Cursor vertical_drag_cursor;
348 Cursor left_edge_cursor;
349 Cursor top_left_corner_cursor;
350 Cursor top_edge_cursor;
351 Cursor top_right_corner_cursor;
352 Cursor right_edge_cursor;
353 Cursor bottom_right_corner_cursor;
354 Cursor bottom_edge_cursor;
355 Cursor bottom_left_corner_cursor;
348 356
349 /* Non-zero means hourglass cursor is currently displayed. */ 357 /* Non-zero means hourglass cursor is currently displayed. */
350 unsigned hourglass_p : 1; 358 unsigned hourglass_p : 1;
diff --git a/src/window.c b/src/window.c
index bf89f0e488b..4816bd69909 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1208,13 +1208,13 @@ coordinates_in_window (register struct window *w, int x, int y)
1208 - WINDOW_BOTTOM_DIVIDER_WIDTH (w)))) 1208 - WINDOW_BOTTOM_DIVIDER_WIDTH (w))))
1209 return ON_HORIZONTAL_SCROLL_BAR; 1209 return ON_HORIZONTAL_SCROLL_BAR;
1210 /* On the mode or header line? */ 1210 /* On the mode or header line? */
1211 else if ((WINDOW_WANTS_MODELINE_P (w) 1211 else if ((window_wants_mode_line (w)
1212 && y >= (bottom_y 1212 && y >= (bottom_y
1213 - CURRENT_MODE_LINE_HEIGHT (w) 1213 - CURRENT_MODE_LINE_HEIGHT (w)
1214 - WINDOW_BOTTOM_DIVIDER_WIDTH (w)) 1214 - WINDOW_BOTTOM_DIVIDER_WIDTH (w))
1215 && y <= bottom_y - WINDOW_BOTTOM_DIVIDER_WIDTH (w) 1215 && y <= bottom_y - WINDOW_BOTTOM_DIVIDER_WIDTH (w)
1216 && (part = ON_MODE_LINE)) 1216 && (part = ON_MODE_LINE))
1217 || (WINDOW_WANTS_HEADER_LINE_P (w) 1217 || (window_wants_header_line (w)
1218 && y < top_y + CURRENT_HEADER_LINE_HEIGHT (w) 1218 && y < top_y + CURRENT_HEADER_LINE_HEIGHT (w)
1219 && (part = ON_HEADER_LINE))) 1219 && (part = ON_HEADER_LINE)))
1220 { 1220 {
@@ -1851,7 +1851,7 @@ Return nil if window display is not up-to-date. In that case, use
1851 1851
1852 if (EQ (line, Qheader_line)) 1852 if (EQ (line, Qheader_line))
1853 { 1853 {
1854 if (!WINDOW_WANTS_HEADER_LINE_P (w)) 1854 if (!window_wants_header_line (w))
1855 return Qnil; 1855 return Qnil;
1856 row = MATRIX_HEADER_LINE_ROW (w->current_matrix); 1856 row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
1857 return row->enabled_p ? list4i (row->height, 0, 0, 0) : Qnil; 1857 return row->enabled_p ? list4i (row->height, 0, 0, 0) : Qnil;
@@ -1898,6 +1898,129 @@ Return nil if window display is not up-to-date. In that case, use
1898 return list4i (row->height + min (0, row->y) - crop, i, row->y, crop); 1898 return list4i (row->height + min (0, row->y) - crop, i, row->y, crop);
1899} 1899}
1900 1900
1901DEFUN ("window-lines-pixel-dimensions", Fwindow_lines_pixel_dimensions, Swindow_lines_pixel_dimensions, 0, 6, 0,
1902 doc: /* Return pixel dimensions of WINDOW's lines.
1903The return value is a list of the x- and y-coordinates of the lower
1904right corner of the last character of each line. Return nil if the
1905current glyph matrix of WINDOW is not up-to-date.
1906
1907Optional argument WINDOW specifies the window whose lines' dimensions
1908shall be returned. Nil or omitted means to return the dimensions for
1909the selected window.
1910
1911FIRST, if non-nil, specifies the index of the first line whose
1912dimensions shall be returned. If FIRST is nil and BODY is non-nil,
1913start with the first text line of WINDOW. Otherwise, start with the
1914first line of WINDOW.
1915
1916LAST, if non-nil, specifies the last line whose dimensions shall be
1917returned. If LAST is nil and BODY is non-nil, the last line is the last
1918line of the body (text area) of WINDOW. Otherwise, last is the last
1919line of WINDOW.
1920
1921INVERSE, if nil, means that the y-pixel value returned for a specific
1922line specifies the distance in pixels from the left edge (body edge if
1923BODY is non-nil) of WINDOW to the right edge of the last glyph of that
1924line. INVERSE non-nil means that the y-pixel value returned for a
1925specific line specifies the distance in pixels from the right edge of
1926the last glyph of that line to the right edge (body edge if BODY is
1927non-nil) of WINDOW.
1928
1929LEFT non-nil means to return the x- and y-coordinates of the lower left
1930corner of the leftmost character on each line. This is the value that
1931should be used for buffers that mostly display text from right to left.
1932
1933If LEFT is non-nil and INVERSE is nil, this means that the y-pixel value
1934returned for a specific line specifies the distance in pixels from the
1935left edge of the last (leftmost) glyph of that line to the right edge
1936(body edge if BODY is non-nil) of WINDOW. If LEFT and INVERSE are both
1937non-nil, the y-pixel value returned for a specific line specifies the
1938distance in pixels from the left edge (body edge if BODY is non-nil) of
1939WINDOW to the left edge of the last (leftmost) glyph of that line.
1940
1941Normally, the value of this function is not available while Emacs is
1942busy, for example, when processing a command. It should be retrievable
1943though when run from an idle timer with a delay of zero seconds. */)
1944 (Lisp_Object window, Lisp_Object first, Lisp_Object last, Lisp_Object body, Lisp_Object inverse, Lisp_Object left)
1945{
1946 struct window *w = decode_live_window (window);
1947 struct buffer *b;
1948 struct glyph_row *row, *end_row;
1949 int max_y = NILP (body) ? WINDOW_PIXEL_HEIGHT (w) : window_text_bottom_y (w);
1950 Lisp_Object rows = Qnil;
1951 int window_width = NILP (body) ? w->pixel_width : window_body_width (w, true);
1952 int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w);
1953 int subtract = NILP (body) ? 0 : header_line_height;
1954 bool invert = !NILP (inverse);
1955 bool left_flag = !NILP (left);
1956
1957 if (noninteractive || w->pseudo_window_p)
1958 return Qnil;
1959
1960 CHECK_BUFFER (w->contents);
1961 b = XBUFFER (w->contents);
1962
1963 /* Fail if current matrix is not up-to-date. */
1964 if (!w->window_end_valid
1965 || windows_or_buffers_changed
1966 || b->clip_changed
1967 || b->prevent_redisplay_optimizations_p
1968 || window_outdated (w))
1969 return Qnil;
1970
1971 if (NILP (first))
1972 row = (NILP (body)
1973 ? MATRIX_ROW (w->current_matrix, 0)
1974 : MATRIX_FIRST_TEXT_ROW (w->current_matrix));
1975 else if (NUMBERP (first))
1976 {
1977 CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows);
1978 row = MATRIX_ROW (w->current_matrix, XINT (first));
1979 }
1980 else
1981 error ("Invalid specification of first line");
1982
1983 if (NILP (last))
1984
1985 end_row = (NILP (body)
1986 ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
1987 : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
1988 else if (NUMBERP (last))
1989 {
1990 CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows);
1991 end_row = MATRIX_ROW (w->current_matrix, XINT (last));
1992 }
1993 else
1994 error ("Invalid specification of last line");
1995
1996 while (row <= end_row && row->enabled_p
1997 && row->y + row->height < max_y)
1998 {
1999
2000 if (left_flag)
2001 {
2002 struct glyph *glyph = row->glyphs[TEXT_AREA];
2003
2004 rows = Fcons (Fcons (make_number
2005 (invert
2006 ? glyph->pixel_width
2007 : window_width - glyph->pixel_width),
2008 make_number (row->y + row->height - subtract)),
2009 rows);
2010 }
2011 else
2012 rows = Fcons (Fcons (make_number
2013 (invert
2014 ? window_width - row->pixel_width
2015 : row->pixel_width),
2016 make_number (row->y + row->height - subtract)),
2017 rows);
2018 row++;
2019 }
2020
2021 return Fnreverse (rows);
2022}
2023
1901DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p, 2024DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p,
1902 0, 1, 0, 2025 0, 1, 0,
1903 doc: /* Return non-nil when WINDOW is dedicated to its buffer. 2026 doc: /* Return non-nil when WINDOW is dedicated to its buffer.
@@ -2003,16 +2126,24 @@ return value is a list of elements of the form (PARAMETER . VALUE). */)
2003 return Fcopy_alist (decode_valid_window (window)->window_parameters); 2126 return Fcopy_alist (decode_valid_window (window)->window_parameters);
2004} 2127}
2005 2128
2129Lisp_Object
2130window_parameter (struct window *w, Lisp_Object parameter)
2131{
2132 Lisp_Object result = Fassq (parameter, w->window_parameters);
2133
2134 return CDR_SAFE (result);
2135}
2136
2137
2006DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter, 2138DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter,
2007 2, 2, 0, 2139 2, 2, 0,
2008 doc: /* Return WINDOW's value for PARAMETER. 2140 doc: /* Return WINDOW's value for PARAMETER.
2009WINDOW can be any window and defaults to the selected one. */) 2141WINDOW can be any window and defaults to the selected one. */)
2010 (Lisp_Object window, Lisp_Object parameter) 2142 (Lisp_Object window, Lisp_Object parameter)
2011{ 2143{
2012 Lisp_Object result; 2144 struct window *w = decode_any_window (window);
2013 2145
2014 result = Fassq (parameter, decode_any_window (window)->window_parameters); 2146 return window_parameter (w, parameter);
2015 return CDR_SAFE (result);
2016} 2147}
2017 2148
2018DEFUN ("set-window-parameter", Fset_window_parameter, 2149DEFUN ("set-window-parameter", Fset_window_parameter,
@@ -4740,6 +4871,69 @@ mark_window_cursors_off (struct window *w)
4740} 4871}
4741 4872
4742 4873
4874/**
4875 * window_wants_mode_line:
4876 *
4877 * Return 1 if window W wants a mode line and is high enough to
4878 * accomodate it, 0 otherwise.
4879 *
4880 * W wants a mode line if it's a leaf window and neither a minibuffer
4881 * nor a pseudo window. Moreover, its 'window-mode-line-format'
4882 * parameter must not be 'none' and either that parameter or W's
4883 * buffer's 'mode-line-format' value must be non-nil. Finally, W must
4884 * be higher than its frame's canonical character height.
4885 */
4886bool
4887window_wants_mode_line (struct window *w)
4888{
4889 Lisp_Object window_mode_line_format =
4890 window_parameter (w, Qmode_line_format);
4891
4892 return ((WINDOW_LEAF_P (w)
4893 && !MINI_WINDOW_P (w)
4894 && !WINDOW_PSEUDO_P (w)
4895 && !EQ (window_mode_line_format, Qnone)
4896 && (!NILP (window_mode_line_format)
4897 || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), mode_line_format)))
4898 && WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w))
4899 ? 1
4900 : 0);
4901}
4902
4903
4904/**
4905 * window_wants_header_line:
4906 *
4907 * Return 1 if window W wants a header line and is high enough to
4908 * accomodate it, 0 otherwise.
4909 *
4910 * W wants a header line if it's a leaf window and neither a minibuffer
4911 * nor a pseudo window. Moreover, its 'window-mode-line-format'
4912 * parameter must not be 'none' and either that parameter or W's
4913 * buffer's 'mode-line-format' value must be non-nil. Finally, W must
4914 * be higher than its frame's canonical character height and be able to
4915 * accomodate a mode line too if necessary (the mode line prevails).
4916 */
4917bool
4918window_wants_header_line (struct window *w)
4919{
4920 Lisp_Object window_header_line_format =
4921 window_parameter (w, Qheader_line_format);
4922
4923 return ((WINDOW_LEAF_P (w)
4924 && !MINI_WINDOW_P (w)
4925 && !WINDOW_PSEUDO_P (w)
4926 && !EQ (window_header_line_format, Qnone)
4927 && (!NILP (window_header_line_format)
4928 || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format)))
4929 && (WINDOW_PIXEL_HEIGHT (w)
4930 > (window_wants_mode_line (w)
4931 ? 2 * WINDOW_FRAME_LINE_HEIGHT (w)
4932 : WINDOW_FRAME_LINE_HEIGHT (w))))
4933 ? 1
4934 : 0);
4935}
4936
4743/* Return number of lines of text (not counting mode lines) in W. */ 4937/* Return number of lines of text (not counting mode lines) in W. */
4744 4938
4745int 4939int
@@ -4753,10 +4947,10 @@ window_internal_height (struct window *w)
4753 || WINDOWP (w->contents) 4947 || WINDOWP (w->contents)
4754 || !NILP (w->next) 4948 || !NILP (w->next)
4755 || !NILP (w->prev) 4949 || !NILP (w->prev)
4756 || WINDOW_WANTS_MODELINE_P (w)) 4950 || window_wants_mode_line (w))
4757 --ht; 4951 --ht;
4758 4952
4759 if (WINDOW_WANTS_HEADER_LINE_P (w)) 4953 if (window_wants_header_line (w))
4760 --ht; 4954 --ht;
4761 } 4955 }
4762 4956
@@ -7354,6 +7548,8 @@ syms_of_window (void)
7354 DEFSYM (Qfloor, "floor"); 7548 DEFSYM (Qfloor, "floor");
7355 DEFSYM (Qceiling, "ceiling"); 7549 DEFSYM (Qceiling, "ceiling");
7356 DEFSYM (Qmark_for_redisplay, "mark-for-redisplay"); 7550 DEFSYM (Qmark_for_redisplay, "mark-for-redisplay");
7551 DEFSYM (Qmode_line_format, "mode-line-format");
7552 DEFSYM (Qheader_line_format, "header-line-format");
7357 7553
7358 staticpro (&Vwindow_list); 7554 staticpro (&Vwindow_list);
7359 7555
@@ -7603,6 +7799,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
7603 defsubr (&Sset_window_point); 7799 defsubr (&Sset_window_point);
7604 defsubr (&Sset_window_start); 7800 defsubr (&Sset_window_start);
7605 defsubr (&Swindow_dedicated_p); 7801 defsubr (&Swindow_dedicated_p);
7802 defsubr (&Swindow_lines_pixel_dimensions);
7606 defsubr (&Sset_window_dedicated_p); 7803 defsubr (&Sset_window_dedicated_p);
7607 defsubr (&Swindow_display_table); 7804 defsubr (&Swindow_display_table);
7608 defsubr (&Sset_window_display_table); 7805 defsubr (&Sset_window_display_table);
diff --git a/src/window.h b/src/window.h
index acb8a5cabfa..e9040f816df 100644
--- a/src/window.h
+++ b/src/window.h
@@ -328,8 +328,9 @@ struct window
328 /* True if this window is a minibuffer window. */ 328 /* True if this window is a minibuffer window. */
329 bool_bf mini : 1; 329 bool_bf mini : 1;
330 330
331 /* Meaningful only if contents is a window, true if this 331 /* Meaningful for internal windows only: true if this window is a
332 internal window is used in horizontal combination. */ 332 horizontal combination, false if it is a vertical
333 combination. */
333 bool_bf horizontal : 1; 334 bool_bf horizontal : 1;
334 335
335 /* True means must regenerate mode line of this window. */ 336 /* True means must regenerate mode line of this window. */
@@ -481,15 +482,14 @@ wset_next_buffers (struct window *w, Lisp_Object val)
481/* True if W is a minibuffer window. */ 482/* True if W is a minibuffer window. */
482#define MINI_WINDOW_P(W) ((W)->mini) 483#define MINI_WINDOW_P(W) ((W)->mini)
483 484
484/* 1 if W is a non-only minibuffer window. */ 485/* True if W is a minibuffer window on a frame that contains at least
485/* The first check is redundant and the second overly complicated. */ 486 one other window. */
486#define MINI_NON_ONLY_WINDOW_P(W) \ 487#define MINI_NON_ONLY_WINDOW_P(W) \
487 (MINI_WINDOW_P (W) \ 488 (MINI_WINDOW_P (W) && !NILP ((W)->prev))
488 && (EQ (W->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))
489 489
490/* 1 if W is a minibuffer-only window. */ 490/* True if W is a minibuffer window that is alone on its frame. */
491#define MINI_ONLY_WINDOW_P(W) \ 491#define MINI_ONLY_WINDOW_P(W) \
492 (MINI_WINDOW_P (W) && NILP (W->prev)) 492 (MINI_WINDOW_P (W) && NILP ((W)->prev))
493 493
494/* General window layout: 494/* General window layout:
495 495
@@ -518,29 +518,34 @@ wset_next_buffers (struct window *w, Lisp_Object val)
518 518
519/* A handy macro. */ 519/* A handy macro. */
520 520
521/* Non-nil if W is leaf (carry the buffer). */ 521/* Non-nil if window W is leaf window (has a buffer). */
522
523#define WINDOW_LEAF_P(W) \ 522#define WINDOW_LEAF_P(W) \
524 (BUFFERP ((W)->contents)) 523 (BUFFERP ((W)->contents))
525 524
526/* Non-nil if W is internal. */ 525/* Non-nil if window W is internal (is a parent window). */
527#define WINDOW_INTERNAL_P(W) \ 526#define WINDOW_INTERNAL_P(W) \
528 (WINDOWP ((W)->contents)) 527 (WINDOWP ((W)->contents))
529 528
530/* True if W is a member of horizontal combination. */ 529/* True if window W is a horizontal combination of windows. */
531#define WINDOW_HORIZONTAL_COMBINATION_P(W) \ 530#define WINDOW_HORIZONTAL_COMBINATION_P(W) \
532 (WINDOW_INTERNAL_P (W) && (W)->horizontal) 531 (WINDOW_INTERNAL_P (W) && (W)->horizontal)
533 532
534/* True if W is a member of vertical combination. */ 533/* True if window W is a vertical combination of windows. */
535#define WINDOW_VERTICAL_COMBINATION_P(W) \ 534#define WINDOW_VERTICAL_COMBINATION_P(W) \
536 (WINDOW_INTERNAL_P (W) && !(W)->horizontal) 535 (WINDOW_INTERNAL_P (W) && !(W)->horizontal)
537 536
538/* WINDOW's XFRAME. */ 537/* Window W's XFRAME. */
539#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W)))) 538#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W))))
540 539
541/* Whether WINDOW is a pseudo window. */ 540/* Whether window W is a pseudo window. */
542#define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p) 541#define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p)
543 542
543/* Window W's buffer. */
544#define WINDOW_BUFFER(W) \
545 (WINDOW_LEAF_P(W) \
546 ? (W)->contents \
547 : Qnil) \
548
544/* Return the canonical column width of the frame of window W. */ 549/* Return the canonical column width of the frame of window W. */
545#define WINDOW_FRAME_COLUMN_WIDTH(W) \ 550#define WINDOW_FRAME_COLUMN_WIDTH(W) \
546 (FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W)))) 551 (FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W))))
@@ -549,24 +554,24 @@ wset_next_buffers (struct window *w, Lisp_Object val)
549#define WINDOW_FRAME_LINE_HEIGHT(W) \ 554#define WINDOW_FRAME_LINE_HEIGHT(W) \
550 (FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W)))) 555 (FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W))))
551 556
552/* Return the pixel width of window W. 557/* Return the pixel width of window W. This includes dividers, scroll
553 This includes scroll bars and fringes. */ 558 bars, fringes and margins, if any. */
554#define WINDOW_PIXEL_WIDTH(W) (W)->pixel_width 559#define WINDOW_PIXEL_WIDTH(W) (W)->pixel_width
555 560
556/* Return the pixel height of window W. 561/* Return the pixel height of window W. This includes dividers, scroll
557 This includes header and mode lines, if any. */ 562 bars, header and mode lines, if any. */
558#define WINDOW_PIXEL_HEIGHT(W) (W)->pixel_height 563#define WINDOW_PIXEL_HEIGHT(W) (W)->pixel_height
559 564
560/* Return the width of window W in canonical column units. 565/* Return the width of window W in canonical column units. This
561 This includes scroll bars and fringes. 566 includes dividers, scroll bars, fringes and margins, if any. The
562 This value is adjusted such that the sum of the widths of all child 567 value is adjusted such that the sum of the widths of all child
563 windows equals the width of their parent window. */ 568 windows equals the width of their parent window. */
564#define WINDOW_TOTAL_COLS(W) (W)->total_cols 569#define WINDOW_TOTAL_COLS(W) (W)->total_cols
565 570
566/* Return the height of window W in canonical line units. 571/* Return the height of window W in canonical line units. This includes
567 This includes header and mode lines, if any. 572 dividers, scroll bars, header and mode lines, if any. The value is
568 This value is adjusted such that the sum of the heights of all child 573 adjusted such that the sum of the heights of all child windows equals
569 windows equals the height of their parent window. */ 574 the height of their parent window. */
570#define WINDOW_TOTAL_LINES(W) (W)->total_lines 575#define WINDOW_TOTAL_LINES(W) (W)->total_lines
571 576
572/* The smallest acceptable dimensions for a window. Anything smaller 577/* The smallest acceptable dimensions for a window. Anything smaller
@@ -581,31 +586,63 @@ wset_next_buffers (struct window *w, Lisp_Object val)
581#define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \ 586#define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \
582 (WINDOW_FRAME_LINE_HEIGHT (W)) 587 (WINDOW_FRAME_LINE_HEIGHT (W))
583 588
589/* True if window W has no other windows to its left on its frame. */
590#define WINDOW_LEFTMOST_P(W) \
591 (WINDOW_LEFT_PIXEL_EDGE (W) == 0)
592
593/* True if window W has no other windows above it on its frame. */
594#define WINDOW_TOPMOST_P(W) \
595 (WINDOW_TOP_PIXEL_EDGE (W) == 0)
596
597/* True if window W has no other windows to its right on its frame. */
598#define WINDOW_RIGHTMOST_P(W) \
599 (WINDOW_RIGHT_PIXEL_EDGE (W) \
600 == (WINDOW_RIGHT_PIXEL_EDGE \
601 (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
602
603/* True if window W has no other windows below it on its frame (the
604 minibuffer window is not counted in this respect unless W itself is a
605 minibuffer window). */
606#define WINDOW_BOTTOMMOST_P(W) \
607 (WINDOW_BOTTOM_PIXEL_EDGE (W) \
608 == (WINDOW_BOTTOM_PIXEL_EDGE \
609 (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
610
611/* True if window W takes up the full width of its frame. */
612#define WINDOW_FULL_WIDTH_P(W) \
613 (WINDOW_PIXEL_WIDTH (W) \
614 == (WINDOW_PIXEL_WIDTH \
615 (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
616
584/* Width of right divider of window W. */ 617/* Width of right divider of window W. */
585#define WINDOW_RIGHT_DIVIDER_WIDTH(W) \ 618#define WINDOW_RIGHT_DIVIDER_WIDTH(W) \
586 ((WINDOW_RIGHTMOST_P (W) || MINI_WINDOW_P (W)) \ 619 (WINDOW_RIGHTMOST_P (W) \
587 ? 0 \ 620 ? 0 : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
588 : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W))) 621
622/* Width of bottom divider of window W. */
623#define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \
624 (((WINDOW_BOTTOMMOST_P (W) \
625 && NILP ((XWINDOW (FRAME_ROOT_WINDOW \
626 (WINDOW_XFRAME (W))))->next)) \
627 || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \
628 || (W)->pseudo_window_p) \
629 ? 0 : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
589 630
590/* Return the canonical frame column at which window W starts. 631/* Return the canonical frame column at which window W starts.
591 This includes a left-hand scroll bar, if any. */ 632 This includes a left-hand scroll bar, if any. */
592
593#define WINDOW_LEFT_EDGE_COL(W) (W)->left_col 633#define WINDOW_LEFT_EDGE_COL(W) (W)->left_col
594 634
595/* Return the canonical frame column before which window W ends. 635/* Return the canonical frame column before which window W ends.
596 This includes a right-hand scroll bar, if any. */ 636 This includes a right-hand scroll bar, if any. */
597
598#define WINDOW_RIGHT_EDGE_COL(W) \ 637#define WINDOW_RIGHT_EDGE_COL(W) \
599 (WINDOW_LEFT_EDGE_COL (W) + WINDOW_TOTAL_COLS (W)) 638 (WINDOW_LEFT_EDGE_COL (W) + WINDOW_TOTAL_COLS (W))
600 639
601/* Return the canonical frame line at which window W starts. 640/* Return the canonical frame line at which window W starts.
602 This includes a header line, if any. */ 641 This includes a header line, if any. */
603
604#define WINDOW_TOP_EDGE_LINE(W) (W)->top_line 642#define WINDOW_TOP_EDGE_LINE(W) (W)->top_line
605 643
606/* Return the canonical frame line before which window W ends. 644/* Return the canonical frame line before which window W ends.
607 This includes a mode line, if any. */ 645 This includes a mode line, if any. */
608
609#define WINDOW_BOTTOM_EDGE_LINE(W) \ 646#define WINDOW_BOTTOM_EDGE_LINE(W) \
610 (WINDOW_TOP_EDGE_LINE (W) + WINDOW_TOTAL_LINES (W)) 647 (WINDOW_TOP_EDGE_LINE (W) + WINDOW_TOTAL_LINES (W))
611 648
@@ -629,20 +666,17 @@ wset_next_buffers (struct window *w, Lisp_Object val)
629 666
630/* Return the frame x-position at which window W starts. 667/* Return the frame x-position at which window W starts.
631 This includes a left-hand scroll bar, if any. */ 668 This includes a left-hand scroll bar, if any. */
632
633#define WINDOW_LEFT_EDGE_X(W) \ 669#define WINDOW_LEFT_EDGE_X(W) \
634 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ 670 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
635 + WINDOW_LEFT_PIXEL_EDGE (W)) 671 + WINDOW_LEFT_PIXEL_EDGE (W))
636 672
637/* Return the frame x- position before which window W ends. 673/* Return the frame x- position before which window W ends.
638 This includes a right-hand scroll bar, if any. */ 674 This includes a right-hand scroll bar, if any. */
639
640#define WINDOW_RIGHT_EDGE_X(W) \ 675#define WINDOW_RIGHT_EDGE_X(W) \
641 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ 676 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
642 + WINDOW_RIGHT_PIXEL_EDGE (W)) 677 + WINDOW_RIGHT_PIXEL_EDGE (W))
643 678
644/* True if W is a menu bar window. */ 679/* True if W is a menu bar window. */
645
646#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) 680#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
647#define WINDOW_MENU_BAR_P(W) \ 681#define WINDOW_MENU_BAR_P(W) \
648 (WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \ 682 (WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \
@@ -661,72 +695,24 @@ wset_next_buffers (struct window *w, Lisp_Object val)
661#define WINDOW_TOOL_BAR_P(W) false 695#define WINDOW_TOOL_BAR_P(W) false
662#endif 696#endif
663 697
664/* Return the frame y-position at which window W starts. 698/* Return the frame y-position at which window W starts. */
665 This includes a header line, if any.
666
667 PXW: With a menu or tool bar this is not symmetric to the _X values
668 since it _does_ include the internal border width. */
669#define WINDOW_TOP_EDGE_Y(W) \ 699#define WINDOW_TOP_EDGE_Y(W) \
670 (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \ 700 (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \
671 ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \ 701 ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \
672 + WINDOW_TOP_PIXEL_EDGE (W)) 702 + WINDOW_TOP_PIXEL_EDGE (W))
673 703
674/* Return the frame y-position before which window W ends. 704/* Return the frame y-position before which window W ends. */
675 This includes a mode line, if any. */
676#define WINDOW_BOTTOM_EDGE_Y(W) \ 705#define WINDOW_BOTTOM_EDGE_Y(W) \
677 (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \ 706 (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \
678 ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \ 707 ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \
679 + WINDOW_BOTTOM_PIXEL_EDGE (W)) 708 + WINDOW_BOTTOM_PIXEL_EDGE (W))
680 709
681/* True if window W takes up the full width of its frame. */ 710/* Return the pixel value where the text (or left fringe) in window W
682#define WINDOW_FULL_WIDTH_P(W) \ 711 starts. */
683 (WINDOW_PIXEL_WIDTH (W) \
684 == (WINDOW_PIXEL_WIDTH \
685 (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
686
687/* True if window W's has no other windows to its left in its frame. */
688
689#define WINDOW_LEFTMOST_P(W) \
690 (WINDOW_LEFT_PIXEL_EDGE (W) == 0)
691
692/* True if window W's has no other windows above in its frame. */
693#define WINDOW_TOPMOST_P(W) \
694 (WINDOW_TOP_PIXEL_EDGE (W) == 0)
695
696/* True if window W's has no other windows to its right in its frame. */
697#define WINDOW_RIGHTMOST_P(W) \
698 (WINDOW_RIGHT_PIXEL_EDGE (W) \
699 == (WINDOW_RIGHT_PIXEL_EDGE \
700 (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
701
702/* True if window W's has no other windows below it in its frame
703 (the minibuffer window is not counted in this respect). */
704#define WINDOW_BOTTOMMOST_P(W) \
705 (WINDOW_BOTTOM_PIXEL_EDGE (W) \
706 == (WINDOW_BOTTOM_PIXEL_EDGE \
707 (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
708
709/* Return the frame column at which the text (or left fringe) in
710 window W starts. This is different from the `LEFT_EDGE' because it
711 does not include a left-hand scroll bar if any. */
712#define WINDOW_BOX_LEFT_EDGE_COL(W) \
713 (WINDOW_LEFT_EDGE_COL (W) \
714 + WINDOW_LEFT_SCROLL_BAR_COLS (W))
715
716/* Return the pixel value where the text (or left fringe) in
717 window W starts. This is different from the `LEFT_EDGE' because it
718 does not include a left-hand scroll bar if any. */
719#define WINDOW_BOX_LEFT_PIXEL_EDGE(W) \ 712#define WINDOW_BOX_LEFT_PIXEL_EDGE(W) \
720 (WINDOW_LEFT_PIXEL_EDGE (W) \ 713 (WINDOW_LEFT_PIXEL_EDGE (W) \
721 + WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (W)) 714 + WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (W))
722 715
723/* Return the window column before which the text in window W ends.
724 This is different from WINDOW_RIGHT_EDGE_COL because it does not
725 include a scroll bar or window-separating line on the right edge. */
726#define WINDOW_BOX_RIGHT_EDGE_COL(W) \
727 (WINDOW_RIGHT_EDGE_COL (W) \
728 - WINDOW_RIGHT_SCROLL_BAR_COLS (W))
729
730/* Return the pixel value before which the text in window W ends. This 716/* Return the pixel value before which the text in window W ends. This
731 is different from the `RIGHT_EDGE' because it does not include a 717 is different from the `RIGHT_EDGE' because it does not include a
732 right-hand scroll bar or window-separating line on the right 718 right-hand scroll bar or window-separating line on the right
@@ -736,16 +722,16 @@ wset_next_buffers (struct window *w, Lisp_Object val)
736 - WINDOW_RIGHT_DIVIDER_WIDTH (W) \ 722 - WINDOW_RIGHT_DIVIDER_WIDTH (W) \
737 - WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (W)) 723 - WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (W))
738 724
739/* Return the frame position at which the text (or left fringe) in 725/* Return the frame x-position at which the text (or left fringe) in
740 window W starts. This is different from the `LEFT_EDGE' because it 726 window W starts. This does not include a left-hand scroll bar if
741 does not include a left-hand scroll bar if any. */ 727 any. */
742#define WINDOW_BOX_LEFT_EDGE_X(W) \ 728#define WINDOW_BOX_LEFT_EDGE_X(W) \
743 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ 729 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
744 + WINDOW_BOX_LEFT_PIXEL_EDGE (W)) 730 + WINDOW_BOX_LEFT_PIXEL_EDGE (W))
745 731
746/* Return the window column before which the text in window W ends. 732/* Return the frame x-position before which the text in window W ends.
747 This is different from WINDOW_RIGHT_EDGE_COL because it does not 733 This does not include a scroll bar, divider or window-separating line
748 include a scroll bar or window-separating line on the right edge. */ 734 on the right edge. */
749#define WINDOW_BOX_RIGHT_EDGE_X(W) \ 735#define WINDOW_BOX_RIGHT_EDGE_X(W) \
750 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ 736 (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
751 + WINDOW_BOX_RIGHT_PIXEL_EDGE (W)) 737 + WINDOW_BOX_RIGHT_PIXEL_EDGE (W))
@@ -899,16 +885,6 @@ wset_next_buffers (struct window *w, Lisp_Object val)
899 ? WINDOW_BOX_RIGHT_EDGE_X (W) \ 885 ? WINDOW_BOX_RIGHT_EDGE_X (W) \
900 : WINDOW_LEFT_EDGE_X (W)) 886 : WINDOW_LEFT_EDGE_X (W))
901 887
902/* Width of bottom divider of window W. */
903#define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \
904 (((WINDOW_BOTTOMMOST_P (W) \
905 && NILP ((XWINDOW (FRAME_ROOT_WINDOW \
906 (WINDOW_XFRAME (W))))->next)) \
907 || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \
908 || (W)->pseudo_window_p) \
909 ? 0 \
910 : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
911
912/* Height that a scroll bar in window W should have, if there is one. 888/* Height that a scroll bar in window W should have, if there is one.
913 Measured in pixels. If scroll bars are turned off, this is still 889 Measured in pixels. If scroll bars are turned off, this is still
914 nonzero. */ 890 nonzero. */
@@ -942,22 +918,22 @@ wset_next_buffers (struct window *w, Lisp_Object val)
942/* Height in pixels of the mode line. 918/* Height in pixels of the mode line.
943 May be zero if W doesn't have a mode line. */ 919 May be zero if W doesn't have a mode line. */
944#define WINDOW_MODE_LINE_HEIGHT(W) \ 920#define WINDOW_MODE_LINE_HEIGHT(W) \
945 (WINDOW_WANTS_MODELINE_P ((W)) \ 921 (window_wants_mode_line ((W)) \
946 ? CURRENT_MODE_LINE_HEIGHT (W) \ 922 ? CURRENT_MODE_LINE_HEIGHT (W) \
947 : 0) 923 : 0)
948 924
949#define WINDOW_MODE_LINE_LINES(W) \ 925#define WINDOW_MODE_LINE_LINES(W) \
950 WINDOW_WANTS_MODELINE_P (W) 926 window_wants_mode_line (W)
951 927
952/* Height in pixels of the header line. 928/* Height in pixels of the header line.
953 Zero if W doesn't have a header line. */ 929 Zero if W doesn't have a header line. */
954#define WINDOW_HEADER_LINE_HEIGHT(W) \ 930#define WINDOW_HEADER_LINE_HEIGHT(W) \
955 (WINDOW_WANTS_HEADER_LINE_P (W) \ 931 (window_wants_header_line (W) \
956 ? CURRENT_HEADER_LINE_HEIGHT (W) \ 932 ? CURRENT_HEADER_LINE_HEIGHT (W) \
957 : 0) 933 : 0)
958 934
959#define WINDOW_HEADER_LINE_LINES(W) \ 935#define WINDOW_HEADER_LINE_LINES(W) \
960 WINDOW_WANTS_HEADER_LINE_P (W) 936 window_wants_header_line (W)
961 937
962/* Pixel height of window W without mode line, bottom scroll bar and 938/* Pixel height of window W without mode line, bottom scroll bar and
963 bottom divider. */ 939 bottom divider. */
@@ -1114,10 +1090,13 @@ struct glyph *get_phys_cursor_glyph (struct window *w);
1114extern Lisp_Object Vwindow_list; 1090extern Lisp_Object Vwindow_list;
1115 1091
1116extern Lisp_Object window_list (void); 1092extern Lisp_Object window_list (void);
1093extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter);
1117extern struct window *decode_live_window (Lisp_Object); 1094extern struct window *decode_live_window (Lisp_Object);
1118extern struct window *decode_any_window (Lisp_Object); 1095extern struct window *decode_any_window (Lisp_Object);
1119extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); 1096extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
1120extern void mark_window_cursors_off (struct window *); 1097extern void mark_window_cursors_off (struct window *);
1098extern bool window_wants_mode_line (struct window *);
1099extern bool window_wants_header_line (struct window *);
1121extern int window_internal_height (struct window *); 1100extern int window_internal_height (struct window *);
1122extern int window_body_width (struct window *w, bool); 1101extern int window_body_width (struct window *w, bool);
1123enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS }; 1102enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS };
@@ -1133,7 +1112,6 @@ extern void init_window_once (void);
1133extern void init_window (void); 1112extern void init_window (void);
1134extern void syms_of_window (void); 1113extern void syms_of_window (void);
1135extern void keys_of_window (void); 1114extern void keys_of_window (void);
1136
1137/* Move cursor to row/column position VPOS/HPOS, pixel coordinates 1115/* Move cursor to row/column position VPOS/HPOS, pixel coordinates
1138 Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y 1116 Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y
1139 are window-relative pixel positions. This is always done during 1117 are window-relative pixel positions. This is always done during
diff --git a/src/xdisp.c b/src/xdisp.c
index 34ee877e6be..8bc5d81f448 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -921,7 +921,7 @@ window_text_bottom_y (struct window *w)
921 921
922 height -= WINDOW_BOTTOM_DIVIDER_WIDTH (w); 922 height -= WINDOW_BOTTOM_DIVIDER_WIDTH (w);
923 923
924 if (WINDOW_WANTS_MODELINE_P (w)) 924 if (window_wants_mode_line (w))
925 height -= CURRENT_MODE_LINE_HEIGHT (w); 925 height -= CURRENT_MODE_LINE_HEIGHT (w);
926 926
927 height -= WINDOW_SCROLL_BAR_AREA_HEIGHT (w); 927 height -= WINDOW_SCROLL_BAR_AREA_HEIGHT (w);
@@ -978,7 +978,7 @@ window_box_height (struct window *w)
978 the appropriate glyph row has its `mode_line_p' flag set, 978 the appropriate glyph row has its `mode_line_p' flag set,
979 and if it doesn't, uses estimate_mode_line_height instead. */ 979 and if it doesn't, uses estimate_mode_line_height instead. */
980 980
981 if (WINDOW_WANTS_MODELINE_P (w)) 981 if (window_wants_mode_line (w))
982 { 982 {
983 struct glyph_row *ml_row 983 struct glyph_row *ml_row
984 = (w->current_matrix && w->current_matrix->rows 984 = (w->current_matrix && w->current_matrix->rows
@@ -990,7 +990,7 @@ window_box_height (struct window *w)
990 height -= estimate_mode_line_height (f, CURRENT_MODE_LINE_FACE_ID (w)); 990 height -= estimate_mode_line_height (f, CURRENT_MODE_LINE_FACE_ID (w));
991 } 991 }
992 992
993 if (WINDOW_WANTS_HEADER_LINE_P (w)) 993 if (window_wants_header_line (w))
994 { 994 {
995 struct glyph_row *hl_row 995 struct glyph_row *hl_row
996 = (w->current_matrix && w->current_matrix->rows 996 = (w->current_matrix && w->current_matrix->rows
@@ -1102,7 +1102,7 @@ window_box (struct window *w, enum glyph_row_area area, int *box_x,
1102 if (box_y) 1102 if (box_y)
1103 { 1103 {
1104 *box_y = WINDOW_TOP_EDGE_Y (w); 1104 *box_y = WINDOW_TOP_EDGE_Y (w);
1105 if (WINDOW_WANTS_HEADER_LINE_P (w)) 1105 if (window_wants_header_line (w))
1106 *box_y += CURRENT_HEADER_LINE_HEIGHT (w); 1106 *box_y += CURRENT_HEADER_LINE_HEIGHT (w);
1107 } 1107 }
1108} 1108}
@@ -1322,15 +1322,29 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
1322 return visible_p; 1322 return visible_p;
1323 1323
1324 /* Compute exact mode line heights. */ 1324 /* Compute exact mode line heights. */
1325 if (WINDOW_WANTS_MODELINE_P (w)) 1325 if (window_wants_mode_line (w))
1326 w->mode_line_height 1326 {
1327 = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), 1327 Lisp_Object window_mode_line_format
1328 BVAR (current_buffer, mode_line_format)); 1328 = window_parameter (w, Qmode_line_format);
1329
1330 w->mode_line_height
1331 = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w),
1332 NILP (window_mode_line_format)
1333 ? BVAR (current_buffer, mode_line_format)
1334 : window_mode_line_format);
1335 }
1329 1336
1330 if (WINDOW_WANTS_HEADER_LINE_P (w)) 1337 if (window_wants_header_line (w))
1331 w->header_line_height 1338 {
1332 = display_mode_line (w, HEADER_LINE_FACE_ID, 1339 Lisp_Object window_header_line_format
1333 BVAR (current_buffer, header_line_format)); 1340 = window_parameter (w, Qheader_line_format);
1341
1342 w->header_line_height
1343 = display_mode_line (w, HEADER_LINE_FACE_ID,
1344 NILP (window_header_line_format)
1345 ? BVAR (current_buffer, header_line_format)
1346 : window_header_line_format);
1347 }
1334 1348
1335 start_display (&it, w, top); 1349 start_display (&it, w, top);
1336 move_it_to (&it, charpos, -1, it.last_visible_y - 1, -1, 1350 move_it_to (&it, charpos, -1, it.last_visible_y - 1, -1,
@@ -2842,13 +2856,12 @@ init_iterator (struct it *it, struct window *w,
2842 2856
2843 /* Get dimensions of truncation and continuation glyphs. These are 2857 /* Get dimensions of truncation and continuation glyphs. These are
2844 displayed as fringe bitmaps under X, but we need them for such 2858 displayed as fringe bitmaps under X, but we need them for such
2845 frames when the fringes are turned off. But leave the dimensions 2859 frames when the fringes are turned off. The no_special_glyphs slot
2846 zero for tooltip frames, as these glyphs look ugly there and also 2860 of the iterator's frame, when set, suppresses their display - by
2847 sabotage calculations of tooltip dimensions in x-show-tip. */ 2861 default for tooltip frames and when set via the 'no-special-glyphs'
2862 frame parameter. */
2848#ifdef HAVE_WINDOW_SYSTEM 2863#ifdef HAVE_WINDOW_SYSTEM
2849 if (!(FRAME_WINDOW_P (it->f) 2864 if (!(FRAME_WINDOW_P (it->f) && it->f->no_special_glyphs))
2850 && FRAMEP (tip_frame)
2851 && it->f == XFRAME (tip_frame)))
2852#endif 2865#endif
2853 { 2866 {
2854 if (it->line_wrap == TRUNCATE) 2867 if (it->line_wrap == TRUNCATE)
@@ -2920,7 +2933,7 @@ init_iterator (struct it *it, struct window *w,
2920 it->last_visible_x -= it->continuation_pixel_width; 2933 it->last_visible_x -= it->continuation_pixel_width;
2921 } 2934 }
2922 2935
2923 it->header_line_p = WINDOW_WANTS_HEADER_LINE_P (w); 2936 it->header_line_p = window_wants_header_line (w);
2924 it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll; 2937 it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll;
2925 } 2938 }
2926 2939
@@ -3019,7 +3032,7 @@ void
3019start_display (struct it *it, struct window *w, struct text_pos pos) 3032start_display (struct it *it, struct window *w, struct text_pos pos)
3020{ 3033{
3021 struct glyph_row *row; 3034 struct glyph_row *row;
3022 bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w); 3035 bool first_vpos = window_wants_header_line (w);
3023 3036
3024 row = w->desired_matrix->rows + first_vpos; 3037 row = w->desired_matrix->rows + first_vpos;
3025 init_iterator (it, w, CHARPOS (pos), BYTEPOS (pos), row, DEFAULT_FACE_ID); 3038 init_iterator (it, w, CHARPOS (pos), BYTEPOS (pos), row, DEFAULT_FACE_ID);
@@ -7755,9 +7768,8 @@ next_element_from_display_vector (struct it *it)
7755 7768
7756 /* KFS: This code used to check ip->dpvec[0] instead of the current element. 7769 /* KFS: This code used to check ip->dpvec[0] instead of the current element.
7757 That seemed totally bogus - so I changed it... */ 7770 That seemed totally bogus - so I changed it... */
7758 gc = it->dpvec[it->current.dpvec_index]; 7771 if (it->dpend - it->dpvec > 0 /* empty dpvec[] is invalid */
7759 7772 && (gc = it->dpvec[it->current.dpvec_index], GLYPH_CODE_P (gc)))
7760 if (GLYPH_CODE_P (gc))
7761 { 7773 {
7762 struct face *this_face, *prev_face, *next_face; 7774 struct face *this_face, *prev_face, *next_face;
7763 7775
@@ -15799,7 +15811,7 @@ compute_window_start_on_continuation_line (struct window *w)
15799 15811
15800 /* Find the start of the continued line. This should be fast 15812 /* Find the start of the continued line. This should be fast
15801 because find_newline is fast (newline cache). */ 15813 because find_newline is fast (newline cache). */
15802 row = w->desired_matrix->rows + WINDOW_WANTS_HEADER_LINE_P (w); 15814 row = w->desired_matrix->rows + window_wants_header_line (w);
15803 init_iterator (&it, w, CHARPOS (start_pos), BYTEPOS (start_pos), 15815 init_iterator (&it, w, CHARPOS (start_pos), BYTEPOS (start_pos),
15804 row, DEFAULT_FACE_ID); 15816 row, DEFAULT_FACE_ID);
15805 reseat_at_previous_visible_line_start (&it); 15817 reseat_at_previous_visible_line_start (&it);
@@ -15949,7 +15961,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
15949 this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); 15961 this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
15950 15962
15951 top_scroll_margin = this_scroll_margin; 15963 top_scroll_margin = this_scroll_margin;
15952 if (WINDOW_WANTS_HEADER_LINE_P (w)) 15964 if (window_wants_header_line (w))
15953 top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); 15965 top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
15954 15966
15955 /* Start with the row the cursor was displayed during the last 15967 /* Start with the row the cursor was displayed during the last
@@ -16732,7 +16744,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16732 margin, even though this part handles windows that didn't 16744 margin, even though this part handles windows that didn't
16733 scroll at all. */ 16745 scroll at all. */
16734 int pixel_margin = margin * frame_line_height; 16746 int pixel_margin = margin * frame_line_height;
16735 bool header_line = WINDOW_WANTS_HEADER_LINE_P (w); 16747 bool header_line = window_wants_header_line (w);
16736 16748
16737 /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop 16749 /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop
16738 below, which finds the row to move point to, advances by 16750 below, which finds the row to move point to, advances by
@@ -17299,15 +17311,15 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
17299 || (w->column_number_displayed != -1 17311 || (w->column_number_displayed != -1
17300 && (w->column_number_displayed != current_column ()))) 17312 && (w->column_number_displayed != current_column ())))
17301 /* This means that the window has a mode line. */ 17313 /* This means that the window has a mode line. */
17302 && (WINDOW_WANTS_MODELINE_P (w) 17314 && (window_wants_mode_line (w)
17303 || WINDOW_WANTS_HEADER_LINE_P (w))) 17315 || window_wants_header_line (w)))
17304 { 17316 {
17305 17317
17306 display_mode_lines (w); 17318 display_mode_lines (w);
17307 17319
17308 /* If mode line height has changed, arrange for a thorough 17320 /* If mode line height has changed, arrange for a thorough
17309 immediate redisplay using the correct mode line height. */ 17321 immediate redisplay using the correct mode line height. */
17310 if (WINDOW_WANTS_MODELINE_P (w) 17322 if (window_wants_mode_line (w)
17311 && CURRENT_MODE_LINE_HEIGHT (w) != DESIRED_MODE_LINE_HEIGHT (w)) 17323 && CURRENT_MODE_LINE_HEIGHT (w) != DESIRED_MODE_LINE_HEIGHT (w))
17312 { 17324 {
17313 f->fonts_changed = true; 17325 f->fonts_changed = true;
@@ -17318,7 +17330,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
17318 17330
17319 /* If header line height has changed, arrange for a thorough 17331 /* If header line height has changed, arrange for a thorough
17320 immediate redisplay using the correct header line height. */ 17332 immediate redisplay using the correct header line height. */
17321 if (WINDOW_WANTS_HEADER_LINE_P (w) 17333 if (window_wants_header_line (w)
17322 && CURRENT_HEADER_LINE_HEIGHT (w) != DESIRED_HEADER_LINE_HEIGHT (w)) 17334 && CURRENT_HEADER_LINE_HEIGHT (w) != DESIRED_HEADER_LINE_HEIGHT (w))
17323 { 17335 {
17324 f->fonts_changed = true; 17336 f->fonts_changed = true;
@@ -17583,7 +17595,7 @@ try_window_reusing_current_matrix (struct window *w)
17583 return false; 17595 return false;
17584 17596
17585 /* If top-line visibility has changed, give up. */ 17597 /* If top-line visibility has changed, give up. */
17586 if (WINDOW_WANTS_HEADER_LINE_P (w) 17598 if (window_wants_header_line (w)
17587 != MATRIX_HEADER_LINE_ROW (w->current_matrix)->mode_line_p) 17599 != MATRIX_HEADER_LINE_ROW (w->current_matrix)->mode_line_p)
17588 return false; 17600 return false;
17589 17601
@@ -18818,7 +18830,7 @@ try_window_id (struct window *w)
18818 = MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix); 18830 = MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix);
18819 int from = WINDOW_TOP_EDGE_LINE (w) + from_vpos; 18831 int from = WINDOW_TOP_EDGE_LINE (w) + from_vpos;
18820 int end = (WINDOW_TOP_EDGE_LINE (w) 18832 int end = (WINDOW_TOP_EDGE_LINE (w)
18821 + WINDOW_WANTS_HEADER_LINE_P (w) 18833 + window_wants_header_line (w)
18822 + window_internal_height (w)); 18834 + window_internal_height (w));
18823 18835
18824#if defined (HAVE_GPM) || defined (MSDOS) 18836#if defined (HAVE_GPM) || defined (MSDOS)
@@ -18996,7 +19008,7 @@ try_window_id (struct window *w)
18996 { 19008 {
18997 /* Displayed to end of window, but no line containing text was 19009 /* Displayed to end of window, but no line containing text was
18998 displayed. Lines were deleted at the end of the window. */ 19010 displayed. Lines were deleted at the end of the window. */
18999 bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w); 19011 bool first_vpos = window_wants_header_line (w);
19000 int vpos = w->window_end_vpos; 19012 int vpos = w->window_end_vpos;
19001 struct glyph_row *current_row = current_matrix->rows + vpos; 19013 struct glyph_row *current_row = current_matrix->rows + vpos;
19002 struct glyph_row *desired_row = desired_matrix->rows + vpos; 19014 struct glyph_row *desired_row = desired_matrix->rows + vpos;
@@ -20696,7 +20708,7 @@ display_line (struct it *it, int cursor_vpos)
20696 ptrdiff_t min_pos = ZV + 1, max_pos = 0; 20708 ptrdiff_t min_pos = ZV + 1, max_pos = 0;
20697 ptrdiff_t min_bpos UNINIT, max_bpos UNINIT; 20709 ptrdiff_t min_bpos UNINIT, max_bpos UNINIT;
20698 bool pending_handle_line_prefix = false; 20710 bool pending_handle_line_prefix = false;
20699 int header_line = WINDOW_WANTS_HEADER_LINE_P (it->w); 20711 int header_line = window_wants_header_line (it->w);
20700 bool hscroll_this_line = (cursor_vpos >= 0 20712 bool hscroll_this_line = (cursor_vpos >= 0
20701 && it->vpos == cursor_vpos - header_line 20713 && it->vpos == cursor_vpos - header_line
20702 && hscrolling_current_line_p (it->w)); 20714 && hscrolling_current_line_p (it->w));
@@ -22649,20 +22661,30 @@ display_mode_lines (struct window *w)
22649 line_number_displayed = false; 22661 line_number_displayed = false;
22650 w->column_number_displayed = -1; 22662 w->column_number_displayed = -1;
22651 22663
22652 if (WINDOW_WANTS_MODELINE_P (w)) 22664 if (window_wants_mode_line (w))
22653 { 22665 {
22666 Lisp_Object window_mode_line_format
22667 = window_parameter (w, Qmode_line_format);
22668
22654 struct window *sel_w = XWINDOW (old_selected_window); 22669 struct window *sel_w = XWINDOW (old_selected_window);
22655 22670
22656 /* Select mode line face based on the real selected window. */ 22671 /* Select mode line face based on the real selected window. */
22657 display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), 22672 display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w),
22658 BVAR (current_buffer, mode_line_format)); 22673 NILP (window_mode_line_format)
22674 ? BVAR (current_buffer, mode_line_format)
22675 : window_mode_line_format);
22659 ++n; 22676 ++n;
22660 } 22677 }
22661 22678
22662 if (WINDOW_WANTS_HEADER_LINE_P (w)) 22679 if (window_wants_header_line (w))
22663 { 22680 {
22681 Lisp_Object window_header_line_format
22682 = window_parameter (w, Qheader_line_format);
22683
22664 display_mode_line (w, HEADER_LINE_FACE_ID, 22684 display_mode_line (w, HEADER_LINE_FACE_ID,
22665 BVAR (current_buffer, header_line_format)); 22685 NILP (window_header_line_format)
22686 ? BVAR (current_buffer, header_line_format)
22687 : window_header_line_format);
22666 ++n; 22688 ++n;
22667 } 22689 }
22668 22690
@@ -30442,13 +30464,67 @@ note_mouse_highlight (struct frame *f, int x, int y)
30442 && part != ON_HEADER_LINE)) 30464 && part != ON_HEADER_LINE))
30443 clear_mouse_face (hlinfo); 30465 clear_mouse_face (hlinfo);
30444 30466
30467 /* Reset help_echo_string. It will get recomputed below. */
30468 help_echo_string = Qnil;
30469
30470#ifdef HAVE_WINDOW_SYSTEM
30471 /* If the cursor is on the internal border of FRAME and FRAME's
30472 internal border is draggable, provide some visual feedback. */
30473 if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0
30474 && !NILP (get_frame_param (f, Qdrag_internal_border)))
30475 {
30476 enum internal_border_part part = frame_internal_border_part (f, x, y);
30477
30478 switch (part)
30479 {
30480 case INTERNAL_BORDER_NONE:
30481 if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
30482 /* Reset cursor. */
30483 cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
30484 break;
30485 case INTERNAL_BORDER_LEFT_EDGE:
30486 cursor = FRAME_X_OUTPUT (f)->left_edge_cursor;
30487 break;
30488 case INTERNAL_BORDER_TOP_LEFT_CORNER:
30489 cursor = FRAME_X_OUTPUT (f)->top_left_corner_cursor;
30490 break;
30491 case INTERNAL_BORDER_TOP_EDGE:
30492 cursor = FRAME_X_OUTPUT (f)->top_edge_cursor;
30493 break;
30494 case INTERNAL_BORDER_TOP_RIGHT_CORNER:
30495 cursor = FRAME_X_OUTPUT (f)->top_right_corner_cursor;
30496 break;
30497 case INTERNAL_BORDER_RIGHT_EDGE:
30498 cursor = FRAME_X_OUTPUT (f)->right_edge_cursor;
30499 break;
30500 case INTERNAL_BORDER_BOTTOM_RIGHT_CORNER:
30501 cursor = FRAME_X_OUTPUT (f)->bottom_right_corner_cursor;
30502 break;
30503 case INTERNAL_BORDER_BOTTOM_EDGE:
30504 cursor = FRAME_X_OUTPUT (f)->bottom_edge_cursor;
30505 break;
30506 case INTERNAL_BORDER_BOTTOM_LEFT_CORNER:
30507 cursor = FRAME_X_OUTPUT (f)->bottom_left_corner_cursor;
30508 break;
30509 default:
30510 /* This should not happen. */
30511 if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
30512 cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
30513 }
30514
30515 if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
30516 {
30517 /* Do we really want a help echo here? */
30518 help_echo_string = build_string ("drag-mouse-1: resize frame");
30519 goto set_cursor;
30520 }
30521 }
30522#endif /* HAVE_WINDOW_SYSTEM */
30523
30445 /* Not on a window -> return. */ 30524 /* Not on a window -> return. */
30446 if (!WINDOWP (window)) 30525 if (!WINDOWP (window))
30447 return; 30526 return;
30448 30527
30449 /* Reset help_echo_string. It will get recomputed below. */
30450 help_echo_string = Qnil;
30451
30452 /* Convert to window-relative pixel coordinates. */ 30528 /* Convert to window-relative pixel coordinates. */
30453 w = XWINDOW (window); 30529 w = XWINDOW (window);
30454 frame_to_window_pixel_xy (w, &x, &y); 30530 frame_to_window_pixel_xy (w, &x, &y);
@@ -30486,11 +30562,13 @@ note_mouse_highlight (struct frame *f, int x, int y)
30486 { 30562 {
30487 cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; 30563 cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
30488 help_echo_string = build_string ("drag-mouse-1: resize"); 30564 help_echo_string = build_string ("drag-mouse-1: resize");
30565 goto set_cursor;
30489 } 30566 }
30490 else if (part == ON_RIGHT_DIVIDER) 30567 else if (part == ON_RIGHT_DIVIDER)
30491 { 30568 {
30492 cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; 30569 cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
30493 help_echo_string = build_string ("drag-mouse-1: resize"); 30570 help_echo_string = build_string ("drag-mouse-1: resize");
30571 goto set_cursor;
30494 } 30572 }
30495 else if (part == ON_BOTTOM_DIVIDER) 30573 else if (part == ON_BOTTOM_DIVIDER)
30496 if (! WINDOW_BOTTOMMOST_P (w) 30574 if (! WINDOW_BOTTOMMOST_P (w)
@@ -30499,6 +30577,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
30499 { 30577 {
30500 cursor = FRAME_X_OUTPUT (f)->vertical_drag_cursor; 30578 cursor = FRAME_X_OUTPUT (f)->vertical_drag_cursor;
30501 help_echo_string = build_string ("drag-mouse-1: resize"); 30579 help_echo_string = build_string ("drag-mouse-1: resize");
30580 goto set_cursor;
30502 } 30581 }
30503 else 30582 else
30504 cursor = FRAME_X_OUTPUT (f)->nontext_cursor; 30583 cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
@@ -31193,8 +31272,15 @@ x_draw_right_divider (struct window *w)
31193 int x0 = WINDOW_RIGHT_EDGE_X (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w); 31272 int x0 = WINDOW_RIGHT_EDGE_X (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w);
31194 int x1 = WINDOW_RIGHT_EDGE_X (w); 31273 int x1 = WINDOW_RIGHT_EDGE_X (w);
31195 int y0 = WINDOW_TOP_EDGE_Y (w); 31274 int y0 = WINDOW_TOP_EDGE_Y (w);
31196 /* The bottom divider prevails. */ 31275 int y1 = WINDOW_BOTTOM_EDGE_Y (w);
31197 int y1 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w); 31276
31277 /* If W is horizontally combined and has a right sibling, don't
31278 draw over any bottom divider. */
31279 if (WINDOW_BOTTOM_DIVIDER_WIDTH (w)
31280 && !NILP (w->parent)
31281 && WINDOW_HORIZONTAL_COMBINATION_P (XWINDOW (w->parent))
31282 && !NILP (w->next))
31283 y1 -= WINDOW_BOTTOM_DIVIDER_WIDTH (w);
31198 31284
31199 FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1); 31285 FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
31200 } 31286 }
@@ -31213,8 +31299,22 @@ x_draw_bottom_divider (struct window *w)
31213 int x1 = WINDOW_RIGHT_EDGE_X (w); 31299 int x1 = WINDOW_RIGHT_EDGE_X (w);
31214 int y0 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w); 31300 int y0 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w);
31215 int y1 = WINDOW_BOTTOM_EDGE_Y (w); 31301 int y1 = WINDOW_BOTTOM_EDGE_Y (w);
31302 struct window *p = !NILP (w->parent) ? XWINDOW (w->parent) : false;
31216 31303
31217 FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1); 31304 /* If W is vertically combined and has a sibling below, don't draw
31305 over any right divider. */
31306 if (WINDOW_RIGHT_DIVIDER_WIDTH (w)
31307 && p
31308 && ((WINDOW_VERTICAL_COMBINATION_P (p)
31309 && !NILP (w->next))
31310 || (WINDOW_HORIZONTAL_COMBINATION_P (p)
31311 && NILP (w->next)
31312 && !NILP (p->parent)
31313 && WINDOW_VERTICAL_COMBINATION_P (XWINDOW (p->parent))
31314 && !NILP (XWINDOW (p->parent)->next))))
31315 x1 -= WINDOW_RIGHT_DIVIDER_WIDTH (w);
31316
31317 FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
31218 } 31318 }
31219} 31319}
31220 31320
@@ -31329,7 +31429,7 @@ expose_window (struct window *w, XRectangle *fr)
31329 } 31429 }
31330 31430
31331 /* Display the mode line if there is one. */ 31431 /* Display the mode line if there is one. */
31332 if (WINDOW_WANTS_MODELINE_P (w) 31432 if (window_wants_mode_line (w)
31333 && (row = MATRIX_MODE_LINE_ROW (w->current_matrix), 31433 && (row = MATRIX_MODE_LINE_ROW (w->current_matrix),
31334 row->enabled_p) 31434 row->enabled_p)
31335 && row->y < r_bottom) 31435 && row->y < r_bottom)
diff --git a/src/xfaces.c b/src/xfaces.c
index 4714b7b3cb8..86bb9b0b496 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6232,7 +6232,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6232 int red, green, blue; 6232 int red, green, blue;
6233 int num; 6233 int num;
6234 6234
6235 while (fgets (buf, sizeof (buf), fp) != NULL) { 6235 while (fgets_unlocked (buf, sizeof (buf), fp) != NULL) {
6236 if (sscanf (buf, "%d %d %d %n", &red, &green, &blue, &num) == 3) 6236 if (sscanf (buf, "%d %d %d %n", &red, &green, &blue, &num) == 3)
6237 { 6237 {
6238#ifdef HAVE_NTGUI 6238#ifdef HAVE_NTGUI
diff --git a/src/xfns.c b/src/xfns.c
index 7be2253cc3b..d8bf9747191 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1120,6 +1120,14 @@ enum mouse_cursor {
1120 mouse_cursor_hand, 1120 mouse_cursor_hand,
1121 mouse_cursor_horizontal_drag, 1121 mouse_cursor_horizontal_drag,
1122 mouse_cursor_vertical_drag, 1122 mouse_cursor_vertical_drag,
1123 mouse_cursor_left_edge,
1124 mouse_cursor_top_left_corner,
1125 mouse_cursor_top_edge,
1126 mouse_cursor_top_right_corner,
1127 mouse_cursor_right_edge,
1128 mouse_cursor_bottom_right_corner,
1129 mouse_cursor_bottom_edge,
1130 mouse_cursor_bottom_left_corner,
1123 mouse_cursor_max 1131 mouse_cursor_max
1124}; 1132};
1125 1133
@@ -1139,13 +1147,21 @@ struct mouse_cursor_types {
1139 1147
1140/* This array must stay in sync with enum mouse_cursor above! */ 1148/* This array must stay in sync with enum mouse_cursor above! */
1141static const struct mouse_cursor_types mouse_cursor_types[] = { 1149static const struct mouse_cursor_types mouse_cursor_types[] = {
1142 { "text", &Vx_pointer_shape, XC_xterm }, 1150 { "text", &Vx_pointer_shape, XC_xterm },
1143 { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr }, 1151 { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr },
1144 { "hourglass", &Vx_hourglass_pointer_shape, XC_watch }, 1152 { "hourglass", &Vx_hourglass_pointer_shape, XC_watch },
1145 { "modeline", &Vx_mode_pointer_shape, XC_xterm }, 1153 { "modeline", &Vx_mode_pointer_shape, XC_xterm },
1146 { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 }, 1154 { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 },
1147 { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow }, 1155 { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow },
1148 { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow }, 1156 { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow },
1157 { NULL, &Vx_window_left_edge_shape, XC_left_side },
1158 { NULL, &Vx_window_top_left_corner_shape, XC_top_left_corner },
1159 { NULL, &Vx_window_top_edge_shape, XC_top_side },
1160 { NULL, &Vx_window_top_right_corner_shape, XC_top_right_corner },
1161 { NULL, &Vx_window_right_edge_shape, XC_right_side },
1162 { NULL, &Vx_window_bottom_right_corner_shape, XC_bottom_right_corner },
1163 { NULL, &Vx_window_bottom_edge_shape, XC_bottom_side },
1164 { NULL, &Vx_window_bottom_left_corner_shape, XC_bottom_left_corner },
1149}; 1165};
1150 1166
1151struct mouse_cursor_data { 1167struct mouse_cursor_data {
@@ -1296,6 +1312,14 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1296 INSTALL_CURSOR (hand_cursor, hand); 1312 INSTALL_CURSOR (hand_cursor, hand);
1297 INSTALL_CURSOR (horizontal_drag_cursor, horizontal_drag); 1313 INSTALL_CURSOR (horizontal_drag_cursor, horizontal_drag);
1298 INSTALL_CURSOR (vertical_drag_cursor, vertical_drag); 1314 INSTALL_CURSOR (vertical_drag_cursor, vertical_drag);
1315 INSTALL_CURSOR (left_edge_cursor, left_edge);
1316 INSTALL_CURSOR (top_left_corner_cursor, top_left_corner);
1317 INSTALL_CURSOR (top_edge_cursor, top_edge);
1318 INSTALL_CURSOR (top_right_corner_cursor, top_right_corner);
1319 INSTALL_CURSOR (right_edge_cursor, right_edge);
1320 INSTALL_CURSOR (bottom_right_corner_cursor, bottom_right_corner);
1321 INSTALL_CURSOR (bottom_edge_cursor, bottom_edge);
1322 INSTALL_CURSOR (bottom_left_corner_cursor, bottom_left_corner);
1299 1323
1300#undef INSTALL_CURSOR 1324#undef INSTALL_CURSOR
1301 1325
@@ -3814,6 +3838,8 @@ This function is an internal primitive--use `make-frame' instead. */)
3814 "leftFringe", "LeftFringe", RES_TYPE_NUMBER); 3838 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3815 x_default_parameter (f, parms, Qright_fringe, Qnil, 3839 x_default_parameter (f, parms, Qright_fringe, Qnil,
3816 "rightFringe", "RightFringe", RES_TYPE_NUMBER); 3840 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3841 x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
3842 NULL, NULL, RES_TYPE_BOOLEAN);
3817 3843
3818 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground, 3844 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3819 "scrollBarForeground", 3845 "scrollBarForeground",
@@ -5286,7 +5312,7 @@ Frames are listed from topmost (first) to bottommost (last). */)
5286static void 5312static void
5287x_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) 5313x_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
5288{ 5314{
5289#ifdef USE_GTK 5315#if defined (USE_GTK) && GTK_CHECK_VERSION (2, 18, 0)
5290 block_input (); 5316 block_input ();
5291 xg_frame_restack (f1, f2, above_flag); 5317 xg_frame_restack (f1, f2, above_flag);
5292 unblock_input (); 5318 unblock_input ();
@@ -6196,6 +6222,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
6196 "cursorColor", "Foreground", RES_TYPE_STRING); 6222 "cursorColor", "Foreground", RES_TYPE_STRING);
6197 x_default_parameter (f, parms, Qborder_color, build_string ("black"), 6223 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6198 "borderColor", "BorderColor", RES_TYPE_STRING); 6224 "borderColor", "BorderColor", RES_TYPE_STRING);
6225 x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
6226 NULL, NULL, RES_TYPE_BOOLEAN);
6199 6227
6200 /* Init faces before x_default_parameter is called for the 6228 /* Init faces before x_default_parameter is called for the
6201 scroll-bar-width parameter because otherwise we end up in 6229 scroll-bar-width parameter because otherwise we end up in
@@ -7486,6 +7514,7 @@ frame_parm_handler x_frame_parm_handlers[] =
7486 x_set_no_accept_focus, 7514 x_set_no_accept_focus,
7487 x_set_z_group, 7515 x_set_z_group,
7488 x_set_override_redirect, 7516 x_set_override_redirect,
7517 x_set_no_special_glyphs,
7489}; 7518};
7490 7519
7491void 7520void
@@ -7564,6 +7593,62 @@ This variable takes effect when you create a new frame
7564or when you set the mouse color. */); 7593or when you set the mouse color. */);
7565 Vx_window_vertical_drag_shape = Qnil; 7594 Vx_window_vertical_drag_shape = Qnil;
7566 7595
7596 DEFVAR_LISP ("x-window-left-edge-cursor",
7597 Vx_window_left_edge_shape,
7598 doc: /* Pointer shape indicating a left x-window edge can be dragged.
7599This variable takes effect when you create a new frame
7600or when you set the mouse color. */);
7601 Vx_window_left_edge_shape = Qnil;
7602
7603 DEFVAR_LISP ("x-window-top-left-corner-cursor",
7604 Vx_window_top_left_corner_shape,
7605 doc: /* Pointer shape indicating a top left x-window corner can be dragged.
7606This variable takes effect when you create a new frame
7607or when you set the mouse color. */);
7608 Vx_window_top_left_corner_shape = Qnil;
7609
7610 DEFVAR_LISP ("x-window-top-edge-cursor",
7611 Vx_window_top_edge_shape,
7612 doc: /* Pointer shape indicating a top x-window edge can be dragged.
7613This variable takes effect when you create a new frame
7614or when you set the mouse color. */);
7615 Vx_window_top_edge_shape = Qnil;
7616
7617 DEFVAR_LISP ("x-window-top-right-corner-cursor",
7618 Vx_window_top_right_corner_shape,
7619 doc: /* Pointer shape indicating a top right x-window corner can be dragged.
7620This variable takes effect when you create a new frame
7621or when you set the mouse color. */);
7622 Vx_window_top_right_corner_shape = Qnil;
7623
7624 DEFVAR_LISP ("x-window-right-edge-cursor",
7625 Vx_window_right_edge_shape,
7626 doc: /* Pointer shape indicating a right x-window edge can be dragged.
7627This variable takes effect when you create a new frame
7628or when you set the mouse color. */);
7629 Vx_window_right_edge_shape = Qnil;
7630
7631 DEFVAR_LISP ("x-window-bottom-right-corner-cursor",
7632 Vx_window_bottom_right_corner_shape,
7633 doc: /* Pointer shape indicating a bottom right x-window corner can be dragged.
7634This variable takes effect when you create a new frame
7635or when you set the mouse color. */);
7636 Vx_window_bottom_right_corner_shape = Qnil;
7637
7638 DEFVAR_LISP ("x-window-bottom-edge-cursor",
7639 Vx_window_bottom_edge_shape,
7640 doc: /* Pointer shape indicating a bottom x-window edge can be dragged.
7641This variable takes effect when you create a new frame
7642or when you set the mouse color. */);
7643 Vx_window_bottom_edge_shape = Qnil;
7644
7645 DEFVAR_LISP ("x-window-bottom-left-corner-cursor",
7646 Vx_window_bottom_left_corner_shape,
7647 doc: /* Pointer shape indicating a bottom left x-window corner can be dragged.
7648This variable takes effect when you create a new frame
7649or when you set the mouse color. */);
7650 Vx_window_bottom_left_corner_shape = Qnil;
7651
7567 DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, 7652 DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
7568 doc: /* A string indicating the foreground color of the cursor box. */); 7653 doc: /* A string indicating the foreground color of the cursor box. */);
7569 Vx_cursor_fore_pixel = Qnil; 7654 Vx_cursor_fore_pixel = Qnil;
diff --git a/src/xterm.c b/src/xterm.c
index c8836b7ca78..a214cd81031 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -11757,6 +11757,22 @@ x_free_frame_resources (struct frame *f)
11757 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->horizontal_drag_cursor); 11757 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->horizontal_drag_cursor);
11758 if (f->output_data.x->vertical_drag_cursor != 0) 11758 if (f->output_data.x->vertical_drag_cursor != 0)
11759 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->vertical_drag_cursor); 11759 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->vertical_drag_cursor);
11760 if (f->output_data.x->left_edge_cursor != 0)
11761 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->left_edge_cursor);
11762 if (f->output_data.x->top_left_corner_cursor != 0)
11763 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_left_corner_cursor);
11764 if (f->output_data.x->top_edge_cursor != 0)
11765 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_edge_cursor);
11766 if (f->output_data.x->top_right_corner_cursor != 0)
11767 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_right_corner_cursor);
11768 if (f->output_data.x->right_edge_cursor != 0)
11769 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->right_edge_cursor);
11770 if (f->output_data.x->bottom_right_corner_cursor != 0)
11771 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_right_corner_cursor);
11772 if (f->output_data.x->bottom_edge_cursor != 0)
11773 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_edge_cursor);
11774 if (f->output_data.x->bottom_left_corner_cursor != 0)
11775 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_left_corner_cursor);
11760 11776
11761 XFlush (FRAME_X_DISPLAY (f)); 11777 XFlush (FRAME_X_DISPLAY (f));
11762 } 11778 }
diff --git a/src/xterm.h b/src/xterm.h
index a75257006fd..803feda99f3 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -637,6 +637,14 @@ struct x_output
637 Cursor horizontal_drag_cursor; 637 Cursor horizontal_drag_cursor;
638 Cursor vertical_drag_cursor; 638 Cursor vertical_drag_cursor;
639 Cursor current_cursor; 639 Cursor current_cursor;
640 Cursor left_edge_cursor;
641 Cursor top_left_corner_cursor;
642 Cursor top_edge_cursor;
643 Cursor top_right_corner_cursor;
644 Cursor right_edge_cursor;
645 Cursor bottom_right_corner_cursor;
646 Cursor bottom_edge_cursor;
647 Cursor bottom_left_corner_cursor;
640 648
641 /* Window whose cursor is hourglass_cursor. This window is temporarily 649 /* Window whose cursor is hourglass_cursor. This window is temporarily
642 mapped to display an hourglass cursor. */ 650 mapped to display an hourglass cursor. */
diff --git a/test/Makefile.in b/test/Makefile.in
index 414eca90564..11373db8ca9 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -147,7 +147,8 @@ endif
147%.log: %.elc 147%.log: %.elc
148 $(AM_V_at)${MKDIR_P} $(dir $@) 148 $(AM_V_at)${MKDIR_P} $(dir $@)
149 $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \ 149 $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \
150 --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} 150 --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" \
151 $(if $(and ${NIX_STORE}, $(findstring tramp, $(testloadfile))), , ${WRITE_LOG})
151 152
152ifeq (@HAVE_MODULES@, yes) 153ifeq (@HAVE_MODULES@, yes)
153maybe_exclude_module_tests := 154maybe_exclude_module_tests :=
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 78a37650619..6f63d30e755 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -593,5 +593,121 @@ baz\"\""
593 :bindings '((electric-quote-string . t)) 593 :bindings '((electric-quote-string . t))
594 :test-in-comments nil :test-in-strings nil) 594 :test-in-comments nil :test-in-strings nil)
595 595
596(define-electric-pair-test electric-quote-opening-single
597 "" "`" :expected-string "‘" :expected-point 2
598 :modes '(text-mode)
599 :fixture-fn #'electric-quote-local-mode
600 :test-in-comments nil :test-in-strings nil)
601
602(define-electric-pair-test electric-quote-closing-single
603 "" "'" :expected-string "’" :expected-point 2
604 :modes '(text-mode)
605 :fixture-fn #'electric-quote-local-mode
606 :test-in-comments nil :test-in-strings nil)
607
608(define-electric-pair-test electric-quote-opening-double
609 "‘" "-`" :expected-string "“" :expected-point 2
610 :modes '(text-mode)
611 :fixture-fn #'electric-quote-local-mode
612 :test-in-comments nil :test-in-strings nil)
613
614(define-electric-pair-test electric-quote-closing-double
615 "’" "-'" :expected-string "”" :expected-point 2
616 :modes '(text-mode)
617 :fixture-fn #'electric-quote-local-mode
618 :test-in-comments nil :test-in-strings nil)
619
620(define-electric-pair-test electric-quote-context-sensitive-backtick
621 "" "`" :expected-string "`" :expected-point 2
622 :modes '(text-mode)
623 :fixture-fn #'electric-quote-local-mode
624 :bindings '((electric-quote-context-sensitive . t))
625 :test-in-comments nil :test-in-strings nil)
626
627(define-electric-pair-test electric-quote-context-sensitive-bob-single
628 "" "'" :expected-string "‘" :expected-point 2
629 :modes '(text-mode)
630 :fixture-fn #'electric-quote-local-mode
631 :bindings '((electric-quote-context-sensitive . t))
632 :test-in-comments nil :test-in-strings nil)
633
634(define-electric-pair-test electric-quote-context-sensitive-bob-double
635 "‘" "-'" :expected-string "“" :expected-point 2
636 :modes '(text-mode)
637 :fixture-fn #'electric-quote-local-mode
638 :bindings '((electric-quote-context-sensitive . t))
639 :test-in-comments nil :test-in-strings nil)
640
641(define-electric-pair-test electric-quote-context-sensitive-bol-single
642 "a\n" "--'" :expected-string "a\n‘" :expected-point 4
643 :modes '(text-mode)
644 :fixture-fn #'electric-quote-local-mode
645 :bindings '((electric-quote-context-sensitive . t))
646 :test-in-comments nil :test-in-strings nil)
647
648(define-electric-pair-test electric-quote-context-sensitive-bol-double
649 "a\n‘" "---'" :expected-string "a\n“" :expected-point 4
650 :modes '(text-mode)
651 :fixture-fn #'electric-quote-local-mode
652 :bindings '((electric-quote-context-sensitive . t))
653 :test-in-comments nil :test-in-strings nil)
654
655(define-electric-pair-test electric-quote-context-sensitive-after-space-single
656 " " "-'" :expected-string " ‘" :expected-point 3
657 :modes '(text-mode)
658 :fixture-fn #'electric-quote-local-mode
659 :bindings '((electric-quote-context-sensitive . t))
660 :test-in-comments nil :test-in-strings nil)
661
662(define-electric-pair-test electric-quote-context-sensitive-after-space-double
663 " ‘" "--'" :expected-string " “" :expected-point 3
664 :modes '(text-mode)
665 :fixture-fn #'electric-quote-local-mode
666 :bindings '((electric-quote-context-sensitive . t))
667 :test-in-comments nil :test-in-strings nil)
668
669(define-electric-pair-test electric-quote-context-sensitive-after-letter-single
670 "a" "-'" :expected-string "a’" :expected-point 3
671 :modes '(text-mode)
672 :fixture-fn #'electric-quote-local-mode
673 :bindings '((electric-quote-context-sensitive . t))
674 :test-in-comments nil :test-in-strings nil)
675
676(define-electric-pair-test electric-quote-context-sensitive-after-letter-double
677 "a’" "--'" :expected-string "a”" :expected-point 3
678 :modes '(text-mode)
679 :fixture-fn #'electric-quote-local-mode
680 :bindings '((electric-quote-context-sensitive . t))
681 :test-in-comments nil :test-in-strings nil)
682
683(define-electric-pair-test electric-quote-context-sensitive-after-paren-single
684 "(" "-'" :expected-string "(‘" :expected-point 3
685 :modes '(text-mode)
686 :fixture-fn #'electric-quote-local-mode
687 :bindings '((electric-quote-context-sensitive . t))
688 :test-in-comments nil :test-in-strings nil)
689
690(define-electric-pair-test electric-quote-context-sensitive-after-paren-double
691 "(‘" "--'" :expected-string "(“" :expected-point 3
692 :modes '(text-mode)
693 :fixture-fn #'electric-quote-local-mode
694 :bindings '((electric-quote-context-sensitive . t))
695 :test-in-comments nil :test-in-strings nil)
696
697(define-electric-pair-test electric-quote-markdown-in-text
698 "" "'" :expected-string "’" :expected-point 2
699 :modes '(text-mode)
700 :fixture-fn #'electric-quote-local-mode
701 :bindings '((electric-quote-code-faces font-lock-constant-face))
702 :test-in-comments nil :test-in-strings nil)
703
704(define-electric-pair-test electric-quote-markdown-in-code
705 #("`a`" 1 2 (face font-lock-constant-face)) "-'"
706 :expected-string "`'a`" :expected-point 3
707 :modes '(text-mode)
708 :fixture-fn #'electric-quote-local-mode
709 :bindings '((electric-quote-code-faces font-lock-constant-face))
710 :test-in-comments nil :test-in-strings nil)
711
596(provide 'electric-tests) 712(provide 'electric-tests)
597;;; electric-tests.el ends here 713;;; electric-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index dfbe18d7844..6448a1b37f7 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -34,7 +34,7 @@
34 (let ((print-circle t)) 34 (let ((print-circle t))
35 (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) 35 (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
36 "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))"))) 36 "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))")))
37 (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'" 37 (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'"
38 (cl-prin1-to-string (symbol-function #'caar)))))) 38 (cl-prin1-to-string (symbol-function #'caar))))))
39 39
40(ert-deftest cl-print-tests-2 () 40(ert-deftest cl-print-tests-2 ()
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index fc5790c3659..317838b250f 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -367,12 +367,8 @@ This macro is used to test if macroexpansion in `should' works."
367 (test (make-ert-test :body test-body)) 367 (test (make-ert-test :body test-body))
368 (result (ert-run-test test))) 368 (result (ert-run-test test)))
369 (should (ert-test-failed-p result)) 369 (should (ert-test-failed-p result))
370 (with-temp-buffer 370 (should (eq (nth 1 (car (ert-test-failed-backtrace result)))
371 (ert--print-backtrace (ert-test-failed-backtrace result)) 371 'signal))))
372 (goto-char (point-min))
373 (end-of-line)
374 (let ((first-line (buffer-substring-no-properties (point-min) (point))))
375 (should (equal first-line (format " %S()" test-body)))))))
376 372
377(ert-deftest ert-test-messages () 373(ert-deftest ert-test-messages ()
378 :tags '(:causes-redisplay) 374 :tags '(:causes-redisplay)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index a90e3fff355..85990a848f5 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -53,6 +53,8 @@
53(defvar tramp-copy-size-limit) 53(defvar tramp-copy-size-limit)
54(defvar tramp-persistency-file-name) 54(defvar tramp-persistency-file-name)
55(defvar tramp-remote-process-environment) 55(defvar tramp-remote-process-environment)
56;; Suppress nasty messages.
57(fset 'shell-command-sentinel 'ignore)
56 58
57;; There is no default value on w32 systems, which could work out of the box. 59;; There is no default value on w32 systems, which could work out of the box.
58(defconst tramp-test-temporary-file-directory 60(defconst tramp-test-temporary-file-directory
@@ -70,6 +72,10 @@
70 (add-to-list 72 (add-to-list
71 'tramp-default-host-alist 73 'tramp-default-host-alist
72 `("\\`mock\\'" nil ,(system-name))) 74 `("\\`mock\\'" nil ,(system-name)))
75 ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
76 ;; batch mode only, therefore.
77 (unless (and (null noninteractive) (file-directory-p "~/"))
78 (setenv "HOME" temporary-file-directory))
73 (format "/mock::%s" temporary-file-directory))) 79 (format "/mock::%s" temporary-file-directory)))
74 "Temporary directory for Tramp tests.") 80 "Temporary directory for Tramp tests.")
75 81
@@ -126,29 +132,52 @@ If QUOTED is non-nil, the local part of the file is quoted."
126 (make-temp-name "tramp-test") 132 (make-temp-name "tramp-test")
127 (if local temporary-file-directory tramp-test-temporary-file-directory)))) 133 (if local temporary-file-directory tramp-test-temporary-file-directory))))
128 134
135;; Don't print messages in nested `tramp--instrument-test-case' calls.
136(defvar tramp--instrument-test-case-p nil
137 "Whether `tramp--instrument-test-case' run.
138This shall used dynamically bound only.")
139
129(defmacro tramp--instrument-test-case (verbose &rest body) 140(defmacro tramp--instrument-test-case (verbose &rest body)
130 "Run BODY with `tramp-verbose' equal VERBOSE. 141 "Run BODY with `tramp-verbose' equal VERBOSE.
131Print the the content of the Tramp debug buffer, if BODY does not 142Print the the content of the Tramp debug buffer, if BODY does not
132eval properly in `should' or `should-not'. `should-error' is not 143eval properly in `should' or `should-not'. `should-error' is not
133handled properly. BODY shall not contain a timeout." 144handled properly. BODY shall not contain a timeout."
134 (declare (indent 1) (debug (natnump body))) 145 (declare (indent 1) (debug (natnump body)))
135 `(let ((tramp-verbose ,verbose) 146 `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
147 (tramp-message-show-message t)
136 (tramp-debug-on-error t) 148 (tramp-debug-on-error t)
137 (debug-ignored-errors 149 (debug-ignored-errors
138 (cons "^make-symbolic-link not supported$" debug-ignored-errors))) 150 (cons "^make-symbolic-link not supported$" debug-ignored-errors))
151 inhibit-message)
139 (unwind-protect 152 (unwind-protect
140 (progn ,@body) 153 (let ((tramp--instrument-test-case-p t)) ,@body)
141 (when (> tramp-verbose 3) 154 ;; Unwind forms.
155 (when (and (null tramp--instrument-test-case-p) (> tramp-verbose 3))
142 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 156 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
143 (with-current-buffer (tramp-get-connection-buffer v) 157 (with-current-buffer (tramp-get-connection-buffer v)
144 (message "%s" (buffer-string))) 158 (message "%s" (buffer-string)))
145 (with-current-buffer (tramp-get-debug-buffer v) 159 (with-current-buffer (tramp-get-debug-buffer v)
146 (message "%s" (buffer-string)))))))) 160 (message "%s" (buffer-string))))))))
147 161
162(defsubst tramp--test-message (fmt-string &rest arguments)
163 "Emit a message into ERT *Messages*."
164 (tramp--instrument-test-case 0
165 (apply
166 'tramp-message
167 (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
168 fmt-string arguments)))
169
170(defsubst tramp--test-backtrace ()
171 "Dump a backtrace into ERT *Messages*."
172 (tramp--instrument-test-case 10
173 (tramp-backtrace
174 (tramp-dissect-file-name tramp-test-temporary-file-directory))))
175
148(ert-deftest tramp-test00-availability () 176(ert-deftest tramp-test00-availability ()
149 "Test availability of Tramp functions." 177 "Test availability of Tramp functions."
150 :expected-result (if (tramp--test-enabled) :passed :failed) 178 :expected-result (if (tramp--test-enabled) :passed :failed)
151 (message "Remote directory: `%s'" tramp-test-temporary-file-directory) 179 (tramp--test-message
180 "Remote directory: `%s'" tramp-test-temporary-file-directory)
152 (should (ignore-errors 181 (should (ignore-errors
153 (and 182 (and
154 (file-remote-p tramp-test-temporary-file-directory) 183 (file-remote-p tramp-test-temporary-file-directory)
@@ -2759,6 +2788,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2759 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) 2788 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2760 (let ((tmp-name (tramp--test-make-temp-name nil quoted)) 2789 (let ((tmp-name (tramp--test-make-temp-name nil quoted))
2761 (default-directory tramp-test-temporary-file-directory) 2790 (default-directory tramp-test-temporary-file-directory)
2791 ;; Suppress nasty messages.
2792 (inhibit-message t)
2762 kill-buffer-query-functions) 2793 kill-buffer-query-functions)
2763 (unwind-protect 2794 (unwind-protect
2764 (with-temp-buffer 2795 (with-temp-buffer
@@ -2787,7 +2818,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2787 (async-shell-command 2818 (async-shell-command
2788 (format "ls %s" (file-name-nondirectory tmp-name)) 2819 (format "ls %s" (file-name-nondirectory tmp-name))
2789 (current-buffer)) 2820 (current-buffer))
2790 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
2791 ;; Read output. 2821 ;; Read output.
2792 (with-timeout (10 (ert-fail "`async-shell-command' timed out")) 2822 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
2793 (while (< (- (point-max) (point-min)) 2823 (while (< (- (point-max) (point-min))
@@ -2816,7 +2846,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2816 (write-region "foo" nil tmp-name) 2846 (write-region "foo" nil tmp-name)
2817 (should (file-exists-p tmp-name)) 2847 (should (file-exists-p tmp-name))
2818 (async-shell-command "read line; ls $line" (current-buffer)) 2848 (async-shell-command "read line; ls $line" (current-buffer))
2819 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
2820 (process-send-string 2849 (process-send-string
2821 (get-buffer-process (current-buffer)) 2850 (get-buffer-process (current-buffer))
2822 (format "%s\n" (file-name-nondirectory tmp-name))) 2851 (format "%s\n" (file-name-nondirectory tmp-name)))
@@ -2847,8 +2876,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2847 "Like `shell-command-to-string', but for asynchronous processes." 2876 "Like `shell-command-to-string', but for asynchronous processes."
2848 (with-temp-buffer 2877 (with-temp-buffer
2849 (async-shell-command command (current-buffer)) 2878 (async-shell-command command (current-buffer))
2850 ;; Suppress nasty messages.
2851 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
2852 (with-timeout (10) 2879 (with-timeout (10)
2853 (while (get-buffer-process (current-buffer)) 2880 (while (get-buffer-process (current-buffer))
2854 (accept-process-output (get-buffer-process (current-buffer)) 0.1))) 2881 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
@@ -3046,11 +3073,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3046 ;; We must force a reconnect, in order to activate $BZR_HOME. 3073 ;; We must force a reconnect, in order to activate $BZR_HOME.
3047 (tramp-cleanup-connection 3074 (tramp-cleanup-connection
3048 (tramp-dissect-file-name tramp-test-temporary-file-directory) 3075 (tramp-dissect-file-name tramp-test-temporary-file-directory)
3049 nil 'keep-password) 3076 'keep-debug 'keep-password)
3050 '(Bzr)) 3077 '(Bzr))
3051 (t nil))))) 3078 (t nil))))
3079 ;; Suppress nasty messages.
3080 (inhibit-message t))
3052 (skip-unless vc-handled-backends) 3081 (skip-unless vc-handled-backends)
3053 (message "%s" vc-handled-backends) 3082 (unless quoted (tramp--test-message "%s" vc-handled-backends))
3054 3083
3055 (unwind-protect 3084 (unwind-protect
3056 (progn 3085 (progn
@@ -3656,90 +3685,134 @@ Use the `ls' command."
3656 "Check parallel asynchronous requests. 3685 "Check parallel asynchronous requests.
3657Such requests could arrive from timers, process filters and 3686Such requests could arrive from timers, process filters and
3658process sentinels. They shall not disturb each other." 3687process sentinels. They shall not disturb each other."
3659 ;; Mark as failed until bug has been fixed.
3660 :expected-result :failed
3661 :tags '(:expensive-test) 3688 :tags '(:expensive-test)
3662 (skip-unless (tramp--test-enabled)) 3689 (skip-unless (tramp--test-enabled))
3663 (skip-unless (tramp--test-sh-p)) 3690 (skip-unless (tramp--test-sh-p))
3664 3691
3665 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) 3692 ;; This test times out on hydra.
3666 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. 3693 (with-timeout
3667 ;; This has the side effect, that this test fails instead to 3694 (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out"))
3668 ;; abort. Good for hydra. 3695 (let* ((tmp-name (tramp--test-make-temp-name))
3669 (tramp--instrument-test-case 0 3696 (default-directory tmp-name)
3670 (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) 3697 ;; Do not cache Tramp properties.
3671 (default-directory tmp-name) 3698 (remote-file-name-inhibit-cache t)
3672 (remote-file-name-inhibit-cache t) 3699 (process-file-side-effects t)
3673 timer buffers kill-buffer-query-functions) 3700 ;; Suppress nasty messages.
3701 (inhibit-message t)
3702 (number-proc 10)
3703 ;; On hydra, timings are bad.
3704 (timer-repeat
3705 (cond
3706 ((getenv "NIX_STORE") 10
3707 (t 1))))
3708 ;; We must distinguish due to performance reasons.
3709 (timer-operation
3710 (cond
3711 ((string-equal "mock" (file-remote-p tmp-name 'method))
3712 'vc-registered)
3713 (t 'file-attributes)))
3714 timer buffers kill-buffer-query-functions)
3674 3715
3675 (unwind-protect 3716 (unwind-protect
3676 (progn 3717 (progn
3677 (make-directory tmp-name) 3718 (make-directory tmp-name)
3678 3719
3679 ;; Setup a timer in order to raise an ordinary command 3720 ;; Setup a timer in order to raise an ordinary command again
3680 ;; again and again. `vc-registered' is well suited, 3721 ;; and again. `vc-registered' is well suited, because there
3681 ;; because there are many checks. 3722 ;; are many checks.
3682 (setq 3723 (setq
3683 timer 3724 timer
3684 (run-at-time 3725 (run-at-time
3685 0 1 3726 0 timer-repeat
3686 (lambda () 3727 (lambda ()
3687 (when buffers 3728 (when buffers
3688 (vc-registered 3729 (let ((default-directory tmp-name)
3689 (buffer-name (nth (random (length buffers)) buffers))))))) 3730 (file
3690 3731 (buffer-name (nth (random (length buffers)) buffers))))
3691 ;; Create temporary buffers. The number of buffers 3732 (tramp--test-message
3692 ;; corresponds to the number of processes; it could be 3733 "Start timer %s %s %s"
3693 ;; increased in order to make pressure on Tramp. 3734 timer-operation file (current-time-string))
3694 (dotimes (_i 5) 3735 (funcall timer-operation file)
3695 (add-to-list 'buffers (generate-new-buffer "*temp*"))) 3736 (tramp--test-message
3696 3737 "Stop timer %s %s %s"
3697 ;; Open asynchronous processes. Set process sentinel. 3738 timer-operation file (current-time-string)))))))
3698 (dolist (buf buffers) 3739
3699 (async-shell-command "read line; touch $line; echo $line" buf) 3740 ;; Create temporary buffers. The number of buffers
3741 ;; corresponds to the number of processes; it could be
3742 ;; increased in order to make pressure on Tramp.
3743 (dotimes (_i number-proc)
3744 (add-to-list 'buffers (generate-new-buffer "foo")))
3745
3746 ;; Open asynchronous processes. Set process sentinel.
3747 (dolist (buf buffers)
3748 (tramp--test-message "Start process %s" buf)
3749 (let ((proc
3750 (start-file-process-shell-command
3751 (buffer-name buf) buf
3752 (concat
3753 "(read line && echo $line >$line);"
3754 "(read line && cat $line);"
3755 "(read line && rm $line)")))
3756 (file (expand-file-name (buffer-name buf))))
3757 ;; Remember the file name. Add counter.
3758 (process-put proc 'foo file)
3759 (process-put proc 'bar 0)
3760 ;; Add process filter.
3761 (set-process-filter
3762 proc
3763 (lambda (proc string)
3764 (tramp--test-message "Process filter %s" proc)
3765 (with-current-buffer (process-buffer proc)
3766 (insert string))
3767 (unless (zerop (length string))
3768 (should (file-attributes (process-get proc 'foo))))))
3769 ;; Add process sentinel.
3700 (set-process-sentinel 3770 (set-process-sentinel
3701 (get-buffer-process buf) 3771 proc
3702 (lambda (proc _state) 3772 (lambda (proc _state)
3703 (delete-file (buffer-name (process-buffer proc)))))) 3773 (tramp--test-message "Process sentinel %s" proc)
3704 3774 (should-not (file-attributes (process-get proc 'foo)))))))
3705 ;; Send a string. Use a random order of the buffers. Mix 3775
3706 ;; with regular operation. 3776 ;; Send a string. Use a random order of the buffers. Mix
3707 (let ((buffers (copy-sequence buffers)) 3777 ;; with regular operation.
3708 buf) 3778 (let ((buffers (copy-sequence buffers)))
3709 (while buffers 3779 (while buffers
3710 (setq buf (nth (random (length buffers)) buffers)) 3780 (let* ((buf (nth (random (length buffers)) buffers))
3711 (process-send-string 3781 (proc (get-buffer-process buf))
3712 (get-buffer-process buf) (format "'%s'\n" buf)) 3782 (file (process-get proc 'foo))
3713 (file-attributes (buffer-name buf)) 3783 (count (process-get proc 'bar)))
3714 (setq buffers (delq buf buffers)))) 3784 ;; Regular operation.
3715 3785 (if (= count 0)
3716 ;; Wait until the whole output has been read. 3786 (should-not (file-attributes file))
3717 (with-timeout ((* 10 (length buffers)) 3787 (should (file-attributes file)))
3718 (ert-fail "`async-shell-command' timed out")) 3788 ;; Send string to process.
3719 (let ((buffers (copy-sequence buffers)) 3789 (tramp--test-message "Send string %s" proc)
3720 buf) 3790 (process-send-string proc (format "%s\n" (buffer-name buf)))
3721 (while buffers 3791 (accept-process-output proc 0.1 nil 0)
3722 (setq buf (nth (random (length buffers)) buffers)) 3792 ;; Regular operation.
3723 (if (ignore-errors 3793 (if (= count 2)
3724 (memq (process-status (get-buffer-process buf)) 3794 (should-not (file-attributes file))
3725 '(run open))) 3795 (should (file-attributes file)))
3726 (accept-process-output (get-buffer-process buf) 0.1) 3796 (process-put proc 'bar (1+ count))
3727 (setq buffers (delq buf buffers)))))) 3797 (unless (process-live-p proc)
3728 3798 (tramp--test-message "Buffer delete %s" buf)
3729 ;; Check. 3799 (setq buffers (delq buf buffers))))))
3730 (dolist (buf buffers) 3800
3731 (with-current-buffer buf 3801 ;; Checks. All process output shall exists in the
3732 (should 3802 ;; respective buffers. All created files shall be deleted.
3733 (string-equal (format "'%s'\n" buf) (buffer-string))))) 3803 (tramp--test-message "Checks %s" buffers)
3734 (should-not 3804 (dolist (buf buffers)
3735 (directory-files 3805 (with-current-buffer buf
3736 tmp-name nil directory-files-no-dot-files-regexp))) 3806 (should (string-equal (format "%s\n" buf) (buffer-string)))))
3737 3807 (should-not
3738 ;; Cleanup. 3808 (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
3739 (ignore-errors (cancel-timer timer)) 3809
3740 (ignore-errors (delete-directory tmp-name 'recursive)) 3810 ;; Cleanup.
3741 (dolist (buf buffers) 3811 (dolist (buf buffers)
3742 (ignore-errors (kill-buffer buf)))))))) 3812 (ignore-errors (delete-process (get-buffer-process buf)))
3813 (ignore-errors (kill-buffer buf)))
3814 (ignore-errors (cancel-timer timer))
3815 (ignore-errors (delete-directory tmp-name 'recursive))))))
3743 3816
3744(ert-deftest tramp-test37-recursive-load () 3817(ert-deftest tramp-test37-recursive-load ()
3745 "Check that Tramp does not fail due to recursive load." 3818 "Check that Tramp does not fail due to recursive load."
@@ -3836,8 +3909,8 @@ Since it unloads Tramp, it shall be the last test to run."
3836;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). 3909;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
3837;; * Fix Bug#27009. Set expected error of 3910;; * Fix Bug#27009. Set expected error of
3838;; `tramp-test29-environment-variables-and-port-numbers'. 3911;; `tramp-test29-environment-variables-and-port-numbers'.
3839;; * Fix Bug#16928. Set expected error of `tramp-test36-asynchronous-requests'. 3912;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'.
3840;; * Fix `tramp-test38-unload' (Not all symbols are unbound). Set 3913;; * Fix `tramp-test39-unload' (Not all symbols are unbound). Set
3841;; expected error. 3914;; expected error.
3842 3915
3843(defun tramp-test-all (&optional interactive) 3916(defun tramp-test-all (&optional interactive)