[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/org-mode-merge 5ca1888: Merge branch 'master' into
|
From: |
Bastien Guerry |
|
Subject: |
[Emacs-diffs] scratch/org-mode-merge 5ca1888: Merge branch 'master' into scratch/org-mode-merge |
|
Date: |
Mon, 3 Jul 2017 03:09:05 -0400 (EDT) |
branch: scratch/org-mode-merge
commit 5ca1888fe670aee7febd4d42665d7372ab2ffebc
Merge: 20e006f 1b4f0a9
Author: Bastien <address@hidden>
Commit: Bastien <address@hidden>
Merge branch 'master' into scratch/org-mode-merge
---
admin/merge-gnulib | 2 +-
admin/unidata/unidata-gen.el | 94 ++--
configure.ac | 2 +-
doc/emacs/dired.texi | 26 +-
doc/emacs/help.texi | 7 +-
doc/emacs/killing.texi | 4 +
doc/emacs/mule.texi | 8 +-
doc/lispref/display.texi | 71 ++-
doc/lispref/elisp.texi | 2 +
doc/lispref/frames.texi | 510 ++++++++++++++++-----
doc/lispref/modes.texi | 4 +-
doc/lispref/objects.texi | 35 +-
doc/lispref/windows.texi | 145 +++++-
doc/misc/emacs-mime.texi | 2 +-
doc/misc/tramp.texi | 42 +-
doc/misc/trampver.texi | 2 +-
etc/NEWS | 89 +++-
lib-src/ebrowse.c | 8 +-
lib-src/emacsclient.c | 3 +-
lib-src/etags.c | 1 +
lib-src/hexl.c | 2 +-
lib-src/make-docfile.c | 10 +-
lib-src/movemail.c | 4 +-
lib-src/profile.c | 2 +-
lib-src/update-game-score.c | 3 +-
lib/gnulib.mk.in | 11 +-
lib/unlocked-io.h | 136 ++++++
lisp/autorevert.el | 56 +--
lisp/calc/calc-units.el | 72 ++-
lisp/descr-text.el | 14 +-
lisp/dired-aux.el | 254 ++++++-----
lisp/dired.el | 27 +-
lisp/electric.el | 66 ++-
lisp/emacs-lisp/cl-extra.el | 39 +-
lisp/emacs-lisp/cl-print.el | 11 +-
lisp/emacs-lisp/debug.el | 188 +++-----
lisp/emacs-lisp/eieio-core.el | 10 +-
lisp/emacs-lisp/ert.el | 87 ++--
lisp/emacs-lisp/lisp-mnt.el | 7 +-
lisp/epg.el | 2 +-
lisp/eshell/esh-cmd.el | 32 +-
lisp/frame.el | 32 ++
lisp/help-fns.el | 103 +++--
lisp/help.el | 257 +++++------
lisp/ldefs-boot.el | 18 +-
lisp/minibuffer.el | 2 +-
lisp/mouse.el | 433 +++++++++++++++++-
lisp/net/eww.el | 16 +-
lisp/net/shr.el | 87 ++--
lisp/net/tramp-adb.el | 49 ++-
lisp/net/tramp-compat.el | 3 +-
lisp/net/tramp-sh.el | 19 +-
lisp/net/tramp.el | 91 ++--
lisp/net/trampver.el | 6 +-
lisp/{net => obsolete}/html2text.el | 3 +
lisp/progmodes/cc-cmds.el | 2 +-
lisp/progmodes/cc-defs.el | 91 +++-
lisp/progmodes/cc-engine.el | 4 +-
lisp/progmodes/cc-fonts.el | 47 +-
lisp/progmodes/cc-langs.el | 24 +-
lisp/progmodes/cc-mode.el | 298 +++++++++----
lisp/progmodes/cc-styles.el | 1 +
lisp/progmodes/tcl.el | 5 +-
lisp/select.el | 3 +
lisp/ses.el | 49 ++-
lisp/subr.el | 4 +-
lisp/term/w32-win.el | 2 +-
lisp/tooltip.el | 6 +-
lisp/url/url-history.el | 9 +-
lisp/window.el | 615 +++++++++++++++++---------
m4/gnulib-comp.m4 | 4 +
m4/unlocked-io.m4 | 41 ++
src/charset.c | 6 +-
src/cm.c | 14 +-
src/dispextern.h | 36 +-
src/dispnew.c | 32 +-
src/emacs-module.c | 6 +-
src/emacs-module.h.in | 3 +-
src/emacs.c | 8 +-
src/fileio.c | 16 +-
src/frame.c | 783 ++++++++++++++++++++++++++-------
src/frame.h | 63 ++-
src/gtkutil.c | 2 +
src/image.c | 11 +-
src/intervals.h | 12 +-
src/keyboard.c | 71 ++-
src/lread.c | 11 +-
src/minibuf.c | 34 +-
src/module-env-25.h | 2 +-
src/nsfns.m | 12 +
src/nsterm.h | 15 +-
src/nsterm.m | 26 +-
src/print.c | 55 ++-
src/process.c | 13 +-
src/sysdep.c | 15 +-
src/sysstdio.h | 41 ++
src/systhread.c | 11 +
src/term.c | 47 +-
src/w32fns.c | 41 +-
src/w32term.c | 63 ++-
src/w32term.h | 8 +
src/window.c | 213 ++++++++-
src/window.h | 200 ++++-----
src/xdisp.c | 190 ++++++--
src/xfaces.c | 2 +-
src/xfns.c | 101 ++++-
src/xterm.c | 16 +
src/xterm.h | 8 +
test/Makefile.in | 3 +-
test/lisp/electric-tests.el | 116 +++++
test/lisp/emacs-lisp/cl-print-tests.el | 2 +-
test/lisp/emacs-lisp/ert-tests.el | 8 +-
test/lisp/net/tramp-tests.el | 255 +++++++----
113 files changed, 4945 insertions(+), 2040 deletions(-)
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index d4bbf17..85921ba 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -40,7 +40,7 @@ GNULIB_MODULES='
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
+ update-copyright unlocked-io utimens
vla warnings
'
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index e1e896c..478099c 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)."
(generator (unidata-prop-generator proplist))
(default-value (unidata-prop-default proplist))
(val-list (unidata-prop-val-list proplist))
- (table (progn
- (message "Generating %S table..." prop)
- (funcall generator prop index default-value val-list)))
- (decoder (char-table-extra-slot table 1))
- (alist (and (functionp index)
- (funcall index)))
- (check #x400))
- (dolist (e unidata-list)
- (let* ((char (car e))
- (val1
- (if alist (nth 1 (assoc char alist))
- (nth index e)))
- val2)
- (if (and (stringp val1) (= (length val1) 0))
- (setq val1 nil))
- (unless (or (consp char)
- (integerp decoder))
- (setq val2
- (cond ((functionp decoder)
- (funcall decoder char (aref table char) table))
- (t ; must be nil
- (aref table char))))
- (if val1
- (cond ((eq generator 'unidata-gen-table-symbol)
- (setq val1 (intern val1)))
- ((eq generator 'unidata-gen-table-integer)
- (setq val1 (string-to-number val1)))
- ((eq generator 'unidata-gen-table-character)
- (setq val1 (string-to-number val1 16)))
- ((eq generator 'unidata-gen-table-decomposition)
- (setq val1 (unidata-split-decomposition val1))))
- (cond ((eq prop 'decomposition)
- (setq val1 (list char)))
- ((eq prop 'bracket-type)
- (setq val1 'n))))
- (when (>= char check)
- (message "%S %04X" prop check)
- (setq check (+ check #x400)))
- (or (equal val1 val2)
- ;; <control> characters get a 'name' property of nil
- (and (eq prop 'name) (string= val1 "<control>") (null val2))
- (insert (format "> %04X %S\n< %04X %S\n"
- char val1 char val2)))
- (sit-for 0))))))))
+ (check #x400)
+ table decoder alist)
+ ;; We compare values in unidata.txt with the ones returned by various
+ ;; generator functions. However, SpecialCasing.txt is read directly by
+ ;; unidata-gen-table-special-casing--do-load and there is no other file
+ ;; to compare those values with. This is why we’re skipping the check
+ ;; for special casing properties.
+ (unless (eq generator 'unidata-gen-table-special-casing)
+ (setq table (progn
+ (message "Generating %S table..." prop)
+ (funcall generator prop index default-value val-list))
+ decoder (char-table-extra-slot table 1))
+ (unless (integerp decoder)
+ (setq alist (and (functionp index) (funcall index)))
+ (dolist (e unidata-list)
+ (let ((char (car e)) val1 val2)
+ (unless (consp char)
+ (setq val1 (if alist
+ (nth 1 (assoc char alist))
+ (nth index e)))
+ (and (stringp val1)
+ (= (length val1) 0)
+ (setq val1 nil))
+ (if val1
+ (cond ((eq generator 'unidata-gen-table-symbol)
+ (setq val1 (intern val1)))
+ ((eq generator 'unidata-gen-table-integer)
+ (setq val1 (string-to-number val1)))
+ ((eq generator 'unidata-gen-table-character)
+ (setq val1 (string-to-number val1 16)))
+ ((eq generator 'unidata-gen-table-decomposition)
+ (setq val1 (unidata-split-decomposition val1))))
+ (cond ((eq prop 'decomposition)
+ (setq val1 (list char)))
+ ((eq prop 'bracket-type)
+ (setq val1 'n))))
+ (setq val2 (aref table char))
+ (when decoder
+ (setq val2 (funcall decoder char val2 table)))
+ (when (>= char check)
+ (message "%S %04X" prop check)
+ (setq check (+ check #x400)))
+ (or (equal val1 val2)
+ ;; <control> characters get a 'name' property of nil
+ (and (eq prop 'name)
+ (string= val1 "<control>")
+ (null val2))
+ (insert (format "> %04X %S\n< %04X %S\n"
+ char val1 char val2)))
+ (sit-for 0))))))))))
;; The entry functions. They generate files described in the header
;; comment of this file.
diff --git a/configure.ac b/configure.ac
index 65c5f92..ef61107 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4240,7 +4240,7 @@ AC_CHECK_HEADERS(valgrind/valgrind.h)
AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
-AC_CHECK_FUNCS_ONCE([getc_unlocked sbrk])
+AC_CHECK_FUNCS_ONCE([sbrk])
ok_so_far=yes
AC_CHECK_FUNC(socket, , ok_so_far=no)
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 22b0fcd..28cb51d 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -875,27 +875,33 @@ treat it specially.
@item
Otherwise, if the command string contains @samp{?} surrounded by
-whitespace, Emacs runs the shell command once @emph{for each file},
-substituting the current file name for @samp{?} each time. You can
-use @samp{?} more than once in the command; the same file name
-replaces each occurrence.
+whitespace or @samp{`?`}, Emacs runs the shell command once
address@hidden each file}, substituting the current file name for @samp{?}
+and @samp{`?`} each time. You can use both @samp{?} or @samp{`?`} more
+than once in the command; the same file name replaces each occurrence.
+If you mix them with @samp{*} the command signals an error.
@item
-If the command string contains neither @samp{*} nor @samp{?}, Emacs
-runs the shell command once for each file, adding the file name at the
+If the command string contains neither @samp{*} nor @samp{?} nor @samp{`?`},
+Emacs runs the shell command once for each file, adding the file name at the
end. For example, @kbd{! uudecode @key{RET}} runs @code{uudecode} on
each file.
@end itemize
- To iterate over the file names in a more complicated fashion, use an
-explicit shell loop. For example, here is how to uuencode each file,
-making the output file name by appending @samp{.uu} to the input file
-name:
+ To iterate over the file names in a more complicated fashion, you might
+prefer to use an explicit shell loop. For example, here is how to uuencode
+each file, making the output file name by appending @samp{.uu} to the input
+file name:
@example
for file in * ; do uuencode "$file" "$file" >"$file".uu; done
@end example
+The same example with @samp{`?`} notation:
address@hidden
+uuencode ? ? > `?`.uu
address@hidden example
+
The @kbd{!} and @kbd{&} commands do not attempt to update the Dired
buffer to show new or modified files, because they don't know what
files 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 548ca6a..fd6df1c 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -203,9 +203,10 @@ string}, which describes exactly what the command does.
describes the command corresponding to @var{key}.
@kbd{C-h c}, @kbd{C-h k} and @kbd{C-h K} work for any sort of key
-sequences, including function keys, menus, and mouse events. For
-instance, after @kbd{C-h k} you can select a menu item from the menu
-bar, to view the documentation string of the command it runs.
+sequences, including function keys, menus, and mouse events (except
+that @kbd{C-h c} ignores mouse movement events). For instance, after
address@hidden k} you can select a menu item from the menu bar, to view the
+documentation string of the command it runs.
@kindex C-h w
@findex where-is
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 47de053..0b5efd0 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
data to the clipboard manager, change the variable
@code{x-select-enable-clipboard-manager} to @code{nil}.
+ Since strings containing NUL bytes are usually truncated when passed
+through the clipboard, Emacs replaces such characters with ``\0''
+before transfering them to the system's clipboard.
+
@vindex select-enable-primary
@findex clipboard-kill-region
@findex clipboard-kill-ring-save
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 13407f6..8edf264 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.
Reordering of bidirectional text into the @dfn{visual} order happens
at display time. As result, character positions no longer increase
monotonically with their positions on display. Emacs implements the
-Unicode Bidirectional Algorithm described in the Unicode Standard
-Annex #9, for reordering of bidirectional text for display.
+Unicode Bidirectional Algorithm (UBA) described in the Unicode
+Standard Annex #9, for reordering of bidirectional text for display.
+It deviates from the UBA only in how continuation lines are displayed
+when text direction is opposite to the base paragraph direction,
+e.g. when a long line of English text appears in a right-to-left
+paragraph.
@vindex bidi-display-reordering
The buffer-local variable @code{bidi-display-reordering} controls
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 4de55fd..2ebe872 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
height of both, if present, in the return value.
@end defun
address@hidden treats the text displayed in a window as a
+whole and does not care about the size of individual lines. The
+following function does.
+
address@hidden window-lines-pixel-dimensions &optional window first last body
inverse
+This function calculates the pixel dimensions of each line displayed in
+the specified @var{window}. It does so by walking @var{window}'s
+current glyph matrix---a matrix storing the glyph (@pxref{Glyphs}) of
+each buffer character currently displayed in @var{window}. If
+successful, it returns a list of cons pairs representing the x- and
+y-coordinates of the lower right corner of the last character of each
+line. Coordinates are measured in pixels from an origin (0, 0) at the
+top-left corner of @var{window}. @var{window} must be a live window and
+defaults to the selected one.
+
+If the optional argument @var{first} is an integer, it denotes the index
+(starting with 0) of the first line of @var{window}'s glyph matrix to be
+returned. Note that if @var{window} has a header line, the line with
+index 0 is that header line. If @var{first} is nil, the first line to
+be considered is determined by the value of the optional argument
address@hidden: If @var{body} is address@hidden, this means to start with
+the first line of @var{window}'s body, skipping any header line, if
+present. Otherwise, this function will start with the first line of
address@hidden's glyph matrix, possibly the header line.
+
+If the optional argument @var{last} is an integer, it denotes the index
+of the last line of @var{window}'s glyph matrix that shall be returned.
+If @var{last} is nil, the last line to be considered is determined by
+the value of @var{body}: If @var{body} is address@hidden, this means to
+use the last line of @var{window}'s body, omitting @var{window}'s mode
+line, if present. Otherwise, this means to use the last line of
address@hidden which may be the mode line.
+
+The optional argument @var{inverse}, if @code{nil}, means that the
+y-pixel value returned for any line specifies the distance in pixels
+from the left edge (body edge if @var{body} is address@hidden) of
address@hidden to the right edge of the last glyph of that line.
address@hidden address@hidden means that the y-pixel value returned for
+any line specifies the distance in pixels from the right edge of the
+last glyph of that line to the right edge (body edge if @var{body} is
address@hidden) of @var{window}. This is useful for determining the
+amount of slack space at the end of each line.
+
+The optional argument @var{left}, if address@hidden means to return the
+x- and y-coordinates of the lower left corner of the leftmost character
+on each line. This is the value that should be used for windows that
+mostly display text from right to left.
+
+If @var{left} is address@hidden and @var{inverse} is @code{nil}, this
+means that the y-pixel value returned for any line specifies the
+distance in pixels from the left edge of the last (leftmost) glyph of
+that line to the right edge (body edge if @var{body} is address@hidden)
+of @var{window}. If @var{left} and @var{inverse} are both
address@hidden, the y-pixel value returned for any line specifies the
+distance in pixels from the left edge (body edge if @var{body} is
address@hidden) of @var{window} to the left edge of the last (leftmost)
+glyph of that line.
+
+This function returns @code{nil} if the current glyph matrix of
address@hidden is not up-to-date which usually happens when Emacs is busy,
+for example, when processing a command. The value should be retrievable
+though when this function is run from an idle timer with a delay of zero
+seconds.
address@hidden defun
+
@defun line-pixel-height
This function returns the height in pixels of the line at point in the
selected window. The value includes the line spacing of the line
@@ -7297,7 +7362,11 @@ follows the Unicode Bidirectional Algorithm (a.k.a.@:
@acronym{UBA}),
which is described in Annex #9 of the Unicode standard
(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full
Bidirectionality'' class implementation of the @acronym{UBA},
-consistent with the requirements of the Unicode Standard v8.0.
+consistent with the requirements of the Unicode Standard v9.0. Note,
+however, that the way Emacs displays continuation lines when text
+direction is opposite to the base paragraph direction deviates from
+the UBA, which requires to perform line wrapping before reordering
+text for display.
@defvar bidi-display-reordering
If the value of this buffer-local variable is address@hidden (the
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 7cc91a8..4bedea3 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1130,6 +1130,8 @@ Window Frame Parameters
* Buffer Parameters:: Which buffers have been or should be shown.
* Frame Interaction Parameters:: Parameters for interacting with other
frames.
+* Mouse Dragging Parameters:: Parameters for resizing and moving
+ frames with the mouse.
* Management Parameters:: Communicating with the window manager.
* Cursor Parameters:: Controlling the cursor appearance.
* Font and Color Parameters:: Fonts and colors for the frame text.
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 50467d1..b430f7c 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
the help of an X-style geometry specification. @xref{Emacs Invocation,,
Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs
Manual}. Below we list some functions to access and set the size of an
-existing, visible frame.
-
address@hidden frame-text-height &optional frame
address@hidden frame-text-width &optional frame
-These functions return the height and width of the text area of
address@hidden (@pxref{Frame Layout}), measured in pixels. For a text
-terminal, the results are in characters rather than pixels.
address@hidden defun
+existing, visible frame, by default the selected one.
@defun frame-height &optional frame
@defunx frame-width &optional frame
@@ -997,11 +990,33 @@ rounded down to the number of characters of the default
font that fully
fit into the text area.
@end defun
address@hidden frame-pixel-height &optional frame
address@hidden frame-pixel-width &optional frame
-These functions return the native width and height, see @ref{Frame
-Layout}) of @var{frame} in pixels. For a text terminal, the results are
-in characters rather than pixels.
+The functions following next return the pixel widths and heights of the
+native, outer and inner frame and the text area (@pxref{Frame Layout})
+of a given frame. For a text terminal, the results are in characters
+rather than pixels.
+
address@hidden frame-outer-width &optional frame
address@hidden frame-outer-height &optional frame
+These functions return the outer width and height of @var{frame} in
+pixels.
address@hidden defun
+
address@hidden frame-native-height &optional frame
address@hidden frame-native-width &optional frame
+These functions return the native width and height of @var{frame} in
+pixels.
address@hidden defun
+
address@hidden frame-inner-width &optional frame
address@hidden frame-inner-height &optional frame
+These functions return the inner width and height of @var{frame} in
+pixels.
address@hidden defun
+
address@hidden frame-text-width &optional frame
address@hidden frame-text-height &optional frame
+These functions return the width and height of the text area of
address@hidden in pixels.
@end defun
On window systems that support it, Emacs tries by default to make the
@@ -1345,6 +1360,8 @@ text terminals.
* Buffer Parameters:: Which buffers have been or should be shown.
* Frame Interaction Parameters:: Parameters for interacting with other
frames.
+* Mouse Dragging Parameters:: Parameters for resizing and moving
+ frames with the mouse.
* Management Parameters:: Communicating with the window manager.
* Cursor Parameters:: Controlling the cursor appearance.
* Font and Color Parameters:: Fonts and colors for the frame text.
@@ -1404,18 +1421,19 @@ named, this parameter will be @code{nil}.
@cindex frame position
Parameters describing the X- and Y-offsets of a frame are always
-measured in pixels. For normal, non-child frames they specify the
-frame's absolute outer position (@pxref{Frame Geometry}) with respect to
-its display's origin. For a child frame (@pxref{Child Frames}) they
-specify the frame's outer position relative to the native position of
-the frame's parent frame. (Note that none of these parameters is
-meaningful on TTY frames.)
+measured in pixels. For a normal, non-child frame they specify the
+frame's outer position (@pxref{Frame Geometry}) relative to its
+display's origin. For a child frame (@pxref{Child Frames}) they specify
+the frame's outer position relative to the native position of the
+frame's parent frame. (Note that none of these parameters is meaningful
+on TTY frames.)
@table @code
@vindex left, a frame parameter
@item left
The position, in pixels, of the left outer edge of the frame with
-respect to the left edge of the frame's display or parent frame.
+respect to the left edge of the frame's display or parent frame. It can
+be specified in one of the following ways.
@table @asis
@item an integer
@@ -1436,6 +1454,30 @@ right edge of the display or parent frame. The integer
@var{pos} may be
positive or negative; a negative value specifies a position outside the
screen or parent frame or on a monitor other than the primary one (for
multi-monitor displays).
+
address@hidden left position ratio
address@hidden top position ratio
address@hidden a floating-point value
+A floating-point value in the range 0.0 to 1.0 specifies the left edge's
+offset via the @dfn{left position ratio} of the frame---the ratio of the
+left edge of its outer frame to the width of the frame's workarea
+(@pxref{Multiple Terminals}) or its parent's native frame (@pxref{Child
+Frames}) minus the width of the outer frame. Thus, a left position
+ratio of 0.0 flushes a frame to the left, a ratio of 0.5 centers it and
+a ratio of 1.0 flushes it to the right of its display or parent frame.
+Similarly, the @dfn{top position ratio} of a frame is the ratio of the
+frame's top position to the height of its workarea or parent frame minus
+the height of the frame.
+
+Emacs will try to keep the position ratios of a child frame unaltered if
+that frame has a address@hidden @code{keep-ratio} parameter
+(@pxref{Frame Interaction Parameters}) and its parent frame is resized.
+
+Since the outer size of a frame (@pxref{Frame Geometry}) is usually
+unavailable before a frame has been made visible, it is generally not
+advisable to use floating-point values when creating decorated frames.
+Floating-point values are more suited for ensuring that an (undecorated)
+child frame is positioned nicely within the area of its parent frame.
@end table
Some window managers ignore program-specified positions. If you want to
@@ -1448,17 +1490,19 @@ following example:
nil '((user-position . t) (left . (+ -4))))
@end example
-In general, it is not a good idea to specify negative offsets to
-position a frame relative to the right or bottom edge of its display.
-Positioning the initial or a new frame is either not accurate (because
-the size of the outer frame is not yet fully known before the frame has
-been made visible) or will cause additional flicker (if the frame is
-repositioned after becoming visible).
+In general, it is not a good idea to position a frame relative to the
+right or bottom edge of its display. Positioning the initial or a new
+frame is either not accurate (because the size of the outer frame is not
+yet fully known before the frame has been made visible) or will cause
+additional flicker (if the frame has to be repositioned after becoming
+visible).
- Note also, that negative offsets are not stored internally and are not
-returned by the function @code{frame-parameters}. This means that the
-desktop saving routines will restore the frame from the positive offsets
-obtained by that function.
+ Note also, that positions specified relative to the right/bottom edge
+of a display, workarea or parent frame as well as floating-point offsets
+are stored internally as integer offsets relative to the left/top edge
+of the display, workarea or parent frame edge. They are also returned
+as such by functions like @code{frame-parameters} and restored as such
+by the desktop saving routines.
@vindex top, a frame parameter
@item top
@@ -1523,24 +1567,61 @@ function @code{frame-restack} (@pxref{Raising and
Lowering}).
@subsubsection Size Parameters
@cindex window size on display
- Frame parameters specify frame sizes in character units. On
-graphical displays, the @code{default} face determines the actual
-pixel sizes of these character units (@pxref{Face Attributes}).
+Frame parameters usually specify frame sizes in character units. On
+graphical displays, the @code{default} face determines the actual pixel
+sizes of these character units (@pxref{Face Attributes}).
@table @code
@vindex width, a frame parameter
@item width
-The width of the frame's text area (@pxref{Frame Geometry}), in
-characters. The value can be also a cons cell of the symbol
address@hidden and an integer denoting the width of the text area in
-pixels.
+This parameter specifies the width of the frame. It can be specified as
+in the following ways:
+
address@hidden @asis
address@hidden an integer
+A positive integer specifies the width of the frame's text area
+(@pxref{Frame Geometry}) in characters.
+
address@hidden a cons cell
+If this is a cons cell with the symbol @code{text-pixels} in its
address@hidden, the @sc{cdr} of that cell specifies the width of the frame's
+text area in pixels.
+
address@hidden frame width ratio
address@hidden frame height ratio
address@hidden a floating-point value
+A floating-point number between 0.0 and 1.0 can be used to specify the
+width of a frame via its @dfn{width ratio}---the ratio of its outer
+width (@pxref{Frame Geometry}) to the width of the frame's workarea
+(@pxref{Multiple Terminals}) or its parent frame's (@pxref{Child
+Frames}) native frame. Thus, a value of 0.5 makes the frame occupy half
+of the width of its workarea or parent frame, a value of 1.0 the full
+width. Similarly, the @dfn{height ratio} of a frame is the ratio of its
+outer height to the height of its workarea or its parent's native frame.
+
+Emacs will try to keep the width and height ratio of a child frame
+unaltered if that frame has a address@hidden @code{keep-ratio} parameter
+(@pxref{Frame Interaction Parameters}) and its parent frame is resized.
+
+Since the outer size of a frame is usually unavailable before a frame
+has been made visible, it is generally not advisable to use
+floating-point values when creating decorated frames. Floating-point
+values are more suited to ensure that a child frame always fits within
+the area of its parent frame as, for example, when customizing
address@hidden (@pxref{Choosing Window}) via
address@hidden
address@hidden table
+
+Regardless of how this parameter was specified, functions reporting the
+value of this parameter like @code{frame-parameters} always report the
+width of the frame's text area in characters as an integer rounded, if
+necessary, to a multiple of the frame's default character width. That
+value is also used by the desktop saving routines.
@vindex height, a frame parameter
@item height
-The height of the frame's text area (@pxref{Frame Geometry}), in
-characters. The value can be also a cons cell of the symbol
address@hidden and an integer denoting the height of the text area
-in pixels.
+This parameter specifies the height of the frame. It works just like
address@hidden, except vertically instead of horizontally.
@vindex user-size, a frame parameter
@item user-size
@@ -1551,25 +1632,25 @@ user-position}) does for the position parameters
@code{top} and
@vindex min-width, a frame parameter
@item min-width
-This parameter specifies the minimum native width of the frame
-(@pxref{Frame Geometry}), in characters. Normally, the functions that
+This parameter specifies the minimum native width (@pxref{Frame
+Geometry}) of the frame, in characters. Normally, the functions that
establish a frame's initial width or resize a frame horizontally make
sure that all the frame's windows, vertical scroll bars, fringes,
margins and vertical dividers can be displayed. This parameter, if
address@hidden allows to make a frame narrower than that with the
-consequence that any components that do not fit on the frame will be
-clipped by the window manager.
+consequence that any components that do not fit will be clipped by the
+window manager.
@vindex min-height, a frame parameter
@item min-height
-This parameter specifies the minimum height of the native (@pxref{Frame
-Geometry}), in characters. Normally, the functions that establish a
-frame's initial size or resize a frame make sure that all the frame's
-windows, horizontal scroll bars and dividers, mode and header lines, the
-echo area and the internal menu and tool bar can be displayed. This
-parameter, if address@hidden allows to make a frame smaller than that
-with the consequence that any components that do not fit on the frame
-will be clipped by the window-system or window manager.
+This parameter specifies the minimum native height (@pxref{Frame
+Geometry}) of the frame, in characters. Normally, the functions that
+establish a frame's initial size or resize a frame make sure that all
+the frame's windows, horizontal scroll bars and dividers, mode and
+header lines, the echo area and the internal menu and tool bar can be
+displayed. This parameter, if address@hidden allows to make a frame
+smaller than that with the consequence that any components that do not
+fit will be clipped by the window manager.
@cindex fullboth frames
@cindex fullheight frames
@@ -1623,6 +1704,20 @@ file as, for example
This will give a new frame full height after typing in it @key{F11} for
the first time.
+
address@hidden fit-frame-to-buffer-margins, a frame parameter
address@hidden fit-frame-to-buffer-margins
+This parameter allows to override the value of the option
address@hidden when fitting this frame to the buffer
+of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing
+Windows}).
+
address@hidden fit-frame-to-buffer-sizes, a frame parameter
address@hidden fit-frame-to-buffer-sizes
+This parameter allows to override the value of the option
address@hidden when fitting this frame to the buffer
+of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing
+Windows}).
@end table
@@ -1646,9 +1741,9 @@ Geometry}).
@vindex vertical-scroll-bars, a frame parameter
@item vertical-scroll-bars
-Whether the frame has scroll bars for vertical scrolling, and which side
-of the frame they should be on. The possible values are @code{left},
address@hidden, and @code{nil} for no scroll bars.
+Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical
+scrolling, and which side of the frame they should be on. The possible
+values are @code{left}, @code{right}, and @code{nil} for no scroll bars.
@vindex horizontal-scroll-bars, a frame parameter
@item horizontal-scroll-bars
@@ -1692,30 +1787,40 @@ to not draw bottom dividers.
@vindex menu-bar-lines frame parameter
@item menu-bar-lines
-The number of lines to allocate at the top of the frame for a menu bar.
-The default is one if Menu Bar mode is enabled and zero otherwise.
address@hidden Bars,,,emacs, The GNU Emacs Manual}. For an external menu
-bar, this value remains unchanged even when the menu bar wraps to two or
-more lines. In that case, the @code{menu-bar-size} value returned by
address@hidden (@pxref{Frame Geometry}) allows to derive whether
-the menu bar actually occupies one or more lines.
+The number of lines to allocate at the top of the frame for a menu bar
+(@pxref{Menu Bar}). The default is one if Menu Bar mode is enabled and
+zero otherwise. @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. For an
+external menu bar (@pxref{Frame Layout}), this value remains unchanged
+even when the menu bar wraps to two or more lines. In that case, the
address@hidden value returned by @code{frame-geometry}
+(@pxref{Frame Geometry}) allows to derive whether the menu bar actually
+occupies one or more lines.
@vindex tool-bar-lines frame parameter
@item tool-bar-lines
-The number of lines to use for the tool bar. The default is one if Tool
-Bar mode is enabled and zero otherwise. @xref{Tool Bars,,,emacs, The
-GNU Emacs Manual}. This value may change whenever the tool bar wraps.
+The number of lines to use for the tool bar (@pxref{Tool Bar}). The
+default is one if Tool Bar mode is enabled and zero otherwise.
address@hidden Bars,,,emacs, The GNU Emacs Manual}. This value may change
+whenever the tool bar wraps (@pxref{Frame Layout}).
@vindex tool-bar-position frame parameter
@item tool-bar-position
-The position of the tool bar. Currently only for the GTK tool bar.
-Value can be one of @code{top}, @code{bottom} @code{left}, @code{right}.
-The default is @code{top}.
+The position of the tool bar when Emacs was built with GTK+. Its value
+can be one of @code{top}, @code{bottom} @code{left}, @code{right}. The
+default is @code{top}.
@vindex line-spacing, a frame parameter
@item line-spacing
Additional space to leave below each text line, in pixels (a positive
integer). @xref{Line Height}, for more information.
+
address@hidden no-special-glyphs, a frame parameter
address@hidden no-special-glyphs
+If this is address@hidden, it suppresses the display of any truncation
+and continuation glyphs (@pxref{Truncation}) for all buffers displayed
+by this frame. This is useful to eliminate such glyphs when fitting a
+frame to its buffer via @code{fit-frame-to-buffer} (@pxref{Resizing
+Windows}).
@end table
@@ -1781,15 +1886,115 @@ Frames}.
@item mouse-wheel-frame
If address@hidden, this parameter specifies the frame whose windows will
be scrolled whenever the mouse wheel is scrolled with the mouse pointer
-hovering over this frame (@pxref{Mouse Commands,,, emacs, The GNU Emacs
-Manual}).
+hovering over this frame, see @ref{Mouse Commands,,, emacs, The GNU
+Emacs Manual}.
@vindex no-other-frame, a frame parameter
@item no-other-frame
If this is address@hidden, then this frame is not eligible as candidate
for the functions @code{next-frame}, @code{previous-frame}
-(@pxref{Finding All Frames}) and @code{other-frame} (@pxref{Frame
-Commands,,, emacs, The GNU Emacs Manual}).
+(@pxref{Finding All Frames}) and @code{other-frame}, see @ref{Frame
+Commands,,, emacs, The GNU Emacs Manual}.
+
address@hidden auto-hide-function, a frame parameter
address@hidden auto-hide-function
+When this parameter specifies a function, that function will be called
+instead of the function specified by the variable
address@hidden when quitting the frame's only window
+(@pxref{Quitting Windows}) and there are other frames left.
+
address@hidden minibuffer-exit, a frame parameter
address@hidden minibuffer-exit
+When this parameter is address@hidden, Emacs will by default make this
+frame invisible whenever the minibuffer (@pxref{Minibuffers}) is exited.
+Alternatively, it can specify the functions @code{iconify-frame} and
address@hidden This parameter is useful to make a child frame
+disappear automatically (similar to how Emacs deals with a window) when
+exiting the minibuffer.
+
address@hidden keep-ratio, a frame parameter
address@hidden keep-ratio
+This parameter is currently meaningful for child frames (@pxref{Child
+Frames}) only. If it is address@hidden, then Emacs will try to keep the
+frame's size (width and height) ratios (@pxref{Size Parameters}) as well
+as its left and right position ratios (@pxref{Position Parameters})
+unaltered whenever its parent frame is resized.
+
+If the value of this parameter is @code{nil}, the frame's position and
+size remain unaltered when the parent frame is resized, so the position
+and size ratios may change. If the value of this parameter is @code{t},
+Emacs will try to preserve the frame's size and position ratios, hence
+the frame's size and position relative to its parent frame may change.
+
+More individual control is possible by using a cons cell: In that case
+the frame's width ratio is preserved if the @sc{car} of the cell is
+either @code{t} or @code{width-only}. The height ratio is preserved if
+the @sc{car} of the cell is either @code{t} or @code{height-only}. The
+left position ratio is preserved if the @sc{cdr} of the cell is either
address@hidden or @code{left-only}. The top position ratio is preserved if
+the @sc{cdr} of the cell is either @code{t} or @code{top-only}.
address@hidden table
+
+
address@hidden Mouse Dragging Parameters
address@hidden Mouse Dragging Parameters
address@hidden mouse dragging parameters
address@hidden parameters for resizing frames with the mouse
address@hidden parameters for moving frames with the mouse
+
+The parameters described below provide support for resizing a frame by
+dragging its internal borders with the mouse. They also allow moving a
+frame with the mouse by dragging the header line of its topmost or the
+mode line of its bottommost window.
+
+These parameters are mostly useful for child frames (@pxref{Child
+Frames}) that come without window manager decorations. If necessary,
+they can be used for undecorated top-level frames as well.
+
address@hidden @code
address@hidden drag-internal-border, a frame parameter
address@hidden drag-internal-border
+If address@hidden, the frame can be resized by dragging its internal
+borders, if present, with the mouse.
+
address@hidden drag-with-header-line, a frame parameter
address@hidden drag-with-header-line
+If address@hidden, the frame can be moved with the mouse by dragging the
+header line of its topmost window.
+
address@hidden drag-with-mode-line, a frame parameter
address@hidden drag-with-mode-line
+If address@hidden, the frame can be moved with the mouse by dragging the
+mode line of its bottommost window. Note that such a frame is not
+allowed to have its own minibuffer window.
+
address@hidden snap-width, a frame parameter
address@hidden snap-width
+A frame that is moved with the mouse will ``snap'' at the border(s) of
+the display or its parent frame whenever it is dragged as near to such
+an edge as the number of pixels specified by this parameter.
+
address@hidden top-visible, a frame parameter
address@hidden top-visible
+If this parameter is a number, the top edge of the frame never appears
+above the top edge of its display or parent frame. Moreover, as many
+pixels of the frame as specified by that number will remain visible when
+the frame is moved against any of the remaining edges of its display or
+parent frame. Setting this parameter is useful to guard against
+dragging a child frame with a address@hidden
address@hidden parameter completely out of the area
+of its parent frame.
+
address@hidden bottom-visible, a frame parameter
address@hidden bottom-visible
+If this parameter is a number, the bottom edge of the frame never
+appears below the bottom edge of its display or parent frame. Moreover,
+as many pixels of the frame as specified by that number will remain
+visible when the frame is moved against any of the remaining edges of
+its display or parent frame. Setting this parameter is useful to guard
+against dragging a child frame with a address@hidden
address@hidden parameter completely out of the area of
+its parent frame.
@end table
@@ -1797,9 +2002,9 @@ Commands,,, emacs, The GNU Emacs Manual}).
@subsubsection Window Management Parameters
@cindex window manager interaction, and frame parameters
- The following frame parameters control various aspects of the
-frame's interaction with the window manager. They have no effect on
-text terminals.
+ The following frame parameters control various aspects of the frame's
+interaction with the window manager or window system. They have no
+effect on text terminals.
@table @code
@vindex visibility, a frame parameter
@@ -1908,7 +2113,8 @@ If address@hidden, this means that this is an
@dfn{override redirect}
frame---a frame not handled by window managers under X. Override
redirect frames have no window manager decorations, can be positioned
and resized only via Emacs' positioning and resizing functions and are
-usually drawn on top of all other frames.
+usually drawn on top of all other frames. Setting this parameter has
+no effect on MS-Windows.
@ignore
@vindex parent-id, a frame parameter
@@ -2080,6 +2286,9 @@ The @code{alpha} frame parameter can also be a cons cell
@code{(@var{active} . @var{inactive})}, where @var{active} is the
opacity of the frame when it is selected, and @var{inactive} is the
opacity when it is not selected.
+
+Some window systems do not support the @code{alpha} parameter for child
+frames (@pxref{Child Frames}).
@end table
The following frame parameters are semi-obsolete in that they are
@@ -2824,57 +3033,78 @@ unwanted frames are iconified instead.
@cindex child frames
@cindex parent frames
-On some window-systems the @code{parent-frame} parameter (@pxref{Frame
-Interaction Parameters}) can be used to make a frame a child of the
-frame specified by that parameter. The frame specified by that
-parameter will then be the frame's parent frame as long as the parameter
-is not changed or reset. Technically, this makes the child frame's
-window-system window a child window of the parent frame's window-system
-window.
+Child frames are objects halfway between windows (@pxref{Windows}) and
+``normal'' frames. Like windows, they are attached to an owning frame.
+Unlike windows, they may overlap each other---changing the size or
+position of one child frame does not change the size or position of any
+of its sibling child frames.
+
+ By design, operations to make or modify child frames are implemented
+with the help of frame parameters (@pxref{Frame Parameters}) without any
+specialized functions or customizable variables. Note that child frames
+are meaningful on graphical terminals only.
+
+ To create a new child frame or to convert a normal frame into a child
+frame, set that frame's @code{parent-frame} parameter (@pxref{Frame
+Interaction Parameters}) to that of an already existing frame. The
+frame specified by that parameter will then be the frame's parent frame
+as long as the parameter is not changed or reset. Technically, this
+makes the child frame's window-system window a child window of the
+parent frame's window-system window.
address@hidden top-level frame
address@hidden reparent frame
address@hidden nest frame
The @code{parent-frame} parameter can be changed at any time. Setting
-it to another frame ``reparents'' the child frame. Setting it to
-another child frame makes the frame a ``nested'' child frame. Setting
-it to @code{nil} restores the frame's status as a top-level frame---one
-whose window-system window is a child of its display's root window.
+it to another frame @dfn{reparents} the child frame. Setting it to
+another child frame makes the frame a @dfn{nested} child frame. Setting
+it to @code{nil} restores the frame's status as a @dfn{top-level
+frame}---a frame whose window-system window is a child of its display's
+root window.
Since child frames can be arbitrarily nested, a frame can be both a
child and a parent frame. Also, the relative roles of child and parent
frame may be reversed at any time (though it's usually a good idea to
-keep the size of child frames sufficiently smaller than that of their
+keep the size of a child frame sufficiently smaller than that of its
parent). An error will be signaled for the attempt to make a frame an
ancestor of itself.
- A child frame is clipped at the native edges (@pxref{Frame Geometry})
-of its parent frame---everything outside these edges is invisible. Its
address@hidden and @code{top} parameters specify positions relative to the
-top-left corner of its parent's native frame. When either of the frames
-is resized, the relative position of the child frame remains unaltered.
-Hence, resizing either of these frames can hide or reveal parts of the
-child frame.
+ Most window-systems clip a child frame at the native edges
+(@pxref{Frame Geometry}) of its parent frame---everything outside these
+edges is usually invisible. A child frame's @code{left} and @code{top}
+parameters specify a position relative to the top-left corner of its
+parent's native frame. When the parent frame is resized, this position
+remains conceptually unaltered.
NS builds do not clip child frames at the parent frame's edges,
-allowing them to be positioned so they do not obscure the parent
-frame while still being visible themselves.
+allowing them to be positioned so they do not obscure the parent frame
+while still being visible themselves.
Usually, moving a parent frame moves along all its child frames and
their descendants as well, keeping their relative positions unaltered.
-The hook @code{move-frame-functions} (@pxref{Frame Position}) is run for
-a child frame only when the position of the child frame relative to its
-parent frame changes. When a parent frame is resized, the child frame
-retains its position respective to the left and upper native edges of
-its parent. In this case, the position respective to the lower or right
-native edge of the parent frame is usually lost.
+Note that the hook @code{move-frame-functions} (@pxref{Frame Position})
+is run for a child frame only when the position of the child frame
+relative to its parent frame changes. It is not run for a child frame
+when the position of the parent frame changes.
+
+ When a parent frame is resized, its child frames conceptually retain
+their previous sizes and their positions relative to the left upper
+corner of the parent. This means that a child frame may become
+(partially) invisible when its parent frame shrinks. The parameter
address@hidden (@pxref{Frame Interaction Parameters}) can be used to
+resize and reposition a child frame proportionally whenever its parent
+frame is resized. This may avoid obscuring parts of a frame when its
+parent frame is shrunk.
A visible child frame always appears on top of its parent frame thus
obscuring parts of it, except on NS builds where it may be positioned
-beneath the parent. This is comparable to the window-system window of
-a top-level frame which also always appears on top of its parent
-window---the desktop's root window. When a parent frame is iconified
-or made invisible (@pxref{Visibility of Frames}), its child frames are
-made invisible. When a parent frame is deiconified or made visible,
-its child frames are made visible. When a parent frame is about to be
-deleted, (@pxref{Deleting Frames}) its child frames are recursively
+beneath the parent. This is comparable to the window-system window of a
+top-level frame which also always appears on top of its parent
+window---the desktop's root window. When a parent frame is iconified or
+made invisible (@pxref{Visibility of Frames}), its child frames are made
+invisible. When a parent frame is deiconified or made visible, its
+child frames are made visible. When a parent frame is about to be
+deleted (@pxref{Deleting Frames}), its child frames are recursively
deleted before it.
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
border width will show a one-pixel wide external border. Under all
window-systems, the internal border can be used. In either case, it's
advisable to disable a child frame's window manager decorations with the
address@hidden frame parameter @pxref{Management Parameters}).
address@hidden frame parameter (@pxref{Management Parameters}).
+
+ To resize or move an undecorated child frame with the mouse, special
+frame parameters (@pxref{Mouse Dragging Parameters}) have to be used.
+The internal border of a child frame, if present, can be used to resize
+the frame with the mouse, provided that frame has a address@hidden
address@hidden parameter. If set, the @code{snap-width}
+parameter indicates the number of pixels where the frame @dfn{snaps} at
+the respective edge or corner of its parent frame.
+
+ There are two ways to drag an entire child frame with the mouse: The
address@hidden parameter, if address@hidden, allows to drag
+a frame without minibuffer window (@pxref{Minibuffer Windows}) via the
+mode line area of its bottommost window. The
address@hidden parameter, if address@hidden, allows to
+drag the frame via the header line area of its topmost window.
+
+ In order to give a child frame a draggable header or mode line, the
+window parameters @code{mode-line-format} and @code{header-line-format}
+are handy (@pxref{Window Parameters}). These allow to remove an
+unwanted mode line (when @code{drag-with-header-line} is chosen) and to
+remove mouse-sensitive areas which might interfere with frame dragging.
+
+ To avoid that dragging moves a frame completely out of its parent's
+native frame, something which might happen when the mouse cursor
+overshoots and makes the frame difficult to retrieve once the mouse
+button has been released, it is advisable to set the frame's
address@hidden or @code{bottom-visible} parameter correspondingly.
+
+ The @code{top-visible} parameter specifies the number of pixels at the
+top of the frame that always remain visible within the parent's native
+frame during dragging and should be set when specifying a address@hidden
address@hidden parameter. The @code{bottom-visible}
+parameter specifies the number of pixels at the bottom of the frame that
+always remain visible within the parent's native frame during dragging
+and should be preferred when specifying a address@hidden
address@hidden parameter.
+
+ When a child frame is used for displaying a buffer via
address@hidden (@pxref{Display Action Functions}),
+the frame's @code{auto-hide-function} parameter (@pxref{Frame
+Interaction Parameters}) can be set to a function, in order to
+appropriately deal with the frame when the window displaying the buffer
+shall be quit.
+
+ When a child frame is used during minibuffer interaction, for example,
+to display completions in a separate window, the @code{minibuffer-exit}
+parameter (@pxref{Frame Interaction Parameters}) is useful in order to
+deal with the frame when the minibuffer is exited.
The behavior of child frames deviates from that of top-level frames in
a 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
frame or on some ancestor instead.
@end itemize
- The following two functions may be useful when working with child and
+ The following two functions can be useful when working with child and
parent frames:
@defun frame-parent &optional frame
@@ -2951,6 +3229,12 @@ of @var{descendant}'s parent frame. Both,
@var{ancestor} and
frame.
@end defun
+Note also the function @code{window-largest-empty-rectangle}
+(@pxref{Coordinates and Windows}) which can be used to inscribe a child
+frame in the largest empty area of an existing window. This can be
+useful to avoid that a child frame obscures any text shown in that
+window.
+
@node Mouse Tracking
@section Mouse Tracking
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 0e476b4..f7013da 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
displayed on the buffer's mode line. The value of
@code{header-line-format} specifies the buffer's header line in the same
way. All windows for the same buffer use the same
address@hidden and @code{header-line-format}.
address@hidden and @code{header-line-format} unless a
address@hidden or @code{header-line-format} parameter has been
+specified for that window (@pxref{Window Parameters}).
For efficiency, Emacs does not continuously recompute each window's
mode 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 1f4c378..daa3971 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -283,11 +283,11 @@ character @kbd{a}.
?Q @result{} 81 ?q @result{} 113
@end example
- You can use the same syntax for punctuation characters, but it is
-often a good idea to add a @samp{\} so that the Emacs commands for
-editing Lisp code don't get confused. For example, @samp{?\(} is the
-way to write the open-paren character. If the character is @samp{\},
-you @emph{must} use a second @samp{\} to quote it: @samp{?\\}.
+ You can use the same syntax for punctuation characters. However, if
+the punctuation character has a special syntactic meaning in Lisp, you
+must quote it with a @samp{\}. For example, @samp{?\(} is the way to
+write the open-paren character. Likewise, if the character is
address@hidden, you must use a second @samp{\} to quote it: @samp{?\\}.
@cindex whitespace
@cindex bell character
@@ -336,18 +336,19 @@ escape character; this has nothing to do with the
character @key{ESC}. @samp{\s} is meant for use in character
constants; in string constants, just write the space.
- A backslash is allowed, and harmless, preceding any character without
-a special escape meaning; thus, @samp{?\+} is equivalent to @samp{?+}.
-There is no reason to add a backslash before most characters. However,
-you should add a backslash before any of the characters
address@hidden()\|;'`"#.,} to avoid confusing the Emacs commands for editing
-Lisp code. You can also add a backslash before whitespace characters such as
-space, tab, newline and formfeed. However, it is cleaner to use one of
-the easily readable escape sequences, such as @samp{\t} or @samp{\s},
-instead of an actual whitespace character such as a tab or a space.
-(If you do write backslash followed by a space, you should write
-an extra space after the character constant to separate it from the
-following text.)
+ A backslash is allowed, and harmless, preceding any character
+without a special escape meaning; thus, @samp{?\+} is equivalent to
address@hidden There is no reason to add a backslash before most
+characters. However, you must add a backslash before any of the
+characters @samp{()[]\;"}, and you should add a backslash before any
+of the characters @samp{|'`#.,} to avoid confusing the Emacs commands
+for editing Lisp code. You can also add a backslash before whitespace
+characters such as space, tab, newline and formfeed. However, it is
+cleaner to use one of the easily readable escape sequences, such as
address@hidden or @samp{\s}, instead of an actual whitespace character such
+as a tab or a space. (If you do write backslash followed by a space,
+you should write an extra space after the character constant to
+separate it from the following text.)
@node General Escape Syntax
@subsubsection General Escape Syntax
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index d9b4b74..eb5c2fc 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -752,6 +752,7 @@ The optional argument @var{pixelwise} address@hidden means
to return the
minimum size of @var{window} counted in pixels.
@end defun
+
@node Resizing Windows
@section Resizing Windows
@cindex window resizing
@@ -943,7 +944,8 @@ help of the two options listed next.
@defopt fit-frame-to-buffer-margins
This option can be used to specify margins around frames to be fit by
@code{fit-frame-to-buffer}. Such margins can be useful to avoid, for
-example, that such frames overlap the taskbar.
+example, that the resized frame overlaps the taskbar or parts of its
+parent frame.
It specifies the numbers of pixels to be left free on the left, above,
the 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}
is added to the newly created frame's parameters.
@end defun
address@hidden display-buffer-in-child-frame buffer alist
+This function tries to display @var{buffer} in a child frame
+(@pxref{Child Frames}) of the selected frame, either reusing an existing
+child frame or by making a new one. If @var{alist} has a address@hidden
address@hidden entry, the corresponding value is an alist
+of frame parameters to give the new frame. A @code{parent-frame}
+parameter specifying the selected frame is provided by default. If the
+child frame should be or become the child of another frame, a
+corresponding entry must be added to @var{alist}.
+
+The appearance of child frames is largely dependent on the parameters
+provided via @var{alist}. It is advisable to use at least ratios to
+specify the size (@pxref{Size Parameters}) and the position
+(@pxref{Position Parameters}) of the child frame and to add the
address@hidden in order to make sure that the child frame remains
+visible. For other parameters that should be considered see @ref{Child
+Frames}.
address@hidden defun
+
@defun display-buffer-use-some-frame buffer alist
This function tries to display @var{buffer} by trying to find a
frame that meets a predicate (by default any frame other than the
@@ -3124,12 +3145,17 @@ killed.
The default is to call @code{iconify-frame} (@pxref{Visibility of
Frames}). Alternatively, you may specify either @code{delete-frame}
(@pxref{Deleting Frames}) to remove the frame from its display,
address@hidden to leave the frame unchanged, or any other function that
-can take a frame as its sole argument.
address@hidden to make the frame invisible, @code{ignore}
+to leave the frame unchanged, or any other function that can take a
+frame as its sole argument.
Note that the function specified by this option is called only if the
specified frame contains just one live window and there is at least one
other frame on the same terminal.
+
+For a particular frame, the value specified here may be overridden by
+that frame's @code{auto-hide-function} frame parameter (@pxref{Frame
+Interaction Parameters}).
@end defopt
@@ -4364,13 +4390,12 @@ is off the screen due to horizontal scrolling:
@cindex coordinate, relative to frame
@cindex window position
-This section describes functions that report the position of a window.
-Most of these functions report positions relative to an origin at the
-native position of the window's frame (@pxref{Frame Geometry}). Some
-functions report positions relative to the origin of the display of the
-window's frame. In any case, the origin has the coordinates (0, 0) and
-X and Y coordinates increase rightward and downward
-respectively.
+This section describes functions that report positions of and within a
+window. Most of these functions report positions relative to an origin
+at the native position of the window's frame (@pxref{Frame Geometry}).
+Some functions report positions relative to the origin of the display of
+the window's frame. In any case, the origin has the coordinates (0, 0)
+and X and Y coordinates increase rightward and downward respectively.
For the following functions, X and Y coordinates are reported in
integer character units, i.e., numbers of lines and columns
@@ -4608,6 +4633,49 @@ point in the selected window, it's sufficient to write:
@end example
@end defun
+The following function returns the largest rectangle that can be
+inscribed in a window without covering text displayed in that window.
+
address@hidden window-largest-empty-rectangle &optional window count min-width
min-height positions left
+This function calculates the dimensions of the largest empty rectangle
+that can be inscribed in the specified @var{window}'s text area.
address@hidden must be a live window and defaults to the selected one.
+
+The return value is a triple of the width and the start and end
+y-coordinates of the largest rectangle that can be inscribed into the
+empty space (space not displaying any text) of the text area of
address@hidden No x-coordinates are returned by this function---any such
+rectangle is assumed to end at the right edge of @var{window}'s text
+area. If no empty space can be found, the return value is @code{nil}.
+
+The optional argument @var{count}, if address@hidden, specifies a
+maximum number of rectangles to return. This means that the return
+value is a list of triples specifying rectangles with the largest
+rectangle first. @var{count} can be also a cons cell whose car
+specifies the number of rectangles to return and whose @sc{cdr}, if
address@hidden, states that all rectangles returned must be disjoint.
+
+The optional arguments @var{min-width} and @var{min-height}, if
address@hidden, specify the minimum width and height of any rectangle
+returned.
+
+The optional argument @var{positions}, if address@hidden, is a cons cell
+whose @sc{car} specifies the uppermost and whose @sc{cdr} specifies the
+lowermost pixel position that must be covered by any rectangle returned.
+These positions measure from the start of the text area of @var{window}.
+
+The optional argument @var{left}, if address@hidden, means to return
+values suitable for buffers displaying right to left text. In that
+case, any rectangle returned is assumed to start at the left edge of
address@hidden's text area.
+
+Note that this function has to retrieve the dimensions of each line of
address@hidden's glyph matrix via @code{window-lines-pixel-dimensions}
+(@pxref{Size of Displayed Text}). Hence, this function may also return
address@hidden when the current glyph matrix of @var{window} is not
+up-to-date.
address@hidden defun
+
@node Mouse Window Auto-selection
@section Mouse Window Auto-selection
@@ -4911,37 +4979,45 @@ windows when exiting that function.
The following parameters are currently used by the window management
code:
address@hidden @asis
address@hidden @code{delete-window}
address@hidden @code
address@hidden delete-window
address@hidden delete-window, a window parameter
This parameter affects the execution of @code{delete-window}
(@pxref{Deleting Windows}).
address@hidden @code{delete-other-windows}
address@hidden delete-other-windows
address@hidden delete-other-windows, a window parameter
This parameter affects the execution of @code{delete-other-windows}
(@pxref{Deleting Windows}).
address@hidden @code{no-delete-other-window}
address@hidden no-delete-other-window
address@hidden no-delete-other-window, a window parameter
This parameter marks the window as not deletable by
@code{delete-other-windows} (@pxref{Deleting Windows}).
address@hidden @code{split-window}
address@hidden split-window
address@hidden split-window, a window parameter
This parameter affects the execution of @code{split-window}
(@pxref{Splitting Windows}).
address@hidden @code{other-window}
address@hidden other-window
address@hidden other-window, a window parameter
This parameter affects the execution of @code{other-window}
(@pxref{Cyclic Window Ordering}).
address@hidden @code{no-other-window}
address@hidden no-other-window
address@hidden no-other-window, a window parameter
This parameter marks the window as not selectable by @code{other-window}
(@pxref{Cyclic Window Ordering}).
address@hidden @code{clone-of}
address@hidden clone-of
address@hidden clone-of, a window parameter
This parameter specifies the window that this one has been cloned
from. It is installed by @code{window-state-get} (@pxref{Window
Configurations}).
address@hidden @code{preserved-size}
address@hidden preserved-size
address@hidden preserved-size, a window parameter
This parameter specifies a buffer, a direction where @code{nil} means
vertical and @code{t} horizontal, and a size in pixels. If this window
displays 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
parameter is installed and updated by the function
@code{window-preserve-size} (@pxref{Preserving Window Sizes}).
address@hidden @code{quit-restore}
address@hidden quit-restore
address@hidden quit-restore, a window parameter
This parameter is installed by the buffer display functions
(@pxref{Choosing Window}) and consulted by @code{quit-restore-window}
(@pxref{Quitting Windows}). It contains four elements:
@@ -4981,15 +5058,37 @@ only if it still shows that buffer.
See the description of @code{quit-restore-window} in @ref{Quitting
Windows} for details.
address@hidden @code{window-side} @code{window-slot}
address@hidden window-side window-slot
address@hidden window-side, a window parameter
address@hidden window-slot, a window parameter
These parameters are used for implementing side windows (@pxref{Side
Windows}).
address@hidden @code{window-atom}
address@hidden window-atom
address@hidden window-atom, a window parameter
This parameter is used for implementing atomic windows, see @ref{Atomic
Windows}.
address@hidden @code{min-margins}
address@hidden mode-line-format
address@hidden mode-line-format, a window parameter
+This parameter replaces the value of the buffer-local variable
address@hidden (@pxref{Mode Line Basics}) of this window's
+buffer whenever this window is displayed. The symbol @code{none} means
+to suppress display of a mode line for this window. Display and
+contents of the mode line on other windows showing this buffer are not
+affected.
+
address@hidden header-line-format
address@hidden header-line-format, a window parameter
+This parameter replaces the value of the buffer-local variable
address@hidden (@pxref{Mode Line Basics}) of this window's
+buffer whenever this window is displayed. The symbol @code{none} means
+to suppress display of a header line for this window. Display and
+contents of the header line on other windows showing this buffer are not
+affected.
+
address@hidden min-margins
address@hidden min-margins, a window parameter
The value of this parameter is a cons cell whose @sc{car} and @sc{cdr},
if address@hidden, specify the minimum values (in columns) for the left
and 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 b0cfbc9..069d6b3 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.
@item mm-text-html-renderer
@vindex mm-text-html-renderer
This selects the function used to render @acronym{HTML}. The predefined
-renderers are selected by the symbols @code{gnus-article-html},
+renderers are selected by the symbols @code{shr}, @code{gnus-w3m},
@address@hidden @uref{http://emacs-w3m.namazu.org/} for more
information about emacs-w3m}, @code{links}, @code{lynx},
@code{w3m-standalone} or @code{html2text}. If @code{nil} use an
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index a42dc6e..6209e02 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
@command{ssh}/@command{scp}.
You can find the latest version of this document on the web at
address@hidden://www.gnu.org/software/tramp/}.
address@hidden://www.gnu.org/software/tramp/}.
@ifhtml
The latest release of @value{tramp} is available for
address@hidden://ftp.gnu.org/gnu/tramp/, download}, or you may see
address@hidden://ftp.gnu.org/gnu/tramp/, download}, or you may see
@ref{Obtaining Tramp} for more details, including the Git server
details.
address@hidden also has a @uref{http://savannah.gnu.org/projects/tramp/,
address@hidden also has a @uref{https://savannah.gnu.org/projects/tramp/,
Savannah Project Page}.
@end ifhtml
There is a mailing list for @value{tramp}, available at
@email{tramp-devel@@gnu.org}, and archived at
address@hidden://lists.gnu.org/archive/html/tramp-devel/, the
address@hidden://lists.gnu.org/archive/html/tramp-devel/, the
@value{tramp} Mail Archive}.
@page
@@ -321,7 +321,7 @@ behind the scenes when you open a file with @value{tramp}.
@value{tramp} is included as part of Emacs (since Emacs version 22.1).
@value{tramp} is also freely packaged for download on the Internet at
address@hidden://ftp.gnu.org/gnu/tramp/}.
address@hidden://ftp.gnu.org/gnu/tramp/}.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features.
@@ -331,7 +331,7 @@ page at the following URL and then clicking on the Git link
in the
navigation bar at the top.
@noindent
address@hidden://savannah.gnu.org/projects/tramp/}
address@hidden://savannah.gnu.org/projects/tramp/}
@noindent
Another way is to follow the terminal session below:
@@ -349,7 +349,7 @@ From behind a firewall:
@example
@group
] @strong{git config --global http.proxy
http://user:pwd@@proxy.server.com:8080}
-] @strong{git clone http://git.savannah.gnu.org/r/tramp.git}
+] @strong{git clone https://git.savannah.gnu.org/r/tramp.git}
@end group
@end example
@@ -917,7 +917,7 @@ numbers are not applicable to Android devices connected
through address@hidden
@cindex dbus
GVFS is the virtual file system for the Gnome Desktop,
address@hidden://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are
address@hidden://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are
mounted locally through FUSE and @value{tramp} uses this locally
mounted directory internally.
@@ -1896,12 +1896,16 @@ where @samp{192.168.0.1} is the remote host IP address
@value{tramp} uses the @option{adb} method to access Android devices.
Android devices provide a restricted shell access through an USB
connection. The local host must have the @command{adb} program
-installed.
+installed. Usually, it is sufficient to open the file
address@hidden@trampfn{adb,,/}}. Then you can navigate in the filesystem via
address@hidden
-Applications such as @code{SSHDroid} that run @command{sshd} process
-on the Android device can accept any @option{ssh}-based methods
-provided these settings are adjusted:
+Alternatively, applications such as @code{SSHDroid} that run
address@hidden process on the Android device can accept any
address@hidden methods provided these settings are adjusted:
address@hidden
address@hidden
@command{sh} must be specified for remote shell since Android devices
do not provide @command{/bin/sh}. @command{sh} will then invoke
whatever shell is installed on the device with this setting:
@@ -1917,6 +1921,7 @@ whatever shell is installed on the device with this
setting:
where @samp{192.168.0.26} is the Android device's IP address.
(@pxref{Predefined connection information}).
address@hidden
@value{tramp} requires preserving @env{PATH} environment variable from
user settings. Android devices prefer @file{/system/xbin} path over
@file{/system/bin}. Both of these are set as follows:
@@ -1928,7 +1933,7 @@ user settings. Android devices prefer
@file{/system/xbin} path over
@end group
@end lisp
address@hidden
address@hidden
When the Android device is not @samp{rooted}, specify a writable
directory for temporary files:
@@ -1936,7 +1941,7 @@ directory for temporary files:
(add-to-list 'tramp-remote-process-environment "TMPDIR=$HOME")
@end lisp
address@hidden
address@hidden
Open a remote connection with the command @kbd{C-x C-f
@trampfn{ssh,192.168.0.26#2222,}}, where @command{sshd} is listening
on port @samp{2222}.
@@ -1967,6 +1972,7 @@ the previous example, fix the connection properties as
follows:
@noindent
Open a remote connection with a more concise command @kbd{C-x C-f
@trampfn{ssh,android,}}.
address@hidden itemize
@node Auto-save and Backup
@@ -2083,7 +2089,7 @@ Pseudo-terminal will not be allocated because stdin is
not a terminal.
Some older versions of Cygwin's @command{ssh} work with the
@option{sshx} access method. Consult Cygwin's FAQ at
address@hidden://cygwin.com/faq/} for details.
address@hidden://cygwin.com/faq/} for details.
@cindex Cygwin and fakecygpty
@cindex fakecygpty and Cygwin
@@ -2797,7 +2803,7 @@ this address go to all the subscribers. This is
@emph{not} the
address to send subscription requests to.
To subscribe to the mailing list, visit:
address@hidden://lists.gnu.org/mailman/listinfo/tramp-devel/, the
address@hidden://lists.gnu.org/mailman/listinfo/tramp-devel/, the
@value{tramp} Mail Subscription Page}.
@ifset installchapter
@@ -2849,13 +2855,13 @@ Where is the latest @value{tramp}?
@value{tramp} is available at the GNU URL:
@noindent
address@hidden://ftp.gnu.org/gnu/tramp/}
address@hidden://ftp.gnu.org/gnu/tramp/}
@noindent
@value{tramp}'s GNU project page is located here:
@noindent
address@hidden://savannah.gnu.org/projects/tramp/}
address@hidden://savannah.gnu.org/projects/tramp/}
@item
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index f1cb60b..05b577d 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
address@hidden trampver 2.3.2-pre
address@hidden trampver 2.3.2
@c Other flags from configuration
@set instprefix /usr/local
diff --git a/etc/NEWS b/etc/NEWS
index 78d37484..39c88c6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -129,6 +129,22 @@ given file is on a case-insensitive filesystem.
of curved quotes for 'electric-quote-mode', allowing user to choose
the types of quotes to be used.
+** The new user option 'electric-quote-context-sensitive' makes
+'electric-quote-mode' context sensitive. If it is non-nil, you can
+type an ASCII apostrophe to insert an opening or closing quote,
+depending on context. Emacs will replace the apostrophe by an opening
+quote character at the beginning of the buffer, the beginning of a
+line, after a whitespace character, and after an opening parenthesis;
+and it will replace the apostrophe by a closing quote character in all
+other cases.
+
+** The new variable 'electric-quote-code-faces' controls when to
+disable electric quoting in text modes. Major modes can add faces to
+this list; Emacs will temporarily disable 'electric-quote-mode'
+whenever point is before a character having such a face. This is
+intended for major modes that derive from 'text-mode' but allow inline
+code segments, such as 'markdown-mode'.
+
+++
** The new user variable 'dired-omit-case-fold' allows the user to
customize the case-sensitivity of dired-omit-mode. It defaults to
@@ -320,6 +336,15 @@ questions, with a handy way to display help texts.
all call stack frames in a Lisp backtrace buffer as lists. Both
debug.el and edebug.el have been updated to heed to this variable.
+---
+** Values in call stack frames are now displayed using 'cl-prin1'.
+The old behaviour of using 'prin1' can be restored by customizing the
+new option 'debugger-print-function'.
+
++++
+** NUL bytes in strings copied to the system clipboard are now
+replaced with "\0".
+
+++
** The new variable 'x-ctrl-keysym' has been added to the existing
roster 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
"emacsclient Options" in the user manual for the details.
+++
+** 'describe-key-briefly' now ignores mouse movement events.
+
++++
** The new variable 'eval-expression-print-maximum-character' prevents
large integers from being displayed as characters.
@@ -471,6 +499,12 @@ properties as intact as possible.
* Changes in Specialized Modes and Packages in Emacs 26.1
+** Dired
+You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced
+by the current file name.
+
+*** html2text is now marked obsolete.
+
*** smerge-refine-regions can refine regions in separate buffers
*** Info menu and index completion uses substring completion by default.
@@ -642,6 +676,13 @@ replaced by the real images asynchronously, which will
also now
respect width/height HTML specs (unless they specify widths/heights
bigger than the current window).
+---
+*** The 'w' command on links is now 'shr-maybe-probe-and-copy-url'.
+'shr-copy-url' now only copies the url at point; users who wish to
+avoid accidentally accessing remote links may rebind 'w' and 'u' in
+'eww-link-keymap' to it.
+
+
** Ido
*** The commands 'find-alternate-file-other-window',
@@ -1203,7 +1244,7 @@ run.
frame's outer border.
+++
-*** New frame parameters
+*** New frame parameters and changed semantics for older ones
+++
**** 'z-group' positions a frame above or below all others.
@@ -1248,10 +1289,32 @@ focus via the mouse.
frame.
+++
-*** The 'width' and 'height' frame parameters allow to specify pixel
-values now.
+**** 'width' and 'height' allow to specify pixel values and ratios now.
+
++++
+**** 'left' and 'top' allow to specify ratios now.
+
++++
+**** 'keep-ratio' preserves size and position of child frames when their
+parent frame is resized.
+++
+**** 'no-special-glyphs' suppresses display of truncation and
+continuation glyphs in a frame.
+
++++
+**** 'auto-hide-function' and 'minibuffer-exit' handle auto hiding of
+frames and exiting from minibuffer individually.
+
++++
+**** 'fit-frame-to-buffer-margins' and 'fit-frame-to-buffer-sizes'
+handle fitting a frame to its buffer individually.
+
++++
+**** 'drag-internal-border', 'drag-with-header-line',
+'drag-with-mode-line', 'snap-width', 'top-visible' and 'bottom-visible'
+allow to drag and resize frames with the mouse.
+
*** The new function 'frame-list-z-order' returns a list of all frames
in Z (stacking) order.
@@ -1310,6 +1373,10 @@ a new window when opening man pages when there's already
one, use
its window gets deleted by 'delete-other-windows'.
+++
+*** New window parameters 'mode-line-format' and 'header-line-format'
+allow to override the buffer-local formats for this window.
+
++++
*** New command 'window-swap-states' swaps the states of two live
windows.
@@ -1319,9 +1386,23 @@ windows.
window changed size when 'window-size-change-functions' are run.
+++
+*** The new function 'window-lines-pixel-dimensions' returns the pixel
+dimensions of a window's text lines.
+
++++
+*** The new function 'window-largest-empty-rectangle' returns the
+dimensions of the largest rectangular area not occupying any text in a
+window's body.
+
++++
*** The semantics of 'mouse-autoselect-window' has changed slightly.
For details see the section "Mouse Window Auto-selection" in the Elisp
manual.
+
+---
+** 'tcl-auto-fill-mode' is now declared obsolete. It's functionality
+can be replicated simply by setting 'comment-auto-fill-only-comments'.
+
* Changes in Emacs 26.1 on Non-Free Operating Systems
@@ -1364,7 +1445,7 @@ This is in contrast to the default action on POSIX
Systems, where it
causes the receiving process to terminate with a core dump if no
debugger has been attached to it.
-** `set-mouse-position' and `set-mouse-absolute-pixel-position' work
+** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work
on macOS.
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 51d1819..e77b7c9 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/>. */
#include <config.h>
#include <stddef.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <assert.h>
#include <getopt.h>
+#include <flexmember.h>
+#include <min-max.h>
+#include <unlocked-io.h>
+
/* The SunOS compiler doesn't have SEEK_END. */
#ifndef SEEK_END
#define SEEK_END 2
#endif
-#include <flexmember.h>
-#include <min-max.h>
-
/* Files are read in chunks of this number of bytes. */
enum { READ_CHUNK_SIZE = 100 * 1024 };
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 8828b76..f1d4e89 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -73,7 +73,6 @@ char *w32_getenv (const char *);
#include <stdarg.h>
#include <ctype.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <getopt.h>
@@ -84,6 +83,8 @@ char *w32_getenv (const char *);
#include <signal.h>
#include <errno.h>
+#include <unlocked-io.h>
+
#ifndef VERSION
#define VERSION "unspecified"
#endif
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 6f280d8..e5ff7bd 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";
#include <errno.h>
#include <fcntl.h>
#include <binary-io.h>
+#include <unlocked-io.h>
#include <c-ctype.h>
#include <c-strcase.h>
diff --git a/lib-src/hexl.c b/lib-src/hexl.c
index 319ce8b..d949af0 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/>. */
#include <config.h>
#include <inttypes.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <binary-io.h>
+#include <unlocked-io.h>
static char *progname;
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 9470bd6..6b2cc11 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/>. */
#include <stdarg.h>
#include <stddef.h>
#include <stdint.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <binary-io.h>
+#include <intprops.h>
+#include <min-max.h>
+#include <unlocked-io.h>
+
#ifdef WINDOWSNT
/* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this
is really just insurance. */
@@ -50,10 +54,6 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include <direct.h>
#endif /* WINDOWSNT */
-#include <binary-io.h>
-#include <intprops.h>
-#include <min-max.h>
-
#ifdef DOS_NT
/* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this
is really just insurance.
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index cd12c48..e5ca0b1 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/>. */
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
-#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <time.h>
@@ -69,6 +68,9 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include <fcntl.h>
#include <signal.h>
#include <string.h>
+
+#include <unlocked-io.h>
+
#include "syswait.h"
#ifdef MAIL_USE_POP
#include "pop.h"
diff --git a/lib-src/profile.c b/lib-src/profile.c
index 253f00e..f4ab45c 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/>. */
#include <config.h>
#include <inttypes.h>
-#include <stdio.h>
#include <stdlib.h>
#include <intprops.h>
#include <systime.h>
+#include <unlocked-io.h>
static struct timespec TV1;
static int watch_not_started = 1; /* flag */
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c
index 5edc8e7..942aeeb 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/>. */
#include <limits.h>
#include <string.h>
#include <stdlib.h>
-#include <stdio.h>
#include <time.h>
#include <pwd.h>
#include <ctype.h>
@@ -47,6 +46,8 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include <sys/stat.h>
#include <getopt.h>
+#include <unlocked-io.h>
+
#ifdef WINDOWSNT
#include "ntlib.h"
#endif
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 509089e..fd0f9e5 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -21,7 +21,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# 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 --avo [...]
+# 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 --avo [...]
MOSTLYCLEANFILES += core *.stackdump
@@ -2996,6 +2996,15 @@ EXTRA_DIST += unistd.in.h
endif
## end gnulib module unistd
+## begin gnulib module unlocked-io
+ifeq (,$(OMIT_GNULIB_MODULE_unlocked-io))
+
+
+EXTRA_DIST += unlocked-io.h
+
+endif
+## end gnulib module unlocked-io
+
## begin gnulib module update-copyright
ifeq (,$(OMIT_GNULIB_MODULE_update-copyright))
diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h
new file mode 100644
index 0000000..aaf60a0
--- /dev/null
+++ b/lib/unlocked-io.h
@@ -0,0 +1,136 @@
+/* Prefer faster, non-thread-safe stdio functions if available.
+
+ Copyright (C) 2001-2004, 2009-2017 Free Software Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+/* Written by Jim Meyering. */
+
+#ifndef UNLOCKED_IO_H
+# define UNLOCKED_IO_H 1
+
+/* These are wrappers for functions/macros from the GNU C library, and
+ from other C libraries supporting POSIX's optional thread-safe functions.
+
+ The standard I/O functions are thread-safe. These *_unlocked ones are
+ more efficient but not thread-safe. That they're not thread-safe is
+ fine since all of the applications in this package are single threaded.
+
+ Also, some code that is shared with the GNU C library may invoke
+ the *_unlocked functions directly. On hosts that lack those
+ functions, invoke the non-thread-safe versions instead. */
+
+# include <stdio.h>
+
+# if HAVE_DECL_CLEARERR_UNLOCKED
+# undef clearerr
+# define clearerr(x) clearerr_unlocked (x)
+# else
+# define clearerr_unlocked(x) clearerr (x)
+# endif
+
+# if HAVE_DECL_FEOF_UNLOCKED
+# undef feof
+# define feof(x) feof_unlocked (x)
+# else
+# define feof_unlocked(x) feof (x)
+# endif
+
+# if HAVE_DECL_FERROR_UNLOCKED
+# undef ferror
+# define ferror(x) ferror_unlocked (x)
+# else
+# define ferror_unlocked(x) ferror (x)
+# endif
+
+# if HAVE_DECL_FFLUSH_UNLOCKED
+# undef fflush
+# define fflush(x) fflush_unlocked (x)
+# else
+# define fflush_unlocked(x) fflush (x)
+# endif
+
+# if HAVE_DECL_FGETS_UNLOCKED
+# undef fgets
+# define fgets(x,y,z) fgets_unlocked (x,y,z)
+# else
+# define fgets_unlocked(x,y,z) fgets (x,y,z)
+# endif
+
+# if HAVE_DECL_FPUTC_UNLOCKED
+# undef fputc
+# define fputc(x,y) fputc_unlocked (x,y)
+# else
+# define fputc_unlocked(x,y) fputc (x,y)
+# endif
+
+# if HAVE_DECL_FPUTS_UNLOCKED
+# undef fputs
+# define fputs(x,y) fputs_unlocked (x,y)
+# else
+# define fputs_unlocked(x,y) fputs (x,y)
+# endif
+
+# if HAVE_DECL_FREAD_UNLOCKED
+# undef fread
+# define fread(w,x,y,z) fread_unlocked (w,x,y,z)
+# else
+# define fread_unlocked(w,x,y,z) fread (w,x,y,z)
+# endif
+
+# if HAVE_DECL_FWRITE_UNLOCKED
+# undef fwrite
+# define fwrite(w,x,y,z) fwrite_unlocked (w,x,y,z)
+# else
+# define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z)
+# endif
+
+# if HAVE_DECL_GETC_UNLOCKED
+# undef getc
+# define getc(x) getc_unlocked (x)
+# else
+# define getc_unlocked(x) getc (x)
+# endif
+
+# if HAVE_DECL_GETCHAR_UNLOCKED
+# undef getchar
+# define getchar() getchar_unlocked ()
+# else
+# define getchar_unlocked() getchar ()
+# endif
+
+# if HAVE_DECL_PUTC_UNLOCKED
+# undef putc
+# define putc(x,y) putc_unlocked (x,y)
+# else
+# define putc_unlocked(x,y) putc (x,y)
+# endif
+
+# if HAVE_DECL_PUTCHAR_UNLOCKED
+# undef putchar
+# define putchar(x) putchar_unlocked (x)
+# else
+# define putchar_unlocked(x) putchar (x)
+# endif
+
+# undef flockfile
+# define flockfile(x) ((void) 0)
+
+# undef ftrylockfile
+# define ftrylockfile(x) 0
+
+# undef funlockfile
+# define funlockfile(x) ((void) 0)
+
+#endif /* UNLOCKED_IO_H */
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 7929162..a15386a 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -319,10 +319,12 @@ the list of old buffers.")
(defvar auto-revert-tail-pos 0
"Position of last known end of file.")
+(defun auto-revert-find-file-function ()
+ (setq-local auto-revert-tail-pos
+ (nth 7 (file-attributes buffer-file-name))))
+
(add-hook 'find-file-hook
- (lambda ()
- (setq-local auto-revert-tail-pos
- (nth 7 (file-attributes buffer-file-name)))))
+ #'auto-revert-find-file-function)
(defvar auto-revert-notify-watch-descriptor-hash-list
(make-hash-table :test 'equal)
@@ -341,6 +343,11 @@ This has been reported by a file notification event.")
;; Functions:
+(defun auto-revert-remove-current-buffer ()
+ "Remove dead buffer from `auto-revert-buffer-list'."
+ (setq auto-revert-buffer-list
+ (delq (current-buffer) auto-revert-buffer-list)))
+
;;;###autoload
(define-minor-mode auto-revert-mode
"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."
(push (current-buffer) auto-revert-buffer-list)
(add-hook
'kill-buffer-hook
- (lambda ()
- (setq auto-revert-buffer-list
- (delq (current-buffer) auto-revert-buffer-list)))
+ #'auto-revert-remove-current-buffer
nil t))
(when auto-revert-use-notify (auto-revert-notify-rm-watch))
- (setq auto-revert-buffer-list
- (delq (current-buffer) auto-revert-buffer-list)))
+ (auto-revert-remove-current-buffer))
(auto-revert-set-timer)
(when auto-revert-mode
(auto-revert-buffers)
@@ -786,24 +790,24 @@ the timer when no buffers need to be checked."
(not (and auto-revert-stop-on-user-input
(input-pending-p))))
(let ((buf (car bufs)))
- (if (buffer-live-p buf)
- (with-current-buffer buf
- ;; Test if someone has turned off Auto-Revert Mode in a
- ;; non-standard way, for example by changing major mode.
- (if (and (not auto-revert-mode)
- (not auto-revert-tail-mode)
- (memq buf auto-revert-buffer-list))
- (setq auto-revert-buffer-list
- (delq buf auto-revert-buffer-list)))
- (when (auto-revert-active-p)
- ;; Enable file notification.
- (when (and auto-revert-use-notify
- (not auto-revert-notify-watch-descriptor))
- (auto-revert-notify-add-watch))
- (auto-revert-handler)))
- ;; Remove dead buffer from `auto-revert-buffer-list'.
- (setq auto-revert-buffer-list
- (delq buf auto-revert-buffer-list))))
+ (with-current-buffer buf
+ (if (buffer-live-p buf)
+ (progn
+ ;; Test if someone has turned off Auto-Revert Mode
+ ;; in a non-standard way, for example by changing
+ ;; major mode.
+ (if (and (not auto-revert-mode)
+ (not auto-revert-tail-mode)
+ (memq buf auto-revert-buffer-list))
+ (auto-revert-remove-current-buffer))
+ (when (auto-revert-active-p)
+ ;; Enable file notification.
+ (when (and auto-revert-use-notify
+ (not auto-revert-notify-watch-descriptor))
+ (auto-revert-notify-add-watch))
+ (auto-revert-handler)))
+ ;; Remove dead buffer from `auto-revert-buffer-list'.
+ (auto-revert-remove-current-buffer))))
(setq bufs (cdr bufs)))
(setq auto-revert-remaining-buffers bufs)
;; Check if we should cancel the timer.
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 0e3715e..a8074ea 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."
(forward-char -1))
(insert ";;; Custom units stored by Calc on " (current-time-string) "\n")
(if math-additional-units
- (progn
+ (let (expr)
(insert "(setq math-additional-units '(\n")
- (let ((list math-additional-units))
- (while list
- (insert " (" (symbol-name (car (car list))) " "
- (if (nth 1 (car list))
- (if (stringp (nth 1 (car list)))
- (prin1-to-string (nth 1 (car list)))
- (prin1-to-string (math-format-flat-expr
- (nth 1 (car list)) 0)))
- "nil")
- " "
- (prin1-to-string (nth 2 (car list)))
- ")\n")
- (setq list (cdr list))))
+ (dolist (u math-additional-units)
+ (insert " (" (symbol-name (car u)) " "
+ (if (setq expr (nth 1 u))
+ (if (stringp expr)
+ (prin1-to-string expr)
+ (prin1-to-string (math-format-flat-expr expr 0)))
+ "nil")
+ " "
+ (prin1-to-string (nth 2 u))
+ ")\n"))
(insert "))\n"))
(insert ";;; (no custom units defined)\n"))
(insert ";;; End of custom units\n")
@@ -916,15 +913,13 @@ If COMP or STD is non-nil, put that in the units table
instead."
(defun math-find-base-units-rec (expr pow)
(let ((u (math-check-unit-name expr)))
(cond (u
- (let ((ulist (math-find-base-units u)))
- (while ulist
- (let ((p (* (cdr (car ulist)) pow))
- (old (assq (car (car ulist)) math-fbu-base)))
- (if old
- (setcdr old (+ (cdr old) p))
- (setq math-fbu-base
- (cons (cons (car (car ulist)) p) math-fbu-base))))
- (setq ulist (cdr ulist)))))
+ (dolist (x (math-find-base-units u))
+ (let ((p (* (cdr x) pow))
+ (old (assq (car x) math-fbu-base)))
+ (if old
+ (setcdr old (+ (cdr old) p))
+ (setq math-fbu-base
+ (cons (cons (car x) p) math-fbu-base))))))
((math-scalarp expr))
((and (eq (car expr) '^)
(integerp (nth 2 expr)))
@@ -1377,20 +1372,15 @@ If COMP or STD is non-nil, put that in the units table
instead."
(if (eq pow1 1)
(math-to-standard-units (list '/ n d) nil)
(list '^ (math-to-standard-units (list '/ n d) nil) pow1))
- (let (ud1)
- (setq un (nth 4 un)
- ud (nth 4 ud))
- (while un
- (setq ud1 ud)
- (while ud1
- (and (eq (car (car un)) (car (car ud1)))
- (setq math-try-cancel-units
- (+ math-try-cancel-units
- (- (* (cdr (car un)) pow1)
- (* (cdr (car ud)) pow2)))))
- (setq ud1 (cdr ud1)))
- (setq un (cdr un)))
- nil))))))
+ (setq un (nth 4 un)
+ ud (nth 4 ud))
+ (dolist (x un)
+ (dolist (y ud)
+ (when (eq (car x) (car y))
+ (setq math-try-cancel-units
+ (+ math-try-cancel-units
+ (- (* (cdr x) pow1)
+ (* (cdr (car ud)) pow2))))))))))))
(math-defsimplify ^
(and math-simplifying-units
@@ -1578,9 +1568,8 @@ If COMP or STD is non-nil, put that in the units table
instead."
(insert "Calculator Units Table:\n\n")
(insert "(All definitions are exact unless marked with an asterisk
(*).)\n\n")
(insert "Unit Type Definition
Description\n\n")
- (while uptr
- (setq u (car uptr)
- name (nth 2 u))
+ (dolist (u uptr)
+ (setq name (nth 2 u))
(when (eq (car u) 'm)
(setq std t))
(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."
(insert " (redefined above)")
(unless (nth 1 u)
(insert " (base unit)")))
- (insert "\n")
- (setq uptr (cdr uptr)))
+ (insert "\n"))
(insert "\n\nUnit Prefix Table:\n\n")
(setq uptr math-unit-prefixes)
(while uptr
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 6a6a8ea..6f36bbe 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -413,12 +413,11 @@ relevant to POS."
(multibyte-p enable-multibyte-characters)
(overlays (mapcar (lambda (o) (overlay-properties o))
(overlays-at pos)))
- (char-description (if (not multibyte-p)
+ (char-description (if (< char 128)
(single-key-description char)
- (if (< char 128)
- (single-key-description char)
- (string-to-multibyte
- (char-to-string char)))))
+ (string (if (not multibyte-p)
+ (decode-char 'eight-bit char)
+ char))))
(text-props-desc
(let ((tmp-buf (generate-new-buffer " *text-props*")))
(unwind-protect
@@ -635,7 +634,9 @@ relevant to POS."
("buffer code"
,(if multibyte-p
(encoded-string-description
- (string-as-unibyte (char-to-string char)) nil)
+ (encode-coding-string (char-to-string char)
+ 'emacs-internal)
+ nil)
(format "#x%02X" char)))
("file code"
,@(if multibyte-p
@@ -704,7 +705,6 @@ relevant to POS."
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (set-buffer-multibyte multibyte-p)
(let ((formatter (format "%%%ds:" max-width)))
(dolist (elt item-list)
(when (cadr elt)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index ec07f9b..12a97f8 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.")
(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
+(make-obsolete-variable 'dired-star-subst-regexp nil "26.1")
+(make-obsolete-variable 'dired-quark-subst-regexp nil "26.1")
+
+(defun dired-isolated-string-re (string)
+ "Return a regexp to match STRING isolated.
+Isolated means that STRING is surrounded by spaces or at the beginning/end
+of a string followed/prefixed with an space.
+The regexp capture the preceding blank, STRING and the following blank as
+the groups 1, 2 and 3 respectively."
+ (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
+
+(defun dired--star-or-qmark-p (string match &optional keep)
+ "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
+MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter
+means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
+If optional arg KEEP is non-nil, then preserve the match data. Otherwise,
+this function changes it and saves MATCH as the second match group.
+
+Isolated means that MATCH is surrounded by spaces or at the beginning/end
+of STRING followed/prefixed with an space. A match to `\\=`?\\=`',
+isolated or not, is also valid."
+ (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote
match) "[*?]")))))
+ (when (or (null match) (equal match "?"))
+ (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
+ (cl-some (lambda (x)
+ (funcall (if keep #'string-match-p #'string-match) x string))
+ regexps)))
;;;###autoload
(defun dired-diff (file &optional switches)
@@ -308,7 +335,7 @@ List has a form of (file-name full-file-name
(attribute-list))."
failures)
(setq failures
(dired-bunch-files 10000
- (function dired-check-process)
+ #'dired-check-process
(append
(list operation program)
(unless (or (string-equal new-attribute "")
@@ -512,7 +539,7 @@ with a prefix argument."
;; If the file has numeric backup versions,
;; put on dired-file-version-alist an element of the form
;; (FILENAME . VERSION-NUMBER-LIST)
- (dired-map-dired-file-lines (function dired-collect-file-versions))
+ (dired-map-dired-file-lines #'dired-collect-file-versions)
;; Sort each VERSION-NUMBER-LIST,
;; and remove the versions not to be deleted.
(let ((fval dired-file-version-alist))
@@ -528,7 +555,7 @@ with a prefix argument."
(setq fval (cdr fval))))
;; Look at each file. If it is a numeric backup file,
;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
- (dired-map-dired-file-lines (function dired-trample-file-versions))
+ (dired-map-dired-file-lines #'dired-trample-file-versions)
(message "Cleaning numerical backups...done")))
;;; Subroutines of dired-clean-directory.
@@ -658,13 +685,13 @@ If there is a `*' in COMMAND, surrounded by whitespace,
this runs
COMMAND just once with the entire file list substituted there.
If there is no `*', but there is a `?' in COMMAND, surrounded by
-whitespace, this runs COMMAND on each file individually with the
-file name substituted for `?'.
+whitespace, or a `\\=`?\\=`' this runs COMMAND on each file
+individually with the file name substituted for `?' or `\\=`?\\=`'.
Otherwise, this runs COMMAND on each file individually with the
file name added at the end of COMMAND (separated by a space).
-`*' and `?' when not surrounded by whitespace have no special
+`*' and `?' when not surrounded by whitespace nor `\\=`' have no special
significance for `dired-do-shell-command', and are passed through
normally to the shell, but you must confirm first.
@@ -704,32 +731,40 @@ can be produced by `dired-get-marked-files', for example."
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
- (no-subst (not (string-match-p dired-quark-subst-regexp command)))
- (star (string-match-p "\\*" command))
- (qmark (string-match-p "\\?" command)))
- ;; Get confirmation for wildcards that may have been meant
- ;; to control substitution of a file name or the file name list.
- (if (cond ((not (or on-each no-subst))
- (error "You can not combine `*' and `?' substitution marks"))
- ((and star on-each)
- (y-or-n-p (format-message
- "Confirm--do you mean to use `*' as a wildcard? ")))
- ((and qmark no-subst)
- (y-or-n-p (format-message
- "Confirm--do you mean to use `?' as a wildcard? ")))
- (t))
- (if on-each
- (dired-bunch-files
- (- 10000 (length command))
- (function (lambda (&rest files)
- (dired-run-shell-command
- (dired-shell-stuff-it command files t arg))))
- nil
- file-list)
- ;; execute the shell command
- (dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg))))))
+ (cl-flet ((need-confirm-p
+ (cmd str)
+ (let ((res cmd)
+ (regexp (regexp-quote str)))
+ ;; Drop all ? and * surrounded by spaces and `?`.
+ (while (and (string-match regexp res)
+ (dired--star-or-qmark-p res str))
+ (setq res (replace-match "" t t res 0)))
+ (string-match regexp res))))
+ (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
+ (no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
+ (star (string-match "\\*" command))
+ (qmark (string-match "\\?" command))
+ ;; Get confirmation for wildcards that may have been meant
+ ;; to control substitution of a file name or the file name list.
+ (ok (cond ((not (or on-each no-subst))
+ (error "You can not combine `*' and `?' substitution
marks"))
+ ((need-confirm-p command "*")
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `*' as a wildcard?
")))
+ ((need-confirm-p command "?")
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `?' as a wildcard?
")))
+ (t))))
+ (when ok
+ (if on-each
+ (dired-bunch-files (- 10000 (length command))
+ (lambda (&rest files)
+ (dired-run-shell-command
+ (dired-shell-stuff-it command files t arg)))
+ nil file-list)
+ ;; execute the shell command
+ (dired-run-shell-command
+ (dired-shell-stuff-it command file-list nil arg)))))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
@@ -769,12 +804,10 @@ can be produced by `dired-get-marked-files', for example."
";"
"&"))
(stuff-it
- (if (or (string-match-p dired-star-subst-regexp command)
- (string-match-p dired-quark-subst-regexp command))
+ (if (dired--star-or-qmark-p command nil 'keep)
(lambda (x)
(let ((retval (concat cmd-prefix command)))
- (while (string-match
- "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
+ (while (dired--star-or-qmark-p retval nil)
(setq retval (replace-match x t t retval 2)))
retval))
(lambda (x) (concat cmd-prefix command dired-mark-separator x)))))
@@ -1122,7 +1155,7 @@ Return nil if no change in files."
(let ((files (dired-get-marked-files t arg nil t))
(string (if (eq op-symbol 'compress) "Compress or uncompress"
(capitalize (symbol-name op-symbol)))))
- (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
+ (dired-mark-pop-up nil op-symbol files #'y-or-n-p
(concat string " "
(dired-mark-prompt arg files) "? ")))))
@@ -1190,7 +1223,7 @@ return t; if SYM is q or ESC, return nil."
(defun dired-do-compress (&optional arg)
"Compress or uncompress marked (or next ARG) files."
(interactive "P")
- (dired-map-over-marks-check (function dired-compress) arg 'compress t))
+ (dired-map-over-marks-check #'dired-compress arg 'compress t))
;; Commands for Emacs Lisp files - load and byte compile
@@ -1218,7 +1251,7 @@ return t; if SYM is q or ESC, return nil."
(defun dired-do-byte-compile (&optional arg)
"Byte compile marked (or next ARG) Emacs Lisp files."
(interactive "P")
- (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile
t))
+ (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t))
(defun dired-load ()
;; Return nil for success, offending file name else.
@@ -1235,7 +1268,7 @@ return t; if SYM is q or ESC, return nil."
(defun dired-do-load (&optional arg)
"Load the marked (or next ARG) Emacs Lisp files."
(interactive "P")
- (dired-map-over-marks-check (function dired-load) arg 'load t))
+ (dired-map-over-marks-check #'dired-load arg 'load t))
;;;###autoload
(defun dired-do-redisplay (&optional arg test-for-subdir)
@@ -1308,7 +1341,7 @@ See Info node `(emacs)Subdir switches' for more details."
(defun dired-add-file (filename &optional marker-char)
(dired-fun-in-all-buffers
(file-name-directory filename) (file-name-nondirectory filename)
- (function dired-add-entry) filename marker-char))
+ #'dired-add-entry filename marker-char))
(defvar dired-omit-mode)
(declare-function dired-omit-regexp "dired-x" ())
@@ -1445,7 +1478,7 @@ files matching `dired-omit-regexp'."
(defun dired-remove-file (file)
(dired-fun-in-all-buffers
(file-name-directory file) (file-name-nondirectory file)
- (function dired-remove-entry) file))
+ #'dired-remove-entry file))
(defun dired-remove-entry (file)
(save-excursion
@@ -1459,7 +1492,7 @@ files matching `dired-omit-regexp'."
"Create or update the line for FILE in all Dired buffers it would belong in."
(dired-fun-in-all-buffers (file-name-directory file)
(file-name-nondirectory file)
- (function dired-relist-entry) file))
+ #'dired-relist-entry file))
(defun dired-relist-entry (file)
;; Relist the line for FILE, or just add it if it did not exist.
@@ -1553,7 +1586,7 @@ Special value `always' suppresses confirmation."
(setq from-dir (file-name-as-directory from-dir)
to-dir (file-name-as-directory to-dir))
(dired-fun-in-all-buffers from-dir nil
- (function dired-rename-subdir-1) from-dir to-dir)
+ #'dired-rename-subdir-1 from-dir to-dir)
;; Update visited file name of all affected buffers
(let ((expanded-from-dir (expand-file-name from-dir))
(blist (buffer-list)))
@@ -1788,7 +1821,7 @@ Optional arg HOW-TO determines how to treat the target.
For any other return value, TARGET is treated as a directory."
(or op1 (setq op1 operation))
(let* ((fn-list (dired-get-marked-files nil arg))
- (rfn-list (mapcar (function dired-make-relative) fn-list))
+ (rfn-list (mapcar #'dired-make-relative fn-list))
(dired-one-file ; fluid variable inside dired-create-files
(and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(target-dir (dired-dwim-target-directory))
@@ -1838,10 +1871,9 @@ Optional arg HOW-TO determines how to treat the target.
(if into-dir ; target is a directory
;; This function uses fluid variable target when called
;; inside dired-create-files:
- (function
- (lambda (from)
- (expand-file-name (file-name-nondirectory from) target)))
- (function (lambda (_from) target)))
+ (lambda (from)
+ (expand-file-name (file-name-nondirectory from) target))
+ (lambda (_from) target))
marker-char))))
;; 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.
&optional default)
(dired-mark-pop-up
nil op-symbol files
- (function read-file-name)
+ #'read-file-name
(format prompt (dired-mark-prompt arg files)) dir default))
(defun dired-dwim-target-directory ()
@@ -1985,7 +2017,7 @@ This command copies symbolic links by creating new ones,
similar
to the \"-d\" option for the \"cp\" shell command."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
- (dired-do-create-files 'copy (function dired-copy-file)
+ (dired-do-create-files 'copy #'dired-copy-file
"Copy"
arg dired-keep-marker-copy
nil dired-copy-how-to-fn)))
@@ -2002,7 +2034,7 @@ suggested for the target directory depends on the value of
For relative symlinks, use \\[dired-do-relsymlink]."
(interactive "P")
- (dired-do-create-files 'symlink (function make-symbolic-link)
+ (dired-do-create-files 'symlink #'make-symbolic-link
"Symlink" arg dired-keep-marker-symlink))
;;;###autoload
@@ -2015,7 +2047,7 @@ with the same names that the files currently have. The
default
suggested for the target directory depends on the value of
`dired-dwim-target', which see."
(interactive "P")
- (dired-do-create-files 'hardlink (function dired-hardlink)
+ (dired-do-create-files 'hardlink #'dired-hardlink
"Hardlink" arg dired-keep-marker-hardlink))
(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.
The default suggested for the target directory depends on the value
of `dired-dwim-target', which see."
(interactive "P")
- (dired-do-create-files 'move (function dired-rename-file)
+ (dired-do-create-files 'move #'dired-rename-file
"Move" arg dired-keep-marker-rename "Rename"))
;;;###end dired-cp.el
@@ -2062,37 +2094,35 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to
next,
(regexp-name-constructor
;; Function to construct new filename using REGEXP and NEWNAME:
(if whole-name ; easy (but rare) case
- (function
- (lambda (from)
- (let ((to (dired-string-replace-match regexp from newname))
- ;; must bind help-form directly around call to
- ;; dired-query
- (help-form rename-regexp-help-form))
- (if to
- (and (dired-query 'rename-regexp-query
- operation-prompt
- from
- to)
- to)
- (dired-log "%s: %s did not match regexp %s\n"
- operation from regexp)))))
- ;; not whole-name, replace non-directory part only
- (function
- (lambda (from)
- (let* ((new (dired-string-replace-match
- regexp (file-name-nondirectory from) newname))
- (to (and new ; nil means there was no match
- (expand-file-name new
- (file-name-directory from))))
+ (lambda (from)
+ (let ((to (dired-string-replace-match regexp from newname))
+ ;; must bind help-form directly around call to
+ ;; dired-query
(help-form rename-regexp-help-form))
- (if to
- (and (dired-query 'rename-regexp-query
- operation-prompt
- (dired-make-relative from)
- (dired-make-relative to))
- to)
- (dired-log "%s: %s did not match regexp %s\n"
- operation (file-name-nondirectory from)
regexp)))))))
+ (if to
+ (and (dired-query 'rename-regexp-query
+ operation-prompt
+ from
+ to)
+ to)
+ (dired-log "%s: %s did not match regexp %s\n"
+ operation from regexp))))
+ ;; not whole-name, replace non-directory part only
+ (lambda (from)
+ (let* ((new (dired-string-replace-match
+ regexp (file-name-nondirectory from) newname))
+ (to (and new ; nil means there was no match
+ (expand-file-name new
+ (file-name-directory from))))
+ (help-form rename-regexp-help-form))
+ (if to
+ (and (dired-query 'rename-regexp-query
+ operation-prompt
+ (dired-make-relative from)
+ (dired-make-relative to))
+ to)
+ (dired-log "%s: %s did not match regexp %s\n"
+ operation (file-name-nondirectory from)
regexp))))))
rename-regexp-query)
(dired-create-files
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.
Normally, only the non-directory part of the file name is used and changed."
(interactive (dired-mark-read-regexp "Rename"))
(dired-do-create-files-regexp
- (function dired-rename-file)
+ #'dired-rename-file
"Rename" arg regexp newname whole-name dired-keep-marker-rename))
;;;###autoload
@@ -2140,7 +2170,7 @@ See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "Copy"))
(let ((dired-recursive-copies nil)) ; No recursive copies.
(dired-do-create-files-regexp
- (function dired-copy-file)
+ #'dired-copy-file
(if dired-copy-preserve-time "Copy [-p]" "Copy")
arg regexp newname whole-name dired-keep-marker-copy)))
@@ -2150,7 +2180,7 @@ See function `dired-do-rename-regexp' for more info."
See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "HardLink"))
(dired-do-create-files-regexp
- (function add-name-to-file)
+ #'add-name-to-file
"HardLink" arg regexp newname whole-name dired-keep-marker-hardlink))
;;;###autoload
@@ -2159,7 +2189,7 @@ See function `dired-do-rename-regexp' for more info."
See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "SymLink"))
(dired-do-create-files-regexp
- (function make-symbolic-link)
+ #'make-symbolic-link
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
(defvar rename-non-directory-query)
@@ -2174,39 +2204,38 @@ See function `dired-do-rename-regexp' for more info."
file-creator
operation
(dired-get-marked-files nil arg)
- (function
- (lambda (from)
- (let ((to (concat (file-name-directory from)
- (funcall basename-constructor
- (file-name-nondirectory from)))))
- (and (let ((help-form (format-message "\
+ (lambda (from)
+ (let ((to (concat (file-name-directory from)
+ (funcall basename-constructor
+ (file-name-nondirectory from)))))
+ (and (let ((help-form (format-message "\
Type SPC or `y' to %s one file, DEL or `n' to skip to next,
`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation))))
- (dired-query 'rename-non-directory-query
- (concat operation " `%s' to `%s'")
- (dired-make-relative from)
- (dired-make-relative to)))
- to))))
+ (downcase operation)
+ (downcase operation))))
+ (dired-query 'rename-non-directory-query
+ (concat operation " `%s' to `%s'")
+ (dired-make-relative from)
+ (dired-make-relative to)))
+ to)))
dired-keep-marker-rename)))
(defun dired-rename-non-directory (basename-constructor operation arg)
(dired-create-files-non-directory
- (function dired-rename-file)
+ #'dired-rename-file
basename-constructor operation arg))
;;;###autoload
(defun dired-upcase (&optional arg)
"Rename all marked (or next ARG) files to upper case."
(interactive "P")
- (dired-rename-non-directory (function upcase) "Rename upcase" arg))
+ (dired-rename-non-directory #'upcase "Rename upcase" arg))
;;;###autoload
(defun dired-downcase (&optional arg)
"Rename all marked (or next ARG) files to lower case."
(interactive "P")
- (dired-rename-non-directory (function downcase) "Rename downcase" arg))
+ (dired-rename-non-directory #'downcase "Rename downcase" arg))
;;;###end dired-re.el
@@ -2316,12 +2345,11 @@ This function takes some pains to conform to `ls -lR'
output."
(when real-switches
(let (case-fold-search)
(mapcar
- (function
- (lambda (x)
- (or (eq (null (string-match-p x real-switches))
- (null (string-match-p x dired-actual-switches)))
- (error
- "Can't have dirs with and without -%s switches together" x))))
+ (lambda (x)
+ (or (eq (null (string-match-p x real-switches))
+ (null (string-match-p x dired-actual-switches)))
+ (error
+ "Can't have dirs with and without -%s switches together" x)))
;; all switches that make a difference to dired-get-filename:
'("F" "b"))))))
@@ -2334,9 +2362,9 @@ This function takes some pains to conform to `ls -lR'
output."
;; Keep the alist sorted on buffer position.
(setq dired-subdir-alist
(sort dired-subdir-alist
- (function (lambda (elt1 elt2)
- (> (dired-get-subdir-min elt1)
- (dired-get-subdir-min elt2)))))))
+ (lambda (elt1 elt2)
+ (> (dired-get-subdir-min elt1)
+ (dired-get-subdir-min elt2))))))
(defun dired-kill-tree (dirname &optional remember-marks kill-root)
"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
diff --git a/lisp/dired.el b/lisp/dired.el
index 909735a..0c1f3e4 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.")
(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
(defvar dired-re-exe;; match ls permission string of an executable file
- (mapconcat (function
- (lambda (x)
- (concat dired-re-maybe-mark dired-re-inode-size x)))
+ (mapconcat (lambda (x)
+ (concat dired-re-maybe-mark dired-re-inode-size x))
'("-[-r][-w][xs][-r][-w].[-r][-w]."
"-[-r][-w].[-r][-w][xs][-r][-w]."
"-[-r][-w].[-r][-w].[-r][-w][xst]")
@@ -607,9 +606,9 @@ marked file, return (t FILENAME) instead of (FILENAME)."
(progn ;; no save-excursion, want to move point.
(dired-repeat-over-lines
,arg
- (function (lambda ()
- (if ,show-progress (sit-for 0))
- (setq results (cons ,body results)))))
+ (lambda ()
+ (if ,show-progress (sit-for 0))
+ (setq results (cons ,body results))))
(if (< ,arg 0)
(nreverse results)
results))
@@ -1995,8 +1994,8 @@ Keybindings:
;; Ignore dired-hide-details-* value of invisible text property by default.
(when (eq buffer-invisibility-spec t)
(setq buffer-invisibility-spec (list t)))
- (setq-local revert-buffer-function (function dired-revert))
- (setq-local buffer-stale-function (function dired-buffer-stale-p))
+ (setq-local revert-buffer-function #'dired-revert)
+ (setq-local buffer-stale-function #'dired-buffer-stale-p)
(setq-local page-delimiter "\n\n")
(setq-local dired-directory (or dirname default-directory))
;; 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]."
(interactive "P")
(let ((string
(or (dired-get-subdir)
- (mapconcat (function identity)
+ (mapconcat #'identity
(if arg
(cond ((zerop (prefix-numeric-value arg))
(dired-get-marked-files))
@@ -2971,12 +2970,12 @@ non-empty directories is allowed."
;; lines still to be changed, so the (point) values in L stay valid.
;; Also, for subdirs in natural order, a subdir's files are deleted
;; before the subdir itself - the other way around would not work.
- (let* ((files (mapcar (function car) l))
+ (let* ((files (mapcar #'car l))
(count (length l))
(succ 0)
(trashing (and trash delete-by-moving-to-trash)))
;; canonicalize file list for pop up
- (setq files (nreverse (mapcar (function dired-make-relative) files)))
+ (setq files (nreverse (mapcar #'dired-make-relative files)))
(if (dired-mark-pop-up
" *Deletions*" 'delete files dired-deletion-confirmer
(format "%s %s "
@@ -2999,7 +2998,7 @@ non-empty directories is allowed."
(progress-reporter-update progress-reporter succ)
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
- (function dired-delete-entry) fn))
+ #'dired-delete-entry fn))
(error ;; catch errors from failed deletions
(dired-log "%s\n" err)
(setq failures (cons (car (car l)) failures)))))
@@ -3293,7 +3292,7 @@ this subdir."
(let ((inhibit-read-only t))
(dired-repeat-over-lines
(prefix-numeric-value arg)
- (function (lambda () (delete-char 1) (insert dired-marker-char))))))))
+ (lambda () (delete-char 1) (insert dired-marker-char)))))))
(defun dired-unmark (arg &optional interactive)
"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."
(cdr
(nreverse
(mapcar
- (function (lambda (f) (desktop-file-name (car f) dirname)))
+ (lambda (f) (desktop-file-name (car f) dirname))
dired-subdir-alist)))))
(defun dired-restore-desktop-buffer (_file-name
diff --git a/lisp/electric.el b/lisp/electric.el
index 4078ef8..1564df5 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -443,11 +443,24 @@ quote, left double quote, and right double quote,
respectively."
:version "25.1"
:type 'boolean :safe 'booleanp :group 'electricity)
+(defcustom electric-quote-context-sensitive nil
+ "Non-nil means to replace \\=' with an electric quote depending on context.
+If `electric-quote-context-sensitive' is non-nil, Emacs replaces
+\\=' and \\='\\=' with an opening quote after a line break,
+whitespace, opening parenthesis, or quote and leaves \\=` alone."
+ :version "26.1"
+ :type 'boolean :safe #'booleanp :group 'electricity)
+
+(defvar electric-quote-code-faces ()
+ "List of faces to treat as inline code in `text-mode'.")
+
(defun electric-quote-post-self-insert-function ()
"Function that `electric-quote-mode' adds to `post-self-insert-hook'.
This requotes when a quoting key is typed."
(when (and electric-quote-mode
- (memq last-command-event '(?\' ?\`)))
+ (or (eq last-command-event ?\')
+ (and (not electric-quote-context-sensitive)
+ (eq last-command-event ?\`))))
(let ((start
(if (and comment-start comment-use-syntax)
(when (or electric-quote-comment electric-quote-string)
@@ -462,30 +475,45 @@ This requotes when a quoting key is typed."
(syntax-ppss (1- (point)))))))))
(and electric-quote-paragraph
(derived-mode-p 'text-mode)
+ ;; FIXME: There should be a ‘cl-disjoint’ function.
+ (null (cl-intersection (face-at-point nil 'multiple)
+ electric-quote-code-faces
+ :test #'eq))
+ ;; FIXME: Why is the next form there? It’s never
+ ;; nil.
(or (eq last-command-event ?\`)
(save-excursion (backward-paragraph) (point)))))))
(pcase electric-quote-chars
(`(,q< ,q> ,q<< ,q>>)
(when start
(save-excursion
- (if (eq last-command-event ?\`)
- (cond ((search-backward (string q< ?`) (- (point) 2) t)
- (replace-match (string q<<))
- (when (and electric-pair-mode
- (eq (cdr-safe
- (assq q< electric-pair-text-pairs))
- (char-after)))
- (delete-char 1))
- (setq last-command-event q<<))
- ((search-backward "`" (1- (point)) t)
- (replace-match (string q<))
- (setq last-command-event q<)))
- (cond ((search-backward (string q> ?') (- (point) 2) t)
- (replace-match (string q>>))
- (setq last-command-event q>>))
- ((search-backward "'" (1- (point)) t)
- (replace-match (string q>))
- (setq last-command-event q>)))))))))))
+ (let ((backtick ?\`))
+ (if (or (eq last-command-event ?\`)
+ (and electric-quote-context-sensitive
+ (save-excursion
+ (backward-char)
+ (or (bobp) (bolp)
+ (memq (char-before) (list q< q<<))
+ (memq (char-syntax (char-before))
+ '(?\s ?\())))
+ (setq backtick ?\')))
+ (cond ((search-backward (string q< backtick) (- (point) 2)
t)
+ (replace-match (string q<<))
+ (when (and electric-pair-mode
+ (eq (cdr-safe
+ (assq q< electric-pair-text-pairs))
+ (char-after)))
+ (delete-char 1))
+ (setq last-command-event q<<))
+ ((search-backward (string backtick) (1- (point)) t)
+ (replace-match (string q<))
+ (setq last-command-event q<)))
+ (cond ((search-backward (string q> ?') (- (point) 2) t)
+ (replace-match (string q>>))
+ (setq last-command-event q>>))
+ ((search-backward "'" (1- (point)) t)
+ (replace-match (string q>))
+ (setq last-command-event q>))))))))))))
(put 'electric-quote-post-self-insert-function 'priority 10)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 3852ceb..99df209 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."
;; Random numbers.
+(defun cl--random-time ()
+ (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
+ (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
+ v))
+
+;;;###autoload (autoload 'cl-random-state-p "cl-extra")
+(cl-defstruct (cl--random-state
+ (:copier nil)
+ (:predicate cl-random-state-p)
+ (:constructor nil)
+ (:constructor cl--make-random-state (vec)))
+ (i -1) (j 30) vec)
+
+(defvar cl--random-state (cl--make-random-state (cl--random-time)))
+
;;;###autoload
(defun cl-random (lim &optional state)
"Return a random nonnegative number less than LIM, an integer or float.
Optional second arg STATE is a random-state object."
(or state (setq state cl--random-state))
;; Inspired by "ran3" from Numerical Recipes. Additive congruential method.
- (let ((vec (aref state 3)))
+ (let ((vec (cl--random-state-vec state)))
(if (integerp vec)
(let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1))
- (aset state 3 (setq vec (make-vector 55 nil)))
+ (setf (cl--random-state-vec state)
+ (setq vec (make-vector 55 nil)))
(aset vec 0 j)
(while (> (setq i (% (+ i 21) 55)) 0)
(aset vec i (setq j (prog1 k (setq k (- j k))))))
(while (< (setq i (1+ i)) 200) (cl-random 2 state))))
- (let* ((i (aset state 1 (% (1+ (aref state 1)) 55)))
- (j (aset state 2 (% (1+ (aref state 2)) 55)))
+ (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state)))
+ (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state)))
(n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
(if (integerp lim)
(if (<= lim 512) (% n lim)
@@ -466,17 +482,10 @@ Optional second arg STATE is a random-state object."
(defun cl-make-random-state (&optional state)
"Return a copy of random-state STATE, or of the internal state if omitted.
If STATE is t, return a new state object seeded from the time of day."
- (cond ((null state) (cl-make-random-state cl--random-state))
- ((vectorp state) (copy-tree state t))
- ((integerp state) (vector 'cl--random-state-tag -1 30 state))
- (t (cl-make-random-state (cl--random-time)))))
-
-;;;###autoload
-(defun cl-random-state-p (object)
- "Return t if OBJECT is a random-state object."
- (and (vectorp object) (= (length object) 4)
- (eq (aref object 0) 'cl--random-state-tag)))
-
+ (unless state (setq state cl--random-state))
+ (if (cl-random-state-p state)
+ (copy-tree state t)
+ (cl--make-random-state (if (integerp state) state (cl--random-time)))))
;; Implementation limits.
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 89a71d1..e9ca041 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'."
- `disassemble' to print the disassembly of the code.
- nil to skip printing any details about the code.")
-(defvar cl-print-compiled-button nil
+(defvar cl-print-compiled-button t
"Control how to print byte-compiled functions into buffers.
When the stream is a buffer, make the bytecode part of the output
into a button whose action shows the function's disassembly.")
@@ -105,10 +105,11 @@ into a button whose action shows the function's
disassembly.")
(if args
(prin1 args stream)
(princ "()" stream)))
- (let ((doc (documentation object 'raw)))
- (when doc
- (princ " " stream)
- (prin1 doc stream)))
+ (pcase (help-split-fundoc (documentation object 'raw) object)
+ ;; Drop args which `help-function-arglist' already printed.
+ (`(,_usage . ,(and doc (guard (stringp doc))))
+ (princ " " stream)
+ (prin1 doc stream)))
(let ((inter (interactive-form object)))
(when inter
(princ " " stream)
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 83456fc..2b87825 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."
:group 'debugger
:version "21.1")
+(defcustom debugger-print-function #'cl-prin1
+ "Function used to print values in the debugger backtraces."
+ :type 'function
+ :options '(cl-prin1 prin1)
+ :version "26.1")
+
(defcustom debugger-bury-or-kill 'bury
"What to do with the debugger buffer when exiting `debug'.
The value affects the behavior of operations on any window
@@ -264,6 +270,40 @@ first will be printed into the backtrace buffer."
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
+
+(defun debugger-insert-backtrace (frames do-xrefs)
+ "Format and insert the backtrace FRAMES at point.
+Make functions into cross-reference buttons if DO-XREFS is non-nil."
+ (let ((standard-output (current-buffer))
+ (eval-buffers eval-buffer-list))
+ (require 'help-mode) ; Define `help-function-def' button type.
+ (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
+ (insert (if (plist-get flags :debug-on-exit)
+ "* " " "))
+ (let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
+ (fun-pt (point)))
+ (cond
+ ((and evald (not debugger-stack-frame-as-list))
+ (funcall debugger-print-function fun)
+ (if args (funcall debugger-print-function args) (princ "()")))
+ (t
+ (funcall debugger-print-function (cons fun args))
+ (cl-incf fun-pt)))
+ (when fun-file
+ (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
+ :type 'help-function-def
+ 'help-args (list fun fun-file))))
+ ;; After any frame that uses eval-buffer, insert a line that
+ ;; states the buffer position it's reading at.
+ (when (and eval-buffers (memq fun '(eval-buffer eval-region)))
+ (insert (format " ; Reading at buffer position %d"
+ ;; This will get the wrong result if there are
+ ;; two nested eval-region calls for the same
+ ;; buffer. That's not a very useful case.
+ (with-current-buffer (pop eval-buffers)
+ (point)))))
+ (insert "\n"))))
+
(defun debugger-setup-buffer (args)
"Initialize the `*Backtrace*' buffer for entry to the debugger.
That buffer should be current already."
@@ -271,27 +311,20 @@ That buffer should be current already."
(erase-buffer)
(set-buffer-multibyte t) ;Why was it nil ? -stef
(setq buffer-undo-list t)
- (let ((standard-output (current-buffer))
- (print-escape-newlines t)
- (print-level 8)
- (print-length 50))
- ;; FIXME the debugger could pass a custom callback to mapbacktrace
- ;; instead of manipulating printed results.
- (mapbacktrace #'backtrace--print-frame 'debug))
- (goto-char (point-min))
- (delete-region (point)
- (progn
- (forward-line (if (eq (car args) 'debug)
- ;; Remove debug--implement-debug-on-entry
- ;; and the advice's `apply' frame.
- 3
- 1))
- (point)))
(insert "Debugger entered")
- ;; lambda is for debug-on-call when a function call is next.
- ;; debug is for debug-on-entry function called.
- (let ((pos (point)))
+ (let ((frames (nthcdr
+ ;; Remove debug--implement-debug-on-entry and the
+ ;; advice's `apply' frame.
+ (if (eq (car args) 'debug) 3 1)
+ (backtrace-frames 'debug)))
+ (print-escape-newlines t)
+ (print-escape-control-characters t)
+ (print-level 8)
+ (print-length 50)
+ (pos (point)))
(pcase (car args)
+ ;; lambda is for debug-on-call when a function call is next.
+ ;; debug is for debug-on-entry function called.
((or `lambda `debug)
(insert "--entering a function:\n")
(setq pos (1- (point))))
@@ -300,11 +333,9 @@ That buffer should be current already."
(insert "--returning value: ")
(setq pos (point))
(setq debugger-value (nth 1 args))
- (prin1 debugger-value (current-buffer))
- (insert ?\n)
- (delete-char 1)
- (insert ? )
- (beginning-of-line))
+ (funcall debugger-print-function debugger-value (current-buffer))
+ (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
+ (insert ?\n))
;; Watchpoint triggered.
((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
(insert
@@ -327,7 +358,7 @@ That buffer should be current already."
(`error
(insert "--Lisp error: ")
(setq pos (point))
- (prin1 (nth 1 args) (current-buffer))
+ (funcall debugger-print-function (nth 1 args) (current-buffer))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
@@ -337,98 +368,15 @@ That buffer should be current already."
(_
(insert ": ")
(setq pos (point))
- (prin1 (if (eq (car args) 'nil)
- (cdr args) args)
- (current-buffer))
+ (funcall debugger-print-function
+ (if (eq (car args) 'nil)
+ (cdr args) args)
+ (current-buffer))
(insert ?\n)))
+ (debugger-insert-backtrace frames t)
;; Place point on "stack frame 0" (bug#15101).
- (goto-char pos))
- ;; After any frame that uses eval-buffer,
- ;; insert a line that states the buffer position it's reading at.
- (save-excursion
- (let ((tem eval-buffer-list))
- (while (and tem
- (re-search-forward "^ eval-\\(buffer\\|region\\)(" nil t))
- (end-of-line)
- (insert (format " ; Reading at buffer position %d"
- ;; This will get the wrong result
- ;; if there are two nested eval-region calls
- ;; for the same buffer. That's not a very useful case.
- (with-current-buffer (car tem)
- (point))))
- (pop tem))))
- (debugger-make-xrefs))
-
-(defun debugger-make-xrefs (&optional buffer)
- "Attach cross-references to function names in the `*Backtrace*' buffer."
- (interactive "b")
- (with-current-buffer (or buffer (current-buffer))
- (save-excursion
- (setq buffer (current-buffer))
- (let ((inhibit-read-only t)
- (old-end (point-min)) (new-end (point-min)))
- ;; If we saved an old backtrace, find the common part
- ;; between the new and the old.
- ;; Compare line by line, starting from the end,
- ;; because that's the part that is likely to be unchanged.
- (if debugger-previous-backtrace
- (let (old-start new-start (all-match t))
- (goto-char (point-max))
- (with-temp-buffer
- (insert debugger-previous-backtrace)
- (while (and all-match (not (bobp)))
- (setq old-end (point))
- (forward-line -1)
- (setq old-start (point))
- (with-current-buffer buffer
- (setq new-end (point))
- (forward-line -1)
- (setq new-start (point)))
- (if (not (zerop
- (let ((case-fold-search nil))
- (compare-buffer-substrings
- (current-buffer) old-start old-end
- buffer new-start new-end))))
- (setq all-match nil))))
- ;; Now new-end is the position of the start of the
- ;; unchanged part in the current buffer, and old-end is
- ;; the position of that same text in the saved old
- ;; backtrace. But we must subtract (point-min) since strings are
- ;; indexed in origin 0.
-
- ;; Replace the unchanged part of the backtrace
- ;; with the text from debugger-previous-backtrace,
- ;; since that already has the proper xrefs.
- ;; With this optimization, we only need to scan
- ;; the changed part of the backtrace.
- (delete-region new-end (point-max))
- (goto-char (point-max))
- (insert (substring debugger-previous-backtrace
- (- old-end (point-min))))
- ;; Make the unchanged part of the backtrace inaccessible
- ;; so it won't be scanned.
- (narrow-to-region (point-min) new-end)))
-
- ;; Scan the new part of the backtrace, inserting xrefs.
- (goto-char (point-min))
- (while (progn
- (goto-char (+ (point) 2))
- (skip-syntax-forward "^w_")
- (not (eobp)))
- (let* ((beg (point))
- (end (progn (skip-syntax-forward "w_") (point)))
- (sym (intern-soft (buffer-substring-no-properties
- beg end)))
- (file (and sym (symbol-file sym 'defun))))
- (when file
- (goto-char beg)
- ;; help-xref-button needs to operate on something matched
- ;; by a regexp, so set that up for it.
- (re-search-forward "\\(\\sw\\|\\s_\\)+")
- (help-xref-button 0 'help-function-def sym file)))
- (forward-line 1))
- (widen))
- (setq debugger-previous-backtrace (buffer-string)))))
+ (goto-char pos)))
+
(defun debugger-step-through ()
"Proceed, stepping through subexpressions of this expression.
@@ -866,9 +814,13 @@ To specify a nil argument interactively, exit with an
empty minibuffer."
'type 'help-function
'help-args (list fun))
(terpri))
- (terpri)
- (princ "Note: if you have redefined a function, then it may no
longer\n")
- (princ "be set to debug on entry, even if it is in the list."))))))
+ ;; Now that debug--function-list uses advice-member-p, its
+ ;; output should be reliable (except for bugs and the exceptional
+ ;; case where some other advice ends up overriding ours).
+ ;;(terpri)
+ ;;(princ "Note: if you have redefined a function, then it may no
longer\n")
+ ;;(princ "be set to debug on entry, even if it is in the list.")
+ )))))
(defun debug--implement-debug-watch (symbol newval op where)
"Conditionally call the debugger.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index dfe1c06..9d618e1 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:
(progn
;; Arrange for field access not to bother checking if the access is indeed
;; made to an eieio--class object.
- (cl-declaim (optimize (safety 0)))
+ (eval-when-compile (cl-declaim (optimize (safety 0))))
(cl-defstruct (eieio--class
(:constructor nil)
@@ -103,8 +103,12 @@ Currently under control of this var:
options ;; storage location of tagged class option
; Stored outright without modifications or stripping
)
- ;; Set it back to the default value.
- (cl-declaim (optimize (safety 1))))
+ ;; Set it back to the default value. NOTE: Using the default
+ ;; `safety' value does NOT give the default
+ ;; `byte-compile-delete-errors' value. Therefore limit this (and
+ ;; the above `cl-declaim') to compile time so that we don't affect
+ ;; code which only loads this library.
+ (eval-when-compile (cl-declaim (optimize (safety 1)))))
(eval-and-compile
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 2c49a63..eb2b2e3 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."
(cl-defstruct (ert-test-aborted-with-non-local-exit
(:include ert-test-result)))
-
-(defun ert--record-backtrace ()
- "Record the current backtrace (as a list) and return it."
- ;; Since the backtrace is stored in the result object, result
- ;; objects must only be printed with appropriate limits
- ;; (`print-level' and `print-length') in place. For interactive
- ;; use, the cost of ensuring this possibly outweighs the advantage
- ;; of storing the backtrace for
- ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
- ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
- ;; For batch use, however, printing the backtrace may be useful.
- (cl-loop
- ;; 6 is the number of frames our own debugger adds (when
- ;; compiled; more when interpreted). FIXME: Need to describe a
- ;; procedure for determining this constant.
- for i from 6
- for frame = (backtrace-frame i)
- while frame
- collect frame))
-
-(defun ert--print-backtrace (backtrace)
+(defun ert--print-backtrace (backtrace do-xrefs)
"Format the backtrace BACKTRACE to the current buffer."
- ;; This is essentially a reimplementation of Fbacktrace
- ;; (src/eval.c), but for a saved backtrace, not the current one.
(let ((print-escape-newlines t)
(print-level 8)
(print-length 50))
- (dolist (frame backtrace)
- (pcase-exhaustive frame
- (`(nil ,special-operator . ,arg-forms)
- ;; Special operator.
- (insert
- (format " %S\n" (cons special-operator arg-forms))))
- (`(t ,fn . ,args)
- ;; Function call.
- (insert (format " %S(" fn))
- (cl-loop for firstp = t then nil
- for arg in args do
- (unless firstp
- (insert " "))
- (insert (format "%S" arg)))
- (insert ")\n"))))))
+ (debugger-insert-backtrace backtrace do-xrefs)))
;; A container for the state of the execution of a single test and
;; environment data needed during its execution.
@@ -750,7 +714,19 @@ run. ARGS are the arguments to `debugger'."
((quit) 'quit)
((ert-test-skipped) 'skipped)
(otherwise 'failed)))
- (backtrace (ert--record-backtrace))
+ ;; We store the backtrace in the result object for
+ ;; `ert-results-pop-to-backtrace-for-test-at-point'.
+ ;; This means we have to limit `print-level' and
+ ;; `print-length' when printing result objects. That
+ ;; might not be worth while when we can also use
+ ;; `ert-results-rerun-test-debugging-errors-at-point',
+ ;; (i.e., when running interactively) but having the
+ ;; backtrace ready for printing is important for batch
+ ;; use.
+ ;;
+ ;; Grab the frames starting from `signal', frames below
+ ;; that are all from the debugger.
+ (backtrace (backtrace-frames 'signal))
(infos (reverse ert--infos)))
(setf (ert--test-execution-info-result info)
(cl-ecase type
@@ -1409,8 +1385,9 @@ Returns the stats object."
(ert-test-result-with-condition
(message "Test %S backtrace:" (ert-test-name test))
(with-temp-buffer
- (ert--print-backtrace
(ert-test-result-with-condition-backtrace
- result))
+ (ert--print-backtrace
+ (ert-test-result-with-condition-backtrace result)
+ nil)
(goto-char (point-min))
(while (not (eobp))
(let ((start (point))
@@ -1491,7 +1468,7 @@ this exits Emacs, with status as per
`ert-run-tests-batch-and-exit'."
(with-temp-buffer
(while (setq logfile (pop command-line-args-left))
(erase-buffer)
- (insert-file-contents logfile)
+ (when (file-readable-p logfile) (insert-file-contents logfile))
(if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t))
(push logfile notests)
(setq ntests (+ ntests (string-to-number (match-string 1))))
@@ -1828,12 +1805,23 @@ EWOC and STATS are arguments for
`ert--results-update-stats-display'."
BEGIN and END specify a region in the current buffer."
(save-excursion
- (save-restriction
- (narrow-to-region begin end)
- ;; Inhibit optimization in `debugger-make-xrefs' that would
- ;; sometimes insert unrelated backtrace info into our buffer.
- (let ((debugger-previous-backtrace nil))
- (debugger-make-xrefs)))))
+ (goto-char begin)
+ (while (progn
+ (goto-char (+ (point) 2))
+ (skip-syntax-forward "^w_")
+ (< (point) end))
+ (let* ((beg (point))
+ (end (progn (skip-syntax-forward "w_") (point)))
+ (sym (intern-soft (buffer-substring-no-properties
+ beg end)))
+ (file (and sym (symbol-file sym 'defun))))
+ (when file
+ (goto-char beg)
+ ;; help-xref-button needs to operate on something matched
+ ;; by a regexp, so set that up for it.
+ (re-search-forward "\\(\\sw\\|\\s_\\)+")
+ (help-xref-button 0 'help-function-def sym file)))
+ (forward-line 1))))
(defun ert--string-first-line (s)
"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."
;; Use unibyte because `debugger-setup-buffer' also does so.
(set-buffer-multibyte nil)
(setq truncate-lines t)
- (ert--print-backtrace backtrace)
- (debugger-make-xrefs)
+ (ert--print-backtrace backtrace t)
(goto-char (point-min))
(insert (substitute-command-keys "Backtrace for test `"))
(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 fc3caf3..a1c5b69 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\")"
(start (point))
(end (line-end-position)))
;; Cope with multi-line copyright `lines'. Assume the second
- ;; line is indented (with the same commenting style).
+ ;; line is indented at least as much as the original, with the
+ ;; same commenting style.
(save-excursion
(beginning-of-line 2)
- (let ((str (concat (match-string-no-properties 1) "[ \t]+")))
+ (let ((str (match-string-no-properties 1)))
(beginning-of-line)
- (while (looking-at str)
+ (while (and (looking-at str) (not (looking-at lm-copyright-prefix)))
(setq end (line-end-position))
(beginning-of-line 2))))
;; Make a single line and parse that.
diff --git a/lisp/epg.el b/lisp/epg.el
index 587271b..1e24b8d 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1047,7 +1047,7 @@ callback data (if any)."
(defun epg--status-TRUST_MARGINAL (context _string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if (and signature
- (eq (epg-signature-status signature) 'marginal))
+ (eq (epg-signature-status signature) 'good))
(setf (epg-signature-validity signature) 'marginal))))
(defun epg--status-TRUST_FULLY (context _string)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 86e7b83..2434220 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."
;; command invocation
+(declare-function help-fns-function-description-header "help-fns")
+
(defun eshell/which (command &rest names)
"Identify the COMMAND, and where it is located."
(dolist (name (cons command names))
@@ -1164,25 +1166,17 @@ be finished later after the completion of an
asynchronous subprocess."
(concat name " is an alias, defined as \""
(cadr alias) "\"")))
(unless program
- (setq program (eshell-search-path name))
- (let* ((esym (eshell-find-alias-function name))
- (sym (or esym (intern-soft name))))
- (if (and (or esym (and sym (fboundp sym)))
- (or eshell-prefer-lisp-functions (not direct)))
- (let ((desc (let ((inhibit-redisplay t))
- (save-window-excursion
- (prog1
- (describe-function sym)
- (message nil))))))
- (setq desc (if desc (substring desc 0
- (1- (or (string-match "\n" desc)
- (length desc))))
- ;; This should not happen.
- (format "%s is defined, \
-but no documentation was found" name)))
- (if (buffer-live-p (get-buffer "*Help*"))
- (kill-buffer "*Help*"))
- (setq program (or desc name))))))
+ (setq program
+ (let* ((esym (eshell-find-alias-function name))
+ (sym (or esym (intern-soft name))))
+ (if (and (or esym (and sym (fboundp sym)))
+ (or eshell-prefer-lisp-functions (not direct)))
+ (or (with-output-to-string
+ (require 'help-fns)
+ (princ (format "%s is " sym))
+ (help-fns-function-description-header sym))
+ name)
+ (eshell-search-path name)))))
(if (not program)
(eshell-error (format "which: no %s in (%s)\n"
name (getenv "PATH")))
diff --git a/lisp/frame.el b/lisp/frame.el
index b7a5516..b54df6f 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1110,6 +1110,38 @@ differing font heights."
If FRAME is omitted, describe the currently selected frame."
(cdr (assq 'width (frame-parameters frame))))
+(defalias 'frame-border-width 'frame-internal-border-width)
+(defalias 'frame-pixel-width 'frame-native-width)
+(defalias 'frame-pixel-height 'frame-native-height)
+
+(defun frame-inner-width (&optional frame)
+ "Return inner width of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (- (frame-native-width frame)
+ (* 2 (frame-internal-border-width frame))))
+
+(defun frame-inner-height (&optional frame)
+ "Return inner height of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (- (frame-native-height frame)
+ (* 2 (frame-internal-border-width frame))))
+
+(defun frame-outer-width (&optional frame)
+ "Return outer width of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (let ((edges (frame-edges frame 'outer-edges)))
+ (- (nth 2 edges) (nth 0 edges))))
+
+(defun frame-outer-height (&optional frame)
+ "Return outer height of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (let ((edges (frame-edges frame 'outer-edges)))
+ (- (nth 3 edges) (nth 1 edges))))
+
(declare-function x-list-fonts "xfaces.c"
(pattern &optional face frame maximum width))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 2c635ff..32324ae 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -560,8 +560,9 @@ FILE is the file where FUNCTION was probably defined."
(setq short rel))))
short))
-;;;###autoload
-(defun describe-function-1 (function)
+(defun help-fns--analyse-function (function)
+ "Return information about FUNCTION.
+Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(let* ((advised (and (symbolp function)
(featurep 'nadvice)
(advice--p (advice--symbol-function function))))
@@ -594,22 +595,24 @@ FILE is the file where FUNCTION was probably defined."
(setq f (symbol-function f)))
f))
((subrp def) (intern (subr-name def)))
- (t def)))
- (sig-key (if (subrp def)
- (indirect-function real-def)
- real-def))
- (file-name (find-lisp-object-file-name function (if aliased 'defun
- def)))
- (pt1 (with-current-buffer (help-buffer) (point)))
- (beg (if (and (or (byte-code-function-p def)
- (keymapp def)
- (memq (car-safe def) '(macro lambda closure)))
- (stringp file-name)
- (help-fns--autoloaded-p function file-name))
- (if (commandp def)
- "an interactive autoloaded "
- "an autoloaded ")
- (if (commandp def) "an interactive " "a "))))
+ (t def))))
+ (list real-function def aliased real-def)))
+
+(defun help-fns-function-description-header (function)
+ "Print a line describing FUNCTION to `standard-output'."
+ (pcase-let* ((`(,_real-function ,def ,aliased ,real-def)
+ (help-fns--analyse-function function))
+ (file-name (find-lisp-object-file-name function (if aliased
'defun
+ def)))
+ (beg (if (and (or (byte-code-function-p def)
+ (keymapp def)
+ (memq (car-safe def) '(macro lambda closure)))
+ (stringp file-name)
+ (help-fns--autoloaded-p function file-name))
+ (if (commandp def)
+ "an interactive autoloaded "
+ "an autoloaded ")
+ (if (commandp def) "an interactive " "a "))))
;; Print what kind of function-like object FUNCTION is.
(princ (cond ((or (stringp def) (vectorp def))
@@ -676,34 +679,42 @@ FILE is the file where FUNCTION was probably defined."
(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
(help-xref-button 1 'help-function-def function file-name))))
- (princ ".")
- (with-current-buffer (help-buffer)
- (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line
0) (point))
- (point)))
- (terpri)(terpri)
-
- (let ((doc-raw (documentation function t))
- (key-bindings-buffer (current-buffer)))
-
- ;; If the function is autoloaded, and its docstring has
- ;; key substitution constructs, load the library.
- (and (autoloadp real-def) doc-raw
- help-enable-auto-load
- (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
- (autoload-do-load real-def))
-
- (help-fns--key-bindings function)
- (with-current-buffer standard-output
- (let ((doc (help-fns--signature function doc-raw sig-key
- real-function key-bindings-buffer)))
- (run-hook-with-args 'help-fns-describe-function-functions function)
- (insert "\n"
- (or doc "Not documented."))
- ;; Avoid asking the user annoying questions if she decides
- ;; to save the help buffer, when her locale's codeset
- ;; isn't UTF-8.
- (unless (memq text-quoting-style '(straight grave))
- (set-buffer-file-coding-system 'utf-8))))))))
+ (princ "."))))
+
+;;;###autoload
+(defun describe-function-1 (function)
+ (let ((pt1 (with-current-buffer (help-buffer) (point))))
+ (help-fns-function-description-header function)
+ (with-current-buffer (help-buffer)
+ (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line
0) (point))
+ (point))))
+ (terpri)(terpri)
+
+ (pcase-let ((`(,real-function ,def ,_aliased ,real-def)
+ (help-fns--analyse-function function))
+ (doc-raw (documentation function t))
+ (key-bindings-buffer (current-buffer)))
+
+ ;; If the function is autoloaded, and its docstring has
+ ;; key substitution constructs, load the library.
+ (and (autoloadp real-def) doc-raw
+ help-enable-auto-load
+ (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
+ (autoload-do-load real-def))
+
+ (help-fns--key-bindings function)
+ (with-current-buffer standard-output
+ (let ((doc (help-fns--signature
+ function doc-raw
+ (if (subrp def) (indirect-function real-def) real-def)
+ real-function key-bindings-buffer)))
+ (run-hook-with-args 'help-fns-describe-function-functions function)
+ (insert "\n" (or doc "Not documented.")))
+ ;; Avoid asking the user annoying questions if she decides
+ ;; to save the help buffer, when her locale's codeset
+ ;; isn't UTF-8.
+ (unless (memq text-quoting-style '(straight grave))
+ (set-buffer-file-coding-system 'utf-8)))))
;; Add defaults to `help-fns-describe-function-functions'.
(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
diff --git a/lisp/help.el b/lisp/help.el
index 361ab2a..0fb1c2d 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."
string
(format "%s (translated from %s)" string otherstring))))))
+(defun help--analyze-key (key untranslated)
+ "Get information about KEY its corresponding UNTRANSLATED events.
+Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)."
+ (if (numberp untranslated)
+ (setq untranslated (this-single-command-raw-keys)))
+ (let* ((event (aref key (if (and (symbolp (aref key 0))
+ (> (length key) 1)
+ (consp (aref key 1)))
+ 1
+ 0)))
+ (modifiers (event-modifiers event))
+ (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
+ (memq 'drag modifiers)) " at that spot" ""))
+ (defn (key-binding key t)))
+ ;; Handle the case where we faked an entry in "Select and Paste" menu.
+ (when (and (eq defn nil)
+ (stringp (aref key (1- (length key))))
+ (eq (key-binding (substring key 0 -1)) 'yank-menu))
+ (setq defn 'menu-bar-select-yank))
+ ;; Don't bother user with strings from (e.g.) the select-paste menu.
+ (when (stringp (aref key (1- (length key))))
+ (aset key (1- (length key)) "(any string)"))
+ (when (and untranslated
+ (stringp (aref untranslated (1- (length untranslated)))))
+ (aset untranslated (1- (length untranslated)) "(any string)"))
+ (list
+ ;; Now describe the key, perhaps as changed.
+ (let ((key-desc (help-key-description key untranslated)))
+ (if (or (null defn) (integerp defn) (equal defn 'undefined))
+ (format "%s%s is undefined" key-desc mouse-msg)
+ (format "%s%s runs the command %S" key-desc mouse-msg defn)))
+ defn event mouse-msg)))
+
(defun describe-key-briefly (&optional key insert untranslated)
"Print the name of the function KEY invokes. KEY is a string.
If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
@@ -603,73 +636,12 @@ the last key hit are used.
If KEY is a menu item or a tool-bar button that is disabled, this command
temporarily enables it to allow getting help on disabled items and buttons."
(interactive
- (let ((enable-disabled-menus-and-buttons t)
- (cursor-in-echo-area t)
- saved-yank-menu)
- (unwind-protect
- (let (key)
- ;; If yank-menu is empty, populate it temporarily, so that
- ;; "Select and Paste" menu can generate a complete event.
- (when (null (cdr yank-menu))
- (setq saved-yank-menu (copy-sequence yank-menu))
- (menu-bar-update-yank-menu "(any string)" nil))
- (while
- (progn
- (setq key (read-key-sequence "Describe the following key,
mouse click, or menu item: "))
- (and (vectorp key)
- (consp (aref key 0))
- (symbolp (car (aref key 0)))
- (string-match "\\(mouse\\|down\\|click\\|drag\\)"
- (symbol-name (car (aref key 0))))
- (not (sit-for (/ double-click-time 1000.0) t)))))
- ;; Clear the echo area message (Bug#7014).
- (message nil)
- ;; If KEY is a down-event, read and discard the
- ;; corresponding up-event. Note that there are also
- ;; down-events on scroll bars and mode lines: the actual
- ;; event then is in the second element of the vector.
- (and (vectorp key)
- (let ((last-idx (1- (length key))))
- (and (eventp (aref key last-idx))
- (memq 'down (event-modifiers (aref key last-idx)))))
- (read-event))
- (list
- key
- (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
- 1))
- ;; Put yank-menu back as it was, if we changed it.
- (when saved-yank-menu
- (setq yank-menu (copy-sequence saved-yank-menu))
- (fset 'yank-menu (cons 'keymap yank-menu))))))
- (if (numberp untranslated)
- (setq untranslated (this-single-command-raw-keys)))
- (let* ((event (if (and (symbolp (aref key 0))
- (> (length key) 1)
- (consp (aref key 1)))
- (aref key 1)
- (aref key 0)))
- (modifiers (event-modifiers event))
- (standard-output (if insert (current-buffer) standard-output))
- (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
- (memq 'drag modifiers)) " at that spot" ""))
- (defn (key-binding key t))
- key-desc)
- ;; Handle the case where we faked an entry in "Select and Paste" menu.
- (if (and (eq defn nil)
- (stringp (aref key (1- (length key))))
- (eq (key-binding (substring key 0 -1)) 'yank-menu))
- (setq defn 'menu-bar-select-yank))
- ;; Don't bother user with strings from (e.g.) the select-paste menu.
- (if (stringp (aref key (1- (length key))))
- (aset key (1- (length key)) "(any string)"))
- (if (and (> (length untranslated) 0)
- (stringp (aref untranslated (1- (length untranslated)))))
- (aset untranslated (1- (length untranslated)) "(any string)"))
- ;; Now describe the key, perhaps as changed.
- (setq key-desc (help-key-description key untranslated))
- (if (or (null defn) (integerp defn) (equal defn 'undefined))
- (princ (format "%s%s is undefined" key-desc mouse-msg))
- (princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
+ ;; Ignore mouse movement events because it's too easy to miss the
+ ;; message while moving the mouse.
+ (pcase-let ((`(,key ,_up-event) (help-read-key-sequence
'no-mouse-movement)))
+ `(,key ,current-prefix-arg 1)))
+ (princ (car (help--analyze-key key untranslated))
+ (if insert (current-buffer) standard-output)))
(defun help--key-binding-keymap (key &optional accept-default no-remap
position)
"Return a keymap holding a binding for KEY within current keymaps.
@@ -734,6 +706,59 @@ function `key-binding'."
(throw 'found x))))
nil)))))
+(defun help-read-key-sequence (&optional no-mouse-movement)
+ "Reads a key sequence from the user.
+Returns a list of the form (KEY UP-EVENT), where KEY is the key
+sequence, and UP-EVENT is the up-event that was discarded by
+reading KEY, or nil.
+If NO-MOUSE-MOVEMENT is non-nil, ignore key sequences starting
+with `mouse-movement' events."
+ (let ((enable-disabled-menus-and-buttons t)
+ (cursor-in-echo-area t)
+ saved-yank-menu)
+ (unwind-protect
+ (let (key)
+ ;; If yank-menu is empty, populate it temporarily, so that
+ ;; "Select and Paste" menu can generate a complete event.
+ (when (null (cdr yank-menu))
+ (setq saved-yank-menu (copy-sequence yank-menu))
+ (menu-bar-update-yank-menu "(any string)" nil))
+ (while
+ (pcase (setq key (read-key-sequence "\
+Describe the following key, mouse click, or menu item: "))
+ ((and (pred vectorp) (let `(,key0 . ,_) (aref key 0))
+ (guard (symbolp key0)) (let keyname (symbol-name key0)))
+ (if no-mouse-movement
+ (string-match "mouse-movement" keyname)
+ (and (string-match "\\(mouse\\|down\\|click\\|drag\\)"
+ keyname)
+ (not (sit-for (/ double-click-time 1000.0) t)))))))
+ (list
+ key
+ ;; If KEY is a down-event, read and include the
+ ;; corresponding up-event. Note that there are also
+ ;; down-events on scroll bars and mode lines: the actual
+ ;; event then is in the second element of the vector.
+ (and (vectorp key)
+ (let ((last-idx (1- (length key))))
+ (and (eventp (aref key last-idx))
+ (memq 'down (event-modifiers (aref key last-idx)))))
+ (or (and (eventp (aref key 0))
+ (memq 'down (event-modifiers (aref key 0)))
+ ;; However, for the C-down-mouse-2 popup
+ ;; menu, there is no subsequent up-event. In
+ ;; this case, the up-event is the next
+ ;; element in the supplied vector.
+ (= (length key) 1))
+ (and (> (length key) 1)
+ (eventp (aref key 1))
+ (memq 'down (event-modifiers (aref key 1)))))
+ (read-event))))
+ ;; Put yank-menu back as it was, if we changed it.
+ (when saved-yank-menu
+ (setq yank-menu (copy-sequence saved-yank-menu))
+ (fset 'yank-menu (cons 'keymap yank-menu))))))
+
(defun describe-key (&optional key untranslated up-event)
"Display documentation of the function invoked by KEY.
KEY 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.
If KEY is a menu item or a tool-bar button that is disabled, this command
temporarily enables it to allow getting help on disabled items and buttons."
(interactive
- (let ((enable-disabled-menus-and-buttons t)
- (cursor-in-echo-area t)
- saved-yank-menu)
- (unwind-protect
- (let (key)
- ;; If yank-menu is empty, populate it temporarily, so that
- ;; "Select and Paste" menu can generate a complete event.
- (when (null (cdr yank-menu))
- (setq saved-yank-menu (copy-sequence yank-menu))
- (menu-bar-update-yank-menu "(any string)" nil))
- (while
- (progn
- (setq key (read-key-sequence "Describe the following key,
mouse click, or menu item: "))
- (and (vectorp key)
- (consp (aref key 0))
- (symbolp (car (aref key 0)))
- (string-match "\\(mouse\\|down\\|click\\|drag\\)"
- (symbol-name (car (aref key 0))))
- (not (sit-for (/ double-click-time 1000.0) t)))))
- (list
- key
- (prefix-numeric-value current-prefix-arg)
- ;; If KEY is a down-event, read and include the
- ;; corresponding up-event. Note that there are also
- ;; down-events on scroll bars and mode lines: the actual
- ;; event then is in the second element of the vector.
- (and (vectorp key)
- (let ((last-idx (1- (length key))))
- (and (eventp (aref key last-idx))
- (memq 'down (event-modifiers (aref key last-idx)))))
- (or (and (eventp (aref key 0))
- (memq 'down (event-modifiers (aref key 0)))
- ;; However, for the C-down-mouse-2 popup
- ;; menu, there is no subsequent up-event. In
- ;; this case, the up-event is the next
- ;; element in the supplied vector.
- (= (length key) 1))
- (and (> (length key) 1)
- (eventp (aref key 1))
- (memq 'down (event-modifiers (aref key 1)))))
- (read-event))))
- ;; Put yank-menu back as it was, if we changed it.
- (when saved-yank-menu
- (setq yank-menu (copy-sequence saved-yank-menu))
- (fset 'yank-menu (cons 'keymap yank-menu))))))
- (if (numberp untranslated)
- (setq untranslated (this-single-command-raw-keys)))
- (let* ((event (aref key (if (and (symbolp (aref key 0))
- (> (length key) 1)
- (consp (aref key 1)))
- 1
- 0)))
- (modifiers (event-modifiers event))
- (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
- (memq 'drag modifiers)) " at that spot" ""))
- (defn (key-binding key t))
- key-locus key-locus-up key-locus-up-tricky
- defn-up defn-up-tricky ev-type
- mouse-1-remapped mouse-1-tricky)
-
- ;; Handle the case where we faked an entry in "Select and Paste" menu.
- (when (and (eq defn nil)
- (stringp (aref key (1- (length key))))
- (eq (key-binding (substring key 0 -1)) 'yank-menu))
- (setq defn 'menu-bar-select-yank))
- (if (or (null defn) (integerp defn) (equal defn 'undefined))
- (message "%s%s is undefined"
- (help-key-description key untranslated) mouse-msg)
+ (pcase-let ((`(,key ,up-event) (help-read-key-sequence)))
+ `(,key ,(prefix-numeric-value current-prefix-arg) ,up-event)))
+ (pcase-let ((`(,brief-desc ,defn ,event ,mouse-msg)
+ (help--analyze-key key untranslated))
+ (defn-up nil) (defn-up-tricky nil)
+ (key-locus-up nil) (key-locus-up-tricky nil)
+ (mouse-1-remapped nil) (mouse-1-tricky nil)
+ (ev-type nil))
+ (if (or (null defn)
+ (integerp defn)
+ (equal defn 'undefined))
+ (message "%s" brief-desc)
(help-setup-xref (list #'describe-function defn)
(called-interactively-p 'interactive))
- ;; Don't bother user with strings from (e.g.) the select-paste menu.
- (when (stringp (aref key (1- (length key))))
- (aset key (1- (length key)) "(any string)"))
- (when (and untranslated
- (stringp (aref untranslated (1- (length untranslated)))))
- (aset untranslated (1- (length untranslated))
- "(any string)"))
;; Need to do this before erasing *Help* buffer in case event
;; is a mouse click in an existing *Help* buffer.
(when up-event
@@ -849,13 +811,12 @@ temporarily enables it to allow getting help on disabled
items and buttons."
(aset sequence 0 'mouse-1)
(setq defn-up-tricky (key-binding sequence nil nil (event-start
up-event)))
(setq key-locus-up-tricky (help--binding-locus sequence
(event-start up-event))))))
- (setq key-locus (help--binding-locus key (event-start event)))
(with-help-window (help-buffer)
- (princ (help-key-description key untranslated))
- (princ (format "%s runs the command %S%s, which is "
- mouse-msg defn (if key-locus
- (format " (found in %s)" key-locus)
- "")))
+ (princ brief-desc)
+ (let ((key-locus (help--binding-locus key (event-start event))))
+ (when key-locus
+ (princ (format " (found in %s)" key-locus))))
+ (princ ", which is ")
(describe-function-1 defn)
(when up-event
(unless (or (null defn-up)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index ae28ba9..dababdb 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -4952,7 +4952,7 @@ call other entry points instead, such as `cl-prin1'.
\(fn OBJECT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"cl-print" '("cl-print-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"cl-print" '("cl-print-" "help-byte-code")))
;;;***
@@ -16544,18 +16544,6 @@ The optional LABEL is used to label the buffer created.
;;;***
-;;;### (autoloads nil "html2text" "net/html2text.el" (0 0 0 0))
-;;; Generated autoloads from net/html2text.el
-
-(autoload 'html2text "html2text" "\
-Convert HTML to plain text in the current buffer.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"html2text" '("html2text-")))
-
-;;;***
-
;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0))
;;; Generated autoloads from htmlfontify.el
(push (purecopy '(htmlfontify 0 21)) package--builtin-versions)
@@ -30399,7 +30387,7 @@ then `snmpv2-mode-hook'.
;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0))
;;; Generated autoloads from net/soap-client.el
-(push (purecopy '(soap-client 3 1 2)) package--builtin-versions)
+(push (purecopy '(soap-client 3 1 3)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"soap-client" '("soap-")))
@@ -34165,7 +34153,7 @@ Reenable Ange-FTP, when Tramp is unloaded.
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 3 2 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 3 2)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"trampver" '("tramp-")))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index c3480cd..e5b1029 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."
(defcustom completion-auto-help t
"Non-nil means automatically provide help for invalid completion input.
-If the value is t the *Completion* buffer is displayed whenever completion
+If the value is t the *Completions* buffer is displayed whenever completion
is requested but cannot be done.
If the value is `lazy', the *Completions* buffer is only displayed after
the second failed attempt to complete."
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 9b6b169..e079443 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -380,7 +380,7 @@ This command must be bound to a mouse click."
(defun mouse-drag-line (start-event line)
"Drag a mode line, header line, or vertical line with the mouse.
-START-EVENT is the starting mouse-event of the drag action. LINE
+START-EVENT is the starting mouse event of the drag action. LINE
must be one of the symbols `header', `mode', or `vertical'."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
@@ -405,29 +405,15 @@ must be one of the symbols `header', `mode', or
`vertical'."
;; window's edge we drag.
(cond
((eq line 'header)
- (if (window-at-side-p window 'top)
- ;; We can't drag the header line of a topmost window.
- (setq draggable nil)
- ;; Drag bottom edge of window above the header line.
- (setq window (window-in-direction 'above window t))))
- ((eq line 'mode)
- (if (and (window-at-side-p window 'bottom)
- ;; Allow resizing the minibuffer window if it's on the
- ;; same frame as and immediately below `window', and it's
- ;; either active or `resize-mini-windows' is nil.
- (let ((minibuffer-window (minibuffer-window frame)))
- (not (and (eq (window-frame minibuffer-window) frame)
- (or (not resize-mini-windows)
- (eq minibuffer-window
- (active-minibuffer-window)))))))
- (setq draggable nil)))
+ ;; Drag bottom edge of window above the header line.
+ (setq window (window-in-direction 'above window t)))
+ ((eq line 'mode))
((eq line 'vertical)
(let ((divider-width (frame-right-divider-width frame)))
(when (and (or (not (numberp divider-width))
(zerop divider-width))
(eq (frame-parameter frame 'vertical-scroll-bars) 'left))
(setq window (window-in-direction 'left window t))))))
-
(let* ((exitfun nil)
(move
(lambda (event) (interactive "e")
@@ -530,20 +516,405 @@ must be one of the symbols `header', `mode', or
`vertical'."
t (lambda () (setq track-mouse old-track-mouse)))))))
(defun mouse-drag-mode-line (start-event)
- "Change the height of a window by dragging on the mode line."
+ "Change the height of a window by dragging on its mode line.
+START-EVENT is the starting mouse event of the drag action.
+
+If the drag happens in a mode line on the bottom of a frame and
+that frame's `drag-with-mode-line' parameter is non-nil, drag the
+frame instead."
(interactive "e")
- (mouse-drag-line start-event 'mode))
+ (let* ((start (event-start start-event))
+ (window (posn-window start))
+ (frame (window-frame window)))
+ (cond
+ ((not (window-live-p window)))
+ ((or (not (window-at-side-p window 'bottom))
+ ;; Allow resizing the minibuffer window if it's on the
+ ;; same frame as and immediately below `window', and it's
+ ;; either active or `resize-mini-windows' is nil.
+ (let ((minibuffer-window (minibuffer-window frame)))
+ (and (eq (window-frame minibuffer-window) frame)
+ (or (not resize-mini-windows)
+ (eq minibuffer-window
+ (active-minibuffer-window))))))
+ (mouse-drag-line start-event 'mode))
+ ((and (frame-parameter frame 'drag-with-mode-line)
+ (window-at-side-p window 'bottom)
+ (let ((minibuffer-window (minibuffer-window frame)))
+ (not (eq (window-frame minibuffer-window) frame))))
+ ;; Drag frame when the window is on the bottom of its frame and
+ ;; there is no minibuffer window below.
+ (mouse-drag-frame start-event 'move)))))
(defun mouse-drag-header-line (start-event)
- "Change the height of a window by dragging on the header line."
+ "Change the height of a window by dragging on its header line.
+START-EVENT is the starting mouse event of the drag action.
+
+If the drag happens in a header line on the top of a frame and
+that frame's `drag-with-header-line' parameter is non-nil, drag
+the frame instead."
(interactive "e")
- (mouse-drag-line start-event 'header))
+ (let* ((start (event-start start-event))
+ (window (posn-window start)))
+ (if (and (window-live-p window)
+ (not (window-at-side-p window 'top)))
+ (mouse-drag-line start-event 'header)
+ (let ((frame (window-frame window)))
+ (when (frame-parameter frame 'drag-with-header-line)
+ (mouse-drag-frame start-event 'move))))))
(defun mouse-drag-vertical-line (start-event)
- "Change the width of a window by dragging on the vertical line."
+ "Change the width of a window by dragging on a vertical line.
+START-EVENT is the starting mouse event of the drag action."
(interactive "e")
(mouse-drag-line start-event 'vertical))
+(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
+ "Helper function for `mouse-drag-frame'."
+ (let* ((frame-x-y (frame-position frame))
+ (frame-x (car frame-x-y))
+ (frame-y (cdr frame-x-y))
+ alist)
+ (if (> x-diff 0)
+ (when x-move
+ (setq x-diff (min x-diff frame-x))
+ (setq x-move (- frame-x x-diff)))
+ (let* ((min-width (frame-windows-min-size frame t nil t))
+ (min-diff (max 0 (- (frame-inner-width frame) min-width))))
+ (setq x-diff (max x-diff (- min-diff)))
+ (when x-move
+ (setq x-move (+ frame-x (- x-diff))))))
+
+ (if (> y-diff 0)
+ (when y-move
+ (setq y-diff (min y-diff frame-y))
+ (setq y-move (- frame-y y-diff)))
+ (let* ((min-height (frame-windows-min-size frame nil nil t))
+ (min-diff (max 0 (- (frame-inner-height frame) min-height))))
+ (setq y-diff (max y-diff (- min-diff)))
+ (when y-move
+ (setq y-move (+ frame-y (- y-diff))))))
+
+ (unless (zerop x-diff)
+ (when x-move
+ (push `(left . ,x-move) alist))
+ (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
+ alist))
+ (unless (zerop y-diff)
+ (when y-move
+ (push `(top . ,y-move) alist))
+ (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
+ alist))
+ (when alist
+ (modify-frame-parameters frame alist))))
+
+(defun mouse-drag-frame (start-event part)
+ "Drag a frame or one of its edges with the mouse.
+START-EVENT is the starting mouse event of the drag action. Its
+position window denotes the frame that will be dragged.
+
+PART specifies the part that has been dragged and must be one of
+the symbols 'left', 'top', 'right', 'bottom', 'top-left',
+'top-right', 'bottom-left', 'bottom-right' to drag an internal
+border or edge. If PART equals 'move', this means to move the
+frame with the mouse."
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let* ((echo-keystrokes 0)
+ (start (event-start start-event))
+ (window (posn-window start))
+ ;; FRAME is the frame to drag.
+ (frame (if (window-live-p window)
+ (window-frame window)
+ window))
+ (width (frame-native-width frame))
+ (height (frame-native-height frame))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ ;; top-level frame, FRAME's workarea.
+ (parent (frame-parent frame))
+ (parent-edges
+ (if parent
+ `(0 0 ,(frame-native-width parent) ,(frame-native-height parent))
+ (let* ((attributes
+ (car (display-monitor-attributes-list)))
+ (workarea (assq 'workarea attributes)))
+ (and workarea
+ `(,(nth 1 workarea) ,(nth 2 workarea)
+ ,(+ (nth 1 workarea) (nth 3 workarea))
+ ,(+ (nth 2 workarea) (nth 4 workarea)))))))
+ (parent-left (and parent-edges (nth 0 parent-edges)))
+ (parent-top (and parent-edges (nth 1 parent-edges)))
+ (parent-right (and parent-edges (nth 2 parent-edges)))
+ (parent-bottom (and parent-edges (nth 3 parent-edges)))
+ ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
+ ;; last sampled mouse position. Note that we sample absolute
+ ;; mouse positions to avoid that moving the mouse from one
+ ;; frame into another gets into our way. `last-x' and `last-y'
+ ;; records the x- and y-coordinates of the previously sampled
+ ;; position. The differences between `last-x' and `pos-x' as
+ ;; well as `last-y' and `pos-y' determine the amount the mouse
+ ;; has been dragged between the last two samples.
+ pos-x-y pos-x pos-y
+ (last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
+ ;; mouse position when FRAME snapped. As soon as the
+ ;; difference between `pos-x' and `snap-x' (or `pos-y' and
+ ;; `snap-y') exceeds the value of FRAME's `snap-width'
+ ;; parameter, unsnap FRAME (at the respective side). `snap-x'
+ ;; and `snap-y' nil mean FRAME is curerntly not snapped.
+ snap-x snap-y
+ (exitfun nil)
+ (move
+ (lambda (event)
+ (interactive "e")
+ (when (consp event)
+ (setq pos-x-y (mouse-absolute-pixel-position))
+ (setq pos-x (car pos-x-y))
+ (setq pos-y (cdr pos-x-y))
+ (cond
+ ((eq part 'left)
+ (mouse-resize-frame frame (- last-x pos-x) 0 t))
+ ((eq part 'top)
+ (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
+ ((eq part 'right)
+ (mouse-resize-frame frame (- pos-x last-x) 0))
+ ((eq part 'bottom)
+ (mouse-resize-frame frame 0 (- pos-y last-y)))
+ ((eq part 'top-left)
+ (mouse-resize-frame
+ frame (- last-x pos-x) (- last-y pos-y) t t))
+ ((eq part 'top-right)
+ (mouse-resize-frame
+ frame (- pos-x last-x) (- last-y pos-y) nil t))
+ ((eq part 'bottom-left)
+ (mouse-resize-frame
+ frame (- last-x pos-x) (- pos-y last-y) t))
+ ((eq part 'bottom-right)
+ (mouse-resize-frame
+ frame (- pos-x last-x) (- pos-y last-y)))
+ ((eq part 'move)
+ (let* ((old-position (frame-position frame))
+ (old-left (car old-position))
+ (old-top (cdr old-position))
+ (left (+ old-left (- pos-x last-x)))
+ (top (+ old-top (- pos-y last-y)))
+ right bottom
+ ;; `snap-width' (maybe also a yet to be provided
+ ;; `snap-height') could become floats to handle
+ ;; proportionality wrt PARENT. We don't do any
+ ;; checks on this parameter so far.
+ (snap-width (frame-parameter frame 'snap-width)))
+ ;; Docking and constraining.
+ (when (and (numberp snap-width) parent-edges)
+ (cond
+ ;; Docking at the left parent edge.
+ ((< pos-x last-x)
+ (cond
+ ((and (> left parent-left)
+ (<= (- left parent-left) snap-width))
+ ;; Snap when the mouse moved leftward and
+ ;; FRAME's left edge would end up within
+ ;; `snap-width' pixels from PARENT's left edge.
+ (setq snap-x pos-x)
+ (setq left parent-left))
+ ((and (<= left parent-left)
+ (<= (- parent-left left) snap-width)
+ snap-x (<= (- snap-x pos-x) snap-width))
+ ;; Stay snapped when the mouse moved leftward
+ ;; but not more than `snap-width' pixels from
+ ;; the time FRAME snapped.
+ (setq left parent-left))
+ (t
+ ;; Unsnap when the mouse moved more than
+ ;; `snap-width' pixels leftward from the time
+ ;; FRAME snapped.
+ (setq snap-x nil))))
+ ((> pos-x last-x)
+ (setq right (+ left width))
+ (cond
+ ((and (< right parent-right)
+ (<= (- parent-right right) snap-width))
+ ;; Snap when the mouse moved rightward and
+ ;; FRAME's right edge would end up within
+ ;; `snap-width' pixels from PARENT's right edge.
+ (setq snap-x pos-x)
+ (setq left (- parent-right width)))
+ ((and (>= right parent-right)
+ (<= (- right parent-right) snap-width)
+ snap-x (<= (- pos-x snap-x) snap-width))
+ ;; Stay snapped when the mouse moved rightward
+ ;; but not more more than `snap-width' pixels
+ ;; from the time FRAME snapped.
+ (setq left (- parent-right width)))
+ (t
+ ;; Unsnap when the mouse moved rightward more
+ ;; than `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-x nil)))))
+
+ (cond
+ ((< pos-y last-y)
+ (cond
+ ((and (> top parent-top)
+ (<= (- top parent-top) snap-width))
+ ;; Snap when the mouse moved upward and FRAME's
+ ;; top edge would end up within `snap-width'
+ ;; pixels from PARENT's top edge.
+ (setq snap-y pos-y)
+ (setq top parent-top))
+ ((and (<= top parent-top)
+ (<= (- parent-top top) snap-width)
+ snap-y (<= (- snap-y pos-y) snap-width))
+ ;; Stay snapped when the mouse moved upward but
+ ;; not more more than `snap-width' pixels from
+ ;; the time FRAME snapped.
+ (setq top parent-top))
+ (t
+ ;; Unsnap when the mouse moved upward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))
+ ((> pos-y last-y)
+ (setq bottom (+ top height))
+ (cond
+ ((and (< bottom parent-bottom)
+ (<= (- parent-bottom bottom) snap-width))
+ ;; Snap when the mouse moved downward and
+ ;; FRAME's bottom edge would end up within
+ ;; `snap-width' pixels from PARENT's bottom
+ ;; edge.
+ (setq snap-y pos-y)
+ (setq top (- parent-bottom height)))
+ ((and (>= bottom parent-bottom)
+ (<= (- bottom parent-bottom) snap-width)
+ snap-y (<= (- pos-y snap-y) snap-width))
+ ;; Stay snapped when the mouse moved downward
+ ;; but not more more than `snap-width' pixels
+ ;; from the time FRAME snapped.
+ (setq top (- parent-bottom height)))
+ (t
+ ;; Unsnap when the mouse moved downward more
+ ;; than `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))))
+
+ ;; If requested, constrain FRAME's draggable areas to
+ ;; PARENT's edges. The `top-visible' parameter should
+ ;; be set when FRAME has a draggable header-line. If
+ ;; set to a number, it ascertains that the top of
+ ;; FRAME is always constrained to the top of PARENT
+ ;; and that at least as many pixels of FRAME as
+ ;; specified by that number are visible on each of the
+ ;; three remaining sides of PARENT.
+ ;;
+ ;; The `bottom-visible' parameter should be set when
+ ;; FRAME has a draggable mode-line. If set to a
+ ;; number, it ascertains that the bottom of FRAME is
+ ;; always constrained to the bottom of PARENT and that
+ ;; at least as many pixels of FRAME as specified by
+ ;; that number are visible on each of the three
+ ;; remaining sides of PARENT.
+ (let ((par (frame-parameter frame 'top-visible))
+ bottom-visible)
+ (unless par
+ (setq par (frame-parameter frame 'bottom-visible))
+ (setq bottom-visible t))
+ (when (and (numberp par) parent-edges)
+ (setq left
+ (max (min (- parent-right par) left)
+ (+ (- parent-left width) par)))
+ (setq top
+ (if bottom-visible
+ (min (max top (- parent-top (- height par)))
+ (- parent-bottom height))
+ (min (max top parent-top)
+ (- parent-bottom par))))))
+
+ ;; Use `modify-frame-parameters' since `left' and
+ ;; `top' may want to move FRAME out of its PARENT.
+ (modify-frame-parameters
+ frame
+ `((left . (+ ,left)) (top . (+ ,top)))))))
+ (setq last-x pos-x)
+ (setq last-y pos-y))))
+ (old-track-mouse track-mouse))
+ ;; Start tracking. The special value 'dragging' signals the
+ ;; display engine to freeze the mouse pointer shape for as long
+ ;; as we drag.
+ (setq track-mouse 'dragging)
+ ;; Loop reading events and sampling the position of the mouse.
+ (setq exitfun
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [switch-frame] #'ignore)
+ (define-key map [select-window] #'ignore)
+ (define-key map [scroll-bar-movement] #'ignore)
+ (define-key map [mouse-movement] move)
+ ;; Swallow drag-mouse-1 events to avoid selecting some other
window.
+ (define-key map [drag-mouse-1]
+ (lambda () (interactive) (funcall exitfun)))
+ ;; Some of the events will of course end up looked up
+ ;; with a mode-line, header-line or vertical-line prefix ...
+ (define-key map [mode-line] map)
+ (define-key map [header-line] map)
+ (define-key map [vertical-line] map)
+ ;; ... and some maybe even with a right- or bottom-divider
+ ;; prefix.
+ (define-key map [right-divider] map)
+ (define-key map [bottom-divider] map)
+ map)
+ t (lambda () (setq track-mouse old-track-mouse))))))
+
+(defun mouse-drag-left-edge (start-event)
+ "Drag left edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'left))
+
+(defun mouse-drag-top-left-corner (start-event)
+ "Drag top left corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'top-left))
+
+(defun mouse-drag-top-edge (start-event)
+ "Drag top edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'top))
+
+(defun mouse-drag-top-right-corner (start-event)
+ "Drag top right corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'top-right))
+
+(defun mouse-drag-right-edge (start-event)
+ "Drag right edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'right))
+
+(defun mouse-drag-bottom-right-corner (start-event)
+ "Drag bottom right corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'bottom-right))
+
+(defun mouse-drag-bottom-edge (start-event)
+ "Drag bottom edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'bottom))
+
+(defun mouse-drag-bottom-left-corner (start-event)
+ "Drag bottom left corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'bottom-left))
+
(defcustom mouse-select-region-move-to-beginning nil
"Effect of selecting a region extending backward from double click.
Nil means keep point at the position clicked (region end);
@@ -2078,6 +2449,22 @@ is copied instead of being cut."
(global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
(global-set-key [bottom-divider mouse-1] 'ignore)
(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
+(global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge)
+(global-set-key [left-edge mouse-1] 'ignore)
+(global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner)
+(global-set-key [top-left-corner mouse-1] 'ignore)
+(global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge)
+(global-set-key [top-edge mouse-1] 'ignore)
+(global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner)
+(global-set-key [top-right-corner mouse-1] 'ignore)
+(global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge)
+(global-set-key [right-edge mouse-1] 'ignore)
+(global-set-key [bottom-right-corner down-mouse-1]
'mouse-drag-bottom-right-corner)
+(global-set-key [bottom-right-corner mouse-1] 'ignore)
+(global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge)
+(global-set-key [bottom-edge mouse-1] 'ignore)
+(global-set-key [bottom-left-corner down-mouse-1]
'mouse-drag-bottom-left-corner)
+(global-set-key [bottom-left-corner mouse-1] 'ignore)
(provide 'mouse)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index fe31657..2fc36e1 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'."
(expand-file-name file))))
;;;###autoload
-(defun eww-search-words (&optional beg end)
+(defun eww-search-words ()
"Search the web for the text between BEG and END.
-See the `eww-search-prefix' variable for the search engine used."
- (interactive "r")
- (eww (buffer-substring beg end)))
+If region is active (and not whitespace), search the web for
+the text between BEG and END. Else, prompt the user for a search
+string. See the `eww-search-prefix' variable for the search
+engine used."
+ (interactive)
+ (if (use-region-p)
+ (let ((region-string (buffer-substring (region-beginning) (region-end))))
+ (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
+ (eww region-string)
+ (call-interactively 'eww)))
+ (call-interactively 'eww)))
(defun eww-open-in-new-buffer ()
"Fetch link at point in a new EWW buffer."
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 2a6b396..4d4e8a8 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -185,8 +185,8 @@ and other things:
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'shr-browse-url)
(define-key map "I" 'shr-insert-image)
- (define-key map "w" 'shr-copy-url)
- (define-key map "u" 'shr-copy-url)
+ (define-key map "w" 'shr-maybe-probe-and-copy-url)
+ (define-key map "u" 'shr-maybe-probe-and-copy-url)
(define-key map "v" 'shr-browse-url)
(define-key map "O" 'shr-save-contents)
(define-key map "\r" 'shr-browse-url)
@@ -290,43 +290,59 @@ DOM should be a parse tree as generated by
(forward-line 1)
(delete-region (point) (point-max))))))
-(defun shr-copy-url (&optional image-url)
+(defun shr-url-at-point (image-url)
+ "Return the URL under point as a string.
+If IMAGE-URL is non-nil, or there is no link under point, but
+there is an image under point then copy the URL of the image
+under point instead."
+ (if image-url
+ (get-text-property (point) 'image-url)
+ (or (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url))))
+
+(defun shr-copy-url (url)
"Copy the URL under point to the kill ring.
If IMAGE-URL (the prefix) is non-nil, or there is no link under
point, but there is an image under point then copy the URL of the
-image under point instead.
-If called twice, then try to fetch the URL and see whether it
-redirects somewhere else."
+image under point instead."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if (not url)
+ (message "No URL under point")
+ (setq url (url-encode-url url))
+ (kill-new url)
+ (message "Copied %s" url)))
+
+(defun shr-probe-url (url cont)
+ "Pass URL's redirect destination to CONT, if it has one.
+CONT should be a function of one argument, the redirect
+destination URL. If URL is not redirected, then CONT is never
+called."
(interactive "P")
- (let ((url (if image-url
- (get-text-property (point) 'image-url)
- (or (get-text-property (point) 'shr-url)
- (get-text-property (point) 'image-url)))))
- (cond
- ((not url)
- (message "No URL under point"))
- ;; Resolve redirected URLs.
- ((equal url (car kill-ring))
- (url-retrieve
- url
- (lambda (a)
- (when (and (consp a)
- (eq (car a) :redirect))
- (with-temp-buffer
- (insert (cadr a))
- (goto-char (point-min))
- ;; Remove common tracking junk from the URL.
- (when (re-search-forward ".utm_.*" nil t)
- (replace-match "" t t))
- (message "Copied %s" (buffer-string))
- (copy-region-as-kill (point-min) (point-max)))))
- nil t))
- ;; Copy the URL to the kill ring.
- (t
- (with-temp-buffer
- (insert (url-encode-url url))
- (copy-region-as-kill (point-min) (point-max))
- (message "Copied %s" (buffer-string)))))))
+ (url-retrieve
+ url (lambda (a)
+ (pcase a
+ (`(:redirect ,destination . ,_)
+ ;; Remove common tracking junk from the URL.
+ (funcall cont (replace-regexp-in-string
+ ".utm_.*" "" destination)))))
+ nil t))
+
+(defun shr-probe-and-copy-url (url)
+ "Copy the URL under point to the kill ring.
+Like `shr-copy-url', but additionally fetch URL and use its
+redirection destination if it has one."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if url (shr-probe-url url #'shr-copy-url)
+ (shr-copy-url url)))
+
+(defun shr-maybe-probe-and-copy-url (url)
+ "Copy the URL under point to the kill ring.
+If the URL is already at the front of the kill ring act like
+`shr-probe-and-copy-url', otherwise like `shr-copy-url'."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if (equal url (car kill-ring))
+ (shr-probe-and-copy-url url)
+ (shr-copy-url url)))
(defun shr-next-link ()
"Skip to the next link."
@@ -512,6 +528,7 @@ size, and full-buffer size."
(* (frame-char-width) 2)
0))))
(shr-insert text)
+ (shr-fill-lines (point-min) (point-max))
(buffer-string)))))
(define-inline shr-char-breakable-p (char)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 23aa901..3469790 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -72,7 +72,7 @@ It is used for TCP/IP devices."
(defconst tramp-adb-ls-toolbox-regexp
(concat
"^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions
- "\\(?:[[:space:]][[:digit:]]+\\)?" ; links (Android 7/ToolBox)
+ "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox)
"[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
"[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
"[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
@@ -411,15 +411,17 @@ pass to the OPERATION."
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument localname)))
;; We insert also filename/. and filename/.., because "ls" doesn't.
- (narrow-to-region (point) (point))
- (tramp-adb-send-command
- v (format "%s -d -a -l %s %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument
- (concat (file-name-as-directory localname) "."))
- (tramp-shell-quote-argument
- (concat (file-name-as-directory localname) ".."))))
- (widen))
+ ;; Looks like it does include them in toybox, since Android 6.
+ (unless (re-search-backward "\\.$" nil t)
+ (narrow-to-region (point-max) (point-max))
+ (tramp-adb-send-command
+ v (format "%s -d -a -l %s %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) "."))
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) ".."))))
+ (widen)))
(tramp-adb-sh-fix-ls-output)
(let ((result (tramp-do-parse-file-attributes-with-ls
v (or id-format 'integer))))
@@ -443,11 +445,12 @@ pass to the OPERATION."
(with-tramp-connection-property vec "ls"
(tramp-message vec 5 "Finding a suitable `ls' command")
(cond
- ;; Can't disable coloring explicitly for toybox ls command
- ((tramp-adb-send-command-and-check vec "toybox") "ls")
+ ;; Can't disable coloring explicitly for toybox ls command. We
+ ;; must force "ls" to print just one column.
+ ((tramp-adb-send-command-and-check vec "toybox") "env COLUMNS=1 ls")
;; On CyanogenMod based system BusyBox is used and "ls" output
- ;; coloring is enabled by default. So we try to disable it
- ;; when possible.
+ ;; coloring is enabled by default. So we try to disable it when
+ ;; possible.
((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null")
"ls --color=never")
(t "ls"))))
@@ -569,13 +572,17 @@ Emacs dired can't find files."
(file-name-as-directory f)
f))
(with-current-buffer (tramp-get-buffer v)
- (append
- '("." "..")
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
- (split-string (buffer-string) "\n")))))))))))
+ (delete-dups
+ (append
+ ;; In older Android versions, "." and ".." are not
+ ;; included. In newer versions (toybox, since Android
+ ;; 6) they are. We fix this by `delete-dups'.
+ '("." "..")
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
+ (split-string (buffer-string) "\n"))))))))))))
(defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index c998df8..b2df4d6 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."
(eval-after-load 'tramp
'(unless
(memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
- (tramp-change-syntax (tramp-compat-tramp-syntax))))
+ (tramp-compat-funcall
+ (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
(provide 'tramp-compat)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index f7b457e..94518d0 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."
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
- (when (and tramp-locked (not tramp-locker))
- (setq tramp-locked nil)
- (tramp-error
- (car-safe tramp-current-connection) 'file-error
- "Forbidden reentrant call of Tramp"))
- (let ((tl tramp-locked))
- (setq tramp-locked t)
- (unwind-protect
- (let ((tramp-locker t))
- (save-match-data
- (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if fn
- (apply (cdr fn) args)
- (tramp-run-real-handler operation args)))))
- (setq tramp-locked tl))))
+ (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
;; This must be the last entry, because `identity' always matches.
;;;###tramp-autoload
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 8d81ac6..9c327c4 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2053,6 +2053,33 @@ ARGS are the arguments OPERATION has been called with."
`(let ((debug-on-error tramp-debug-on-error))
(condition-case-unless-debug ,var ,bodyform ,@handlers)))
+;; In Emacs, there is some concurrency due to timers. If a timer
+;; interrupts Tramp and wishes to use the same connection buffer as
+;; the "main" Emacs, then garbage might occur in the connection
+;; buffer. Therefore, we need to make sure that a timer does not use
+;; the same connection buffer as the "main" Emacs. We implement a
+;; cheap global lock, instead of locking each connection buffer
+;; separately. The global lock is based on two variables,
+;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
+;; (with setq) to indicate a lock. But Tramp also calls itself during
+;; processing of a single file operation, so we need to allow
+;; recursive calls. That's where the `tramp-locker' variable comes in
+;; -- it is let-bound to t during the execution of the current
+;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
+;; then we should just proceed because we have been called
+;; recursively. But if `tramp-locker' is nil, then we are a timer
+;; interrupting the "main" Emacs, and then we signal an error.
+
+(defvar tramp-locked nil
+ "If non-nil, then Tramp is currently busy.
+Together with `tramp-locker', this implements a locking mechanism
+preventing reentrant calls of Tramp.")
+
+(defvar tramp-locker nil
+ "If non-nil, then a caller has locked Tramp.
+Together with `tramp-locked', this implements a locking mechanism
+preventing reentrant calls of Tramp.")
+
;; Main function.
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler.
@@ -2090,7 +2117,20 @@ Falls back to normal file name handler if no Tramp file
name handler exists."
(setq result
(catch 'non-essential
(catch 'suppress
- (apply foreign operation args))))
+ (when (and tramp-locked (not tramp-locker))
+ (setq tramp-locked nil)
+ (tramp-error
+ (car-safe tramp-current-connection)
+ 'file-error
+ "Forbidden reentrant call of Tramp"))
+ (let ((tl tramp-locked))
+ (setq tramp-locked t)
+ (unwind-protect
+ (let ((tramp-locker t))
+ (apply foreign operation args))
+ ;; Give timers a chance.
+ (unless (setq tramp-locked tl)
+ (sit-for 0.001 'nodisp)))))))
(cond
((eq result 'non-essential)
(tramp-message
@@ -2145,33 +2185,6 @@ Falls back to normal file name handler if no Tramp file
name handler exists."
;; we don't do anything.
(tramp-run-real-handler operation args))))
-;; In Emacs, there is some concurrency due to timers. If a timer
-;; interrupts Tramp and wishes to use the same connection buffer as
-;; the "main" Emacs, then garbage might occur in the connection
-;; buffer. Therefore, we need to make sure that a timer does not use
-;; the same connection buffer as the "main" Emacs. We implement a
-;; cheap global lock, instead of locking each connection buffer
-;; separately. The global lock is based on two variables,
-;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
-;; (with setq) to indicate a lock. But Tramp also calls itself during
-;; processing of a single file operation, so we need to allow
-;; recursive calls. That's where the `tramp-locker' variable comes in
-;; -- it is let-bound to t during the execution of the current
-;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
-;; then we should just proceed because we have been called
-;; recursively. But if `tramp-locker' is nil, then we are a timer
-;; interrupting the "main" Emacs, and then we signal an error.
-
-(defvar tramp-locked nil
- "If non-nil, then Tramp is currently busy.
-Together with `tramp-locker', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
-(defvar tramp-locker nil
- "If non-nil, then a caller has locked Tramp.
-Together with `tramp-locked', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
;;;###autoload
(defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler.
@@ -3631,31 +3644,17 @@ connection buffer."
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
for process communication also."
- ;; FIXME: There are problems, when an asynchronous process runs in
- ;; parallel, and also timers are active. See
- ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>.
- (when (and timer-event-last
- (string-prefix-p "*tramp/" (process-name proc))
- (let (result)
- (maphash
- (lambda (key _value)
- (and (processp key)
- (not (string-prefix-p "*tramp/" (process-name key)))
- (process-live-p key)
- (setq result t)))
- tramp-cache-data)
- result))
- (sit-for 0.01 'nodisp))
(with-current-buffer (process-buffer proc)
(let (buffer-read-only last-coding-system-used)
- ;; Under Windows XP, accept-process-output doesn't return
+ ;; Under Windows XP, `accept-process-output' doesn't return
;; sometimes. So we add an additional timeout. JUST-THIS-ONE
- ;; is set due to Bug#12145.
+ ;; is set due to Bug#12145. It is an integer, in order to avoid
+ ;; running timers as well.
(tramp-message
proc 10 "%s %s %s\n%s"
proc (process-status proc)
(with-timeout (timeout)
- (accept-process-output proc timeout nil t))
+ (accept-process-output proc timeout nil 0))
(buffer-string)))))
(defun tramp-check-for-regexp (proc regexp)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 387a3c8..4be487e 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <address@hidden>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.3.2-pre
+;; Version: 2.3.2
;; This file is part of GNU Emacs.
@@ -33,7 +33,7 @@
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.3.2-pre"
+(defconst tramp-version "2.3.2"
"This version of Tramp.")
;;;###tramp-autoload
@@ -55,7 +55,7 @@
;; Check for Emacs version.
(let ((x (if (>= emacs-major-version 24)
"ok"
- (format "Tramp 2.3.2-pre is not fit for %s"
+ (format "Tramp 2.3.2 is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
diff --git a/lisp/net/html2text.el b/lisp/obsolete/html2text.el
similarity index 99%
rename from lisp/net/html2text.el
rename to lisp/obsolete/html2text.el
index 87c71dc..27560a7 100644
--- a/lisp/net/html2text.el
+++ b/lisp/obsolete/html2text.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
;; Author: Joakim Hove <address@hidden>
+;; Obsolete-since: 26.1
;; This file is part of GNU Emacs.
@@ -29,6 +30,8 @@
;;
;; The main function is `html2text'.
+;; This package was obsoleted by shr.el.
+
;;; Code:
;;
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index c05200b..de25439 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1915,7 +1915,7 @@ with a brace block."
(save-restriction
(let ((start (point))
(paren-state (c-parse-state))
- lim pos end-pos encl-decl-block where)
+ lim pos end-pos where)
;; Narrow enclosing brace blocks out, as required by the values of
;; `c-defun-tactic', `near', and the position of point.
(when (eq c-defun-tactic 'go-outward)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index dd8f8af..85a4085 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -44,19 +44,12 @@
(load "cc-bytecomp" nil t)))
(eval-and-compile
- (defvar c--mapcan-status
- (cond ((and (fboundp 'mapcan)
- (subrp (symbol-function 'mapcan)))
- ;; XEmacs
- 'mapcan)
- ((locate-file "cl-lib.elc" load-path)
- ;; Emacs >= 24.3
- 'cl-mapcan)
- (t
- ;; Emacs <= 24.2
- nil))))
-
-(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
+ (defvar c--cl-library
+ (if (locate-library "cl-lib")
+ 'cl-lib
+ 'cl)))
+
+(cc-external-require c--cl-library)
; was (cc-external-require 'cl). ACM 2005/11/29.
; Changed from (eval-when-compile (require 'cl)) back to
; cc-external-require, 2015-08-12.
@@ -182,9 +175,12 @@ This variant works around bugs in `eval-when-compile' in
various
;; The motivation for this macro is to avoid the irritating message
;; "function `mapcan' from cl package called at runtime" produced by Emacs.
(cond
- ((eq c--mapcan-status 'mapcan)
+ ((and (fboundp 'mapcan)
+ (subrp (symbol-function 'mapcan)))
+ ;; XEmacs and Emacs >= 26.
`(mapcan ,fun ,liszt))
- ((eq c--mapcan-status 'cl-mapcan)
+ ((eq c--cl-library 'cl-lib)
+ ;; Emacs >= 24.3, < 26.
`(cl-mapcan ,fun ,liszt))
(t
;; 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
(defmacro c--set-difference (liszt1 liszt2 &rest other-args)
;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3.
- (if (eq c--mapcan-status 'cl-mapcan)
+ (if (eq c--cl-library 'cl-lib)
`(cl-set-difference ,liszt1 ,liszt2 ,@other-args)
`(set-difference ,liszt1 ,liszt2 ,@other-args)))
(defmacro c--intersection (liszt1 liszt2 &rest other-args)
;; Macro to smooth out the renaming of `intersection' in Emacs 24.3.
- (if (eq c--mapcan-status 'cl-mapcan)
+ (if (eq c--cl-library 'cl-lib)
`(cl-intersection ,liszt1 ,liszt2 ,@other-args)
`(intersection ,liszt1 ,liszt2 ,@other-args)))
@@ -212,7 +208,7 @@ This variant works around bugs in `eval-when-compile' in
various
(defmacro c--delete-duplicates (cl-seq &rest cl-keys)
;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3.
- (if (eq c--mapcan-status 'cl-mapcan)
+ (if (eq c--cl-library 'cl-lib)
`(cl-delete-duplicates ,cl-seq ,@cl-keys)
`(delete-duplicates ,cl-seq ,@cl-keys))))
@@ -1175,6 +1171,63 @@ been put there by c-put-char-property. POINT remains
unchanged."
nil ,from ,to ,value nil -property-))
;; GNU Emacs
`(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
+
+(defun c-clear-char-property-with-value-on-char-function (from to property
+ value char)
+ "Remove all text-properties PROPERTY with value VALUE on
+characters with value CHAR from the region [FROM, TO), as tested
+by `equal'. These properties are assumed to be over individual
+characters, having been put there by c-put-char-property. POINT
+remains unchanged."
+ (let ((place from)
+ )
+ (while ; loop round occurrences of (PROPERTY VALUE)
+ (progn
+ (while ; loop round changes in PROPERTY till we find VALUE
+ (and
+ (< place to)
+ (not (equal (get-text-property place property) value)))
+ (setq place (c-next-single-property-change place property nil to)))
+ (< place to))
+ (if (eq (char-after place) char)
+ (remove-text-properties place (1+ place) (cons property nil)))
+ ;; Do we have to do anything with stickiness here?
+ (setq place (1+ place)))))
+
+(defmacro c-clear-char-property-with-value-on-char (from to property value
char)
+ "Remove all text-properties PROPERTY with value VALUE on
+characters with value CHAR from the region [FROM, TO), as tested
+by `equal'. These properties are assumed to be over individual
+characters, having been put there by c-put-char-property. POINT
+remains unchanged."
+ (if c-use-extents
+ ;; XEmacs
+ `(let ((-property- ,property)
+ (-char- ,char))
+ (map-extents (lambda (ext val)
+ (if (and (equal (extent-property ext -property-) val)
+ (eq (char-after
+ (extent-start-position ext))
+ -char-))
+ (delete-extent ext)))
+ nil ,from ,to ,value nil -property-))
+ ;; Gnu Emacs
+ `(c-clear-char-property-with-value-on-char-function ,from ,to ,property
+ ,value ,char)))
+
+(defmacro c-put-char-properties-on-char (from to property value char)
+ ;; This needs to be a macro because `property' passed to
+ ;; `c-put-char-property' must be a constant.
+ "Put the text property PROPERTY with value VALUE on characters
+with value CHAR in the region [FROM to)."
+ `(let ((skip-string (concat "^" (list ,char)))
+ (-to- ,to))
+ (save-excursion
+ (goto-char ,from)
+ (while (progn (skip-chars-forward skip-string -to-)
+ (< (point) -to-))
+ (c-put-char-property (point) ,property ,value)
+ (forward-char)))))
;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
;; 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."
(def-edebug-spec c-put-char-property t)
(def-edebug-spec c-get-char-property t)
(def-edebug-spec c-clear-char-property t)
+(def-edebug-spec c-clear-char-property-with-value-on-char t)
+(def-edebug-spec c-put-char-properties-on-char t)
(def-edebug-spec c-clear-char-properties t)
(def-edebug-spec c-put-overlay t)
(def-edebug-spec c-delete-overlay t)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index aa84ade..955e1eb 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."
(c-self-bind-state-cache
(let ((start (point))
- state-2
;; A list of syntactically relevant positions in descending
;; order. It's used to avoid scanning repeatedly over
;; potentially large regions with `parse-partial-sexp' to verify
@@ -7809,8 +7808,7 @@ comment at the start of cc-engine.el for more info."
;; looking (in C++) like this "FQN::of::base::Class". Move to the start of
;; this construct and return t. If the parsing fails, return nil, leaving
;; point unchanged.
- (let ((here (point))
- end)
+ (let (end)
(if (not (c-on-identifier))
nil
(c-simple-skip-symbol-backward)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 9bae7d9..66f2575 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -702,6 +702,36 @@ stuff. Used on level 1 and higher."
t)
(c-put-font-lock-face start (1+ start) 'font-lock-warning-face)))))
+(defun c-font-lock-invalid-single-quotes (limit)
+ ;; This function will be called from font-lock for a region bounded by POINT
+ ;; and LIMIT, as though it were to identify a keyword for
+ ;; font-lock-keyword-face. It always returns NIL to inhibit this and
+ ;; prevent a repeat invocation. See elisp/lispref page "Search-based
+ ;; Fontification".
+ ;;
+ ;; This function fontifies invalid single quotes with
+ ;; `font-lock-warning-face'. These are the single quotes which
+ ;; o - aren't inside a literal;
+ ;; o - are marked with a syntax-table text property value '(1); and
+ ;; o - are NOT marked with a non-null c-digit-separator property.
+ (let ((limits (c-literal-limits))
+ state beg end)
+ (if limits
+ (goto-char (cdr limits))) ; Even for being in a ' '
+ (while (< (point) limit)
+ (setq beg (point))
+ (setq state (parse-partial-sexp (point) limit nil nil nil 'syntax-table))
+ (setq end (point))
+ (goto-char beg)
+ (while (progn (skip-chars-forward "^'" end)
+ (< (point) end))
+ (if (and (equal (c-get-char-property (point) 'syntax-table) '(1))
+ (not (c-get-char-property (point) 'c-digit-separator)))
+ (c-put-font-lock-face (point) (1+ (point)) font-lock-warning-face))
+ (forward-char))
+ (parse-partial-sexp end limit nil nil state 'syntax-table)))
+ nil)
+
(c-lang-defconst c-basic-matchers-before
"Font lock matchers for basic keywords, labels, references and various
other easily recognizable things that should be fontified before generic
@@ -723,6 +753,9 @@ casts and declarations are fontified. Used on level 2 and
higher."
(concat ".\\(" c-string-limit-regexp "\\)")
'((c-font-lock-invalid-string)))
+ ;; Invalid single quotes.
+ c-font-lock-invalid-single-quotes
+
;; Fontify C++ raw strings.
,@(when (c-major-mode-is 'c++-mode)
'(c-font-lock-raw-strings))
@@ -777,7 +810,8 @@ casts and declarations are fontified. Used on level 2 and
higher."
(c-backward-syntactic-ws)
(setq id-end (point))
(< (skip-chars-backward
- ,(c-lang-const c-symbol-chars)) 0))
+ ,(c-lang-const c-symbol-chars))
+ 0))
(not (get-text-property (point) 'face)))
(c-put-font-lock-face (point) id-end
c-reference-face-name)
@@ -1013,13 +1047,11 @@ casts and declarations are fontified. Used on level 2
and higher."
;;(message "c-font-lock-declarators from %s to %s" (point) limit)
(c-fontify-types-and-refs
- ((pos (point)) next-pos id-start id-end
+ ((pos (point)) next-pos id-start
decl-res
- paren-depth
id-face got-type got-init
c-last-identifier-range
- (separator-prop (if types 'c-decl-type-start 'c-decl-id-start))
- brackets-after-id)
+ (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)))
;; The following `while' fontifies a single declarator id each time round.
;; It loops only when LIST is non-nil.
@@ -1036,7 +1068,7 @@ casts and declarations are fontified. Used on level 2
and higher."
(forward-char)
(c-forward-syntactic-ws)
(looking-at "[*&]")))
- (not (car (cddr decl-res))) ; brackets-after-id
+ (not (car (cddr decl-res)))
(or (not (c-major-mode-is 'c++-mode))
(save-excursion
(let (c-last-identifier-range)
@@ -1375,7 +1407,6 @@ casts and declarations are fontified. Used on level 2
and higher."
;; it finds any. That's necessary so that we later will
;; stop inside them to fontify types there.
(c-parse-and-markup-<>-arglists t)
- lbrace ; position of some {.
;; The font-lock package in Emacs is known to clobber
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
@@ -2503,7 +2534,7 @@ need for `c++-font-lock-extra-types'.")
limit
"[-+]"
nil
- (lambda (match-pos inside-macro &optional top-level)
+ (lambda (_match-pos _inside-macro &optional _top-level)
(forward-char)
(c-font-lock-objc-method))))
nil)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index a9d5ac3..8be8060 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -130,7 +130,7 @@
;; This file is not always loaded. See note above.
-(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
+(cc-external-require (if (eq c--cl-library 'cl-lib) 'cl-lib 'cl))
;;; Setup for the `c-lang-defvar' system.
@@ -474,18 +474,19 @@ so that all identifiers are recognized as words.")
;; The value here may be a list of functions or a single function.
t nil
c++ '(c-extend-region-for-CPP
-; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem
needed.
c-before-change-check-raw-strings
c-before-change-check-<>-operators
c-depropertize-CPP
- c-before-after-change-digit-quote
c-invalidate-macro-cache
- c-truncate-bs-cache)
+ c-truncate-bs-cache
+ c-parse-quotes-before-change)
(c objc) '(c-extend-region-for-CPP
c-depropertize-CPP
c-invalidate-macro-cache
- c-truncate-bs-cache)
- ;; java 'c-before-change-check-<>-operators
+ c-truncate-bs-cache
+ c-parse-quotes-before-change)
+ java 'c-parse-quotes-before-change
+ ;; 'c-before-change-check-<>-operators
awk 'c-awk-record-region-clear-NL)
(c-lang-defvar c-get-state-before-change-functions
(let ((fs (c-lang-const c-get-state-before-change-functions)))
@@ -515,18 +516,19 @@ parameters \(point-min) and \(point-max).")
t '(c-depropertize-new-text
c-change-expand-fl-region)
(c objc) '(c-depropertize-new-text
+ c-parse-quotes-after-change
c-extend-font-lock-region-for-macros
c-neutralize-syntax-in-and-mark-CPP
c-change-expand-fl-region)
c++ '(c-depropertize-new-text
+ c-parse-quotes-after-change
c-extend-font-lock-region-for-macros
-; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem
needed.
- c-before-after-change-digit-quote
c-after-change-re-mark-raw-strings
c-neutralize-syntax-in-and-mark-CPP
c-restore-<>-properties
c-change-expand-fl-region)
java '(c-depropertize-new-text
+ c-parse-quotes-after-change
c-restore-<>-properties
c-change-expand-fl-region)
awk '(c-depropertize-new-text
@@ -609,6 +611,12 @@ EOL terminated statements."
(c c++ objc) t)
(c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields))
+(c-lang-defconst c-has-quoted-numbers
+ "Whether the language has numbers quoted like 4'294'967'295."
+ t nil
+ c++ t)
+(c-lang-defvar c-has-quoted-numbers (c-lang-const c-has-quoted-numbers))
+
(c-lang-defconst c-modified-constant
"Regexp that matches a “modified” constant literal such as \"L\\='a\\='\",
a “long character”. In particular, this recognizes forms of constant
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index a501ebb..ef93f75 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."
(forward-line)) ; no infinite loop with, e.g., "#//"
)))))
-(defun c-before-after-change-digit-quote (beg end &optional old-len)
- ;; This function either removes or applies the punctuation value ('(1)) of
- ;; the `syntax-table' text property on single quote marks which are
- ;; separator characters in long integer literals, e.g. "4'294'967'295". It
- ;; applies to both decimal/octal and hex literals. (FIXME (2016-06-10): it
- ;; should also apply to binary literals.)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Parsing of quotes.
+;;
+;; Valid digit separators in numbers will get the syntax-table "punctuation"
+;; property, '(1), and also the text property `c-digit-separator' value t.
+;;
+;; Invalid other quotes (i.e. those not validly bounding a single character,
+;; or escaped character) will get the syntax-table "punctuation" property,
+;; '(1), too.
+;;
+;; Note that, for convenience, these properties are applied even inside
+;; comments and strings.
+
+(defconst c-maybe-quoted-number-head
+ (concat
+ "\\(0\\("
+ "\\([Xx]\\([0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*'?\\)?\\)"
+ "\\|"
+ "\\([Bb]\\([01]\\('[01]\\|[01]\\)*'?\\)?\\)"
+ "\\|"
+ "\\('[0-7]\\|[0-7]\\)*'?"
+ "\\)"
+ "\\|"
+ "[1-9]\\('[0-9]\\|[0-9]\\)*'?"
+ "\\)")
+ "Regexp matching the head of a numeric literal, including with digit
separators.")
+
+(defun c-quoted-number-head-before-point ()
+ ;; Return non-nil when the head of a possibly quoted number is found
+ ;; immediately before point. The value returned in this case is the buffer
+ ;; position of the start of the head. That position is also in
+ ;; (match-beginning 0).
+ (when c-has-quoted-numbers
+ (save-excursion
+ (let ((here (point))
+ found)
+ (skip-chars-backward "0-9a-fA-F'")
+ (if (and (memq (char-before) '(?x ?X))
+ (eq (char-before (1- (point))) ?0))
+ (backward-char 2))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp c-maybe-quoted-number-head here t))
+ (< found here)))
+ (and (eq found here) (match-beginning 0))))))
+
+(defconst c-maybe-quoted-number-tail
+ (concat
+ "\\("
+ "\\([xX']?[0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)"
+ "\\|"
+ "\\([bB']?[01]\\('[01]\\|[01]\\)*\\)"
+ "\\|"
+ "\\('?[0-9]\\('[0-9]\\|[0-9]\\)*\\)"
+ "\\)")
+ "Regexp matching the tail of a numeric literal, including with digit
separators.
+Note that this is a strict tail, so won't match, e.g. \"0x....\".")
+
+(defun c-quoted-number-tail-after-point ()
+ ;; Return non-nil when a proper tail of a possibly quoted number is found
+ ;; immediately after point. The value returned in this case is the buffer
+ ;; position of the end of the tail. That position is also in (match-end 0).
+ (when c-has-quoted-numbers
+ (and (looking-at c-maybe-quoted-number-tail)
+ (match-end 0))))
+
+(defconst c-maybe-quoted-number
+ (concat
+ "\\(0\\("
+ "\\([Xx][0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)"
+ "\\|"
+ "\\([Bb][01]\\('[01]\\|[01]\\)*\\)"
+ "\\|"
+ "\\('[0-7]\\|[0-7]\\)*"
+ "\\)"
+ "\\|"
+ "[1-9]\\('[0-9]\\|[0-9]\\)*"
+ "\\)")
+ "Regexp matching a numeric literal, including with digit separators.")
+
+(defun c-quoted-number-straddling-point ()
+ ;; Return non-nil if a definitely quoted number starts before point and ends
+ ;; after point. In this case the number is bounded by (match-beginning 0)
+ ;; and (match-end 0).
+ (when c-has-quoted-numbers
+ (save-excursion
+ (let ((here (point))
+ (bound (progn (skip-chars-forward "0-9a-fA-F'") (point))))
+ (goto-char here)
+ (when (< (skip-chars-backward "0-9a-fA-F'") 0)
+ (if (and (memq (char-before) '(?x ?X))
+ (eq (char-before (1- (point))) ?0))
+ (backward-char 2))
+ (while (and (search-forward-regexp c-maybe-quoted-number bound t)
+ (<= (match-end 0) here)))
+ (and (< (match-beginning 0) here)
+ (> (match-end 0) here)
+ (save-match-data
+ (goto-char (match-beginning 0))
+ (save-excursion (search-forward "'" (match-end 0) t)))))))))
+
+(defun c-parse-quotes-before-change (beg end)
+ ;; This function analyzes 's near the region (c-new-BEG c-new-END), amending
+ ;; those two variables as needed to include 's into that region when they
+ ;; might be syntactically relevant to the change in progress.
;;
- ;; In both uses of the function, the `syntax-table' properties are
- ;; removed/applied only on quote marks which appear to be digit separators.
+ ;; Having amended that region, the function removes pertinent text
+ ;; properties (syntax-table properties with value '(1) and c-digit-separator
+ ;; props with value t) from 's in it. This operation is performed even
+ ;; within strings and comments.
;;
- ;; Point is undefined on both entry and exit to this function, and the
- ;; return value has no significance. The function is called solely as a
- ;; before-change function (see `c-get-state-before-change-functions') and as
- ;; an after change function (see `c-before-font-lock-functions', with the
- ;; parameters BEG, END, and (optionally) OLD-LEN being given the standard
- ;; values for before/after-change functions.
- (c-save-buffer-state ((num-begin c-new-BEG) digit-re try-end)
+ ;; This function is called exclusively as a before-change function via the
+ ;; variable `c-get-state-before-change-functions'.
+ (c-save-buffer-state (p-limit limits found)
+ ;; Special consideraton for deleting \ from '\''.
+ (if (and (> end beg)
+ (eq (char-before end) ?\\)
+ (<= c-new-END end))
+ (setq c-new-END (min (1+ end) (point-max))))
+
+ ;; Do we have a ' (or something like ',',',',',') within range of
+ ;; c-new-BEG?
+ (goto-char c-new-BEG)
+ (setq p-limit (max (- (point) 2) (point-min)))
+ (while (and (skip-chars-backward "^\\\\'" p-limit)
+ (> (point) p-limit))
+ (when (eq (char-before) ?\\)
+ (setq p-limit (max (1- p-limit) (point-min))))
+ (backward-char)
+ (setq c-new-BEG (point)))
+ (beginning-of-line)
+ (while (and
+ (setq found (search-forward-regexp "\\('\\([^'\\]\\|\\\\.\\)\\)*'"
+ c-new-BEG 'limit))
+ (< (point) (1- c-new-BEG))))
+ (if found
+ (setq c-new-BEG
+ (if (and (eq (point) (1- c-new-BEG))
+ (eq (char-after) ?')) ; "''" before c-new-BEG.
+ (1- c-new-BEG)
+ (match-beginning 0))))
+
+ ;; Check for a number with quote separators straddling c-new-BEG
+ (when c-has-quoted-numbers
+ (goto-char c-new-BEG)
+ (when ;; (c-quoted-number-straddling-point)
+ (c-quoted-number-head-before-point)
+ (setq c-new-BEG (match-beginning 0))))
+
+ ;; Do we have a ' (or something like ',',',',...,',') within range of
+ ;; c-new-END?
(goto-char c-new-END)
- (when (looking-at "\\(x\\)?[0-9a-fA-F']+")
- (setq c-new-END (match-end 0)))
+ (setq p-limit (min (+ (point) 2) (point-max)))
+ (while (and (skip-chars-forward "^\\\\'" p-limit)
+ (< (point) p-limit))
+ (when (eq (char-after) ?\\)
+ (setq p-limit (min (1+ p-limit) (point-max))))
+ (forward-char)
+ (setq c-new-END (point)))
+ (if (looking-at "[^']?\\('\\([^'\\]\\|\\\\.\\)\\)*'")
+ (setq c-new-END (match-end 0)))
+
+ ;; Check for a number with quote separators straddling c-new-END.
+ (when c-has-quoted-numbers
+ (goto-char c-new-END)
+ (when ;; (c-quoted-number-straddling-point)
+ (c-quoted-number-tail-after-point)
+ (setq c-new-END (match-end 0))))
+
+ ;; Remove the '(1) syntax-table property from all "'"s within (c-new-BEG
+ ;; c-new-END).
+ (c-clear-char-property-with-value-on-char
+ c-new-BEG c-new-END
+ 'syntax-table '(1)
+ ?')
+ ;; Remove the c-digit-separator text property from the same "'"s.
+ (when c-has-quoted-numbers
+ (c-clear-char-property-with-value-on-char
+ c-new-BEG c-new-END
+ 'c-digit-separator t
+ ?'))))
+
+(defun c-parse-quotes-after-change (beg end old-len)
+ ;; This function applies syntax-table properties (value '(1)) and
+ ;; c-digit-separator properties as needed to 's within the range (c-new-BEG
+ ;; c-new-END). This operation is performed even within strings and
+ ;; comments.
+ ;;
+ ;; This function is called exclusively as an after-change function via the
+ ;; variable `c-before-font-lock-functions'.
+ (c-save-buffer-state (p-limit limits num-beg num-end clear-from-BEG-to)
+ ;; Apply the needed syntax-table and c-digit-separator text properties to
+ ;; quotes.
(goto-char c-new-BEG)
- (when (looking-at "\\(x?\\)[0-9a-fA-F']")
- (if (re-search-backward "\\(0x\\)?[0-9a-fA-F]*\\=" nil t)
- (setq c-new-BEG (point))))
-
- (while
- (re-search-forward "[0-9a-fA-F]'[0-9a-fA-F]" c-new-END t)
- (setq try-end (1- (point)))
- (re-search-backward "[^0-9a-fA-F']" num-begin t)
- (setq digit-re
- (cond
- ((and (not (bobp)) (eq (char-before) ?0) (memq (char-after) '(?x
?X)))
- "[0-9a-fA-F]")
- ((and (eq (char-after (1+ (point))) ?0)
- (memq (char-after (+ 2 (point))) '(?b ?B)))
- "[01]")
- ((memq (char-after (1+ (point))) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- "[0-9]")
- (t nil)))
- (when digit-re
- (cond ((eq (char-after) ?x) (forward-char))
- ((looking-at ".?0[Bb]") (goto-char (match-end 0)))
- ((looking-at digit-re))
- (t (forward-char)))
- (when (not (c-in-literal))
- (let ((num-end ; End of valid sequence of digits/quotes.
- (save-excursion
- (re-search-forward
- (concat "\\=\\(" digit-re "+'\\)*" digit-re "+") nil t)
- (point))))
- (setq try-end ; End of sequence of digits/quotes
+ (while (and (< (point) c-new-END)
+ (search-forward "'" c-new-END 'limit))
+ (cond ((and (eq (char-before (1- (point))) ?\\)
+ ;; Check we've got an odd number of \s, here.
(save-excursion
- (re-search-forward
- (concat "\\=\\(" digit-re "\\|'\\)+") nil t)
- (point)))
- (while (re-search-forward
- (concat digit-re "\\('\\)" digit-re) num-end t)
- (if old-len ; i.e. are we in an after-change function?
- (c-put-char-property (match-beginning 1) 'syntax-table '(1))
- (c-clear-char-property (match-beginning 1) 'syntax-table))
- (backward-char)))))
- (goto-char try-end)
- (setq num-begin (point)))))
-
-;; The following doesn't seem needed at the moment (2016-08-15).
-;; (defun c-before-after-change-extend-region-for-lambda-capture
-;; (_beg _end &optional _old-len)
-;; ;; In C++ Mode, extend the region (c-new-BEG c-new-END) to cover any
lambda
-;; ;; function capture lists we happen to be inside. This function is
expected
-;; ;; to be called both as a before-change and after change function.
-;; ;;
-;; ;; Note that these things _might_ be nested, with a capture list looking
-;; ;; like:
-;; ;;
-;; ;; [ ...., &foo = [..](){...}(..), ... ]
-;; ;;
-;; ;; . What a wonderful language is C++. ;-)
-;; (c-save-buffer-state (paren-state pos)
-;; (goto-char c-new-BEG)
-;; (setq paren-state (c-parse-state))
-;; (while (setq pos (c-pull-open-brace paren-state))
-;; (goto-char pos)
-;; (when (c-looking-at-c++-lambda-capture-list)
-;; (setq c-new-BEG (min c-new-BEG pos))
-;; (if (c-go-list-forward)
-;; (setq c-new-END (max c-new-END (point))))))
-
-;; (goto-char c-new-END)
-;; (setq paren-state (c-parse-state))
-;; (while (setq pos (c-pull-open-brace paren-state))
-;; (goto-char pos)
-;; (when (c-looking-at-c++-lambda-capture-list)
-;; (setq c-new-BEG (min c-new-BEG pos))
-;; (if (c-go-list-forward)
-;; (setq c-new-END (max c-new-END (point))))))))
+ (backward-char)
+ (eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a
real '.
+ ((c-quoted-number-straddling-point)
+ (setq num-beg (match-beginning 0)
+ num-end (match-end 0))
+ (c-put-char-properties-on-char num-beg num-end
+ 'syntax-table '(1) ?')
+ (c-put-char-properties-on-char num-beg num-end
+ 'c-digit-separator t ?')
+ (goto-char num-end))
+ ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression.
+ (goto-char (match-end 0)))
+ (t (c-put-char-property (1- (point)) 'syntax-table '(1)))))))
(defun c-before-change (beg end)
;; 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 b3848a7..b1c94c3 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -47,6 +47,7 @@
;; `c-add-style' often contains references to functions defined there.
;; Silence the compiler.
+(cc-bytecomp-defun c-guess-basic-syntax)
(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 902a5aa..de0cd50 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -353,8 +353,6 @@ information):
Quotes all \"#\" characters that don't correspond to actual
Tcl comments. (Useful when editing code not originally created
with this mode).
- `tcl-auto-fill-mode'
- Auto-filling of Tcl comments.
Add functions to the hook with `add-hook':
@@ -1413,6 +1411,9 @@ Prefix argument means switch to the Tcl buffer
afterwards."
(defun tcl-auto-fill-mode (&optional arg)
"Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'."
+ (declare
+ (obsolete
+ "Use `auto-fill-mode' with `comment-auto-fill-only-comments'." "26.1"))
(interactive "P")
(auto-fill-mode arg)
(if auto-fill-function
diff --git a/lisp/select.el b/lisp/select.el
index 4849d7d..579c5c7 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -475,6 +475,9 @@ two markers or an overlay. Otherwise, it is nil."
(t
(error "Unknown selection type: %S" type)))))
+ ;; Most programs are unable to handle NUL bytes in strings.
+ (setq str (replace-regexp-in-string "\0" "\\0" str t t))
+
(setq next-selection-coding-system nil)
(cons type str))))
diff --git a/lisp/ses.el b/lisp/ses.el
index fd7174d..97bade3 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."
(declare (debug t))
`(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
(if (eq rc :ses-named)
- (gethash ,sym ses--named-cell-hashmap)
+ (and ses--named-cell-hashmap (gethash ,sym ses--named-cell-hashmap))
rc)))
(defun ses-cell-p (cell)
@@ -868,27 +868,39 @@ means Emacs will crash if FORMULA contains a circular
list."
(oldref (ses-formula-references old))
(newref (ses-formula-references formula))
(inhibit-quit t)
+ not-a-cell-ref-list
x xrow xcol)
(cl-pushnew sym ses--deferred-recalc)
;;Delete old references from this cell. Skip the ones that are also
;;in the new list.
(dolist (ref oldref)
(unless (memq ref newref)
- (setq x (ses-sym-rowcol ref)
- xrow (car x)
- xcol (cdr x))
- (ses-set-cell xrow xcol 'references
- (delq sym (ses-cell-references xrow xcol)))))
+ ;; because we do not cancel edit when the user provides a
+ ;; false reference in it, then we need to check that ref
+ ;; points to a cell that is within the spreadsheet.
+ (setq x (ses-sym-rowcol ref))
+ (and x
+ (< (setq xrow (car x)) ses--numrows)
+ (< (setq xcol (cdr x)) ses--numcols)
+ (ses-set-cell xrow xcol 'references
+ (delq sym (ses-cell-references xrow xcol))))))
;;Add new ones. Skip ones left over from old list
(dolist (ref newref)
- (setq x (ses-sym-rowcol ref)
- xrow (car x)
- xcol (cdr x)
- x (ses-cell-references xrow xcol))
- (or (memq sym x)
- (ses-set-cell xrow xcol 'references (cons sym x))))
+ (setq x (ses-sym-rowcol ref))
+ ;;Do not trust the user, the reference may be outside the spreadsheet
+ (if (and
+ x
+ (< (setq xrow (car x)) ses--numrows)
+ (< (setq xcol (cdr x)) ses--numcols))
+ (progn
+ (setq x (ses-cell-references xrow xcol))
+ (or (memq sym x)
+ (ses-set-cell xrow xcol 'references (cons sym x))))
+ (cl-pushnew ref not-a-cell-ref-list)))
(ses-formula-record formula)
- (ses-set-cell row col 'formula formula))))
+ (ses-set-cell row col 'formula formula)
+ (and not-a-cell-ref-list
+ (error "Found in formula cells not in spreadsheet: %S"
not-a-cell-ref-list)))))
(defun ses-repair-cell-reference-all ()
@@ -1529,7 +1541,13 @@ by (ROWINCR,COLINCR)."
;;Relocate this variable, unless it is a named cell
(if (eq (get sym 'ses-cell) :ses-named)
sym
- (ses-create-cell-symbol row col))
+ ;; otherwise, we create the relocated cell symbol because
+ ;; ses-cell-symbol gives the old symbols, however since
+ ;; renamed cell are not relocated we keep the relocated
+ ;; cell old symbol in this case.
+ (if (eq (get (setq sym (ses-cell-symbol row col)) 'ses-cell)
:ses-named)
+ sym
+ (ses-create-cell-symbol row col)))
;;Delete reference to a deleted cell
nil))))
@@ -2337,7 +2355,8 @@ to are recalculated first."
"Recalculate and reprint all cells."
(interactive "*")
(let ((startcell (ses--cell-at-pos (point)))
- (ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows)
+ (ses--curcell (cons (ses-cell-symbol 0 0)
+ (ses-cell-symbol (1- ses--numrows)
(1- ses--numcols)))))
(ses-recalculate-cell ses--curcell)
(ses-jump-safe startcell)))
diff --git a/lisp/subr.el b/lisp/subr.el
index ef00286..a9edff6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -121,6 +121,7 @@ BODY should be a list of Lisp expressions.
(defmacro setq-local (var val)
"Set variable VAR to value VAL in current buffer."
;; Can't use backquote here, it's too early in the bootstrap.
+ (declare (debug (symbolp form)))
(list 'set (list 'make-local-variable (list 'quote var)) val))
(defmacro defvar-local (var val &optional docstring)
@@ -4513,7 +4514,8 @@ EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
(defun backtrace ()
"Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'."
- (let ((print-level (or print-level 8)))
+ (let ((print-level (or print-level 8))
+ (print-escape-control-characters t))
(mapbacktrace #'backtrace--print-frame 'backtrace)))
(defun backtrace-frames (&optional base)
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index fda9388..be895a0 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.")
;;; Fix interface to (X-specific) mouse.el
(defun w32--set-selection (type value)
(if (eq type 'CLIPBOARD)
- (w32-set-clipboard-data value)
+ (w32-set-clipboard-data (replace-regexp-in-string "\0" "\\0" value t t))
(put 'x-selections (or type 'PRIMARY) value)))
(defun w32--get-selection (&optional type data-type)
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 367114b..c011f1b 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -119,7 +119,8 @@ the value of `tooltip-y-offset' is ignored."
(defcustom tooltip-frame-parameters
'((name . "tooltip")
(internal-border-width . 2)
- (border-width . 1))
+ (border-width . 1)
+ (no-special-glyphs . t))
"Frame parameters used for tooltips.
If `left' or `top' parameters are included, they specify the absolute
@@ -130,7 +131,8 @@ of the `tooltip' face are used instead."
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
(sexp :tag "Value")))
- :group 'tooltip)
+ :group 'tooltip
+ :version "26.1")
(defface tooltip
'((((class color))
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 1fa0854..8657d19 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,4 +1,4 @@
-;;; url-history.el --- Global history tracking for URL package
+;;; url-history.el --- Global history tracking for URL package -*-
lexical-binding:t -*-
;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc.
@@ -106,7 +106,7 @@ to run the `url-history-setup-save-timer' function
manually."
(defun url-history-update-url (url time)
(setq url-history-changed-since-last-save t)
- (puthash (if (vectorp url) (url-recreate-url url) url) time
+ (puthash (if (url-p url) (url-recreate-url url) url) time
url-history-hash-table))
(autoload 'url-make-private-file "url-util")
@@ -157,6 +157,7 @@ user for what type to save as."
(gethash url url-history-hash-table nil))
(defun url-completion-function (string predicate function)
+ (declare (obsolete url-history-hash-table "26.1"))
;; Completion function to complete urls from the history.
;; This is obsolete since we can now pass the hash-table directly as a
;; completion table.
@@ -164,7 +165,7 @@ user for what type to save as."
(cond
((eq function nil)
(let ((list nil))
- (maphash (lambda (key val) (push key list))
+ (maphash (lambda (key _) (push key list))
url-history-hash-table)
;; Not sure why we bother reversing the list. --Stef
(try-completion string (nreverse list) predicate)))
@@ -172,7 +173,7 @@ user for what type to save as."
(let ((stub (concat "\\`" (regexp-quote string)))
(retval nil))
(maphash
- (lambda (url time)
+ (lambda (url _)
(if (string-match stub url) (push url retval)))
url-history-hash-table)
retval))
diff --git a/lisp/window.el b/lisp/window.el
index 8b07ed4..c933996 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
ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
(let* ((window (window-normalize-window window body))
(frame (window-frame window))
- (border-width (frame-border-width frame))
+ (border-width (frame-internal-border-width frame))
(char-width (frame-char-width frame))
(char-height (frame-char-height frame))
(left (if pixelwise
@@ -4572,12 +4572,13 @@ The function is called with one argument - a frame.
Functions affected by this option are those that bury a buffer
shown in a separate frame like `quit-window' and `bury-buffer'."
:type '(choice (const :tag "Iconify" iconify-frame)
+ (const :tag "Make invisible" make-frame-invisible)
(const :tag "Delete" delete-frame)
(const :tag "Do nothing" ignore)
function)
:group 'windows
:group 'frames
- :version "24.1")
+ :version "26.1")
(defun window--delete (&optional window dedicated-only kill)
"Delete WINDOW if possible.
@@ -4595,7 +4596,9 @@ if WINDOW gets deleted or its frame is auto-hidden."
(cond
(kill
(delete-frame frame))
- ((functionp frame-auto-hide-function)
+ ((functionp (frame-parameter frame 'auto-hide-function))
+ (funcall (frame-parameter frame 'auto-hide-function)))
+ ((functionp frame-auto-hide-function)
(funcall frame-auto-hide-function frame))))
'frame)
(deletable
@@ -6734,15 +6737,17 @@ live."
window))
(defun window--maybe-raise-frame (frame)
- (let ((visible (frame-visible-p frame)))
- (unless (or (not visible)
- ;; Assume the selected frame is already visible enough.
- (eq frame (selected-frame))
- ;; Assume the frame from which we invoked the
- ;; minibuffer is visible.
- (and (minibuffer-window-active-p (selected-window))
- (eq frame (window-frame (minibuffer-selected-window)))))
- (raise-frame frame))))
+ (make-frame-visible frame)
+ (unless (or (frame-parameter frame 'no-focus-on-map)
+ ;; Don't raise frames that should not get focus.
+ (frame-parameter frame 'no-accept-focus)
+ ;; Assume the selected frame is already visible enough.
+ (eq frame (selected-frame))
+ ;; Assume the frame from which we invoked the
+ ;; minibuffer is visible.
+ (and (minibuffer-window-active-p (selected-window))
+ (eq frame (window-frame (minibuffer-selected-window)))))
+ (raise-frame frame)))
;; FIXME: Not implemented.
;; 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
(const display-buffer-pop-up-window)
(const display-buffer-same-window)
(const display-buffer-pop-up-frame)
+ (const display-buffer-in-child-frame)
(const display-buffer-below-selected)
(const display-buffer-at-bottom)
(const display-buffer-in-previous-window)
@@ -6908,6 +6914,7 @@ Available action functions include:
`display-buffer-same-window'
`display-buffer-reuse-window'
`display-buffer-pop-up-frame'
+ `display-buffer-in-child-frame'
`display-buffer-pop-up-window'
`display-buffer-in-previous-window'
`display-buffer-use-some-window'
@@ -7239,6 +7246,7 @@ raising the frame."
(get-largest-window frame t) alist)
(window--try-to-split-window
(get-lru-window frame t) alist))))
+
(prog1 (window--display-buffer
buffer window 'window alist display-buffer-mark-dedicated)
(unless (cdr (assq 'inhibit-switch-frame alist))
@@ -7258,6 +7266,47 @@ again with `display-buffer-pop-up-window'."
(and pop-up-windows
(display-buffer-pop-up-window buffer alist))))
+(defun display-buffer-in-child-frame (buffer alist)
+ "Display BUFFER in a child frame.
+By default, this either reuses a child frame of the selected
+frame or makes a new child frame of the selected frame. If
+successful, return the window used; otherwise return nil.
+
+If ALIST has a non-nil 'child-frame-parameters' entry, the
+corresponding value is an alist of frame parameters to give the
+new frame. A 'parent-frame' parameter specifying the selected
+frame is provided by default. If the child frame should be or
+become the child of any other frame, a corresponding entry must
+be added to ALIST."
+ (let* ((parameters
+ (append
+ (cdr (assq 'child-frame-parameters alist))
+ `((parent-frame . ,(selected-frame)))))
+ (parent (or (assq 'parent-frame parameters)
+ (selected-frame)))
+ (share (assq 'share-child-frame parameters))
+ share1 frame window)
+ (with-current-buffer buffer
+ (when (frame-live-p parent)
+ (catch 'frame
+ (dolist (frame1 (frame-list))
+ (when (eq (frame-parent frame1) parent)
+ (setq share1 (assq 'share-child-frame
+ (frame-parameters frame1)))
+ (when (eq share share1)
+ (setq frame frame1)
+ (throw 'frame t))))))
+
+ (if frame
+ (setq window (frame-selected-window frame))
+ (setq frame (make-frame parameters))
+ (setq window (frame-selected-window frame))))
+
+ (prog1 (window--display-buffer
+ buffer window 'frame alist display-buffer-mark-dedicated)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame frame)))))
+
(defun display-buffer-below-selected (buffer alist)
"Try displaying BUFFER in a window below the selected window.
If there is a window below the selected one and that window
@@ -7272,7 +7321,8 @@ below the selected one, use that window."
(and (not (frame-parameter nil 'unsplittable))
(let ((split-height-threshold 0)
split-width-threshold)
- (setq window (window--try-to-split-window (selected-window)
alist)))
+ (setq window (window--try-to-split-window
+ (selected-window) alist)))
(window--display-buffer
buffer window 'window alist display-buffer-mark-dedicated))
(and (setq window (window-in-direction 'below))
@@ -7885,10 +7935,12 @@ See also `fit-frame-to-buffer-margins'."
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
(defun window--sanitize-margin (margin left right)
- "Return MARGIN if it's a number between LEFT and RIGHT."
- (when (and (numberp margin)
- (<= left (- right margin)) (<= margin right))
- margin))
+ "Return MARGIN if it's a number between LEFT and RIGHT.
+Return 0 otherwise."
+ (if (and (numberp margin)
+ (<= left (- right margin)) (<= margin right))
+ margin
+ 0))
(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
@@ -7906,190 +7958,197 @@ horizontally only.
The new position and size of FRAME can be additionally determined
by customizing the options `fit-frame-to-buffer-sizes' and
-`fit-frame-to-buffer-margins' or the corresponding parameters of
-FRAME."
+`fit-frame-to-buffer-margins' or setting the corresponding
+parameters of FRAME."
(interactive)
- (unless (and (fboundp 'x-display-pixel-height)
- ;; We need the respective sizes now.
- (fboundp 'display-monitor-attributes-list))
+ (unless (fboundp 'display-monitor-attributes-list)
(user-error "Cannot resize frame in non-graphic Emacs"))
(setq frame (window-normalize-frame frame))
(when (window-live-p (frame-root-window frame))
- (with-selected-window (frame-root-window frame)
- (let* ((char-width (frame-char-width))
- (char-height (frame-char-height))
- (monitor-attributes (car (display-monitor-attributes-list
- (frame-parameter frame 'display))))
- (geometry (cdr (assq 'geometry monitor-attributes)))
- (display-width (- (nth 2 geometry) (nth 0 geometry)))
- (display-height (- (nth 3 geometry) (nth 1 geometry)))
- (workarea (cdr (assq 'workarea monitor-attributes)))
- ;; Handle margins.
- (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
- fit-frame-to-buffer-margins))
- (left-margin (if (nth 0 margins)
- (or (window--sanitize-margin
- (nth 0 margins) 0 display-width)
- 0)
- (nth 0 workarea)))
- (top-margin (if (nth 1 margins)
- (or (window--sanitize-margin
- (nth 1 margins) 0 display-height)
- 0)
- (nth 1 workarea)))
- (workarea-width (nth 2 workarea))
- (right-margin (if (nth 2 margins)
- (- display-width
- (or (window--sanitize-margin
- (nth 2 margins) left-margin
display-width)
- 0))
- (nth 2 workarea)))
- (workarea-height (nth 3 workarea))
- (bottom-margin (if (nth 3 margins)
- (- display-height
- (or (window--sanitize-margin
- (nth 3 margins) top-margin
display-height)
- 0))
- (nth 3 workarea)))
- ;; The pixel width of FRAME (which does not include the
- ;; window manager's decorations).
- (frame-width (frame-pixel-width))
- ;; The pixel width of the body of FRAME's root window.
- (window-body-width (window-body-width nil t))
- ;; The difference in pixels between total and body width of
- ;; FRAME's window.
- (window-extra-width (- (window-pixel-width) window-body-width))
- ;; The difference in pixels between the frame's pixel width
- ;; and the window's body width. This is the space we can't
- ;; use for fitting.
- (extra-width (- frame-width window-body-width))
- ;; The pixel position of FRAME's left border. We usually
- ;; try to leave this alone.
- (left
- (let ((left (frame-parameter nil 'left)))
- (if (consp left)
- (funcall (car left) (cadr left))
- left)))
- ;; The pixel height of FRAME (which does not include title
- ;; line, decorations, and sometimes neither the menu nor
- ;; the toolbar).
- (frame-height (frame-pixel-height))
- ;; The pixel height of FRAME's root window (we don't care
- ;; about the window's body height since the return value of
- ;; `window-text-pixel-size' includes header and mode line).
- (window-height (window-pixel-height))
- ;; The difference in pixels between the frame's pixel
- ;; height and the window's height.
- (extra-height (- frame-height window-height))
- ;; The pixel position of FRAME's top border.
- (top
- (let ((top (frame-parameter nil 'top)))
- (if (consp top)
- (funcall (car top) (cadr top))
- top)))
- ;; Sanitize minimum and maximum sizes.
- (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
- fit-frame-to-buffer-sizes))
- (max-height
- (cond
- ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
- ((numberp max-height) (* max-height char-height))
- (t display-height)))
- (min-height
- (cond
- ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
- ((numberp min-height) (* min-height char-height))
- (t (* window-min-height char-height))))
- (max-width
- (cond
- ((numberp (nth 2 sizes))
- (- (* (nth 2 sizes) char-width) window-extra-width))
- ((numberp max-width)
- (- (* max-width char-width) window-extra-width))
- (t display-width)))
- (min-width
- (cond
- ((numberp (nth 3 sizes))
- (- (* (nth 3 sizes) char-width) window-extra-width))
- ((numberp min-width)
- (- (* min-width char-width) window-extra-width))
- (t (* window-min-width char-width))))
- ;; Note: Currently, for a new frame the sizes of the header
- ;; and mode line may be estimated incorrectly
- (value (window-text-pixel-size
- nil t t workarea-width workarea-height t))
- (width (+ (car value) (window-right-divider-width)))
- (height
- (+ (cdr value)
- (window-bottom-divider-width)
- (window-scroll-bar-height))))
- ;; Don't change height or width when the window's size is fixed
- ;; in either direction or ONLY forbids it.
- (cond
- ((or (eq window-size-fixed 'width) (eq only 'vertically))
- (setq width nil))
- ((or (eq window-size-fixed 'height) (eq only 'horizontally))
- (setq height nil)))
- ;; Fit width to constraints.
- (when width
- (unless frame-resize-pixelwise
- ;; Round to character sizes.
- (setq width (* (/ (+ width char-width -1) char-width)
- char-width)))
- ;; Fit to maximum and minimum widths.
- (setq width (max (min width max-width) min-width))
- ;; Add extra width.
- (setq width (+ width extra-width))
- ;; Preserve margins.
- (let ((right (+ left width)))
- (cond
- ((> right right-margin)
- ;; Move frame to left (we don't know its real width).
- (setq left (max left-margin (- left (- right right-margin)))))
- ((< left left-margin)
- ;; Move frame to right.
- (setq left left-margin)))))
- ;; Fit height to constraints.
- (when height
- (unless frame-resize-pixelwise
- (setq height (* (/ (+ height char-height -1) char-height)
- char-height)))
- ;; Fit to maximum and minimum heights.
- (setq height (max (min height max-height) min-height))
- ;; Add extra height.
- (setq height (+ height extra-height))
- ;; Preserve margins.
- (let ((bottom (+ top height)))
- (cond
- ((> bottom bottom-margin)
- ;; Move frame up (we don't know its real height).
- (setq top (max top-margin (- top (- bottom bottom-margin)))))
- ((< top top-margin)
- ;; Move frame down.
- (setq top top-margin)))))
- ;; Apply changes.
- (set-frame-position frame left top)
- ;; Clumsily try to translate our calculations to what
- ;; `set-frame-size' wants.
- (when width
- (setq width (- (+ (frame-text-width) width)
- extra-width window-body-width)))
- (when height
- (setq height (- (+ (frame-text-height) height)
- extra-height window-height)))
- (set-frame-size
- frame
- (if width
- (if frame-resize-pixelwise
- width
- (/ width char-width))
- (frame-text-width))
- (if height
- (if frame-resize-pixelwise
- height
- (/ height char-height))
- (frame-text-height))
- frame-resize-pixelwise)))))
+ (let* ((char-width (frame-char-width frame))
+ (char-height (frame-char-height frame))
+ ;; WINDOW is FRAME's root window.
+ (window (frame-root-window frame))
+ (parent (frame-parent frame))
+ (monitor-attributes
+ (unless parent
+ (car (display-monitor-attributes-list
+ (frame-parameter frame 'display)))))
+ ;; FRAME'S parent or display sizes. Used in connection
+ ;; with margins.
+ (geometry
+ (unless parent
+ (cdr (assq 'geometry monitor-attributes))))
+ (parent-or-display-width
+ (if parent
+ (frame-native-width parent)
+ (- (nth 2 geometry) (nth 0 geometry))))
+ (parent-or-display-height
+ (if parent
+ (frame-native-height parent)
+ (- (nth 3 geometry) (nth 1 geometry))))
+ ;; FRAME'S parent or workarea sizes. Used when no margins
+ ;; are specified.
+ (parent-or-workarea
+ (if parent
+ `(0 0 ,parent-or-display-width ,parent-or-display-height)
+ (cdr (assq 'workarea monitor-attributes))))
+ ;; The outer size of FRAME. Needed to calculate the
+ ;; margins around the root window's body that have to
+ ;; remain untouched by fitting.
+ (outer-edges (frame-edges frame 'outer-edges))
+ (outer-width (if outer-edges
+ (- (nth 2 outer-edges) (nth 0 outer-edges))
+ ;; A poor guess.
+ (frame-pixel-width frame)))
+ (outer-height (if outer-edges
+ (- (nth 3 outer-edges) (nth 1 outer-edges))
+ ;; Another poor guess.
+ (frame-pixel-height frame)))
+ ;; The text size of of FRAME. Needed to specify FRAME's
+ ;; text size after the root window's body's new sizes have
+ ;; been calculated.
+ (text-width (frame-text-width frame))
+ (text-height (frame-text-height frame))
+ ;; WINDOW's body size.
+ (body-width (window-body-width window t))
+ (body-height (window-body-height window t))
+ ;; The difference between FRAME's outer size and WINDOW's
+ ;; body size.
+ (outer-minus-body-width (- outer-width body-width))
+ (outer-minus-body-height (- outer-height body-height))
+ ;; The difference between FRAME's text size and WINDOW's
+ ;; body size (these values "should" be positive).
+ (text-minus-body-width (- text-width body-width))
+ (text-minus-body-height (- text-height body-height))
+ ;; The current position of FRAME.
+ (position (frame-position frame))
+ (left (car position))
+ (top (cdr position))
+ ;; The margins specified for FRAME. These represent pixel
+ ;; offsets from the left, top, right and bottom edge of the
+ ;; display or FRAME's parent's native rectangle and have to
+ ;; take care of the display's taskbar and other obstacles.
+ ;; If they are unspecified, constrain the resulting frame
+ ;; to its workarea or the parent frame's native rectangle.
+ (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
+ fit-frame-to-buffer-margins))
+ ;; Convert margins intto pixel offsets from the left-top
+ ;; corner of FRAME's display or parent.
+ (left-margin (if (nth 0 margins)
+ (window--sanitize-margin
+ (nth 0 margins) 0 parent-or-display-width)
+ (nth 0 parent-or-workarea)))
+ (top-margin (if (nth 1 margins)
+ (window--sanitize-margin
+ (nth 1 margins) 0 parent-or-display-height)
+ (nth 1 parent-or-workarea)))
+ (right-margin (if (nth 2 margins)
+ (- parent-or-display-width
+ (window--sanitize-margin
+ (nth 2 margins) left-margin
+ parent-or-display-width))
+ (nth 2 parent-or-workarea)))
+ (bottom-margin (if (nth 3 margins)
+ (- parent-or-display-height
+ (window--sanitize-margin
+ (nth 3 margins) top-margin
+ parent-or-display-height))
+ (nth 3 parent-or-workarea)))
+ ;; Minimum and maximum sizes specified for FRAME.
+ (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
+ fit-frame-to-buffer-sizes))
+ ;; Calculate the minimum and maximum pixel sizes of FRAME
+ ;; from the values provided by the MAX-HEIGHT, MIN-HEIGHT,
+ ;; MAX-WIDTH and MIN-WIDTH arguments or, if these are nil,
+ ;; from those provided by `fit-frame-to-buffer-sizes'.
+ (max-height
+ (min
+ (cond
+ ((numberp max-height) (* max-height char-height))
+ ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
+ (t parent-or-display-height))
+ ;; The following is the maximum height that fits into the
+ ;; top and bottom margins.
+ (max (- bottom-margin top-margin outer-minus-body-height))))
+ (min-height
+ (cond
+ ((numberp min-height) (* min-height char-height))
+ ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
+ (t (window-min-size window nil nil t))))
+ (max-width
+ (min
+ (cond
+ ((numberp max-width) (* max-width char-width))
+ ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width))
+ (t parent-or-display-width))
+ ;; The following is the maximum width that fits into the
+ ;; left and right margins.
+ (max (- right-margin left-margin outer-minus-body-width))))
+ (min-width
+ (cond
+ ((numberp min-width) (* min-width char-width))
+ ((numberp (nth 3 sizes)) (nth 3 sizes))
+ (t (window-min-size window t nil t))))
+ ;; Note: Currently, for a new frame the sizes of the header
+ ;; and mode line may be estimated incorrectly
+ (size
+ (window-text-pixel-size window t t max-width max-height))
+ (width (max (car size) min-width))
+ (height (max (cdr size) min-height)))
+ ;; Don't change height or width when the window's size is fixed
+ ;; in either direction or ONLY forbids it.
+ (cond
+ ((or (eq window-size-fixed 'width) (eq only 'vertically))
+ (setq width nil))
+ ((or (eq window-size-fixed 'height) (eq only 'horizontally))
+ (setq height nil)))
+ ;; Fit width to constraints.
+ (when width
+ (unless frame-resize-pixelwise
+ ;; Round to character sizes.
+ (setq width (* (/ (+ width char-width -1) char-width)
+ char-width)))
+ ;; The new outer width (in pixels).
+ (setq outer-width (+ width outer-minus-body-width))
+ ;; Maybe move FRAME to preserve margins.
+ (let ((right (+ left outer-width)))
+ (cond
+ ((> right right-margin)
+ ;; Move frame to left.
+ (setq left (max left-margin (- left (- right right-margin)))))
+ ((< left left-margin)
+ ;; Move frame to right.
+ (setq left left-margin)))))
+ ;; Fit height to constraints.
+ (when height
+ (unless frame-resize-pixelwise
+ (setq height (* (/ (+ height char-height -1) char-height)
+ char-height)))
+ ;; The new outer height.
+ (setq outer-height (+ height outer-minus-body-height))
+ ;; Preserve margins.
+ (let ((bottom (+ top outer-height)))
+ (cond
+ ((> bottom bottom-margin)
+ ;; Move frame up.
+ (setq top (max top-margin (- top (- bottom bottom-margin)))))
+ ((< top top-margin)
+ ;; Move frame down.
+ (setq top top-margin)))))
+ ;; Apply our changes.
+ (setq text-width
+ (if width
+ (+ width text-minus-body-width)
+ (frame-text-width frame)))
+ (setq text-height
+ (if height
+ (+ height text-minus-body-height)
+ (frame-text-height frame)))
+ (modify-frame-parameters
+ frame `((left . ,left) (top . ,top)
+ (width . (text-pixels . ,text-width))
+ (height . (text-pixels . ,text-height)))))))
(defun fit-window-to-buffer (&optional window max-height min-height max-width
min-width preserve-size)
"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."
(when (and (window-combined-p window)
(pos-visible-in-window-p (point-min) window))
(fit-window-to-buffer window (window-total-height window))))
+
+(defun window-largest-empty-rectangle--maximums-1 (quad maximums)
+ "Support function for `window-largest-empty-rectangle'."
+ (cond
+ ((null maximums)
+ (list quad))
+ ((> (car quad) (caar maximums))
+ (cons quad maximums))
+ (t
+ (cons (car maximums)
+ (window-largest-empty-rectangle--maximums-1 quad (cdr maximums))))))
+
+(defun window-largest-empty-rectangle--maximums (quad maximums count)
+ "Support function for `window-largest-empty-rectangle'."
+ (setq maximums (window-largest-empty-rectangle--maximums-1 quad maximums))
+ (if (> (length maximums) count)
+ (nbutlast maximums)
+ maximums))
+
+(defun window-largest-empty-rectangle--disjoint-maximums (maximums count)
+ "Support function for `window-largest-empty-rectangle'."
+ (setq maximums (sort maximums (lambda (x y) (> (car x) (car y)))))
+ (let ((new-length 0)
+ new-maximums)
+ (while (and maximums (< new-length count))
+ (let* ((maximum (car maximums))
+ (at (nth 2 maximum))
+ (to (nth 3 maximum)))
+ (catch 'drop
+ (dolist (new-maximum new-maximums)
+ (let ((new-at (nth 2 new-maximum))
+ (new-to (nth 3 new-maximum)))
+ (when (if (< at new-at) (> to new-at) (< at new-to))
+ ;; Intersection -> drop.
+ (throw 'drop nil))))
+ (setq new-maximums (cons maximum new-maximums))
+ (setq new-length (1+ new-length)))
+ (setq maximums (cdr maximums))))
+
+ (nreverse new-maximums)))
+
+(defun window-largest-empty-rectangle (&optional window count min-width
min-height positions left)
+ "Return dimensions of largest empty rectangle in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+The return value is a triple of the width and the start and end
+Y-coordinates of the largest rectangle that can be inscribed into
+the empty space (the space not displaying any text) of WINDOW's
+text area. The return value is nil if the current glyph matrix
+of WINDOW is not up-to-date.
+
+Optional argument COUNT, if non-nil, specifies the maximum number
+of rectangles to return. This means that the return value is a
+list of triples specifying rectangles with the largest rectangle
+first. COUNT can be also a cons cell whose car specifies the
+number of rectangles to return and whose cdr, if non-nil, states
+that all rectangles returned must be disjoint.
+
+Note that the right edge of any rectangle returned by this
+function is the right edge of WINDOW (the left edge if its buffer
+displays RTL text).
+
+Optional arguments MIN-WIDTH and MIN-HEIGHT, if non-nil, specify
+the minimum width and height of any rectangle returned.
+
+Optional argument POSITIONS, if non-nil, is a cons cell whose car
+specifies the uppermost and whose cdr specifies the lowermost
+pixel position that must be covered by any rectangle returned.
+Note that positions are counted from the start of the text area
+of WINDOW.
+
+Optional argument LEFT, if non-nil, means to return values suitable for
+buffers displaying right to left text."
+ ;; Process lines as returned by ‘window-lines-pixel-dimensions’.
+ ;; STACK is a stack that contains rows that have to be processed yet.
+ (let* ((window (window-normalize-window window t))
+ (disjoint (and (consp count) (cdr count)))
+ (count (or (and (numberp count) count)
+ (and (consp count) (numberp (car count)) (car count))))
+ (rows (window-lines-pixel-dimensions window nil nil t t left))
+ (rows-at 0)
+ (max-size 0)
+ row stack stack-at stack-to
+ top top-width top-at top-to top-size
+ max-width max-at max-to maximums)
+ ;; ROWS-AT is the position where the first element of ROWS starts.
+ ;; STACK-AT is the position where the first element of STACK starts.
+ (while rows
+ (setq row (car rows))
+ (if (or (not stack) (>= (car row) (caar stack)))
+ (progn
+ (unless stack
+ (setq stack-at rows-at))
+ (setq stack (cons row stack))
+ ;; Set ROWS-AT to where the first element of ROWS ends
+ ;; which, after popping ROW, makes it the start position of
+ ;; the next ROW.
+ (setq rows-at (cdr row))
+ (setq rows (cdr rows)))
+ (setq top (car stack))
+ (setq stack (cdr stack))
+ (setq top-width (car top))
+ (setq top-at (if stack (cdar stack) stack-at))
+ (setq top-to (cdr top))
+ (setq top-size (* top-width (- top-to top-at)))
+ (unless (or (and min-width (< top-width min-width))
+ (and min-height (< (- top-to top-at) min-height))
+ (and positions
+ (or (> top-at (car positions))
+ (< top-to (cdr positions)))))
+ (if count
+ (if disjoint
+ (setq maximums (cons (list top-size top-width top-at top-to)
+ maximums))
+ (setq maximums (window-largest-empty-rectangle--maximums
+ (list top-size top-width top-at top-to)
+ maximums count)))
+ (when (> top-size max-size)
+ (setq max-size top-size)
+ (setq max-width top-width)
+ (setq max-at top-at)
+ (setq max-to top-to))))
+ (if (and stack (> (caar stack) (car row)))
+ ;; Have new top element of stack include old top.
+ (setq stack (cons (cons (caar stack) (cdr top)) (cdr stack)))
+ ;; Move rows-at backwards to top-at.
+ (setq rows-at top-at))))
+
+ (when stack
+ ;; STACK-TO is the position where the stack ends.
+ (setq stack-to (cdar stack))
+ (while stack
+ (setq top (car stack))
+ (setq stack (cdr stack))
+ (setq top-width (car top))
+ (setq top-at (if stack (cdar stack) stack-at))
+ (setq top-size (* top-width (- stack-to top-at)))
+ (unless (or (and min-width (< top-width min-width))
+ (and min-height (< (- stack-to top-at) min-height))
+ (and positions
+ (or (> top-at (car positions))
+ (< stack-to (cdr positions)))))
+ (if count
+ (if disjoint
+ (setq maximums (cons (list top-size top-width top-at stack-to)
+ maximums))
+ (setq maximums (window-largest-empty-rectangle--maximums
+ (list top-size top-width top-at stack-to)
+ maximums count)))
+ (when (> top-size max-size)
+ (setq max-size top-size)
+ (setq max-width top-width)
+ (setq max-at top-at)
+ (setq max-to stack-to))))))
+
+ (cond
+ (maximums
+ (if disjoint
+ (window-largest-empty-rectangle--disjoint-maximums maximums count)
+ maximums))
+ ((> max-size 0)
+ (list max-width max-at max-to)))))
(defun kill-buffer-and-window ()
"Kill the current buffer and delete the selected window."
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 1ac58e8..107645d 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -158,6 +158,7 @@ AC_DEFUN([gl_EARLY],
# Code from module timespec-sub:
# Code from module u64:
# Code from module unistd:
+ # Code from module unlocked-io:
# Code from module update-copyright:
# Code from module utimens:
# Code from module vararrays:
@@ -399,6 +400,7 @@ AC_DEFUN([gl_INIT],
gl_TIMER_TIME
gl_TIMESPEC
gl_UNISTD_H
+ gl_FUNC_GLIBC_UNLOCKED_IO
gl_UTIMENS
AC_C_VARARRAYS
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
@@ -940,6 +942,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/u64.h
lib/unistd.c
lib/unistd.in.h
+ lib/unlocked-io.h
lib/utimens.c
lib/utimens.h
lib/verify.h
@@ -1044,6 +1047,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/timespec.m4
m4/tm_gmtoff.m4
m4/unistd_h.m4
+ m4/unlocked-io.m4
m4/utimens.m4
m4/utimes.m4
m4/vararrays.m4
diff --git a/m4/unlocked-io.m4 b/m4/unlocked-io.m4
new file mode 100644
index 0000000..448ccac
--- /dev/null
+++ b/m4/unlocked-io.m4
@@ -0,0 +1,41 @@
+# unlocked-io.m4 serial 15
+
+# Copyright (C) 1998-2006, 2009-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering.
+dnl
+dnl See if the glibc *_unlocked I/O macros or functions are available.
+dnl Use only those *_unlocked macros or functions that are declared
+dnl (because some of them were declared in Solaris 2.5.1 but were removed
+dnl in Solaris 2.6, whereas we want binaries built on Solaris 2.5.1 to run
+dnl on Solaris 2.6).
+
+AC_DEFUN([gl_FUNC_GLIBC_UNLOCKED_IO],
+[
+ AC_DEFINE([USE_UNLOCKED_IO], [1],
+ [Define to 1 if you want getc etc. to use unlocked I/O if available.
+ Unlocked I/O can improve performance in unithreaded apps,
+ but it is not safe for multithreaded apps.])
+
+ dnl Persuade glibc and Solaris <stdio.h> to declare
+ dnl fgets_unlocked(), fputs_unlocked() etc.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_DECLS_ONCE([clearerr_unlocked])
+ AC_CHECK_DECLS_ONCE([feof_unlocked])
+ AC_CHECK_DECLS_ONCE([ferror_unlocked])
+ AC_CHECK_DECLS_ONCE([fflush_unlocked])
+ AC_CHECK_DECLS_ONCE([fgets_unlocked])
+ AC_CHECK_DECLS_ONCE([fputc_unlocked])
+ AC_CHECK_DECLS_ONCE([fputs_unlocked])
+ AC_CHECK_DECLS_ONCE([fread_unlocked])
+ AC_CHECK_DECLS_ONCE([fwrite_unlocked])
+ AC_CHECK_DECLS_ONCE([getc_unlocked])
+ AC_CHECK_DECLS_ONCE([getchar_unlocked])
+ AC_CHECK_DECLS_ONCE([putc_unlocked])
+ AC_CHECK_DECLS_ONCE([putchar_unlocked])
+])
diff --git a/src/charset.c b/src/charset.c
index 9d15375..d0840f7 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/>. */
#include <config.h>
#include <errno.h>
-#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <limits.h>
@@ -40,6 +39,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include "charset.h"
#include "coding.h"
#include "buffer.h"
+#include "sysstdio.h"
/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
@@ -198,10 +198,6 @@ static struct
#define GET_TEMP_CHARSET_WORK_DECODER(CODE) \
(temp_charset_work->table.decoder[(CODE)])
-
-#ifndef HAVE_GETC_UNLOCKED
-#define getc_unlocked getc
-#endif
/* 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 efa50b0..9a90f37 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/>. */
#include <config.h>
-#include <stdio.h>
#include "lisp.h"
#include "cm.h"
+#include "sysstdio.h"
#include "termchar.h"
#include "tparam.h"
@@ -45,8 +45,8 @@ int
cmputc (int c)
{
if (current_tty->termscript)
- putc (c & 0177, current_tty->termscript);
- putc (c & 0177, current_tty->output);
+ putc_unlocked (c & 0177, current_tty->termscript);
+ putc_unlocked (c & 0177, current_tty->output);
return c;
}
@@ -117,11 +117,11 @@ cmcheckmagic (struct tty_display_info *tty)
if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1)
emacs_abort ();
if (tty->termscript)
- putc ('\r', tty->termscript);
- putc ('\r', tty->output);
+ putc_unlocked ('\r', tty->termscript);
+ putc_unlocked ('\r', tty->output);
if (tty->termscript)
- putc ('\n', tty->termscript);
- putc ('\n', tty->output);
+ putc_unlocked ('\n', tty->termscript);
+ putc_unlocked ('\n', tty->output);
curX (tty) = 0;
curY (tty)++;
}
diff --git a/src/dispextern.h b/src/dispextern.h
index d1e4715..8644ce2 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1106,7 +1106,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
#define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \
((MATRIX)->rows \
+ (MATRIX)->nrows \
- - (WINDOW_WANTS_MODELINE_P ((W)) ? 1 : 0))
+ - (window_wants_mode_line ((W)) ? 1 : 0))
/* Non-zero if the face of the last glyph in ROW's text area has
to be drawn to the end of the text area. */
@@ -1469,40 +1469,6 @@ struct glyph_string
#define DESIRED_HEADER_LINE_HEIGHT(W) \
MATRIX_HEADER_LINE_HEIGHT ((W)->desired_matrix)
-/* PXW: The height checks below serve to show at least one text line
- instead of a mode- and/or header line when a window gets very small.
- But (1) the check fails when the mode- or header-line is taller than
- the associated frame's line height and (2) we don't care much about
- text visibility anyway when shrinking a frame containing a toolbar.
-
- So maybe these checks should be removed and any clipping left to the
- window manager. */
-
-/* Value is true if window W wants a mode line and is large enough
- to accommodate it. */
-#define WINDOW_WANTS_MODELINE_P(W) \
- (BUFFERP ((W)->contents) \
- ? (!MINI_WINDOW_P (W) \
- && !(W)->pseudo_window_p \
- && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \
- && !NILP (BVAR (XBUFFER ((W)->contents), mode_line_format)) \
- && WINDOW_PIXEL_HEIGHT (W) > WINDOW_FRAME_LINE_HEIGHT (W)) \
- : false)
-
-/* Value is true if window W wants a header line and is large enough
- to accommodate it. */
-#define WINDOW_WANTS_HEADER_LINE_P(W) \
- (BUFFERP ((W)->contents) \
- ? (!MINI_WINDOW_P (W) \
- && !(W)->pseudo_window_p \
- && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \
- && !NILP (BVAR (XBUFFER ((W)->contents), header_line_format)) \
- && (WINDOW_PIXEL_HEIGHT (W) \
- > (WINDOW_WANTS_MODELINE_P (W) \
- ? (2 * WINDOW_FRAME_LINE_HEIGHT (W)) \
- : WINDOW_FRAME_LINE_HEIGHT (W)))) \
- : false)
-
/* Return proper value to be used as baseline offset of font that has
ASCENT and DESCENT to draw characters by the font at the vertical
center of the line of frame F.
diff --git a/src/dispnew.c b/src/dispnew.c
index 27c69bd..93ef6a5 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
{
window_box (w, ANY_AREA, 0, 0, &window_width, &window_height);
- header_line_p = WINDOW_WANTS_HEADER_LINE_P (w);
+ header_line_p = window_wants_header_line (w);
header_line_changed_p = header_line_p != matrix->header_line_p;
}
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
if (w == NULL
|| (row == matrix->rows + dim.height - 1
- && WINDOW_WANTS_MODELINE_P (w))
+ && window_wants_mode_line (w))
|| (row == matrix->rows && matrix->header_line_p))
{
row->glyphs[TEXT_AREA]
@@ -491,7 +491,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix
*matrix, int x, int y
/* The mode line, if displayed, never has marginal areas. */
if ((row == matrix->rows + dim.height - 1
- && !(w && WINDOW_WANTS_MODELINE_P (w)))
+ && !(w && window_wants_mode_line (w)))
|| (row == matrix->rows && matrix->header_line_p))
{
row->glyphs[TEXT_AREA]
@@ -570,7 +570,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix
*matrix, int x, int y
the mode line, if any, since otherwise it will remain
disabled in the current matrix, and expose events won't
redraw it. */
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
w->update_mode_line = 1;
}
else if (matrix == w->desired_matrix)
@@ -3126,9 +3126,9 @@ update_frame (struct frame *f, bool force_p, bool
inhibit_hairy_id_p)
if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
{
if (FRAME_TTY (f)->termscript)
- fflush (FRAME_TTY (f)->termscript);
+ fflush_unlocked (FRAME_TTY (f)->termscript);
if (FRAME_TERMCAP_P (f))
- fflush (FRAME_TTY (f)->output);
+ fflush_unlocked (FRAME_TTY (f)->output);
}
/* Check window matrices for lost pointers. */
@@ -3181,8 +3181,8 @@ update_frame_with_menu (struct frame *f, int row, int col)
update_end (f);
if (FRAME_TTY (f)->termscript)
- fflush (FRAME_TTY (f)->termscript);
- fflush (FRAME_TTY (f)->output);
+ fflush_unlocked (FRAME_TTY (f)->termscript);
+ fflush_unlocked (FRAME_TTY (f)->output);
/* Check window matrices for lost pointers. */
#if GLYPH_DEBUG
#if 0
@@ -4531,7 +4531,7 @@ update_frame_1 (struct frame *f, bool force_p, bool
inhibit_id_p,
ptrdiff_t outq = __fpending (display_output);
if (outq > 900
|| (outq > 20 && ((i - 1) % preempt_count == 0)))
- fflush (display_output);
+ fflush_unlocked (display_output);
}
}
@@ -5188,7 +5188,7 @@ buffer_posn_from_coords (struct window *w, int *x, int
*y, struct display_pos *p
start position, i.e. it excludes the header-line row, but
MATRIX_ROW includes the header-line row. Adjust for a possible
header-line row. */
- it_vpos = it.vpos + WINDOW_WANTS_HEADER_LINE_P (w);
+ it_vpos = it.vpos + window_wants_header_line (w);
if (it_vpos < w->current_matrix->nrows
&& (row = MATRIX_ROW (w->current_matrix, it_vpos),
row->enabled_p))
@@ -5615,13 +5615,13 @@ when TERMINAL is nil. */)
if (tty->termscript)
{
- fwrite (SDATA (string), 1, SBYTES (string), tty->termscript);
- fflush (tty->termscript);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->termscript);
+ fflush_unlocked (tty->termscript);
}
out = tty->output;
}
- fwrite (SDATA (string), 1, SBYTES (string), out);
- fflush (out);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string), out);
+ fflush_unlocked (out);
unblock_input ();
return Qnil;
}
@@ -5636,7 +5636,7 @@ terminate any keyboard macro currently executing. */)
if (!NILP (arg))
{
if (noninteractive)
- putchar (07);
+ putchar_unlocked (07);
else
ring_bell (XFRAME (selected_frame));
}
@@ -5650,7 +5650,7 @@ void
bitch_at_user (void)
{
if (noninteractive)
- putchar (07);
+ putchar_unlocked (07);
else if (!INTERACTIVE) /* Stop executing a keyboard macro. */
{
const char *msg
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 2693a45..7b1a402 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)
MODULE_FUNCTION_BEGIN (module_nil);
if (! (0 <= length && length <= STRING_BYTES_BOUND))
xsignal0 (Qoverflow_error);
+ /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated,
+ but we shouldn’t require that. */
AUTO_STRING_WITH_LEN (lstr, str, length);
return lisp_to_value (env,
code_convert_string_norecord (lstr, Qutf_8, false));
@@ -599,7 +601,6 @@ module_get_user_ptr (emacs_env *env, emacs_value uptr)
static void
module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
{
- /* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lisp = value_to_lisp (uptr);
CHECK_USER_PTR (lisp);
@@ -619,7 +620,6 @@ static void
module_set_user_finalizer (emacs_env *env, emacs_value uptr,
emacs_finalizer_function fin)
{
- /* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lisp = value_to_lisp (uptr);
CHECK_USER_PTR (lisp);
@@ -638,7 +638,6 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i)
static void
module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
{
- /* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lvec = value_to_lisp (vec);
check_vec_index (lvec, i);
@@ -657,7 +656,6 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t
i)
static ptrdiff_t
module_vec_size (emacs_env *env, emacs_value vec)
{
- /* FIXME: Return a sentinel value (e.g., -1) on error. */
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lvec = value_to_lisp (vec);
CHECK_VECTOR (lvec);
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 339234f..40b6448 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -80,7 +80,7 @@ enum emacs_funcall_exit
emacs_funcall_exit_signal = 1,
/* Function has exit using `throw'. */
- emacs_funcall_exit_throw = 2,
+ emacs_funcall_exit_throw = 2
};
struct emacs_env_25
@@ -97,6 +97,7 @@ struct emacs_env_26
/* Every module should define a function as follows. */
extern int emacs_module_init (struct emacs_runtime *ert)
+ EMACS_NOEXCEPT
EMACS_ATTRIBUTE_NONNULL(1);
#ifdef __cplusplus
diff --git a/src/emacs.c b/src/emacs.c
index da8df1b..0fec716 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/>. */
#include <errno.h>
#include <fcntl.h>
-#include <stdio.h>
#include <stdlib.h>
#include <sys/file.h>
@@ -33,6 +32,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#define MAIN_PROGRAM
#include "lisp.h"
+#include "sysstdio.h"
#ifdef WINDOWSNT
#include <fcntl.h>
@@ -885,7 +885,7 @@ main (int argc, char **argv)
}
#endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */
- clearerr (stdin);
+ clearerr_unlocked (stdin);
emacs_backtrace (-1);
@@ -983,7 +983,7 @@ main (int argc, char **argv)
int i;
printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]);
for (i = 0; i < ARRAYELTS (usage_message); i++)
- fputs (usage_message[i], stdout);
+ fputs_unlocked (usage_message[i], stdout);
exit (0);
}
@@ -2197,7 +2197,7 @@ You must run Emacs in batch mode in order to dump it. */)
}
#endif
- fflush (stdout);
+ fflush_unlocked (stdout);
/* Tell malloc where start of impure now is. */
/* Also arrange for warnings when nearly out of space. */
#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
diff --git a/src/fileio.c b/src/fileio.c
index cb07002..a57d50b 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5643,14 +5643,12 @@ A non-nil CURRENT-ONLY argument means save only current
buffer. */)
{
block_input ();
if (!NILP (BVAR (b, filename)))
- {
- fwrite (SDATA (BVAR (b, filename)), 1,
- SBYTES (BVAR (b, filename)), stream);
- }
- putc ('\n', stream);
- fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
- SBYTES (BVAR (b, auto_save_file_name)), stream);
- putc ('\n', stream);
+ fwrite_unlocked (SDATA (BVAR (b, filename)), 1,
+ SBYTES (BVAR (b, filename)), stream);
+ putc_unlocked ('\n', stream);
+ fwrite_unlocked (SDATA (BVAR (b, auto_save_file_name)), 1,
+ SBYTES (BVAR (b, auto_save_file_name)), stream);
+ putc_unlocked ('\n', stream);
unblock_input ();
}
@@ -5841,7 +5839,7 @@ effect except for flushing STREAM's data. */)
binmode = NILP (mode) ? O_TEXT : O_BINARY;
if (fp != stdin)
- fflush (fp);
+ fflush_unlocked (fp);
return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
}
diff --git a/src/frame.c b/src/frame.c
index 4d17a07..1e5e4bb 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -328,8 +328,8 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
* frame_windows_min_size:
*
* Return the minimum number of lines (columns if HORIZONTAL is non-nil)
- * of FRAME. If PIXELWISE is non-nil, return the minimum height (width)
- * in pixels.
+ * of FRAME. If PIXELWISE is non-nil, return the minimum inner height
+ * (width) of FRAME in pixels.
*
* This value is calculated by the function `frame-windows-min-size' in
* window.el unless the `min-height' (`min-width' if HORIZONTAL is
@@ -341,7 +341,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
* of `window-min-height' (`window-min-width' if HORIZONTAL is non-nil).
* With IGNORE non-nil the values of these variables are ignored.
*
- * In either case never return a value less than 1.
+ * In either case, never return a value less than 1.
*/
static int
frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
@@ -373,46 +373,173 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object
horizontal,
}
-/* Make sure windows sizes of frame F are OK. new_width and new_height
- are in pixels. A value of -1 means no change is requested for that
- size (but the frame may still have to be resized to accommodate
- windows with their minimum sizes). This can either issue a request
- to resize the frame externally (via x_set_window_size), to resize the
- frame internally (via resize_frame_windows) or do nothing at all.
+#ifdef HAVE_WINDOW_SYSTEM
+/**
+ * keep_ratio:
+ *
+ * Preserve ratios of frame F which usually happens after its parent
+ * frame P got resized. OLD_WIDTH, OLD_HEIGHT specifies the old native
+ * size of F's parent, NEW_WIDTH and NEW_HEIGHT its new size.
+ *
+ * Adjust F's width if F's 'keep_ratio' parameter is non-nil and, if
+ * it is a cons, its car is not 'height-only'. Adjust F's height if F's
+ * 'keep_ratio' parameter is non-nil and, if it is a cons, its car
+ * is not 'width-only'.
+ *
+ * Adjust F's left position if F's 'keep_ratio' parameter is non-nil
+ * and, if its is a cons, its cdr is non-nil and not 'top-only'. Adjust
+ * F's top position if F's 'keep_ratio' parameter is non-nil and, if
+ * its is a cons, its cdr is non-nil and not 'left-only'.
+ *
+ * Note that when positional adjustment is requested but the size of F
+ * should remain unaltered in the corresponding direction, this routine
+ * tries to constrain F to its parent frame - something which usually
+ * happens when the parent frame shrinks. This means, however, that
+ * when the parent frame is re-enlarged later, the child's original
+ * position will not get restored to its pre-shrinking value.
+ *
+ * This routine is currently useful for child frames only. It might be
+ * eventually useful when moving non-child frames between monitors with
+ * different resolutions.
+ */
+static void
+keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height,
+ int new_width, int new_height)
+{
+ Lisp_Object keep_ratio = get_frame_param (f, Qkeep_ratio);
+
+
+ if (!NILP (keep_ratio))
+ {
+ double width_factor = (double)new_width / (double)old_width;
+ double height_factor = (double)new_height / (double)old_height;
+ int pixel_width, pixel_height, pos_x, pos_y;
+
+ if (!CONSP (keep_ratio) || !NILP (Fcdr (keep_ratio)))
+ {
+ if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qtop_only))
+ pos_x = f->left_pos;
+ else
+ {
+ pos_x = (int)(f->left_pos * width_factor + 0.5);
- The argument INHIBIT can assume the following values:
+ if (CONSP (keep_ratio)
+ && (NILP (Fcar (keep_ratio))
+ || EQ (Fcar (keep_ratio), Qheight_only))
+ && p->pixel_width - f->pixel_width < pos_x)
+ {
+ int p_f_width = p->pixel_width - f->pixel_width;
- 0 means to unconditionally call x_set_window_size even if sizes
- apparently do not change. Fx_create_frame uses this to pass the
- initial size to the window manager.
+ if (p_f_width <= 0)
+ pos_x = 0;
+ else
+ pos_x = (int)(p_f_width * width_factor * 0.5 + 0.5);
+ }
- 1 means to call x_set_window_size if the outer frame size really
- changes. Fset_frame_size, Fset_frame_height, ... use this.
+ f->left_pos = pos_x;
+ }
- 2 means to call x_set_window_size provided frame_inhibit_resize
- allows it. The menu and tool bar code use this ("3" won't work
- here in general because menu and tool bar are often not counted in
- the frame's text height).
+ if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qleft_only))
+ pos_y = f->top_pos;
+ else
+ {
+ pos_y = (int)(f->top_pos * height_factor + 0.5);
+
+ if (CONSP (keep_ratio)
+ && (NILP (Fcar (keep_ratio))
+ || EQ (Fcar (keep_ratio), Qwidth_only))
+ && p->pixel_height - f->pixel_height < pos_y)
+ /* When positional adjustment was requested and the
+ width of F should remain unaltered, try to constrain
+ F to its parent. This means that when the parent
+ frame is enlarged later the child's original position
+ won't get restored. */
+ {
+ int p_f_height = p->pixel_height - f->pixel_height;
- 3 means call x_set_window_size if window minimum sizes must be
- preserved or frame_inhibit_resize allows it. x_set_left_fringe,
- x_set_scroll_bar_width, x_new_font ... use (or should use) this.
+ if (p_f_height <= 0)
+ pos_y = 0;
+ else
+ pos_y = (int)(p_f_height * height_factor * 0.5 + 0.5);
+ }
- 4 means call x_set_window_size only if window minimum sizes must be
- preserved. x_set_right_divider_width, x_set_border_width and the
- code responsible for wrapping the tool bar use this.
+ f->top_pos = pos_y;
+ }
- 5 means to never call x_set_window_size. change_frame_size uses
- this.
+ x_set_offset (f, pos_x, pos_y, -1);
+ }
- Note that even when x_set_window_size is not called, individual
- windows may have to be resized (via `window--sanitize-window-sizes')
- in order to support minimum size constraints.
+ if (!CONSP (keep_ratio) || !NILP (Fcar (keep_ratio)))
+ {
+ if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qheight_only))
+ pixel_width = -1;
+ else
+ {
+ pixel_width = (int)(f->pixel_width * width_factor + 0.5);
+ pixel_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, pixel_width);
+ }
- PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the
- symbol of the parameter changed (like `menu-bar-lines', `font', ...).
- This is passed on to frame_inhibit_resize to let the latter decide on
- a case-by-case basis whether the frame may be resized externally. */
+ if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qwidth_only))
+ pixel_height = -1;
+ else
+ {
+ pixel_height = (int)(f->pixel_height * height_factor + 0.5);
+ pixel_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixel_height);
+ }
+
+ adjust_frame_size (f, pixel_width, pixel_height, 1, 0,
+ Qkeep_ratio);
+ }
+ }
+}
+#endif
+
+
+/**
+ * adjust_frame_size:
+ *
+ * Adjust size of frame F. NEW_WIDTH and NEW_HEIGHT specify the new
+ * text size of F in pixels. A value of -1 means no change is requested
+ * for that direction (but the frame may still have to be resized to
+ * accommodate windows with their minimum sizes). This can either issue
+ * a request to resize the frame externally (via x_set_window_size), to
+ * resize the frame internally (via resize_frame_windows) or do nothing
+ * at all.
+ *
+ * The argument INHIBIT can assume the following values:
+ *
+ * 0 means to unconditionally call x_set_window_size even if sizes
+ * apparently do not change. Fx_create_frame uses this to pass the
+ * initial size to the window manager.
+ *
+ * 1 means to call x_set_window_size if the native frame size really
+ * changes. Fset_frame_size, Fset_frame_height, ... use this.
+ *
+ * 2 means to call x_set_window_size provided frame_inhibit_resize
+ * allows it. The menu and tool bar code use this ("3" won't work
+ * here in general because menu and tool bar are often not counted in
+ * the frame's text height).
+ *
+ * 3 means call x_set_window_size if window minimum sizes must be
+ * preserved or frame_inhibit_resize allows it. x_set_left_fringe,
+ * x_set_scroll_bar_width, x_new_font ... use (or should use) this.
+ *
+ * 4 means call x_set_window_size only if window minimum sizes must be
+ * preserved. x_set_right_divider_width, x_set_border_width and the
+ * code responsible for wrapping the tool bar use this.
+ *
+ * 5 means to never call x_set_window_size. change_frame_size uses
+ * this.
+ *
+ * Note that even when x_set_window_size is not called, individual
+ * windows may have to be resized (via `window--sanitize-window-sizes')
+ * in order to support minimum size constraints.
+ *
+ * PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the
+ * symbol of the parameter changed (like `menu-bar-lines', `font', ...).
+ * This is passed on to frame_inhibit_resize to let the latter decide on
+ * a case-by-case basis whether the frame may be resized externally.
+ */
void
adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
bool pretend, Lisp_Object parameter)
@@ -636,6 +763,18 @@ adjust_frame_size (struct frame *f, int new_width, int
new_height, int inhibit,
|| new_pixel_height != old_pixel_height);
unblock_input ();
+
+#ifdef HAVE_WINDOW_SYSTEM
+ {
+ /* Adjust size of F's child frames. */
+ Lisp_Object frames, frame1;
+
+ FOR_EACH_FRAME (frames, frame1)
+ if (FRAME_PARENT_FRAME (XFRAME (frame1)) == f)
+ keep_ratio (XFRAME (frame1), f, old_pixel_width, old_pixel_height,
+ new_pixel_width, new_pixel_height);
+ }
+#endif
}
/* Allocate basically initialized frame. */
@@ -684,6 +823,7 @@ make_frame (bool mini_p)
f->horizontal_scroll_bars = false;
f->want_fullscreen = FULLSCREEN_NONE;
f->undecorated = false;
+ f->no_special_glyphs = false;
#ifndef HAVE_NTGUI
f->override_redirect = false;
#endif
@@ -2004,8 +2144,101 @@ The functions are run with one argument, the frame to
be deleted. */)
{
return delete_frame (frame, !NILP (force) ? Qt : Qnil);
}
-
+#ifdef HAVE_WINDOW_SYSTEM
+/**
+ * frame_internal_border_part:
+ *
+ * Return part of internal border the coordinates X and Y relative to
+ * frame F are on. Return nil if the coordinates are not on the
+ * internal border of F.
+ *
+ * Return one of INTERNAL_BORDER_LEFT_EDGE, INTERNAL_BORDER_TOP_EDGE,
+ * INTERNAL_BORDER_RIGHT_EDGE or INTERNAL_BORDER_BOTTOM_EDGE when the
+ * mouse cursor is on the corresponding border with an offset of at
+ * least one canonical character height from that border's edges.
+ *
+ * If no border part could be found this way, return one of
+ * INTERNAL_BORDER_TOP_LEFT_CORNER, INTERNAL_BORDER_TOP_RIGHT_CORNER,
+ * INTERNAL_BORDER_BOTTOM_LEFT_CORNER or
+ * INTERNAL_BORDER_BOTTOM_RIGHT_CORNER to indicate that the mouse is in
+ * one of the corresponding corners. This means that for very small
+ * frames an `edge' return value is preferred.
+ */
+enum internal_border_part
+frame_internal_border_part (struct frame *f, int x, int y)
+{
+ int border = FRAME_INTERNAL_BORDER_WIDTH (f);
+ int offset = FRAME_LINE_HEIGHT (f);
+ int width = FRAME_PIXEL_WIDTH (f);
+ int height = FRAME_PIXEL_HEIGHT (f);
+ enum internal_border_part part = INTERNAL_BORDER_NONE;
+
+ if (offset < border)
+ /* For very wide borders make offset at least as large as
+ border. */
+ offset = border;
+
+ if (offset < x && x < width - offset)
+ /* Top or bottom border. */
+ {
+ if (0 <= y && y <= border)
+ part = INTERNAL_BORDER_TOP_EDGE;
+ else if (height - border <= y && y <= height)
+ part = INTERNAL_BORDER_BOTTOM_EDGE;
+ }
+ else if (offset < y && y < height - offset)
+ /* Left or right border. */
+ {
+ if (0 <= x && x <= border)
+ part = INTERNAL_BORDER_LEFT_EDGE;
+ else if (width - border <= x && x <= width)
+ part = INTERNAL_BORDER_RIGHT_EDGE;
+ }
+ else
+ {
+ /* An edge. */
+ int half_width = width / 2;
+ int half_height = height / 2;
+
+ if (0 <= x && x <= border)
+ {
+ /* A left edge. */
+ if (0 <= y && y <= half_height)
+ part = INTERNAL_BORDER_TOP_LEFT_CORNER;
+ else if (half_height < y && y <= height)
+ part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER;
+ }
+ else if (width - border <= x && x <= width)
+ {
+ /* A right edge. */
+ if (0 <= y && y <= half_height)
+ part = INTERNAL_BORDER_TOP_RIGHT_CORNER;
+ else if (half_height < y && y <= height)
+ part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER;
+ }
+ else if (0 <= y && y <= border)
+ {
+ /* A top edge. */
+ if (0 <= x && x <= half_width)
+ part = INTERNAL_BORDER_TOP_LEFT_CORNER;
+ else if (half_width < x && x <= width)
+ part = INTERNAL_BORDER_TOP_RIGHT_CORNER;
+ }
+ else if (height - border <= y && y <= height)
+ {
+ /* A bottom edge. */
+ if (0 <= x && x <= half_width)
+ part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER;
+ else if (half_width < x && x <= width)
+ part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER;
+ }
+ }
+
+ return part;
+}
+#endif
+
/* Return mouse position in character cell units. */
DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
@@ -2962,49 +3195,47 @@ For a terminal screen, the value is always 1. */)
return make_number (1);
}
-DEFUN ("frame-pixel-height", Fframe_pixel_height,
- Sframe_pixel_height, 0, 1, 0,
- doc: /* Return a FRAME's height in pixels.
-If FRAME is omitted or nil, the selected frame is used. The exact value
-of the result depends on the window-system and toolkit in use:
-
-In the Gtk+ version of Emacs, it includes only any window (including
-the minibuffer or echo area), mode line, and header line. It does not
-include the tool bar or menu bar.
-
-With other graphical versions, it also includes the tool bar and the
-menu bar.
-
-For a text terminal, it includes the menu bar. In this case, the
-result is really in characters rather than pixels (i.e., is identical
-to `frame-height'). */)
+DEFUN ("frame-native-width", Fframe_native_width,
+ Sframe_native_width, 0, 1, 0,
+ doc: /* Return FRAME's native width in pixels.
+For a terminal frame, the result really gives the width in characters.
+If FRAME is omitted or nil, the selected frame is used. */)
(Lisp_Object frame)
{
struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
- return make_number (FRAME_PIXEL_HEIGHT (f));
+ return make_number (FRAME_PIXEL_WIDTH (f));
else
#endif
- return make_number (FRAME_TOTAL_LINES (f));
+ return make_number (FRAME_TOTAL_COLS (f));
}
-DEFUN ("frame-pixel-width", Fframe_pixel_width,
- Sframe_pixel_width, 0, 1, 0,
- doc: /* Return FRAME's width in pixels.
-For a terminal frame, the result really gives the width in characters.
-If FRAME is omitted or nil, the selected frame is used. */)
+DEFUN ("frame-native-height", Fframe_native_height,
+ Sframe_native_height, 0, 1, 0,
+ doc: /* Return FRAME's native height in pixels.
+If FRAME is omitted or nil, the selected frame is used. The exact value
+of the result depends on the window-system and toolkit in use:
+
+In the Gtk+ and NS versions, it includes only any window (including the
+minibuffer or echo area), mode line, and header line. It does not
+include the tool bar or menu bar. With other graphical versions, it may
+also include the tool bar and the menu bar.
+
+For a text terminal, it includes the menu bar. In this case, the
+result is really in characters rather than pixels (i.e., is identical
+to `frame-height'). */)
(Lisp_Object frame)
{
struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
- return make_number (FRAME_PIXEL_WIDTH (f));
+ return make_number (FRAME_PIXEL_HEIGHT (f));
else
#endif
- return make_number (FRAME_TOTAL_COLS (f));
+ return make_number (FRAME_TOTAL_LINES (f));
}
DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
@@ -3087,8 +3318,8 @@ DEFUN ("frame-fringe-width", Ffringe_width,
Sfringe_width, 0, 1, 0,
return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
}
-DEFUN ("frame-border-width", Fborder_width, Sborder_width, 0, 1, 0,
- doc: /* Return border width of FRAME in pixels. */)
+DEFUN ("frame-internal-border-width", Fframe_internal_border_width,
Sframe_internal_border_width, 0, 1, 0,
+ doc: /* Return width of FRAME's internal border in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame)));
@@ -3224,7 +3455,6 @@ bottom edge of FRAME's display. */)
return Qt;
}
-
/***********************************************************************
Frame Parameters
@@ -3289,10 +3519,193 @@ static const struct frame_parm_table frame_parms[] =
{"no-accept-focus", SYMBOL_INDEX (Qno_accept_focus)},
{"z-group", SYMBOL_INDEX (Qz_group)},
{"override-redirect", SYMBOL_INDEX (Qoverride_redirect)},
+ {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)},
};
#ifdef HAVE_WINDOW_SYSTEM
+/* Enumeration type for switch in frame_float. */
+enum frame_float_type
+{
+ FRAME_FLOAT_WIDTH,
+ FRAME_FLOAT_HEIGHT,
+ FRAME_FLOAT_LEFT,
+ FRAME_FLOAT_TOP
+};
+
+/**
+ * frame_float:
+ *
+ * Process the value VAL of the float type frame parameter 'width',
+ * 'height', 'left', or 'top' specified via a frame_float_type
+ * enumeration type WHAT for frame F. Such parameters relate the outer
+ * size or position of F to the size of the F's display or parent frame
+ * which have to be both available in some way.
+ *
+ * The return value is a size or position value in pixels. VAL must be
+ * in the range 0.0 to 1.0 where a width/height of 0.0 means to return 0
+ * and 1.0 means to return the full width/height of the display/parent.
+ * For positions, 0.0 means position in the left/top corner of the
+ * display/parent while 1.0 means to position at the right/bottom corner
+ * of the display/parent frame.
+ *
+ * Set PARENT_DONE and OUTER_DONE to avoid recalculation of the outer
+ * size or parent or display attributes when more float parameters are
+ * calculated in a row: -1 means not processed yet, 0 means processing
+ * failed, 1 means processing succeeded.
+ *
+ * Return DEFAULT_VALUE when processing fails for whatever reason with
+ * one exception: When calculating F's outer edges fails (probably
+ * because F has not been created yet) return the difference between F's
+ * native and text size.
+ */
+static int
+frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what,
+ int *parent_done, int *outer_done, int default_value)
+{
+ double d_val = XFLOAT_DATA (val);
+
+ if (d_val < 0.0 || d_val > 1.0)
+ /* Invalid VAL. */
+ return default_value;
+ else
+ {
+ static unsigned parent_width, parent_height;
+ static int parent_left, parent_top;
+ static unsigned outer_minus_text_width, outer_minus_text_height;
+ struct frame *p = FRAME_PARENT_FRAME (f);
+
+ if (*parent_done == 1)
+ ;
+ else if (p)
+ {
+ parent_width = FRAME_PIXEL_WIDTH (p);
+ parent_height = FRAME_PIXEL_HEIGHT (p);
+ *parent_done = 1;
+ }
+ else
+ {
+ if (*parent_done == 0)
+ /* No workarea available. */
+ return default_value;
+ else if (*parent_done == -1)
+ {
+ Lisp_Object monitor_attributes;
+ Lisp_Object workarea;
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ monitor_attributes = Fcar (call1
(Qdisplay_monitor_attributes_list, frame));
+ if (NILP (monitor_attributes))
+ {
+ /* No monitor attributes available. */
+ *parent_done = 0;
+
+ return default_value;
+ }
+
+ workarea = Fcdr (Fassq (Qworkarea, monitor_attributes));
+ if (NILP (workarea))
+ {
+ /* No workarea available. */
+ *parent_done = 0;
+
+ return default_value;
+ }
+
+ /* Workarea available. */
+ parent_left = XINT (Fnth (make_number (0), workarea));
+ parent_top = XINT (Fnth (make_number (1), workarea));
+ parent_width = XINT (Fnth (make_number (2), workarea));
+ parent_height = XINT (Fnth (make_number (3), workarea));
+ *parent_done = 1;
+ }
+ }
+
+ if (*outer_done == 1)
+ ;
+ else if (FRAME_UNDECORATED (f))
+ {
+ outer_minus_text_width
+ = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f);
+ outer_minus_text_height
+ = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f);
+ *outer_done = 1;
+ }
+ else if (*outer_done == 0)
+ /* No outer size available. */
+ return default_value;
+ else if (*outer_done == -1)
+ {
+ Lisp_Object frame, outer_edges;
+
+ XSETFRAME (frame, f);
+ outer_edges = call2 (Qframe_edges, frame, Qouter_edges);
+
+ if (!NILP (outer_edges))
+ {
+ outer_minus_text_width
+ = (XINT (Fnth (make_number (2), outer_edges))
+ - XINT (Fnth (make_number (0), outer_edges))
+ - FRAME_TEXT_WIDTH (f));
+ outer_minus_text_height
+ = (XINT (Fnth (make_number (3), outer_edges))
+ - XINT (Fnth (make_number (1), outer_edges))
+ - FRAME_TEXT_HEIGHT (f));
+ }
+ else
+ {
+ /* If we can't get any outer edges, proceed as if the frame
+ were undecorated. */
+ outer_minus_text_width
+ = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f);
+ outer_minus_text_height
+ = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f);
+ }
+
+ *outer_done = 1;
+ }
+
+ switch (what)
+ {
+ case FRAME_FLOAT_WIDTH:
+ return parent_width * d_val - outer_minus_text_width;
+
+ case FRAME_FLOAT_HEIGHT:
+ return parent_height * d_val - outer_minus_text_height;
+
+ case FRAME_FLOAT_LEFT:
+ {
+ int rest_width = (parent_width
+ - FRAME_TEXT_WIDTH (f)
+ - outer_minus_text_width);
+
+ if (p)
+ return (rest_width <= 0 ? 0 : d_val * rest_width);
+ else
+ return (rest_width <= 0
+ ? parent_left
+ : parent_left + d_val * rest_width);
+ }
+ case FRAME_FLOAT_TOP:
+ {
+ int rest_height = (parent_height
+ - FRAME_TEXT_HEIGHT (f)
+ - outer_minus_text_height);
+
+ if (p)
+ return (rest_height <= 0 ? 0 : d_val * rest_height);
+ else
+ return (rest_height <= 0
+ ? parent_top
+ : parent_top + d_val * rest_height);
+ }
+ default:
+ emacs_abort ();
+ }
+ }
+}
+
/* Change the parameters of frame F as specified by ALIST.
If a parameter is not specially recognized, do nothing special;
otherwise call the `x_set_...' function for that parameter.
@@ -3302,7 +3715,8 @@ static const struct frame_parm_table frame_parms[] =
void
x_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
+
/* If both of these parameters are present, it's more efficient to
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)
#ifdef HAVE_X_WINDOWS
bool icon_left_no_change = 0, icon_top_no_change = 0;
#endif
+ int parent_done = -1, outer_done = -1;
+ XSETFRAME (frame, f);
for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
size++;
CHECK_LIST_END (tail, alist);
@@ -3388,6 +3804,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object
alist)
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
width = XFASTINT (XCDR (val));
+ else if (FLOATP (val))
+ width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done,
+ &outer_done, -1);
}
else if (EQ (prop, Qheight))
{
@@ -3396,6 +3815,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object
alist)
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
height = XFASTINT (XCDR (val));
+ else if (FLOATP (val))
+ height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done,
+ &outer_done, -1);
}
else if (EQ (prop, Qtop))
top = val;
@@ -3472,105 +3894,100 @@ x_set_frame_parameters (struct frame *f, Lisp_Object
alist)
Don't set these parameters unless they actually differ from the
window's current parameters; the window may not actually exist
yet. */
- {
- Lisp_Object frame;
-
- XSETFRAME (frame, f);
-
- if ((width != -1 && width != FRAME_TEXT_WIDTH (f))
- || (height != -1 && height != FRAME_TEXT_HEIGHT (f)))
- /* We could consider checking f->after_make_frame here, but I
- don't have the faintest idea why the following is needed at
- all. With the old setting it can get a Heisenbug when
- EmacsFrameResize intermittently provokes a delayed
- change_frame_size in the middle of adjust_frame_size. */
- /** || (f->can_x_set_window_size && (f->new_height ||
f->new_width))) **/
- adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters);
-
- if ((!NILP (left) || !NILP (top))
- && ! (left_no_change && top_no_change)
- && ! (NUMBERP (left) && XINT (left) == f->left_pos
- && NUMBERP (top) && XINT (top) == f->top_pos))
- {
- int leftpos = 0;
- int toppos = 0;
+ if ((width != -1 && width != FRAME_TEXT_WIDTH (f))
+ || (height != -1 && height != FRAME_TEXT_HEIGHT (f)))
+ /* We could consider checking f->after_make_frame here, but I
+ don't have the faintest idea why the following is needed at
+ all. With the old setting it can get a Heisenbug when
+ EmacsFrameResize intermittently provokes a delayed
+ change_frame_size in the middle of adjust_frame_size. */
+ /** || (f->can_x_set_window_size && (f->new_height ||
f->new_width))) **/
+ adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters);
+
+ if ((!NILP (left) || !NILP (top))
+ && ! (left_no_change && top_no_change)
+ && ! (NUMBERP (left) && XINT (left) == f->left_pos
+ && NUMBERP (top) && XINT (top) == f->top_pos))
+ {
+ int leftpos = 0;
+ int toppos = 0;
- /* Record the signs. */
- f->size_hint_flags &= ~ (XNegative | YNegative);
- if (EQ (left, Qminus))
- f->size_hint_flags |= XNegative;
- else if (TYPE_RANGED_INTEGERP (int, left))
- {
- leftpos = XINT (left);
- if (leftpos < 0)
- f->size_hint_flags |= XNegative;
- }
- else if (CONSP (left) && EQ (XCAR (left), Qminus)
- && CONSP (XCDR (left))
- && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
- {
- leftpos = - XINT (XCAR (XCDR (left)));
+ /* Record the signs. */
+ f->size_hint_flags &= ~ (XNegative | YNegative);
+ if (EQ (left, Qminus))
+ f->size_hint_flags |= XNegative;
+ else if (TYPE_RANGED_INTEGERP (int, left))
+ {
+ leftpos = XINT (left);
+ if (leftpos < 0)
f->size_hint_flags |= XNegative;
- }
- else if (CONSP (left) && EQ (XCAR (left), Qplus)
- && CONSP (XCDR (left))
- && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
- {
- leftpos = XINT (XCAR (XCDR (left)));
- }
+ }
+ else if (CONSP (left) && EQ (XCAR (left), Qminus)
+ && CONSP (XCDR (left))
+ && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
+ {
+ leftpos = - XINT (XCAR (XCDR (left)));
+ f->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCAR (left), Qplus)
+ && CONSP (XCDR (left))
+ && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
+ leftpos = XINT (XCAR (XCDR (left)));
+ else if (FLOATP (left))
+ leftpos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
+ &outer_done, 0);
- if (EQ (top, Qminus))
- f->size_hint_flags |= YNegative;
- else if (TYPE_RANGED_INTEGERP (int, top))
- {
- toppos = XINT (top);
- if (toppos < 0)
- f->size_hint_flags |= YNegative;
- }
- else if (CONSP (top) && EQ (XCAR (top), Qminus)
- && CONSP (XCDR (top))
- && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
- {
- toppos = - XINT (XCAR (XCDR (top)));
+ if (EQ (top, Qminus))
+ f->size_hint_flags |= YNegative;
+ else if (TYPE_RANGED_INTEGERP (int, top))
+ {
+ toppos = XINT (top);
+ if (toppos < 0)
f->size_hint_flags |= YNegative;
- }
- else if (CONSP (top) && EQ (XCAR (top), Qplus)
- && CONSP (XCDR (top))
- && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
- {
- toppos = XINT (XCAR (XCDR (top)));
- }
-
+ }
+ else if (CONSP (top) && EQ (XCAR (top), Qminus)
+ && CONSP (XCDR (top))
+ && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
+ {
+ toppos = - XINT (XCAR (XCDR (top)));
+ f->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCAR (top), Qplus)
+ && CONSP (XCDR (top))
+ && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
+ toppos = XINT (XCAR (XCDR (top)));
+ else if (FLOATP (top))
+ toppos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
+ &outer_done, 0);
- /* Store the numeric value of the position. */
- f->top_pos = toppos;
- f->left_pos = leftpos;
+ /* Store the numeric value of the position. */
+ f->top_pos = toppos;
+ f->left_pos = leftpos;
- f->win_gravity = NorthWestGravity;
+ f->win_gravity = NorthWestGravity;
- /* Actually set that position, and convert to absolute. */
- x_set_offset (f, leftpos, toppos, -1);
- }
+ /* Actually set that position, and convert to absolute. */
+ x_set_offset (f, leftpos, toppos, -1);
+ }
- if (fullscreen_change)
- {
- Lisp_Object old_value = get_frame_param (f, Qfullscreen);
+ if (fullscreen_change)
+ {
+ Lisp_Object old_value = get_frame_param (f, Qfullscreen);
- frame_size_history_add
- (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen));
+ frame_size_history_add
+ (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen));
- store_frame_param (f, Qfullscreen, fullscreen);
- if (!EQ (fullscreen, old_value))
- x_set_fullscreen (f, fullscreen, old_value);
- }
+ store_frame_param (f, Qfullscreen, fullscreen);
+ if (!EQ (fullscreen, old_value))
+ x_set_fullscreen (f, fullscreen, old_value);
+ }
#ifdef HAVE_X_WINDOWS
- if ((!NILP (icon_left) || !NILP (icon_top))
- && ! (icon_left_no_change && icon_top_no_change))
- x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
+ if ((!NILP (icon_left) || !NILP (icon_top))
+ && ! (icon_left_no_change && icon_top_no_change))
+ x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
#endif /* HAVE_X_WINDOWS */
- }
SAFE_FREE ();
}
@@ -3990,7 +4407,6 @@ x_set_right_divider_width (struct frame *f, Lisp_Object
arg, Lisp_Object oldval)
adjust_frame_glyphs (f);
SET_FRAME_GARBAGED (f);
}
-
}
void
@@ -4204,6 +4620,22 @@ x_set_alpha (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
return;
}
+
+/**
+ * x_set_no_special_glyphs:
+ *
+ * Set frame F's `no-special-glyphs' parameter which, if non-nil,
+ * suppresses the display of truncation and continuation glyphs
+ * outside fringes.
+ */
+void
+x_set_no_special_glyphs (struct frame *f, Lisp_Object new_value, Lisp_Object
old_value)
+{
+ if (!EQ (new_value, old_value))
+ FRAME_NO_SPECIAL_GLYPHS (f) = !NILP (new_value);
+}
+
+
#ifndef HAVE_NS
/* 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
Lisp_Object height, width, user_size, top, left, user_position;
long window_prompting = 0;
Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
+ int parent_done = -1, outer_done = -1;
/* Default values if we fall through.
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
f->inhibit_horizontal_resize = true;
*x_width = XINT (XCDR (width));
}
+ else if (FLOATP (width))
+ {
+ double d_width = XFLOAT_DATA (width);
+
+ if (d_width < 0.0 || d_width > 1.0)
+ xsignal1 (Qargs_out_of_range, width);
+ else
+ {
+ int new_width = frame_float (f, width, FRAME_FLOAT_WIDTH,
+ &parent_done, &outer_done, -1);
+
+ if (new_width > -1)
+ SET_FRAME_WIDTH (f, new_width);
+ }
+ }
else
{
CHECK_NUMBER (width);
@@ -4845,6 +5293,21 @@ x_figure_window_size (struct frame *f, Lisp_Object
parms, bool toolbar_p, int *x
f->inhibit_vertical_resize = true;
*x_height = XINT (XCDR (height));
}
+ else if (FLOATP (height))
+ {
+ double d_height = XFLOAT_DATA (height);
+
+ if (d_height < 0.0 || d_height > 1.0)
+ xsignal1 (Qargs_out_of_range, height);
+ else
+ {
+ int new_height = frame_float (f, height, FRAME_FLOAT_HEIGHT,
+ &parent_done, &outer_done, -1);
+
+ if (new_height > -1)
+ SET_FRAME_HEIGHT (f, new_height);
+ }
+ }
else
{
CHECK_NUMBER (height);
@@ -4885,6 +5348,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms,
bool toolbar_p, int *x
{
f->top_pos = XINT (XCAR (XCDR (top)));
}
+ else if (FLOATP (top))
+ f->top_pos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
+ &outer_done, 0);
else if (EQ (top, Qunbound))
f->top_pos = 0;
else
@@ -4913,6 +5379,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms,
bool toolbar_p, int *x
{
f->left_pos = XINT (XCAR (XCDR (left)));
}
+ else if (FLOATP (left))
+ f->left_pos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
+ &outer_done, 0);
else if (EQ (left, Qunbound))
f->left_pos = 0;
else
@@ -5071,12 +5540,14 @@ syms_of_frame (void)
DEFSYM (Qframep, "framep");
DEFSYM (Qframe_live_p, "frame-live-p");
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
+ DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list");
DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
DEFSYM (Qicon, "icon");
DEFSYM (Qminibuffer, "minibuffer");
DEFSYM (Qundecorated, "undecorated");
+ DEFSYM (Qno_special_glyphs, "no-special-glyphs");
DEFSYM (Qparent_frame, "parent-frame");
DEFSYM (Qskip_taskbar, "skip-taskbar");
DEFSYM (Qno_focus_on_map, "no-focus-on-map");
@@ -5129,6 +5600,7 @@ syms_of_frame (void)
DEFSYM (Qframes, "frames");
DEFSYM (Qsource, "source");
+ DEFSYM (Qframe_edges, "frame-edges");
DEFSYM (Qouter_edges, "outer-edges");
DEFSYM (Qouter_position, "outer-position");
DEFSYM (Qouter_size, "outer-size");
@@ -5220,6 +5692,11 @@ syms_of_frame (void)
DEFSYM (Qmin_width, "min-width");
DEFSYM (Qmin_height, "min-height");
DEFSYM (Qmouse_wheel_frame, "mouse-wheel-frame");
+ DEFSYM (Qkeep_ratio, "keep-ratio");
+ DEFSYM (Qwidth_only, "width-only");
+ DEFSYM (Qheight_only, "height-only");
+ DEFSYM (Qleft_only, "left-only");
+ DEFSYM (Qtop_only, "top-only");
{
int i;
@@ -5564,8 +6041,8 @@ Gtk+ tooltips are not used) and on Windows. */);
defsubr (&Smodify_frame_parameters);
defsubr (&Sframe_char_height);
defsubr (&Sframe_char_width);
- defsubr (&Sframe_pixel_height);
- defsubr (&Sframe_pixel_width);
+ defsubr (&Sframe_native_height);
+ defsubr (&Sframe_native_width);
defsubr (&Sframe_text_cols);
defsubr (&Sframe_text_lines);
defsubr (&Sframe_total_cols);
@@ -5575,7 +6052,7 @@ Gtk+ tooltips are not used) and on Windows. */);
defsubr (&Sscroll_bar_width);
defsubr (&Sscroll_bar_height);
defsubr (&Sfringe_width);
- defsubr (&Sborder_width);
+ defsubr (&Sframe_internal_border_width);
defsubr (&Sright_divider_width);
defsubr (&Sbottom_divider_width);
defsubr (&Stool_bar_pixel_width);
diff --git a/src/frame.h b/src/frame.h
index 4aa7c34..154dc9a 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -52,6 +52,19 @@ enum z_group
z_group_below,
z_group_above_suspended,
};
+
+enum internal_border_part
+ {
+ INTERNAL_BORDER_NONE,
+ INTERNAL_BORDER_LEFT_EDGE,
+ INTERNAL_BORDER_TOP_LEFT_CORNER,
+ INTERNAL_BORDER_TOP_EDGE,
+ INTERNAL_BORDER_TOP_RIGHT_CORNER,
+ INTERNAL_BORDER_RIGHT_EDGE,
+ INTERNAL_BORDER_BOTTOM_RIGHT_CORNER,
+ INTERNAL_BORDER_BOTTOM_EDGE,
+ INTERNAL_BORDER_BOTTOM_LEFT_CORNER,
+ };
#endif /* HAVE_WINDOW_SYSTEM */
/* The structure representing a frame. */
@@ -354,7 +367,11 @@ struct frame
/* The z-group this frame's window belongs to. */
ENUM_BF (z_group) z_group : 2;
-#endif /* HAVE_WINDOW_SYSTEM and not HAVE_NS */
+
+ /* Non-zero if display of truncation and continuation glyphs outside
+ the fringes is suppressed. */
+ bool_bf no_special_glyphs : 1;
+#endif /* HAVE_WINDOW_SYSTEM */
/* Whether new_height and new_width shall be interpreted
in pixels. */
@@ -824,7 +841,7 @@ default_pixels_per_inch_y (void)
#ifdef USE_GTK
#define FRAME_TOOL_BAR_POSITION(f) (f)->tool_bar_position
#else
-#define FRAME_TOOL_BAR_POSITION(f) ((void) f, Qtop)
+#define FRAME_TOOL_BAR_POSITION(f) ((void) (f), Qtop)
#endif
/* Number of lines of frame F used for the tool-bar. */
@@ -908,16 +925,17 @@ default_pixels_per_inch_y (void)
((f)->vertical_scroll_bar_type == vertical_scroll_bar_right)
#else /* not HAVE_WINDOW_SYSTEM */
/* If there is no window system, there are no scroll bars. */
-#define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) ((void) f, vertical_scroll_bar_none)
-#define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) f, 0)
-#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) f, 0)
-#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) f, 0)
+#define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) \
+ ((void) (f), vertical_scroll_bar_none)
+#define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) (f), 0)
+#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) (f), 0)
+#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) (f), 0)
#endif /* HAVE_WINDOW_SYSTEM */
#if defined (HAVE_WINDOW_SYSTEM)
#define FRAME_UNDECORATED(f) ((f)->undecorated)
#ifdef HAVE_NTGUI
-#define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0)
+#define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0)
#else
#define FRAME_OVERRIDE_REDIRECT(f) ((f)->override_redirect)
#endif
@@ -928,6 +946,7 @@ default_pixels_per_inch_y (void)
#define FRAME_SKIP_TASKBAR(f) ((f)->skip_taskbar)
#define FRAME_NO_FOCUS_ON_MAP(f) ((f)->no_focus_on_map)
#define FRAME_NO_ACCEPT_FOCUS(f) ((f)->no_accept_focus)
+#define FRAME_NO_SPECIAL_GLYPHS(f) ((f)->no_special_glyphs)
#define FRAME_Z_GROUP(f) ((f)->z_group)
#define FRAME_Z_GROUP_NONE(f) ((f)->z_group == z_group_none)
#define FRAME_Z_GROUP_ABOVE(f) ((f)->z_group == z_group_above)
@@ -935,16 +954,17 @@ default_pixels_per_inch_y (void)
((f)->z_group == z_group_above_suspended)
#define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below)
#else /* not HAVE_WINDOW_SYSTEM */
-#define FRAME_UNDECORATED(f) ((void) f, 0)
-#define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0)
-#define FRAME_PARENT_FRAME(f) ((void) f, NULL)
-#define FRAME_SKIP_TASKBAR(f) ((void) f, 0)
-#define FRAME_NO_FOCUS_ON_MAP(f) ((void) f, 0)
-#define FRAME_NO_ACCEPT_FOCUS(f) ((void) f, 0)
-#define FRAME_Z_GROUP(f) ((void) f, z_group_none)
-#define FRAME_Z_GROUP_NONE(f) ((void) f, true)
-#define FRAME_Z_GROUP_ABOVE(f) ((void) f, false)
-#define FRAME_Z_GROUP_BELOW(f) ((void) f, false)
+#define FRAME_UNDECORATED(f) ((void) (f), 0)
+#define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0)
+#define FRAME_PARENT_FRAME(f) ((void) (f), NULL)
+#define FRAME_SKIP_TASKBAR(f) ((void) (f), 0)
+#define FRAME_NO_FOCUS_ON_MAP(f) ((void) (f), 0)
+#define FRAME_NO_ACCEPT_FOCUS(f) ((void) (f), 0)
+#define FRAME_NO_SPECIAL_GLYPHS(f) ((void) (f), 0)
+#define FRAME_Z_GROUP(f) ((void) (f), z_group_none)
+#define FRAME_Z_GROUP_NONE(f) ((void) (f), true)
+#define FRAME_Z_GROUP_ABOVE(f) ((void) (f), false)
+#define FRAME_Z_GROUP_BELOW(f) ((void) (f), false)
#endif /* HAVE_WINDOW_SYSTEM */
/* Whether horizontal scroll bars are currently enabled for frame F. */
@@ -952,7 +972,7 @@ default_pixels_per_inch_y (void)
#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) \
((f)->horizontal_scroll_bars)
#else
-#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) f, 0)
+#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) (f), 0)
#endif
/* 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)
return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f);
}
-/* Pixel-width of internal border lines */
+/* Pixel-width of internal border lines. */
INLINE int
FRAME_INTERNAL_BORDER_WIDTH (struct frame *f)
{
return frame_dimension (f->internal_border_width);
}
-/* Pixel-size of window divider lines */
+/* Pixel-size of window divider lines. */
INLINE int
FRAME_RIGHT_DIVIDER_WIDTH (struct frame *f)
{
return frame_dimension (f->right_divider_width);
}
+
INLINE int
FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
{
@@ -1498,6 +1519,7 @@ extern void x_set_scroll_bar_height (struct frame *,
Lisp_Object, Lisp_Object);
extern long x_figure_window_size (struct frame *, Lisp_Object, bool, int *,
int *);
extern void x_set_alpha (struct frame *, Lisp_Object, Lisp_Object);
+extern void x_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object);
extern void validate_x_resource_name (void);
@@ -1521,6 +1543,7 @@ extern void x_real_positions (struct frame *, int *, int
*);
extern void free_frame_menubar (struct frame *);
extern void x_free_frame_resources (struct frame *);
extern bool frame_ancestor_p (struct frame *af, struct frame *df);
+extern enum internal_border_part frame_internal_border_part (struct frame *f,
int x, int y);
#if defined HAVE_X_WINDOWS
extern void x_wm_set_icon_position (struct frame *, int, int);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 16eb284..2d4abef 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1503,6 +1503,7 @@ xg_set_undecorated (struct frame *f, Lisp_Object
undecorated)
void
xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
{
+#if GTK_CHECK_VERSION (2, 18, 0)
block_input ();
if (FRAME_GTK_OUTER_WIDGET (f1) && FRAME_GTK_OUTER_WIDGET (f2))
{
@@ -1517,6 +1518,7 @@ xg_frame_restack (struct frame *f1, struct frame *f2,
bool above_flag)
x_sync (f1);
}
unblock_input ();
+#endif
}
diff --git a/src/image.c b/src/image.c
index aedec79..07c4769 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/>. */
#include <config.h>
#include <fcntl.h>
-#include <stdio.h>
#include <unistd.h>
/* 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/>. */
#include "buffer.h"
#include "dispextern.h"
#include "blockinput.h"
+#include "sysstdio.h"
#include "systime.h"
#include <epaths.h>
#include "coding.h"
@@ -2361,7 +2361,7 @@ slurp_file (int fd, ptrdiff_t *size)
This can happen if the file grows as we read it. */
ptrdiff_t buflen = st.st_size;
buf = xmalloc (buflen + 1);
- if (fread (buf, 1, buflen + 1, fp) == buflen)
+ if (fread_unlocked (buf, 1, buflen + 1, fp) == buflen)
*size = buflen;
else
{
@@ -5890,7 +5890,7 @@ png_read_from_file (png_structp png_ptr, png_bytep data,
png_size_t length)
{
FILE *fp = png_get_io_ptr (png_ptr);
- if (fread (data, 1, length, fp) < length)
+ if (fread_unlocked (data, 1, length, fp) < length)
png_error (png_ptr, "Read error");
}
@@ -5959,7 +5959,7 @@ png_load_body (struct frame *f, struct image *img, struct
png_load_context *c)
}
/* Check PNG signature. */
- if (fread (sig, 1, sizeof sig, fp) != sizeof sig
+ if (fread_unlocked (sig, 1, sizeof sig, fp) != sizeof sig
|| png_sig_cmp (sig, 0, sizeof sig))
{
fclose (fp);
@@ -6598,7 +6598,8 @@ our_stdio_fill_input_buffer (j_decompress_ptr cinfo)
{
ptrdiff_t bytes;
- bytes = fread (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE, src->file);
+ bytes = fread_unlocked (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE,
+ src->file);
if (bytes > 0)
src->mgr.bytes_in_buffer = bytes;
else
diff --git a/src/intervals.h b/src/intervals.h
index db91b3f..a0da6f3 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -85,10 +85,10 @@ struct interval
#define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL)
/* True if this interval has no parent and is therefore the root. */
-#define ROOT_INTERVAL_P(i) (NULL_PARENT (i))
+#define ROOT_INTERVAL_P(i) NULL_PARENT (i)
/* True if this interval is the only interval in the interval tree. */
-#define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P ((i)) && LEAF_INTERVAL_P ((i)))
+#define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P (i) && LEAF_INTERVAL_P (i))
/* True if this interval has both left and right children. */
#define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL)
@@ -98,13 +98,13 @@ struct interval
#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length)
/* The size of text represented by this interval alone. */
-#define LENGTH(i) ((i) == NULL ? 0 : (TOTAL_LENGTH ((i)) \
- - TOTAL_LENGTH ((i)->right) \
- - TOTAL_LENGTH ((i)->left)))
+#define LENGTH(i) ((i)->total_length \
+ - TOTAL_LENGTH ((i)->right) \
+ - TOTAL_LENGTH ((i)->left))
/* The position of the character just past the end of I. Note that
the position cache i->position must be valid for this to work. */
-#define INTERVAL_LAST_POS(i) ((i)->position + LENGTH ((i)))
+#define INTERVAL_LAST_POS(i) ((i)->position + LENGTH (i))
/* The total size of the left subtree of this interval. */
#define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0)
diff --git a/src/keyboard.c b/src/keyboard.c
index 55486c6..9e90899 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/>. */
#include "intervals.h"
#include "keymap.h"
#include "blockinput.h"
+#include "sysstdio.h"
#include "systime.h"
#include "atimer.h"
#include "process.h"
@@ -3290,7 +3291,7 @@ record_char (Lisp_Object c)
if (INTEGERP (c))
{
if (XUINT (c) < 0x100)
- putc (XUINT (c), dribble);
+ putc_unlocked (XUINT (c), dribble);
else
fprintf (dribble, " 0x%"pI"x", XUINT (c));
}
@@ -3303,15 +3304,15 @@ record_char (Lisp_Object c)
if (SYMBOLP (dribblee))
{
- putc ('<', dribble);
- fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
- SBYTES (SYMBOL_NAME (dribblee)),
- dribble);
- putc ('>', dribble);
+ putc_unlocked ('<', dribble);
+ fwrite_unlocked (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
+ SBYTES (SYMBOL_NAME (dribblee)),
+ dribble);
+ putc_unlocked ('>', dribble);
}
}
- fflush (dribble);
+ fflush_unlocked (dribble);
unblock_input ();
}
}
@@ -3769,7 +3770,7 @@ kbd_buffer_get_event (KBOARD **kbp,
detaching from the terminal. */
|| (IS_DAEMON && DAEMON_RUNNING))
{
- int c = getchar ();
+ int c = getchar_unlocked ();
XSETINT (obj, c);
*kbp = current_kboard;
return obj;
@@ -5126,6 +5127,17 @@ static short const scroll_bar_parts[] = {
SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio)
};
+/* An array of symbol indexes of internal border parts, indexed by an enum
+ internal_border_part value. Note that Qnil corresponds to
+ internal_border_part_none and should not appear in Lisp events. */
+static short const internal_border_parts[] = {
+ SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qleft_edge),
+ SYMBOL_INDEX (Qtop_left_corner), SYMBOL_INDEX (Qtop_edge),
+ SYMBOL_INDEX (Qtop_right_corner), SYMBOL_INDEX (Qright_edge),
+ SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge),
+ SYMBOL_INDEX (Qbottom_left_corner)
+};
+
/* A vector, indexed by button number, giving the down-going location
of currently depressed buttons, both scroll bar and non-scroll bar.
@@ -5163,15 +5175,15 @@ make_lispy_position (struct frame *f, Lisp_Object x,
Lisp_Object y,
Lisp_Object extra_info = Qnil;
/* Coordinate pixel positions to return. */
int xret = 0, yret = 0;
- /* The window under frame pixel coordinates (x,y) */
- Lisp_Object window = f
+ /* The window or frame under frame pixel coordinates (x,y) */
+ Lisp_Object window_or_frame = f
? window_from_coordinates (f, XINT (x), XINT (y), &part, 0)
: Qnil;
- if (WINDOWP (window))
+ if (WINDOWP (window_or_frame))
{
/* It's a click in window WINDOW at frame coordinates (X,Y) */
- struct window *w = XWINDOW (window);
+ struct window *w = XWINDOW (window_or_frame);
Lisp_Object string_info = Qnil;
ptrdiff_t textpos = 0;
int col = -1, row = -1;
@@ -5360,17 +5372,31 @@ make_lispy_position (struct frame *f, Lisp_Object x,
Lisp_Object y,
make_number (row)),
extra_info)));
}
- else if (f != 0)
+
+#ifdef HAVE_WINDOW_SYSTEM
+ else if (f)
{
/* Return mouse pixel coordinates here. */
- XSETFRAME (window, f);
+ XSETFRAME (window_or_frame, f);
xret = XINT (x);
yret = XINT (y);
+
+ if (FRAME_LIVE_P (f)
+ && FRAME_INTERNAL_BORDER_WIDTH (f) > 0
+ && !NILP (get_frame_param (f, Qdrag_internal_border)))
+ {
+ enum internal_border_part part
+ = frame_internal_border_part (f, xret, yret);
+
+ posn = builtin_lisp_symbol (internal_border_parts[part]);
+ }
}
+#endif
+
else
- window = Qnil;
+ window_or_frame = Qnil;
- return Fcons (window,
+ return Fcons (window_or_frame,
Fcons (posn,
Fcons (Fcons (make_number (xret),
make_number (yret)),
@@ -10377,7 +10403,7 @@ handle_interrupt (bool in_signal_handler)
sigemptyset (&blocked);
sigaddset (&blocked, SIGINT);
pthread_sigmask (SIG_BLOCK, &blocked, 0);
- fflush (stdout);
+ fflush_unlocked (stdout);
}
reset_all_sys_modes ();
@@ -11158,6 +11184,17 @@ syms_of_keyboard (void)
Fset (Qinput_method_exit_on_first_char, Qnil);
Fset (Qinput_method_use_echo_area, Qnil);
+ /* Symbols for dragging internal borders. */
+ DEFSYM (Qdrag_internal_border, "drag-internal-border");
+ DEFSYM (Qleft_edge, "left-edge");
+ DEFSYM (Qtop_left_corner, "top-left-corner");
+ DEFSYM (Qtop_edge, "top-edge");
+ DEFSYM (Qtop_right_corner, "top-right-corner");
+ DEFSYM (Qright_edge, "right-edge");
+ DEFSYM (Qbottom_right_corner, "bottom-right-corner");
+ DEFSYM (Qbottom_edge, "bottom-edge");
+ DEFSYM (Qbottom_left_corner, "bottom-left-corner");
+
/* Symbols to head events. */
DEFSYM (Qmouse_movement, "mouse-movement");
DEFSYM (Qscroll_bar_movement, "scroll-bar-movement");
diff --git a/src/lread.c b/src/lread.c
index 8716b86..182f962 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/>. */
#define file_tell ftell
#endif
-#ifndef HAVE_GETC_UNLOCKED
-#define getc_unlocked getc
-#endif
-
/* The objects or placeholders read with the #n=object form.
A hash table maps a number to either a placeholder (while the
@@ -474,16 +470,15 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
}
block_input ();
- c = getc_unlocked (instream);
/* Interrupted reads have been observed while reading over the network. */
- while (c == EOF && ferror (instream) && errno == EINTR)
+ while ((c = getc_unlocked (instream)) == EOF && errno == EINTR
+ && ferror_unlocked (instream))
{
unblock_input ();
maybe_quit ();
block_input ();
- clearerr (instream);
- c = getc_unlocked (instream);
+ clearerr_unlocked (instream);
}
unblock_input ();
diff --git a/src/minibuf.c b/src/minibuf.c
index 1bbe276..d4128ce 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/>. */
#include <config.h>
#include <errno.h>
-#include <stdio.h>
#include <binary-io.h>
@@ -31,6 +30,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include "frame.h"
#include "window.h"
#include "keymap.h"
+#include "sysstdio.h"
#include "systty.h"
/* List of buffers for use as minibuffers.
@@ -209,15 +209,15 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object
initial,
suppress_echo_on_tty (STDIN_FILENO);
}
- fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout);
- fflush (stdout);
+ fwrite_unlocked (SDATA (prompt), 1, SBYTES (prompt), stdout);
+ fflush_unlocked (stdout);
val = Qnil;
size = 100;
len = 0;
line = xmalloc (size);
- while ((c = getchar ()) != '\n' && c != '\r')
+ while ((c = getchar_unlocked ()) != '\n' && c != '\r')
{
if (c == EOF)
{
@@ -874,6 +874,30 @@ read_minibuf_unwind (void)
if (minibuf_level == 0)
resize_mini_window (XWINDOW (window), 0);
+ /* Deal with frames that should be removed when exiting the
+ minibuffer. */
+ {
+ Lisp_Object frames, frame1, val;
+ struct frame *f1;
+
+ FOR_EACH_FRAME (frames, frame1)
+ {
+ f1 = XFRAME (frame1);
+
+ if ((FRAME_PARENT_FRAME (f1)
+ || !NILP (get_frame_param (f1, Qdelete_before)))
+ && !NILP (val = (get_frame_param (f1, Qminibuffer_exit))))
+ {
+ if (EQ (val, Qiconify_frame))
+ Ficonify_frame (frame1);
+ else if (EQ (val, Qdelete_frame))
+ Fdelete_frame (frame1, Qnil);
+ else
+ Fmake_frame_invisible (frame1, Qnil);
+ }
+ }
+ }
+
/* In case the previous minibuffer displayed in this miniwindow is
dead, we may keep displaying this buffer (tho it's inactive), so reset it,
to make sure we don't leave around bindings and stuff which only
@@ -1930,6 +1954,8 @@ syms_of_minibuf (void)
DEFSYM (Qactivate_input_method, "activate-input-method");
DEFSYM (Qcase_fold_search, "case-fold-search");
DEFSYM (Qmetadata, "metadata");
+ /* A frame parameter. */
+ DEFSYM (Qminibuffer_exit, "minibuffer-exit");
DEFVAR_LISP ("read-expression-history", Vread_expression_history,
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 17e6700..675010b 100644
--- a/src/module-env-25.h
+++ b/src/module-env-25.h
@@ -92,7 +92,7 @@
SIZE must point to the total size of the buffer. If BUFFER is
NULL or if SIZE is not big enough, write the required buffer size
- to SIZE and return false.
+ to SIZE and return true.
Note that SIZE must include the last null byte (e.g. "abc" needs
a buffer of size 4).
diff --git a/src/nsfns.m b/src/nsfns.m
index dbce279..68eba8b 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -984,6 +984,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
x_set_no_accept_focus,
x_set_z_group, /* x_set_z_group */
0, /* x_set_override_redirect */
+ x_set_no_special_glyphs,
};
@@ -1256,6 +1257,8 @@ This function is an internal primitive--use `make-frame'
instead. */)
"leftFringe", "LeftFringe", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qright_fringe, Qnil,
"rightFringe", "RightFringe", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
init_frame_faces (f);
@@ -1325,6 +1328,15 @@ This function is an internal primitive--use `make-frame'
instead. */)
f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
+ f->output_data.ns->left_edge_cursor = [NSCursor resizeLeftRightCursor];
+ f->output_data.ns->top_left_corner_cursor = [NSCursor arrowCursor];
+ f->output_data.ns->top_edge_cursor = [NSCursor resizeUpDownCursor];
+ f->output_data.ns->top_right_corner_cursor = [NSCursor arrowCursor];
+ f->output_data.ns->right_edge_cursor = [NSCursor resizeLeftRightCursor];
+ f->output_data.ns->bottom_right_corner_cursor = [NSCursor arrowCursor];
+ f->output_data.ns->bottom_edge_cursor = [NSCursor resizeUpDownCursor];
+ f->output_data.ns->bottom_left_corner_cursor = [NSCursor arrowCursor];
+
FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
= [NSCursor arrowCursor];
FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
diff --git a/src/nsterm.h b/src/nsterm.h
index bed0b92..0f1b36d 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -957,6 +957,14 @@ struct ns_output
Cursor hourglass_cursor;
Cursor horizontal_drag_cursor;
Cursor vertical_drag_cursor;
+ Cursor left_edge_cursor;
+ Cursor top_left_corner_cursor;
+ Cursor top_edge_cursor;
+ Cursor top_right_corner_cursor;
+ Cursor right_edge_cursor;
+ Cursor bottom_right_corner_cursor;
+ Cursor bottom_edge_cursor;
+ Cursor bottom_left_corner_cursor;
/* NS-specific */
Cursor current_pointer;
@@ -1225,8 +1233,11 @@ extern void x_set_no_accept_focus (struct frame *f,
Lisp_Object new_value,
extern void x_set_z_group (struct frame *f, Lisp_Object new_value,
Lisp_Object old_value);
extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timespec const *timeout,
- sigset_t const *sigmask);
+ fd_set *exceptfds, struct timespec *timeout,
+ sigset_t *sigmask);
+#ifdef HAVE_PTHREAD
+extern void ns_run_loop_break (void);
+#endif
extern unsigned long ns_get_rgb_color (struct frame *f,
float r, float g, float b, float a);
diff --git a/src/nsterm.m b/src/nsterm.m
index e05dbf4..bf83550 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -4068,7 +4068,7 @@ ns_send_appdefined (int value)
app->nextappdefined = value;
[app performSelectorOnMainThread:@selector (sendFromMainThread:)
withObject:nil
- waitUntilDone:YES];
+ waitUntilDone:NO];
return;
}
@@ -4293,8 +4293,8 @@ ns_read_socket (struct terminal *terminal, struct
input_event *hold_quit)
int
ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timespec const *timeout,
- sigset_t const *sigmask)
+ fd_set *exceptfds, struct timespec *timeout,
+ sigset_t *sigmask)
/* --------------------------------------------------------------------------
Replacement for select, checking for events
--------------------------------------------------------------------------
*/
@@ -4327,7 +4327,13 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
if (NSApp == nil
|| ![NSThread isMainThread]
|| (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0))
- return pselect (nfds, readfds, writefds, exceptfds, timeout, sigmask);
+ return thread_select(pselect, nfds, readfds, writefds,
+ exceptfds, timeout, sigmask);
+ else
+ {
+ struct timespec t = {0, 0};
+ thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask);
+ }
[outerpool release];
outerpool = [[NSAutoreleasePool alloc] init];
@@ -4430,6 +4436,18 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
return result;
}
+#ifdef HAVE_PTHREAD
+void
+ns_run_loop_break ()
+/* Break out of the NS run loop in ns_select or ns_read_socket. */
+{
+ NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_run_loop_break");
+
+ /* If we don't have a GUI, don't send the event. */
+ if (NSApp != NULL)
+ ns_send_appdefined(-1);
+}
+#endif
/* ==========================================================================
diff --git a/src/print.c b/src/print.c
index aaec5b0..50c75d7 100644
--- a/src/print.c
+++ b/src/print.c
@@ -228,7 +228,7 @@ printchar_to_stream (unsigned int ch, FILE *stream)
{
if (ASCII_CHAR_P (ch))
{
- putc (ch, stream);
+ putc_unlocked (ch, stream);
#ifdef WINDOWSNT
/* Send the output to a debugger (nothing happens if there
isn't one). */
@@ -246,7 +246,7 @@ printchar_to_stream (unsigned int ch, FILE *stream)
if (encode_p)
encoded_ch = code_convert_string_norecord (encoded_ch,
coding_system, true);
- fwrite (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream);
+ fwrite_unlocked (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream);
#ifdef WINDOWSNT
if (print_output_debug_flag && stream == stderr)
OutputDebugString (SSDATA (encoded_ch));
@@ -298,7 +298,7 @@ printchar (unsigned int ch, Lisp_Object fun)
if (DISP_TABLE_P (Vstandard_display_table))
printchar_to_stream (ch, stdout);
else
- fwrite (str, 1, len, stdout);
+ fwrite_unlocked (str, 1, len, stdout);
noninteractive_need_newline = 1;
}
else
@@ -350,7 +350,7 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t
size_byte,
}
}
else
- fwrite (ptr, 1, size_byte, stdout);
+ fwrite_unlocked (ptr, 1, size_byte, stdout);
noninteractive_need_newline = 1;
}
@@ -801,7 +801,7 @@ append to existing target file. */)
report_file_error ("Cannot open debugging output stream", file);
}
- fflush (stderr);
+ fflush_unlocked (stderr);
if (dup2 (fd, STDERR_FILENO) < 0)
report_file_error ("dup2", file);
if (fd != stderr_dup)
@@ -1870,21 +1870,36 @@ print_object (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag)
}
else
{
+ bool still_need_nonhex = false;
/* If we just had a hex escape, and this character
could be taken as part of it,
output `\ ' to prevent that. */
- if (need_nonhex && c_isxdigit (c))
- print_c_string ("\\ ", printcharfun);
-
- if (c == '\n' && print_escape_newlines
- ? (c = 'n', true)
- : c == '\f' && print_escape_newlines
- ? (c = 'f', true)
- : c == '\"' || c == '\\')
- printchar ('\\', printcharfun);
-
- printchar (c, printcharfun);
- need_nonhex = false;
+ if (c_isxdigit (c))
+ {
+ if (need_nonhex)
+ print_c_string ("\\ ", printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (c == '\n' && print_escape_newlines
+ ? (c = 'n', true)
+ : c == '\f' && print_escape_newlines
+ ? (c = 'f', true)
+ : c == '\0' && print_escape_control_characters
+ ? (c = '0', still_need_nonhex = true)
+ : c == '\"' || c == '\\')
+ {
+ printchar ('\\', printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (print_escape_control_characters && c_iscntrl (c))
+ {
+ char outbuf[1 + 3 + 1];
+ int len = sprintf (outbuf, "\\%03o", c + 0u);
+ strout (outbuf, len, len, printcharfun);
+ }
+ else
+ printchar (c, printcharfun);
+ need_nonhex = still_need_nonhex;
}
}
printchar ('\"', printcharfun);
@@ -2329,6 +2344,11 @@ A value of nil means no limit. See also
`eval-expression-print-level'. */);
Also print formfeeds as `\\f'. */);
print_escape_newlines = 0;
+ DEFVAR_BOOL ("print-escape-control-characters",
print_escape_control_characters,
+ doc: /* Non-nil means print control characters in strings as
`\\OOO'.
+\(OOO is the octal representation of the character code.)*/);
+ print_escape_control_characters = 0;
+
DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
doc: /* Non-nil means print unibyte non-ASCII chars in strings
as \\OOO.
\(OOO is the octal representation of the character code.)
@@ -2418,6 +2438,7 @@ priorities. */);
DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
+ DEFSYM (Qprint_escape_control_characters, "print-escape-control-characters");
print_prune_charset_plist = Qnil;
staticpro (&print_prune_charset_plist);
diff --git a/src/process.c b/src/process.c
index 2a1c2ee..abd017b 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,
nfds = xg_select (max_desc + 1,
&Available, (check_write ? &Writeok : 0),
NULL, &timeout, NULL);
+#elif defined HAVE_NS
+ /* And NS builds call thread_select in ns_select. */
+ nfds = ns_select (max_desc + 1,
+ &Available, (check_write ? &Writeok : 0),
+ NULL, &timeout, NULL);
#else /* !HAVE_GLIB */
- nfds = thread_select (
-# ifdef HAVE_NS
- ns_select
-# else
- pselect
-# endif
- , max_desc + 1,
+ nfds = thread_select (pselect, max_desc + 1,
&Available,
(check_write ? &Writeok : 0),
NULL, &timeout, NULL);
diff --git a/src/sysdep.c b/src/sysdep.c
index 70f4a9d..b522367 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1408,7 +1408,7 @@ reset_sys_modes (struct tty_display_info *tty_out)
{
if (noninteractive)
{
- fflush (stdout);
+ fflush_unlocked (stdout);
return;
}
if (!tty_out->term_initted)
@@ -1428,17 +1428,14 @@ reset_sys_modes (struct tty_display_info *tty_out)
}
else
{ /* have to do it the hard way */
- int i;
tty_turn_off_insert (tty_out);
- for (i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++)
- {
- fputc (' ', tty_out->output);
- }
+ for (int i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++)
+ fputc_unlocked (' ', tty_out->output);
}
cmgoto (tty_out, FrameRows (tty_out) - 1, 0);
- fflush (tty_out->output);
+ fflush_unlocked (tty_out->output);
if (tty_out->terminal->reset_terminal_modes_hook)
tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal);
@@ -3079,7 +3076,7 @@ procfs_ttyname (int rdev)
char minor[25]; /* 2 32-bit numbers + dash */
char *endp;
- for (; !feof (fdev) && !ferror (fdev); name[0] = 0)
+ for (; !feof_unlocked (fdev) && !ferror_unlocked (fdev); name[0] = 0)
{
if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3
&& major == MAJOR (rdev))
@@ -3129,7 +3126,7 @@ procfs_get_total_memory (void)
break;
case 0:
- while ((c = getc (fmem)) != EOF && c != '\n')
+ while ((c = getc_unlocked (fmem)) != EOF && c != '\n')
continue;
done = c == EOF;
break;
diff --git a/src/sysstdio.h b/src/sysstdio.h
index 45ee33f..7fbcefc 100644
--- a/src/sysstdio.h
+++ b/src/sysstdio.h
@@ -33,4 +33,45 @@ extern FILE *emacs_fopen (char const *, char const *);
# define FOPEN_TEXT ""
#endif
+/* These are compatible with unlocked-io.h, if both files are included. */
+#if !HAVE_DECL_CLEARERR_UNLOCKED
+# define clearerr_unlocked(x) clearerr (x)
+#endif
+#if !HAVE_DECL_FEOF_UNLOCKED
+# define feof_unlocked(x) feof (x)
+#endif
+#if !HAVE_DECL_FERROR_UNLOCKED
+# define ferror_unlocked(x) ferror (x)
+#endif
+#if !HAVE_DECL_FFLUSH_UNLOCKED
+# define fflush_unlocked(x) fflush (x)
+#endif
+#if !HAVE_DECL_FGETS_UNLOCKED
+# define fgets_unlocked(x,y,z) fgets (x,y,z)
+#endif
+#if !HAVE_DECL_FPUTC_UNLOCKED
+# define fputc_unlocked(x,y) fputc (x,y)
+#endif
+#if !HAVE_DECL_FPUTS_UNLOCKED
+# define fputs_unlocked(x,y) fputs (x,y)
+#endif
+#if !HAVE_DECL_FREAD_UNLOCKED
+# define fread_unlocked(w,x,y,z) fread (w,x,y,z)
+#endif
+#if !HAVE_DECL_FWRITE_UNLOCKED
+# define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z)
+#endif
+#if !HAVE_DECL_GETC_UNLOCKED
+# define getc_unlocked(x) getc (x)
+#endif
+#if !HAVE_DECL_GETCHAR_UNLOCKED
+# define getchar_unlocked() getchar ()
+#endif
+#if !HAVE_DECL_PUTC_UNLOCKED
+# define putc_unlocked(x,y) putc (x,y)
+#endif
+#if !HAVE_DECL_PUTCHAR_UNLOCKED
+# define putchar_unlocked(x) putchar (x)
+#endif
+
#endif /* EMACS_SYSSTDIO_H */
diff --git a/src/systhread.c b/src/systhread.c
index a84060c..aee12a9 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/>. */
#include <setjmp.h>
#include "lisp.h"
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#ifndef THREADS_ENABLED
void
@@ -130,6 +134,13 @@ void
sys_cond_broadcast (sys_cond_t *cond)
{
pthread_cond_broadcast (cond);
+#ifdef HAVE_NS
+ /* Send an app defined event to break out of the NS run loop.
+ It seems that if ns_select is running the NS run loop, this
+ broadcast has no effect until the loop is done, breaking a couple
+ of tests in thread-tests.el. */
+ ns_run_loop_break ();
+#endif
}
void
diff --git a/src/term.c b/src/term.c
index 8770aff..3d7f4ad 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/>. */
#include <config.h>
#include <errno.h>
#include <fcntl.h>
-#include <stdio.h>
#include <stdlib.h>
#include <sys/file.h>
#include <sys/time.h>
@@ -45,6 +44,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include "keymap.h"
#include "blockinput.h"
#include "syssignal.h"
+#include "sysstdio.h"
#ifdef MSDOS
#include "msdos.h"
static int been_here = -1;
@@ -146,7 +146,7 @@ tty_ring_bell (struct frame *f)
OUTPUT (tty, (tty->TS_visible_bell && visible_bell
? tty->TS_visible_bell
: tty->TS_bell));
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
}
@@ -167,9 +167,10 @@ tty_send_additional_strings (struct terminal *terminal,
Lisp_Object sym)
Lisp_Object string = XCAR (extra_codes);
if (STRINGP (string))
{
- fwrite (SDATA (string), 1, SBYTES (string), tty->output);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->output);
if (tty->termscript)
- fwrite (SDATA (string), 1, SBYTES (string), tty->termscript);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string),
+ tty->termscript);
}
}
}
@@ -197,7 +198,7 @@ tty_set_terminal_modes (struct terminal *terminal)
OUTPUT_IF (tty, tty->TS_keypad_mode);
losecursor (tty);
tty_send_additional_strings (terminal, Qtty_mode_set_strings);
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
}
@@ -220,7 +221,7 @@ tty_reset_terminal_modes (struct terminal *terminal)
/* Output raw CR so kernel can track the cursor hpos. */
current_tty = tty;
cmputc ('\r');
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
}
@@ -235,7 +236,7 @@ tty_update_end (struct frame *f)
tty_show_cursor (tty);
tty_turn_off_insert (tty);
tty_background_highlight (tty);
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
/* 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)
for (i = curX (tty); i < first_unused_hpos; i++)
{
if (tty->termscript)
- fputc (' ', tty->termscript);
- fputc (' ', tty->output);
+ fputc_unlocked (' ', tty->termscript);
+ fputc_unlocked (' ', tty->output);
}
cmplus (tty, first_unused_hpos - curX (tty));
}
@@ -771,11 +772,11 @@ tty_write_glyphs (struct frame *f, struct glyph *string,
int len)
if (coding->produced > 0)
{
block_input ();
- fwrite (conversion_buffer, 1, coding->produced, tty->output);
- if (ferror (tty->output))
- clearerr (tty->output);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
+ clearerr_unlocked (tty->output);
if (tty->termscript)
- fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced,
+ tty->termscript);
unblock_input ();
}
string += n;
@@ -832,11 +833,11 @@ tty_write_glyphs_with_face (register struct frame *f,
register struct glyph *str
if (coding->produced > 0)
{
block_input ();
- fwrite (conversion_buffer, 1, coding->produced, tty->output);
- if (ferror (tty->output))
- clearerr (tty->output);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
+ clearerr_unlocked (tty->output);
if (tty->termscript)
- fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced,
+ tty->termscript);
unblock_input ();
}
@@ -918,11 +919,11 @@ tty_insert_glyphs (struct frame *f, struct glyph *start,
int len)
if (coding->produced > 0)
{
block_input ();
- fwrite (conversion_buffer, 1, coding->produced, tty->output);
- if (ferror (tty->output))
- clearerr (tty->output);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
+ clearerr_unlocked (tty->output);
if (tty->termscript)
- fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced,
+ tty->termscript);
unblock_input ();
}
@@ -3327,7 +3328,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
which calls tty_show_cursor. Re-hide it, so it doesn't show
through the menus. */
tty_hide_cursor (tty);
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
sf->mouse_moved = 0;
@@ -3335,7 +3336,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
while (statecount--)
free_saved_screen (state[statecount].screen_behind);
tty_show_cursor (tty); /* Turn cursor back on. */
- fflush (tty->output);
+ fflush_unlocked (tty->output);
/* Clean up any mouse events that are waiting inside Emacs event queue.
These events are likely to be generated before the menu was even
diff --git a/src/w32fns.c b/src/w32fns.c
index e490588..b0842b5 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -5889,6 +5889,8 @@ This function is an internal primitive--use `make-frame'
instead. */)
NULL, NULL, RES_TYPE_BOOLEAN);
x_default_parameter (f, parameters, Qno_accept_focus, Qnil,
NULL, NULL, RES_TYPE_BOOLEAN);
+ x_default_parameter (f, parameters, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
/* Process alpha here (Bug#16619). On XP this fails with child
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. */)
f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS);
+ f->output_data.w32->left_edge_cursor = w32_load_cursor (IDC_SIZEWE);
+ f->output_data.w32->top_left_corner_cursor = w32_load_cursor (IDC_SIZENWSE);
+ f->output_data.w32->top_edge_cursor = w32_load_cursor (IDC_SIZENS);
+ f->output_data.w32->top_right_corner_cursor = w32_load_cursor (IDC_SIZENESW);
+ f->output_data.w32->right_edge_cursor = w32_load_cursor (IDC_SIZEWE);
+ f->output_data.w32->bottom_right_corner_cursor = w32_load_cursor
(IDC_SIZENWSE);
+ f->output_data.w32->bottom_edge_cursor = w32_load_cursor (IDC_SIZENS);
+ f->output_data.w32->bottom_left_corner_cursor = w32_load_cursor
(IDC_SIZENESW);
f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
@@ -7049,6 +7059,8 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
Lisp_Object parms)
"cursorColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qt,
+ NULL, NULL, RES_TYPE_BOOLEAN);
/* Init faces before x_default_parameter is called for the
scroll-bar-width parameter because otherwise we end up in
@@ -8950,33 +8962,47 @@ menu bar or tool bar of FRAME. */)
if (EQ (type, Qouter_edges))
{
RECT rectangle;
+ BOOL success = false;
block_input ();
/* Outer frame rectangle, including outer borders and title bar. */
- GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
+ success = GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
unblock_input ();
- return list4 (make_number (rectangle.left),
- make_number (rectangle.top),
- make_number (rectangle.right),
- make_number (rectangle.bottom));
+ if (success)
+ return list4 (make_number (rectangle.left),
+ make_number (rectangle.top),
+ make_number (rectangle.right),
+ make_number (rectangle.bottom));
+ else
+ return Qnil;
}
else
{
RECT rectangle;
POINT pt;
int left, top, right, bottom;
+ BOOL success;
block_input ();
/* Inner frame rectangle, excluding borders and title bar. */
- GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
+ success = GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
/* Get top-left corner of native rectangle in screen
coordinates. */
+ if (!success)
+ {
+ unblock_input ();
+ return Qnil;
+ }
+
pt.x = 0;
pt.y = 0;
- ClientToScreen (FRAME_W32_WINDOW (f), &pt);
+ success = ClientToScreen (FRAME_W32_WINDOW (f), &pt);
unblock_input ();
+ if (!success)
+ return Qnil;
+
left = pt.x;
top = pt.y;
right = left + rectangle.right;
@@ -10330,6 +10356,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
x_set_no_accept_focus,
x_set_z_group,
0, /* x_set_override_redirect */
+ x_set_no_special_glyphs,
};
void
diff --git a/src/w32term.c b/src/w32term.c
index 712bdae..c37805c 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -5086,6 +5086,51 @@ w32_read_socket (struct terminal *terminal,
}
case WM_WINDOWPOSCHANGED:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ RECT rect;
+ int /* rows, columns, */ width, height, text_width, text_height;
+
+ if (GetClientRect (msg.msg.hwnd, &rect)
+ /* GetClientRect evidently returns (0, 0, 0, 0) if
+ called on a minimized frame. Such "dimensions"
+ aren't useful anyway. */
+ && !(rect.bottom == 0
+ && rect.top == 0
+ && rect.left == 0
+ && rect.right == 0))
+ {
+ height = rect.bottom - rect.top;
+ width = rect.right - rect.left;
+ text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, width);
+ text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, height);
+ /* rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, height); */
+ /* columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, width); */
+
+ /* TODO: Clip size to the screen dimensions. */
+
+ /* Even if the number of character rows and columns
+ has not changed, the font size may have changed,
+ so we need to check the pixel dimensions as well. */
+
+ if (width != FRAME_PIXEL_WIDTH (f)
+ || height != FRAME_PIXEL_HEIGHT (f)
+ || text_width != FRAME_TEXT_WIDTH (f)
+ || text_height != FRAME_TEXT_HEIGHT (f))
+ {
+ change_frame_size (f, text_width, text_height, 0, 1, 0,
1);
+ SET_FRAME_GARBAGED (f);
+ cancel_mouse_face (f);
+ f->win_gravity = NorthWestGravity;
+ }
+ }
+ }
+
+ check_visibility = 1;
+ break;
+
case WM_ACTIVATE:
case WM_ACTIVATEAPP:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
@@ -6052,7 +6097,7 @@ x_calc_absolute_position (struct frame *f)
int display_top = 0;
struct frame *p = FRAME_PARENT_FRAME (f);
- if (flags & (XNegative | YNegative))
+ if (!p && flags & (XNegative | YNegative))
{
Lisp_Object list;
@@ -6078,20 +6123,26 @@ x_calc_absolute_position (struct frame *f)
}
/* Treat negative positions as relative to the rightmost bottommost
- position that fits on the screen. */
+ position that fits on the screen or parent frame.
+
+ I see no need for subtracting 1 from the border widths - is there
+ any on the remaining platforms? Here these subtractions did put
+ the last pixel line/column of a frame off-display when, for
+ example, a (set-frame-parameter nil 'left '(- 0)) specification was
+ used - martin 20017-05-05. */
if (flags & XNegative)
{
if (p)
f->left_pos = (FRAME_PIXEL_WIDTH (p)
- FRAME_PIXEL_WIDTH (f)
+ f->left_pos
- - (left_right_borders_width - 1));
+ - left_right_borders_width);
else
f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f))
+ display_left
- FRAME_PIXEL_WIDTH (f)
+ f->left_pos
- - (left_right_borders_width - 1));
+ - left_right_borders_width);
}
if (flags & YNegative)
@@ -6100,13 +6151,13 @@ x_calc_absolute_position (struct frame *f)
f->top_pos = (FRAME_PIXEL_HEIGHT (p)
- FRAME_PIXEL_HEIGHT (f)
+ f->top_pos
- - (top_bottom_borders_height - 1));
+ - top_bottom_borders_height);
else
f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f))
+ display_top
- FRAME_PIXEL_HEIGHT (f)
+ f->top_pos
- - (top_bottom_borders_height - 1));
+ - top_bottom_borders_height);
}
/* 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 371cf90..9956682 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -345,6 +345,14 @@ struct w32_output
Cursor hourglass_cursor;
Cursor horizontal_drag_cursor;
Cursor vertical_drag_cursor;
+ Cursor left_edge_cursor;
+ Cursor top_left_corner_cursor;
+ Cursor top_edge_cursor;
+ Cursor top_right_corner_cursor;
+ Cursor right_edge_cursor;
+ Cursor bottom_right_corner_cursor;
+ Cursor bottom_edge_cursor;
+ Cursor bottom_left_corner_cursor;
/* Non-zero means hourglass cursor is currently displayed. */
unsigned hourglass_p : 1;
diff --git a/src/window.c b/src/window.c
index bf89f0e..4816bd6 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1208,13 +1208,13 @@ coordinates_in_window (register struct window *w, int
x, int y)
- WINDOW_BOTTOM_DIVIDER_WIDTH (w))))
return ON_HORIZONTAL_SCROLL_BAR;
/* On the mode or header line? */
- else if ((WINDOW_WANTS_MODELINE_P (w)
+ else if ((window_wants_mode_line (w)
&& y >= (bottom_y
- CURRENT_MODE_LINE_HEIGHT (w)
- WINDOW_BOTTOM_DIVIDER_WIDTH (w))
&& y <= bottom_y - WINDOW_BOTTOM_DIVIDER_WIDTH (w)
&& (part = ON_MODE_LINE))
- || (WINDOW_WANTS_HEADER_LINE_P (w)
+ || (window_wants_header_line (w)
&& y < top_y + CURRENT_HEADER_LINE_HEIGHT (w)
&& (part = ON_HEADER_LINE)))
{
@@ -1851,7 +1851,7 @@ Return nil if window display is not up-to-date. In that
case, use
if (EQ (line, Qheader_line))
{
- if (!WINDOW_WANTS_HEADER_LINE_P (w))
+ if (!window_wants_header_line (w))
return Qnil;
row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
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
return list4i (row->height + min (0, row->y) - crop, i, row->y, crop);
}
+DEFUN ("window-lines-pixel-dimensions", Fwindow_lines_pixel_dimensions,
Swindow_lines_pixel_dimensions, 0, 6, 0,
+ doc: /* Return pixel dimensions of WINDOW's lines.
+The return value is a list of the x- and y-coordinates of the lower
+right corner of the last character of each line. Return nil if the
+current glyph matrix of WINDOW is not up-to-date.
+
+Optional argument WINDOW specifies the window whose lines' dimensions
+shall be returned. Nil or omitted means to return the dimensions for
+the selected window.
+
+FIRST, if non-nil, specifies the index of the first line whose
+dimensions shall be returned. If FIRST is nil and BODY is non-nil,
+start with the first text line of WINDOW. Otherwise, start with the
+first line of WINDOW.
+
+LAST, if non-nil, specifies the last line whose dimensions shall be
+returned. If LAST is nil and BODY is non-nil, the last line is the last
+line of the body (text area) of WINDOW. Otherwise, last is the last
+line of WINDOW.
+
+INVERSE, if nil, means that the y-pixel value returned for a specific
+line specifies the distance in pixels from the left edge (body edge if
+BODY is non-nil) of WINDOW to the right edge of the last glyph of that
+line. INVERSE non-nil means that the y-pixel value returned for a
+specific line specifies the distance in pixels from the right edge of
+the last glyph of that line to the right edge (body edge if BODY is
+non-nil) of WINDOW.
+
+LEFT non-nil means to return the x- and y-coordinates of the lower left
+corner of the leftmost character on each line. This is the value that
+should be used for buffers that mostly display text from right to left.
+
+If LEFT is non-nil and INVERSE is nil, this means that the y-pixel value
+returned for a specific line specifies the distance in pixels from the
+left edge of the last (leftmost) glyph of that line to the right edge
+(body edge if BODY is non-nil) of WINDOW. If LEFT and INVERSE are both
+non-nil, the y-pixel value returned for a specific line specifies the
+distance in pixels from the left edge (body edge if BODY is non-nil) of
+WINDOW to the left edge of the last (leftmost) glyph of that line.
+
+Normally, the value of this function is not available while Emacs is
+busy, for example, when processing a command. It should be retrievable
+though when run from an idle timer with a delay of zero seconds. */)
+ (Lisp_Object window, Lisp_Object first, Lisp_Object last, Lisp_Object body,
Lisp_Object inverse, Lisp_Object left)
+{
+ struct window *w = decode_live_window (window);
+ struct buffer *b;
+ struct glyph_row *row, *end_row;
+ int max_y = NILP (body) ? WINDOW_PIXEL_HEIGHT (w) : window_text_bottom_y (w);
+ Lisp_Object rows = Qnil;
+ int window_width = NILP (body) ? w->pixel_width : window_body_width (w,
true);
+ int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w);
+ int subtract = NILP (body) ? 0 : header_line_height;
+ bool invert = !NILP (inverse);
+ bool left_flag = !NILP (left);
+
+ if (noninteractive || w->pseudo_window_p)
+ return Qnil;
+
+ CHECK_BUFFER (w->contents);
+ b = XBUFFER (w->contents);
+
+ /* Fail if current matrix is not up-to-date. */
+ if (!w->window_end_valid
+ || windows_or_buffers_changed
+ || b->clip_changed
+ || b->prevent_redisplay_optimizations_p
+ || window_outdated (w))
+ return Qnil;
+
+ if (NILP (first))
+ row = (NILP (body)
+ ? MATRIX_ROW (w->current_matrix, 0)
+ : MATRIX_FIRST_TEXT_ROW (w->current_matrix));
+ else if (NUMBERP (first))
+ {
+ CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows);
+ row = MATRIX_ROW (w->current_matrix, XINT (first));
+ }
+ else
+ error ("Invalid specification of first line");
+
+ if (NILP (last))
+
+ end_row = (NILP (body)
+ ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
+ : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
+ else if (NUMBERP (last))
+ {
+ CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows);
+ end_row = MATRIX_ROW (w->current_matrix, XINT (last));
+ }
+ else
+ error ("Invalid specification of last line");
+
+ while (row <= end_row && row->enabled_p
+ && row->y + row->height < max_y)
+ {
+
+ if (left_flag)
+ {
+ struct glyph *glyph = row->glyphs[TEXT_AREA];
+
+ rows = Fcons (Fcons (make_number
+ (invert
+ ? glyph->pixel_width
+ : window_width - glyph->pixel_width),
+ make_number (row->y + row->height - subtract)),
+ rows);
+ }
+ else
+ rows = Fcons (Fcons (make_number
+ (invert
+ ? window_width - row->pixel_width
+ : row->pixel_width),
+ make_number (row->y + row->height - subtract)),
+ rows);
+ row++;
+ }
+
+ return Fnreverse (rows);
+}
+
DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p,
0, 1, 0,
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). */)
return Fcopy_alist (decode_valid_window (window)->window_parameters);
}
+Lisp_Object
+window_parameter (struct window *w, Lisp_Object parameter)
+{
+ Lisp_Object result = Fassq (parameter, w->window_parameters);
+
+ return CDR_SAFE (result);
+}
+
+
DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter,
2, 2, 0,
doc: /* Return WINDOW's value for PARAMETER.
WINDOW can be any window and defaults to the selected one. */)
(Lisp_Object window, Lisp_Object parameter)
{
- Lisp_Object result;
+ struct window *w = decode_any_window (window);
- result = Fassq (parameter, decode_any_window (window)->window_parameters);
- return CDR_SAFE (result);
+ return window_parameter (w, parameter);
}
DEFUN ("set-window-parameter", Fset_window_parameter,
@@ -4740,6 +4871,69 @@ mark_window_cursors_off (struct window *w)
}
+/**
+ * window_wants_mode_line:
+ *
+ * Return 1 if window W wants a mode line and is high enough to
+ * accomodate it, 0 otherwise.
+ *
+ * W wants a mode line if it's a leaf window and neither a minibuffer
+ * nor a pseudo window. Moreover, its 'window-mode-line-format'
+ * parameter must not be 'none' and either that parameter or W's
+ * buffer's 'mode-line-format' value must be non-nil. Finally, W must
+ * be higher than its frame's canonical character height.
+ */
+bool
+window_wants_mode_line (struct window *w)
+{
+ Lisp_Object window_mode_line_format =
+ window_parameter (w, Qmode_line_format);
+
+ return ((WINDOW_LEAF_P (w)
+ && !MINI_WINDOW_P (w)
+ && !WINDOW_PSEUDO_P (w)
+ && !EQ (window_mode_line_format, Qnone)
+ && (!NILP (window_mode_line_format)
+ || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), mode_line_format)))
+ && WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w))
+ ? 1
+ : 0);
+}
+
+
+/**
+ * window_wants_header_line:
+ *
+ * Return 1 if window W wants a header line and is high enough to
+ * accomodate it, 0 otherwise.
+ *
+ * W wants a header line if it's a leaf window and neither a minibuffer
+ * nor a pseudo window. Moreover, its 'window-mode-line-format'
+ * parameter must not be 'none' and either that parameter or W's
+ * buffer's 'mode-line-format' value must be non-nil. Finally, W must
+ * be higher than its frame's canonical character height and be able to
+ * accomodate a mode line too if necessary (the mode line prevails).
+ */
+bool
+window_wants_header_line (struct window *w)
+{
+ Lisp_Object window_header_line_format =
+ window_parameter (w, Qheader_line_format);
+
+ return ((WINDOW_LEAF_P (w)
+ && !MINI_WINDOW_P (w)
+ && !WINDOW_PSEUDO_P (w)
+ && !EQ (window_header_line_format, Qnone)
+ && (!NILP (window_header_line_format)
+ || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)),
header_line_format)))
+ && (WINDOW_PIXEL_HEIGHT (w)
+ > (window_wants_mode_line (w)
+ ? 2 * WINDOW_FRAME_LINE_HEIGHT (w)
+ : WINDOW_FRAME_LINE_HEIGHT (w))))
+ ? 1
+ : 0);
+}
+
/* Return number of lines of text (not counting mode lines) in W. */
int
@@ -4753,10 +4947,10 @@ window_internal_height (struct window *w)
|| WINDOWP (w->contents)
|| !NILP (w->next)
|| !NILP (w->prev)
- || WINDOW_WANTS_MODELINE_P (w))
+ || window_wants_mode_line (w))
--ht;
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
--ht;
}
@@ -7354,6 +7548,8 @@ syms_of_window (void)
DEFSYM (Qfloor, "floor");
DEFSYM (Qceiling, "ceiling");
DEFSYM (Qmark_for_redisplay, "mark-for-redisplay");
+ DEFSYM (Qmode_line_format, "mode-line-format");
+ DEFSYM (Qheader_line_format, "header-line-format");
staticpro (&Vwindow_list);
@@ -7603,6 +7799,7 @@ displayed after a scrolling operation to be somewhat
inaccurate. */);
defsubr (&Sset_window_point);
defsubr (&Sset_window_start);
defsubr (&Swindow_dedicated_p);
+ defsubr (&Swindow_lines_pixel_dimensions);
defsubr (&Sset_window_dedicated_p);
defsubr (&Swindow_display_table);
defsubr (&Sset_window_display_table);
diff --git a/src/window.h b/src/window.h
index acb8a5c..e9040f816 100644
--- a/src/window.h
+++ b/src/window.h
@@ -328,8 +328,9 @@ struct window
/* True if this window is a minibuffer window. */
bool_bf mini : 1;
- /* Meaningful only if contents is a window, true if this
- internal window is used in horizontal combination. */
+ /* Meaningful for internal windows only: true if this window is a
+ horizontal combination, false if it is a vertical
+ combination. */
bool_bf horizontal : 1;
/* True means must regenerate mode line of this window. */
@@ -481,15 +482,14 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* True if W is a minibuffer window. */
#define MINI_WINDOW_P(W) ((W)->mini)
-/* 1 if W is a non-only minibuffer window. */
-/* The first check is redundant and the second overly complicated. */
-#define MINI_NON_ONLY_WINDOW_P(W) \
- (MINI_WINDOW_P (W) \
- && (EQ (W->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))
+/* True if W is a minibuffer window on a frame that contains at least
+ one other window. */
+#define MINI_NON_ONLY_WINDOW_P(W) \
+ (MINI_WINDOW_P (W) && !NILP ((W)->prev))
-/* 1 if W is a minibuffer-only window. */
-#define MINI_ONLY_WINDOW_P(W) \
- (MINI_WINDOW_P (W) && NILP (W->prev))
+/* True if W is a minibuffer window that is alone on its frame. */
+#define MINI_ONLY_WINDOW_P(W) \
+ (MINI_WINDOW_P (W) && NILP ((W)->prev))
/* General window layout:
@@ -518,29 +518,34 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* A handy macro. */
-/* Non-nil if W is leaf (carry the buffer). */
-
+/* Non-nil if window W is leaf window (has a buffer). */
#define WINDOW_LEAF_P(W) \
(BUFFERP ((W)->contents))
-/* Non-nil if W is internal. */
+/* Non-nil if window W is internal (is a parent window). */
#define WINDOW_INTERNAL_P(W) \
(WINDOWP ((W)->contents))
-/* True if W is a member of horizontal combination. */
+/* True if window W is a horizontal combination of windows. */
#define WINDOW_HORIZONTAL_COMBINATION_P(W) \
(WINDOW_INTERNAL_P (W) && (W)->horizontal)
-/* True if W is a member of vertical combination. */
+/* True if window W is a vertical combination of windows. */
#define WINDOW_VERTICAL_COMBINATION_P(W) \
(WINDOW_INTERNAL_P (W) && !(W)->horizontal)
-/* WINDOW's XFRAME. */
+/* Window W's XFRAME. */
#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W))))
-/* Whether WINDOW is a pseudo window. */
+/* Whether window W is a pseudo window. */
#define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p)
+/* Window W's buffer. */
+#define WINDOW_BUFFER(W) \
+ (WINDOW_LEAF_P(W) \
+ ? (W)->contents \
+ : Qnil) \
+
/* Return the canonical column width of the frame of window W. */
#define WINDOW_FRAME_COLUMN_WIDTH(W) \
(FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W))))
@@ -549,24 +554,24 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define WINDOW_FRAME_LINE_HEIGHT(W) \
(FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W))))
-/* Return the pixel width of window W.
- This includes scroll bars and fringes. */
+/* Return the pixel width of window W. This includes dividers, scroll
+ bars, fringes and margins, if any. */
#define WINDOW_PIXEL_WIDTH(W) (W)->pixel_width
-/* Return the pixel height of window W.
- This includes header and mode lines, if any. */
+/* Return the pixel height of window W. This includes dividers, scroll
+ bars, header and mode lines, if any. */
#define WINDOW_PIXEL_HEIGHT(W) (W)->pixel_height
-/* Return the width of window W in canonical column units.
- This includes scroll bars and fringes.
- This value is adjusted such that the sum of the widths of all child
+/* Return the width of window W in canonical column units. This
+ includes dividers, scroll bars, fringes and margins, if any. The
+ value is adjusted such that the sum of the widths of all child
windows equals the width of their parent window. */
#define WINDOW_TOTAL_COLS(W) (W)->total_cols
-/* Return the height of window W in canonical line units.
- This includes header and mode lines, if any.
- This value is adjusted such that the sum of the heights of all child
- windows equals the height of their parent window. */
+/* Return the height of window W in canonical line units. This includes
+ dividers, scroll bars, header and mode lines, if any. The value is
+ adjusted such that the sum of the heights of all child windows equals
+ the height of their parent window. */
#define WINDOW_TOTAL_LINES(W) (W)->total_lines
/* The smallest acceptable dimensions for a window. Anything smaller
@@ -581,31 +586,63 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \
(WINDOW_FRAME_LINE_HEIGHT (W))
+/* True if window W has no other windows to its left on its frame. */
+#define WINDOW_LEFTMOST_P(W) \
+ (WINDOW_LEFT_PIXEL_EDGE (W) == 0)
+
+/* True if window W has no other windows above it on its frame. */
+#define WINDOW_TOPMOST_P(W) \
+ (WINDOW_TOP_PIXEL_EDGE (W) == 0)
+
+/* True if window W has no other windows to its right on its frame. */
+#define WINDOW_RIGHTMOST_P(W) \
+ (WINDOW_RIGHT_PIXEL_EDGE (W) \
+ == (WINDOW_RIGHT_PIXEL_EDGE \
+ (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
+
+/* True if window W has no other windows below it on its frame (the
+ minibuffer window is not counted in this respect unless W itself is a
+ minibuffer window). */
+#define WINDOW_BOTTOMMOST_P(W) \
+ (WINDOW_BOTTOM_PIXEL_EDGE (W) \
+ == (WINDOW_BOTTOM_PIXEL_EDGE \
+ (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
+
+/* True if window W takes up the full width of its frame. */
+#define WINDOW_FULL_WIDTH_P(W) \
+ (WINDOW_PIXEL_WIDTH (W) \
+ == (WINDOW_PIXEL_WIDTH \
+ (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
+
/* Width of right divider of window W. */
#define WINDOW_RIGHT_DIVIDER_WIDTH(W) \
- ((WINDOW_RIGHTMOST_P (W) || MINI_WINDOW_P (W)) \
- ? 0 \
- : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
+ (WINDOW_RIGHTMOST_P (W) \
+ ? 0 : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
+
+/* Width of bottom divider of window W. */
+#define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \
+ (((WINDOW_BOTTOMMOST_P (W) \
+ && NILP ((XWINDOW (FRAME_ROOT_WINDOW \
+ (WINDOW_XFRAME (W))))->next)) \
+ || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \
+ || (W)->pseudo_window_p) \
+ ? 0 : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
/* Return the canonical frame column at which window W starts.
This includes a left-hand scroll bar, if any. */
-
#define WINDOW_LEFT_EDGE_COL(W) (W)->left_col
/* Return the canonical frame column before which window W ends.
This includes a right-hand scroll bar, if any. */
-
#define WINDOW_RIGHT_EDGE_COL(W) \
(WINDOW_LEFT_EDGE_COL (W) + WINDOW_TOTAL_COLS (W))
/* Return the canonical frame line at which window W starts.
This includes a header line, if any. */
-
#define WINDOW_TOP_EDGE_LINE(W) (W)->top_line
/* Return the canonical frame line before which window W ends.
This includes a mode line, if any. */
-
#define WINDOW_BOTTOM_EDGE_LINE(W) \
(WINDOW_TOP_EDGE_LINE (W) + WINDOW_TOTAL_LINES (W))
@@ -629,20 +666,17 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Return the frame x-position at which window W starts.
This includes a left-hand scroll bar, if any. */
-
#define WINDOW_LEFT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_LEFT_PIXEL_EDGE (W))
/* Return the frame x- position before which window W ends.
This includes a right-hand scroll bar, if any. */
-
#define WINDOW_RIGHT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_RIGHT_PIXEL_EDGE (W))
/* True if W is a menu bar window. */
-
#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined
(USE_GTK)
#define WINDOW_MENU_BAR_P(W) \
(WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \
@@ -661,72 +695,24 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define WINDOW_TOOL_BAR_P(W) false
#endif
-/* Return the frame y-position at which window W starts.
- This includes a header line, if any.
-
- PXW: With a menu or tool bar this is not symmetric to the _X values
- since it _does_ include the internal border width. */
+/* Return the frame y-position at which window W starts. */
#define WINDOW_TOP_EDGE_Y(W) \
(((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \
? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \
+ WINDOW_TOP_PIXEL_EDGE (W))
-/* Return the frame y-position before which window W ends.
- This includes a mode line, if any. */
+/* Return the frame y-position before which window W ends. */
#define WINDOW_BOTTOM_EDGE_Y(W) \
(((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \
? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \
+ WINDOW_BOTTOM_PIXEL_EDGE (W))
-/* True if window W takes up the full width of its frame. */
-#define WINDOW_FULL_WIDTH_P(W) \
- (WINDOW_PIXEL_WIDTH (W) \
- == (WINDOW_PIXEL_WIDTH \
- (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
-
-/* True if window W's has no other windows to its left in its frame. */
-
-#define WINDOW_LEFTMOST_P(W) \
- (WINDOW_LEFT_PIXEL_EDGE (W) == 0)
-
-/* True if window W's has no other windows above in its frame. */
-#define WINDOW_TOPMOST_P(W) \
- (WINDOW_TOP_PIXEL_EDGE (W) == 0)
-
-/* True if window W's has no other windows to its right in its frame. */
-#define WINDOW_RIGHTMOST_P(W) \
- (WINDOW_RIGHT_PIXEL_EDGE (W) \
- == (WINDOW_RIGHT_PIXEL_EDGE \
- (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
-
-/* True if window W's has no other windows below it in its frame
- (the minibuffer window is not counted in this respect). */
-#define WINDOW_BOTTOMMOST_P(W) \
- (WINDOW_BOTTOM_PIXEL_EDGE (W) \
- == (WINDOW_BOTTOM_PIXEL_EDGE \
- (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
-
-/* Return the frame column at which the text (or left fringe) in
- window W starts. This is different from the `LEFT_EDGE' because it
- does not include a left-hand scroll bar if any. */
-#define WINDOW_BOX_LEFT_EDGE_COL(W) \
- (WINDOW_LEFT_EDGE_COL (W) \
- + WINDOW_LEFT_SCROLL_BAR_COLS (W))
-
-/* Return the pixel value where the text (or left fringe) in
- window W starts. This is different from the `LEFT_EDGE' because it
- does not include a left-hand scroll bar if any. */
+/* Return the pixel value where the text (or left fringe) in window W
+ starts. */
#define WINDOW_BOX_LEFT_PIXEL_EDGE(W) \
(WINDOW_LEFT_PIXEL_EDGE (W) \
+ WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (W))
-/* Return the window column before which the text in window W ends.
- This is different from WINDOW_RIGHT_EDGE_COL because it does not
- include a scroll bar or window-separating line on the right edge. */
-#define WINDOW_BOX_RIGHT_EDGE_COL(W) \
- (WINDOW_RIGHT_EDGE_COL (W) \
- - WINDOW_RIGHT_SCROLL_BAR_COLS (W))
-
/* Return the pixel value before which the text in window W ends. This
is different from the `RIGHT_EDGE' because it does not include a
right-hand scroll bar or window-separating line on the right
@@ -736,16 +722,16 @@ wset_next_buffers (struct window *w, Lisp_Object val)
- WINDOW_RIGHT_DIVIDER_WIDTH (W) \
- WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (W))
-/* Return the frame position at which the text (or left fringe) in
- window W starts. This is different from the `LEFT_EDGE' because it
- does not include a left-hand scroll bar if any. */
+/* Return the frame x-position at which the text (or left fringe) in
+ window W starts. This does not include a left-hand scroll bar if
+ any. */
#define WINDOW_BOX_LEFT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_BOX_LEFT_PIXEL_EDGE (W))
-/* Return the window column before which the text in window W ends.
- This is different from WINDOW_RIGHT_EDGE_COL because it does not
- include a scroll bar or window-separating line on the right edge. */
+/* Return the frame x-position before which the text in window W ends.
+ This does not include a scroll bar, divider or window-separating line
+ on the right edge. */
#define WINDOW_BOX_RIGHT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_BOX_RIGHT_PIXEL_EDGE (W))
@@ -899,16 +885,6 @@ wset_next_buffers (struct window *w, Lisp_Object val)
? WINDOW_BOX_RIGHT_EDGE_X (W) \
: WINDOW_LEFT_EDGE_X (W))
-/* Width of bottom divider of window W. */
-#define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \
- (((WINDOW_BOTTOMMOST_P (W) \
- && NILP ((XWINDOW (FRAME_ROOT_WINDOW \
- (WINDOW_XFRAME (W))))->next)) \
- || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \
- || (W)->pseudo_window_p) \
- ? 0 \
- : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
-
/* Height that a scroll bar in window W should have, if there is one.
Measured in pixels. If scroll bars are turned off, this is still
nonzero. */
@@ -942,22 +918,22 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Height in pixels of the mode line.
May be zero if W doesn't have a mode line. */
#define WINDOW_MODE_LINE_HEIGHT(W) \
- (WINDOW_WANTS_MODELINE_P ((W)) \
+ (window_wants_mode_line ((W)) \
? CURRENT_MODE_LINE_HEIGHT (W) \
: 0)
#define WINDOW_MODE_LINE_LINES(W) \
- WINDOW_WANTS_MODELINE_P (W)
+ window_wants_mode_line (W)
/* Height in pixels of the header line.
Zero if W doesn't have a header line. */
#define WINDOW_HEADER_LINE_HEIGHT(W) \
- (WINDOW_WANTS_HEADER_LINE_P (W) \
+ (window_wants_header_line (W) \
? CURRENT_HEADER_LINE_HEIGHT (W) \
: 0)
#define WINDOW_HEADER_LINE_LINES(W) \
- WINDOW_WANTS_HEADER_LINE_P (W)
+ window_wants_header_line (W)
/* Pixel height of window W without mode line, bottom scroll bar and
bottom divider. */
@@ -1114,10 +1090,13 @@ struct glyph *get_phys_cursor_glyph (struct window *w);
extern Lisp_Object Vwindow_list;
extern Lisp_Object window_list (void);
+extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter);
extern struct window *decode_live_window (Lisp_Object);
extern struct window *decode_any_window (Lisp_Object);
extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
extern void mark_window_cursors_off (struct window *);
+extern bool window_wants_mode_line (struct window *);
+extern bool window_wants_header_line (struct window *);
extern int window_internal_height (struct window *);
extern int window_body_width (struct window *w, bool);
enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS };
@@ -1133,7 +1112,6 @@ extern void init_window_once (void);
extern void init_window (void);
extern void syms_of_window (void);
extern void keys_of_window (void);
-
/* Move cursor to row/column position VPOS/HPOS, pixel coordinates
Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y
are window-relative pixel positions. This is always done during
diff --git a/src/xdisp.c b/src/xdisp.c
index 34ee877..8bc5d81 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -921,7 +921,7 @@ window_text_bottom_y (struct window *w)
height -= WINDOW_BOTTOM_DIVIDER_WIDTH (w);
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
height -= CURRENT_MODE_LINE_HEIGHT (w);
height -= WINDOW_SCROLL_BAR_AREA_HEIGHT (w);
@@ -978,7 +978,7 @@ window_box_height (struct window *w)
the appropriate glyph row has its `mode_line_p' flag set,
and if it doesn't, uses estimate_mode_line_height instead. */
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
{
struct glyph_row *ml_row
= (w->current_matrix && w->current_matrix->rows
@@ -990,7 +990,7 @@ window_box_height (struct window *w)
height -= estimate_mode_line_height (f, CURRENT_MODE_LINE_FACE_ID (w));
}
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
{
struct glyph_row *hl_row
= (w->current_matrix && w->current_matrix->rows
@@ -1102,7 +1102,7 @@ window_box (struct window *w, enum glyph_row_area area,
int *box_x,
if (box_y)
{
*box_y = WINDOW_TOP_EDGE_Y (w);
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
*box_y += CURRENT_HEADER_LINE_HEIGHT (w);
}
}
@@ -1322,15 +1322,29 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int
*x, int *y,
return visible_p;
/* Compute exact mode line heights. */
- if (WINDOW_WANTS_MODELINE_P (w))
- w->mode_line_height
- = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w),
- BVAR (current_buffer, mode_line_format));
+ if (window_wants_mode_line (w))
+ {
+ Lisp_Object window_mode_line_format
+ = window_parameter (w, Qmode_line_format);
+
+ w->mode_line_height
+ = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w),
+ NILP (window_mode_line_format)
+ ? BVAR (current_buffer, mode_line_format)
+ : window_mode_line_format);
+ }
- if (WINDOW_WANTS_HEADER_LINE_P (w))
- w->header_line_height
- = display_mode_line (w, HEADER_LINE_FACE_ID,
- BVAR (current_buffer, header_line_format));
+ if (window_wants_header_line (w))
+ {
+ Lisp_Object window_header_line_format
+ = window_parameter (w, Qheader_line_format);
+
+ w->header_line_height
+ = display_mode_line (w, HEADER_LINE_FACE_ID,
+ NILP (window_header_line_format)
+ ? BVAR (current_buffer, header_line_format)
+ : window_header_line_format);
+ }
start_display (&it, w, top);
move_it_to (&it, charpos, -1, it.last_visible_y - 1, -1,
@@ -2842,13 +2856,12 @@ init_iterator (struct it *it, struct window *w,
/* Get dimensions of truncation and continuation glyphs. These are
displayed as fringe bitmaps under X, but we need them for such
- frames when the fringes are turned off. But leave the dimensions
- zero for tooltip frames, as these glyphs look ugly there and also
- sabotage calculations of tooltip dimensions in x-show-tip. */
+ frames when the fringes are turned off. The no_special_glyphs slot
+ of the iterator's frame, when set, suppresses their display - by
+ default for tooltip frames and when set via the 'no-special-glyphs'
+ frame parameter. */
#ifdef HAVE_WINDOW_SYSTEM
- if (!(FRAME_WINDOW_P (it->f)
- && FRAMEP (tip_frame)
- && it->f == XFRAME (tip_frame)))
+ if (!(FRAME_WINDOW_P (it->f) && it->f->no_special_glyphs))
#endif
{
if (it->line_wrap == TRUNCATE)
@@ -2920,7 +2933,7 @@ init_iterator (struct it *it, struct window *w,
it->last_visible_x -= it->continuation_pixel_width;
}
- it->header_line_p = WINDOW_WANTS_HEADER_LINE_P (w);
+ it->header_line_p = window_wants_header_line (w);
it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll;
}
@@ -3019,7 +3032,7 @@ void
start_display (struct it *it, struct window *w, struct text_pos pos)
{
struct glyph_row *row;
- bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w);
+ bool first_vpos = window_wants_header_line (w);
row = w->desired_matrix->rows + first_vpos;
init_iterator (it, w, CHARPOS (pos), BYTEPOS (pos), row, DEFAULT_FACE_ID);
@@ -7755,9 +7768,8 @@ next_element_from_display_vector (struct it *it)
/* KFS: This code used to check ip->dpvec[0] instead of the current element.
That seemed totally bogus - so I changed it... */
- gc = it->dpvec[it->current.dpvec_index];
-
- if (GLYPH_CODE_P (gc))
+ if (it->dpend - it->dpvec > 0 /* empty dpvec[] is invalid */
+ && (gc = it->dpvec[it->current.dpvec_index], GLYPH_CODE_P (gc)))
{
struct face *this_face, *prev_face, *next_face;
@@ -15799,7 +15811,7 @@ compute_window_start_on_continuation_line (struct
window *w)
/* Find the start of the continued line. This should be fast
because find_newline is fast (newline cache). */
- row = w->desired_matrix->rows + WINDOW_WANTS_HEADER_LINE_P (w);
+ row = w->desired_matrix->rows + window_wants_header_line (w);
init_iterator (&it, w, CHARPOS (start_pos), BYTEPOS (start_pos),
row, DEFAULT_FACE_ID);
reseat_at_previous_visible_line_start (&it);
@@ -15949,7 +15961,7 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
top_scroll_margin = this_scroll_margin;
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
/* 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)
margin, even though this part handles windows that didn't
scroll at all. */
int pixel_margin = margin * frame_line_height;
- bool header_line = WINDOW_WANTS_HEADER_LINE_P (w);
+ bool header_line = window_wants_header_line (w);
/* Note: We add an extra FRAME_LINE_HEIGHT, because the loop
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)
|| (w->column_number_displayed != -1
&& (w->column_number_displayed != current_column ())))
/* This means that the window has a mode line. */
- && (WINDOW_WANTS_MODELINE_P (w)
- || WINDOW_WANTS_HEADER_LINE_P (w)))
+ && (window_wants_mode_line (w)
+ || window_wants_header_line (w)))
{
display_mode_lines (w);
/* If mode line height has changed, arrange for a thorough
immediate redisplay using the correct mode line height. */
- if (WINDOW_WANTS_MODELINE_P (w)
+ if (window_wants_mode_line (w)
&& CURRENT_MODE_LINE_HEIGHT (w) != DESIRED_MODE_LINE_HEIGHT (w))
{
f->fonts_changed = true;
@@ -17318,7 +17330,7 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
/* If header line height has changed, arrange for a thorough
immediate redisplay using the correct header line height. */
- if (WINDOW_WANTS_HEADER_LINE_P (w)
+ if (window_wants_header_line (w)
&& CURRENT_HEADER_LINE_HEIGHT (w) != DESIRED_HEADER_LINE_HEIGHT (w))
{
f->fonts_changed = true;
@@ -17583,7 +17595,7 @@ try_window_reusing_current_matrix (struct window *w)
return false;
/* If top-line visibility has changed, give up. */
- if (WINDOW_WANTS_HEADER_LINE_P (w)
+ if (window_wants_header_line (w)
!= MATRIX_HEADER_LINE_ROW (w->current_matrix)->mode_line_p)
return false;
@@ -18818,7 +18830,7 @@ try_window_id (struct window *w)
= MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix);
int from = WINDOW_TOP_EDGE_LINE (w) + from_vpos;
int end = (WINDOW_TOP_EDGE_LINE (w)
- + WINDOW_WANTS_HEADER_LINE_P (w)
+ + window_wants_header_line (w)
+ window_internal_height (w));
#if defined (HAVE_GPM) || defined (MSDOS)
@@ -18996,7 +19008,7 @@ try_window_id (struct window *w)
{
/* Displayed to end of window, but no line containing text was
displayed. Lines were deleted at the end of the window. */
- bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w);
+ bool first_vpos = window_wants_header_line (w);
int vpos = w->window_end_vpos;
struct glyph_row *current_row = current_matrix->rows + vpos;
struct glyph_row *desired_row = desired_matrix->rows + vpos;
@@ -20696,7 +20708,7 @@ display_line (struct it *it, int cursor_vpos)
ptrdiff_t min_pos = ZV + 1, max_pos = 0;
ptrdiff_t min_bpos UNINIT, max_bpos UNINIT;
bool pending_handle_line_prefix = false;
- int header_line = WINDOW_WANTS_HEADER_LINE_P (it->w);
+ int header_line = window_wants_header_line (it->w);
bool hscroll_this_line = (cursor_vpos >= 0
&& it->vpos == cursor_vpos - header_line
&& hscrolling_current_line_p (it->w));
@@ -22649,20 +22661,30 @@ display_mode_lines (struct window *w)
line_number_displayed = false;
w->column_number_displayed = -1;
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
{
+ Lisp_Object window_mode_line_format
+ = window_parameter (w, Qmode_line_format);
+
struct window *sel_w = XWINDOW (old_selected_window);
/* Select mode line face based on the real selected window. */
display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w),
- BVAR (current_buffer, mode_line_format));
+ NILP (window_mode_line_format)
+ ? BVAR (current_buffer, mode_line_format)
+ : window_mode_line_format);
++n;
}
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
{
+ Lisp_Object window_header_line_format
+ = window_parameter (w, Qheader_line_format);
+
display_mode_line (w, HEADER_LINE_FACE_ID,
- BVAR (current_buffer, header_line_format));
+ NILP (window_header_line_format)
+ ? BVAR (current_buffer, header_line_format)
+ : window_header_line_format);
++n;
}
@@ -30442,13 +30464,67 @@ note_mouse_highlight (struct frame *f, int x, int y)
&& part != ON_HEADER_LINE))
clear_mouse_face (hlinfo);
+ /* Reset help_echo_string. It will get recomputed below. */
+ help_echo_string = Qnil;
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* If the cursor is on the internal border of FRAME and FRAME's
+ internal border is draggable, provide some visual feedback. */
+ if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0
+ && !NILP (get_frame_param (f, Qdrag_internal_border)))
+ {
+ enum internal_border_part part = frame_internal_border_part (f, x, y);
+
+ switch (part)
+ {
+ case INTERNAL_BORDER_NONE:
+ if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
+ /* Reset cursor. */
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+ break;
+ case INTERNAL_BORDER_LEFT_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->left_edge_cursor;
+ break;
+ case INTERNAL_BORDER_TOP_LEFT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->top_left_corner_cursor;
+ break;
+ case INTERNAL_BORDER_TOP_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->top_edge_cursor;
+ break;
+ case INTERNAL_BORDER_TOP_RIGHT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->top_right_corner_cursor;
+ break;
+ case INTERNAL_BORDER_RIGHT_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->right_edge_cursor;
+ break;
+ case INTERNAL_BORDER_BOTTOM_RIGHT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->bottom_right_corner_cursor;
+ break;
+ case INTERNAL_BORDER_BOTTOM_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->bottom_edge_cursor;
+ break;
+ case INTERNAL_BORDER_BOTTOM_LEFT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->bottom_left_corner_cursor;
+ break;
+ default:
+ /* This should not happen. */
+ if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+ }
+
+ if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
+ {
+ /* Do we really want a help echo here? */
+ help_echo_string = build_string ("drag-mouse-1: resize frame");
+ goto set_cursor;
+ }
+ }
+#endif /* HAVE_WINDOW_SYSTEM */
+
/* Not on a window -> return. */
if (!WINDOWP (window))
return;
- /* Reset help_echo_string. It will get recomputed below. */
- help_echo_string = Qnil;
-
/* Convert to window-relative pixel coordinates. */
w = XWINDOW (window);
frame_to_window_pixel_xy (w, &x, &y);
@@ -30486,11 +30562,13 @@ note_mouse_highlight (struct frame *f, int x, int y)
{
cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
help_echo_string = build_string ("drag-mouse-1: resize");
+ goto set_cursor;
}
else if (part == ON_RIGHT_DIVIDER)
{
cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
help_echo_string = build_string ("drag-mouse-1: resize");
+ goto set_cursor;
}
else if (part == ON_BOTTOM_DIVIDER)
if (! WINDOW_BOTTOMMOST_P (w)
@@ -30499,6 +30577,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
{
cursor = FRAME_X_OUTPUT (f)->vertical_drag_cursor;
help_echo_string = build_string ("drag-mouse-1: resize");
+ goto set_cursor;
}
else
cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
@@ -31193,8 +31272,15 @@ x_draw_right_divider (struct window *w)
int x0 = WINDOW_RIGHT_EDGE_X (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w);
int x1 = WINDOW_RIGHT_EDGE_X (w);
int y0 = WINDOW_TOP_EDGE_Y (w);
- /* The bottom divider prevails. */
- int y1 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w);
+ int y1 = WINDOW_BOTTOM_EDGE_Y (w);
+
+ /* If W is horizontally combined and has a right sibling, don't
+ draw over any bottom divider. */
+ if (WINDOW_BOTTOM_DIVIDER_WIDTH (w)
+ && !NILP (w->parent)
+ && WINDOW_HORIZONTAL_COMBINATION_P (XWINDOW (w->parent))
+ && !NILP (w->next))
+ y1 -= WINDOW_BOTTOM_DIVIDER_WIDTH (w);
FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
}
@@ -31213,8 +31299,22 @@ x_draw_bottom_divider (struct window *w)
int x1 = WINDOW_RIGHT_EDGE_X (w);
int y0 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w);
int y1 = WINDOW_BOTTOM_EDGE_Y (w);
+ struct window *p = !NILP (w->parent) ? XWINDOW (w->parent) : false;
- FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
+ /* If W is vertically combined and has a sibling below, don't draw
+ over any right divider. */
+ if (WINDOW_RIGHT_DIVIDER_WIDTH (w)
+ && p
+ && ((WINDOW_VERTICAL_COMBINATION_P (p)
+ && !NILP (w->next))
+ || (WINDOW_HORIZONTAL_COMBINATION_P (p)
+ && NILP (w->next)
+ && !NILP (p->parent)
+ && WINDOW_VERTICAL_COMBINATION_P (XWINDOW (p->parent))
+ && !NILP (XWINDOW (p->parent)->next))))
+ x1 -= WINDOW_RIGHT_DIVIDER_WIDTH (w);
+
+ FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
}
}
@@ -31329,7 +31429,7 @@ expose_window (struct window *w, XRectangle *fr)
}
/* Display the mode line if there is one. */
- if (WINDOW_WANTS_MODELINE_P (w)
+ if (window_wants_mode_line (w)
&& (row = MATRIX_MODE_LINE_ROW (w->current_matrix),
row->enabled_p)
&& row->y < r_bottom)
diff --git a/src/xfaces.c b/src/xfaces.c
index 4714b7b..86bb9b0 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. */)
int red, green, blue;
int num;
- while (fgets (buf, sizeof (buf), fp) != NULL) {
+ while (fgets_unlocked (buf, sizeof (buf), fp) != NULL) {
if (sscanf (buf, "%d %d %d %n", &red, &green, &blue, &num) == 3)
{
#ifdef HAVE_NTGUI
diff --git a/src/xfns.c b/src/xfns.c
index 7be2253..d8bf974 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1120,6 +1120,14 @@ enum mouse_cursor {
mouse_cursor_hand,
mouse_cursor_horizontal_drag,
mouse_cursor_vertical_drag,
+ mouse_cursor_left_edge,
+ mouse_cursor_top_left_corner,
+ mouse_cursor_top_edge,
+ mouse_cursor_top_right_corner,
+ mouse_cursor_right_edge,
+ mouse_cursor_bottom_right_corner,
+ mouse_cursor_bottom_edge,
+ mouse_cursor_bottom_left_corner,
mouse_cursor_max
};
@@ -1139,13 +1147,21 @@ struct mouse_cursor_types {
/* This array must stay in sync with enum mouse_cursor above! */
static const struct mouse_cursor_types mouse_cursor_types[] = {
- { "text", &Vx_pointer_shape, XC_xterm },
- { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr },
- { "hourglass", &Vx_hourglass_pointer_shape, XC_watch },
- { "modeline", &Vx_mode_pointer_shape, XC_xterm },
- { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 },
- { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow },
- { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow },
+ { "text", &Vx_pointer_shape, XC_xterm
},
+ { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr
},
+ { "hourglass", &Vx_hourglass_pointer_shape, XC_watch
},
+ { "modeline", &Vx_mode_pointer_shape, XC_xterm
},
+ { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2
},
+ { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow
},
+ { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow
},
+ { NULL, &Vx_window_left_edge_shape, XC_left_side
},
+ { NULL, &Vx_window_top_left_corner_shape, XC_top_left_corner
},
+ { NULL, &Vx_window_top_edge_shape, XC_top_side
},
+ { NULL, &Vx_window_top_right_corner_shape, XC_top_right_corner
},
+ { NULL, &Vx_window_right_edge_shape, XC_right_side
},
+ { NULL, &Vx_window_bottom_right_corner_shape, XC_bottom_right_corner
},
+ { NULL, &Vx_window_bottom_edge_shape, XC_bottom_side
},
+ { NULL, &Vx_window_bottom_left_corner_shape, XC_bottom_left_corner
},
};
struct mouse_cursor_data {
@@ -1296,6 +1312,14 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
INSTALL_CURSOR (hand_cursor, hand);
INSTALL_CURSOR (horizontal_drag_cursor, horizontal_drag);
INSTALL_CURSOR (vertical_drag_cursor, vertical_drag);
+ INSTALL_CURSOR (left_edge_cursor, left_edge);
+ INSTALL_CURSOR (top_left_corner_cursor, top_left_corner);
+ INSTALL_CURSOR (top_edge_cursor, top_edge);
+ INSTALL_CURSOR (top_right_corner_cursor, top_right_corner);
+ INSTALL_CURSOR (right_edge_cursor, right_edge);
+ INSTALL_CURSOR (bottom_right_corner_cursor, bottom_right_corner);
+ INSTALL_CURSOR (bottom_edge_cursor, bottom_edge);
+ INSTALL_CURSOR (bottom_left_corner_cursor, bottom_left_corner);
#undef INSTALL_CURSOR
@@ -3814,6 +3838,8 @@ This function is an internal primitive--use `make-frame'
instead. */)
"leftFringe", "LeftFringe", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qright_fringe, Qnil,
"rightFringe", "RightFringe", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
"scrollBarForeground",
@@ -5286,7 +5312,7 @@ Frames are listed from topmost (first) to bottommost
(last). */)
static void
x_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
{
-#ifdef USE_GTK
+#if defined (USE_GTK) && GTK_CHECK_VERSION (2, 18, 0)
block_input ();
xg_frame_restack (f1, f2, above_flag);
unblock_input ();
@@ -6196,6 +6222,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
Lisp_Object parms)
"cursorColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
/* Init faces before x_default_parameter is called for the
scroll-bar-width parameter because otherwise we end up in
@@ -7486,6 +7514,7 @@ frame_parm_handler x_frame_parm_handlers[] =
x_set_no_accept_focus,
x_set_z_group,
x_set_override_redirect,
+ x_set_no_special_glyphs,
};
void
@@ -7564,6 +7593,62 @@ This variable takes effect when you create a new frame
or when you set the mouse color. */);
Vx_window_vertical_drag_shape = Qnil;
+ DEFVAR_LISP ("x-window-left-edge-cursor",
+ Vx_window_left_edge_shape,
+ doc: /* Pointer shape indicating a left x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_left_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-top-left-corner-cursor",
+ Vx_window_top_left_corner_shape,
+ doc: /* Pointer shape indicating a top left x-window corner can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_top_left_corner_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-top-edge-cursor",
+ Vx_window_top_edge_shape,
+ doc: /* Pointer shape indicating a top x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_top_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-top-right-corner-cursor",
+ Vx_window_top_right_corner_shape,
+ doc: /* Pointer shape indicating a top right x-window corner can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_top_right_corner_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-right-edge-cursor",
+ Vx_window_right_edge_shape,
+ doc: /* Pointer shape indicating a right x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_right_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-bottom-right-corner-cursor",
+ Vx_window_bottom_right_corner_shape,
+ doc: /* Pointer shape indicating a bottom right x-window corner can be
dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_bottom_right_corner_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-bottom-edge-cursor",
+ Vx_window_bottom_edge_shape,
+ doc: /* Pointer shape indicating a bottom x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_bottom_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-bottom-left-corner-cursor",
+ Vx_window_bottom_left_corner_shape,
+ doc: /* Pointer shape indicating a bottom left x-window corner can be
dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_bottom_left_corner_shape = Qnil;
+
DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
doc: /* A string indicating the foreground color of the cursor box. */);
Vx_cursor_fore_pixel = Qnil;
diff --git a/src/xterm.c b/src/xterm.c
index c8836b7..a214cd8 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -11757,6 +11757,22 @@ x_free_frame_resources (struct frame *f)
XFreeCursor (FRAME_X_DISPLAY (f),
f->output_data.x->horizontal_drag_cursor);
if (f->output_data.x->vertical_drag_cursor != 0)
XFreeCursor (FRAME_X_DISPLAY (f),
f->output_data.x->vertical_drag_cursor);
+ if (f->output_data.x->left_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->left_edge_cursor);
+ if (f->output_data.x->top_left_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f),
f->output_data.x->top_left_corner_cursor);
+ if (f->output_data.x->top_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_edge_cursor);
+ if (f->output_data.x->top_right_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f),
f->output_data.x->top_right_corner_cursor);
+ if (f->output_data.x->right_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->right_edge_cursor);
+ if (f->output_data.x->bottom_right_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f),
f->output_data.x->bottom_right_corner_cursor);
+ if (f->output_data.x->bottom_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_edge_cursor);
+ if (f->output_data.x->bottom_left_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f),
f->output_data.x->bottom_left_corner_cursor);
XFlush (FRAME_X_DISPLAY (f));
}
diff --git a/src/xterm.h b/src/xterm.h
index a752570..803feda 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -637,6 +637,14 @@ struct x_output
Cursor horizontal_drag_cursor;
Cursor vertical_drag_cursor;
Cursor current_cursor;
+ Cursor left_edge_cursor;
+ Cursor top_left_corner_cursor;
+ Cursor top_edge_cursor;
+ Cursor top_right_corner_cursor;
+ Cursor right_edge_cursor;
+ Cursor bottom_right_corner_cursor;
+ Cursor bottom_edge_cursor;
+ Cursor bottom_left_corner_cursor;
/* Window whose cursor is hourglass_cursor. This window is temporarily
mapped to display an hourglass cursor. */
diff --git a/test/Makefile.in b/test/Makefile.in
index 414eca9..11373db 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -147,7 +147,8 @@ endif
%.log: %.elc
$(AM_V_at)${MKDIR_P} $(dir $@)
$(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \
- --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})"
${WRITE_LOG}
+ --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" \
+ $(if $(and ${NIX_STORE}, $(findstring tramp, $(testloadfile))), ,
${WRITE_LOG})
ifeq (@HAVE_MODULES@, yes)
maybe_exclude_module_tests :=
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 78a3765..6f63d30 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -593,5 +593,121 @@ baz\"\""
:bindings '((electric-quote-string . t))
:test-in-comments nil :test-in-strings nil)
+(define-electric-pair-test electric-quote-opening-single
+ "" "`" :expected-string "‘" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-closing-single
+ "" "'" :expected-string "’" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-opening-double
+ "‘" "-`" :expected-string "“" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-closing-double
+ "’" "-'" :expected-string "”" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-backtick
+ "" "`" :expected-string "`" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bob-single
+ "" "'" :expected-string "‘" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bob-double
+ "‘" "-'" :expected-string "“" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bol-single
+ "a\n" "--'" :expected-string "a\n‘" :expected-point 4
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bol-double
+ "a\n‘" "---'" :expected-string "a\n“" :expected-point 4
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-space-single
+ " " "-'" :expected-string " ‘" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-space-double
+ " ‘" "--'" :expected-string " “" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-letter-single
+ "a" "-'" :expected-string "a’" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-letter-double
+ "a’" "--'" :expected-string "a”" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-paren-single
+ "(" "-'" :expected-string "(‘" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-paren-double
+ "(‘" "--'" :expected-string "(“" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-markdown-in-text
+ "" "'" :expected-string "’" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-code-faces font-lock-constant-face))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-markdown-in-code
+ #("`a`" 1 2 (face font-lock-constant-face)) "-'"
+ :expected-string "`'a`" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-code-faces font-lock-constant-face))
+ :test-in-comments nil :test-in-strings nil)
+
(provide 'electric-tests)
;;; 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 dfbe18d..6448a1b 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -34,7 +34,7 @@
(let ((print-circle t))
(should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
"((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))")))
- (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'"
+ (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'"
(cl-prin1-to-string (symbol-function #'caar))))))
(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 fc5790c..317838b 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."
(test (make-ert-test :body test-body))
(result (ert-run-test test)))
(should (ert-test-failed-p result))
- (with-temp-buffer
- (ert--print-backtrace (ert-test-failed-backtrace result))
- (goto-char (point-min))
- (end-of-line)
- (let ((first-line (buffer-substring-no-properties (point-min) (point))))
- (should (equal first-line (format " %S()" test-body)))))))
+ (should (eq (nth 1 (car (ert-test-failed-backtrace result)))
+ 'signal))))
(ert-deftest ert-test-messages ()
:tags '(:causes-redisplay)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index a90e3ff..85990a8 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -53,6 +53,8 @@
(defvar tramp-copy-size-limit)
(defvar tramp-persistency-file-name)
(defvar tramp-remote-process-environment)
+;; Suppress nasty messages.
+(fset 'shell-command-sentinel 'ignore)
;; There is no default value on w32 systems, which could work out of the box.
(defconst tramp-test-temporary-file-directory
@@ -70,6 +72,10 @@
(add-to-list
'tramp-default-host-alist
`("\\`mock\\'" nil ,(system-name)))
+ ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
+ ;; batch mode only, therefore.
+ (unless (and (null noninteractive) (file-directory-p "~/"))
+ (setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
@@ -126,29 +132,52 @@ If QUOTED is non-nil, the local part of the file is
quoted."
(make-temp-name "tramp-test")
(if local temporary-file-directory tramp-test-temporary-file-directory))))
+;; Don't print messages in nested `tramp--instrument-test-case' calls.
+(defvar tramp--instrument-test-case-p nil
+ "Whether `tramp--instrument-test-case' run.
+This shall used dynamically bound only.")
+
(defmacro tramp--instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
Print the the content of the Tramp debug buffer, if BODY does not
eval properly in `should' or `should-not'. `should-error' is not
handled properly. BODY shall not contain a timeout."
(declare (indent 1) (debug (natnump body)))
- `(let ((tramp-verbose ,verbose)
+ `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
+ (tramp-message-show-message t)
(tramp-debug-on-error t)
(debug-ignored-errors
- (cons "^make-symbolic-link not supported$" debug-ignored-errors)))
+ (cons "^make-symbolic-link not supported$" debug-ignored-errors))
+ inhibit-message)
(unwind-protect
- (progn ,@body)
- (when (> tramp-verbose 3)
+ (let ((tramp--instrument-test-case-p t)) ,@body)
+ ;; Unwind forms.
+ (when (and (null tramp--instrument-test-case-p) (> tramp-verbose 3))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(with-current-buffer (tramp-get-connection-buffer v)
(message "%s" (buffer-string)))
(with-current-buffer (tramp-get-debug-buffer v)
(message "%s" (buffer-string))))))))
+(defsubst tramp--test-message (fmt-string &rest arguments)
+ "Emit a message into ERT *Messages*."
+ (tramp--instrument-test-case 0
+ (apply
+ 'tramp-message
+ (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
+ fmt-string arguments)))
+
+(defsubst tramp--test-backtrace ()
+ "Dump a backtrace into ERT *Messages*."
+ (tramp--instrument-test-case 10
+ (tramp-backtrace
+ (tramp-dissect-file-name tramp-test-temporary-file-directory))))
+
(ert-deftest tramp-test00-availability ()
"Test availability of Tramp functions."
:expected-result (if (tramp--test-enabled) :passed :failed)
- (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
+ (tramp--test-message
+ "Remote directory: `%s'" tramp-test-temporary-file-directory)
(should (ignore-errors
(and
(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'."
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(default-directory tramp-test-temporary-file-directory)
+ ;; Suppress nasty messages.
+ (inhibit-message t)
kill-buffer-query-functions)
(unwind-protect
(with-temp-buffer
@@ -2787,7 +2818,6 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(async-shell-command
(format "ls %s" (file-name-nondirectory tmp-name))
(current-buffer))
- (set-process-sentinel (get-buffer-process (current-buffer)) nil)
;; Read output.
(with-timeout (10 (ert-fail "`async-shell-command' timed out"))
(while (< (- (point-max) (point-min))
@@ -2816,7 +2846,6 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(async-shell-command "read line; ls $line" (current-buffer))
- (set-process-sentinel (get-buffer-process (current-buffer)) nil)
(process-send-string
(get-buffer-process (current-buffer))
(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'."
"Like `shell-command-to-string', but for asynchronous processes."
(with-temp-buffer
(async-shell-command command (current-buffer))
- ;; Suppress nasty messages.
- (set-process-sentinel (get-buffer-process (current-buffer)) nil)
(with-timeout (10)
(while (get-buffer-process (current-buffer))
(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'."
;; We must force a reconnect, in order to activate $BZR_HOME.
(tramp-cleanup-connection
(tramp-dissect-file-name tramp-test-temporary-file-directory)
- nil 'keep-password)
+ 'keep-debug 'keep-password)
'(Bzr))
- (t nil)))))
+ (t nil))))
+ ;; Suppress nasty messages.
+ (inhibit-message t))
(skip-unless vc-handled-backends)
- (message "%s" vc-handled-backends)
+ (unless quoted (tramp--test-message "%s" vc-handled-backends))
(unwind-protect
(progn
@@ -3656,90 +3685,134 @@ Use the `ls' command."
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
- ;; Mark as failed until bug has been fixed.
- :expected-result :failed
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
- (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
- ;; Keep instrumentation verbosity 0 until Tramp bug is fixed.
- ;; This has the side effect, that this test fails instead to
- ;; abort. Good for hydra.
- (tramp--instrument-test-case 0
- (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
- (default-directory tmp-name)
- (remote-file-name-inhibit-cache t)
- timer buffers kill-buffer-query-functions)
+ ;; This test times out on hydra.
+ (with-timeout
+ (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out"))
+ (let* ((tmp-name (tramp--test-make-temp-name))
+ (default-directory tmp-name)
+ ;; Do not cache Tramp properties.
+ (remote-file-name-inhibit-cache t)
+ (process-file-side-effects t)
+ ;; Suppress nasty messages.
+ (inhibit-message t)
+ (number-proc 10)
+ ;; On hydra, timings are bad.
+ (timer-repeat
+ (cond
+ ((getenv "NIX_STORE") 10
+ (t 1))))
+ ;; We must distinguish due to performance reasons.
+ (timer-operation
+ (cond
+ ((string-equal "mock" (file-remote-p tmp-name 'method))
+ 'vc-registered)
+ (t 'file-attributes)))
+ timer buffers kill-buffer-query-functions)
- (unwind-protect
- (progn
- (make-directory tmp-name)
-
- ;; Setup a timer in order to raise an ordinary command
- ;; again and again. `vc-registered' is well suited,
- ;; because there are many checks.
- (setq
- timer
- (run-at-time
- 0 1
- (lambda ()
- (when buffers
- (vc-registered
- (buffer-name (nth (random (length buffers)) buffers)))))))
-
- ;; Create temporary buffers. The number of buffers
- ;; corresponds to the number of processes; it could be
- ;; increased in order to make pressure on Tramp.
- (dotimes (_i 5)
- (add-to-list 'buffers (generate-new-buffer "*temp*")))
-
- ;; Open asynchronous processes. Set process sentinel.
- (dolist (buf buffers)
- (async-shell-command "read line; touch $line; echo $line" buf)
+ (unwind-protect
+ (progn
+ (make-directory tmp-name)
+
+ ;; Setup a timer in order to raise an ordinary command again
+ ;; and again. `vc-registered' is well suited, because there
+ ;; are many checks.
+ (setq
+ timer
+ (run-at-time
+ 0 timer-repeat
+ (lambda ()
+ (when buffers
+ (let ((default-directory tmp-name)
+ (file
+ (buffer-name (nth (random (length buffers)) buffers))))
+ (tramp--test-message
+ "Start timer %s %s %s"
+ timer-operation file (current-time-string))
+ (funcall timer-operation file)
+ (tramp--test-message
+ "Stop timer %s %s %s"
+ timer-operation file (current-time-string)))))))
+
+ ;; Create temporary buffers. The number of buffers
+ ;; corresponds to the number of processes; it could be
+ ;; increased in order to make pressure on Tramp.
+ (dotimes (_i number-proc)
+ (add-to-list 'buffers (generate-new-buffer "foo")))
+
+ ;; Open asynchronous processes. Set process sentinel.
+ (dolist (buf buffers)
+ (tramp--test-message "Start process %s" buf)
+ (let ((proc
+ (start-file-process-shell-command
+ (buffer-name buf) buf
+ (concat
+ "(read line && echo $line >$line);"
+ "(read line && cat $line);"
+ "(read line && rm $line)")))
+ (file (expand-file-name (buffer-name buf))))
+ ;; Remember the file name. Add counter.
+ (process-put proc 'foo file)
+ (process-put proc 'bar 0)
+ ;; Add process filter.
+ (set-process-filter
+ proc
+ (lambda (proc string)
+ (tramp--test-message "Process filter %s" proc)
+ (with-current-buffer (process-buffer proc)
+ (insert string))
+ (unless (zerop (length string))
+ (should (file-attributes (process-get proc 'foo))))))
+ ;; Add process sentinel.
(set-process-sentinel
- (get-buffer-process buf)
+ proc
(lambda (proc _state)
- (delete-file (buffer-name (process-buffer proc))))))
-
- ;; Send a string. Use a random order of the buffers. Mix
- ;; with regular operation.
- (let ((buffers (copy-sequence buffers))
- buf)
- (while buffers
- (setq buf (nth (random (length buffers)) buffers))
- (process-send-string
- (get-buffer-process buf) (format "'%s'\n" buf))
- (file-attributes (buffer-name buf))
- (setq buffers (delq buf buffers))))
-
- ;; Wait until the whole output has been read.
- (with-timeout ((* 10 (length buffers))
- (ert-fail "`async-shell-command' timed out"))
- (let ((buffers (copy-sequence buffers))
- buf)
- (while buffers
- (setq buf (nth (random (length buffers)) buffers))
- (if (ignore-errors
- (memq (process-status (get-buffer-process buf))
- '(run open)))
- (accept-process-output (get-buffer-process buf) 0.1)
- (setq buffers (delq buf buffers))))))
-
- ;; Check.
- (dolist (buf buffers)
- (with-current-buffer buf
- (should
- (string-equal (format "'%s'\n" buf) (buffer-string)))))
- (should-not
- (directory-files
- tmp-name nil directory-files-no-dot-files-regexp)))
-
- ;; Cleanup.
- (ignore-errors (cancel-timer timer))
- (ignore-errors (delete-directory tmp-name 'recursive))
- (dolist (buf buffers)
- (ignore-errors (kill-buffer buf))))))))
+ (tramp--test-message "Process sentinel %s" proc)
+ (should-not (file-attributes (process-get proc 'foo)))))))
+
+ ;; Send a string. Use a random order of the buffers. Mix
+ ;; with regular operation.
+ (let ((buffers (copy-sequence buffers)))
+ (while buffers
+ (let* ((buf (nth (random (length buffers)) buffers))
+ (proc (get-buffer-process buf))
+ (file (process-get proc 'foo))
+ (count (process-get proc 'bar)))
+ ;; Regular operation.
+ (if (= count 0)
+ (should-not (file-attributes file))
+ (should (file-attributes file)))
+ ;; Send string to process.
+ (tramp--test-message "Send string %s" proc)
+ (process-send-string proc (format "%s\n" (buffer-name buf)))
+ (accept-process-output proc 0.1 nil 0)
+ ;; Regular operation.
+ (if (= count 2)
+ (should-not (file-attributes file))
+ (should (file-attributes file)))
+ (process-put proc 'bar (1+ count))
+ (unless (process-live-p proc)
+ (tramp--test-message "Buffer delete %s" buf)
+ (setq buffers (delq buf buffers))))))
+
+ ;; Checks. All process output shall exists in the
+ ;; respective buffers. All created files shall be deleted.
+ (tramp--test-message "Checks %s" buffers)
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (should (string-equal (format "%s\n" buf) (buffer-string)))))
+ (should-not
+ (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
+
+ ;; Cleanup.
+ (dolist (buf buffers)
+ (ignore-errors (delete-process (get-buffer-process buf)))
+ (ignore-errors (kill-buffer buf)))
+ (ignore-errors (cancel-timer timer))
+ (ignore-errors (delete-directory tmp-name 'recursive))))))
(ert-deftest tramp-test37-recursive-load ()
"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."
;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
;; * Fix Bug#27009. Set expected error of
;; `tramp-test29-environment-variables-and-port-numbers'.
-;; * Fix Bug#16928. Set expected error of
`tramp-test36-asynchronous-requests'.
-;; * Fix `tramp-test38-unload' (Not all symbols are unbound). Set
+;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'.
+;; * Fix `tramp-test39-unload' (Not all symbols are unbound). Set
;; expected error.
(defun tramp-test-all (&optional interactive)