diff options
| author | Bastien | 2017-07-03 09:06:29 +0200 |
|---|---|---|
| committer | Bastien | 2017-07-03 09:06:29 +0200 |
| commit | 5ca1888fe670aee7febd4d42665d7372ab2ffebc (patch) | |
| tree | 1f7f8d8a7580e556fc83cf3a6aaeec567b33a090 | |
| parent | 20e006ffee41062f1b551a92c24d9edc53cd0f56 (diff) | |
| parent | 1b4f0a92ff3505ef9a465b9b391756e3a73a6443 (diff) | |
| download | emacs-5ca1888fe670aee7febd4d42665d7372ab2ffebc.tar.gz emacs-5ca1888fe670aee7febd4d42665d7372ab2ffebc.zip | |
Merge branch 'master' into scratch/org-mode-merge
113 files changed, 4945 insertions, 2040 deletions
diff --git a/admin/merge-gnulib b/admin/merge-gnulib index d4bbf17cb3d..85921ba1ba6 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib | |||
| @@ -40,7 +40,7 @@ GNULIB_MODULES=' | |||
| 40 | sig2str socklen stat-time std-gnu11 stdalign stddef stdio | 40 | sig2str socklen stat-time std-gnu11 stdalign stddef stdio |
| 41 | stpcpy strftime strtoimax symlink sys_stat | 41 | stpcpy strftime strtoimax symlink sys_stat |
| 42 | sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub | 42 | sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub |
| 43 | update-copyright utimens | 43 | update-copyright unlocked-io utimens |
| 44 | vla warnings | 44 | vla warnings |
| 45 | ' | 45 | ' |
| 46 | 46 | ||
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index e1e896ce29c..478099c831a 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el | |||
| @@ -1346,50 +1346,56 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." | |||
| 1346 | (generator (unidata-prop-generator proplist)) | 1346 | (generator (unidata-prop-generator proplist)) |
| 1347 | (default-value (unidata-prop-default proplist)) | 1347 | (default-value (unidata-prop-default proplist)) |
| 1348 | (val-list (unidata-prop-val-list proplist)) | 1348 | (val-list (unidata-prop-val-list proplist)) |
| 1349 | (table (progn | 1349 | (check #x400) |
| 1350 | (message "Generating %S table..." prop) | 1350 | table decoder alist) |
| 1351 | (funcall generator prop index default-value val-list))) | 1351 | ;; We compare values in unidata.txt with the ones returned by various |
| 1352 | (decoder (char-table-extra-slot table 1)) | 1352 | ;; generator functions. However, SpecialCasing.txt is read directly by |
| 1353 | (alist (and (functionp index) | 1353 | ;; unidata-gen-table-special-casing--do-load and there is no other file |
| 1354 | (funcall index))) | 1354 | ;; to compare those values with. This is why we’re skipping the check |
| 1355 | (check #x400)) | 1355 | ;; for special casing properties. |
| 1356 | (dolist (e unidata-list) | 1356 | (unless (eq generator 'unidata-gen-table-special-casing) |
| 1357 | (let* ((char (car e)) | 1357 | (setq table (progn |
| 1358 | (val1 | 1358 | (message "Generating %S table..." prop) |
| 1359 | (if alist (nth 1 (assoc char alist)) | 1359 | (funcall generator prop index default-value val-list)) |
| 1360 | (nth index e))) | 1360 | decoder (char-table-extra-slot table 1)) |
| 1361 | val2) | 1361 | (unless (integerp decoder) |
| 1362 | (if (and (stringp val1) (= (length val1) 0)) | 1362 | (setq alist (and (functionp index) (funcall index))) |
| 1363 | (setq val1 nil)) | 1363 | (dolist (e unidata-list) |
| 1364 | (unless (or (consp char) | 1364 | (let ((char (car e)) val1 val2) |
| 1365 | (integerp decoder)) | 1365 | (unless (consp char) |
| 1366 | (setq val2 | 1366 | (setq val1 (if alist |
| 1367 | (cond ((functionp decoder) | 1367 | (nth 1 (assoc char alist)) |
| 1368 | (funcall decoder char (aref table char) table)) | 1368 | (nth index e))) |
| 1369 | (t ; must be nil | 1369 | (and (stringp val1) |
| 1370 | (aref table char)))) | 1370 | (= (length val1) 0) |
| 1371 | (if val1 | 1371 | (setq val1 nil)) |
| 1372 | (cond ((eq generator 'unidata-gen-table-symbol) | 1372 | (if val1 |
| 1373 | (setq val1 (intern val1))) | 1373 | (cond ((eq generator 'unidata-gen-table-symbol) |
| 1374 | ((eq generator 'unidata-gen-table-integer) | 1374 | (setq val1 (intern val1))) |
| 1375 | (setq val1 (string-to-number val1))) | 1375 | ((eq generator 'unidata-gen-table-integer) |
| 1376 | ((eq generator 'unidata-gen-table-character) | 1376 | (setq val1 (string-to-number val1))) |
| 1377 | (setq val1 (string-to-number val1 16))) | 1377 | ((eq generator 'unidata-gen-table-character) |
| 1378 | ((eq generator 'unidata-gen-table-decomposition) | 1378 | (setq val1 (string-to-number val1 16))) |
| 1379 | (setq val1 (unidata-split-decomposition val1)))) | 1379 | ((eq generator 'unidata-gen-table-decomposition) |
| 1380 | (cond ((eq prop 'decomposition) | 1380 | (setq val1 (unidata-split-decomposition val1)))) |
| 1381 | (setq val1 (list char))) | 1381 | (cond ((eq prop 'decomposition) |
| 1382 | ((eq prop 'bracket-type) | 1382 | (setq val1 (list char))) |
| 1383 | (setq val1 'n)))) | 1383 | ((eq prop 'bracket-type) |
| 1384 | (when (>= char check) | 1384 | (setq val1 'n)))) |
| 1385 | (message "%S %04X" prop check) | 1385 | (setq val2 (aref table char)) |
| 1386 | (setq check (+ check #x400))) | 1386 | (when decoder |
| 1387 | (or (equal val1 val2) | 1387 | (setq val2 (funcall decoder char val2 table))) |
| 1388 | ;; <control> characters get a 'name' property of nil | 1388 | (when (>= char check) |
| 1389 | (and (eq prop 'name) (string= val1 "<control>") (null val2)) | 1389 | (message "%S %04X" prop check) |
| 1390 | (insert (format "> %04X %S\n< %04X %S\n" | 1390 | (setq check (+ check #x400))) |
| 1391 | char val1 char val2))) | 1391 | (or (equal val1 val2) |
| 1392 | (sit-for 0)))))))) | 1392 | ;; <control> characters get a 'name' property of nil |
| 1393 | (and (eq prop 'name) | ||
| 1394 | (string= val1 "<control>") | ||
| 1395 | (null val2)) | ||
| 1396 | (insert (format "> %04X %S\n< %04X %S\n" | ||
| 1397 | char val1 char val2))) | ||
| 1398 | (sit-for 0)))))))))) | ||
| 1393 | 1399 | ||
| 1394 | ;; The entry functions. They generate files described in the header | 1400 | ;; The entry functions. They generate files described in the header |
| 1395 | ;; comment of this file. | 1401 | ;; comment of this file. |
diff --git a/configure.ac b/configure.ac index 65c5f9268ad..ef61107b025 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -4240,7 +4240,7 @@ AC_CHECK_HEADERS(valgrind/valgrind.h) | |||
| 4240 | 4240 | ||
| 4241 | AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]]) | 4241 | AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]]) |
| 4242 | 4242 | ||
| 4243 | AC_CHECK_FUNCS_ONCE([getc_unlocked sbrk]) | 4243 | AC_CHECK_FUNCS_ONCE([sbrk]) |
| 4244 | 4244 | ||
| 4245 | ok_so_far=yes | 4245 | ok_so_far=yes |
| 4246 | AC_CHECK_FUNC(socket, , ok_so_far=no) | 4246 | AC_CHECK_FUNC(socket, , ok_so_far=no) |
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 22b0fcd4676..28cb51d88bb 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi | |||
| @@ -875,27 +875,33 @@ treat it specially. | |||
| 875 | 875 | ||
| 876 | @item | 876 | @item |
| 877 | Otherwise, if the command string contains @samp{?} surrounded by | 877 | Otherwise, if the command string contains @samp{?} surrounded by |
| 878 | whitespace, Emacs runs the shell command once @emph{for each file}, | 878 | whitespace or @samp{`?`}, Emacs runs the shell command once |
| 879 | substituting the current file name for @samp{?} each time. You can | 879 | @emph{for each file}, substituting the current file name for @samp{?} |
| 880 | use @samp{?} more than once in the command; the same file name | 880 | and @samp{`?`} each time. You can use both @samp{?} or @samp{`?`} more |
| 881 | replaces each occurrence. | 881 | than once in the command; the same file name replaces each occurrence. |
| 882 | If you mix them with @samp{*} the command signals an error. | ||
| 882 | 883 | ||
| 883 | @item | 884 | @item |
| 884 | If the command string contains neither @samp{*} nor @samp{?}, Emacs | 885 | If the command string contains neither @samp{*} nor @samp{?} nor @samp{`?`}, |
| 885 | runs the shell command once for each file, adding the file name at the | 886 | Emacs runs the shell command once for each file, adding the file name at the |
| 886 | end. For example, @kbd{! uudecode @key{RET}} runs @code{uudecode} on | 887 | end. For example, @kbd{! uudecode @key{RET}} runs @code{uudecode} on |
| 887 | each file. | 888 | each file. |
| 888 | @end itemize | 889 | @end itemize |
| 889 | 890 | ||
| 890 | To iterate over the file names in a more complicated fashion, use an | 891 | To iterate over the file names in a more complicated fashion, you might |
| 891 | explicit shell loop. For example, here is how to uuencode each file, | 892 | prefer to use an explicit shell loop. For example, here is how to uuencode |
| 892 | making the output file name by appending @samp{.uu} to the input file | 893 | each file, making the output file name by appending @samp{.uu} to the input |
| 893 | name: | 894 | file name: |
| 894 | 895 | ||
| 895 | @example | 896 | @example |
| 896 | for file in * ; do uuencode "$file" "$file" >"$file".uu; done | 897 | for file in * ; do uuencode "$file" "$file" >"$file".uu; done |
| 897 | @end example | 898 | @end example |
| 898 | 899 | ||
| 900 | The same example with @samp{`?`} notation: | ||
| 901 | @example | ||
| 902 | uuencode ? ? > `?`.uu | ||
| 903 | @end example | ||
| 904 | |||
| 899 | The @kbd{!} and @kbd{&} commands do not attempt to update the Dired | 905 | The @kbd{!} and @kbd{&} commands do not attempt to update the Dired |
| 900 | buffer to show new or modified files, because they don't know what | 906 | buffer to show new or modified files, because they don't know what |
| 901 | files will be changed. Use the @kbd{g} command to update the Dired | 907 | 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 548ca6a1b48..fd6df1c7e53 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi | |||
| @@ -203,9 +203,10 @@ string}, which describes exactly what the command does. | |||
| 203 | describes the command corresponding to @var{key}. | 203 | describes the command corresponding to @var{key}. |
| 204 | 204 | ||
| 205 | @kbd{C-h c}, @kbd{C-h k} and @kbd{C-h K} work for any sort of key | 205 | @kbd{C-h c}, @kbd{C-h k} and @kbd{C-h K} work for any sort of key |
| 206 | sequences, including function keys, menus, and mouse events. For | 206 | sequences, including function keys, menus, and mouse events (except |
| 207 | instance, after @kbd{C-h k} you can select a menu item from the menu | 207 | that @kbd{C-h c} ignores mouse movement events). For instance, after |
| 208 | bar, to view the documentation string of the command it runs. | 208 | @kbd{C-h k} you can select a menu item from the menu bar, to view the |
| 209 | documentation string of the command it runs. | ||
| 209 | 210 | ||
| 210 | @kindex C-h w | 211 | @kindex C-h w |
| 211 | @findex where-is | 212 | @findex where-is |
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 47de0531292..0b5efd04a18 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi | |||
| @@ -519,6 +519,10 @@ when exiting Emacs; if you wish to prevent Emacs from transferring | |||
| 519 | data to the clipboard manager, change the variable | 519 | data to the clipboard manager, change the variable |
| 520 | @code{x-select-enable-clipboard-manager} to @code{nil}. | 520 | @code{x-select-enable-clipboard-manager} to @code{nil}. |
| 521 | 521 | ||
| 522 | Since strings containing NUL bytes are usually truncated when passed | ||
| 523 | through the clipboard, Emacs replaces such characters with ``\0'' | ||
| 524 | before transfering them to the system's clipboard. | ||
| 525 | |||
| 522 | @vindex select-enable-primary | 526 | @vindex select-enable-primary |
| 523 | @findex clipboard-kill-region | 527 | @findex clipboard-kill-region |
| 524 | @findex clipboard-kill-ring-save | 528 | @findex clipboard-kill-ring-save |
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 13407f6f07b..8edf2640cfe 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi | |||
| @@ -1795,8 +1795,12 @@ of the first character you read precedes that of the next character. | |||
| 1795 | Reordering of bidirectional text into the @dfn{visual} order happens | 1795 | Reordering of bidirectional text into the @dfn{visual} order happens |
| 1796 | at display time. As result, character positions no longer increase | 1796 | at display time. As result, character positions no longer increase |
| 1797 | monotonically with their positions on display. Emacs implements the | 1797 | monotonically with their positions on display. Emacs implements the |
| 1798 | Unicode Bidirectional Algorithm described in the Unicode Standard | 1798 | Unicode Bidirectional Algorithm (UBA) described in the Unicode |
| 1799 | Annex #9, for reordering of bidirectional text for display. | 1799 | Standard Annex #9, for reordering of bidirectional text for display. |
| 1800 | It deviates from the UBA only in how continuation lines are displayed | ||
| 1801 | when text direction is opposite to the base paragraph direction, | ||
| 1802 | e.g. when a long line of English text appears in a right-to-left | ||
| 1803 | paragraph. | ||
| 1800 | 1804 | ||
| 1801 | @vindex bidi-display-reordering | 1805 | @vindex bidi-display-reordering |
| 1802 | The buffer-local variable @code{bidi-display-reordering} controls | 1806 | The buffer-local variable @code{bidi-display-reordering} controls |
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 4de55fd3fb2..2ebe872c362 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi | |||
| @@ -1974,6 +1974,71 @@ line, if present, in the return value. If it is @code{t}, include the | |||
| 1974 | height of both, if present, in the return value. | 1974 | height of both, if present, in the return value. |
| 1975 | @end defun | 1975 | @end defun |
| 1976 | 1976 | ||
| 1977 | @code{window-text-pixel-size} treats the text displayed in a window as a | ||
| 1978 | whole and does not care about the size of individual lines. The | ||
| 1979 | following function does. | ||
| 1980 | |||
| 1981 | @defun window-lines-pixel-dimensions &optional window first last body inverse | ||
| 1982 | This function calculates the pixel dimensions of each line displayed in | ||
| 1983 | the specified @var{window}. It does so by walking @var{window}'s | ||
| 1984 | current glyph matrix---a matrix storing the glyph (@pxref{Glyphs}) of | ||
| 1985 | each buffer character currently displayed in @var{window}. If | ||
| 1986 | successful, it returns a list of cons pairs representing the x- and | ||
| 1987 | y-coordinates of the lower right corner of the last character of each | ||
| 1988 | line. Coordinates are measured in pixels from an origin (0, 0) at the | ||
| 1989 | top-left corner of @var{window}. @var{window} must be a live window and | ||
| 1990 | defaults to the selected one. | ||
| 1991 | |||
| 1992 | If the optional argument @var{first} is an integer, it denotes the index | ||
| 1993 | (starting with 0) of the first line of @var{window}'s glyph matrix to be | ||
| 1994 | returned. Note that if @var{window} has a header line, the line with | ||
| 1995 | index 0 is that header line. If @var{first} is nil, the first line to | ||
| 1996 | be considered is determined by the value of the optional argument | ||
| 1997 | @var{body}: If @var{body} is non-@code{nil}, this means to start with | ||
| 1998 | the first line of @var{window}'s body, skipping any header line, if | ||
| 1999 | present. Otherwise, this function will start with the first line of | ||
| 2000 | @var{window}'s glyph matrix, possibly the header line. | ||
| 2001 | |||
| 2002 | If the optional argument @var{last} is an integer, it denotes the index | ||
| 2003 | of the last line of @var{window}'s glyph matrix that shall be returned. | ||
| 2004 | If @var{last} is nil, the last line to be considered is determined by | ||
| 2005 | the value of @var{body}: If @var{body} is non-@code{nil}, this means to | ||
| 2006 | use the last line of @var{window}'s body, omitting @var{window}'s mode | ||
| 2007 | line, if present. Otherwise, this means to use the last line of | ||
| 2008 | @var{window} which may be the mode line. | ||
| 2009 | |||
| 2010 | The optional argument @var{inverse}, if @code{nil}, means that the | ||
| 2011 | y-pixel value returned for any line specifies the distance in pixels | ||
| 2012 | from the left edge (body edge if @var{body} is non-@code{nil}) of | ||
| 2013 | @var{window} to the right edge of the last glyph of that line. | ||
| 2014 | @var{inverse} non-@code{nil} means that the y-pixel value returned for | ||
| 2015 | any line specifies the distance in pixels from the right edge of the | ||
| 2016 | last glyph of that line to the right edge (body edge if @var{body} is | ||
| 2017 | non-@code{nil}) of @var{window}. This is useful for determining the | ||
| 2018 | amount of slack space at the end of each line. | ||
| 2019 | |||
| 2020 | The optional argument @var{left}, if non-@code{nil} means to return the | ||
| 2021 | x- and y-coordinates of the lower left corner of the leftmost character | ||
| 2022 | on each line. This is the value that should be used for windows that | ||
| 2023 | mostly display text from right to left. | ||
| 2024 | |||
| 2025 | If @var{left} is non-@code{nil} and @var{inverse} is @code{nil}, this | ||
| 2026 | means that the y-pixel value returned for any line specifies the | ||
| 2027 | distance in pixels from the left edge of the last (leftmost) glyph of | ||
| 2028 | that line to the right edge (body edge if @var{body} is non-@code{nil}) | ||
| 2029 | of @var{window}. If @var{left} and @var{inverse} are both | ||
| 2030 | non-@code{nil}, the y-pixel value returned for any line specifies the | ||
| 2031 | distance in pixels from the left edge (body edge if @var{body} is | ||
| 2032 | non-@code{nil}) of @var{window} to the left edge of the last (leftmost) | ||
| 2033 | glyph of that line. | ||
| 2034 | |||
| 2035 | This function returns @code{nil} if the current glyph matrix of | ||
| 2036 | @var{window} is not up-to-date which usually happens when Emacs is busy, | ||
| 2037 | for example, when processing a command. The value should be retrievable | ||
| 2038 | though when this function is run from an idle timer with a delay of zero | ||
| 2039 | seconds. | ||
| 2040 | @end defun | ||
| 2041 | |||
| 1977 | @defun line-pixel-height | 2042 | @defun line-pixel-height |
| 1978 | This function returns the height in pixels of the line at point in the | 2043 | This function returns the height in pixels of the line at point in the |
| 1979 | selected window. The value includes the line spacing of the line | 2044 | 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}), | |||
| 7297 | which is described in Annex #9 of the Unicode standard | 7362 | which is described in Annex #9 of the Unicode standard |
| 7298 | (@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full | 7363 | (@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full |
| 7299 | Bidirectionality'' class implementation of the @acronym{UBA}, | 7364 | Bidirectionality'' class implementation of the @acronym{UBA}, |
| 7300 | consistent with the requirements of the Unicode Standard v8.0. | 7365 | consistent with the requirements of the Unicode Standard v9.0. Note, |
| 7366 | however, that the way Emacs displays continuation lines when text | ||
| 7367 | direction is opposite to the base paragraph direction deviates from | ||
| 7368 | the UBA, which requires to perform line wrapping before reordering | ||
| 7369 | text for display. | ||
| 7301 | 7370 | ||
| 7302 | @defvar bidi-display-reordering | 7371 | @defvar bidi-display-reordering |
| 7303 | If the value of this buffer-local variable is non-@code{nil} (the | 7372 | If the value of this buffer-local variable is non-@code{nil} (the |
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 7cc91a8f7e3..4bedea3bdd1 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi | |||
| @@ -1130,6 +1130,8 @@ Window Frame Parameters | |||
| 1130 | * Buffer Parameters:: Which buffers have been or should be shown. | 1130 | * Buffer Parameters:: Which buffers have been or should be shown. |
| 1131 | * Frame Interaction Parameters:: Parameters for interacting with other | 1131 | * Frame Interaction Parameters:: Parameters for interacting with other |
| 1132 | frames. | 1132 | frames. |
| 1133 | * Mouse Dragging Parameters:: Parameters for resizing and moving | ||
| 1134 | frames with the mouse. | ||
| 1133 | * Management Parameters:: Communicating with the window manager. | 1135 | * Management Parameters:: Communicating with the window manager. |
| 1134 | * Cursor Parameters:: Controlling the cursor appearance. | 1136 | * Cursor Parameters:: Controlling the cursor appearance. |
| 1135 | * Font and Color Parameters:: Fonts and colors for the frame text. | 1137 | * Font and Color Parameters:: Fonts and colors for the frame text. |
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 50467d1dfd5..b430f7c6fad 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi | |||
| @@ -974,14 +974,7 @@ Parameters}). The text size of the initial frame can be also set with | |||
| 974 | the help of an X-style geometry specification. @xref{Emacs Invocation,, | 974 | the help of an X-style geometry specification. @xref{Emacs Invocation,, |
| 975 | Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs | 975 | Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs |
| 976 | Manual}. Below we list some functions to access and set the size of an | 976 | Manual}. Below we list some functions to access and set the size of an |
| 977 | existing, visible frame. | 977 | existing, visible frame, by default the selected one. |
| 978 | |||
| 979 | @defun frame-text-height &optional frame | ||
| 980 | @defunx frame-text-width &optional frame | ||
| 981 | These functions return the height and width of the text area of | ||
| 982 | @var{frame} (@pxref{Frame Layout}), measured in pixels. For a text | ||
| 983 | terminal, the results are in characters rather than pixels. | ||
| 984 | @end defun | ||
| 985 | 978 | ||
| 986 | @defun frame-height &optional frame | 979 | @defun frame-height &optional frame |
| 987 | @defunx frame-width &optional frame | 980 | @defunx frame-width &optional frame |
| @@ -997,11 +990,33 @@ rounded down to the number of characters of the default font that fully | |||
| 997 | fit into the text area. | 990 | fit into the text area. |
| 998 | @end defun | 991 | @end defun |
| 999 | 992 | ||
| 1000 | @defun frame-pixel-height &optional frame | 993 | The functions following next return the pixel widths and heights of the |
| 1001 | @defunx frame-pixel-width &optional frame | 994 | native, outer and inner frame and the text area (@pxref{Frame Layout}) |
| 1002 | These functions return the native width and height, see @ref{Frame | 995 | of a given frame. For a text terminal, the results are in characters |
| 1003 | Layout}) of @var{frame} in pixels. For a text terminal, the results are | 996 | rather than pixels. |
| 1004 | in characters rather than pixels. | 997 | |
| 998 | @defun frame-outer-width &optional frame | ||
| 999 | @defunx frame-outer-height &optional frame | ||
| 1000 | These functions return the outer width and height of @var{frame} in | ||
| 1001 | pixels. | ||
| 1002 | @end defun | ||
| 1003 | |||
| 1004 | @defun frame-native-height &optional frame | ||
| 1005 | @defunx frame-native-width &optional frame | ||
| 1006 | These functions return the native width and height of @var{frame} in | ||
| 1007 | pixels. | ||
| 1008 | @end defun | ||
| 1009 | |||
| 1010 | @defun frame-inner-width &optional frame | ||
| 1011 | @defunx frame-inner-height &optional frame | ||
| 1012 | These functions return the inner width and height of @var{frame} in | ||
| 1013 | pixels. | ||
| 1014 | @end defun | ||
| 1015 | |||
| 1016 | @defun frame-text-width &optional frame | ||
| 1017 | @defunx frame-text-height &optional frame | ||
| 1018 | These functions return the width and height of the text area of | ||
| 1019 | @var{frame} in pixels. | ||
| 1005 | @end defun | 1020 | @end defun |
| 1006 | 1021 | ||
| 1007 | On window systems that support it, Emacs tries by default to make the | 1022 | On window systems that support it, Emacs tries by default to make the |
| @@ -1345,6 +1360,8 @@ text terminals. | |||
| 1345 | * Buffer Parameters:: Which buffers have been or should be shown. | 1360 | * Buffer Parameters:: Which buffers have been or should be shown. |
| 1346 | * Frame Interaction Parameters:: Parameters for interacting with other | 1361 | * Frame Interaction Parameters:: Parameters for interacting with other |
| 1347 | frames. | 1362 | frames. |
| 1363 | * Mouse Dragging Parameters:: Parameters for resizing and moving | ||
| 1364 | frames with the mouse. | ||
| 1348 | * Management Parameters:: Communicating with the window manager. | 1365 | * Management Parameters:: Communicating with the window manager. |
| 1349 | * Cursor Parameters:: Controlling the cursor appearance. | 1366 | * Cursor Parameters:: Controlling the cursor appearance. |
| 1350 | * Font and Color Parameters:: Fonts and colors for the frame text. | 1367 | * Font and Color Parameters:: Fonts and colors for the frame text. |
| @@ -1404,18 +1421,19 @@ named, this parameter will be @code{nil}. | |||
| 1404 | @cindex frame position | 1421 | @cindex frame position |
| 1405 | 1422 | ||
| 1406 | Parameters describing the X- and Y-offsets of a frame are always | 1423 | Parameters describing the X- and Y-offsets of a frame are always |
| 1407 | measured in pixels. For normal, non-child frames they specify the | 1424 | measured in pixels. For a normal, non-child frame they specify the |
| 1408 | frame's absolute outer position (@pxref{Frame Geometry}) with respect to | 1425 | frame's outer position (@pxref{Frame Geometry}) relative to its |
| 1409 | its display's origin. For a child frame (@pxref{Child Frames}) they | 1426 | display's origin. For a child frame (@pxref{Child Frames}) they specify |
| 1410 | specify the frame's outer position relative to the native position of | 1427 | the frame's outer position relative to the native position of the |
| 1411 | the frame's parent frame. (Note that none of these parameters is | 1428 | frame's parent frame. (Note that none of these parameters is meaningful |
| 1412 | meaningful on TTY frames.) | 1429 | on TTY frames.) |
| 1413 | 1430 | ||
| 1414 | @table @code | 1431 | @table @code |
| 1415 | @vindex left, a frame parameter | 1432 | @vindex left, a frame parameter |
| 1416 | @item left | 1433 | @item left |
| 1417 | The position, in pixels, of the left outer edge of the frame with | 1434 | The position, in pixels, of the left outer edge of the frame with |
| 1418 | respect to the left edge of the frame's display or parent frame. | 1435 | respect to the left edge of the frame's display or parent frame. It can |
| 1436 | be specified in one of the following ways. | ||
| 1419 | 1437 | ||
| 1420 | @table @asis | 1438 | @table @asis |
| 1421 | @item an integer | 1439 | @item an integer |
| @@ -1436,6 +1454,30 @@ right edge of the display or parent frame. The integer @var{pos} may be | |||
| 1436 | positive or negative; a negative value specifies a position outside the | 1454 | positive or negative; a negative value specifies a position outside the |
| 1437 | screen or parent frame or on a monitor other than the primary one (for | 1455 | screen or parent frame or on a monitor other than the primary one (for |
| 1438 | multi-monitor displays). | 1456 | multi-monitor displays). |
| 1457 | |||
| 1458 | @cindex left position ratio | ||
| 1459 | @cindex top position ratio | ||
| 1460 | @item a floating-point value | ||
| 1461 | A floating-point value in the range 0.0 to 1.0 specifies the left edge's | ||
| 1462 | offset via the @dfn{left position ratio} of the frame---the ratio of the | ||
| 1463 | left edge of its outer frame to the width of the frame's workarea | ||
| 1464 | (@pxref{Multiple Terminals}) or its parent's native frame (@pxref{Child | ||
| 1465 | Frames}) minus the width of the outer frame. Thus, a left position | ||
| 1466 | ratio of 0.0 flushes a frame to the left, a ratio of 0.5 centers it and | ||
| 1467 | a ratio of 1.0 flushes it to the right of its display or parent frame. | ||
| 1468 | Similarly, the @dfn{top position ratio} of a frame is the ratio of the | ||
| 1469 | frame's top position to the height of its workarea or parent frame minus | ||
| 1470 | the height of the frame. | ||
| 1471 | |||
| 1472 | Emacs will try to keep the position ratios of a child frame unaltered if | ||
| 1473 | that frame has a non-@code{nil} @code{keep-ratio} parameter | ||
| 1474 | (@pxref{Frame Interaction Parameters}) and its parent frame is resized. | ||
| 1475 | |||
| 1476 | Since the outer size of a frame (@pxref{Frame Geometry}) is usually | ||
| 1477 | unavailable before a frame has been made visible, it is generally not | ||
| 1478 | advisable to use floating-point values when creating decorated frames. | ||
| 1479 | Floating-point values are more suited for ensuring that an (undecorated) | ||
| 1480 | child frame is positioned nicely within the area of its parent frame. | ||
| 1439 | @end table | 1481 | @end table |
| 1440 | 1482 | ||
| 1441 | Some window managers ignore program-specified positions. If you want to | 1483 | Some window managers ignore program-specified positions. If you want to |
| @@ -1448,17 +1490,19 @@ following example: | |||
| 1448 | nil '((user-position . t) (left . (+ -4)))) | 1490 | nil '((user-position . t) (left . (+ -4)))) |
| 1449 | @end example | 1491 | @end example |
| 1450 | 1492 | ||
| 1451 | In general, it is not a good idea to specify negative offsets to | 1493 | In general, it is not a good idea to position a frame relative to the |
| 1452 | position a frame relative to the right or bottom edge of its display. | 1494 | right or bottom edge of its display. Positioning the initial or a new |
| 1453 | Positioning the initial or a new frame is either not accurate (because | 1495 | frame is either not accurate (because the size of the outer frame is not |
| 1454 | the size of the outer frame is not yet fully known before the frame has | 1496 | yet fully known before the frame has been made visible) or will cause |
| 1455 | been made visible) or will cause additional flicker (if the frame is | 1497 | additional flicker (if the frame has to be repositioned after becoming |
| 1456 | repositioned after becoming visible). | 1498 | visible). |
| 1457 | 1499 | ||
| 1458 | Note also, that negative offsets are not stored internally and are not | 1500 | Note also, that positions specified relative to the right/bottom edge |
| 1459 | returned by the function @code{frame-parameters}. This means that the | 1501 | of a display, workarea or parent frame as well as floating-point offsets |
| 1460 | desktop saving routines will restore the frame from the positive offsets | 1502 | are stored internally as integer offsets relative to the left/top edge |
| 1461 | obtained by that function. | 1503 | of the display, workarea or parent frame edge. They are also returned |
| 1504 | as such by functions like @code{frame-parameters} and restored as such | ||
| 1505 | by the desktop saving routines. | ||
| 1462 | 1506 | ||
| 1463 | @vindex top, a frame parameter | 1507 | @vindex top, a frame parameter |
| 1464 | @item top | 1508 | @item top |
| @@ -1523,24 +1567,61 @@ function @code{frame-restack} (@pxref{Raising and Lowering}). | |||
| 1523 | @subsubsection Size Parameters | 1567 | @subsubsection Size Parameters |
| 1524 | @cindex window size on display | 1568 | @cindex window size on display |
| 1525 | 1569 | ||
| 1526 | Frame parameters specify frame sizes in character units. On | 1570 | Frame parameters usually specify frame sizes in character units. On |
| 1527 | graphical displays, the @code{default} face determines the actual | 1571 | graphical displays, the @code{default} face determines the actual pixel |
| 1528 | pixel sizes of these character units (@pxref{Face Attributes}). | 1572 | sizes of these character units (@pxref{Face Attributes}). |
| 1529 | 1573 | ||
| 1530 | @table @code | 1574 | @table @code |
| 1531 | @vindex width, a frame parameter | 1575 | @vindex width, a frame parameter |
| 1532 | @item width | 1576 | @item width |
| 1533 | The width of the frame's text area (@pxref{Frame Geometry}), in | 1577 | This parameter specifies the width of the frame. It can be specified as |
| 1534 | characters. The value can be also a cons cell of the symbol | 1578 | in the following ways: |
| 1535 | @code{text-pixels} and an integer denoting the width of the text area in | 1579 | |
| 1536 | pixels. | 1580 | @table @asis |
| 1581 | @item an integer | ||
| 1582 | A positive integer specifies the width of the frame's text area | ||
| 1583 | (@pxref{Frame Geometry}) in characters. | ||
| 1584 | |||
| 1585 | @item a cons cell | ||
| 1586 | If this is a cons cell with the symbol @code{text-pixels} in its | ||
| 1587 | @sc{car}, the @sc{cdr} of that cell specifies the width of the frame's | ||
| 1588 | text area in pixels. | ||
| 1589 | |||
| 1590 | @cindex frame width ratio | ||
| 1591 | @cindex frame height ratio | ||
| 1592 | @item a floating-point value | ||
| 1593 | A floating-point number between 0.0 and 1.0 can be used to specify the | ||
| 1594 | width of a frame via its @dfn{width ratio}---the ratio of its outer | ||
| 1595 | width (@pxref{Frame Geometry}) to the width of the frame's workarea | ||
| 1596 | (@pxref{Multiple Terminals}) or its parent frame's (@pxref{Child | ||
| 1597 | Frames}) native frame. Thus, a value of 0.5 makes the frame occupy half | ||
| 1598 | of the width of its workarea or parent frame, a value of 1.0 the full | ||
| 1599 | width. Similarly, the @dfn{height ratio} of a frame is the ratio of its | ||
| 1600 | outer height to the height of its workarea or its parent's native frame. | ||
| 1601 | |||
| 1602 | Emacs will try to keep the width and height ratio of a child frame | ||
| 1603 | unaltered if that frame has a non-@code{nil} @code{keep-ratio} parameter | ||
| 1604 | (@pxref{Frame Interaction Parameters}) and its parent frame is resized. | ||
| 1605 | |||
| 1606 | Since the outer size of a frame is usually unavailable before a frame | ||
| 1607 | has been made visible, it is generally not advisable to use | ||
| 1608 | floating-point values when creating decorated frames. Floating-point | ||
| 1609 | values are more suited to ensure that a child frame always fits within | ||
| 1610 | the area of its parent frame as, for example, when customizing | ||
| 1611 | @code{display-buffer-alist} (@pxref{Choosing Window}) via | ||
| 1612 | @code{display-buffer-in-child-frame}. | ||
| 1613 | @end table | ||
| 1614 | |||
| 1615 | Regardless of how this parameter was specified, functions reporting the | ||
| 1616 | value of this parameter like @code{frame-parameters} always report the | ||
| 1617 | width of the frame's text area in characters as an integer rounded, if | ||
| 1618 | necessary, to a multiple of the frame's default character width. That | ||
| 1619 | value is also used by the desktop saving routines. | ||
| 1537 | 1620 | ||
| 1538 | @vindex height, a frame parameter | 1621 | @vindex height, a frame parameter |
| 1539 | @item height | 1622 | @item height |
| 1540 | The height of the frame's text area (@pxref{Frame Geometry}), in | 1623 | This parameter specifies the height of the frame. It works just like |
| 1541 | characters. The value can be also a cons cell of the symbol | 1624 | @code{width}, except vertically instead of horizontally. |
| 1542 | @code{text-pixels} and an integer denoting the height of the text area | ||
| 1543 | in pixels. | ||
| 1544 | 1625 | ||
| 1545 | @vindex user-size, a frame parameter | 1626 | @vindex user-size, a frame parameter |
| 1546 | @item user-size | 1627 | @item user-size |
| @@ -1551,25 +1632,25 @@ user-position}) does for the position parameters @code{top} and | |||
| 1551 | 1632 | ||
| 1552 | @vindex min-width, a frame parameter | 1633 | @vindex min-width, a frame parameter |
| 1553 | @item min-width | 1634 | @item min-width |
| 1554 | This parameter specifies the minimum native width of the frame | 1635 | This parameter specifies the minimum native width (@pxref{Frame |
| 1555 | (@pxref{Frame Geometry}), in characters. Normally, the functions that | 1636 | Geometry}) of the frame, in characters. Normally, the functions that |
| 1556 | establish a frame's initial width or resize a frame horizontally make | 1637 | establish a frame's initial width or resize a frame horizontally make |
| 1557 | sure that all the frame's windows, vertical scroll bars, fringes, | 1638 | sure that all the frame's windows, vertical scroll bars, fringes, |
| 1558 | margins and vertical dividers can be displayed. This parameter, if | 1639 | margins and vertical dividers can be displayed. This parameter, if |
| 1559 | non-@code{nil} allows to make a frame narrower than that with the | 1640 | non-@code{nil} allows to make a frame narrower than that with the |
| 1560 | consequence that any components that do not fit on the frame will be | 1641 | consequence that any components that do not fit will be clipped by the |
| 1561 | clipped by the window manager. | 1642 | window manager. |
| 1562 | 1643 | ||
| 1563 | @vindex min-height, a frame parameter | 1644 | @vindex min-height, a frame parameter |
| 1564 | @item min-height | 1645 | @item min-height |
| 1565 | This parameter specifies the minimum height of the native (@pxref{Frame | 1646 | This parameter specifies the minimum native height (@pxref{Frame |
| 1566 | Geometry}), in characters. Normally, the functions that establish a | 1647 | Geometry}) of the frame, in characters. Normally, the functions that |
| 1567 | frame's initial size or resize a frame make sure that all the frame's | 1648 | establish a frame's initial size or resize a frame make sure that all |
| 1568 | windows, horizontal scroll bars and dividers, mode and header lines, the | 1649 | the frame's windows, horizontal scroll bars and dividers, mode and |
| 1569 | echo area and the internal menu and tool bar can be displayed. This | 1650 | header lines, the echo area and the internal menu and tool bar can be |
| 1570 | parameter, if non-@code{nil} allows to make a frame smaller than that | 1651 | displayed. This parameter, if non-@code{nil} allows to make a frame |
| 1571 | with the consequence that any components that do not fit on the frame | 1652 | smaller than that with the consequence that any components that do not |
| 1572 | will be clipped by the window-system or window manager. | 1653 | fit will be clipped by the window manager. |
| 1573 | 1654 | ||
| 1574 | @cindex fullboth frames | 1655 | @cindex fullboth frames |
| 1575 | @cindex fullheight frames | 1656 | @cindex fullheight frames |
| @@ -1623,6 +1704,20 @@ file as, for example | |||
| 1623 | 1704 | ||
| 1624 | This will give a new frame full height after typing in it @key{F11} for | 1705 | This will give a new frame full height after typing in it @key{F11} for |
| 1625 | the first time. | 1706 | the first time. |
| 1707 | |||
| 1708 | @vindex fit-frame-to-buffer-margins, a frame parameter | ||
| 1709 | @item fit-frame-to-buffer-margins | ||
| 1710 | This parameter allows to override the value of the option | ||
| 1711 | @code{fit-frame-to-buffer-margins} when fitting this frame to the buffer | ||
| 1712 | of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing | ||
| 1713 | Windows}). | ||
| 1714 | |||
| 1715 | @vindex fit-frame-to-buffer-sizes, a frame parameter | ||
| 1716 | @item fit-frame-to-buffer-sizes | ||
| 1717 | This parameter allows to override the value of the option | ||
| 1718 | @code{fit-frame-to-buffer-sizes} when fitting this frame to the buffer | ||
| 1719 | of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing | ||
| 1720 | Windows}). | ||
| 1626 | @end table | 1721 | @end table |
| 1627 | 1722 | ||
| 1628 | 1723 | ||
| @@ -1646,9 +1741,9 @@ Geometry}). | |||
| 1646 | 1741 | ||
| 1647 | @vindex vertical-scroll-bars, a frame parameter | 1742 | @vindex vertical-scroll-bars, a frame parameter |
| 1648 | @item vertical-scroll-bars | 1743 | @item vertical-scroll-bars |
| 1649 | Whether the frame has scroll bars for vertical scrolling, and which side | 1744 | Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical |
| 1650 | of the frame they should be on. The possible values are @code{left}, | 1745 | scrolling, and which side of the frame they should be on. The possible |
| 1651 | @code{right}, and @code{nil} for no scroll bars. | 1746 | values are @code{left}, @code{right}, and @code{nil} for no scroll bars. |
| 1652 | 1747 | ||
| 1653 | @vindex horizontal-scroll-bars, a frame parameter | 1748 | @vindex horizontal-scroll-bars, a frame parameter |
| 1654 | @item horizontal-scroll-bars | 1749 | @item horizontal-scroll-bars |
| @@ -1692,30 +1787,40 @@ to not draw bottom dividers. | |||
| 1692 | 1787 | ||
| 1693 | @vindex menu-bar-lines frame parameter | 1788 | @vindex menu-bar-lines frame parameter |
| 1694 | @item menu-bar-lines | 1789 | @item menu-bar-lines |
| 1695 | The number of lines to allocate at the top of the frame for a menu bar. | 1790 | The number of lines to allocate at the top of the frame for a menu bar |
| 1696 | The default is one if Menu Bar mode is enabled and zero otherwise. | 1791 | (@pxref{Menu Bar}). The default is one if Menu Bar mode is enabled and |
| 1697 | @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. For an external menu | 1792 | zero otherwise. @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. For an |
| 1698 | bar, this value remains unchanged even when the menu bar wraps to two or | 1793 | external menu bar (@pxref{Frame Layout}), this value remains unchanged |
| 1699 | more lines. In that case, the @code{menu-bar-size} value returned by | 1794 | even when the menu bar wraps to two or more lines. In that case, the |
| 1700 | @code{frame-geometry} (@pxref{Frame Geometry}) allows to derive whether | 1795 | @code{menu-bar-size} value returned by @code{frame-geometry} |
| 1701 | the menu bar actually occupies one or more lines. | 1796 | (@pxref{Frame Geometry}) allows to derive whether the menu bar actually |
| 1797 | occupies one or more lines. | ||
| 1702 | 1798 | ||
| 1703 | @vindex tool-bar-lines frame parameter | 1799 | @vindex tool-bar-lines frame parameter |
| 1704 | @item tool-bar-lines | 1800 | @item tool-bar-lines |
| 1705 | The number of lines to use for the tool bar. The default is one if Tool | 1801 | The number of lines to use for the tool bar (@pxref{Tool Bar}). The |
| 1706 | Bar mode is enabled and zero otherwise. @xref{Tool Bars,,,emacs, The | 1802 | default is one if Tool Bar mode is enabled and zero otherwise. |
| 1707 | GNU Emacs Manual}. This value may change whenever the tool bar wraps. | 1803 | @xref{Tool Bars,,,emacs, The GNU Emacs Manual}. This value may change |
| 1804 | whenever the tool bar wraps (@pxref{Frame Layout}). | ||
| 1708 | 1805 | ||
| 1709 | @vindex tool-bar-position frame parameter | 1806 | @vindex tool-bar-position frame parameter |
| 1710 | @item tool-bar-position | 1807 | @item tool-bar-position |
| 1711 | The position of the tool bar. Currently only for the GTK tool bar. | 1808 | The position of the tool bar when Emacs was built with GTK+. Its value |
| 1712 | Value can be one of @code{top}, @code{bottom} @code{left}, @code{right}. | 1809 | can be one of @code{top}, @code{bottom} @code{left}, @code{right}. The |
| 1713 | The default is @code{top}. | 1810 | default is @code{top}. |
| 1714 | 1811 | ||
| 1715 | @vindex line-spacing, a frame parameter | 1812 | @vindex line-spacing, a frame parameter |
| 1716 | @item line-spacing | 1813 | @item line-spacing |
| 1717 | Additional space to leave below each text line, in pixels (a positive | 1814 | Additional space to leave below each text line, in pixels (a positive |
| 1718 | integer). @xref{Line Height}, for more information. | 1815 | integer). @xref{Line Height}, for more information. |
| 1816 | |||
| 1817 | @vindex no-special-glyphs, a frame parameter | ||
| 1818 | @item no-special-glyphs | ||
| 1819 | If this is non-@code{nil}, it suppresses the display of any truncation | ||
| 1820 | and continuation glyphs (@pxref{Truncation}) for all buffers displayed | ||
| 1821 | by this frame. This is useful to eliminate such glyphs when fitting a | ||
| 1822 | frame to its buffer via @code{fit-frame-to-buffer} (@pxref{Resizing | ||
| 1823 | Windows}). | ||
| 1719 | @end table | 1824 | @end table |
| 1720 | 1825 | ||
| 1721 | 1826 | ||
| @@ -1781,15 +1886,115 @@ Frames}. | |||
| 1781 | @item mouse-wheel-frame | 1886 | @item mouse-wheel-frame |
| 1782 | If non-@code{nil}, this parameter specifies the frame whose windows will | 1887 | If non-@code{nil}, this parameter specifies the frame whose windows will |
| 1783 | be scrolled whenever the mouse wheel is scrolled with the mouse pointer | 1888 | be scrolled whenever the mouse wheel is scrolled with the mouse pointer |
| 1784 | hovering over this frame (@pxref{Mouse Commands,,, emacs, The GNU Emacs | 1889 | hovering over this frame, see @ref{Mouse Commands,,, emacs, The GNU |
| 1785 | Manual}). | 1890 | Emacs Manual}. |
| 1786 | 1891 | ||
| 1787 | @vindex no-other-frame, a frame parameter | 1892 | @vindex no-other-frame, a frame parameter |
| 1788 | @item no-other-frame | 1893 | @item no-other-frame |
| 1789 | If this is non-@code{nil}, then this frame is not eligible as candidate | 1894 | If this is non-@code{nil}, then this frame is not eligible as candidate |
| 1790 | for the functions @code{next-frame}, @code{previous-frame} | 1895 | for the functions @code{next-frame}, @code{previous-frame} |
| 1791 | (@pxref{Finding All Frames}) and @code{other-frame} (@pxref{Frame | 1896 | (@pxref{Finding All Frames}) and @code{other-frame}, see @ref{Frame |
| 1792 | Commands,,, emacs, The GNU Emacs Manual}). | 1897 | Commands,,, emacs, The GNU Emacs Manual}. |
| 1898 | |||
| 1899 | @vindex auto-hide-function, a frame parameter | ||
| 1900 | @item auto-hide-function | ||
| 1901 | When this parameter specifies a function, that function will be called | ||
| 1902 | instead of the function specified by the variable | ||
| 1903 | @code{frame-auto-hide-function} when quitting the frame's only window | ||
| 1904 | (@pxref{Quitting Windows}) and there are other frames left. | ||
| 1905 | |||
| 1906 | @vindex minibuffer-exit, a frame parameter | ||
| 1907 | @item minibuffer-exit | ||
| 1908 | When this parameter is non-@code{nil}, Emacs will by default make this | ||
| 1909 | frame invisible whenever the minibuffer (@pxref{Minibuffers}) is exited. | ||
| 1910 | Alternatively, it can specify the functions @code{iconify-frame} and | ||
| 1911 | @code{delete-frame}. This parameter is useful to make a child frame | ||
| 1912 | disappear automatically (similar to how Emacs deals with a window) when | ||
| 1913 | exiting the minibuffer. | ||
| 1914 | |||
| 1915 | @vindex keep-ratio, a frame parameter | ||
| 1916 | @item keep-ratio | ||
| 1917 | This parameter is currently meaningful for child frames (@pxref{Child | ||
| 1918 | Frames}) only. If it is non-@code{nil}, then Emacs will try to keep the | ||
| 1919 | frame's size (width and height) ratios (@pxref{Size Parameters}) as well | ||
| 1920 | as its left and right position ratios (@pxref{Position Parameters}) | ||
| 1921 | unaltered whenever its parent frame is resized. | ||
| 1922 | |||
| 1923 | If the value of this parameter is @code{nil}, the frame's position and | ||
| 1924 | size remain unaltered when the parent frame is resized, so the position | ||
| 1925 | and size ratios may change. If the value of this parameter is @code{t}, | ||
| 1926 | Emacs will try to preserve the frame's size and position ratios, hence | ||
| 1927 | the frame's size and position relative to its parent frame may change. | ||
| 1928 | |||
| 1929 | More individual control is possible by using a cons cell: In that case | ||
| 1930 | the frame's width ratio is preserved if the @sc{car} of the cell is | ||
| 1931 | either @code{t} or @code{width-only}. The height ratio is preserved if | ||
| 1932 | the @sc{car} of the cell is either @code{t} or @code{height-only}. The | ||
| 1933 | left position ratio is preserved if the @sc{cdr} of the cell is either | ||
| 1934 | @code{t} or @code{left-only}. The top position ratio is preserved if | ||
| 1935 | the @sc{cdr} of the cell is either @code{t} or @code{top-only}. | ||
| 1936 | @end table | ||
| 1937 | |||
| 1938 | |||
| 1939 | @node Mouse Dragging Parameters | ||
| 1940 | @subsubsection Mouse Dragging Parameters | ||
| 1941 | @cindex mouse dragging parameters | ||
| 1942 | @cindex parameters for resizing frames with the mouse | ||
| 1943 | @cindex parameters for moving frames with the mouse | ||
| 1944 | |||
| 1945 | The parameters described below provide support for resizing a frame by | ||
| 1946 | dragging its internal borders with the mouse. They also allow moving a | ||
| 1947 | frame with the mouse by dragging the header line of its topmost or the | ||
| 1948 | mode line of its bottommost window. | ||
| 1949 | |||
| 1950 | These parameters are mostly useful for child frames (@pxref{Child | ||
| 1951 | Frames}) that come without window manager decorations. If necessary, | ||
| 1952 | they can be used for undecorated top-level frames as well. | ||
| 1953 | |||
| 1954 | @table @code | ||
| 1955 | @vindex drag-internal-border, a frame parameter | ||
| 1956 | @item drag-internal-border | ||
| 1957 | If non-@code{nil}, the frame can be resized by dragging its internal | ||
| 1958 | borders, if present, with the mouse. | ||
| 1959 | |||
| 1960 | @vindex drag-with-header-line, a frame parameter | ||
| 1961 | @item drag-with-header-line | ||
| 1962 | If non-@code{nil}, the frame can be moved with the mouse by dragging the | ||
| 1963 | header line of its topmost window. | ||
| 1964 | |||
| 1965 | @vindex drag-with-mode-line, a frame parameter | ||
| 1966 | @item drag-with-mode-line | ||
| 1967 | If non-@code{nil}, the frame can be moved with the mouse by dragging the | ||
| 1968 | mode line of its bottommost window. Note that such a frame is not | ||
| 1969 | allowed to have its own minibuffer window. | ||
| 1970 | |||
| 1971 | @vindex snap-width, a frame parameter | ||
| 1972 | @item snap-width | ||
| 1973 | A frame that is moved with the mouse will ``snap'' at the border(s) of | ||
| 1974 | the display or its parent frame whenever it is dragged as near to such | ||
| 1975 | an edge as the number of pixels specified by this parameter. | ||
| 1976 | |||
| 1977 | @vindex top-visible, a frame parameter | ||
| 1978 | @item top-visible | ||
| 1979 | If this parameter is a number, the top edge of the frame never appears | ||
| 1980 | above the top edge of its display or parent frame. Moreover, as many | ||
| 1981 | pixels of the frame as specified by that number will remain visible when | ||
| 1982 | the frame is moved against any of the remaining edges of its display or | ||
| 1983 | parent frame. Setting this parameter is useful to guard against | ||
| 1984 | dragging a child frame with a non-@code{nil} | ||
| 1985 | @code{drag-with-header-line} parameter completely out of the area | ||
| 1986 | of its parent frame. | ||
| 1987 | |||
| 1988 | @vindex bottom-visible, a frame parameter | ||
| 1989 | @item bottom-visible | ||
| 1990 | If this parameter is a number, the bottom edge of the frame never | ||
| 1991 | appears below the bottom edge of its display or parent frame. Moreover, | ||
| 1992 | as many pixels of the frame as specified by that number will remain | ||
| 1993 | visible when the frame is moved against any of the remaining edges of | ||
| 1994 | its display or parent frame. Setting this parameter is useful to guard | ||
| 1995 | against dragging a child frame with a non-@code{nil} | ||
| 1996 | @code{drag-with-mode-line} parameter completely out of the area of | ||
| 1997 | its parent frame. | ||
| 1793 | @end table | 1998 | @end table |
| 1794 | 1999 | ||
| 1795 | 2000 | ||
| @@ -1797,9 +2002,9 @@ Commands,,, emacs, The GNU Emacs Manual}). | |||
| 1797 | @subsubsection Window Management Parameters | 2002 | @subsubsection Window Management Parameters |
| 1798 | @cindex window manager interaction, and frame parameters | 2003 | @cindex window manager interaction, and frame parameters |
| 1799 | 2004 | ||
| 1800 | The following frame parameters control various aspects of the | 2005 | The following frame parameters control various aspects of the frame's |
| 1801 | frame's interaction with the window manager. They have no effect on | 2006 | interaction with the window manager or window system. They have no |
| 1802 | text terminals. | 2007 | effect on text terminals. |
| 1803 | 2008 | ||
| 1804 | @table @code | 2009 | @table @code |
| 1805 | @vindex visibility, a frame parameter | 2010 | @vindex visibility, a frame parameter |
| @@ -1908,7 +2113,8 @@ If non-@code{nil}, this means that this is an @dfn{override redirect} | |||
| 1908 | frame---a frame not handled by window managers under X. Override | 2113 | frame---a frame not handled by window managers under X. Override |
| 1909 | redirect frames have no window manager decorations, can be positioned | 2114 | redirect frames have no window manager decorations, can be positioned |
| 1910 | and resized only via Emacs' positioning and resizing functions and are | 2115 | and resized only via Emacs' positioning and resizing functions and are |
| 1911 | usually drawn on top of all other frames. | 2116 | usually drawn on top of all other frames. Setting this parameter has |
| 2117 | no effect on MS-Windows. | ||
| 1912 | 2118 | ||
| 1913 | @ignore | 2119 | @ignore |
| 1914 | @vindex parent-id, a frame parameter | 2120 | @vindex parent-id, a frame parameter |
| @@ -2080,6 +2286,9 @@ The @code{alpha} frame parameter can also be a cons cell | |||
| 2080 | @code{(@var{active} . @var{inactive})}, where @var{active} is the | 2286 | @code{(@var{active} . @var{inactive})}, where @var{active} is the |
| 2081 | opacity of the frame when it is selected, and @var{inactive} is the | 2287 | opacity of the frame when it is selected, and @var{inactive} is the |
| 2082 | opacity when it is not selected. | 2288 | opacity when it is not selected. |
| 2289 | |||
| 2290 | Some window systems do not support the @code{alpha} parameter for child | ||
| 2291 | frames (@pxref{Child Frames}). | ||
| 2083 | @end table | 2292 | @end table |
| 2084 | 2293 | ||
| 2085 | The following frame parameters are semi-obsolete in that they are | 2294 | The following frame parameters are semi-obsolete in that they are |
| @@ -2824,57 +3033,78 @@ unwanted frames are iconified instead. | |||
| 2824 | @cindex child frames | 3033 | @cindex child frames |
| 2825 | @cindex parent frames | 3034 | @cindex parent frames |
| 2826 | 3035 | ||
| 2827 | On some window-systems the @code{parent-frame} parameter (@pxref{Frame | 3036 | Child frames are objects halfway between windows (@pxref{Windows}) and |
| 2828 | Interaction Parameters}) can be used to make a frame a child of the | 3037 | ``normal'' frames. Like windows, they are attached to an owning frame. |
| 2829 | frame specified by that parameter. The frame specified by that | 3038 | Unlike windows, they may overlap each other---changing the size or |
| 2830 | parameter will then be the frame's parent frame as long as the parameter | 3039 | position of one child frame does not change the size or position of any |
| 2831 | is not changed or reset. Technically, this makes the child frame's | 3040 | of its sibling child frames. |
| 2832 | window-system window a child window of the parent frame's window-system | 3041 | |
| 2833 | window. | 3042 | By design, operations to make or modify child frames are implemented |
| 3043 | with the help of frame parameters (@pxref{Frame Parameters}) without any | ||
| 3044 | specialized functions or customizable variables. Note that child frames | ||
| 3045 | are meaningful on graphical terminals only. | ||
| 3046 | |||
| 3047 | To create a new child frame or to convert a normal frame into a child | ||
| 3048 | frame, set that frame's @code{parent-frame} parameter (@pxref{Frame | ||
| 3049 | Interaction Parameters}) to that of an already existing frame. The | ||
| 3050 | frame specified by that parameter will then be the frame's parent frame | ||
| 3051 | as long as the parameter is not changed or reset. Technically, this | ||
| 3052 | makes the child frame's window-system window a child window of the | ||
| 3053 | parent frame's window-system window. | ||
| 2834 | 3054 | ||
| 3055 | @cindex top-level frame | ||
| 3056 | @cindex reparent frame | ||
| 3057 | @cindex nest frame | ||
| 2835 | The @code{parent-frame} parameter can be changed at any time. Setting | 3058 | The @code{parent-frame} parameter can be changed at any time. Setting |
| 2836 | it to another frame ``reparents'' the child frame. Setting it to | 3059 | it to another frame @dfn{reparents} the child frame. Setting it to |
| 2837 | another child frame makes the frame a ``nested'' child frame. Setting | 3060 | another child frame makes the frame a @dfn{nested} child frame. Setting |
| 2838 | it to @code{nil} restores the frame's status as a top-level frame---one | 3061 | it to @code{nil} restores the frame's status as a @dfn{top-level |
| 2839 | whose window-system window is a child of its display's root window. | 3062 | frame}---a frame whose window-system window is a child of its display's |
| 3063 | root window. | ||
| 2840 | 3064 | ||
| 2841 | Since child frames can be arbitrarily nested, a frame can be both a | 3065 | Since child frames can be arbitrarily nested, a frame can be both a |
| 2842 | child and a parent frame. Also, the relative roles of child and parent | 3066 | child and a parent frame. Also, the relative roles of child and parent |
| 2843 | frame may be reversed at any time (though it's usually a good idea to | 3067 | frame may be reversed at any time (though it's usually a good idea to |
| 2844 | keep the size of child frames sufficiently smaller than that of their | 3068 | keep the size of a child frame sufficiently smaller than that of its |
| 2845 | parent). An error will be signaled for the attempt to make a frame an | 3069 | parent). An error will be signaled for the attempt to make a frame an |
| 2846 | ancestor of itself. | 3070 | ancestor of itself. |
| 2847 | 3071 | ||
| 2848 | A child frame is clipped at the native edges (@pxref{Frame Geometry}) | 3072 | Most window-systems clip a child frame at the native edges |
| 2849 | of its parent frame---everything outside these edges is invisible. Its | 3073 | (@pxref{Frame Geometry}) of its parent frame---everything outside these |
| 2850 | @code{left} and @code{top} parameters specify positions relative to the | 3074 | edges is usually invisible. A child frame's @code{left} and @code{top} |
| 2851 | top-left corner of its parent's native frame. When either of the frames | 3075 | parameters specify a position relative to the top-left corner of its |
| 2852 | is resized, the relative position of the child frame remains unaltered. | 3076 | parent's native frame. When the parent frame is resized, this position |
| 2853 | Hence, resizing either of these frames can hide or reveal parts of the | 3077 | remains conceptually unaltered. |
| 2854 | child frame. | ||
| 2855 | 3078 | ||
| 2856 | NS builds do not clip child frames at the parent frame's edges, | 3079 | NS builds do not clip child frames at the parent frame's edges, |
| 2857 | allowing them to be positioned so they do not obscure the parent | 3080 | allowing them to be positioned so they do not obscure the parent frame |
| 2858 | frame while still being visible themselves. | 3081 | while still being visible themselves. |
| 2859 | 3082 | ||
| 2860 | Usually, moving a parent frame moves along all its child frames and | 3083 | Usually, moving a parent frame moves along all its child frames and |
| 2861 | their descendants as well, keeping their relative positions unaltered. | 3084 | their descendants as well, keeping their relative positions unaltered. |
| 2862 | The hook @code{move-frame-functions} (@pxref{Frame Position}) is run for | 3085 | Note that the hook @code{move-frame-functions} (@pxref{Frame Position}) |
| 2863 | a child frame only when the position of the child frame relative to its | 3086 | is run for a child frame only when the position of the child frame |
| 2864 | parent frame changes. When a parent frame is resized, the child frame | 3087 | relative to its parent frame changes. It is not run for a child frame |
| 2865 | retains its position respective to the left and upper native edges of | 3088 | when the position of the parent frame changes. |
| 2866 | its parent. In this case, the position respective to the lower or right | 3089 | |
| 2867 | native edge of the parent frame is usually lost. | 3090 | When a parent frame is resized, its child frames conceptually retain |
| 3091 | their previous sizes and their positions relative to the left upper | ||
| 3092 | corner of the parent. This means that a child frame may become | ||
| 3093 | (partially) invisible when its parent frame shrinks. The parameter | ||
| 3094 | @code{keep-ratio} (@pxref{Frame Interaction Parameters}) can be used to | ||
| 3095 | resize and reposition a child frame proportionally whenever its parent | ||
| 3096 | frame is resized. This may avoid obscuring parts of a frame when its | ||
| 3097 | parent frame is shrunk. | ||
| 2868 | 3098 | ||
| 2869 | A visible child frame always appears on top of its parent frame thus | 3099 | A visible child frame always appears on top of its parent frame thus |
| 2870 | obscuring parts of it, except on NS builds where it may be positioned | 3100 | obscuring parts of it, except on NS builds where it may be positioned |
| 2871 | beneath the parent. This is comparable to the window-system window of | 3101 | beneath the parent. This is comparable to the window-system window of a |
| 2872 | a top-level frame which also always appears on top of its parent | 3102 | top-level frame which also always appears on top of its parent |
| 2873 | window---the desktop's root window. When a parent frame is iconified | 3103 | window---the desktop's root window. When a parent frame is iconified or |
| 2874 | or made invisible (@pxref{Visibility of Frames}), its child frames are | 3104 | made invisible (@pxref{Visibility of Frames}), its child frames are made |
| 2875 | made invisible. When a parent frame is deiconified or made visible, | 3105 | invisible. When a parent frame is deiconified or made visible, its |
| 2876 | its child frames are made visible. When a parent frame is about to be | 3106 | child frames are made visible. When a parent frame is about to be |
| 2877 | deleted, (@pxref{Deleting Frames}) its child frames are recursively | 3107 | deleted (@pxref{Deleting Frames}), its child frames are recursively |
| 2878 | deleted before it. | 3108 | deleted before it. |
| 2879 | 3109 | ||
| 2880 | Whether a child frame can have a menu or tool bar is window-system or | 3110 | Whether a child frame can have a menu or tool bar is window-system or |
| @@ -2892,7 +3122,55 @@ outer border can be used. On MS-Windows, specifying a non-zero outer | |||
| 2892 | border width will show a one-pixel wide external border. Under all | 3122 | border width will show a one-pixel wide external border. Under all |
| 2893 | window-systems, the internal border can be used. In either case, it's | 3123 | window-systems, the internal border can be used. In either case, it's |
| 2894 | advisable to disable a child frame's window manager decorations with the | 3124 | advisable to disable a child frame's window manager decorations with the |
| 2895 | @code{undecorated} frame parameter @pxref{Management Parameters}). | 3125 | @code{undecorated} frame parameter (@pxref{Management Parameters}). |
| 3126 | |||
| 3127 | To resize or move an undecorated child frame with the mouse, special | ||
| 3128 | frame parameters (@pxref{Mouse Dragging Parameters}) have to be used. | ||
| 3129 | The internal border of a child frame, if present, can be used to resize | ||
| 3130 | the frame with the mouse, provided that frame has a non-@code{nil} | ||
| 3131 | @code{drag-internal-border} parameter. If set, the @code{snap-width} | ||
| 3132 | parameter indicates the number of pixels where the frame @dfn{snaps} at | ||
| 3133 | the respective edge or corner of its parent frame. | ||
| 3134 | |||
| 3135 | There are two ways to drag an entire child frame with the mouse: The | ||
| 3136 | @code{drag-with-mode-line} parameter, if non-@code{nil}, allows to drag | ||
| 3137 | a frame without minibuffer window (@pxref{Minibuffer Windows}) via the | ||
| 3138 | mode line area of its bottommost window. The | ||
| 3139 | @code{drag-with-header-line} parameter, if non-@code{nil}, allows to | ||
| 3140 | drag the frame via the header line area of its topmost window. | ||
| 3141 | |||
| 3142 | In order to give a child frame a draggable header or mode line, the | ||
| 3143 | window parameters @code{mode-line-format} and @code{header-line-format} | ||
| 3144 | are handy (@pxref{Window Parameters}). These allow to remove an | ||
| 3145 | unwanted mode line (when @code{drag-with-header-line} is chosen) and to | ||
| 3146 | remove mouse-sensitive areas which might interfere with frame dragging. | ||
| 3147 | |||
| 3148 | To avoid that dragging moves a frame completely out of its parent's | ||
| 3149 | native frame, something which might happen when the mouse cursor | ||
| 3150 | overshoots and makes the frame difficult to retrieve once the mouse | ||
| 3151 | button has been released, it is advisable to set the frame's | ||
| 3152 | @code{top-visible} or @code{bottom-visible} parameter correspondingly. | ||
| 3153 | |||
| 3154 | The @code{top-visible} parameter specifies the number of pixels at the | ||
| 3155 | top of the frame that always remain visible within the parent's native | ||
| 3156 | frame during dragging and should be set when specifying a non-@code{nil} | ||
| 3157 | @code{drag-with-header-line} parameter. The @code{bottom-visible} | ||
| 3158 | parameter specifies the number of pixels at the bottom of the frame that | ||
| 3159 | always remain visible within the parent's native frame during dragging | ||
| 3160 | and should be preferred when specifying a non-@code{nil} | ||
| 3161 | @code{drag-with-mode-line} parameter. | ||
| 3162 | |||
| 3163 | When a child frame is used for displaying a buffer via | ||
| 3164 | @code{display-buffer-in-child-frame} (@pxref{Display Action Functions}), | ||
| 3165 | the frame's @code{auto-hide-function} parameter (@pxref{Frame | ||
| 3166 | Interaction Parameters}) can be set to a function, in order to | ||
| 3167 | appropriately deal with the frame when the window displaying the buffer | ||
| 3168 | shall be quit. | ||
| 3169 | |||
| 3170 | When a child frame is used during minibuffer interaction, for example, | ||
| 3171 | to display completions in a separate window, the @code{minibuffer-exit} | ||
| 3172 | parameter (@pxref{Frame Interaction Parameters}) is useful in order to | ||
| 3173 | deal with the frame when the minibuffer is exited. | ||
| 2896 | 3174 | ||
| 2897 | The behavior of child frames deviates from that of top-level frames in | 3175 | The behavior of child frames deviates from that of top-level frames in |
| 2898 | a number of other ways as well. Here we sketch a few of them: | 3176 | 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 | |||
| 2930 | frame or on some ancestor instead. | 3208 | frame or on some ancestor instead. |
| 2931 | @end itemize | 3209 | @end itemize |
| 2932 | 3210 | ||
| 2933 | The following two functions may be useful when working with child and | 3211 | The following two functions can be useful when working with child and |
| 2934 | parent frames: | 3212 | parent frames: |
| 2935 | 3213 | ||
| 2936 | @defun frame-parent &optional frame | 3214 | @defun frame-parent &optional frame |
| @@ -2951,6 +3229,12 @@ of @var{descendant}'s parent frame. Both, @var{ancestor} and | |||
| 2951 | frame. | 3229 | frame. |
| 2952 | @end defun | 3230 | @end defun |
| 2953 | 3231 | ||
| 3232 | Note also the function @code{window-largest-empty-rectangle} | ||
| 3233 | (@pxref{Coordinates and Windows}) which can be used to inscribe a child | ||
| 3234 | frame in the largest empty area of an existing window. This can be | ||
| 3235 | useful to avoid that a child frame obscures any text shown in that | ||
| 3236 | window. | ||
| 3237 | |||
| 2954 | 3238 | ||
| 2955 | @node Mouse Tracking | 3239 | @node Mouse Tracking |
| 2956 | @section Mouse Tracking | 3240 | @section Mouse Tracking |
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 0e476b47a31..f7013da9433 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi | |||
| @@ -1737,7 +1737,9 @@ holds a @dfn{mode line construct}: a template that controls what is | |||
| 1737 | displayed on the buffer's mode line. The value of | 1737 | displayed on the buffer's mode line. The value of |
| 1738 | @code{header-line-format} specifies the buffer's header line in the same | 1738 | @code{header-line-format} specifies the buffer's header line in the same |
| 1739 | way. All windows for the same buffer use the same | 1739 | way. All windows for the same buffer use the same |
| 1740 | @code{mode-line-format} and @code{header-line-format}. | 1740 | @code{mode-line-format} and @code{header-line-format} unless a |
| 1741 | @code{mode-line-format} or @code{header-line-format} parameter has been | ||
| 1742 | specified for that window (@pxref{Window Parameters}). | ||
| 1741 | 1743 | ||
| 1742 | For efficiency, Emacs does not continuously recompute each window's | 1744 | For efficiency, Emacs does not continuously recompute each window's |
| 1743 | mode line and header line. It does so when circumstances appear to call | 1745 | 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 1f4c378df18..daa397175c3 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi | |||
| @@ -283,11 +283,11 @@ character @kbd{a}. | |||
| 283 | ?Q @result{} 81 ?q @result{} 113 | 283 | ?Q @result{} 81 ?q @result{} 113 |
| 284 | @end example | 284 | @end example |
| 285 | 285 | ||
| 286 | You can use the same syntax for punctuation characters, but it is | 286 | You can use the same syntax for punctuation characters. However, if |
| 287 | often a good idea to add a @samp{\} so that the Emacs commands for | 287 | the punctuation character has a special syntactic meaning in Lisp, you |
| 288 | editing Lisp code don't get confused. For example, @samp{?\(} is the | 288 | must quote it with a @samp{\}. For example, @samp{?\(} is the way to |
| 289 | way to write the open-paren character. If the character is @samp{\}, | 289 | write the open-paren character. Likewise, if the character is |
| 290 | you @emph{must} use a second @samp{\} to quote it: @samp{?\\}. | 290 | @samp{\}, you must use a second @samp{\} to quote it: @samp{?\\}. |
| 291 | 291 | ||
| 292 | @cindex whitespace | 292 | @cindex whitespace |
| 293 | @cindex bell character | 293 | @cindex bell character |
| @@ -336,18 +336,19 @@ escape character; this has nothing to do with the | |||
| 336 | character @key{ESC}. @samp{\s} is meant for use in character | 336 | character @key{ESC}. @samp{\s} is meant for use in character |
| 337 | constants; in string constants, just write the space. | 337 | constants; in string constants, just write the space. |
| 338 | 338 | ||
| 339 | A backslash is allowed, and harmless, preceding any character without | 339 | A backslash is allowed, and harmless, preceding any character |
| 340 | a special escape meaning; thus, @samp{?\+} is equivalent to @samp{?+}. | 340 | without a special escape meaning; thus, @samp{?\+} is equivalent to |
| 341 | There is no reason to add a backslash before most characters. However, | 341 | @samp{?+}. There is no reason to add a backslash before most |
| 342 | you should add a backslash before any of the characters | 342 | characters. However, you must add a backslash before any of the |
| 343 | @samp{()\|;'`"#.,} to avoid confusing the Emacs commands for editing | 343 | characters @samp{()[]\;"}, and you should add a backslash before any |
| 344 | Lisp code. You can also add a backslash before whitespace characters such as | 344 | of the characters @samp{|'`#.,} to avoid confusing the Emacs commands |
| 345 | space, tab, newline and formfeed. However, it is cleaner to use one of | 345 | for editing Lisp code. You can also add a backslash before whitespace |
| 346 | the easily readable escape sequences, such as @samp{\t} or @samp{\s}, | 346 | characters such as space, tab, newline and formfeed. However, it is |
| 347 | instead of an actual whitespace character such as a tab or a space. | 347 | cleaner to use one of the easily readable escape sequences, such as |
| 348 | (If you do write backslash followed by a space, you should write | 348 | @samp{\t} or @samp{\s}, instead of an actual whitespace character such |
| 349 | an extra space after the character constant to separate it from the | 349 | as a tab or a space. (If you do write backslash followed by a space, |
| 350 | following text.) | 350 | you should write an extra space after the character constant to |
| 351 | separate it from the following text.) | ||
| 351 | 352 | ||
| 352 | @node General Escape Syntax | 353 | @node General Escape Syntax |
| 353 | @subsubsection General Escape Syntax | 354 | @subsubsection General Escape Syntax |
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index d9b4b743a3b..eb5c2fc46be 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi | |||
| @@ -752,6 +752,7 @@ The optional argument @var{pixelwise} non-@code{nil} means to return the | |||
| 752 | minimum size of @var{window} counted in pixels. | 752 | minimum size of @var{window} counted in pixels. |
| 753 | @end defun | 753 | @end defun |
| 754 | 754 | ||
| 755 | |||
| 755 | @node Resizing Windows | 756 | @node Resizing Windows |
| 756 | @section Resizing Windows | 757 | @section Resizing Windows |
| 757 | @cindex window resizing | 758 | @cindex window resizing |
| @@ -943,7 +944,8 @@ help of the two options listed next. | |||
| 943 | @defopt fit-frame-to-buffer-margins | 944 | @defopt fit-frame-to-buffer-margins |
| 944 | This option can be used to specify margins around frames to be fit by | 945 | This option can be used to specify margins around frames to be fit by |
| 945 | @code{fit-frame-to-buffer}. Such margins can be useful to avoid, for | 946 | @code{fit-frame-to-buffer}. Such margins can be useful to avoid, for |
| 946 | example, that such frames overlap the taskbar. | 947 | example, that the resized frame overlaps the taskbar or parts of its |
| 948 | parent frame. | ||
| 947 | 949 | ||
| 948 | It specifies the numbers of pixels to be left free on the left, above, | 950 | It specifies the numbers of pixels to be left free on the left, above, |
| 949 | the right, and below a frame that shall be fit. The default specifies | 951 | 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} | |||
| 2484 | is added to the newly created frame's parameters. | 2486 | is added to the newly created frame's parameters. |
| 2485 | @end defun | 2487 | @end defun |
| 2486 | 2488 | ||
| 2489 | @defun display-buffer-in-child-frame buffer alist | ||
| 2490 | This function tries to display @var{buffer} in a child frame | ||
| 2491 | (@pxref{Child Frames}) of the selected frame, either reusing an existing | ||
| 2492 | child frame or by making a new one. If @var{alist} has a non-@code{nil} | ||
| 2493 | @code{child-frame-parameters} entry, the corresponding value is an alist | ||
| 2494 | of frame parameters to give the new frame. A @code{parent-frame} | ||
| 2495 | parameter specifying the selected frame is provided by default. If the | ||
| 2496 | child frame should be or become the child of another frame, a | ||
| 2497 | corresponding entry must be added to @var{alist}. | ||
| 2498 | |||
| 2499 | The appearance of child frames is largely dependent on the parameters | ||
| 2500 | provided via @var{alist}. It is advisable to use at least ratios to | ||
| 2501 | specify the size (@pxref{Size Parameters}) and the position | ||
| 2502 | (@pxref{Position Parameters}) of the child frame and to add the | ||
| 2503 | @code{keep-ratio} in order to make sure that the child frame remains | ||
| 2504 | visible. For other parameters that should be considered see @ref{Child | ||
| 2505 | Frames}. | ||
| 2506 | @end defun | ||
| 2507 | |||
| 2487 | @defun display-buffer-use-some-frame buffer alist | 2508 | @defun display-buffer-use-some-frame buffer alist |
| 2488 | This function tries to display @var{buffer} by trying to find a | 2509 | This function tries to display @var{buffer} by trying to find a |
| 2489 | frame that meets a predicate (by default any frame other than the | 2510 | frame that meets a predicate (by default any frame other than the |
| @@ -3124,12 +3145,17 @@ killed. | |||
| 3124 | The default is to call @code{iconify-frame} (@pxref{Visibility of | 3145 | The default is to call @code{iconify-frame} (@pxref{Visibility of |
| 3125 | Frames}). Alternatively, you may specify either @code{delete-frame} | 3146 | Frames}). Alternatively, you may specify either @code{delete-frame} |
| 3126 | (@pxref{Deleting Frames}) to remove the frame from its display, | 3147 | (@pxref{Deleting Frames}) to remove the frame from its display, |
| 3127 | @code{ignore} to leave the frame unchanged, or any other function that | 3148 | @code{make-frame-invisible} to make the frame invisible, @code{ignore} |
| 3128 | can take a frame as its sole argument. | 3149 | to leave the frame unchanged, or any other function that can take a |
| 3150 | frame as its sole argument. | ||
| 3129 | 3151 | ||
| 3130 | Note that the function specified by this option is called only if the | 3152 | Note that the function specified by this option is called only if the |
| 3131 | specified frame contains just one live window and there is at least one | 3153 | specified frame contains just one live window and there is at least one |
| 3132 | other frame on the same terminal. | 3154 | other frame on the same terminal. |
| 3155 | |||
| 3156 | For a particular frame, the value specified here may be overridden by | ||
| 3157 | that frame's @code{auto-hide-function} frame parameter (@pxref{Frame | ||
| 3158 | Interaction Parameters}). | ||
| 3133 | @end defopt | 3159 | @end defopt |
| 3134 | 3160 | ||
| 3135 | 3161 | ||
| @@ -4364,13 +4390,12 @@ is off the screen due to horizontal scrolling: | |||
| 4364 | @cindex coordinate, relative to frame | 4390 | @cindex coordinate, relative to frame |
| 4365 | @cindex window position | 4391 | @cindex window position |
| 4366 | 4392 | ||
| 4367 | This section describes functions that report the position of a window. | 4393 | This section describes functions that report positions of and within a |
| 4368 | Most of these functions report positions relative to an origin at the | 4394 | window. Most of these functions report positions relative to an origin |
| 4369 | native position of the window's frame (@pxref{Frame Geometry}). Some | 4395 | at the native position of the window's frame (@pxref{Frame Geometry}). |
| 4370 | functions report positions relative to the origin of the display of the | 4396 | Some functions report positions relative to the origin of the display of |
| 4371 | window's frame. In any case, the origin has the coordinates (0, 0) and | 4397 | the window's frame. In any case, the origin has the coordinates (0, 0) |
| 4372 | X and Y coordinates increase rightward and downward | 4398 | and X and Y coordinates increase rightward and downward respectively. |
| 4373 | respectively. | ||
| 4374 | 4399 | ||
| 4375 | For the following functions, X and Y coordinates are reported in | 4400 | For the following functions, X and Y coordinates are reported in |
| 4376 | integer character units, i.e., numbers of lines and columns | 4401 | integer character units, i.e., numbers of lines and columns |
| @@ -4608,6 +4633,49 @@ point in the selected window, it's sufficient to write: | |||
| 4608 | @end example | 4633 | @end example |
| 4609 | @end defun | 4634 | @end defun |
| 4610 | 4635 | ||
| 4636 | The following function returns the largest rectangle that can be | ||
| 4637 | inscribed in a window without covering text displayed in that window. | ||
| 4638 | |||
| 4639 | @defun window-largest-empty-rectangle &optional window count min-width min-height positions left | ||
| 4640 | This function calculates the dimensions of the largest empty rectangle | ||
| 4641 | that can be inscribed in the specified @var{window}'s text area. | ||
| 4642 | @var{window} must be a live window and defaults to the selected one. | ||
| 4643 | |||
| 4644 | The return value is a triple of the width and the start and end | ||
| 4645 | y-coordinates of the largest rectangle that can be inscribed into the | ||
| 4646 | empty space (space not displaying any text) of the text area of | ||
| 4647 | @var{window}. No x-coordinates are returned by this function---any such | ||
| 4648 | rectangle is assumed to end at the right edge of @var{window}'s text | ||
| 4649 | area. If no empty space can be found, the return value is @code{nil}. | ||
| 4650 | |||
| 4651 | The optional argument @var{count}, if non-@code{nil}, specifies a | ||
| 4652 | maximum number of rectangles to return. This means that the return | ||
| 4653 | value is a list of triples specifying rectangles with the largest | ||
| 4654 | rectangle first. @var{count} can be also a cons cell whose car | ||
| 4655 | specifies the number of rectangles to return and whose @sc{cdr}, if | ||
| 4656 | non-@code{nil}, states that all rectangles returned must be disjoint. | ||
| 4657 | |||
| 4658 | The optional arguments @var{min-width} and @var{min-height}, if | ||
| 4659 | non-@code{nil}, specify the minimum width and height of any rectangle | ||
| 4660 | returned. | ||
| 4661 | |||
| 4662 | The optional argument @var{positions}, if non-@code{nil}, is a cons cell | ||
| 4663 | whose @sc{car} specifies the uppermost and whose @sc{cdr} specifies the | ||
| 4664 | lowermost pixel position that must be covered by any rectangle returned. | ||
| 4665 | These positions measure from the start of the text area of @var{window}. | ||
| 4666 | |||
| 4667 | The optional argument @var{left}, if non-@code{nil}, means to return | ||
| 4668 | values suitable for buffers displaying right to left text. In that | ||
| 4669 | case, any rectangle returned is assumed to start at the left edge of | ||
| 4670 | @var{window}'s text area. | ||
| 4671 | |||
| 4672 | Note that this function has to retrieve the dimensions of each line of | ||
| 4673 | @var{window}'s glyph matrix via @code{window-lines-pixel-dimensions} | ||
| 4674 | (@pxref{Size of Displayed Text}). Hence, this function may also return | ||
| 4675 | @code{nil} when the current glyph matrix of @var{window} is not | ||
| 4676 | up-to-date. | ||
| 4677 | @end defun | ||
| 4678 | |||
| 4611 | 4679 | ||
| 4612 | @node Mouse Window Auto-selection | 4680 | @node Mouse Window Auto-selection |
| 4613 | @section Mouse Window Auto-selection | 4681 | @section Mouse Window Auto-selection |
| @@ -4911,37 +4979,45 @@ windows when exiting that function. | |||
| 4911 | The following parameters are currently used by the window management | 4979 | The following parameters are currently used by the window management |
| 4912 | code: | 4980 | code: |
| 4913 | 4981 | ||
| 4914 | @table @asis | 4982 | @table @code |
| 4915 | @item @code{delete-window} | 4983 | @item delete-window |
| 4984 | @vindex delete-window, a window parameter | ||
| 4916 | This parameter affects the execution of @code{delete-window} | 4985 | This parameter affects the execution of @code{delete-window} |
| 4917 | (@pxref{Deleting Windows}). | 4986 | (@pxref{Deleting Windows}). |
| 4918 | 4987 | ||
| 4919 | @item @code{delete-other-windows} | 4988 | @item delete-other-windows |
| 4989 | @vindex delete-other-windows, a window parameter | ||
| 4920 | This parameter affects the execution of @code{delete-other-windows} | 4990 | This parameter affects the execution of @code{delete-other-windows} |
| 4921 | (@pxref{Deleting Windows}). | 4991 | (@pxref{Deleting Windows}). |
| 4922 | 4992 | ||
| 4923 | @item @code{no-delete-other-window} | 4993 | @item no-delete-other-window |
| 4994 | @vindex no-delete-other-window, a window parameter | ||
| 4924 | This parameter marks the window as not deletable by | 4995 | This parameter marks the window as not deletable by |
| 4925 | @code{delete-other-windows} (@pxref{Deleting Windows}). | 4996 | @code{delete-other-windows} (@pxref{Deleting Windows}). |
| 4926 | 4997 | ||
| 4927 | @item @code{split-window} | 4998 | @item split-window |
| 4999 | @vindex split-window, a window parameter | ||
| 4928 | This parameter affects the execution of @code{split-window} | 5000 | This parameter affects the execution of @code{split-window} |
| 4929 | (@pxref{Splitting Windows}). | 5001 | (@pxref{Splitting Windows}). |
| 4930 | 5002 | ||
| 4931 | @item @code{other-window} | 5003 | @item other-window |
| 5004 | @vindex other-window, a window parameter | ||
| 4932 | This parameter affects the execution of @code{other-window} | 5005 | This parameter affects the execution of @code{other-window} |
| 4933 | (@pxref{Cyclic Window Ordering}). | 5006 | (@pxref{Cyclic Window Ordering}). |
| 4934 | 5007 | ||
| 4935 | @item @code{no-other-window} | 5008 | @item no-other-window |
| 5009 | @vindex no-other-window, a window parameter | ||
| 4936 | This parameter marks the window as not selectable by @code{other-window} | 5010 | This parameter marks the window as not selectable by @code{other-window} |
| 4937 | (@pxref{Cyclic Window Ordering}). | 5011 | (@pxref{Cyclic Window Ordering}). |
| 4938 | 5012 | ||
| 4939 | @item @code{clone-of} | 5013 | @item clone-of |
| 5014 | @vindex clone-of, a window parameter | ||
| 4940 | This parameter specifies the window that this one has been cloned | 5015 | This parameter specifies the window that this one has been cloned |
| 4941 | from. It is installed by @code{window-state-get} (@pxref{Window | 5016 | from. It is installed by @code{window-state-get} (@pxref{Window |
| 4942 | Configurations}). | 5017 | Configurations}). |
| 4943 | 5018 | ||
| 4944 | @item @code{preserved-size} | 5019 | @item preserved-size |
| 5020 | @vindex preserved-size, a window parameter | ||
| 4945 | This parameter specifies a buffer, a direction where @code{nil} means | 5021 | This parameter specifies a buffer, a direction where @code{nil} means |
| 4946 | vertical and @code{t} horizontal, and a size in pixels. If this window | 5022 | vertical and @code{t} horizontal, and a size in pixels. If this window |
| 4947 | displays the specified buffer and its size in the indicated direction | 5023 | 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 | |||
| 4950 | parameter is installed and updated by the function | 5026 | parameter is installed and updated by the function |
| 4951 | @code{window-preserve-size} (@pxref{Preserving Window Sizes}). | 5027 | @code{window-preserve-size} (@pxref{Preserving Window Sizes}). |
| 4952 | 5028 | ||
| 4953 | @item @code{quit-restore} | 5029 | @item quit-restore |
| 5030 | @vindex quit-restore, a window parameter | ||
| 4954 | This parameter is installed by the buffer display functions | 5031 | This parameter is installed by the buffer display functions |
| 4955 | (@pxref{Choosing Window}) and consulted by @code{quit-restore-window} | 5032 | (@pxref{Choosing Window}) and consulted by @code{quit-restore-window} |
| 4956 | (@pxref{Quitting Windows}). It contains four elements: | 5033 | (@pxref{Quitting Windows}). It contains four elements: |
| @@ -4981,15 +5058,37 @@ only if it still shows that buffer. | |||
| 4981 | See the description of @code{quit-restore-window} in @ref{Quitting | 5058 | See the description of @code{quit-restore-window} in @ref{Quitting |
| 4982 | Windows} for details. | 5059 | Windows} for details. |
| 4983 | 5060 | ||
| 4984 | @item @code{window-side} @code{window-slot} | 5061 | @item window-side window-slot |
| 5062 | @vindex window-side, a window parameter | ||
| 5063 | @vindex window-slot, a window parameter | ||
| 4985 | These parameters are used for implementing side windows (@pxref{Side | 5064 | These parameters are used for implementing side windows (@pxref{Side |
| 4986 | Windows}). | 5065 | Windows}). |
| 4987 | 5066 | ||
| 4988 | @item @code{window-atom} | 5067 | @item window-atom |
| 5068 | @vindex window-atom, a window parameter | ||
| 4989 | This parameter is used for implementing atomic windows, see @ref{Atomic | 5069 | This parameter is used for implementing atomic windows, see @ref{Atomic |
| 4990 | Windows}. | 5070 | Windows}. |
| 4991 | 5071 | ||
| 4992 | @item @code{min-margins} | 5072 | @item mode-line-format |
| 5073 | @vindex mode-line-format, a window parameter | ||
| 5074 | This parameter replaces the value of the buffer-local variable | ||
| 5075 | @code{mode-line-format} (@pxref{Mode Line Basics}) of this window's | ||
| 5076 | buffer whenever this window is displayed. The symbol @code{none} means | ||
| 5077 | to suppress display of a mode line for this window. Display and | ||
| 5078 | contents of the mode line on other windows showing this buffer are not | ||
| 5079 | affected. | ||
| 5080 | |||
| 5081 | @item header-line-format | ||
| 5082 | @vindex header-line-format, a window parameter | ||
| 5083 | This parameter replaces the value of the buffer-local variable | ||
| 5084 | @code{header-line-format} (@pxref{Mode Line Basics}) of this window's | ||
| 5085 | buffer whenever this window is displayed. The symbol @code{none} means | ||
| 5086 | to suppress display of a header line for this window. Display and | ||
| 5087 | contents of the header line on other windows showing this buffer are not | ||
| 5088 | affected. | ||
| 5089 | |||
| 5090 | @item min-margins | ||
| 5091 | @vindex min-margins, a window parameter | ||
| 4993 | The value of this parameter is a cons cell whose @sc{car} and @sc{cdr}, | 5092 | The value of this parameter is a cons cell whose @sc{car} and @sc{cdr}, |
| 4994 | if non-@code{nil}, specify the minimum values (in columns) for the left | 5093 | if non-@code{nil}, specify the minimum values (in columns) for the left |
| 4995 | and right margin of this window. When present, Emacs will use these | 5094 | 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 b0cfbc9d3c0..069d6b3389b 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi | |||
| @@ -405,7 +405,7 @@ variable will cause @samp{text/html} parts to be treated as attachments. | |||
| 405 | @item mm-text-html-renderer | 405 | @item mm-text-html-renderer |
| 406 | @vindex mm-text-html-renderer | 406 | @vindex mm-text-html-renderer |
| 407 | This selects the function used to render @acronym{HTML}. The predefined | 407 | This selects the function used to render @acronym{HTML}. The predefined |
| 408 | renderers are selected by the symbols @code{gnus-article-html}, | 408 | renderers are selected by the symbols @code{shr}, @code{gnus-w3m}, |
| 409 | @code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more | 409 | @code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more |
| 410 | information about emacs-w3m}, @code{links}, @code{lynx}, | 410 | information about emacs-w3m}, @code{links}, @code{lynx}, |
| 411 | @code{w3m-standalone} or @code{html2text}. If @code{nil} use an | 411 | @code{w3m-standalone} or @code{html2text}. If @code{nil} use an |
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index a42dc6ed3c0..6209e02ebc5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi | |||
| @@ -72,21 +72,21 @@ local and the remote host, whereas @value{tramp} uses a combination of | |||
| 72 | @command{ssh}/@command{scp}. | 72 | @command{ssh}/@command{scp}. |
| 73 | 73 | ||
| 74 | You can find the latest version of this document on the web at | 74 | You can find the latest version of this document on the web at |
| 75 | @uref{http://www.gnu.org/software/tramp/}. | 75 | @uref{https://www.gnu.org/software/tramp/}. |
| 76 | 76 | ||
| 77 | @ifhtml | 77 | @ifhtml |
| 78 | The latest release of @value{tramp} is available for | 78 | The latest release of @value{tramp} is available for |
| 79 | @uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see | 79 | @uref{https://ftp.gnu.org/gnu/tramp/, download}, or you may see |
| 80 | @ref{Obtaining Tramp} for more details, including the Git server | 80 | @ref{Obtaining Tramp} for more details, including the Git server |
| 81 | details. | 81 | details. |
| 82 | 82 | ||
| 83 | @value{tramp} also has a @uref{http://savannah.gnu.org/projects/tramp/, | 83 | @value{tramp} also has a @uref{https://savannah.gnu.org/projects/tramp/, |
| 84 | Savannah Project Page}. | 84 | Savannah Project Page}. |
| 85 | @end ifhtml | 85 | @end ifhtml |
| 86 | 86 | ||
| 87 | There is a mailing list for @value{tramp}, available at | 87 | There is a mailing list for @value{tramp}, available at |
| 88 | @email{tramp-devel@@gnu.org}, and archived at | 88 | @email{tramp-devel@@gnu.org}, and archived at |
| 89 | @uref{http://lists.gnu.org/archive/html/tramp-devel/, the | 89 | @uref{https://lists.gnu.org/archive/html/tramp-devel/, the |
| 90 | @value{tramp} Mail Archive}. | 90 | @value{tramp} Mail Archive}. |
| 91 | 91 | ||
| 92 | @page | 92 | @page |
| @@ -321,7 +321,7 @@ behind the scenes when you open a file with @value{tramp}. | |||
| 321 | @value{tramp} is included as part of Emacs (since Emacs version 22.1). | 321 | @value{tramp} is included as part of Emacs (since Emacs version 22.1). |
| 322 | 322 | ||
| 323 | @value{tramp} is also freely packaged for download on the Internet at | 323 | @value{tramp} is also freely packaged for download on the Internet at |
| 324 | @uref{ftp://ftp.gnu.org/gnu/tramp/}. | 324 | @uref{https://ftp.gnu.org/gnu/tramp/}. |
| 325 | 325 | ||
| 326 | @value{tramp} development versions are available on Git servers. | 326 | @value{tramp} development versions are available on Git servers. |
| 327 | Development versions contain new and incomplete features. | 327 | 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 | |||
| 331 | navigation bar at the top. | 331 | navigation bar at the top. |
| 332 | 332 | ||
| 333 | @noindent | 333 | @noindent |
| 334 | @uref{http://savannah.gnu.org/projects/tramp/} | 334 | @uref{https://savannah.gnu.org/projects/tramp/} |
| 335 | 335 | ||
| 336 | @noindent | 336 | @noindent |
| 337 | Another way is to follow the terminal session below: | 337 | Another way is to follow the terminal session below: |
| @@ -349,7 +349,7 @@ From behind a firewall: | |||
| 349 | @example | 349 | @example |
| 350 | @group | 350 | @group |
| 351 | ] @strong{git config --global http.proxy http://user:pwd@@proxy.server.com:8080} | 351 | ] @strong{git config --global http.proxy http://user:pwd@@proxy.server.com:8080} |
| 352 | ] @strong{git clone http://git.savannah.gnu.org/r/tramp.git} | 352 | ] @strong{git clone https://git.savannah.gnu.org/r/tramp.git} |
| 353 | @end group | 353 | @end group |
| 354 | @end example | 354 | @end example |
| 355 | 355 | ||
| @@ -917,7 +917,7 @@ numbers are not applicable to Android devices connected through USB@. | |||
| 917 | @cindex dbus | 917 | @cindex dbus |
| 918 | 918 | ||
| 919 | GVFS is the virtual file system for the Gnome Desktop, | 919 | GVFS is the virtual file system for the Gnome Desktop, |
| 920 | @uref{http://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are | 920 | @uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are |
| 921 | mounted locally through FUSE and @value{tramp} uses this locally | 921 | mounted locally through FUSE and @value{tramp} uses this locally |
| 922 | mounted directory internally. | 922 | mounted directory internally. |
| 923 | 923 | ||
| @@ -1896,12 +1896,16 @@ where @samp{192.168.0.1} is the remote host IP address | |||
| 1896 | @value{tramp} uses the @option{adb} method to access Android devices. | 1896 | @value{tramp} uses the @option{adb} method to access Android devices. |
| 1897 | Android devices provide a restricted shell access through an USB | 1897 | Android devices provide a restricted shell access through an USB |
| 1898 | connection. The local host must have the @command{adb} program | 1898 | connection. The local host must have the @command{adb} program |
| 1899 | installed. | 1899 | installed. Usually, it is sufficient to open the file |
| 1900 | @file{@trampfn{adb,,/}}. Then you can navigate in the filesystem via | ||
| 1901 | @code{dired}. | ||
| 1900 | 1902 | ||
| 1901 | Applications such as @code{SSHDroid} that run @command{sshd} process | 1903 | Alternatively, applications such as @code{SSHDroid} that run |
| 1902 | on the Android device can accept any @option{ssh}-based methods | 1904 | @command{sshd} process on the Android device can accept any |
| 1903 | provided these settings are adjusted: | 1905 | @option{ssh}-based methods provided these settings are adjusted: |
| 1904 | 1906 | ||
| 1907 | @itemize | ||
| 1908 | @item | ||
| 1905 | @command{sh} must be specified for remote shell since Android devices | 1909 | @command{sh} must be specified for remote shell since Android devices |
| 1906 | do not provide @command{/bin/sh}. @command{sh} will then invoke | 1910 | do not provide @command{/bin/sh}. @command{sh} will then invoke |
| 1907 | whatever shell is installed on the device with this setting: | 1911 | whatever shell is installed on the device with this setting: |
| @@ -1917,6 +1921,7 @@ whatever shell is installed on the device with this setting: | |||
| 1917 | where @samp{192.168.0.26} is the Android device's IP address. | 1921 | where @samp{192.168.0.26} is the Android device's IP address. |
| 1918 | (@pxref{Predefined connection information}). | 1922 | (@pxref{Predefined connection information}). |
| 1919 | 1923 | ||
| 1924 | @item | ||
| 1920 | @value{tramp} requires preserving @env{PATH} environment variable from | 1925 | @value{tramp} requires preserving @env{PATH} environment variable from |
| 1921 | user settings. Android devices prefer @file{/system/xbin} path over | 1926 | user settings. Android devices prefer @file{/system/xbin} path over |
| 1922 | @file{/system/bin}. Both of these are set as follows: | 1927 | @file{/system/bin}. Both of these are set as follows: |
| @@ -1928,7 +1933,7 @@ user settings. Android devices prefer @file{/system/xbin} path over | |||
| 1928 | @end group | 1933 | @end group |
| 1929 | @end lisp | 1934 | @end lisp |
| 1930 | 1935 | ||
| 1931 | @noindent | 1936 | @item |
| 1932 | When the Android device is not @samp{rooted}, specify a writable | 1937 | When the Android device is not @samp{rooted}, specify a writable |
| 1933 | directory for temporary files: | 1938 | directory for temporary files: |
| 1934 | 1939 | ||
| @@ -1936,7 +1941,7 @@ directory for temporary files: | |||
| 1936 | (add-to-list 'tramp-remote-process-environment "TMPDIR=$HOME") | 1941 | (add-to-list 'tramp-remote-process-environment "TMPDIR=$HOME") |
| 1937 | @end lisp | 1942 | @end lisp |
| 1938 | 1943 | ||
| 1939 | @noindent | 1944 | @item |
| 1940 | Open a remote connection with the command @kbd{C-x C-f | 1945 | Open a remote connection with the command @kbd{C-x C-f |
| 1941 | @trampfn{ssh,192.168.0.26#2222,}}, where @command{sshd} is listening | 1946 | @trampfn{ssh,192.168.0.26#2222,}}, where @command{sshd} is listening |
| 1942 | on port @samp{2222}. | 1947 | on port @samp{2222}. |
| @@ -1967,6 +1972,7 @@ the previous example, fix the connection properties as follows: | |||
| 1967 | @noindent | 1972 | @noindent |
| 1968 | Open a remote connection with a more concise command @kbd{C-x C-f | 1973 | Open a remote connection with a more concise command @kbd{C-x C-f |
| 1969 | @trampfn{ssh,android,}}. | 1974 | @trampfn{ssh,android,}}. |
| 1975 | @end itemize | ||
| 1970 | 1976 | ||
| 1971 | 1977 | ||
| 1972 | @node Auto-save and Backup | 1978 | @node Auto-save and Backup |
| @@ -2083,7 +2089,7 @@ Pseudo-terminal will not be allocated because stdin is not a terminal. | |||
| 2083 | 2089 | ||
| 2084 | Some older versions of Cygwin's @command{ssh} work with the | 2090 | Some older versions of Cygwin's @command{ssh} work with the |
| 2085 | @option{sshx} access method. Consult Cygwin's FAQ at | 2091 | @option{sshx} access method. Consult Cygwin's FAQ at |
| 2086 | @uref{http://cygwin.com/faq/} for details. | 2092 | @uref{https://cygwin.com/faq/} for details. |
| 2087 | 2093 | ||
| 2088 | @cindex Cygwin and fakecygpty | 2094 | @cindex Cygwin and fakecygpty |
| 2089 | @cindex fakecygpty and Cygwin | 2095 | @cindex fakecygpty and Cygwin |
| @@ -2797,7 +2803,7 @@ this address go to all the subscribers. This is @emph{not} the | |||
| 2797 | address to send subscription requests to. | 2803 | address to send subscription requests to. |
| 2798 | 2804 | ||
| 2799 | To subscribe to the mailing list, visit: | 2805 | To subscribe to the mailing list, visit: |
| 2800 | @uref{http://lists.gnu.org/mailman/listinfo/tramp-devel/, the | 2806 | @uref{https://lists.gnu.org/mailman/listinfo/tramp-devel/, the |
| 2801 | @value{tramp} Mail Subscription Page}. | 2807 | @value{tramp} Mail Subscription Page}. |
| 2802 | 2808 | ||
| 2803 | @ifset installchapter | 2809 | @ifset installchapter |
| @@ -2849,13 +2855,13 @@ Where is the latest @value{tramp}? | |||
| 2849 | @value{tramp} is available at the GNU URL: | 2855 | @value{tramp} is available at the GNU URL: |
| 2850 | 2856 | ||
| 2851 | @noindent | 2857 | @noindent |
| 2852 | @uref{ftp://ftp.gnu.org/gnu/tramp/} | 2858 | @uref{https://ftp.gnu.org/gnu/tramp/} |
| 2853 | 2859 | ||
| 2854 | @noindent | 2860 | @noindent |
| 2855 | @value{tramp}'s GNU project page is located here: | 2861 | @value{tramp}'s GNU project page is located here: |
| 2856 | 2862 | ||
| 2857 | @noindent | 2863 | @noindent |
| 2858 | @uref{http://savannah.gnu.org/projects/tramp/} | 2864 | @uref{https://savannah.gnu.org/projects/tramp/} |
| 2859 | 2865 | ||
| 2860 | 2866 | ||
| 2861 | @item | 2867 | @item |
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index f1cb60b9d25..05b577da005 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi | |||
| @@ -8,7 +8,7 @@ | |||
| 8 | @c In the Tramp GIT, the version number is auto-frobbed from | 8 | @c In the Tramp GIT, the version number is auto-frobbed from |
| 9 | @c configure.ac, so you should edit that file and run | 9 | @c configure.ac, so you should edit that file and run |
| 10 | @c "autoconf && ./configure" to change the version number. | 10 | @c "autoconf && ./configure" to change the version number. |
| 11 | @set trampver 2.3.2-pre | 11 | @set trampver 2.3.2 |
| 12 | 12 | ||
| 13 | @c Other flags from configuration | 13 | @c Other flags from configuration |
| 14 | @set instprefix /usr/local | 14 | @set instprefix /usr/local |
| @@ -129,6 +129,22 @@ given file is on a case-insensitive filesystem. | |||
| 129 | of curved quotes for 'electric-quote-mode', allowing user to choose | 129 | of curved quotes for 'electric-quote-mode', allowing user to choose |
| 130 | the types of quotes to be used. | 130 | the types of quotes to be used. |
| 131 | 131 | ||
| 132 | ** The new user option 'electric-quote-context-sensitive' makes | ||
| 133 | 'electric-quote-mode' context sensitive. If it is non-nil, you can | ||
| 134 | type an ASCII apostrophe to insert an opening or closing quote, | ||
| 135 | depending on context. Emacs will replace the apostrophe by an opening | ||
| 136 | quote character at the beginning of the buffer, the beginning of a | ||
| 137 | line, after a whitespace character, and after an opening parenthesis; | ||
| 138 | and it will replace the apostrophe by a closing quote character in all | ||
| 139 | other cases. | ||
| 140 | |||
| 141 | ** The new variable 'electric-quote-code-faces' controls when to | ||
| 142 | disable electric quoting in text modes. Major modes can add faces to | ||
| 143 | this list; Emacs will temporarily disable 'electric-quote-mode' | ||
| 144 | whenever point is before a character having such a face. This is | ||
| 145 | intended for major modes that derive from 'text-mode' but allow inline | ||
| 146 | code segments, such as 'markdown-mode'. | ||
| 147 | |||
| 132 | +++ | 148 | +++ |
| 133 | ** The new user variable 'dired-omit-case-fold' allows the user to | 149 | ** The new user variable 'dired-omit-case-fold' allows the user to |
| 134 | customize the case-sensitivity of dired-omit-mode. It defaults to | 150 | customize the case-sensitivity of dired-omit-mode. It defaults to |
| @@ -320,6 +336,15 @@ questions, with a handy way to display help texts. | |||
| 320 | all call stack frames in a Lisp backtrace buffer as lists. Both | 336 | all call stack frames in a Lisp backtrace buffer as lists. Both |
| 321 | debug.el and edebug.el have been updated to heed to this variable. | 337 | debug.el and edebug.el have been updated to heed to this variable. |
| 322 | 338 | ||
| 339 | --- | ||
| 340 | ** Values in call stack frames are now displayed using 'cl-prin1'. | ||
| 341 | The old behaviour of using 'prin1' can be restored by customizing the | ||
| 342 | new option 'debugger-print-function'. | ||
| 343 | |||
| 344 | +++ | ||
| 345 | ** NUL bytes in strings copied to the system clipboard are now | ||
| 346 | replaced with "\0". | ||
| 347 | |||
| 323 | +++ | 348 | +++ |
| 324 | ** The new variable 'x-ctrl-keysym' has been added to the existing | 349 | ** The new variable 'x-ctrl-keysym' has been added to the existing |
| 325 | roster of X keysyms. It can be used in combination with another | 350 | 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 | |||
| 364 | "emacsclient Options" in the user manual for the details. | 389 | "emacsclient Options" in the user manual for the details. |
| 365 | 390 | ||
| 366 | +++ | 391 | +++ |
| 392 | ** 'describe-key-briefly' now ignores mouse movement events. | ||
| 393 | |||
| 394 | +++ | ||
| 367 | ** The new variable 'eval-expression-print-maximum-character' prevents | 395 | ** The new variable 'eval-expression-print-maximum-character' prevents |
| 368 | large integers from being displayed as characters. | 396 | large integers from being displayed as characters. |
| 369 | 397 | ||
| @@ -471,6 +499,12 @@ properties as intact as possible. | |||
| 471 | 499 | ||
| 472 | * Changes in Specialized Modes and Packages in Emacs 26.1 | 500 | * Changes in Specialized Modes and Packages in Emacs 26.1 |
| 473 | 501 | ||
| 502 | ** Dired | ||
| 503 | You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced | ||
| 504 | by the current file name. | ||
| 505 | |||
| 506 | *** html2text is now marked obsolete. | ||
| 507 | |||
| 474 | *** smerge-refine-regions can refine regions in separate buffers | 508 | *** smerge-refine-regions can refine regions in separate buffers |
| 475 | 509 | ||
| 476 | *** Info menu and index completion uses substring completion by default. | 510 | *** Info menu and index completion uses substring completion by default. |
| @@ -642,6 +676,13 @@ replaced by the real images asynchronously, which will also now | |||
| 642 | respect width/height HTML specs (unless they specify widths/heights | 676 | respect width/height HTML specs (unless they specify widths/heights |
| 643 | bigger than the current window). | 677 | bigger than the current window). |
| 644 | 678 | ||
| 679 | --- | ||
| 680 | *** The 'w' command on links is now 'shr-maybe-probe-and-copy-url'. | ||
| 681 | 'shr-copy-url' now only copies the url at point; users who wish to | ||
| 682 | avoid accidentally accessing remote links may rebind 'w' and 'u' in | ||
| 683 | 'eww-link-keymap' to it. | ||
| 684 | |||
| 685 | |||
| 645 | ** Ido | 686 | ** Ido |
| 646 | 687 | ||
| 647 | *** The commands 'find-alternate-file-other-window', | 688 | *** The commands 'find-alternate-file-other-window', |
| @@ -1203,7 +1244,7 @@ run. | |||
| 1203 | frame's outer border. | 1244 | frame's outer border. |
| 1204 | 1245 | ||
| 1205 | +++ | 1246 | +++ |
| 1206 | *** New frame parameters | 1247 | *** New frame parameters and changed semantics for older ones |
| 1207 | 1248 | ||
| 1208 | +++ | 1249 | +++ |
| 1209 | **** 'z-group' positions a frame above or below all others. | 1250 | **** 'z-group' positions a frame above or below all others. |
| @@ -1248,10 +1289,32 @@ focus via the mouse. | |||
| 1248 | frame. | 1289 | frame. |
| 1249 | 1290 | ||
| 1250 | +++ | 1291 | +++ |
| 1251 | *** The 'width' and 'height' frame parameters allow to specify pixel | 1292 | **** 'width' and 'height' allow to specify pixel values and ratios now. |
| 1252 | values now. | 1293 | |
| 1294 | +++ | ||
| 1295 | **** 'left' and 'top' allow to specify ratios now. | ||
| 1296 | |||
| 1297 | +++ | ||
| 1298 | **** 'keep-ratio' preserves size and position of child frames when their | ||
| 1299 | parent frame is resized. | ||
| 1253 | 1300 | ||
| 1254 | +++ | 1301 | +++ |
| 1302 | **** 'no-special-glyphs' suppresses display of truncation and | ||
| 1303 | continuation glyphs in a frame. | ||
| 1304 | |||
| 1305 | +++ | ||
| 1306 | **** 'auto-hide-function' and 'minibuffer-exit' handle auto hiding of | ||
| 1307 | frames and exiting from minibuffer individually. | ||
| 1308 | |||
| 1309 | +++ | ||
| 1310 | **** 'fit-frame-to-buffer-margins' and 'fit-frame-to-buffer-sizes' | ||
| 1311 | handle fitting a frame to its buffer individually. | ||
| 1312 | |||
| 1313 | +++ | ||
| 1314 | **** 'drag-internal-border', 'drag-with-header-line', | ||
| 1315 | 'drag-with-mode-line', 'snap-width', 'top-visible' and 'bottom-visible' | ||
| 1316 | allow to drag and resize frames with the mouse. | ||
| 1317 | |||
| 1255 | *** The new function 'frame-list-z-order' returns a list of all frames | 1318 | *** The new function 'frame-list-z-order' returns a list of all frames |
| 1256 | in Z (stacking) order. | 1319 | in Z (stacking) order. |
| 1257 | 1320 | ||
| @@ -1310,6 +1373,10 @@ a new window when opening man pages when there's already one, use | |||
| 1310 | its window gets deleted by 'delete-other-windows'. | 1373 | its window gets deleted by 'delete-other-windows'. |
| 1311 | 1374 | ||
| 1312 | +++ | 1375 | +++ |
| 1376 | *** New window parameters 'mode-line-format' and 'header-line-format' | ||
| 1377 | allow to override the buffer-local formats for this window. | ||
| 1378 | |||
| 1379 | +++ | ||
| 1313 | *** New command 'window-swap-states' swaps the states of two live | 1380 | *** New command 'window-swap-states' swaps the states of two live |
| 1314 | windows. | 1381 | windows. |
| 1315 | 1382 | ||
| @@ -1319,9 +1386,23 @@ windows. | |||
| 1319 | window changed size when 'window-size-change-functions' are run. | 1386 | window changed size when 'window-size-change-functions' are run. |
| 1320 | 1387 | ||
| 1321 | +++ | 1388 | +++ |
| 1389 | *** The new function 'window-lines-pixel-dimensions' returns the pixel | ||
| 1390 | dimensions of a window's text lines. | ||
| 1391 | |||
| 1392 | +++ | ||
| 1393 | *** The new function 'window-largest-empty-rectangle' returns the | ||
| 1394 | dimensions of the largest rectangular area not occupying any text in a | ||
| 1395 | window's body. | ||
| 1396 | |||
| 1397 | +++ | ||
| 1322 | *** The semantics of 'mouse-autoselect-window' has changed slightly. | 1398 | *** The semantics of 'mouse-autoselect-window' has changed slightly. |
| 1323 | For details see the section "Mouse Window Auto-selection" in the Elisp | 1399 | For details see the section "Mouse Window Auto-selection" in the Elisp |
| 1324 | manual. | 1400 | manual. |
| 1401 | |||
| 1402 | --- | ||
| 1403 | ** 'tcl-auto-fill-mode' is now declared obsolete. It's functionality | ||
| 1404 | can be replicated simply by setting 'comment-auto-fill-only-comments'. | ||
| 1405 | |||
| 1325 | 1406 | ||
| 1326 | * Changes in Emacs 26.1 on Non-Free Operating Systems | 1407 | * Changes in Emacs 26.1 on Non-Free Operating Systems |
| 1327 | 1408 | ||
| @@ -1364,7 +1445,7 @@ This is in contrast to the default action on POSIX Systems, where it | |||
| 1364 | causes the receiving process to terminate with a core dump if no | 1445 | causes the receiving process to terminate with a core dump if no |
| 1365 | debugger has been attached to it. | 1446 | debugger has been attached to it. |
| 1366 | 1447 | ||
| 1367 | ** `set-mouse-position' and `set-mouse-absolute-pixel-position' work | 1448 | ** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work |
| 1368 | on macOS. | 1449 | on macOS. |
| 1369 | 1450 | ||
| 1370 | 1451 | ||
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 51d181997b1..e77b7c94cca 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c | |||
| @@ -20,21 +20,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 20 | 20 | ||
| 21 | #include <config.h> | 21 | #include <config.h> |
| 22 | #include <stddef.h> | 22 | #include <stddef.h> |
| 23 | #include <stdio.h> | ||
| 24 | #include <stdlib.h> | 23 | #include <stdlib.h> |
| 25 | #include <string.h> | 24 | #include <string.h> |
| 26 | #include <ctype.h> | 25 | #include <ctype.h> |
| 27 | #include <assert.h> | 26 | #include <assert.h> |
| 28 | #include <getopt.h> | 27 | #include <getopt.h> |
| 29 | 28 | ||
| 29 | #include <flexmember.h> | ||
| 30 | #include <min-max.h> | ||
| 31 | #include <unlocked-io.h> | ||
| 32 | |||
| 30 | /* The SunOS compiler doesn't have SEEK_END. */ | 33 | /* The SunOS compiler doesn't have SEEK_END. */ |
| 31 | #ifndef SEEK_END | 34 | #ifndef SEEK_END |
| 32 | #define SEEK_END 2 | 35 | #define SEEK_END 2 |
| 33 | #endif | 36 | #endif |
| 34 | 37 | ||
| 35 | #include <flexmember.h> | ||
| 36 | #include <min-max.h> | ||
| 37 | |||
| 38 | /* Files are read in chunks of this number of bytes. */ | 38 | /* Files are read in chunks of this number of bytes. */ |
| 39 | 39 | ||
| 40 | enum { READ_CHUNK_SIZE = 100 * 1024 }; | 40 | enum { READ_CHUNK_SIZE = 100 * 1024 }; |
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 8828b7652de..f1d4e8976da 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c | |||
| @@ -73,7 +73,6 @@ char *w32_getenv (const char *); | |||
| 73 | 73 | ||
| 74 | #include <stdarg.h> | 74 | #include <stdarg.h> |
| 75 | #include <ctype.h> | 75 | #include <ctype.h> |
| 76 | #include <stdio.h> | ||
| 77 | #include <stdlib.h> | 76 | #include <stdlib.h> |
| 78 | #include <string.h> | 77 | #include <string.h> |
| 79 | #include <getopt.h> | 78 | #include <getopt.h> |
| @@ -84,6 +83,8 @@ char *w32_getenv (const char *); | |||
| 84 | #include <signal.h> | 83 | #include <signal.h> |
| 85 | #include <errno.h> | 84 | #include <errno.h> |
| 86 | 85 | ||
| 86 | #include <unlocked-io.h> | ||
| 87 | |||
| 87 | #ifndef VERSION | 88 | #ifndef VERSION |
| 88 | #define VERSION "unspecified" | 89 | #define VERSION "unspecified" |
| 89 | #endif | 90 | #endif |
diff --git a/lib-src/etags.c b/lib-src/etags.c index 6f280d8ab40..e5ff7bd10fc 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c | |||
| @@ -123,6 +123,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; | |||
| 123 | #include <errno.h> | 123 | #include <errno.h> |
| 124 | #include <fcntl.h> | 124 | #include <fcntl.h> |
| 125 | #include <binary-io.h> | 125 | #include <binary-io.h> |
| 126 | #include <unlocked-io.h> | ||
| 126 | #include <c-ctype.h> | 127 | #include <c-ctype.h> |
| 127 | #include <c-strcase.h> | 128 | #include <c-strcase.h> |
| 128 | 129 | ||
diff --git a/lib-src/hexl.c b/lib-src/hexl.c index 319ce8bc890..d949af08902 100644 --- a/lib-src/hexl.c +++ b/lib-src/hexl.c | |||
| @@ -22,11 +22,11 @@ along with this program. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 22 | #include <config.h> | 22 | #include <config.h> |
| 23 | 23 | ||
| 24 | #include <inttypes.h> | 24 | #include <inttypes.h> |
| 25 | #include <stdio.h> | ||
| 26 | #include <stdlib.h> | 25 | #include <stdlib.h> |
| 27 | #include <string.h> | 26 | #include <string.h> |
| 28 | 27 | ||
| 29 | #include <binary-io.h> | 28 | #include <binary-io.h> |
| 29 | #include <unlocked-io.h> | ||
| 30 | 30 | ||
| 31 | static char *progname; | 31 | static char *progname; |
| 32 | 32 | ||
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 9470bd635f5..6b2cc110403 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c | |||
| @@ -39,10 +39,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 39 | #include <stdarg.h> | 39 | #include <stdarg.h> |
| 40 | #include <stddef.h> | 40 | #include <stddef.h> |
| 41 | #include <stdint.h> | 41 | #include <stdint.h> |
| 42 | #include <stdio.h> | ||
| 43 | #include <stdlib.h> | 42 | #include <stdlib.h> |
| 44 | #include <string.h> | 43 | #include <string.h> |
| 45 | 44 | ||
| 45 | #include <binary-io.h> | ||
| 46 | #include <intprops.h> | ||
| 47 | #include <min-max.h> | ||
| 48 | #include <unlocked-io.h> | ||
| 49 | |||
| 46 | #ifdef WINDOWSNT | 50 | #ifdef WINDOWSNT |
| 47 | /* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this | 51 | /* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this |
| 48 | is really just insurance. */ | 52 | is really just insurance. */ |
| @@ -50,10 +54,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 50 | #include <direct.h> | 54 | #include <direct.h> |
| 51 | #endif /* WINDOWSNT */ | 55 | #endif /* WINDOWSNT */ |
| 52 | 56 | ||
| 53 | #include <binary-io.h> | ||
| 54 | #include <intprops.h> | ||
| 55 | #include <min-max.h> | ||
| 56 | |||
| 57 | #ifdef DOS_NT | 57 | #ifdef DOS_NT |
| 58 | /* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this | 58 | /* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this |
| 59 | is really just insurance. | 59 | is really just insurance. |
diff --git a/lib-src/movemail.c b/lib-src/movemail.c index cd12c48ed36..e5ca0b16611 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c | |||
| @@ -59,7 +59,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 59 | #include <sys/types.h> | 59 | #include <sys/types.h> |
| 60 | #include <sys/stat.h> | 60 | #include <sys/stat.h> |
| 61 | #include <sys/file.h> | 61 | #include <sys/file.h> |
| 62 | #include <stdio.h> | ||
| 63 | #include <stdlib.h> | 62 | #include <stdlib.h> |
| 64 | #include <errno.h> | 63 | #include <errno.h> |
| 65 | #include <time.h> | 64 | #include <time.h> |
| @@ -69,6 +68,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 69 | #include <fcntl.h> | 68 | #include <fcntl.h> |
| 70 | #include <signal.h> | 69 | #include <signal.h> |
| 71 | #include <string.h> | 70 | #include <string.h> |
| 71 | |||
| 72 | #include <unlocked-io.h> | ||
| 73 | |||
| 72 | #include "syswait.h" | 74 | #include "syswait.h" |
| 73 | #ifdef MAIL_USE_POP | 75 | #ifdef MAIL_USE_POP |
| 74 | #include "pop.h" | 76 | #include "pop.h" |
diff --git a/lib-src/profile.c b/lib-src/profile.c index 253f00e2d80..f4ab45c1718 100644 --- a/lib-src/profile.c +++ b/lib-src/profile.c | |||
| @@ -34,11 +34,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 34 | #include <config.h> | 34 | #include <config.h> |
| 35 | 35 | ||
| 36 | #include <inttypes.h> | 36 | #include <inttypes.h> |
| 37 | #include <stdio.h> | ||
| 38 | #include <stdlib.h> | 37 | #include <stdlib.h> |
| 39 | 38 | ||
| 40 | #include <intprops.h> | 39 | #include <intprops.h> |
| 41 | #include <systime.h> | 40 | #include <systime.h> |
| 41 | #include <unlocked-io.h> | ||
| 42 | 42 | ||
| 43 | static struct timespec TV1; | 43 | static struct timespec TV1; |
| 44 | static int watch_not_started = 1; /* flag */ | 44 | static int watch_not_started = 1; /* flag */ |
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c index 5edc8e79569..942aeeb399d 100644 --- a/lib-src/update-game-score.c +++ b/lib-src/update-game-score.c | |||
| @@ -39,7 +39,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 39 | #include <limits.h> | 39 | #include <limits.h> |
| 40 | #include <string.h> | 40 | #include <string.h> |
| 41 | #include <stdlib.h> | 41 | #include <stdlib.h> |
| 42 | #include <stdio.h> | ||
| 43 | #include <time.h> | 42 | #include <time.h> |
| 44 | #include <pwd.h> | 43 | #include <pwd.h> |
| 45 | #include <ctype.h> | 44 | #include <ctype.h> |
| @@ -47,6 +46,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 47 | #include <sys/stat.h> | 46 | #include <sys/stat.h> |
| 48 | #include <getopt.h> | 47 | #include <getopt.h> |
| 49 | 48 | ||
| 49 | #include <unlocked-io.h> | ||
| 50 | |||
| 50 | #ifdef WINDOWSNT | 51 | #ifdef WINDOWSNT |
| 51 | #include "ntlib.h" | 52 | #include "ntlib.h" |
| 52 | #endif | 53 | #endif |
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 509089e6391..fd0f9e5c780 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in | |||
| @@ -21,7 +21,7 @@ | |||
| 21 | # the same distribution terms as the rest of that program. | 21 | # the same distribution terms as the rest of that program. |
| 22 | # | 22 | # |
| 23 | # Generated by gnulib-tool. | 23 | # Generated by gnulib-tool. |
| 24 | # Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright utimens vla warnings | 24 | # Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings |
| 25 | 25 | ||
| 26 | 26 | ||
| 27 | MOSTLYCLEANFILES += core *.stackdump | 27 | MOSTLYCLEANFILES += core *.stackdump |
| @@ -2996,6 +2996,15 @@ EXTRA_DIST += unistd.in.h | |||
| 2996 | endif | 2996 | endif |
| 2997 | ## end gnulib module unistd | 2997 | ## end gnulib module unistd |
| 2998 | 2998 | ||
| 2999 | ## begin gnulib module unlocked-io | ||
| 3000 | ifeq (,$(OMIT_GNULIB_MODULE_unlocked-io)) | ||
| 3001 | |||
| 3002 | |||
| 3003 | EXTRA_DIST += unlocked-io.h | ||
| 3004 | |||
| 3005 | endif | ||
| 3006 | ## end gnulib module unlocked-io | ||
| 3007 | |||
| 2999 | ## begin gnulib module update-copyright | 3008 | ## begin gnulib module update-copyright |
| 3000 | ifeq (,$(OMIT_GNULIB_MODULE_update-copyright)) | 3009 | ifeq (,$(OMIT_GNULIB_MODULE_update-copyright)) |
| 3001 | 3010 | ||
diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h new file mode 100644 index 00000000000..aaf60a0fb4e --- /dev/null +++ b/lib/unlocked-io.h | |||
| @@ -0,0 +1,136 @@ | |||
| 1 | /* Prefer faster, non-thread-safe stdio functions if available. | ||
| 2 | |||
| 3 | Copyright (C) 2001-2004, 2009-2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | This program is free software: you can redistribute it and/or modify | ||
| 6 | it under the terms of the GNU General Public License as published by | ||
| 7 | the Free Software Foundation; either version 3 of the License, or | ||
| 8 | (at your option) any later version. | ||
| 9 | |||
| 10 | This program is distributed in the hope that it will be useful, | ||
| 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | GNU General Public License for more details. | ||
| 14 | |||
| 15 | You should have received a copy of the GNU General Public License | ||
| 16 | along with this program. If not, see <http://www.gnu.org/licenses/>. */ | ||
| 17 | |||
| 18 | /* Written by Jim Meyering. */ | ||
| 19 | |||
| 20 | #ifndef UNLOCKED_IO_H | ||
| 21 | # define UNLOCKED_IO_H 1 | ||
| 22 | |||
| 23 | /* These are wrappers for functions/macros from the GNU C library, and | ||
| 24 | from other C libraries supporting POSIX's optional thread-safe functions. | ||
| 25 | |||
| 26 | The standard I/O functions are thread-safe. These *_unlocked ones are | ||
| 27 | more efficient but not thread-safe. That they're not thread-safe is | ||
| 28 | fine since all of the applications in this package are single threaded. | ||
| 29 | |||
| 30 | Also, some code that is shared with the GNU C library may invoke | ||
| 31 | the *_unlocked functions directly. On hosts that lack those | ||
| 32 | functions, invoke the non-thread-safe versions instead. */ | ||
| 33 | |||
| 34 | # include <stdio.h> | ||
| 35 | |||
| 36 | # if HAVE_DECL_CLEARERR_UNLOCKED | ||
| 37 | # undef clearerr | ||
| 38 | # define clearerr(x) clearerr_unlocked (x) | ||
| 39 | # else | ||
| 40 | # define clearerr_unlocked(x) clearerr (x) | ||
| 41 | # endif | ||
| 42 | |||
| 43 | # if HAVE_DECL_FEOF_UNLOCKED | ||
| 44 | # undef feof | ||
| 45 | # define feof(x) feof_unlocked (x) | ||
| 46 | # else | ||
| 47 | # define feof_unlocked(x) feof (x) | ||
| 48 | # endif | ||
| 49 | |||
| 50 | # if HAVE_DECL_FERROR_UNLOCKED | ||
| 51 | # undef ferror | ||
| 52 | # define ferror(x) ferror_unlocked (x) | ||
| 53 | # else | ||
| 54 | # define ferror_unlocked(x) ferror (x) | ||
| 55 | # endif | ||
| 56 | |||
| 57 | # if HAVE_DECL_FFLUSH_UNLOCKED | ||
| 58 | # undef fflush | ||
| 59 | # define fflush(x) fflush_unlocked (x) | ||
| 60 | # else | ||
| 61 | # define fflush_unlocked(x) fflush (x) | ||
| 62 | # endif | ||
| 63 | |||
| 64 | # if HAVE_DECL_FGETS_UNLOCKED | ||
| 65 | # undef fgets | ||
| 66 | # define fgets(x,y,z) fgets_unlocked (x,y,z) | ||
| 67 | # else | ||
| 68 | # define fgets_unlocked(x,y,z) fgets (x,y,z) | ||
| 69 | # endif | ||
| 70 | |||
| 71 | # if HAVE_DECL_FPUTC_UNLOCKED | ||
| 72 | # undef fputc | ||
| 73 | # define fputc(x,y) fputc_unlocked (x,y) | ||
| 74 | # else | ||
| 75 | # define fputc_unlocked(x,y) fputc (x,y) | ||
| 76 | # endif | ||
| 77 | |||
| 78 | # if HAVE_DECL_FPUTS_UNLOCKED | ||
| 79 | # undef fputs | ||
| 80 | # define fputs(x,y) fputs_unlocked (x,y) | ||
| 81 | # else | ||
| 82 | # define fputs_unlocked(x,y) fputs (x,y) | ||
| 83 | # endif | ||
| 84 | |||
| 85 | # if HAVE_DECL_FREAD_UNLOCKED | ||
| 86 | # undef fread | ||
| 87 | # define fread(w,x,y,z) fread_unlocked (w,x,y,z) | ||
| 88 | # else | ||
| 89 | # define fread_unlocked(w,x,y,z) fread (w,x,y,z) | ||
| 90 | # endif | ||
| 91 | |||
| 92 | # if HAVE_DECL_FWRITE_UNLOCKED | ||
| 93 | # undef fwrite | ||
| 94 | # define fwrite(w,x,y,z) fwrite_unlocked (w,x,y,z) | ||
| 95 | # else | ||
| 96 | # define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z) | ||
| 97 | # endif | ||
| 98 | |||
| 99 | # if HAVE_DECL_GETC_UNLOCKED | ||
| 100 | # undef getc | ||
| 101 | # define getc(x) getc_unlocked (x) | ||
| 102 | # else | ||
| 103 | # define getc_unlocked(x) getc (x) | ||
| 104 | # endif | ||
| 105 | |||
| 106 | # if HAVE_DECL_GETCHAR_UNLOCKED | ||
| 107 | # undef getchar | ||
| 108 | # define getchar() getchar_unlocked () | ||
| 109 | # else | ||
| 110 | # define getchar_unlocked() getchar () | ||
| 111 | # endif | ||
| 112 | |||
| 113 | # if HAVE_DECL_PUTC_UNLOCKED | ||
| 114 | # undef putc | ||
| 115 | # define putc(x,y) putc_unlocked (x,y) | ||
| 116 | # else | ||
| 117 | # define putc_unlocked(x,y) putc (x,y) | ||
| 118 | # endif | ||
| 119 | |||
| 120 | # if HAVE_DECL_PUTCHAR_UNLOCKED | ||
| 121 | # undef putchar | ||
| 122 | # define putchar(x) putchar_unlocked (x) | ||
| 123 | # else | ||
| 124 | # define putchar_unlocked(x) putchar (x) | ||
| 125 | # endif | ||
| 126 | |||
| 127 | # undef flockfile | ||
| 128 | # define flockfile(x) ((void) 0) | ||
| 129 | |||
| 130 | # undef ftrylockfile | ||
| 131 | # define ftrylockfile(x) 0 | ||
| 132 | |||
| 133 | # undef funlockfile | ||
| 134 | # define funlockfile(x) ((void) 0) | ||
| 135 | |||
| 136 | #endif /* UNLOCKED_IO_H */ | ||
diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 79291624523..a15386aa1af 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el | |||
| @@ -319,10 +319,12 @@ the list of old buffers.") | |||
| 319 | (defvar auto-revert-tail-pos 0 | 319 | (defvar auto-revert-tail-pos 0 |
| 320 | "Position of last known end of file.") | 320 | "Position of last known end of file.") |
| 321 | 321 | ||
| 322 | (defun auto-revert-find-file-function () | ||
| 323 | (setq-local auto-revert-tail-pos | ||
| 324 | (nth 7 (file-attributes buffer-file-name)))) | ||
| 325 | |||
| 322 | (add-hook 'find-file-hook | 326 | (add-hook 'find-file-hook |
| 323 | (lambda () | 327 | #'auto-revert-find-file-function) |
| 324 | (setq-local auto-revert-tail-pos | ||
| 325 | (nth 7 (file-attributes buffer-file-name))))) | ||
| 326 | 328 | ||
| 327 | (defvar auto-revert-notify-watch-descriptor-hash-list | 329 | (defvar auto-revert-notify-watch-descriptor-hash-list |
| 328 | (make-hash-table :test 'equal) | 330 | (make-hash-table :test 'equal) |
| @@ -341,6 +343,11 @@ This has been reported by a file notification event.") | |||
| 341 | 343 | ||
| 342 | ;; Functions: | 344 | ;; Functions: |
| 343 | 345 | ||
| 346 | (defun auto-revert-remove-current-buffer () | ||
| 347 | "Remove dead buffer from `auto-revert-buffer-list'." | ||
| 348 | (setq auto-revert-buffer-list | ||
| 349 | (delq (current-buffer) auto-revert-buffer-list))) | ||
| 350 | |||
| 344 | ;;;###autoload | 351 | ;;;###autoload |
| 345 | (define-minor-mode auto-revert-mode | 352 | (define-minor-mode auto-revert-mode |
| 346 | "Toggle reverting buffer when the file changes (Auto-Revert Mode). | 353 | "Toggle reverting buffer when the file changes (Auto-Revert Mode). |
| @@ -364,13 +371,10 @@ without being changed in the part that is already in the buffer." | |||
| 364 | (push (current-buffer) auto-revert-buffer-list) | 371 | (push (current-buffer) auto-revert-buffer-list) |
| 365 | (add-hook | 372 | (add-hook |
| 366 | 'kill-buffer-hook | 373 | 'kill-buffer-hook |
| 367 | (lambda () | 374 | #'auto-revert-remove-current-buffer |
| 368 | (setq auto-revert-buffer-list | ||
| 369 | (delq (current-buffer) auto-revert-buffer-list))) | ||
| 370 | nil t)) | 375 | nil t)) |
| 371 | (when auto-revert-use-notify (auto-revert-notify-rm-watch)) | 376 | (when auto-revert-use-notify (auto-revert-notify-rm-watch)) |
| 372 | (setq auto-revert-buffer-list | 377 | (auto-revert-remove-current-buffer)) |
| 373 | (delq (current-buffer) auto-revert-buffer-list))) | ||
| 374 | (auto-revert-set-timer) | 378 | (auto-revert-set-timer) |
| 375 | (when auto-revert-mode | 379 | (when auto-revert-mode |
| 376 | (auto-revert-buffers) | 380 | (auto-revert-buffers) |
| @@ -786,24 +790,24 @@ the timer when no buffers need to be checked." | |||
| 786 | (not (and auto-revert-stop-on-user-input | 790 | (not (and auto-revert-stop-on-user-input |
| 787 | (input-pending-p)))) | 791 | (input-pending-p)))) |
| 788 | (let ((buf (car bufs))) | 792 | (let ((buf (car bufs))) |
| 789 | (if (buffer-live-p buf) | 793 | (with-current-buffer buf |
| 790 | (with-current-buffer buf | 794 | (if (buffer-live-p buf) |
| 791 | ;; Test if someone has turned off Auto-Revert Mode in a | 795 | (progn |
| 792 | ;; non-standard way, for example by changing major mode. | 796 | ;; Test if someone has turned off Auto-Revert Mode |
| 793 | (if (and (not auto-revert-mode) | 797 | ;; in a non-standard way, for example by changing |
| 794 | (not auto-revert-tail-mode) | 798 | ;; major mode. |
| 795 | (memq buf auto-revert-buffer-list)) | 799 | (if (and (not auto-revert-mode) |
| 796 | (setq auto-revert-buffer-list | 800 | (not auto-revert-tail-mode) |
| 797 | (delq buf auto-revert-buffer-list))) | 801 | (memq buf auto-revert-buffer-list)) |
| 798 | (when (auto-revert-active-p) | 802 | (auto-revert-remove-current-buffer)) |
| 799 | ;; Enable file notification. | 803 | (when (auto-revert-active-p) |
| 800 | (when (and auto-revert-use-notify | 804 | ;; Enable file notification. |
| 801 | (not auto-revert-notify-watch-descriptor)) | 805 | (when (and auto-revert-use-notify |
| 802 | (auto-revert-notify-add-watch)) | 806 | (not auto-revert-notify-watch-descriptor)) |
| 803 | (auto-revert-handler))) | 807 | (auto-revert-notify-add-watch)) |
| 804 | ;; Remove dead buffer from `auto-revert-buffer-list'. | 808 | (auto-revert-handler))) |
| 805 | (setq auto-revert-buffer-list | 809 | ;; Remove dead buffer from `auto-revert-buffer-list'. |
| 806 | (delq buf auto-revert-buffer-list)))) | 810 | (auto-revert-remove-current-buffer)))) |
| 807 | (setq bufs (cdr bufs))) | 811 | (setq bufs (cdr bufs))) |
| 808 | (setq auto-revert-remaining-buffers bufs) | 812 | (setq auto-revert-remaining-buffers bufs) |
| 809 | ;; Check if we should cancel the timer. | 813 | ;; Check if we should cancel the timer. |
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 0e3715eb4cf..a8074eaeb20 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el | |||
| @@ -825,21 +825,18 @@ If COMP or STD is non-nil, put that in the units table instead." | |||
| 825 | (forward-char -1)) | 825 | (forward-char -1)) |
| 826 | (insert ";;; Custom units stored by Calc on " (current-time-string) "\n") | 826 | (insert ";;; Custom units stored by Calc on " (current-time-string) "\n") |
| 827 | (if math-additional-units | 827 | (if math-additional-units |
| 828 | (progn | 828 | (let (expr) |
| 829 | (insert "(setq math-additional-units '(\n") | 829 | (insert "(setq math-additional-units '(\n") |
| 830 | (let ((list math-additional-units)) | 830 | (dolist (u math-additional-units) |
| 831 | (while list | 831 | (insert " (" (symbol-name (car u)) " " |
| 832 | (insert " (" (symbol-name (car (car list))) " " | 832 | (if (setq expr (nth 1 u)) |
| 833 | (if (nth 1 (car list)) | 833 | (if (stringp expr) |
| 834 | (if (stringp (nth 1 (car list))) | 834 | (prin1-to-string expr) |
| 835 | (prin1-to-string (nth 1 (car list))) | 835 | (prin1-to-string (math-format-flat-expr expr 0))) |
| 836 | (prin1-to-string (math-format-flat-expr | 836 | "nil") |
| 837 | (nth 1 (car list)) 0))) | 837 | " " |
| 838 | "nil") | 838 | (prin1-to-string (nth 2 u)) |
| 839 | " " | 839 | ")\n")) |
| 840 | (prin1-to-string (nth 2 (car list))) | ||
| 841 | ")\n") | ||
| 842 | (setq list (cdr list)))) | ||
| 843 | (insert "))\n")) | 840 | (insert "))\n")) |
| 844 | (insert ";;; (no custom units defined)\n")) | 841 | (insert ";;; (no custom units defined)\n")) |
| 845 | (insert ";;; End of custom units\n") | 842 | (insert ";;; End of custom units\n") |
| @@ -916,15 +913,13 @@ If COMP or STD is non-nil, put that in the units table instead." | |||
| 916 | (defun math-find-base-units-rec (expr pow) | 913 | (defun math-find-base-units-rec (expr pow) |
| 917 | (let ((u (math-check-unit-name expr))) | 914 | (let ((u (math-check-unit-name expr))) |
| 918 | (cond (u | 915 | (cond (u |
| 919 | (let ((ulist (math-find-base-units u))) | 916 | (dolist (x (math-find-base-units u)) |
| 920 | (while ulist | 917 | (let ((p (* (cdr x) pow)) |
| 921 | (let ((p (* (cdr (car ulist)) pow)) | 918 | (old (assq (car x) math-fbu-base))) |
| 922 | (old (assq (car (car ulist)) math-fbu-base))) | 919 | (if old |
| 923 | (if old | 920 | (setcdr old (+ (cdr old) p)) |
| 924 | (setcdr old (+ (cdr old) p)) | 921 | (setq math-fbu-base |
| 925 | (setq math-fbu-base | 922 | (cons (cons (car x) p) math-fbu-base)))))) |
| 926 | (cons (cons (car (car ulist)) p) math-fbu-base)))) | ||
| 927 | (setq ulist (cdr ulist))))) | ||
| 928 | ((math-scalarp expr)) | 923 | ((math-scalarp expr)) |
| 929 | ((and (eq (car expr) '^) | 924 | ((and (eq (car expr) '^) |
| 930 | (integerp (nth 2 expr))) | 925 | (integerp (nth 2 expr))) |
| @@ -1377,20 +1372,15 @@ If COMP or STD is non-nil, put that in the units table instead." | |||
| 1377 | (if (eq pow1 1) | 1372 | (if (eq pow1 1) |
| 1378 | (math-to-standard-units (list '/ n d) nil) | 1373 | (math-to-standard-units (list '/ n d) nil) |
| 1379 | (list '^ (math-to-standard-units (list '/ n d) nil) pow1)) | 1374 | (list '^ (math-to-standard-units (list '/ n d) nil) pow1)) |
| 1380 | (let (ud1) | 1375 | (setq un (nth 4 un) |
| 1381 | (setq un (nth 4 un) | 1376 | ud (nth 4 ud)) |
| 1382 | ud (nth 4 ud)) | 1377 | (dolist (x un) |
| 1383 | (while un | 1378 | (dolist (y ud) |
| 1384 | (setq ud1 ud) | 1379 | (when (eq (car x) (car y)) |
| 1385 | (while ud1 | 1380 | (setq math-try-cancel-units |
| 1386 | (and (eq (car (car un)) (car (car ud1))) | 1381 | (+ math-try-cancel-units |
| 1387 | (setq math-try-cancel-units | 1382 | (- (* (cdr x) pow1) |
| 1388 | (+ math-try-cancel-units | 1383 | (* (cdr (car ud)) pow2)))))))))))) |
| 1389 | (- (* (cdr (car un)) pow1) | ||
| 1390 | (* (cdr (car ud)) pow2))))) | ||
| 1391 | (setq ud1 (cdr ud1))) | ||
| 1392 | (setq un (cdr un))) | ||
| 1393 | nil)))))) | ||
| 1394 | 1384 | ||
| 1395 | (math-defsimplify ^ | 1385 | (math-defsimplify ^ |
| 1396 | (and math-simplifying-units | 1386 | (and math-simplifying-units |
| @@ -1578,9 +1568,8 @@ If COMP or STD is non-nil, put that in the units table instead." | |||
| 1578 | (insert "Calculator Units Table:\n\n") | 1568 | (insert "Calculator Units Table:\n\n") |
| 1579 | (insert "(All definitions are exact unless marked with an asterisk (*).)\n\n") | 1569 | (insert "(All definitions are exact unless marked with an asterisk (*).)\n\n") |
| 1580 | (insert "Unit Type Definition Description\n\n") | 1570 | (insert "Unit Type Definition Description\n\n") |
| 1581 | (while uptr | 1571 | (dolist (u uptr) |
| 1582 | (setq u (car uptr) | 1572 | (setq name (nth 2 u)) |
| 1583 | name (nth 2 u)) | ||
| 1584 | (when (eq (car u) 'm) | 1573 | (when (eq (car u) 'm) |
| 1585 | (setq std t)) | 1574 | (setq std t)) |
| 1586 | (setq shadowed (and std (assq (car u) math-additional-units))) | 1575 | (setq shadowed (and std (assq (car u) math-additional-units))) |
| @@ -1618,8 +1607,7 @@ If COMP or STD is non-nil, put that in the units table instead." | |||
| 1618 | (insert " (redefined above)") | 1607 | (insert " (redefined above)") |
| 1619 | (unless (nth 1 u) | 1608 | (unless (nth 1 u) |
| 1620 | (insert " (base unit)"))) | 1609 | (insert " (base unit)"))) |
| 1621 | (insert "\n") | 1610 | (insert "\n")) |
| 1622 | (setq uptr (cdr uptr))) | ||
| 1623 | (insert "\n\nUnit Prefix Table:\n\n") | 1611 | (insert "\n\nUnit Prefix Table:\n\n") |
| 1624 | (setq uptr math-unit-prefixes) | 1612 | (setq uptr math-unit-prefixes) |
| 1625 | (while uptr | 1613 | (while uptr |
diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 6a6a8ea4479..6f36bbed680 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el | |||
| @@ -413,12 +413,11 @@ relevant to POS." | |||
| 413 | (multibyte-p enable-multibyte-characters) | 413 | (multibyte-p enable-multibyte-characters) |
| 414 | (overlays (mapcar (lambda (o) (overlay-properties o)) | 414 | (overlays (mapcar (lambda (o) (overlay-properties o)) |
| 415 | (overlays-at pos))) | 415 | (overlays-at pos))) |
| 416 | (char-description (if (not multibyte-p) | 416 | (char-description (if (< char 128) |
| 417 | (single-key-description char) | 417 | (single-key-description char) |
| 418 | (if (< char 128) | 418 | (string (if (not multibyte-p) |
| 419 | (single-key-description char) | 419 | (decode-char 'eight-bit char) |
| 420 | (string-to-multibyte | 420 | char)))) |
| 421 | (char-to-string char))))) | ||
| 422 | (text-props-desc | 421 | (text-props-desc |
| 423 | (let ((tmp-buf (generate-new-buffer " *text-props*"))) | 422 | (let ((tmp-buf (generate-new-buffer " *text-props*"))) |
| 424 | (unwind-protect | 423 | (unwind-protect |
| @@ -635,7 +634,9 @@ relevant to POS." | |||
| 635 | ("buffer code" | 634 | ("buffer code" |
| 636 | ,(if multibyte-p | 635 | ,(if multibyte-p |
| 637 | (encoded-string-description | 636 | (encoded-string-description |
| 638 | (string-as-unibyte (char-to-string char)) nil) | 637 | (encode-coding-string (char-to-string char) |
| 638 | 'emacs-internal) | ||
| 639 | nil) | ||
| 639 | (format "#x%02X" char))) | 640 | (format "#x%02X" char))) |
| 640 | ("file code" | 641 | ("file code" |
| 641 | ,@(if multibyte-p | 642 | ,@(if multibyte-p |
| @@ -704,7 +705,6 @@ relevant to POS." | |||
| 704 | (called-interactively-p 'interactive)) | 705 | (called-interactively-p 'interactive)) |
| 705 | (with-help-window (help-buffer) | 706 | (with-help-window (help-buffer) |
| 706 | (with-current-buffer standard-output | 707 | (with-current-buffer standard-output |
| 707 | (set-buffer-multibyte multibyte-p) | ||
| 708 | (let ((formatter (format "%%%ds:" max-width))) | 708 | (let ((formatter (format "%%%ds:" max-width))) |
| 709 | (dolist (elt item-list) | 709 | (dolist (elt item-list) |
| 710 | (when (cadr elt) | 710 | (when (cadr elt) |
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index ec07f9bf735..12a97f8457e 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -51,6 +51,33 @@ into this list; they also should call `dired-log' to log the errors.") | |||
| 51 | 51 | ||
| 52 | (defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)") | 52 | (defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)") |
| 53 | (defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)") | 53 | (defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)") |
| 54 | (make-obsolete-variable 'dired-star-subst-regexp nil "26.1") | ||
| 55 | (make-obsolete-variable 'dired-quark-subst-regexp nil "26.1") | ||
| 56 | |||
| 57 | (defun dired-isolated-string-re (string) | ||
| 58 | "Return a regexp to match STRING isolated. | ||
| 59 | Isolated means that STRING is surrounded by spaces or at the beginning/end | ||
| 60 | of a string followed/prefixed with an space. | ||
| 61 | The regexp capture the preceding blank, STRING and the following blank as | ||
| 62 | the groups 1, 2 and 3 respectively." | ||
| 63 | (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) | ||
| 64 | |||
| 65 | (defun dired--star-or-qmark-p (string match &optional keep) | ||
| 66 | "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. | ||
| 67 | MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter | ||
| 68 | means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". | ||
| 69 | If optional arg KEEP is non-nil, then preserve the match data. Otherwise, | ||
| 70 | this function changes it and saves MATCH as the second match group. | ||
| 71 | |||
| 72 | Isolated means that MATCH is surrounded by spaces or at the beginning/end | ||
| 73 | of STRING followed/prefixed with an space. A match to `\\=`?\\=`', | ||
| 74 | isolated or not, is also valid." | ||
| 75 | (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) | ||
| 76 | (when (or (null match) (equal match "?")) | ||
| 77 | (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) | ||
| 78 | (cl-some (lambda (x) | ||
| 79 | (funcall (if keep #'string-match-p #'string-match) x string)) | ||
| 80 | regexps))) | ||
| 54 | 81 | ||
| 55 | ;;;###autoload | 82 | ;;;###autoload |
| 56 | (defun dired-diff (file &optional switches) | 83 | (defun dired-diff (file &optional switches) |
| @@ -308,7 +335,7 @@ List has a form of (file-name full-file-name (attribute-list))." | |||
| 308 | failures) | 335 | failures) |
| 309 | (setq failures | 336 | (setq failures |
| 310 | (dired-bunch-files 10000 | 337 | (dired-bunch-files 10000 |
| 311 | (function dired-check-process) | 338 | #'dired-check-process |
| 312 | (append | 339 | (append |
| 313 | (list operation program) | 340 | (list operation program) |
| 314 | (unless (or (string-equal new-attribute "") | 341 | (unless (or (string-equal new-attribute "") |
| @@ -512,7 +539,7 @@ with a prefix argument." | |||
| 512 | ;; If the file has numeric backup versions, | 539 | ;; If the file has numeric backup versions, |
| 513 | ;; put on dired-file-version-alist an element of the form | 540 | ;; put on dired-file-version-alist an element of the form |
| 514 | ;; (FILENAME . VERSION-NUMBER-LIST) | 541 | ;; (FILENAME . VERSION-NUMBER-LIST) |
| 515 | (dired-map-dired-file-lines (function dired-collect-file-versions)) | 542 | (dired-map-dired-file-lines #'dired-collect-file-versions) |
| 516 | ;; Sort each VERSION-NUMBER-LIST, | 543 | ;; Sort each VERSION-NUMBER-LIST, |
| 517 | ;; and remove the versions not to be deleted. | 544 | ;; and remove the versions not to be deleted. |
| 518 | (let ((fval dired-file-version-alist)) | 545 | (let ((fval dired-file-version-alist)) |
| @@ -528,7 +555,7 @@ with a prefix argument." | |||
| 528 | (setq fval (cdr fval)))) | 555 | (setq fval (cdr fval)))) |
| 529 | ;; Look at each file. If it is a numeric backup file, | 556 | ;; Look at each file. If it is a numeric backup file, |
| 530 | ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion. | 557 | ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion. |
| 531 | (dired-map-dired-file-lines (function dired-trample-file-versions)) | 558 | (dired-map-dired-file-lines #'dired-trample-file-versions) |
| 532 | (message "Cleaning numerical backups...done"))) | 559 | (message "Cleaning numerical backups...done"))) |
| 533 | 560 | ||
| 534 | ;;; Subroutines of dired-clean-directory. | 561 | ;;; Subroutines of dired-clean-directory. |
| @@ -658,13 +685,13 @@ If there is a `*' in COMMAND, surrounded by whitespace, this runs | |||
| 658 | COMMAND just once with the entire file list substituted there. | 685 | COMMAND just once with the entire file list substituted there. |
| 659 | 686 | ||
| 660 | If there is no `*', but there is a `?' in COMMAND, surrounded by | 687 | If there is no `*', but there is a `?' in COMMAND, surrounded by |
| 661 | whitespace, this runs COMMAND on each file individually with the | 688 | whitespace, or a `\\=`?\\=`' this runs COMMAND on each file |
| 662 | file name substituted for `?'. | 689 | individually with the file name substituted for `?' or `\\=`?\\=`'. |
| 663 | 690 | ||
| 664 | Otherwise, this runs COMMAND on each file individually with the | 691 | Otherwise, this runs COMMAND on each file individually with the |
| 665 | file name added at the end of COMMAND (separated by a space). | 692 | file name added at the end of COMMAND (separated by a space). |
| 666 | 693 | ||
| 667 | `*' and `?' when not surrounded by whitespace have no special | 694 | `*' and `?' when not surrounded by whitespace nor `\\=`' have no special |
| 668 | significance for `dired-do-shell-command', and are passed through | 695 | significance for `dired-do-shell-command', and are passed through |
| 669 | normally to the shell, but you must confirm first. | 696 | normally to the shell, but you must confirm first. |
| 670 | 697 | ||
| @@ -704,32 +731,40 @@ can be produced by `dired-get-marked-files', for example." | |||
| 704 | (dired-read-shell-command "! on %s: " current-prefix-arg files) | 731 | (dired-read-shell-command "! on %s: " current-prefix-arg files) |
| 705 | current-prefix-arg | 732 | current-prefix-arg |
| 706 | files))) | 733 | files))) |
| 707 | (let* ((on-each (not (string-match-p dired-star-subst-regexp command))) | 734 | (cl-flet ((need-confirm-p |
| 708 | (no-subst (not (string-match-p dired-quark-subst-regexp command))) | 735 | (cmd str) |
| 709 | (star (string-match-p "\\*" command)) | 736 | (let ((res cmd) |
| 710 | (qmark (string-match-p "\\?" command))) | 737 | (regexp (regexp-quote str))) |
| 711 | ;; Get confirmation for wildcards that may have been meant | 738 | ;; Drop all ? and * surrounded by spaces and `?`. |
| 712 | ;; to control substitution of a file name or the file name list. | 739 | (while (and (string-match regexp res) |
| 713 | (if (cond ((not (or on-each no-subst)) | 740 | (dired--star-or-qmark-p res str)) |
| 714 | (error "You can not combine `*' and `?' substitution marks")) | 741 | (setq res (replace-match "" t t res 0))) |
| 715 | ((and star on-each) | 742 | (string-match regexp res)))) |
| 716 | (y-or-n-p (format-message | 743 | (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) |
| 717 | "Confirm--do you mean to use `*' as a wildcard? "))) | 744 | (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) |
| 718 | ((and qmark no-subst) | 745 | (star (string-match "\\*" command)) |
| 719 | (y-or-n-p (format-message | 746 | (qmark (string-match "\\?" command)) |
| 720 | "Confirm--do you mean to use `?' as a wildcard? "))) | 747 | ;; Get confirmation for wildcards that may have been meant |
| 721 | (t)) | 748 | ;; to control substitution of a file name or the file name list. |
| 722 | (if on-each | 749 | (ok (cond ((not (or on-each no-subst)) |
| 723 | (dired-bunch-files | 750 | (error "You can not combine `*' and `?' substitution marks")) |
| 724 | (- 10000 (length command)) | 751 | ((need-confirm-p command "*") |
| 725 | (function (lambda (&rest files) | 752 | (y-or-n-p (format-message |
| 726 | (dired-run-shell-command | 753 | "Confirm--do you mean to use `*' as a wildcard? "))) |
| 727 | (dired-shell-stuff-it command files t arg)))) | 754 | ((need-confirm-p command "?") |
| 728 | nil | 755 | (y-or-n-p (format-message |
| 729 | file-list) | 756 | "Confirm--do you mean to use `?' as a wildcard? "))) |
| 730 | ;; execute the shell command | 757 | (t)))) |
| 731 | (dired-run-shell-command | 758 | (when ok |
| 732 | (dired-shell-stuff-it command file-list nil arg)))))) | 759 | (if on-each |
| 760 | (dired-bunch-files (- 10000 (length command)) | ||
| 761 | (lambda (&rest files) | ||
| 762 | (dired-run-shell-command | ||
| 763 | (dired-shell-stuff-it command files t arg))) | ||
| 764 | nil file-list) | ||
| 765 | ;; execute the shell command | ||
| 766 | (dired-run-shell-command | ||
| 767 | (dired-shell-stuff-it command file-list nil arg))))))) | ||
| 733 | 768 | ||
| 734 | ;; Might use {,} for bash or csh: | 769 | ;; Might use {,} for bash or csh: |
| 735 | (defvar dired-mark-prefix "" | 770 | (defvar dired-mark-prefix "" |
| @@ -769,12 +804,10 @@ can be produced by `dired-get-marked-files', for example." | |||
| 769 | ";" | 804 | ";" |
| 770 | "&")) | 805 | "&")) |
| 771 | (stuff-it | 806 | (stuff-it |
| 772 | (if (or (string-match-p dired-star-subst-regexp command) | 807 | (if (dired--star-or-qmark-p command nil 'keep) |
| 773 | (string-match-p dired-quark-subst-regexp command)) | ||
| 774 | (lambda (x) | 808 | (lambda (x) |
| 775 | (let ((retval (concat cmd-prefix command))) | 809 | (let ((retval (concat cmd-prefix command))) |
| 776 | (while (string-match | 810 | (while (dired--star-or-qmark-p retval nil) |
| 777 | "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) | ||
| 778 | (setq retval (replace-match x t t retval 2))) | 811 | (setq retval (replace-match x t t retval 2))) |
| 779 | retval)) | 812 | retval)) |
| 780 | (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) | 813 | (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) |
| @@ -1122,7 +1155,7 @@ Return nil if no change in files." | |||
| 1122 | (let ((files (dired-get-marked-files t arg nil t)) | 1155 | (let ((files (dired-get-marked-files t arg nil t)) |
| 1123 | (string (if (eq op-symbol 'compress) "Compress or uncompress" | 1156 | (string (if (eq op-symbol 'compress) "Compress or uncompress" |
| 1124 | (capitalize (symbol-name op-symbol))))) | 1157 | (capitalize (symbol-name op-symbol))))) |
| 1125 | (dired-mark-pop-up nil op-symbol files (function y-or-n-p) | 1158 | (dired-mark-pop-up nil op-symbol files #'y-or-n-p |
| 1126 | (concat string " " | 1159 | (concat string " " |
| 1127 | (dired-mark-prompt arg files) "? "))))) | 1160 | (dired-mark-prompt arg files) "? "))))) |
| 1128 | 1161 | ||
| @@ -1190,7 +1223,7 @@ return t; if SYM is q or ESC, return nil." | |||
| 1190 | (defun dired-do-compress (&optional arg) | 1223 | (defun dired-do-compress (&optional arg) |
| 1191 | "Compress or uncompress marked (or next ARG) files." | 1224 | "Compress or uncompress marked (or next ARG) files." |
| 1192 | (interactive "P") | 1225 | (interactive "P") |
| 1193 | (dired-map-over-marks-check (function dired-compress) arg 'compress t)) | 1226 | (dired-map-over-marks-check #'dired-compress arg 'compress t)) |
| 1194 | 1227 | ||
| 1195 | ;; Commands for Emacs Lisp files - load and byte compile | 1228 | ;; Commands for Emacs Lisp files - load and byte compile |
| 1196 | 1229 | ||
| @@ -1218,7 +1251,7 @@ return t; if SYM is q or ESC, return nil." | |||
| 1218 | (defun dired-do-byte-compile (&optional arg) | 1251 | (defun dired-do-byte-compile (&optional arg) |
| 1219 | "Byte compile marked (or next ARG) Emacs Lisp files." | 1252 | "Byte compile marked (or next ARG) Emacs Lisp files." |
| 1220 | (interactive "P") | 1253 | (interactive "P") |
| 1221 | (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t)) | 1254 | (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t)) |
| 1222 | 1255 | ||
| 1223 | (defun dired-load () | 1256 | (defun dired-load () |
| 1224 | ;; Return nil for success, offending file name else. | 1257 | ;; Return nil for success, offending file name else. |
| @@ -1235,7 +1268,7 @@ return t; if SYM is q or ESC, return nil." | |||
| 1235 | (defun dired-do-load (&optional arg) | 1268 | (defun dired-do-load (&optional arg) |
| 1236 | "Load the marked (or next ARG) Emacs Lisp files." | 1269 | "Load the marked (or next ARG) Emacs Lisp files." |
| 1237 | (interactive "P") | 1270 | (interactive "P") |
| 1238 | (dired-map-over-marks-check (function dired-load) arg 'load t)) | 1271 | (dired-map-over-marks-check #'dired-load arg 'load t)) |
| 1239 | 1272 | ||
| 1240 | ;;;###autoload | 1273 | ;;;###autoload |
| 1241 | (defun dired-do-redisplay (&optional arg test-for-subdir) | 1274 | (defun dired-do-redisplay (&optional arg test-for-subdir) |
| @@ -1308,7 +1341,7 @@ See Info node `(emacs)Subdir switches' for more details." | |||
| 1308 | (defun dired-add-file (filename &optional marker-char) | 1341 | (defun dired-add-file (filename &optional marker-char) |
| 1309 | (dired-fun-in-all-buffers | 1342 | (dired-fun-in-all-buffers |
| 1310 | (file-name-directory filename) (file-name-nondirectory filename) | 1343 | (file-name-directory filename) (file-name-nondirectory filename) |
| 1311 | (function dired-add-entry) filename marker-char)) | 1344 | #'dired-add-entry filename marker-char)) |
| 1312 | 1345 | ||
| 1313 | (defvar dired-omit-mode) | 1346 | (defvar dired-omit-mode) |
| 1314 | (declare-function dired-omit-regexp "dired-x" ()) | 1347 | (declare-function dired-omit-regexp "dired-x" ()) |
| @@ -1445,7 +1478,7 @@ files matching `dired-omit-regexp'." | |||
| 1445 | (defun dired-remove-file (file) | 1478 | (defun dired-remove-file (file) |
| 1446 | (dired-fun-in-all-buffers | 1479 | (dired-fun-in-all-buffers |
| 1447 | (file-name-directory file) (file-name-nondirectory file) | 1480 | (file-name-directory file) (file-name-nondirectory file) |
| 1448 | (function dired-remove-entry) file)) | 1481 | #'dired-remove-entry file)) |
| 1449 | 1482 | ||
| 1450 | (defun dired-remove-entry (file) | 1483 | (defun dired-remove-entry (file) |
| 1451 | (save-excursion | 1484 | (save-excursion |
| @@ -1459,7 +1492,7 @@ files matching `dired-omit-regexp'." | |||
| 1459 | "Create or update the line for FILE in all Dired buffers it would belong in." | 1492 | "Create or update the line for FILE in all Dired buffers it would belong in." |
| 1460 | (dired-fun-in-all-buffers (file-name-directory file) | 1493 | (dired-fun-in-all-buffers (file-name-directory file) |
| 1461 | (file-name-nondirectory file) | 1494 | (file-name-nondirectory file) |
| 1462 | (function dired-relist-entry) file)) | 1495 | #'dired-relist-entry file)) |
| 1463 | 1496 | ||
| 1464 | (defun dired-relist-entry (file) | 1497 | (defun dired-relist-entry (file) |
| 1465 | ;; Relist the line for FILE, or just add it if it did not exist. | 1498 | ;; Relist the line for FILE, or just add it if it did not exist. |
| @@ -1553,7 +1586,7 @@ Special value `always' suppresses confirmation." | |||
| 1553 | (setq from-dir (file-name-as-directory from-dir) | 1586 | (setq from-dir (file-name-as-directory from-dir) |
| 1554 | to-dir (file-name-as-directory to-dir)) | 1587 | to-dir (file-name-as-directory to-dir)) |
| 1555 | (dired-fun-in-all-buffers from-dir nil | 1588 | (dired-fun-in-all-buffers from-dir nil |
| 1556 | (function dired-rename-subdir-1) from-dir to-dir) | 1589 | #'dired-rename-subdir-1 from-dir to-dir) |
| 1557 | ;; Update visited file name of all affected buffers | 1590 | ;; Update visited file name of all affected buffers |
| 1558 | (let ((expanded-from-dir (expand-file-name from-dir)) | 1591 | (let ((expanded-from-dir (expand-file-name from-dir)) |
| 1559 | (blist (buffer-list))) | 1592 | (blist (buffer-list))) |
| @@ -1788,7 +1821,7 @@ Optional arg HOW-TO determines how to treat the target. | |||
| 1788 | For any other return value, TARGET is treated as a directory." | 1821 | For any other return value, TARGET is treated as a directory." |
| 1789 | (or op1 (setq op1 operation)) | 1822 | (or op1 (setq op1 operation)) |
| 1790 | (let* ((fn-list (dired-get-marked-files nil arg)) | 1823 | (let* ((fn-list (dired-get-marked-files nil arg)) |
| 1791 | (rfn-list (mapcar (function dired-make-relative) fn-list)) | 1824 | (rfn-list (mapcar #'dired-make-relative fn-list)) |
| 1792 | (dired-one-file ; fluid variable inside dired-create-files | 1825 | (dired-one-file ; fluid variable inside dired-create-files |
| 1793 | (and (consp fn-list) (null (cdr fn-list)) (car fn-list))) | 1826 | (and (consp fn-list) (null (cdr fn-list)) (car fn-list))) |
| 1794 | (target-dir (dired-dwim-target-directory)) | 1827 | (target-dir (dired-dwim-target-directory)) |
| @@ -1838,10 +1871,9 @@ Optional arg HOW-TO determines how to treat the target. | |||
| 1838 | (if into-dir ; target is a directory | 1871 | (if into-dir ; target is a directory |
| 1839 | ;; This function uses fluid variable target when called | 1872 | ;; This function uses fluid variable target when called |
| 1840 | ;; inside dired-create-files: | 1873 | ;; inside dired-create-files: |
| 1841 | (function | 1874 | (lambda (from) |
| 1842 | (lambda (from) | 1875 | (expand-file-name (file-name-nondirectory from) target)) |
| 1843 | (expand-file-name (file-name-nondirectory from) target))) | 1876 | (lambda (_from) target)) |
| 1844 | (function (lambda (_from) target))) | ||
| 1845 | marker-char)))) | 1877 | marker-char)))) |
| 1846 | 1878 | ||
| 1847 | ;; Read arguments for a marked-files command that wants a file name, | 1879 | ;; Read arguments for a marked-files command that wants a file name, |
| @@ -1857,7 +1889,7 @@ Optional arg HOW-TO determines how to treat the target. | |||
| 1857 | &optional default) | 1889 | &optional default) |
| 1858 | (dired-mark-pop-up | 1890 | (dired-mark-pop-up |
| 1859 | nil op-symbol files | 1891 | nil op-symbol files |
| 1860 | (function read-file-name) | 1892 | #'read-file-name |
| 1861 | (format prompt (dired-mark-prompt arg files)) dir default)) | 1893 | (format prompt (dired-mark-prompt arg files)) dir default)) |
| 1862 | 1894 | ||
| 1863 | (defun dired-dwim-target-directory () | 1895 | (defun dired-dwim-target-directory () |
| @@ -1985,7 +2017,7 @@ This command copies symbolic links by creating new ones, similar | |||
| 1985 | to the \"-d\" option for the \"cp\" shell command." | 2017 | to the \"-d\" option for the \"cp\" shell command." |
| 1986 | (interactive "P") | 2018 | (interactive "P") |
| 1987 | (let ((dired-recursive-copies dired-recursive-copies)) | 2019 | (let ((dired-recursive-copies dired-recursive-copies)) |
| 1988 | (dired-do-create-files 'copy (function dired-copy-file) | 2020 | (dired-do-create-files 'copy #'dired-copy-file |
| 1989 | "Copy" | 2021 | "Copy" |
| 1990 | arg dired-keep-marker-copy | 2022 | arg dired-keep-marker-copy |
| 1991 | nil dired-copy-how-to-fn))) | 2023 | nil dired-copy-how-to-fn))) |
| @@ -2002,7 +2034,7 @@ suggested for the target directory depends on the value of | |||
| 2002 | 2034 | ||
| 2003 | For relative symlinks, use \\[dired-do-relsymlink]." | 2035 | For relative symlinks, use \\[dired-do-relsymlink]." |
| 2004 | (interactive "P") | 2036 | (interactive "P") |
| 2005 | (dired-do-create-files 'symlink (function make-symbolic-link) | 2037 | (dired-do-create-files 'symlink #'make-symbolic-link |
| 2006 | "Symlink" arg dired-keep-marker-symlink)) | 2038 | "Symlink" arg dired-keep-marker-symlink)) |
| 2007 | 2039 | ||
| 2008 | ;;;###autoload | 2040 | ;;;###autoload |
| @@ -2015,7 +2047,7 @@ with the same names that the files currently have. The default | |||
| 2015 | suggested for the target directory depends on the value of | 2047 | suggested for the target directory depends on the value of |
| 2016 | `dired-dwim-target', which see." | 2048 | `dired-dwim-target', which see." |
| 2017 | (interactive "P") | 2049 | (interactive "P") |
| 2018 | (dired-do-create-files 'hardlink (function dired-hardlink) | 2050 | (dired-do-create-files 'hardlink #'dired-hardlink |
| 2019 | "Hardlink" arg dired-keep-marker-hardlink)) | 2051 | "Hardlink" arg dired-keep-marker-hardlink)) |
| 2020 | 2052 | ||
| 2021 | (defun dired-hardlink (file newname &optional ok-if-already-exists) | 2053 | (defun dired-hardlink (file newname &optional ok-if-already-exists) |
| @@ -2034,7 +2066,7 @@ This command also renames any buffers that are visiting the files. | |||
| 2034 | The default suggested for the target directory depends on the value | 2066 | The default suggested for the target directory depends on the value |
| 2035 | of `dired-dwim-target', which see." | 2067 | of `dired-dwim-target', which see." |
| 2036 | (interactive "P") | 2068 | (interactive "P") |
| 2037 | (dired-do-create-files 'move (function dired-rename-file) | 2069 | (dired-do-create-files 'move #'dired-rename-file |
| 2038 | "Move" arg dired-keep-marker-rename "Rename")) | 2070 | "Move" arg dired-keep-marker-rename "Rename")) |
| 2039 | ;;;###end dired-cp.el | 2071 | ;;;###end dired-cp.el |
| 2040 | 2072 | ||
| @@ -2062,37 +2094,35 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next, | |||
| 2062 | (regexp-name-constructor | 2094 | (regexp-name-constructor |
| 2063 | ;; Function to construct new filename using REGEXP and NEWNAME: | 2095 | ;; Function to construct new filename using REGEXP and NEWNAME: |
| 2064 | (if whole-name ; easy (but rare) case | 2096 | (if whole-name ; easy (but rare) case |
| 2065 | (function | 2097 | (lambda (from) |
| 2066 | (lambda (from) | 2098 | (let ((to (dired-string-replace-match regexp from newname)) |
| 2067 | (let ((to (dired-string-replace-match regexp from newname)) | 2099 | ;; must bind help-form directly around call to |
| 2068 | ;; must bind help-form directly around call to | 2100 | ;; dired-query |
| 2069 | ;; dired-query | ||
| 2070 | (help-form rename-regexp-help-form)) | ||
| 2071 | (if to | ||
| 2072 | (and (dired-query 'rename-regexp-query | ||
| 2073 | operation-prompt | ||
| 2074 | from | ||
| 2075 | to) | ||
| 2076 | to) | ||
| 2077 | (dired-log "%s: %s did not match regexp %s\n" | ||
| 2078 | operation from regexp))))) | ||
| 2079 | ;; not whole-name, replace non-directory part only | ||
| 2080 | (function | ||
| 2081 | (lambda (from) | ||
| 2082 | (let* ((new (dired-string-replace-match | ||
| 2083 | regexp (file-name-nondirectory from) newname)) | ||
| 2084 | (to (and new ; nil means there was no match | ||
| 2085 | (expand-file-name new | ||
| 2086 | (file-name-directory from)))) | ||
| 2087 | (help-form rename-regexp-help-form)) | 2101 | (help-form rename-regexp-help-form)) |
| 2088 | (if to | 2102 | (if to |
| 2089 | (and (dired-query 'rename-regexp-query | 2103 | (and (dired-query 'rename-regexp-query |
| 2090 | operation-prompt | 2104 | operation-prompt |
| 2091 | (dired-make-relative from) | 2105 | from |
| 2092 | (dired-make-relative to)) | 2106 | to) |
| 2093 | to) | 2107 | to) |
| 2094 | (dired-log "%s: %s did not match regexp %s\n" | 2108 | (dired-log "%s: %s did not match regexp %s\n" |
| 2095 | operation (file-name-nondirectory from) regexp))))))) | 2109 | operation from regexp)))) |
| 2110 | ;; not whole-name, replace non-directory part only | ||
| 2111 | (lambda (from) | ||
| 2112 | (let* ((new (dired-string-replace-match | ||
| 2113 | regexp (file-name-nondirectory from) newname)) | ||
| 2114 | (to (and new ; nil means there was no match | ||
| 2115 | (expand-file-name new | ||
| 2116 | (file-name-directory from)))) | ||
| 2117 | (help-form rename-regexp-help-form)) | ||
| 2118 | (if to | ||
| 2119 | (and (dired-query 'rename-regexp-query | ||
| 2120 | operation-prompt | ||
| 2121 | (dired-make-relative from) | ||
| 2122 | (dired-make-relative to)) | ||
| 2123 | to) | ||
| 2124 | (dired-log "%s: %s did not match regexp %s\n" | ||
| 2125 | operation (file-name-nondirectory from) regexp)))))) | ||
| 2096 | rename-regexp-query) | 2126 | rename-regexp-query) |
| 2097 | (dired-create-files | 2127 | (dired-create-files |
| 2098 | file-creator operation fn-list regexp-name-constructor marker-char))) | 2128 | file-creator operation fn-list regexp-name-constructor marker-char))) |
| @@ -2130,7 +2160,7 @@ With a zero prefix arg, renaming by regexp affects the absolute file name. | |||
| 2130 | Normally, only the non-directory part of the file name is used and changed." | 2160 | Normally, only the non-directory part of the file name is used and changed." |
| 2131 | (interactive (dired-mark-read-regexp "Rename")) | 2161 | (interactive (dired-mark-read-regexp "Rename")) |
| 2132 | (dired-do-create-files-regexp | 2162 | (dired-do-create-files-regexp |
| 2133 | (function dired-rename-file) | 2163 | #'dired-rename-file |
| 2134 | "Rename" arg regexp newname whole-name dired-keep-marker-rename)) | 2164 | "Rename" arg regexp newname whole-name dired-keep-marker-rename)) |
| 2135 | 2165 | ||
| 2136 | ;;;###autoload | 2166 | ;;;###autoload |
| @@ -2140,7 +2170,7 @@ See function `dired-do-rename-regexp' for more info." | |||
| 2140 | (interactive (dired-mark-read-regexp "Copy")) | 2170 | (interactive (dired-mark-read-regexp "Copy")) |
| 2141 | (let ((dired-recursive-copies nil)) ; No recursive copies. | 2171 | (let ((dired-recursive-copies nil)) ; No recursive copies. |
| 2142 | (dired-do-create-files-regexp | 2172 | (dired-do-create-files-regexp |
| 2143 | (function dired-copy-file) | 2173 | #'dired-copy-file |
| 2144 | (if dired-copy-preserve-time "Copy [-p]" "Copy") | 2174 | (if dired-copy-preserve-time "Copy [-p]" "Copy") |
| 2145 | arg regexp newname whole-name dired-keep-marker-copy))) | 2175 | arg regexp newname whole-name dired-keep-marker-copy))) |
| 2146 | 2176 | ||
| @@ -2150,7 +2180,7 @@ See function `dired-do-rename-regexp' for more info." | |||
| 2150 | See function `dired-do-rename-regexp' for more info." | 2180 | See function `dired-do-rename-regexp' for more info." |
| 2151 | (interactive (dired-mark-read-regexp "HardLink")) | 2181 | (interactive (dired-mark-read-regexp "HardLink")) |
| 2152 | (dired-do-create-files-regexp | 2182 | (dired-do-create-files-regexp |
| 2153 | (function add-name-to-file) | 2183 | #'add-name-to-file |
| 2154 | "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink)) | 2184 | "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink)) |
| 2155 | 2185 | ||
| 2156 | ;;;###autoload | 2186 | ;;;###autoload |
| @@ -2159,7 +2189,7 @@ See function `dired-do-rename-regexp' for more info." | |||
| 2159 | See function `dired-do-rename-regexp' for more info." | 2189 | See function `dired-do-rename-regexp' for more info." |
| 2160 | (interactive (dired-mark-read-regexp "SymLink")) | 2190 | (interactive (dired-mark-read-regexp "SymLink")) |
| 2161 | (dired-do-create-files-regexp | 2191 | (dired-do-create-files-regexp |
| 2162 | (function make-symbolic-link) | 2192 | #'make-symbolic-link |
| 2163 | "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) | 2193 | "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) |
| 2164 | 2194 | ||
| 2165 | (defvar rename-non-directory-query) | 2195 | (defvar rename-non-directory-query) |
| @@ -2174,39 +2204,38 @@ See function `dired-do-rename-regexp' for more info." | |||
| 2174 | file-creator | 2204 | file-creator |
| 2175 | operation | 2205 | operation |
| 2176 | (dired-get-marked-files nil arg) | 2206 | (dired-get-marked-files nil arg) |
| 2177 | (function | 2207 | (lambda (from) |
| 2178 | (lambda (from) | 2208 | (let ((to (concat (file-name-directory from) |
| 2179 | (let ((to (concat (file-name-directory from) | 2209 | (funcall basename-constructor |
| 2180 | (funcall basename-constructor | 2210 | (file-name-nondirectory from))))) |
| 2181 | (file-name-nondirectory from))))) | 2211 | (and (let ((help-form (format-message "\ |
| 2182 | (and (let ((help-form (format-message "\ | ||
| 2183 | Type SPC or `y' to %s one file, DEL or `n' to skip to next, | 2212 | Type SPC or `y' to %s one file, DEL or `n' to skip to next, |
| 2184 | `!' to %s all remaining matches with no more questions." | 2213 | `!' to %s all remaining matches with no more questions." |
| 2185 | (downcase operation) | 2214 | (downcase operation) |
| 2186 | (downcase operation)))) | 2215 | (downcase operation)))) |
| 2187 | (dired-query 'rename-non-directory-query | 2216 | (dired-query 'rename-non-directory-query |
| 2188 | (concat operation " `%s' to `%s'") | 2217 | (concat operation " `%s' to `%s'") |
| 2189 | (dired-make-relative from) | 2218 | (dired-make-relative from) |
| 2190 | (dired-make-relative to))) | 2219 | (dired-make-relative to))) |
| 2191 | to)))) | 2220 | to))) |
| 2192 | dired-keep-marker-rename))) | 2221 | dired-keep-marker-rename))) |
| 2193 | 2222 | ||
| 2194 | (defun dired-rename-non-directory (basename-constructor operation arg) | 2223 | (defun dired-rename-non-directory (basename-constructor operation arg) |
| 2195 | (dired-create-files-non-directory | 2224 | (dired-create-files-non-directory |
| 2196 | (function dired-rename-file) | 2225 | #'dired-rename-file |
| 2197 | basename-constructor operation arg)) | 2226 | basename-constructor operation arg)) |
| 2198 | 2227 | ||
| 2199 | ;;;###autoload | 2228 | ;;;###autoload |
| 2200 | (defun dired-upcase (&optional arg) | 2229 | (defun dired-upcase (&optional arg) |
| 2201 | "Rename all marked (or next ARG) files to upper case." | 2230 | "Rename all marked (or next ARG) files to upper case." |
| 2202 | (interactive "P") | 2231 | (interactive "P") |
| 2203 | (dired-rename-non-directory (function upcase) "Rename upcase" arg)) | 2232 | (dired-rename-non-directory #'upcase "Rename upcase" arg)) |
| 2204 | 2233 | ||
| 2205 | ;;;###autoload | 2234 | ;;;###autoload |
| 2206 | (defun dired-downcase (&optional arg) | 2235 | (defun dired-downcase (&optional arg) |
| 2207 | "Rename all marked (or next ARG) files to lower case." | 2236 | "Rename all marked (or next ARG) files to lower case." |
| 2208 | (interactive "P") | 2237 | (interactive "P") |
| 2209 | (dired-rename-non-directory (function downcase) "Rename downcase" arg)) | 2238 | (dired-rename-non-directory #'downcase "Rename downcase" arg)) |
| 2210 | 2239 | ||
| 2211 | ;;;###end dired-re.el | 2240 | ;;;###end dired-re.el |
| 2212 | 2241 | ||
| @@ -2316,12 +2345,11 @@ This function takes some pains to conform to `ls -lR' output." | |||
| 2316 | (when real-switches | 2345 | (when real-switches |
| 2317 | (let (case-fold-search) | 2346 | (let (case-fold-search) |
| 2318 | (mapcar | 2347 | (mapcar |
| 2319 | (function | 2348 | (lambda (x) |
| 2320 | (lambda (x) | 2349 | (or (eq (null (string-match-p x real-switches)) |
| 2321 | (or (eq (null (string-match-p x real-switches)) | 2350 | (null (string-match-p x dired-actual-switches))) |
| 2322 | (null (string-match-p x dired-actual-switches))) | 2351 | (error |
| 2323 | (error | 2352 | "Can't have dirs with and without -%s switches together" x))) |
| 2324 | "Can't have dirs with and without -%s switches together" x)))) | ||
| 2325 | ;; all switches that make a difference to dired-get-filename: | 2353 | ;; all switches that make a difference to dired-get-filename: |
| 2326 | '("F" "b")))))) | 2354 | '("F" "b")))))) |
| 2327 | 2355 | ||
| @@ -2334,9 +2362,9 @@ This function takes some pains to conform to `ls -lR' output." | |||
| 2334 | ;; Keep the alist sorted on buffer position. | 2362 | ;; Keep the alist sorted on buffer position. |
| 2335 | (setq dired-subdir-alist | 2363 | (setq dired-subdir-alist |
| 2336 | (sort dired-subdir-alist | 2364 | (sort dired-subdir-alist |
| 2337 | (function (lambda (elt1 elt2) | 2365 | (lambda (elt1 elt2) |
| 2338 | (> (dired-get-subdir-min elt1) | 2366 | (> (dired-get-subdir-min elt1) |
| 2339 | (dired-get-subdir-min elt2))))))) | 2367 | (dired-get-subdir-min elt2)))))) |
| 2340 | 2368 | ||
| 2341 | (defun dired-kill-tree (dirname &optional remember-marks kill-root) | 2369 | (defun dired-kill-tree (dirname &optional remember-marks kill-root) |
| 2342 | "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself. | 2370 | "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself. |
diff --git a/lisp/dired.el b/lisp/dired.el index 909735a3b54..0c1f3e4af64 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -335,9 +335,8 @@ The directory name must be absolute, but need not be fully expanded.") | |||
| 335 | (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]")) | 335 | (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]")) |
| 336 | (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]")) | 336 | (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]")) |
| 337 | (defvar dired-re-exe;; match ls permission string of an executable file | 337 | (defvar dired-re-exe;; match ls permission string of an executable file |
| 338 | (mapconcat (function | 338 | (mapconcat (lambda (x) |
| 339 | (lambda (x) | 339 | (concat dired-re-maybe-mark dired-re-inode-size x)) |
| 340 | (concat dired-re-maybe-mark dired-re-inode-size x))) | ||
| 341 | '("-[-r][-w][xs][-r][-w].[-r][-w]." | 340 | '("-[-r][-w][xs][-r][-w].[-r][-w]." |
| 342 | "-[-r][-w].[-r][-w][xs][-r][-w]." | 341 | "-[-r][-w].[-r][-w][xs][-r][-w]." |
| 343 | "-[-r][-w].[-r][-w].[-r][-w][xst]") | 342 | "-[-r][-w].[-r][-w].[-r][-w][xst]") |
| @@ -607,9 +606,9 @@ marked file, return (t FILENAME) instead of (FILENAME)." | |||
| 607 | (progn ;; no save-excursion, want to move point. | 606 | (progn ;; no save-excursion, want to move point. |
| 608 | (dired-repeat-over-lines | 607 | (dired-repeat-over-lines |
| 609 | ,arg | 608 | ,arg |
| 610 | (function (lambda () | 609 | (lambda () |
| 611 | (if ,show-progress (sit-for 0)) | 610 | (if ,show-progress (sit-for 0)) |
| 612 | (setq results (cons ,body results))))) | 611 | (setq results (cons ,body results)))) |
| 613 | (if (< ,arg 0) | 612 | (if (< ,arg 0) |
| 614 | (nreverse results) | 613 | (nreverse results) |
| 615 | results)) | 614 | results)) |
| @@ -1995,8 +1994,8 @@ Keybindings: | |||
| 1995 | ;; Ignore dired-hide-details-* value of invisible text property by default. | 1994 | ;; Ignore dired-hide-details-* value of invisible text property by default. |
| 1996 | (when (eq buffer-invisibility-spec t) | 1995 | (when (eq buffer-invisibility-spec t) |
| 1997 | (setq buffer-invisibility-spec (list t))) | 1996 | (setq buffer-invisibility-spec (list t))) |
| 1998 | (setq-local revert-buffer-function (function dired-revert)) | 1997 | (setq-local revert-buffer-function #'dired-revert) |
| 1999 | (setq-local buffer-stale-function (function dired-buffer-stale-p)) | 1998 | (setq-local buffer-stale-function #'dired-buffer-stale-p) |
| 2000 | (setq-local page-delimiter "\n\n") | 1999 | (setq-local page-delimiter "\n\n") |
| 2001 | (setq-local dired-directory (or dirname default-directory)) | 2000 | (setq-local dired-directory (or dirname default-directory)) |
| 2002 | ;; list-buffers uses this to display the dir being edited in this buffer. | 2001 | ;; list-buffers uses this to display the dir being edited in this buffer. |
| @@ -2469,7 +2468,7 @@ You can then feed the file name(s) to other commands with \\[yank]." | |||
| 2469 | (interactive "P") | 2468 | (interactive "P") |
| 2470 | (let ((string | 2469 | (let ((string |
| 2471 | (or (dired-get-subdir) | 2470 | (or (dired-get-subdir) |
| 2472 | (mapconcat (function identity) | 2471 | (mapconcat #'identity |
| 2473 | (if arg | 2472 | (if arg |
| 2474 | (cond ((zerop (prefix-numeric-value arg)) | 2473 | (cond ((zerop (prefix-numeric-value arg)) |
| 2475 | (dired-get-marked-files)) | 2474 | (dired-get-marked-files)) |
| @@ -2971,12 +2970,12 @@ non-empty directories is allowed." | |||
| 2971 | ;; lines still to be changed, so the (point) values in L stay valid. | 2970 | ;; lines still to be changed, so the (point) values in L stay valid. |
| 2972 | ;; Also, for subdirs in natural order, a subdir's files are deleted | 2971 | ;; Also, for subdirs in natural order, a subdir's files are deleted |
| 2973 | ;; before the subdir itself - the other way around would not work. | 2972 | ;; before the subdir itself - the other way around would not work. |
| 2974 | (let* ((files (mapcar (function car) l)) | 2973 | (let* ((files (mapcar #'car l)) |
| 2975 | (count (length l)) | 2974 | (count (length l)) |
| 2976 | (succ 0) | 2975 | (succ 0) |
| 2977 | (trashing (and trash delete-by-moving-to-trash))) | 2976 | (trashing (and trash delete-by-moving-to-trash))) |
| 2978 | ;; canonicalize file list for pop up | 2977 | ;; canonicalize file list for pop up |
| 2979 | (setq files (nreverse (mapcar (function dired-make-relative) files))) | 2978 | (setq files (nreverse (mapcar #'dired-make-relative files))) |
| 2980 | (if (dired-mark-pop-up | 2979 | (if (dired-mark-pop-up |
| 2981 | " *Deletions*" 'delete files dired-deletion-confirmer | 2980 | " *Deletions*" 'delete files dired-deletion-confirmer |
| 2982 | (format "%s %s " | 2981 | (format "%s %s " |
| @@ -2999,7 +2998,7 @@ non-empty directories is allowed." | |||
| 2999 | (progress-reporter-update progress-reporter succ) | 2998 | (progress-reporter-update progress-reporter succ) |
| 3000 | (dired-fun-in-all-buffers | 2999 | (dired-fun-in-all-buffers |
| 3001 | (file-name-directory fn) (file-name-nondirectory fn) | 3000 | (file-name-directory fn) (file-name-nondirectory fn) |
| 3002 | (function dired-delete-entry) fn)) | 3001 | #'dired-delete-entry fn)) |
| 3003 | (error ;; catch errors from failed deletions | 3002 | (error ;; catch errors from failed deletions |
| 3004 | (dired-log "%s\n" err) | 3003 | (dired-log "%s\n" err) |
| 3005 | (setq failures (cons (car (car l)) failures))))) | 3004 | (setq failures (cons (car (car l)) failures))))) |
| @@ -3293,7 +3292,7 @@ this subdir." | |||
| 3293 | (let ((inhibit-read-only t)) | 3292 | (let ((inhibit-read-only t)) |
| 3294 | (dired-repeat-over-lines | 3293 | (dired-repeat-over-lines |
| 3295 | (prefix-numeric-value arg) | 3294 | (prefix-numeric-value arg) |
| 3296 | (function (lambda () (delete-char 1) (insert dired-marker-char)))))))) | 3295 | (lambda () (delete-char 1) (insert dired-marker-char))))))) |
| 3297 | 3296 | ||
| 3298 | (defun dired-unmark (arg &optional interactive) | 3297 | (defun dired-unmark (arg &optional interactive) |
| 3299 | "Unmark the file at point in the Dired buffer. | 3298 | "Unmark the file at point in the Dired buffer. |
| @@ -3928,7 +3927,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." | |||
| 3928 | (cdr | 3927 | (cdr |
| 3929 | (nreverse | 3928 | (nreverse |
| 3930 | (mapcar | 3929 | (mapcar |
| 3931 | (function (lambda (f) (desktop-file-name (car f) dirname))) | 3930 | (lambda (f) (desktop-file-name (car f) dirname)) |
| 3932 | dired-subdir-alist))))) | 3931 | dired-subdir-alist))))) |
| 3933 | 3932 | ||
| 3934 | (defun dired-restore-desktop-buffer (_file-name | 3933 | (defun dired-restore-desktop-buffer (_file-name |
diff --git a/lisp/electric.el b/lisp/electric.el index 4078ef8193e..1564df5949c 100644 --- a/lisp/electric.el +++ b/lisp/electric.el | |||
| @@ -443,11 +443,24 @@ quote, left double quote, and right double quote, respectively." | |||
| 443 | :version "25.1" | 443 | :version "25.1" |
| 444 | :type 'boolean :safe 'booleanp :group 'electricity) | 444 | :type 'boolean :safe 'booleanp :group 'electricity) |
| 445 | 445 | ||
| 446 | (defcustom electric-quote-context-sensitive nil | ||
| 447 | "Non-nil means to replace \\=' with an electric quote depending on context. | ||
| 448 | If `electric-quote-context-sensitive' is non-nil, Emacs replaces | ||
| 449 | \\=' and \\='\\=' with an opening quote after a line break, | ||
| 450 | whitespace, opening parenthesis, or quote and leaves \\=` alone." | ||
| 451 | :version "26.1" | ||
| 452 | :type 'boolean :safe #'booleanp :group 'electricity) | ||
| 453 | |||
| 454 | (defvar electric-quote-code-faces () | ||
| 455 | "List of faces to treat as inline code in `text-mode'.") | ||
| 456 | |||
| 446 | (defun electric-quote-post-self-insert-function () | 457 | (defun electric-quote-post-self-insert-function () |
| 447 | "Function that `electric-quote-mode' adds to `post-self-insert-hook'. | 458 | "Function that `electric-quote-mode' adds to `post-self-insert-hook'. |
| 448 | This requotes when a quoting key is typed." | 459 | This requotes when a quoting key is typed." |
| 449 | (when (and electric-quote-mode | 460 | (when (and electric-quote-mode |
| 450 | (memq last-command-event '(?\' ?\`))) | 461 | (or (eq last-command-event ?\') |
| 462 | (and (not electric-quote-context-sensitive) | ||
| 463 | (eq last-command-event ?\`)))) | ||
| 451 | (let ((start | 464 | (let ((start |
| 452 | (if (and comment-start comment-use-syntax) | 465 | (if (and comment-start comment-use-syntax) |
| 453 | (when (or electric-quote-comment electric-quote-string) | 466 | (when (or electric-quote-comment electric-quote-string) |
| @@ -462,30 +475,45 @@ This requotes when a quoting key is typed." | |||
| 462 | (syntax-ppss (1- (point))))))))) | 475 | (syntax-ppss (1- (point))))))))) |
| 463 | (and electric-quote-paragraph | 476 | (and electric-quote-paragraph |
| 464 | (derived-mode-p 'text-mode) | 477 | (derived-mode-p 'text-mode) |
| 478 | ;; FIXME: There should be a ‘cl-disjoint’ function. | ||
| 479 | (null (cl-intersection (face-at-point nil 'multiple) | ||
| 480 | electric-quote-code-faces | ||
| 481 | :test #'eq)) | ||
| 482 | ;; FIXME: Why is the next form there? It’s never | ||
| 483 | ;; nil. | ||
| 465 | (or (eq last-command-event ?\`) | 484 | (or (eq last-command-event ?\`) |
| 466 | (save-excursion (backward-paragraph) (point))))))) | 485 | (save-excursion (backward-paragraph) (point))))))) |
| 467 | (pcase electric-quote-chars | 486 | (pcase electric-quote-chars |
| 468 | (`(,q< ,q> ,q<< ,q>>) | 487 | (`(,q< ,q> ,q<< ,q>>) |
| 469 | (when start | 488 | (when start |
| 470 | (save-excursion | 489 | (save-excursion |
| 471 | (if (eq last-command-event ?\`) | 490 | (let ((backtick ?\`)) |
| 472 | (cond ((search-backward (string q< ?`) (- (point) 2) t) | 491 | (if (or (eq last-command-event ?\`) |
| 473 | (replace-match (string q<<)) | 492 | (and electric-quote-context-sensitive |
| 474 | (when (and electric-pair-mode | 493 | (save-excursion |
| 475 | (eq (cdr-safe | 494 | (backward-char) |
| 476 | (assq q< electric-pair-text-pairs)) | 495 | (or (bobp) (bolp) |
| 477 | (char-after))) | 496 | (memq (char-before) (list q< q<<)) |
| 478 | (delete-char 1)) | 497 | (memq (char-syntax (char-before)) |
| 479 | (setq last-command-event q<<)) | 498 | '(?\s ?\()))) |
| 480 | ((search-backward "`" (1- (point)) t) | 499 | (setq backtick ?\'))) |
| 481 | (replace-match (string q<)) | 500 | (cond ((search-backward (string q< backtick) (- (point) 2) t) |
| 482 | (setq last-command-event q<))) | 501 | (replace-match (string q<<)) |
| 483 | (cond ((search-backward (string q> ?') (- (point) 2) t) | 502 | (when (and electric-pair-mode |
| 484 | (replace-match (string q>>)) | 503 | (eq (cdr-safe |
| 485 | (setq last-command-event q>>)) | 504 | (assq q< electric-pair-text-pairs)) |
| 486 | ((search-backward "'" (1- (point)) t) | 505 | (char-after))) |
| 487 | (replace-match (string q>)) | 506 | (delete-char 1)) |
| 488 | (setq last-command-event q>))))))))))) | 507 | (setq last-command-event q<<)) |
| 508 | ((search-backward (string backtick) (1- (point)) t) | ||
| 509 | (replace-match (string q<)) | ||
| 510 | (setq last-command-event q<))) | ||
| 511 | (cond ((search-backward (string q> ?') (- (point) 2) t) | ||
| 512 | (replace-match (string q>>)) | ||
| 513 | (setq last-command-event q>>)) | ||
| 514 | ((search-backward "'" (1- (point)) t) | ||
| 515 | (replace-match (string q>)) | ||
| 516 | (setq last-command-event q>)))))))))))) | ||
| 489 | 517 | ||
| 490 | (put 'electric-quote-post-self-insert-function 'priority 10) | 518 | (put 'electric-quote-post-self-insert-function 'priority 10) |
| 491 | 519 | ||
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 3852ceb6c31..99df209d1a2 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el | |||
| @@ -437,22 +437,38 @@ as an integer unless JUNK-ALLOWED is non-nil." | |||
| 437 | 437 | ||
| 438 | ;; Random numbers. | 438 | ;; Random numbers. |
| 439 | 439 | ||
| 440 | (defun cl--random-time () | ||
| 441 | (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) | ||
| 442 | (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) | ||
| 443 | v)) | ||
| 444 | |||
| 445 | ;;;###autoload (autoload 'cl-random-state-p "cl-extra") | ||
| 446 | (cl-defstruct (cl--random-state | ||
| 447 | (:copier nil) | ||
| 448 | (:predicate cl-random-state-p) | ||
| 449 | (:constructor nil) | ||
| 450 | (:constructor cl--make-random-state (vec))) | ||
| 451 | (i -1) (j 30) vec) | ||
| 452 | |||
| 453 | (defvar cl--random-state (cl--make-random-state (cl--random-time))) | ||
| 454 | |||
| 440 | ;;;###autoload | 455 | ;;;###autoload |
| 441 | (defun cl-random (lim &optional state) | 456 | (defun cl-random (lim &optional state) |
| 442 | "Return a random nonnegative number less than LIM, an integer or float. | 457 | "Return a random nonnegative number less than LIM, an integer or float. |
| 443 | Optional second arg STATE is a random-state object." | 458 | Optional second arg STATE is a random-state object." |
| 444 | (or state (setq state cl--random-state)) | 459 | (or state (setq state cl--random-state)) |
| 445 | ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. | 460 | ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. |
| 446 | (let ((vec (aref state 3))) | 461 | (let ((vec (cl--random-state-vec state))) |
| 447 | (if (integerp vec) | 462 | (if (integerp vec) |
| 448 | (let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1)) | 463 | (let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1)) |
| 449 | (aset state 3 (setq vec (make-vector 55 nil))) | 464 | (setf (cl--random-state-vec state) |
| 465 | (setq vec (make-vector 55 nil))) | ||
| 450 | (aset vec 0 j) | 466 | (aset vec 0 j) |
| 451 | (while (> (setq i (% (+ i 21) 55)) 0) | 467 | (while (> (setq i (% (+ i 21) 55)) 0) |
| 452 | (aset vec i (setq j (prog1 k (setq k (- j k)))))) | 468 | (aset vec i (setq j (prog1 k (setq k (- j k)))))) |
| 453 | (while (< (setq i (1+ i)) 200) (cl-random 2 state)))) | 469 | (while (< (setq i (1+ i)) 200) (cl-random 2 state)))) |
| 454 | (let* ((i (aset state 1 (% (1+ (aref state 1)) 55))) | 470 | (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state))) |
| 455 | (j (aset state 2 (% (1+ (aref state 2)) 55))) | 471 | (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state))) |
| 456 | (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) | 472 | (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) |
| 457 | (if (integerp lim) | 473 | (if (integerp lim) |
| 458 | (if (<= lim 512) (% n lim) | 474 | (if (<= lim 512) (% n lim) |
| @@ -466,17 +482,10 @@ Optional second arg STATE is a random-state object." | |||
| 466 | (defun cl-make-random-state (&optional state) | 482 | (defun cl-make-random-state (&optional state) |
| 467 | "Return a copy of random-state STATE, or of the internal state if omitted. | 483 | "Return a copy of random-state STATE, or of the internal state if omitted. |
| 468 | If STATE is t, return a new state object seeded from the time of day." | 484 | If STATE is t, return a new state object seeded from the time of day." |
| 469 | (cond ((null state) (cl-make-random-state cl--random-state)) | 485 | (unless state (setq state cl--random-state)) |
| 470 | ((vectorp state) (copy-tree state t)) | 486 | (if (cl-random-state-p state) |
| 471 | ((integerp state) (vector 'cl--random-state-tag -1 30 state)) | 487 | (copy-tree state t) |
| 472 | (t (cl-make-random-state (cl--random-time))))) | 488 | (cl--make-random-state (if (integerp state) state (cl--random-time))))) |
| 473 | |||
| 474 | ;;;###autoload | ||
| 475 | (defun cl-random-state-p (object) | ||
| 476 | "Return t if OBJECT is a random-state object." | ||
| 477 | (and (vectorp object) (= (length object) 4) | ||
| 478 | (eq (aref object 0) 'cl--random-state-tag))) | ||
| 479 | |||
| 480 | 489 | ||
| 481 | ;; Implementation limits. | 490 | ;; Implementation limits. |
| 482 | 491 | ||
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 89a71d1b6c5..e9ca0412848 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el | |||
| @@ -90,7 +90,7 @@ call other entry points instead, such as `cl-prin1'." | |||
| 90 | - `disassemble' to print the disassembly of the code. | 90 | - `disassemble' to print the disassembly of the code. |
| 91 | - nil to skip printing any details about the code.") | 91 | - nil to skip printing any details about the code.") |
| 92 | 92 | ||
| 93 | (defvar cl-print-compiled-button nil | 93 | (defvar cl-print-compiled-button t |
| 94 | "Control how to print byte-compiled functions into buffers. | 94 | "Control how to print byte-compiled functions into buffers. |
| 95 | When the stream is a buffer, make the bytecode part of the output | 95 | When the stream is a buffer, make the bytecode part of the output |
| 96 | into a button whose action shows the function's disassembly.") | 96 | into a button whose action shows the function's disassembly.") |
| @@ -105,10 +105,11 @@ into a button whose action shows the function's disassembly.") | |||
| 105 | (if args | 105 | (if args |
| 106 | (prin1 args stream) | 106 | (prin1 args stream) |
| 107 | (princ "()" stream))) | 107 | (princ "()" stream))) |
| 108 | (let ((doc (documentation object 'raw))) | 108 | (pcase (help-split-fundoc (documentation object 'raw) object) |
| 109 | (when doc | 109 | ;; Drop args which `help-function-arglist' already printed. |
| 110 | (princ " " stream) | 110 | (`(,_usage . ,(and doc (guard (stringp doc)))) |
| 111 | (prin1 doc stream))) | 111 | (princ " " stream) |
| 112 | (prin1 doc stream))) | ||
| 112 | (let ((inter (interactive-form object))) | 113 | (let ((inter (interactive-form object))) |
| 113 | (when inter | 114 | (when inter |
| 114 | (princ " " stream) | 115 | (princ " " stream) |
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 83456fc31a2..2b8782590c4 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el | |||
| @@ -49,6 +49,12 @@ the middle is discarded, and just the beginning and end are displayed." | |||
| 49 | :group 'debugger | 49 | :group 'debugger |
| 50 | :version "21.1") | 50 | :version "21.1") |
| 51 | 51 | ||
| 52 | (defcustom debugger-print-function #'cl-prin1 | ||
| 53 | "Function used to print values in the debugger backtraces." | ||
| 54 | :type 'function | ||
| 55 | :options '(cl-prin1 prin1) | ||
| 56 | :version "26.1") | ||
| 57 | |||
| 52 | (defcustom debugger-bury-or-kill 'bury | 58 | (defcustom debugger-bury-or-kill 'bury |
| 53 | "What to do with the debugger buffer when exiting `debug'. | 59 | "What to do with the debugger buffer when exiting `debug'. |
| 54 | The value affects the behavior of operations on any window | 60 | The value affects the behavior of operations on any window |
| @@ -264,6 +270,40 @@ first will be printed into the backtrace buffer." | |||
| 264 | (setq debug-on-next-call debugger-step-after-exit) | 270 | (setq debug-on-next-call debugger-step-after-exit) |
| 265 | debugger-value))) | 271 | debugger-value))) |
| 266 | 272 | ||
| 273 | |||
| 274 | (defun debugger-insert-backtrace (frames do-xrefs) | ||
| 275 | "Format and insert the backtrace FRAMES at point. | ||
| 276 | Make functions into cross-reference buttons if DO-XREFS is non-nil." | ||
| 277 | (let ((standard-output (current-buffer)) | ||
| 278 | (eval-buffers eval-buffer-list)) | ||
| 279 | (require 'help-mode) ; Define `help-function-def' button type. | ||
| 280 | (pcase-dolist (`(,evald ,fun ,args ,flags) frames) | ||
| 281 | (insert (if (plist-get flags :debug-on-exit) | ||
| 282 | "* " " ")) | ||
| 283 | (let ((fun-file (and do-xrefs (symbol-file fun 'defun))) | ||
| 284 | (fun-pt (point))) | ||
| 285 | (cond | ||
| 286 | ((and evald (not debugger-stack-frame-as-list)) | ||
| 287 | (funcall debugger-print-function fun) | ||
| 288 | (if args (funcall debugger-print-function args) (princ "()"))) | ||
| 289 | (t | ||
| 290 | (funcall debugger-print-function (cons fun args)) | ||
| 291 | (cl-incf fun-pt))) | ||
| 292 | (when fun-file | ||
| 293 | (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) | ||
| 294 | :type 'help-function-def | ||
| 295 | 'help-args (list fun fun-file)))) | ||
| 296 | ;; After any frame that uses eval-buffer, insert a line that | ||
| 297 | ;; states the buffer position it's reading at. | ||
| 298 | (when (and eval-buffers (memq fun '(eval-buffer eval-region))) | ||
| 299 | (insert (format " ; Reading at buffer position %d" | ||
| 300 | ;; This will get the wrong result if there are | ||
| 301 | ;; two nested eval-region calls for the same | ||
| 302 | ;; buffer. That's not a very useful case. | ||
| 303 | (with-current-buffer (pop eval-buffers) | ||
| 304 | (point))))) | ||
| 305 | (insert "\n")))) | ||
| 306 | |||
| 267 | (defun debugger-setup-buffer (args) | 307 | (defun debugger-setup-buffer (args) |
| 268 | "Initialize the `*Backtrace*' buffer for entry to the debugger. | 308 | "Initialize the `*Backtrace*' buffer for entry to the debugger. |
| 269 | That buffer should be current already." | 309 | That buffer should be current already." |
| @@ -271,27 +311,20 @@ That buffer should be current already." | |||
| 271 | (erase-buffer) | 311 | (erase-buffer) |
| 272 | (set-buffer-multibyte t) ;Why was it nil ? -stef | 312 | (set-buffer-multibyte t) ;Why was it nil ? -stef |
| 273 | (setq buffer-undo-list t) | 313 | (setq buffer-undo-list t) |
| 274 | (let ((standard-output (current-buffer)) | ||
| 275 | (print-escape-newlines t) | ||
| 276 | (print-level 8) | ||
| 277 | (print-length 50)) | ||
| 278 | ;; FIXME the debugger could pass a custom callback to mapbacktrace | ||
| 279 | ;; instead of manipulating printed results. | ||
| 280 | (mapbacktrace #'backtrace--print-frame 'debug)) | ||
| 281 | (goto-char (point-min)) | ||
| 282 | (delete-region (point) | ||
| 283 | (progn | ||
| 284 | (forward-line (if (eq (car args) 'debug) | ||
| 285 | ;; Remove debug--implement-debug-on-entry | ||
| 286 | ;; and the advice's `apply' frame. | ||
| 287 | 3 | ||
| 288 | 1)) | ||
| 289 | (point))) | ||
| 290 | (insert "Debugger entered") | 314 | (insert "Debugger entered") |
| 291 | ;; lambda is for debug-on-call when a function call is next. | 315 | (let ((frames (nthcdr |
| 292 | ;; debug is for debug-on-entry function called. | 316 | ;; Remove debug--implement-debug-on-entry and the |
| 293 | (let ((pos (point))) | 317 | ;; advice's `apply' frame. |
| 318 | (if (eq (car args) 'debug) 3 1) | ||
| 319 | (backtrace-frames 'debug))) | ||
| 320 | (print-escape-newlines t) | ||
| 321 | (print-escape-control-characters t) | ||
| 322 | (print-level 8) | ||
| 323 | (print-length 50) | ||
| 324 | (pos (point))) | ||
| 294 | (pcase (car args) | 325 | (pcase (car args) |
| 326 | ;; lambda is for debug-on-call when a function call is next. | ||
| 327 | ;; debug is for debug-on-entry function called. | ||
| 295 | ((or `lambda `debug) | 328 | ((or `lambda `debug) |
| 296 | (insert "--entering a function:\n") | 329 | (insert "--entering a function:\n") |
| 297 | (setq pos (1- (point)))) | 330 | (setq pos (1- (point)))) |
| @@ -300,11 +333,9 @@ That buffer should be current already." | |||
| 300 | (insert "--returning value: ") | 333 | (insert "--returning value: ") |
| 301 | (setq pos (point)) | 334 | (setq pos (point)) |
| 302 | (setq debugger-value (nth 1 args)) | 335 | (setq debugger-value (nth 1 args)) |
| 303 | (prin1 debugger-value (current-buffer)) | 336 | (funcall debugger-print-function debugger-value (current-buffer)) |
| 304 | (insert ?\n) | 337 | (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) |
| 305 | (delete-char 1) | 338 | (insert ?\n)) |
| 306 | (insert ? ) | ||
| 307 | (beginning-of-line)) | ||
| 308 | ;; Watchpoint triggered. | 339 | ;; Watchpoint triggered. |
| 309 | ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) | 340 | ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) |
| 310 | (insert | 341 | (insert |
| @@ -327,7 +358,7 @@ That buffer should be current already." | |||
| 327 | (`error | 358 | (`error |
| 328 | (insert "--Lisp error: ") | 359 | (insert "--Lisp error: ") |
| 329 | (setq pos (point)) | 360 | (setq pos (point)) |
| 330 | (prin1 (nth 1 args) (current-buffer)) | 361 | (funcall debugger-print-function (nth 1 args) (current-buffer)) |
| 331 | (insert ?\n)) | 362 | (insert ?\n)) |
| 332 | ;; debug-on-call, when the next thing is an eval. | 363 | ;; debug-on-call, when the next thing is an eval. |
| 333 | (`t | 364 | (`t |
| @@ -337,98 +368,15 @@ That buffer should be current already." | |||
| 337 | (_ | 368 | (_ |
| 338 | (insert ": ") | 369 | (insert ": ") |
| 339 | (setq pos (point)) | 370 | (setq pos (point)) |
| 340 | (prin1 (if (eq (car args) 'nil) | 371 | (funcall debugger-print-function |
| 341 | (cdr args) args) | 372 | (if (eq (car args) 'nil) |
| 342 | (current-buffer)) | 373 | (cdr args) args) |
| 374 | (current-buffer)) | ||
| 343 | (insert ?\n))) | 375 | (insert ?\n))) |
| 376 | (debugger-insert-backtrace frames t) | ||
| 344 | ;; Place point on "stack frame 0" (bug#15101). | 377 | ;; Place point on "stack frame 0" (bug#15101). |
| 345 | (goto-char pos)) | 378 | (goto-char pos))) |
| 346 | ;; After any frame that uses eval-buffer, | 379 | |
| 347 | ;; insert a line that states the buffer position it's reading at. | ||
| 348 | (save-excursion | ||
| 349 | (let ((tem eval-buffer-list)) | ||
| 350 | (while (and tem | ||
| 351 | (re-search-forward "^ eval-\\(buffer\\|region\\)(" nil t)) | ||
| 352 | (end-of-line) | ||
| 353 | (insert (format " ; Reading at buffer position %d" | ||
| 354 | ;; This will get the wrong result | ||
| 355 | ;; if there are two nested eval-region calls | ||
| 356 | ;; for the same buffer. That's not a very useful case. | ||
| 357 | (with-current-buffer (car tem) | ||
| 358 | (point)))) | ||
| 359 | (pop tem)))) | ||
| 360 | (debugger-make-xrefs)) | ||
| 361 | |||
| 362 | (defun debugger-make-xrefs (&optional buffer) | ||
| 363 | "Attach cross-references to function names in the `*Backtrace*' buffer." | ||
| 364 | (interactive "b") | ||
| 365 | (with-current-buffer (or buffer (current-buffer)) | ||
| 366 | (save-excursion | ||
| 367 | (setq buffer (current-buffer)) | ||
| 368 | (let ((inhibit-read-only t) | ||
| 369 | (old-end (point-min)) (new-end (point-min))) | ||
| 370 | ;; If we saved an old backtrace, find the common part | ||
| 371 | ;; between the new and the old. | ||
| 372 | ;; Compare line by line, starting from the end, | ||
| 373 | ;; because that's the part that is likely to be unchanged. | ||
| 374 | (if debugger-previous-backtrace | ||
| 375 | (let (old-start new-start (all-match t)) | ||
| 376 | (goto-char (point-max)) | ||
| 377 | (with-temp-buffer | ||
| 378 | (insert debugger-previous-backtrace) | ||
| 379 | (while (and all-match (not (bobp))) | ||
| 380 | (setq old-end (point)) | ||
| 381 | (forward-line -1) | ||
| 382 | (setq old-start (point)) | ||
| 383 | (with-current-buffer buffer | ||
| 384 | (setq new-end (point)) | ||
| 385 | (forward-line -1) | ||
| 386 | (setq new-start (point))) | ||
| 387 | (if (not (zerop | ||
| 388 | (let ((case-fold-search nil)) | ||
| 389 | (compare-buffer-substrings | ||
| 390 | (current-buffer) old-start old-end | ||
| 391 | buffer new-start new-end)))) | ||
| 392 | (setq all-match nil)))) | ||
| 393 | ;; Now new-end is the position of the start of the | ||
| 394 | ;; unchanged part in the current buffer, and old-end is | ||
| 395 | ;; the position of that same text in the saved old | ||
| 396 | ;; backtrace. But we must subtract (point-min) since strings are | ||
| 397 | ;; indexed in origin 0. | ||
| 398 | |||
| 399 | ;; Replace the unchanged part of the backtrace | ||
| 400 | ;; with the text from debugger-previous-backtrace, | ||
| 401 | ;; since that already has the proper xrefs. | ||
| 402 | ;; With this optimization, we only need to scan | ||
| 403 | ;; the changed part of the backtrace. | ||
| 404 | (delete-region new-end (point-max)) | ||
| 405 | (goto-char (point-max)) | ||
| 406 | (insert (substring debugger-previous-backtrace | ||
| 407 | (- old-end (point-min)))) | ||
| 408 | ;; Make the unchanged part of the backtrace inaccessible | ||
| 409 | ;; so it won't be scanned. | ||
| 410 | (narrow-to-region (point-min) new-end))) | ||
| 411 | |||
| 412 | ;; Scan the new part of the backtrace, inserting xrefs. | ||
| 413 | (goto-char (point-min)) | ||
| 414 | (while (progn | ||
| 415 | (goto-char (+ (point) 2)) | ||
| 416 | (skip-syntax-forward "^w_") | ||
| 417 | (not (eobp))) | ||
| 418 | (let* ((beg (point)) | ||
| 419 | (end (progn (skip-syntax-forward "w_") (point))) | ||
| 420 | (sym (intern-soft (buffer-substring-no-properties | ||
| 421 | beg end))) | ||
| 422 | (file (and sym (symbol-file sym 'defun)))) | ||
| 423 | (when file | ||
| 424 | (goto-char beg) | ||
| 425 | ;; help-xref-button needs to operate on something matched | ||
| 426 | ;; by a regexp, so set that up for it. | ||
| 427 | (re-search-forward "\\(\\sw\\|\\s_\\)+") | ||
| 428 | (help-xref-button 0 'help-function-def sym file))) | ||
| 429 | (forward-line 1)) | ||
| 430 | (widen)) | ||
| 431 | (setq debugger-previous-backtrace (buffer-string))))) | ||
| 432 | 380 | ||
| 433 | (defun debugger-step-through () | 381 | (defun debugger-step-through () |
| 434 | "Proceed, stepping through subexpressions of this expression. | 382 | "Proceed, stepping through subexpressions of this expression. |
| @@ -866,9 +814,13 @@ To specify a nil argument interactively, exit with an empty minibuffer." | |||
| 866 | 'type 'help-function | 814 | 'type 'help-function |
| 867 | 'help-args (list fun)) | 815 | 'help-args (list fun)) |
| 868 | (terpri)) | 816 | (terpri)) |
| 869 | (terpri) | 817 | ;; Now that debug--function-list uses advice-member-p, its |
| 870 | (princ "Note: if you have redefined a function, then it may no longer\n") | 818 | ;; output should be reliable (except for bugs and the exceptional |
| 871 | (princ "be set to debug on entry, even if it is in the list.")))))) | 819 | ;; case where some other advice ends up overriding ours). |
| 820 | ;;(terpri) | ||
| 821 | ;;(princ "Note: if you have redefined a function, then it may no longer\n") | ||
| 822 | ;;(princ "be set to debug on entry, even if it is in the list.") | ||
| 823 | ))))) | ||
| 872 | 824 | ||
| 873 | (defun debug--implement-debug-watch (symbol newval op where) | 825 | (defun debug--implement-debug-watch (symbol newval op where) |
| 874 | "Conditionally call the debugger. | 826 | "Conditionally call the debugger. |
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index dfe1c06bfaf..9d618e1dc81 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -84,7 +84,7 @@ Currently under control of this var: | |||
| 84 | (progn | 84 | (progn |
| 85 | ;; Arrange for field access not to bother checking if the access is indeed | 85 | ;; Arrange for field access not to bother checking if the access is indeed |
| 86 | ;; made to an eieio--class object. | 86 | ;; made to an eieio--class object. |
| 87 | (cl-declaim (optimize (safety 0))) | 87 | (eval-when-compile (cl-declaim (optimize (safety 0)))) |
| 88 | 88 | ||
| 89 | (cl-defstruct (eieio--class | 89 | (cl-defstruct (eieio--class |
| 90 | (:constructor nil) | 90 | (:constructor nil) |
| @@ -103,8 +103,12 @@ Currently under control of this var: | |||
| 103 | options ;; storage location of tagged class option | 103 | options ;; storage location of tagged class option |
| 104 | ; Stored outright without modifications or stripping | 104 | ; Stored outright without modifications or stripping |
| 105 | ) | 105 | ) |
| 106 | ;; Set it back to the default value. | 106 | ;; Set it back to the default value. NOTE: Using the default |
| 107 | (cl-declaim (optimize (safety 1)))) | 107 | ;; `safety' value does NOT give the default |
| 108 | ;; `byte-compile-delete-errors' value. Therefore limit this (and | ||
| 109 | ;; the above `cl-declaim') to compile time so that we don't affect | ||
| 110 | ;; code which only loads this library. | ||
| 111 | (eval-when-compile (cl-declaim (optimize (safety 1))))) | ||
| 108 | 112 | ||
| 109 | 113 | ||
| 110 | (eval-and-compile | 114 | (eval-and-compile |
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 2c49a634e35..eb2b2e3e11b 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el | |||
| @@ -670,48 +670,12 @@ and is displayed in front of the value of MESSAGE-FORM." | |||
| 670 | (cl-defstruct (ert-test-aborted-with-non-local-exit | 670 | (cl-defstruct (ert-test-aborted-with-non-local-exit |
| 671 | (:include ert-test-result))) | 671 | (:include ert-test-result))) |
| 672 | 672 | ||
| 673 | 673 | (defun ert--print-backtrace (backtrace do-xrefs) | |
| 674 | (defun ert--record-backtrace () | ||
| 675 | "Record the current backtrace (as a list) and return it." | ||
| 676 | ;; Since the backtrace is stored in the result object, result | ||
| 677 | ;; objects must only be printed with appropriate limits | ||
| 678 | ;; (`print-level' and `print-length') in place. For interactive | ||
| 679 | ;; use, the cost of ensuring this possibly outweighs the advantage | ||
| 680 | ;; of storing the backtrace for | ||
| 681 | ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we | ||
| 682 | ;; already have `ert-results-rerun-test-debugging-errors-at-point'. | ||
| 683 | ;; For batch use, however, printing the backtrace may be useful. | ||
| 684 | (cl-loop | ||
| 685 | ;; 6 is the number of frames our own debugger adds (when | ||
| 686 | ;; compiled; more when interpreted). FIXME: Need to describe a | ||
| 687 | ;; procedure for determining this constant. | ||
| 688 | for i from 6 | ||
| 689 | for frame = (backtrace-frame i) | ||
| 690 | while frame | ||
| 691 | collect frame)) | ||
| 692 | |||
| 693 | (defun ert--print-backtrace (backtrace) | ||
| 694 | "Format the backtrace BACKTRACE to the current buffer." | 674 | "Format the backtrace BACKTRACE to the current buffer." |
| 695 | ;; This is essentially a reimplementation of Fbacktrace | ||
| 696 | ;; (src/eval.c), but for a saved backtrace, not the current one. | ||
| 697 | (let ((print-escape-newlines t) | 675 | (let ((print-escape-newlines t) |
| 698 | (print-level 8) | 676 | (print-level 8) |
| 699 | (print-length 50)) | 677 | (print-length 50)) |
| 700 | (dolist (frame backtrace) | 678 | (debugger-insert-backtrace backtrace do-xrefs))) |
| 701 | (pcase-exhaustive frame | ||
| 702 | (`(nil ,special-operator . ,arg-forms) | ||
| 703 | ;; Special operator. | ||
| 704 | (insert | ||
| 705 | (format " %S\n" (cons special-operator arg-forms)))) | ||
| 706 | (`(t ,fn . ,args) | ||
| 707 | ;; Function call. | ||
| 708 | (insert (format " %S(" fn)) | ||
| 709 | (cl-loop for firstp = t then nil | ||
| 710 | for arg in args do | ||
| 711 | (unless firstp | ||
| 712 | (insert " ")) | ||
| 713 | (insert (format "%S" arg))) | ||
| 714 | (insert ")\n")))))) | ||
| 715 | 679 | ||
| 716 | ;; A container for the state of the execution of a single test and | 680 | ;; A container for the state of the execution of a single test and |
| 717 | ;; environment data needed during its execution. | 681 | ;; environment data needed during its execution. |
| @@ -750,7 +714,19 @@ run. ARGS are the arguments to `debugger'." | |||
| 750 | ((quit) 'quit) | 714 | ((quit) 'quit) |
| 751 | ((ert-test-skipped) 'skipped) | 715 | ((ert-test-skipped) 'skipped) |
| 752 | (otherwise 'failed))) | 716 | (otherwise 'failed))) |
| 753 | (backtrace (ert--record-backtrace)) | 717 | ;; We store the backtrace in the result object for |
| 718 | ;; `ert-results-pop-to-backtrace-for-test-at-point'. | ||
| 719 | ;; This means we have to limit `print-level' and | ||
| 720 | ;; `print-length' when printing result objects. That | ||
| 721 | ;; might not be worth while when we can also use | ||
| 722 | ;; `ert-results-rerun-test-debugging-errors-at-point', | ||
| 723 | ;; (i.e., when running interactively) but having the | ||
| 724 | ;; backtrace ready for printing is important for batch | ||
| 725 | ;; use. | ||
| 726 | ;; | ||
| 727 | ;; Grab the frames starting from `signal', frames below | ||
| 728 | ;; that are all from the debugger. | ||
| 729 | (backtrace (backtrace-frames 'signal)) | ||
| 754 | (infos (reverse ert--infos))) | 730 | (infos (reverse ert--infos))) |
| 755 | (setf (ert--test-execution-info-result info) | 731 | (setf (ert--test-execution-info-result info) |
| 756 | (cl-ecase type | 732 | (cl-ecase type |
| @@ -1409,8 +1385,9 @@ Returns the stats object." | |||
| 1409 | (ert-test-result-with-condition | 1385 | (ert-test-result-with-condition |
| 1410 | (message "Test %S backtrace:" (ert-test-name test)) | 1386 | (message "Test %S backtrace:" (ert-test-name test)) |
| 1411 | (with-temp-buffer | 1387 | (with-temp-buffer |
| 1412 | (ert--print-backtrace (ert-test-result-with-condition-backtrace | 1388 | (ert--print-backtrace |
| 1413 | result)) | 1389 | (ert-test-result-with-condition-backtrace result) |
| 1390 | nil) | ||
| 1414 | (goto-char (point-min)) | 1391 | (goto-char (point-min)) |
| 1415 | (while (not (eobp)) | 1392 | (while (not (eobp)) |
| 1416 | (let ((start (point)) | 1393 | (let ((start (point)) |
| @@ -1491,7 +1468,7 @@ this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." | |||
| 1491 | (with-temp-buffer | 1468 | (with-temp-buffer |
| 1492 | (while (setq logfile (pop command-line-args-left)) | 1469 | (while (setq logfile (pop command-line-args-left)) |
| 1493 | (erase-buffer) | 1470 | (erase-buffer) |
| 1494 | (insert-file-contents logfile) | 1471 | (when (file-readable-p logfile) (insert-file-contents logfile)) |
| 1495 | (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t)) | 1472 | (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t)) |
| 1496 | (push logfile notests) | 1473 | (push logfile notests) |
| 1497 | (setq ntests (+ ntests (string-to-number (match-string 1)))) | 1474 | (setq ntests (+ ntests (string-to-number (match-string 1)))) |
| @@ -1828,12 +1805,23 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'." | |||
| 1828 | 1805 | ||
| 1829 | BEGIN and END specify a region in the current buffer." | 1806 | BEGIN and END specify a region in the current buffer." |
| 1830 | (save-excursion | 1807 | (save-excursion |
| 1831 | (save-restriction | 1808 | (goto-char begin) |
| 1832 | (narrow-to-region begin end) | 1809 | (while (progn |
| 1833 | ;; Inhibit optimization in `debugger-make-xrefs' that would | 1810 | (goto-char (+ (point) 2)) |
| 1834 | ;; sometimes insert unrelated backtrace info into our buffer. | 1811 | (skip-syntax-forward "^w_") |
| 1835 | (let ((debugger-previous-backtrace nil)) | 1812 | (< (point) end)) |
| 1836 | (debugger-make-xrefs))))) | 1813 | (let* ((beg (point)) |
| 1814 | (end (progn (skip-syntax-forward "w_") (point))) | ||
| 1815 | (sym (intern-soft (buffer-substring-no-properties | ||
| 1816 | beg end))) | ||
| 1817 | (file (and sym (symbol-file sym 'defun)))) | ||
| 1818 | (when file | ||
| 1819 | (goto-char beg) | ||
| 1820 | ;; help-xref-button needs to operate on something matched | ||
| 1821 | ;; by a regexp, so set that up for it. | ||
| 1822 | (re-search-forward "\\(\\sw\\|\\s_\\)+") | ||
| 1823 | (help-xref-button 0 'help-function-def sym file))) | ||
| 1824 | (forward-line 1)))) | ||
| 1837 | 1825 | ||
| 1838 | (defun ert--string-first-line (s) | 1826 | (defun ert--string-first-line (s) |
| 1839 | "Return the first line of S, or S if it contains no newlines. | 1827 | "Return the first line of S, or S if it contains no newlines. |
| @@ -2420,8 +2408,7 @@ To be used in the ERT results buffer." | |||
| 2420 | ;; Use unibyte because `debugger-setup-buffer' also does so. | 2408 | ;; Use unibyte because `debugger-setup-buffer' also does so. |
| 2421 | (set-buffer-multibyte nil) | 2409 | (set-buffer-multibyte nil) |
| 2422 | (setq truncate-lines t) | 2410 | (setq truncate-lines t) |
| 2423 | (ert--print-backtrace backtrace) | 2411 | (ert--print-backtrace backtrace t) |
| 2424 | (debugger-make-xrefs) | ||
| 2425 | (goto-char (point-min)) | 2412 | (goto-char (point-min)) |
| 2426 | (insert (substitute-command-keys "Backtrace for test `")) | 2413 | (insert (substitute-command-keys "Backtrace for test `")) |
| 2427 | (ert-insert-test-name-button (ert-test-name test)) | 2414 | (ert-insert-test-name-button (ert-test-name test)) |
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index fc3caf3359a..a1c5b6977f8 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el | |||
| @@ -326,12 +326,13 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")" | |||
| 326 | (start (point)) | 326 | (start (point)) |
| 327 | (end (line-end-position))) | 327 | (end (line-end-position))) |
| 328 | ;; Cope with multi-line copyright `lines'. Assume the second | 328 | ;; Cope with multi-line copyright `lines'. Assume the second |
| 329 | ;; line is indented (with the same commenting style). | 329 | ;; line is indented at least as much as the original, with the |
| 330 | ;; same commenting style. | ||
| 330 | (save-excursion | 331 | (save-excursion |
| 331 | (beginning-of-line 2) | 332 | (beginning-of-line 2) |
| 332 | (let ((str (concat (match-string-no-properties 1) "[ \t]+"))) | 333 | (let ((str (match-string-no-properties 1))) |
| 333 | (beginning-of-line) | 334 | (beginning-of-line) |
| 334 | (while (looking-at str) | 335 | (while (and (looking-at str) (not (looking-at lm-copyright-prefix))) |
| 335 | (setq end (line-end-position)) | 336 | (setq end (line-end-position)) |
| 336 | (beginning-of-line 2)))) | 337 | (beginning-of-line 2)))) |
| 337 | ;; Make a single line and parse that. | 338 | ;; Make a single line and parse that. |
diff --git a/lisp/epg.el b/lisp/epg.el index 587271b0003..1e24b8d1169 100644 --- a/lisp/epg.el +++ b/lisp/epg.el | |||
| @@ -1047,7 +1047,7 @@ callback data (if any)." | |||
| 1047 | (defun epg--status-TRUST_MARGINAL (context _string) | 1047 | (defun epg--status-TRUST_MARGINAL (context _string) |
| 1048 | (let ((signature (car (epg-context-result-for context 'verify)))) | 1048 | (let ((signature (car (epg-context-result-for context 'verify)))) |
| 1049 | (if (and signature | 1049 | (if (and signature |
| 1050 | (eq (epg-signature-status signature) 'marginal)) | 1050 | (eq (epg-signature-status signature) 'good)) |
| 1051 | (setf (epg-signature-validity signature) 'marginal)))) | 1051 | (setf (epg-signature-validity signature) 'marginal)))) |
| 1052 | 1052 | ||
| 1053 | (defun epg--status-TRUST_FULLY (context _string) | 1053 | (defun epg--status-TRUST_FULLY (context _string) |
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 86e7b83c281..24342208771 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el | |||
| @@ -1148,6 +1148,8 @@ be finished later after the completion of an asynchronous subprocess." | |||
| 1148 | 1148 | ||
| 1149 | ;; command invocation | 1149 | ;; command invocation |
| 1150 | 1150 | ||
| 1151 | (declare-function help-fns-function-description-header "help-fns") | ||
| 1152 | |||
| 1151 | (defun eshell/which (command &rest names) | 1153 | (defun eshell/which (command &rest names) |
| 1152 | "Identify the COMMAND, and where it is located." | 1154 | "Identify the COMMAND, and where it is located." |
| 1153 | (dolist (name (cons command names)) | 1155 | (dolist (name (cons command names)) |
| @@ -1164,25 +1166,17 @@ be finished later after the completion of an asynchronous subprocess." | |||
| 1164 | (concat name " is an alias, defined as \"" | 1166 | (concat name " is an alias, defined as \"" |
| 1165 | (cadr alias) "\""))) | 1167 | (cadr alias) "\""))) |
| 1166 | (unless program | 1168 | (unless program |
| 1167 | (setq program (eshell-search-path name)) | 1169 | (setq program |
| 1168 | (let* ((esym (eshell-find-alias-function name)) | 1170 | (let* ((esym (eshell-find-alias-function name)) |
| 1169 | (sym (or esym (intern-soft name)))) | 1171 | (sym (or esym (intern-soft name)))) |
| 1170 | (if (and (or esym (and sym (fboundp sym))) | 1172 | (if (and (or esym (and sym (fboundp sym))) |
| 1171 | (or eshell-prefer-lisp-functions (not direct))) | 1173 | (or eshell-prefer-lisp-functions (not direct))) |
| 1172 | (let ((desc (let ((inhibit-redisplay t)) | 1174 | (or (with-output-to-string |
| 1173 | (save-window-excursion | 1175 | (require 'help-fns) |
| 1174 | (prog1 | 1176 | (princ (format "%s is " sym)) |
| 1175 | (describe-function sym) | 1177 | (help-fns-function-description-header sym)) |
| 1176 | (message nil)))))) | 1178 | name) |
| 1177 | (setq desc (if desc (substring desc 0 | 1179 | (eshell-search-path name))))) |
| 1178 | (1- (or (string-match "\n" desc) | ||
| 1179 | (length desc)))) | ||
| 1180 | ;; This should not happen. | ||
| 1181 | (format "%s is defined, \ | ||
| 1182 | but no documentation was found" name))) | ||
| 1183 | (if (buffer-live-p (get-buffer "*Help*")) | ||
| 1184 | (kill-buffer "*Help*")) | ||
| 1185 | (setq program (or desc name)))))) | ||
| 1186 | (if (not program) | 1180 | (if (not program) |
| 1187 | (eshell-error (format "which: no %s in (%s)\n" | 1181 | (eshell-error (format "which: no %s in (%s)\n" |
| 1188 | name (getenv "PATH"))) | 1182 | name (getenv "PATH"))) |
diff --git a/lisp/frame.el b/lisp/frame.el index b7a55169281..b54df6fa160 100644 --- a/lisp/frame.el +++ b/lisp/frame.el | |||
| @@ -1110,6 +1110,38 @@ differing font heights." | |||
| 1110 | If FRAME is omitted, describe the currently selected frame." | 1110 | If FRAME is omitted, describe the currently selected frame." |
| 1111 | (cdr (assq 'width (frame-parameters frame)))) | 1111 | (cdr (assq 'width (frame-parameters frame)))) |
| 1112 | 1112 | ||
| 1113 | (defalias 'frame-border-width 'frame-internal-border-width) | ||
| 1114 | (defalias 'frame-pixel-width 'frame-native-width) | ||
| 1115 | (defalias 'frame-pixel-height 'frame-native-height) | ||
| 1116 | |||
| 1117 | (defun frame-inner-width (&optional frame) | ||
| 1118 | "Return inner width of FRAME in pixels. | ||
| 1119 | FRAME defaults to the selected frame." | ||
| 1120 | (setq frame (window-normalize-frame frame)) | ||
| 1121 | (- (frame-native-width frame) | ||
| 1122 | (* 2 (frame-internal-border-width frame)))) | ||
| 1123 | |||
| 1124 | (defun frame-inner-height (&optional frame) | ||
| 1125 | "Return inner height of FRAME in pixels. | ||
| 1126 | FRAME defaults to the selected frame." | ||
| 1127 | (setq frame (window-normalize-frame frame)) | ||
| 1128 | (- (frame-native-height frame) | ||
| 1129 | (* 2 (frame-internal-border-width frame)))) | ||
| 1130 | |||
| 1131 | (defun frame-outer-width (&optional frame) | ||
| 1132 | "Return outer width of FRAME in pixels. | ||
| 1133 | FRAME defaults to the selected frame." | ||
| 1134 | (setq frame (window-normalize-frame frame)) | ||
| 1135 | (let ((edges (frame-edges frame 'outer-edges))) | ||
| 1136 | (- (nth 2 edges) (nth 0 edges)))) | ||
| 1137 | |||
| 1138 | (defun frame-outer-height (&optional frame) | ||
| 1139 | "Return outer height of FRAME in pixels. | ||
| 1140 | FRAME defaults to the selected frame." | ||
| 1141 | (setq frame (window-normalize-frame frame)) | ||
| 1142 | (let ((edges (frame-edges frame 'outer-edges))) | ||
| 1143 | (- (nth 3 edges) (nth 1 edges)))) | ||
| 1144 | |||
| 1113 | (declare-function x-list-fonts "xfaces.c" | 1145 | (declare-function x-list-fonts "xfaces.c" |
| 1114 | (pattern &optional face frame maximum width)) | 1146 | (pattern &optional face frame maximum width)) |
| 1115 | 1147 | ||
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 2c635ffa500..32324ae3bcb 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -560,8 +560,9 @@ FILE is the file where FUNCTION was probably defined." | |||
| 560 | (setq short rel)))) | 560 | (setq short rel)))) |
| 561 | short)) | 561 | short)) |
| 562 | 562 | ||
| 563 | ;;;###autoload | 563 | (defun help-fns--analyse-function (function) |
| 564 | (defun describe-function-1 (function) | 564 | "Return information about FUNCTION. |
| 565 | Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." | ||
| 565 | (let* ((advised (and (symbolp function) | 566 | (let* ((advised (and (symbolp function) |
| 566 | (featurep 'nadvice) | 567 | (featurep 'nadvice) |
| 567 | (advice--p (advice--symbol-function function)))) | 568 | (advice--p (advice--symbol-function function)))) |
| @@ -594,22 +595,24 @@ FILE is the file where FUNCTION was probably defined." | |||
| 594 | (setq f (symbol-function f))) | 595 | (setq f (symbol-function f))) |
| 595 | f)) | 596 | f)) |
| 596 | ((subrp def) (intern (subr-name def))) | 597 | ((subrp def) (intern (subr-name def))) |
| 597 | (t def))) | 598 | (t def)))) |
| 598 | (sig-key (if (subrp def) | 599 | (list real-function def aliased real-def))) |
| 599 | (indirect-function real-def) | 600 | |
| 600 | real-def)) | 601 | (defun help-fns-function-description-header (function) |
| 601 | (file-name (find-lisp-object-file-name function (if aliased 'defun | 602 | "Print a line describing FUNCTION to `standard-output'." |
| 602 | def))) | 603 | (pcase-let* ((`(,_real-function ,def ,aliased ,real-def) |
| 603 | (pt1 (with-current-buffer (help-buffer) (point))) | 604 | (help-fns--analyse-function function)) |
| 604 | (beg (if (and (or (byte-code-function-p def) | 605 | (file-name (find-lisp-object-file-name function (if aliased 'defun |
| 605 | (keymapp def) | 606 | def))) |
| 606 | (memq (car-safe def) '(macro lambda closure))) | 607 | (beg (if (and (or (byte-code-function-p def) |
| 607 | (stringp file-name) | 608 | (keymapp def) |
| 608 | (help-fns--autoloaded-p function file-name)) | 609 | (memq (car-safe def) '(macro lambda closure))) |
| 609 | (if (commandp def) | 610 | (stringp file-name) |
| 610 | "an interactive autoloaded " | 611 | (help-fns--autoloaded-p function file-name)) |
| 611 | "an autoloaded ") | 612 | (if (commandp def) |
| 612 | (if (commandp def) "an interactive " "a ")))) | 613 | "an interactive autoloaded " |
| 614 | "an autoloaded ") | ||
| 615 | (if (commandp def) "an interactive " "a ")))) | ||
| 613 | 616 | ||
| 614 | ;; Print what kind of function-like object FUNCTION is. | 617 | ;; Print what kind of function-like object FUNCTION is. |
| 615 | (princ (cond ((or (stringp def) (vectorp def)) | 618 | (princ (cond ((or (stringp def) (vectorp def)) |
| @@ -676,34 +679,42 @@ FILE is the file where FUNCTION was probably defined." | |||
| 676 | (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") | 679 | (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") |
| 677 | nil t) | 680 | nil t) |
| 678 | (help-xref-button 1 'help-function-def function file-name)))) | 681 | (help-xref-button 1 'help-function-def function file-name)))) |
| 679 | (princ ".") | 682 | (princ ".")))) |
| 680 | (with-current-buffer (help-buffer) | 683 | |
| 681 | (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) | 684 | ;;;###autoload |
| 682 | (point))) | 685 | (defun describe-function-1 (function) |
| 683 | (terpri)(terpri) | 686 | (let ((pt1 (with-current-buffer (help-buffer) (point)))) |
| 684 | 687 | (help-fns-function-description-header function) | |
| 685 | (let ((doc-raw (documentation function t)) | 688 | (with-current-buffer (help-buffer) |
| 686 | (key-bindings-buffer (current-buffer))) | 689 | (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) |
| 687 | 690 | (point)))) | |
| 688 | ;; If the function is autoloaded, and its docstring has | 691 | (terpri)(terpri) |
| 689 | ;; key substitution constructs, load the library. | 692 | |
| 690 | (and (autoloadp real-def) doc-raw | 693 | (pcase-let ((`(,real-function ,def ,_aliased ,real-def) |
| 691 | help-enable-auto-load | 694 | (help-fns--analyse-function function)) |
| 692 | (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) | 695 | (doc-raw (documentation function t)) |
| 693 | (autoload-do-load real-def)) | 696 | (key-bindings-buffer (current-buffer))) |
| 694 | 697 | ||
| 695 | (help-fns--key-bindings function) | 698 | ;; If the function is autoloaded, and its docstring has |
| 696 | (with-current-buffer standard-output | 699 | ;; key substitution constructs, load the library. |
| 697 | (let ((doc (help-fns--signature function doc-raw sig-key | 700 | (and (autoloadp real-def) doc-raw |
| 698 | real-function key-bindings-buffer))) | 701 | help-enable-auto-load |
| 699 | (run-hook-with-args 'help-fns-describe-function-functions function) | 702 | (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) |
| 700 | (insert "\n" | 703 | (autoload-do-load real-def)) |
| 701 | (or doc "Not documented.")) | 704 | |
| 702 | ;; Avoid asking the user annoying questions if she decides | 705 | (help-fns--key-bindings function) |
| 703 | ;; to save the help buffer, when her locale's codeset | 706 | (with-current-buffer standard-output |
| 704 | ;; isn't UTF-8. | 707 | (let ((doc (help-fns--signature |
| 705 | (unless (memq text-quoting-style '(straight grave)) | 708 | function doc-raw |
| 706 | (set-buffer-file-coding-system 'utf-8)))))))) | 709 | (if (subrp def) (indirect-function real-def) real-def) |
| 710 | real-function key-bindings-buffer))) | ||
| 711 | (run-hook-with-args 'help-fns-describe-function-functions function) | ||
| 712 | (insert "\n" (or doc "Not documented."))) | ||
| 713 | ;; Avoid asking the user annoying questions if she decides | ||
| 714 | ;; to save the help buffer, when her locale's codeset | ||
| 715 | ;; isn't UTF-8. | ||
| 716 | (unless (memq text-quoting-style '(straight grave)) | ||
| 717 | (set-buffer-file-coding-system 'utf-8))))) | ||
| 707 | 718 | ||
| 708 | ;; Add defaults to `help-fns-describe-function-functions'. | 719 | ;; Add defaults to `help-fns-describe-function-functions'. |
| 709 | (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) | 720 | (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) |
diff --git a/lisp/help.el b/lisp/help.el index 361ab2a01ee..0fb1c2dab77 100644 --- a/lisp/help.el +++ b/lisp/help.el | |||
| @@ -593,6 +593,39 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." | |||
| 593 | string | 593 | string |
| 594 | (format "%s (translated from %s)" string otherstring)))))) | 594 | (format "%s (translated from %s)" string otherstring)))))) |
| 595 | 595 | ||
| 596 | (defun help--analyze-key (key untranslated) | ||
| 597 | "Get information about KEY its corresponding UNTRANSLATED events. | ||
| 598 | Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)." | ||
| 599 | (if (numberp untranslated) | ||
| 600 | (setq untranslated (this-single-command-raw-keys))) | ||
| 601 | (let* ((event (aref key (if (and (symbolp (aref key 0)) | ||
| 602 | (> (length key) 1) | ||
| 603 | (consp (aref key 1))) | ||
| 604 | 1 | ||
| 605 | 0))) | ||
| 606 | (modifiers (event-modifiers event)) | ||
| 607 | (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) | ||
| 608 | (memq 'drag modifiers)) " at that spot" "")) | ||
| 609 | (defn (key-binding key t))) | ||
| 610 | ;; Handle the case where we faked an entry in "Select and Paste" menu. | ||
| 611 | (when (and (eq defn nil) | ||
| 612 | (stringp (aref key (1- (length key)))) | ||
| 613 | (eq (key-binding (substring key 0 -1)) 'yank-menu)) | ||
| 614 | (setq defn 'menu-bar-select-yank)) | ||
| 615 | ;; Don't bother user with strings from (e.g.) the select-paste menu. | ||
| 616 | (when (stringp (aref key (1- (length key)))) | ||
| 617 | (aset key (1- (length key)) "(any string)")) | ||
| 618 | (when (and untranslated | ||
| 619 | (stringp (aref untranslated (1- (length untranslated))))) | ||
| 620 | (aset untranslated (1- (length untranslated)) "(any string)")) | ||
| 621 | (list | ||
| 622 | ;; Now describe the key, perhaps as changed. | ||
| 623 | (let ((key-desc (help-key-description key untranslated))) | ||
| 624 | (if (or (null defn) (integerp defn) (equal defn 'undefined)) | ||
| 625 | (format "%s%s is undefined" key-desc mouse-msg) | ||
| 626 | (format "%s%s runs the command %S" key-desc mouse-msg defn))) | ||
| 627 | defn event mouse-msg))) | ||
| 628 | |||
| 596 | (defun describe-key-briefly (&optional key insert untranslated) | 629 | (defun describe-key-briefly (&optional key insert untranslated) |
| 597 | "Print the name of the function KEY invokes. KEY is a string. | 630 | "Print the name of the function KEY invokes. KEY is a string. |
| 598 | If INSERT (the prefix arg) is non-nil, insert the message in the buffer. | 631 | If INSERT (the prefix arg) is non-nil, insert the message in the buffer. |
| @@ -603,73 +636,12 @@ the last key hit are used. | |||
| 603 | If KEY is a menu item or a tool-bar button that is disabled, this command | 636 | If KEY is a menu item or a tool-bar button that is disabled, this command |
| 604 | temporarily enables it to allow getting help on disabled items and buttons." | 637 | temporarily enables it to allow getting help on disabled items and buttons." |
| 605 | (interactive | 638 | (interactive |
| 606 | (let ((enable-disabled-menus-and-buttons t) | 639 | ;; Ignore mouse movement events because it's too easy to miss the |
| 607 | (cursor-in-echo-area t) | 640 | ;; message while moving the mouse. |
| 608 | saved-yank-menu) | 641 | (pcase-let ((`(,key ,_up-event) (help-read-key-sequence 'no-mouse-movement))) |
| 609 | (unwind-protect | 642 | `(,key ,current-prefix-arg 1))) |
| 610 | (let (key) | 643 | (princ (car (help--analyze-key key untranslated)) |
| 611 | ;; If yank-menu is empty, populate it temporarily, so that | 644 | (if insert (current-buffer) standard-output))) |
| 612 | ;; "Select and Paste" menu can generate a complete event. | ||
| 613 | (when (null (cdr yank-menu)) | ||
| 614 | (setq saved-yank-menu (copy-sequence yank-menu)) | ||
| 615 | (menu-bar-update-yank-menu "(any string)" nil)) | ||
| 616 | (while | ||
| 617 | (progn | ||
| 618 | (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: ")) | ||
| 619 | (and (vectorp key) | ||
| 620 | (consp (aref key 0)) | ||
| 621 | (symbolp (car (aref key 0))) | ||
| 622 | (string-match "\\(mouse\\|down\\|click\\|drag\\)" | ||
| 623 | (symbol-name (car (aref key 0)))) | ||
| 624 | (not (sit-for (/ double-click-time 1000.0) t))))) | ||
| 625 | ;; Clear the echo area message (Bug#7014). | ||
| 626 | (message nil) | ||
| 627 | ;; If KEY is a down-event, read and discard the | ||
| 628 | ;; corresponding up-event. Note that there are also | ||
| 629 | ;; down-events on scroll bars and mode lines: the actual | ||
| 630 | ;; event then is in the second element of the vector. | ||
| 631 | (and (vectorp key) | ||
| 632 | (let ((last-idx (1- (length key)))) | ||
| 633 | (and (eventp (aref key last-idx)) | ||
| 634 | (memq 'down (event-modifiers (aref key last-idx))))) | ||
| 635 | (read-event)) | ||
| 636 | (list | ||
| 637 | key | ||
| 638 | (if current-prefix-arg (prefix-numeric-value current-prefix-arg)) | ||
| 639 | 1)) | ||
| 640 | ;; Put yank-menu back as it was, if we changed it. | ||
| 641 | (when saved-yank-menu | ||
| 642 | (setq yank-menu (copy-sequence saved-yank-menu)) | ||
| 643 | (fset 'yank-menu (cons 'keymap yank-menu)))))) | ||
| 644 | (if (numberp untranslated) | ||
| 645 | (setq untranslated (this-single-command-raw-keys))) | ||
| 646 | (let* ((event (if (and (symbolp (aref key 0)) | ||
| 647 | (> (length key) 1) | ||
| 648 | (consp (aref key 1))) | ||
| 649 | (aref key 1) | ||
| 650 | (aref key 0))) | ||
| 651 | (modifiers (event-modifiers event)) | ||
| 652 | (standard-output (if insert (current-buffer) standard-output)) | ||
| 653 | (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) | ||
| 654 | (memq 'drag modifiers)) " at that spot" "")) | ||
| 655 | (defn (key-binding key t)) | ||
| 656 | key-desc) | ||
| 657 | ;; Handle the case where we faked an entry in "Select and Paste" menu. | ||
| 658 | (if (and (eq defn nil) | ||
| 659 | (stringp (aref key (1- (length key)))) | ||
| 660 | (eq (key-binding (substring key 0 -1)) 'yank-menu)) | ||
| 661 | (setq defn 'menu-bar-select-yank)) | ||
| 662 | ;; Don't bother user with strings from (e.g.) the select-paste menu. | ||
| 663 | (if (stringp (aref key (1- (length key)))) | ||
| 664 | (aset key (1- (length key)) "(any string)")) | ||
| 665 | (if (and (> (length untranslated) 0) | ||
| 666 | (stringp (aref untranslated (1- (length untranslated))))) | ||
| 667 | (aset untranslated (1- (length untranslated)) "(any string)")) | ||
| 668 | ;; Now describe the key, perhaps as changed. | ||
| 669 | (setq key-desc (help-key-description key untranslated)) | ||
| 670 | (if (or (null defn) (integerp defn) (equal defn 'undefined)) | ||
| 671 | (princ (format "%s%s is undefined" key-desc mouse-msg)) | ||
| 672 | (princ (format "%s%s runs the command %S" key-desc mouse-msg defn))))) | ||
| 673 | 645 | ||
| 674 | (defun help--key-binding-keymap (key &optional accept-default no-remap position) | 646 | (defun help--key-binding-keymap (key &optional accept-default no-remap position) |
| 675 | "Return a keymap holding a binding for KEY within current keymaps. | 647 | "Return a keymap holding a binding for KEY within current keymaps. |
| @@ -734,6 +706,59 @@ function `key-binding'." | |||
| 734 | (throw 'found x)))) | 706 | (throw 'found x)))) |
| 735 | nil))))) | 707 | nil))))) |
| 736 | 708 | ||
| 709 | (defun help-read-key-sequence (&optional no-mouse-movement) | ||
| 710 | "Reads a key sequence from the user. | ||
| 711 | Returns a list of the form (KEY UP-EVENT), where KEY is the key | ||
| 712 | sequence, and UP-EVENT is the up-event that was discarded by | ||
| 713 | reading KEY, or nil. | ||
| 714 | If NO-MOUSE-MOVEMENT is non-nil, ignore key sequences starting | ||
| 715 | with `mouse-movement' events." | ||
| 716 | (let ((enable-disabled-menus-and-buttons t) | ||
| 717 | (cursor-in-echo-area t) | ||
| 718 | saved-yank-menu) | ||
| 719 | (unwind-protect | ||
| 720 | (let (key) | ||
| 721 | ;; If yank-menu is empty, populate it temporarily, so that | ||
| 722 | ;; "Select and Paste" menu can generate a complete event. | ||
| 723 | (when (null (cdr yank-menu)) | ||
| 724 | (setq saved-yank-menu (copy-sequence yank-menu)) | ||
| 725 | (menu-bar-update-yank-menu "(any string)" nil)) | ||
| 726 | (while | ||
| 727 | (pcase (setq key (read-key-sequence "\ | ||
| 728 | Describe the following key, mouse click, or menu item: ")) | ||
| 729 | ((and (pred vectorp) (let `(,key0 . ,_) (aref key 0)) | ||
| 730 | (guard (symbolp key0)) (let keyname (symbol-name key0))) | ||
| 731 | (if no-mouse-movement | ||
| 732 | (string-match "mouse-movement" keyname) | ||
| 733 | (and (string-match "\\(mouse\\|down\\|click\\|drag\\)" | ||
| 734 | keyname) | ||
| 735 | (not (sit-for (/ double-click-time 1000.0) t))))))) | ||
| 736 | (list | ||
| 737 | key | ||
| 738 | ;; If KEY is a down-event, read and include the | ||
| 739 | ;; corresponding up-event. Note that there are also | ||
| 740 | ;; down-events on scroll bars and mode lines: the actual | ||
| 741 | ;; event then is in the second element of the vector. | ||
| 742 | (and (vectorp key) | ||
| 743 | (let ((last-idx (1- (length key)))) | ||
| 744 | (and (eventp (aref key last-idx)) | ||
| 745 | (memq 'down (event-modifiers (aref key last-idx))))) | ||
| 746 | (or (and (eventp (aref key 0)) | ||
| 747 | (memq 'down (event-modifiers (aref key 0))) | ||
| 748 | ;; However, for the C-down-mouse-2 popup | ||
| 749 | ;; menu, there is no subsequent up-event. In | ||
| 750 | ;; this case, the up-event is the next | ||
| 751 | ;; element in the supplied vector. | ||
| 752 | (= (length key) 1)) | ||
| 753 | (and (> (length key) 1) | ||
| 754 | (eventp (aref key 1)) | ||
| 755 | (memq 'down (event-modifiers (aref key 1))))) | ||
| 756 | (read-event)))) | ||
| 757 | ;; Put yank-menu back as it was, if we changed it. | ||
| 758 | (when saved-yank-menu | ||
| 759 | (setq yank-menu (copy-sequence saved-yank-menu)) | ||
| 760 | (fset 'yank-menu (cons 'keymap yank-menu)))))) | ||
| 761 | |||
| 737 | (defun describe-key (&optional key untranslated up-event) | 762 | (defun describe-key (&optional key untranslated up-event) |
| 738 | "Display documentation of the function invoked by KEY. | 763 | "Display documentation of the function invoked by KEY. |
| 739 | KEY can be any kind of a key sequence; it can include keyboard events, | 764 | 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. | |||
| 748 | If KEY is a menu item or a tool-bar button that is disabled, this command | 773 | If KEY is a menu item or a tool-bar button that is disabled, this command |
| 749 | temporarily enables it to allow getting help on disabled items and buttons." | 774 | temporarily enables it to allow getting help on disabled items and buttons." |
| 750 | (interactive | 775 | (interactive |
| 751 | (let ((enable-disabled-menus-and-buttons t) | 776 | (pcase-let ((`(,key ,up-event) (help-read-key-sequence))) |
| 752 | (cursor-in-echo-area t) | 777 | `(,key ,(prefix-numeric-value current-prefix-arg) ,up-event))) |
| 753 | saved-yank-menu) | 778 | (pcase-let ((`(,brief-desc ,defn ,event ,mouse-msg) |
| 754 | (unwind-protect | 779 | (help--analyze-key key untranslated)) |
| 755 | (let (key) | 780 | (defn-up nil) (defn-up-tricky nil) |
| 756 | ;; If yank-menu is empty, populate it temporarily, so that | 781 | (key-locus-up nil) (key-locus-up-tricky nil) |
| 757 | ;; "Select and Paste" menu can generate a complete event. | 782 | (mouse-1-remapped nil) (mouse-1-tricky nil) |
| 758 | (when (null (cdr yank-menu)) | 783 | (ev-type nil)) |
| 759 | (setq saved-yank-menu (copy-sequence yank-menu)) | 784 | (if (or (null defn) |
| 760 | (menu-bar-update-yank-menu "(any string)" nil)) | 785 | (integerp defn) |
| 761 | (while | 786 | (equal defn 'undefined)) |
| 762 | (progn | 787 | (message "%s" brief-desc) |
| 763 | (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: ")) | ||
| 764 | (and (vectorp key) | ||
| 765 | (consp (aref key 0)) | ||
| 766 | (symbolp (car (aref key 0))) | ||
| 767 | (string-match "\\(mouse\\|down\\|click\\|drag\\)" | ||
| 768 | (symbol-name (car (aref key 0)))) | ||
| 769 | (not (sit-for (/ double-click-time 1000.0) t))))) | ||
| 770 | (list | ||
| 771 | key | ||
| 772 | (prefix-numeric-value current-prefix-arg) | ||
| 773 | ;; If KEY is a down-event, read and include the | ||
| 774 | ;; corresponding up-event. Note that there are also | ||
| 775 | ;; down-events on scroll bars and mode lines: the actual | ||
| 776 | ;; event then is in the second element of the vector. | ||
| 777 | (and (vectorp key) | ||
| 778 | (let ((last-idx (1- (length key)))) | ||
| 779 | (and (eventp (aref key last-idx)) | ||
| 780 | (memq 'down (event-modifiers (aref key last-idx))))) | ||
| 781 | (or (and (eventp (aref key 0)) | ||
| 782 | (memq 'down (event-modifiers (aref key 0))) | ||
| 783 | ;; However, for the C-down-mouse-2 popup | ||
| 784 | ;; menu, there is no subsequent up-event. In | ||
| 785 | ;; this case, the up-event is the next | ||
| 786 | ;; element in the supplied vector. | ||
| 787 | (= (length key) 1)) | ||
| 788 | (and (> (length key) 1) | ||
| 789 | (eventp (aref key 1)) | ||
| 790 | (memq 'down (event-modifiers (aref key 1))))) | ||
| 791 | (read-event)))) | ||
| 792 | ;; Put yank-menu back as it was, if we changed it. | ||
| 793 | (when saved-yank-menu | ||
| 794 | (setq yank-menu (copy-sequence saved-yank-menu)) | ||
| 795 | (fset 'yank-menu (cons 'keymap yank-menu)))))) | ||
| 796 | (if (numberp untranslated) | ||
| 797 | (setq untranslated (this-single-command-raw-keys))) | ||
| 798 | (let* ((event (aref key (if (and (symbolp (aref key 0)) | ||
| 799 | (> (length key) 1) | ||
| 800 | (consp (aref key 1))) | ||
| 801 | 1 | ||
| 802 | 0))) | ||
| 803 | (modifiers (event-modifiers event)) | ||
| 804 | (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) | ||
| 805 | (memq 'drag modifiers)) " at that spot" "")) | ||
| 806 | (defn (key-binding key t)) | ||
| 807 | key-locus key-locus-up key-locus-up-tricky | ||
| 808 | defn-up defn-up-tricky ev-type | ||
| 809 | mouse-1-remapped mouse-1-tricky) | ||
| 810 | |||
| 811 | ;; Handle the case where we faked an entry in "Select and Paste" menu. | ||
| 812 | (when (and (eq defn nil) | ||
| 813 | (stringp (aref key (1- (length key)))) | ||
| 814 | (eq (key-binding (substring key 0 -1)) 'yank-menu)) | ||
| 815 | (setq defn 'menu-bar-select-yank)) | ||
| 816 | (if (or (null defn) (integerp defn) (equal defn 'undefined)) | ||
| 817 | (message "%s%s is undefined" | ||
| 818 | (help-key-description key untranslated) mouse-msg) | ||
| 819 | (help-setup-xref (list #'describe-function defn) | 788 | (help-setup-xref (list #'describe-function defn) |
| 820 | (called-interactively-p 'interactive)) | 789 | (called-interactively-p 'interactive)) |
| 821 | ;; Don't bother user with strings from (e.g.) the select-paste menu. | ||
| 822 | (when (stringp (aref key (1- (length key)))) | ||
| 823 | (aset key (1- (length key)) "(any string)")) | ||
| 824 | (when (and untranslated | ||
| 825 | (stringp (aref untranslated (1- (length untranslated))))) | ||
| 826 | (aset untranslated (1- (length untranslated)) | ||
| 827 | "(any string)")) | ||
| 828 | ;; Need to do this before erasing *Help* buffer in case event | 790 | ;; Need to do this before erasing *Help* buffer in case event |
| 829 | ;; is a mouse click in an existing *Help* buffer. | 791 | ;; is a mouse click in an existing *Help* buffer. |
| 830 | (when up-event | 792 | (when up-event |
| @@ -849,13 +811,12 @@ temporarily enables it to allow getting help on disabled items and buttons." | |||
| 849 | (aset sequence 0 'mouse-1) | 811 | (aset sequence 0 'mouse-1) |
| 850 | (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))) | 812 | (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))) |
| 851 | (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event)))))) | 813 | (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event)))))) |
| 852 | (setq key-locus (help--binding-locus key (event-start event))) | ||
| 853 | (with-help-window (help-buffer) | 814 | (with-help-window (help-buffer) |
| 854 | (princ (help-key-description key untranslated)) | 815 | (princ brief-desc) |
| 855 | (princ (format "%s runs the command %S%s, which is " | 816 | (let ((key-locus (help--binding-locus key (event-start event)))) |
| 856 | mouse-msg defn (if key-locus | 817 | (when key-locus |
| 857 | (format " (found in %s)" key-locus) | 818 | (princ (format " (found in %s)" key-locus)))) |
| 858 | ""))) | 819 | (princ ", which is ") |
| 859 | (describe-function-1 defn) | 820 | (describe-function-1 defn) |
| 860 | (when up-event | 821 | (when up-event |
| 861 | (unless (or (null defn-up) | 822 | (unless (or (null defn-up) |
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ae28ba93e61..dababdb4fa6 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el | |||
| @@ -4952,7 +4952,7 @@ call other entry points instead, such as `cl-prin1'. | |||
| 4952 | 4952 | ||
| 4953 | \(fn OBJECT)" nil nil) | 4953 | \(fn OBJECT)" nil nil) |
| 4954 | 4954 | ||
| 4955 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-"))) | 4955 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code"))) |
| 4956 | 4956 | ||
| 4957 | ;;;*** | 4957 | ;;;*** |
| 4958 | 4958 | ||
| @@ -16544,18 +16544,6 @@ The optional LABEL is used to label the buffer created. | |||
| 16544 | 16544 | ||
| 16545 | ;;;*** | 16545 | ;;;*** |
| 16546 | 16546 | ||
| 16547 | ;;;### (autoloads nil "html2text" "net/html2text.el" (0 0 0 0)) | ||
| 16548 | ;;; Generated autoloads from net/html2text.el | ||
| 16549 | |||
| 16550 | (autoload 'html2text "html2text" "\ | ||
| 16551 | Convert HTML to plain text in the current buffer. | ||
| 16552 | |||
| 16553 | \(fn)" t nil) | ||
| 16554 | |||
| 16555 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "html2text" '("html2text-"))) | ||
| 16556 | |||
| 16557 | ;;;*** | ||
| 16558 | |||
| 16559 | ;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0)) | 16547 | ;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0)) |
| 16560 | ;;; Generated autoloads from htmlfontify.el | 16548 | ;;; Generated autoloads from htmlfontify.el |
| 16561 | (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) | 16549 | (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) |
| @@ -30399,7 +30387,7 @@ then `snmpv2-mode-hook'. | |||
| 30399 | 30387 | ||
| 30400 | ;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) | 30388 | ;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) |
| 30401 | ;;; Generated autoloads from net/soap-client.el | 30389 | ;;; Generated autoloads from net/soap-client.el |
| 30402 | (push (purecopy '(soap-client 3 1 2)) package--builtin-versions) | 30390 | (push (purecopy '(soap-client 3 1 3)) package--builtin-versions) |
| 30403 | 30391 | ||
| 30404 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-"))) | 30392 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-"))) |
| 30405 | 30393 | ||
| @@ -34165,7 +34153,7 @@ Reenable Ange-FTP, when Tramp is unloaded. | |||
| 34165 | 34153 | ||
| 34166 | ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) | 34154 | ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) |
| 34167 | ;;; Generated autoloads from net/trampver.el | 34155 | ;;; Generated autoloads from net/trampver.el |
| 34168 | (push (purecopy '(tramp 2 3 2 -1)) package--builtin-versions) | 34156 | (push (purecopy '(tramp 2 3 2)) package--builtin-versions) |
| 34169 | 34157 | ||
| 34170 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) | 34158 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) |
| 34171 | 34159 | ||
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index c3480cd6c64..e5b1029c01f 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -746,7 +746,7 @@ If the current buffer is not a minibuffer, erase its entire contents." | |||
| 746 | 746 | ||
| 747 | (defcustom completion-auto-help t | 747 | (defcustom completion-auto-help t |
| 748 | "Non-nil means automatically provide help for invalid completion input. | 748 | "Non-nil means automatically provide help for invalid completion input. |
| 749 | If the value is t the *Completion* buffer is displayed whenever completion | 749 | If the value is t the *Completions* buffer is displayed whenever completion |
| 750 | is requested but cannot be done. | 750 | is requested but cannot be done. |
| 751 | If the value is `lazy', the *Completions* buffer is only displayed after | 751 | If the value is `lazy', the *Completions* buffer is only displayed after |
| 752 | the second failed attempt to complete." | 752 | the second failed attempt to complete." |
diff --git a/lisp/mouse.el b/lisp/mouse.el index 9b6b169e568..e0794435d7a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el | |||
| @@ -380,7 +380,7 @@ This command must be bound to a mouse click." | |||
| 380 | 380 | ||
| 381 | (defun mouse-drag-line (start-event line) | 381 | (defun mouse-drag-line (start-event line) |
| 382 | "Drag a mode line, header line, or vertical line with the mouse. | 382 | "Drag a mode line, header line, or vertical line with the mouse. |
| 383 | START-EVENT is the starting mouse-event of the drag action. LINE | 383 | START-EVENT is the starting mouse event of the drag action. LINE |
| 384 | must be one of the symbols `header', `mode', or `vertical'." | 384 | must be one of the symbols `header', `mode', or `vertical'." |
| 385 | ;; Give temporary modes such as isearch a chance to turn off. | 385 | ;; Give temporary modes such as isearch a chance to turn off. |
| 386 | (run-hooks 'mouse-leave-buffer-hook) | 386 | (run-hooks 'mouse-leave-buffer-hook) |
| @@ -405,29 +405,15 @@ must be one of the symbols `header', `mode', or `vertical'." | |||
| 405 | ;; window's edge we drag. | 405 | ;; window's edge we drag. |
| 406 | (cond | 406 | (cond |
| 407 | ((eq line 'header) | 407 | ((eq line 'header) |
| 408 | (if (window-at-side-p window 'top) | 408 | ;; Drag bottom edge of window above the header line. |
| 409 | ;; We can't drag the header line of a topmost window. | 409 | (setq window (window-in-direction 'above window t))) |
| 410 | (setq draggable nil) | 410 | ((eq line 'mode)) |
| 411 | ;; Drag bottom edge of window above the header line. | ||
| 412 | (setq window (window-in-direction 'above window t)))) | ||
| 413 | ((eq line 'mode) | ||
| 414 | (if (and (window-at-side-p window 'bottom) | ||
| 415 | ;; Allow resizing the minibuffer window if it's on the | ||
| 416 | ;; same frame as and immediately below `window', and it's | ||
| 417 | ;; either active or `resize-mini-windows' is nil. | ||
| 418 | (let ((minibuffer-window (minibuffer-window frame))) | ||
| 419 | (not (and (eq (window-frame minibuffer-window) frame) | ||
| 420 | (or (not resize-mini-windows) | ||
| 421 | (eq minibuffer-window | ||
| 422 | (active-minibuffer-window))))))) | ||
| 423 | (setq draggable nil))) | ||
| 424 | ((eq line 'vertical) | 411 | ((eq line 'vertical) |
| 425 | (let ((divider-width (frame-right-divider-width frame))) | 412 | (let ((divider-width (frame-right-divider-width frame))) |
| 426 | (when (and (or (not (numberp divider-width)) | 413 | (when (and (or (not (numberp divider-width)) |
| 427 | (zerop divider-width)) | 414 | (zerop divider-width)) |
| 428 | (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) | 415 | (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) |
| 429 | (setq window (window-in-direction 'left window t)))))) | 416 | (setq window (window-in-direction 'left window t)))))) |
| 430 | |||
| 431 | (let* ((exitfun nil) | 417 | (let* ((exitfun nil) |
| 432 | (move | 418 | (move |
| 433 | (lambda (event) (interactive "e") | 419 | (lambda (event) (interactive "e") |
| @@ -530,20 +516,405 @@ must be one of the symbols `header', `mode', or `vertical'." | |||
| 530 | t (lambda () (setq track-mouse old-track-mouse))))))) | 516 | t (lambda () (setq track-mouse old-track-mouse))))))) |
| 531 | 517 | ||
| 532 | (defun mouse-drag-mode-line (start-event) | 518 | (defun mouse-drag-mode-line (start-event) |
| 533 | "Change the height of a window by dragging on the mode line." | 519 | "Change the height of a window by dragging on its mode line. |
| 520 | START-EVENT is the starting mouse event of the drag action. | ||
| 521 | |||
| 522 | If the drag happens in a mode line on the bottom of a frame and | ||
| 523 | that frame's `drag-with-mode-line' parameter is non-nil, drag the | ||
| 524 | frame instead." | ||
| 534 | (interactive "e") | 525 | (interactive "e") |
| 535 | (mouse-drag-line start-event 'mode)) | 526 | (let* ((start (event-start start-event)) |
| 527 | (window (posn-window start)) | ||
| 528 | (frame (window-frame window))) | ||
| 529 | (cond | ||
| 530 | ((not (window-live-p window))) | ||
| 531 | ((or (not (window-at-side-p window 'bottom)) | ||
| 532 | ;; Allow resizing the minibuffer window if it's on the | ||
| 533 | ;; same frame as and immediately below `window', and it's | ||
| 534 | ;; either active or `resize-mini-windows' is nil. | ||
| 535 | (let ((minibuffer-window (minibuffer-window frame))) | ||
| 536 | (and (eq (window-frame minibuffer-window) frame) | ||
| 537 | (or (not resize-mini-windows) | ||
| 538 | (eq minibuffer-window | ||
| 539 | (active-minibuffer-window)))))) | ||
| 540 | (mouse-drag-line start-event 'mode)) | ||
| 541 | ((and (frame-parameter frame 'drag-with-mode-line) | ||
| 542 | (window-at-side-p window 'bottom) | ||
| 543 | (let ((minibuffer-window (minibuffer-window frame))) | ||
| 544 | (not (eq (window-frame minibuffer-window) frame)))) | ||
| 545 | ;; Drag frame when the window is on the bottom of its frame and | ||
| 546 | ;; there is no minibuffer window below. | ||
| 547 | (mouse-drag-frame start-event 'move))))) | ||
| 536 | 548 | ||
| 537 | (defun mouse-drag-header-line (start-event) | 549 | (defun mouse-drag-header-line (start-event) |
| 538 | "Change the height of a window by dragging on the header line." | 550 | "Change the height of a window by dragging on its header line. |
| 551 | START-EVENT is the starting mouse event of the drag action. | ||
| 552 | |||
| 553 | If the drag happens in a header line on the top of a frame and | ||
| 554 | that frame's `drag-with-header-line' parameter is non-nil, drag | ||
| 555 | the frame instead." | ||
| 539 | (interactive "e") | 556 | (interactive "e") |
| 540 | (mouse-drag-line start-event 'header)) | 557 | (let* ((start (event-start start-event)) |
| 558 | (window (posn-window start))) | ||
| 559 | (if (and (window-live-p window) | ||
| 560 | (not (window-at-side-p window 'top))) | ||
| 561 | (mouse-drag-line start-event 'header) | ||
| 562 | (let ((frame (window-frame window))) | ||
| 563 | (when (frame-parameter frame 'drag-with-header-line) | ||
| 564 | (mouse-drag-frame start-event 'move)))))) | ||
| 541 | 565 | ||
| 542 | (defun mouse-drag-vertical-line (start-event) | 566 | (defun mouse-drag-vertical-line (start-event) |
| 543 | "Change the width of a window by dragging on the vertical line." | 567 | "Change the width of a window by dragging on a vertical line. |
| 568 | START-EVENT is the starting mouse event of the drag action." | ||
| 544 | (interactive "e") | 569 | (interactive "e") |
| 545 | (mouse-drag-line start-event 'vertical)) | 570 | (mouse-drag-line start-event 'vertical)) |
| 546 | 571 | ||
| 572 | (defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move) | ||
| 573 | "Helper function for `mouse-drag-frame'." | ||
| 574 | (let* ((frame-x-y (frame-position frame)) | ||
| 575 | (frame-x (car frame-x-y)) | ||
| 576 | (frame-y (cdr frame-x-y)) | ||
| 577 | alist) | ||
| 578 | (if (> x-diff 0) | ||
| 579 | (when x-move | ||
| 580 | (setq x-diff (min x-diff frame-x)) | ||
| 581 | (setq x-move (- frame-x x-diff))) | ||
| 582 | (let* ((min-width (frame-windows-min-size frame t nil t)) | ||
| 583 | (min-diff (max 0 (- (frame-inner-width frame) min-width)))) | ||
| 584 | (setq x-diff (max x-diff (- min-diff))) | ||
| 585 | (when x-move | ||
| 586 | (setq x-move (+ frame-x (- x-diff)))))) | ||
| 587 | |||
| 588 | (if (> y-diff 0) | ||
| 589 | (when y-move | ||
| 590 | (setq y-diff (min y-diff frame-y)) | ||
| 591 | (setq y-move (- frame-y y-diff))) | ||
| 592 | (let* ((min-height (frame-windows-min-size frame nil nil t)) | ||
| 593 | (min-diff (max 0 (- (frame-inner-height frame) min-height)))) | ||
| 594 | (setq y-diff (max y-diff (- min-diff))) | ||
| 595 | (when y-move | ||
| 596 | (setq y-move (+ frame-y (- y-diff)))))) | ||
| 597 | |||
| 598 | (unless (zerop x-diff) | ||
| 599 | (when x-move | ||
| 600 | (push `(left . ,x-move) alist)) | ||
| 601 | (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff))) | ||
| 602 | alist)) | ||
| 603 | (unless (zerop y-diff) | ||
| 604 | (when y-move | ||
| 605 | (push `(top . ,y-move) alist)) | ||
| 606 | (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff))) | ||
| 607 | alist)) | ||
| 608 | (when alist | ||
| 609 | (modify-frame-parameters frame alist)))) | ||
| 610 | |||
| 611 | (defun mouse-drag-frame (start-event part) | ||
| 612 | "Drag a frame or one of its edges with the mouse. | ||
| 613 | START-EVENT is the starting mouse event of the drag action. Its | ||
| 614 | position window denotes the frame that will be dragged. | ||
| 615 | |||
| 616 | PART specifies the part that has been dragged and must be one of | ||
| 617 | the symbols 'left', 'top', 'right', 'bottom', 'top-left', | ||
| 618 | 'top-right', 'bottom-left', 'bottom-right' to drag an internal | ||
| 619 | border or edge. If PART equals 'move', this means to move the | ||
| 620 | frame with the mouse." | ||
| 621 | ;; Give temporary modes such as isearch a chance to turn off. | ||
| 622 | (run-hooks 'mouse-leave-buffer-hook) | ||
| 623 | (let* ((echo-keystrokes 0) | ||
| 624 | (start (event-start start-event)) | ||
| 625 | (window (posn-window start)) | ||
| 626 | ;; FRAME is the frame to drag. | ||
| 627 | (frame (if (window-live-p window) | ||
| 628 | (window-frame window) | ||
| 629 | window)) | ||
| 630 | (width (frame-native-width frame)) | ||
| 631 | (height (frame-native-height frame)) | ||
| 632 | ;; PARENT is the parent frame of FRAME or, if FRAME is a | ||
| 633 | ;; top-level frame, FRAME's workarea. | ||
| 634 | (parent (frame-parent frame)) | ||
| 635 | (parent-edges | ||
| 636 | (if parent | ||
| 637 | `(0 0 ,(frame-native-width parent) ,(frame-native-height parent)) | ||
| 638 | (let* ((attributes | ||
| 639 | (car (display-monitor-attributes-list))) | ||
| 640 | (workarea (assq 'workarea attributes))) | ||
| 641 | (and workarea | ||
| 642 | `(,(nth 1 workarea) ,(nth 2 workarea) | ||
| 643 | ,(+ (nth 1 workarea) (nth 3 workarea)) | ||
| 644 | ,(+ (nth 2 workarea) (nth 4 workarea))))))) | ||
| 645 | (parent-left (and parent-edges (nth 0 parent-edges))) | ||
| 646 | (parent-top (and parent-edges (nth 1 parent-edges))) | ||
| 647 | (parent-right (and parent-edges (nth 2 parent-edges))) | ||
| 648 | (parent-bottom (and parent-edges (nth 3 parent-edges))) | ||
| 649 | ;; `pos-x' and `pos-y' record the x- and y-coordinates of the | ||
| 650 | ;; last sampled mouse position. Note that we sample absolute | ||
| 651 | ;; mouse positions to avoid that moving the mouse from one | ||
| 652 | ;; frame into another gets into our way. `last-x' and `last-y' | ||
| 653 | ;; records the x- and y-coordinates of the previously sampled | ||
| 654 | ;; position. The differences between `last-x' and `pos-x' as | ||
| 655 | ;; well as `last-y' and `pos-y' determine the amount the mouse | ||
| 656 | ;; has been dragged between the last two samples. | ||
| 657 | pos-x-y pos-x pos-y | ||
| 658 | (last-x-y (mouse-absolute-pixel-position)) | ||
| 659 | (last-x (car last-x-y)) | ||
| 660 | (last-y (cdr last-x-y)) | ||
| 661 | ;; `snap-x' and `snap-y' record the x- and y-coordinates of the | ||
| 662 | ;; mouse position when FRAME snapped. As soon as the | ||
| 663 | ;; difference between `pos-x' and `snap-x' (or `pos-y' and | ||
| 664 | ;; `snap-y') exceeds the value of FRAME's `snap-width' | ||
| 665 | ;; parameter, unsnap FRAME (at the respective side). `snap-x' | ||
| 666 | ;; and `snap-y' nil mean FRAME is curerntly not snapped. | ||
| 667 | snap-x snap-y | ||
| 668 | (exitfun nil) | ||
| 669 | (move | ||
| 670 | (lambda (event) | ||
| 671 | (interactive "e") | ||
| 672 | (when (consp event) | ||
| 673 | (setq pos-x-y (mouse-absolute-pixel-position)) | ||
| 674 | (setq pos-x (car pos-x-y)) | ||
| 675 | (setq pos-y (cdr pos-x-y)) | ||
| 676 | (cond | ||
| 677 | ((eq part 'left) | ||
| 678 | (mouse-resize-frame frame (- last-x pos-x) 0 t)) | ||
| 679 | ((eq part 'top) | ||
| 680 | (mouse-resize-frame frame 0 (- last-y pos-y) nil t)) | ||
| 681 | ((eq part 'right) | ||
| 682 | (mouse-resize-frame frame (- pos-x last-x) 0)) | ||
| 683 | ((eq part 'bottom) | ||
| 684 | (mouse-resize-frame frame 0 (- pos-y last-y))) | ||
| 685 | ((eq part 'top-left) | ||
| 686 | (mouse-resize-frame | ||
| 687 | frame (- last-x pos-x) (- last-y pos-y) t t)) | ||
| 688 | ((eq part 'top-right) | ||
| 689 | (mouse-resize-frame | ||
| 690 | frame (- pos-x last-x) (- last-y pos-y) nil t)) | ||
| 691 | ((eq part 'bottom-left) | ||
| 692 | (mouse-resize-frame | ||
| 693 | frame (- last-x pos-x) (- pos-y last-y) t)) | ||
| 694 | ((eq part 'bottom-right) | ||
| 695 | (mouse-resize-frame | ||
| 696 | frame (- pos-x last-x) (- pos-y last-y))) | ||
| 697 | ((eq part 'move) | ||
| 698 | (let* ((old-position (frame-position frame)) | ||
| 699 | (old-left (car old-position)) | ||
| 700 | (old-top (cdr old-position)) | ||
| 701 | (left (+ old-left (- pos-x last-x))) | ||
| 702 | (top (+ old-top (- pos-y last-y))) | ||
| 703 | right bottom | ||
| 704 | ;; `snap-width' (maybe also a yet to be provided | ||
| 705 | ;; `snap-height') could become floats to handle | ||
| 706 | ;; proportionality wrt PARENT. We don't do any | ||
| 707 | ;; checks on this parameter so far. | ||
| 708 | (snap-width (frame-parameter frame 'snap-width))) | ||
| 709 | ;; Docking and constraining. | ||
| 710 | (when (and (numberp snap-width) parent-edges) | ||
| 711 | (cond | ||
| 712 | ;; Docking at the left parent edge. | ||
| 713 | ((< pos-x last-x) | ||
| 714 | (cond | ||
| 715 | ((and (> left parent-left) | ||
| 716 | (<= (- left parent-left) snap-width)) | ||
| 717 | ;; Snap when the mouse moved leftward and | ||
| 718 | ;; FRAME's left edge would end up within | ||
| 719 | ;; `snap-width' pixels from PARENT's left edge. | ||
| 720 | (setq snap-x pos-x) | ||
| 721 | (setq left parent-left)) | ||
| 722 | ((and (<= left parent-left) | ||
| 723 | (<= (- parent-left left) snap-width) | ||
| 724 | snap-x (<= (- snap-x pos-x) snap-width)) | ||
| 725 | ;; Stay snapped when the mouse moved leftward | ||
| 726 | ;; but not more than `snap-width' pixels from | ||
| 727 | ;; the time FRAME snapped. | ||
| 728 | (setq left parent-left)) | ||
| 729 | (t | ||
| 730 | ;; Unsnap when the mouse moved more than | ||
| 731 | ;; `snap-width' pixels leftward from the time | ||
| 732 | ;; FRAME snapped. | ||
| 733 | (setq snap-x nil)))) | ||
| 734 | ((> pos-x last-x) | ||
| 735 | (setq right (+ left width)) | ||
| 736 | (cond | ||
| 737 | ((and (< right parent-right) | ||
| 738 | (<= (- parent-right right) snap-width)) | ||
| 739 | ;; Snap when the mouse moved rightward and | ||
| 740 | ;; FRAME's right edge would end up within | ||
| 741 | ;; `snap-width' pixels from PARENT's right edge. | ||
| 742 | (setq snap-x pos-x) | ||
| 743 | (setq left (- parent-right width))) | ||
| 744 | ((and (>= right parent-right) | ||
| 745 | (<= (- right parent-right) snap-width) | ||
| 746 | snap-x (<= (- pos-x snap-x) snap-width)) | ||
| 747 | ;; Stay snapped when the mouse moved rightward | ||
| 748 | ;; but not more more than `snap-width' pixels | ||
| 749 | ;; from the time FRAME snapped. | ||
| 750 | (setq left (- parent-right width))) | ||
| 751 | (t | ||
| 752 | ;; Unsnap when the mouse moved rightward more | ||
| 753 | ;; than `snap-width' pixels from the time FRAME | ||
| 754 | ;; snapped. | ||
| 755 | (setq snap-x nil))))) | ||
| 756 | |||
| 757 | (cond | ||
| 758 | ((< pos-y last-y) | ||
| 759 | (cond | ||
| 760 | ((and (> top parent-top) | ||
| 761 | (<= (- top parent-top) snap-width)) | ||
| 762 | ;; Snap when the mouse moved upward and FRAME's | ||
| 763 | ;; top edge would end up within `snap-width' | ||
| 764 | ;; pixels from PARENT's top edge. | ||
| 765 | (setq snap-y pos-y) | ||
| 766 | (setq top parent-top)) | ||
| 767 | ((and (<= top parent-top) | ||
| 768 | (<= (- parent-top top) snap-width) | ||
| 769 | snap-y (<= (- snap-y pos-y) snap-width)) | ||
| 770 | ;; Stay snapped when the mouse moved upward but | ||
| 771 | ;; not more more than `snap-width' pixels from | ||
| 772 | ;; the time FRAME snapped. | ||
| 773 | (setq top parent-top)) | ||
| 774 | (t | ||
| 775 | ;; Unsnap when the mouse moved upward more than | ||
| 776 | ;; `snap-width' pixels from the time FRAME | ||
| 777 | ;; snapped. | ||
| 778 | (setq snap-y nil)))) | ||
| 779 | ((> pos-y last-y) | ||
| 780 | (setq bottom (+ top height)) | ||
| 781 | (cond | ||
| 782 | ((and (< bottom parent-bottom) | ||
| 783 | (<= (- parent-bottom bottom) snap-width)) | ||
| 784 | ;; Snap when the mouse moved downward and | ||
| 785 | ;; FRAME's bottom edge would end up within | ||
| 786 | ;; `snap-width' pixels from PARENT's bottom | ||
| 787 | ;; edge. | ||
| 788 | (setq snap-y pos-y) | ||
| 789 | (setq top (- parent-bottom height))) | ||
| 790 | ((and (>= bottom parent-bottom) | ||
| 791 | (<= (- bottom parent-bottom) snap-width) | ||
| 792 | snap-y (<= (- pos-y snap-y) snap-width)) | ||
| 793 | ;; Stay snapped when the mouse moved downward | ||
| 794 | ;; but not more more than `snap-width' pixels | ||
| 795 | ;; from the time FRAME snapped. | ||
| 796 | (setq top (- parent-bottom height))) | ||
| 797 | (t | ||
| 798 | ;; Unsnap when the mouse moved downward more | ||
| 799 | ;; than `snap-width' pixels from the time FRAME | ||
| 800 | ;; snapped. | ||
| 801 | (setq snap-y nil)))))) | ||
| 802 | |||
| 803 | ;; If requested, constrain FRAME's draggable areas to | ||
| 804 | ;; PARENT's edges. The `top-visible' parameter should | ||
| 805 | ;; be set when FRAME has a draggable header-line. If | ||
| 806 | ;; set to a number, it ascertains that the top of | ||
| 807 | ;; FRAME is always constrained to the top of PARENT | ||
| 808 | ;; and that at least as many pixels of FRAME as | ||
| 809 | ;; specified by that number are visible on each of the | ||
| 810 | ;; three remaining sides of PARENT. | ||
| 811 | ;; | ||
| 812 | ;; The `bottom-visible' parameter should be set when | ||
| 813 | ;; FRAME has a draggable mode-line. If set to a | ||
| 814 | ;; number, it ascertains that the bottom of FRAME is | ||
| 815 | ;; always constrained to the bottom of PARENT and that | ||
| 816 | ;; at least as many pixels of FRAME as specified by | ||
| 817 | ;; that number are visible on each of the three | ||
| 818 | ;; remaining sides of PARENT. | ||
| 819 | (let ((par (frame-parameter frame 'top-visible)) | ||
| 820 | bottom-visible) | ||
| 821 | (unless par | ||
| 822 | (setq par (frame-parameter frame 'bottom-visible)) | ||
| 823 | (setq bottom-visible t)) | ||
| 824 | (when (and (numberp par) parent-edges) | ||
| 825 | (setq left | ||
| 826 | (max (min (- parent-right par) left) | ||
| 827 | (+ (- parent-left width) par))) | ||
| 828 | (setq top | ||
| 829 | (if bottom-visible | ||
| 830 | (min (max top (- parent-top (- height par))) | ||
| 831 | (- parent-bottom height)) | ||
| 832 | (min (max top parent-top) | ||
| 833 | (- parent-bottom par)))))) | ||
| 834 | |||
| 835 | ;; Use `modify-frame-parameters' since `left' and | ||
| 836 | ;; `top' may want to move FRAME out of its PARENT. | ||
| 837 | (modify-frame-parameters | ||
| 838 | frame | ||
| 839 | `((left . (+ ,left)) (top . (+ ,top))))))) | ||
| 840 | (setq last-x pos-x) | ||
| 841 | (setq last-y pos-y)))) | ||
| 842 | (old-track-mouse track-mouse)) | ||
| 843 | ;; Start tracking. The special value 'dragging' signals the | ||
| 844 | ;; display engine to freeze the mouse pointer shape for as long | ||
| 845 | ;; as we drag. | ||
| 846 | (setq track-mouse 'dragging) | ||
| 847 | ;; Loop reading events and sampling the position of the mouse. | ||
| 848 | (setq exitfun | ||
| 849 | (set-transient-map | ||
| 850 | (let ((map (make-sparse-keymap))) | ||
| 851 | (define-key map [switch-frame] #'ignore) | ||
| 852 | (define-key map [select-window] #'ignore) | ||
| 853 | (define-key map [scroll-bar-movement] #'ignore) | ||
| 854 | (define-key map [mouse-movement] move) | ||
| 855 | ;; Swallow drag-mouse-1 events to avoid selecting some other window. | ||
| 856 | (define-key map [drag-mouse-1] | ||
| 857 | (lambda () (interactive) (funcall exitfun))) | ||
| 858 | ;; Some of the events will of course end up looked up | ||
| 859 | ;; with a mode-line, header-line or vertical-line prefix ... | ||
| 860 | (define-key map [mode-line] map) | ||
| 861 | (define-key map [header-line] map) | ||
| 862 | (define-key map [vertical-line] map) | ||
| 863 | ;; ... and some maybe even with a right- or bottom-divider | ||
| 864 | ;; prefix. | ||
| 865 | (define-key map [right-divider] map) | ||
| 866 | (define-key map [bottom-divider] map) | ||
| 867 | map) | ||
| 868 | t (lambda () (setq track-mouse old-track-mouse)))))) | ||
| 869 | |||
| 870 | (defun mouse-drag-left-edge (start-event) | ||
| 871 | "Drag left edge of a frame with the mouse. | ||
| 872 | START-EVENT is the starting mouse event of the drag action." | ||
| 873 | (interactive "e") | ||
| 874 | (mouse-drag-frame start-event 'left)) | ||
| 875 | |||
| 876 | (defun mouse-drag-top-left-corner (start-event) | ||
| 877 | "Drag top left corner of a frame with the mouse. | ||
| 878 | START-EVENT is the starting mouse event of the drag action." | ||
| 879 | (interactive "e") | ||
| 880 | (mouse-drag-frame start-event 'top-left)) | ||
| 881 | |||
| 882 | (defun mouse-drag-top-edge (start-event) | ||
| 883 | "Drag top edge of a frame with the mouse. | ||
| 884 | START-EVENT is the starting mouse event of the drag action." | ||
| 885 | (interactive "e") | ||
| 886 | (mouse-drag-frame start-event 'top)) | ||
| 887 | |||
| 888 | (defun mouse-drag-top-right-corner (start-event) | ||
| 889 | "Drag top right corner of a frame with the mouse. | ||
| 890 | START-EVENT is the starting mouse event of the drag action." | ||
| 891 | (interactive "e") | ||
| 892 | (mouse-drag-frame start-event 'top-right)) | ||
| 893 | |||
| 894 | (defun mouse-drag-right-edge (start-event) | ||
| 895 | "Drag right edge of a frame with the mouse. | ||
| 896 | START-EVENT is the starting mouse event of the drag action." | ||
| 897 | (interactive "e") | ||
| 898 | (mouse-drag-frame start-event 'right)) | ||
| 899 | |||
| 900 | (defun mouse-drag-bottom-right-corner (start-event) | ||
| 901 | "Drag bottom right corner of a frame with the mouse. | ||
| 902 | START-EVENT is the starting mouse event of the drag action." | ||
| 903 | (interactive "e") | ||
| 904 | (mouse-drag-frame start-event 'bottom-right)) | ||
| 905 | |||
| 906 | (defun mouse-drag-bottom-edge (start-event) | ||
| 907 | "Drag bottom edge of a frame with the mouse. | ||
| 908 | START-EVENT is the starting mouse event of the drag action." | ||
| 909 | (interactive "e") | ||
| 910 | (mouse-drag-frame start-event 'bottom)) | ||
| 911 | |||
| 912 | (defun mouse-drag-bottom-left-corner (start-event) | ||
| 913 | "Drag bottom left corner of a frame with the mouse. | ||
| 914 | START-EVENT is the starting mouse event of the drag action." | ||
| 915 | (interactive "e") | ||
| 916 | (mouse-drag-frame start-event 'bottom-left)) | ||
| 917 | |||
| 547 | (defcustom mouse-select-region-move-to-beginning nil | 918 | (defcustom mouse-select-region-move-to-beginning nil |
| 548 | "Effect of selecting a region extending backward from double click. | 919 | "Effect of selecting a region extending backward from double click. |
| 549 | Nil means keep point at the position clicked (region end); | 920 | Nil means keep point at the position clicked (region end); |
| @@ -2078,6 +2449,22 @@ is copied instead of being cut." | |||
| 2078 | (global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line) | 2449 | (global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line) |
| 2079 | (global-set-key [bottom-divider mouse-1] 'ignore) | 2450 | (global-set-key [bottom-divider mouse-1] 'ignore) |
| 2080 | (global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally) | 2451 | (global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally) |
| 2452 | (global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge) | ||
| 2453 | (global-set-key [left-edge mouse-1] 'ignore) | ||
| 2454 | (global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner) | ||
| 2455 | (global-set-key [top-left-corner mouse-1] 'ignore) | ||
| 2456 | (global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge) | ||
| 2457 | (global-set-key [top-edge mouse-1] 'ignore) | ||
| 2458 | (global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner) | ||
| 2459 | (global-set-key [top-right-corner mouse-1] 'ignore) | ||
| 2460 | (global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge) | ||
| 2461 | (global-set-key [right-edge mouse-1] 'ignore) | ||
| 2462 | (global-set-key [bottom-right-corner down-mouse-1] 'mouse-drag-bottom-right-corner) | ||
| 2463 | (global-set-key [bottom-right-corner mouse-1] 'ignore) | ||
| 2464 | (global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge) | ||
| 2465 | (global-set-key [bottom-edge mouse-1] 'ignore) | ||
| 2466 | (global-set-key [bottom-left-corner down-mouse-1] 'mouse-drag-bottom-left-corner) | ||
| 2467 | (global-set-key [bottom-left-corner mouse-1] 'ignore) | ||
| 2081 | 2468 | ||
| 2082 | (provide 'mouse) | 2469 | (provide 'mouse) |
| 2083 | 2470 | ||
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index fe316579142..2fc36e180ee 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el | |||
| @@ -312,11 +312,19 @@ word(s) will be searched for via `eww-search-prefix'." | |||
| 312 | (expand-file-name file)))) | 312 | (expand-file-name file)))) |
| 313 | 313 | ||
| 314 | ;;;###autoload | 314 | ;;;###autoload |
| 315 | (defun eww-search-words (&optional beg end) | 315 | (defun eww-search-words () |
| 316 | "Search the web for the text between BEG and END. | 316 | "Search the web for the text between BEG and END. |
| 317 | See the `eww-search-prefix' variable for the search engine used." | 317 | If region is active (and not whitespace), search the web for |
| 318 | (interactive "r") | 318 | the text between BEG and END. Else, prompt the user for a search |
| 319 | (eww (buffer-substring beg end))) | 319 | string. See the `eww-search-prefix' variable for the search |
| 320 | engine used." | ||
| 321 | (interactive) | ||
| 322 | (if (use-region-p) | ||
| 323 | (let ((region-string (buffer-substring (region-beginning) (region-end)))) | ||
| 324 | (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string)) | ||
| 325 | (eww region-string) | ||
| 326 | (call-interactively 'eww))) | ||
| 327 | (call-interactively 'eww))) | ||
| 320 | 328 | ||
| 321 | (defun eww-open-in-new-buffer () | 329 | (defun eww-open-in-new-buffer () |
| 322 | "Fetch link at point in a new EWW buffer." | 330 | "Fetch link at point in a new EWW buffer." |
diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2a6b3960c46..4d4e8a809e1 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el | |||
| @@ -185,8 +185,8 @@ and other things: | |||
| 185 | (define-key map [follow-link] 'mouse-face) | 185 | (define-key map [follow-link] 'mouse-face) |
| 186 | (define-key map [mouse-2] 'shr-browse-url) | 186 | (define-key map [mouse-2] 'shr-browse-url) |
| 187 | (define-key map "I" 'shr-insert-image) | 187 | (define-key map "I" 'shr-insert-image) |
| 188 | (define-key map "w" 'shr-copy-url) | 188 | (define-key map "w" 'shr-maybe-probe-and-copy-url) |
| 189 | (define-key map "u" 'shr-copy-url) | 189 | (define-key map "u" 'shr-maybe-probe-and-copy-url) |
| 190 | (define-key map "v" 'shr-browse-url) | 190 | (define-key map "v" 'shr-browse-url) |
| 191 | (define-key map "O" 'shr-save-contents) | 191 | (define-key map "O" 'shr-save-contents) |
| 192 | (define-key map "\r" 'shr-browse-url) | 192 | (define-key map "\r" 'shr-browse-url) |
| @@ -290,43 +290,59 @@ DOM should be a parse tree as generated by | |||
| 290 | (forward-line 1) | 290 | (forward-line 1) |
| 291 | (delete-region (point) (point-max)))))) | 291 | (delete-region (point) (point-max)))))) |
| 292 | 292 | ||
| 293 | (defun shr-copy-url (&optional image-url) | 293 | (defun shr-url-at-point (image-url) |
| 294 | "Return the URL under point as a string. | ||
| 295 | If IMAGE-URL is non-nil, or there is no link under point, but | ||
| 296 | there is an image under point then copy the URL of the image | ||
| 297 | under point instead." | ||
| 298 | (if image-url | ||
| 299 | (get-text-property (point) 'image-url) | ||
| 300 | (or (get-text-property (point) 'shr-url) | ||
| 301 | (get-text-property (point) 'image-url)))) | ||
| 302 | |||
| 303 | (defun shr-copy-url (url) | ||
| 294 | "Copy the URL under point to the kill ring. | 304 | "Copy the URL under point to the kill ring. |
| 295 | If IMAGE-URL (the prefix) is non-nil, or there is no link under | 305 | If IMAGE-URL (the prefix) is non-nil, or there is no link under |
| 296 | point, but there is an image under point then copy the URL of the | 306 | point, but there is an image under point then copy the URL of the |
| 297 | image under point instead. | 307 | image under point instead." |
| 298 | If called twice, then try to fetch the URL and see whether it | 308 | (interactive (list (shr-url-at-point current-prefix-arg))) |
| 299 | redirects somewhere else." | 309 | (if (not url) |
| 310 | (message "No URL under point") | ||
| 311 | (setq url (url-encode-url url)) | ||
| 312 | (kill-new url) | ||
| 313 | (message "Copied %s" url))) | ||
| 314 | |||
| 315 | (defun shr-probe-url (url cont) | ||
| 316 | "Pass URL's redirect destination to CONT, if it has one. | ||
| 317 | CONT should be a function of one argument, the redirect | ||
| 318 | destination URL. If URL is not redirected, then CONT is never | ||
| 319 | called." | ||
| 300 | (interactive "P") | 320 | (interactive "P") |
| 301 | (let ((url (if image-url | 321 | (url-retrieve |
| 302 | (get-text-property (point) 'image-url) | 322 | url (lambda (a) |
| 303 | (or (get-text-property (point) 'shr-url) | 323 | (pcase a |
| 304 | (get-text-property (point) 'image-url))))) | 324 | (`(:redirect ,destination . ,_) |
| 305 | (cond | 325 | ;; Remove common tracking junk from the URL. |
| 306 | ((not url) | 326 | (funcall cont (replace-regexp-in-string |
| 307 | (message "No URL under point")) | 327 | ".utm_.*" "" destination))))) |
| 308 | ;; Resolve redirected URLs. | 328 | nil t)) |
| 309 | ((equal url (car kill-ring)) | 329 | |
| 310 | (url-retrieve | 330 | (defun shr-probe-and-copy-url (url) |
| 311 | url | 331 | "Copy the URL under point to the kill ring. |
| 312 | (lambda (a) | 332 | Like `shr-copy-url', but additionally fetch URL and use its |
| 313 | (when (and (consp a) | 333 | redirection destination if it has one." |
| 314 | (eq (car a) :redirect)) | 334 | (interactive (list (shr-url-at-point current-prefix-arg))) |
| 315 | (with-temp-buffer | 335 | (if url (shr-probe-url url #'shr-copy-url) |
| 316 | (insert (cadr a)) | 336 | (shr-copy-url url))) |
| 317 | (goto-char (point-min)) | 337 | |
| 318 | ;; Remove common tracking junk from the URL. | 338 | (defun shr-maybe-probe-and-copy-url (url) |
| 319 | (when (re-search-forward ".utm_.*" nil t) | 339 | "Copy the URL under point to the kill ring. |
| 320 | (replace-match "" t t)) | 340 | If the URL is already at the front of the kill ring act like |
| 321 | (message "Copied %s" (buffer-string)) | 341 | `shr-probe-and-copy-url', otherwise like `shr-copy-url'." |
| 322 | (copy-region-as-kill (point-min) (point-max))))) | 342 | (interactive (list (shr-url-at-point current-prefix-arg))) |
| 323 | nil t)) | 343 | (if (equal url (car kill-ring)) |
| 324 | ;; Copy the URL to the kill ring. | 344 | (shr-probe-and-copy-url url) |
| 325 | (t | 345 | (shr-copy-url url))) |
| 326 | (with-temp-buffer | ||
| 327 | (insert (url-encode-url url)) | ||
| 328 | (copy-region-as-kill (point-min) (point-max)) | ||
| 329 | (message "Copied %s" (buffer-string))))))) | ||
| 330 | 346 | ||
| 331 | (defun shr-next-link () | 347 | (defun shr-next-link () |
| 332 | "Skip to the next link." | 348 | "Skip to the next link." |
| @@ -512,6 +528,7 @@ size, and full-buffer size." | |||
| 512 | (* (frame-char-width) 2) | 528 | (* (frame-char-width) 2) |
| 513 | 0)))) | 529 | 0)))) |
| 514 | (shr-insert text) | 530 | (shr-insert text) |
| 531 | (shr-fill-lines (point-min) (point-max)) | ||
| 515 | (buffer-string))))) | 532 | (buffer-string))))) |
| 516 | 533 | ||
| 517 | (define-inline shr-char-breakable-p (char) | 534 | (define-inline shr-char-breakable-p (char) |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 23aa90186a6..346979000f5 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -72,7 +72,7 @@ It is used for TCP/IP devices." | |||
| 72 | (defconst tramp-adb-ls-toolbox-regexp | 72 | (defconst tramp-adb-ls-toolbox-regexp |
| 73 | (concat | 73 | (concat |
| 74 | "^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions | 74 | "^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions |
| 75 | "\\(?:[[:space:]][[:digit:]]+\\)?" ; links (Android 7/ToolBox) | 75 | "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox) |
| 76 | "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username | 76 | "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username |
| 77 | "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group | 77 | "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group |
| 78 | "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size | 78 | "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size |
| @@ -411,15 +411,17 @@ pass to the OPERATION." | |||
| 411 | (tramp-adb-get-ls-command v) | 411 | (tramp-adb-get-ls-command v) |
| 412 | (tramp-shell-quote-argument localname))) | 412 | (tramp-shell-quote-argument localname))) |
| 413 | ;; We insert also filename/. and filename/.., because "ls" doesn't. | 413 | ;; We insert also filename/. and filename/.., because "ls" doesn't. |
| 414 | (narrow-to-region (point) (point)) | 414 | ;; Looks like it does include them in toybox, since Android 6. |
| 415 | (tramp-adb-send-command | 415 | (unless (re-search-backward "\\.$" nil t) |
| 416 | v (format "%s -d -a -l %s %s" | 416 | (narrow-to-region (point-max) (point-max)) |
| 417 | (tramp-adb-get-ls-command v) | 417 | (tramp-adb-send-command |
| 418 | (tramp-shell-quote-argument | 418 | v (format "%s -d -a -l %s %s" |
| 419 | (concat (file-name-as-directory localname) ".")) | 419 | (tramp-adb-get-ls-command v) |
| 420 | (tramp-shell-quote-argument | 420 | (tramp-shell-quote-argument |
| 421 | (concat (file-name-as-directory localname) "..")))) | 421 | (concat (file-name-as-directory localname) ".")) |
| 422 | (widen)) | 422 | (tramp-shell-quote-argument |
| 423 | (concat (file-name-as-directory localname) "..")))) | ||
| 424 | (widen))) | ||
| 423 | (tramp-adb-sh-fix-ls-output) | 425 | (tramp-adb-sh-fix-ls-output) |
| 424 | (let ((result (tramp-do-parse-file-attributes-with-ls | 426 | (let ((result (tramp-do-parse-file-attributes-with-ls |
| 425 | v (or id-format 'integer)))) | 427 | v (or id-format 'integer)))) |
| @@ -443,11 +445,12 @@ pass to the OPERATION." | |||
| 443 | (with-tramp-connection-property vec "ls" | 445 | (with-tramp-connection-property vec "ls" |
| 444 | (tramp-message vec 5 "Finding a suitable `ls' command") | 446 | (tramp-message vec 5 "Finding a suitable `ls' command") |
| 445 | (cond | 447 | (cond |
| 446 | ;; Can't disable coloring explicitly for toybox ls command | 448 | ;; Can't disable coloring explicitly for toybox ls command. We |
| 447 | ((tramp-adb-send-command-and-check vec "toybox") "ls") | 449 | ;; must force "ls" to print just one column. |
| 450 | ((tramp-adb-send-command-and-check vec "toybox") "env COLUMNS=1 ls") | ||
| 448 | ;; On CyanogenMod based system BusyBox is used and "ls" output | 451 | ;; On CyanogenMod based system BusyBox is used and "ls" output |
| 449 | ;; coloring is enabled by default. So we try to disable it | 452 | ;; coloring is enabled by default. So we try to disable it when |
| 450 | ;; when possible. | 453 | ;; possible. |
| 451 | ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null") | 454 | ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null") |
| 452 | "ls --color=never") | 455 | "ls --color=never") |
| 453 | (t "ls")))) | 456 | (t "ls")))) |
| @@ -569,13 +572,17 @@ Emacs dired can't find files." | |||
| 569 | (file-name-as-directory f) | 572 | (file-name-as-directory f) |
| 570 | f)) | 573 | f)) |
| 571 | (with-current-buffer (tramp-get-buffer v) | 574 | (with-current-buffer (tramp-get-buffer v) |
| 572 | (append | 575 | (delete-dups |
| 573 | '("." "..") | 576 | (append |
| 574 | (delq | 577 | ;; In older Android versions, "." and ".." are not |
| 575 | nil | 578 | ;; included. In newer versions (toybox, since Android |
| 576 | (mapcar | 579 | ;; 6) they are. We fix this by `delete-dups'. |
| 577 | (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l)) | 580 | '("." "..") |
| 578 | (split-string (buffer-string) "\n"))))))))))) | 581 | (delq |
| 582 | nil | ||
| 583 | (mapcar | ||
| 584 | (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l)) | ||
| 585 | (split-string (buffer-string) "\n")))))))))))) | ||
| 579 | 586 | ||
| 580 | (defun tramp-adb-handle-file-local-copy (filename) | 587 | (defun tramp-adb-handle-file-local-copy (filename) |
| 581 | "Like `file-local-copy' for Tramp files." | 588 | "Like `file-local-copy' for Tramp files." |
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index c998df814c1..b2df4d6324b 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -252,7 +252,8 @@ If NAME is a remote file name, the local part of NAME is unquoted." | |||
| 252 | (eval-after-load 'tramp | 252 | (eval-after-load 'tramp |
| 253 | '(unless | 253 | '(unless |
| 254 | (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values))) | 254 | (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values))) |
| 255 | (tramp-change-syntax (tramp-compat-tramp-syntax)))) | 255 | (tramp-compat-funcall |
| 256 | (quote tramp-change-syntax) (tramp-compat-tramp-syntax)))) | ||
| 256 | 257 | ||
| 257 | (provide 'tramp-compat) | 258 | (provide 'tramp-compat) |
| 258 | 259 | ||
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f7b457ebf04..94518d0d359 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -3500,21 +3500,10 @@ the result will be a local, non-Tramp, file name." | |||
| 3500 | (defun tramp-sh-file-name-handler (operation &rest args) | 3500 | (defun tramp-sh-file-name-handler (operation &rest args) |
| 3501 | "Invoke remote-shell Tramp file name handler. | 3501 | "Invoke remote-shell Tramp file name handler. |
| 3502 | Fall back to normal file name handler if no Tramp handler exists." | 3502 | Fall back to normal file name handler if no Tramp handler exists." |
| 3503 | (when (and tramp-locked (not tramp-locker)) | 3503 | (let ((fn (assoc operation tramp-sh-file-name-handler-alist))) |
| 3504 | (setq tramp-locked nil) | 3504 | (if fn |
| 3505 | (tramp-error | 3505 | (save-match-data (apply (cdr fn) args)) |
| 3506 | (car-safe tramp-current-connection) 'file-error | 3506 | (tramp-run-real-handler operation args)))) |
| 3507 | "Forbidden reentrant call of Tramp")) | ||
| 3508 | (let ((tl tramp-locked)) | ||
| 3509 | (setq tramp-locked t) | ||
| 3510 | (unwind-protect | ||
| 3511 | (let ((tramp-locker t)) | ||
| 3512 | (save-match-data | ||
| 3513 | (let ((fn (assoc operation tramp-sh-file-name-handler-alist))) | ||
| 3514 | (if fn | ||
| 3515 | (apply (cdr fn) args) | ||
| 3516 | (tramp-run-real-handler operation args))))) | ||
| 3517 | (setq tramp-locked tl)))) | ||
| 3518 | 3507 | ||
| 3519 | ;; This must be the last entry, because `identity' always matches. | 3508 | ;; This must be the last entry, because `identity' always matches. |
| 3520 | ;;;###tramp-autoload | 3509 | ;;;###tramp-autoload |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8d81ac64aa2..9c327c410a7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -2053,6 +2053,33 @@ ARGS are the arguments OPERATION has been called with." | |||
| 2053 | `(let ((debug-on-error tramp-debug-on-error)) | 2053 | `(let ((debug-on-error tramp-debug-on-error)) |
| 2054 | (condition-case-unless-debug ,var ,bodyform ,@handlers))) | 2054 | (condition-case-unless-debug ,var ,bodyform ,@handlers))) |
| 2055 | 2055 | ||
| 2056 | ;; In Emacs, there is some concurrency due to timers. If a timer | ||
| 2057 | ;; interrupts Tramp and wishes to use the same connection buffer as | ||
| 2058 | ;; the "main" Emacs, then garbage might occur in the connection | ||
| 2059 | ;; buffer. Therefore, we need to make sure that a timer does not use | ||
| 2060 | ;; the same connection buffer as the "main" Emacs. We implement a | ||
| 2061 | ;; cheap global lock, instead of locking each connection buffer | ||
| 2062 | ;; separately. The global lock is based on two variables, | ||
| 2063 | ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true | ||
| 2064 | ;; (with setq) to indicate a lock. But Tramp also calls itself during | ||
| 2065 | ;; processing of a single file operation, so we need to allow | ||
| 2066 | ;; recursive calls. That's where the `tramp-locker' variable comes in | ||
| 2067 | ;; -- it is let-bound to t during the execution of the current | ||
| 2068 | ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t, | ||
| 2069 | ;; then we should just proceed because we have been called | ||
| 2070 | ;; recursively. But if `tramp-locker' is nil, then we are a timer | ||
| 2071 | ;; interrupting the "main" Emacs, and then we signal an error. | ||
| 2072 | |||
| 2073 | (defvar tramp-locked nil | ||
| 2074 | "If non-nil, then Tramp is currently busy. | ||
| 2075 | Together with `tramp-locker', this implements a locking mechanism | ||
| 2076 | preventing reentrant calls of Tramp.") | ||
| 2077 | |||
| 2078 | (defvar tramp-locker nil | ||
| 2079 | "If non-nil, then a caller has locked Tramp. | ||
| 2080 | Together with `tramp-locked', this implements a locking mechanism | ||
| 2081 | preventing reentrant calls of Tramp.") | ||
| 2082 | |||
| 2056 | ;; Main function. | 2083 | ;; Main function. |
| 2057 | (defun tramp-file-name-handler (operation &rest args) | 2084 | (defun tramp-file-name-handler (operation &rest args) |
| 2058 | "Invoke Tramp file name handler. | 2085 | "Invoke Tramp file name handler. |
| @@ -2090,7 +2117,20 @@ Falls back to normal file name handler if no Tramp file name handler exists." | |||
| 2090 | (setq result | 2117 | (setq result |
| 2091 | (catch 'non-essential | 2118 | (catch 'non-essential |
| 2092 | (catch 'suppress | 2119 | (catch 'suppress |
| 2093 | (apply foreign operation args)))) | 2120 | (when (and tramp-locked (not tramp-locker)) |
| 2121 | (setq tramp-locked nil) | ||
| 2122 | (tramp-error | ||
| 2123 | (car-safe tramp-current-connection) | ||
| 2124 | 'file-error | ||
| 2125 | "Forbidden reentrant call of Tramp")) | ||
| 2126 | (let ((tl tramp-locked)) | ||
| 2127 | (setq tramp-locked t) | ||
| 2128 | (unwind-protect | ||
| 2129 | (let ((tramp-locker t)) | ||
| 2130 | (apply foreign operation args)) | ||
| 2131 | ;; Give timers a chance. | ||
| 2132 | (unless (setq tramp-locked tl) | ||
| 2133 | (sit-for 0.001 'nodisp))))))) | ||
| 2094 | (cond | 2134 | (cond |
| 2095 | ((eq result 'non-essential) | 2135 | ((eq result 'non-essential) |
| 2096 | (tramp-message | 2136 | (tramp-message |
| @@ -2145,33 +2185,6 @@ Falls back to normal file name handler if no Tramp file name handler exists." | |||
| 2145 | ;; we don't do anything. | 2185 | ;; we don't do anything. |
| 2146 | (tramp-run-real-handler operation args)))) | 2186 | (tramp-run-real-handler operation args)))) |
| 2147 | 2187 | ||
| 2148 | ;; In Emacs, there is some concurrency due to timers. If a timer | ||
| 2149 | ;; interrupts Tramp and wishes to use the same connection buffer as | ||
| 2150 | ;; the "main" Emacs, then garbage might occur in the connection | ||
| 2151 | ;; buffer. Therefore, we need to make sure that a timer does not use | ||
| 2152 | ;; the same connection buffer as the "main" Emacs. We implement a | ||
| 2153 | ;; cheap global lock, instead of locking each connection buffer | ||
| 2154 | ;; separately. The global lock is based on two variables, | ||
| 2155 | ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true | ||
| 2156 | ;; (with setq) to indicate a lock. But Tramp also calls itself during | ||
| 2157 | ;; processing of a single file operation, so we need to allow | ||
| 2158 | ;; recursive calls. That's where the `tramp-locker' variable comes in | ||
| 2159 | ;; -- it is let-bound to t during the execution of the current | ||
| 2160 | ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t, | ||
| 2161 | ;; then we should just proceed because we have been called | ||
| 2162 | ;; recursively. But if `tramp-locker' is nil, then we are a timer | ||
| 2163 | ;; interrupting the "main" Emacs, and then we signal an error. | ||
| 2164 | |||
| 2165 | (defvar tramp-locked nil | ||
| 2166 | "If non-nil, then Tramp is currently busy. | ||
| 2167 | Together with `tramp-locker', this implements a locking mechanism | ||
| 2168 | preventing reentrant calls of Tramp.") | ||
| 2169 | |||
| 2170 | (defvar tramp-locker nil | ||
| 2171 | "If non-nil, then a caller has locked Tramp. | ||
| 2172 | Together with `tramp-locked', this implements a locking mechanism | ||
| 2173 | preventing reentrant calls of Tramp.") | ||
| 2174 | |||
| 2175 | ;;;###autoload | 2188 | ;;;###autoload |
| 2176 | (defun tramp-completion-file-name-handler (operation &rest args) | 2189 | (defun tramp-completion-file-name-handler (operation &rest args) |
| 2177 | "Invoke Tramp file name completion handler. | 2190 | "Invoke Tramp file name completion handler. |
| @@ -3631,31 +3644,17 @@ connection buffer." | |||
| 3631 | "Like `accept-process-output' for Tramp processes. | 3644 | "Like `accept-process-output' for Tramp processes. |
| 3632 | This is needed in order to hide `last-coding-system-used', which is set | 3645 | This is needed in order to hide `last-coding-system-used', which is set |
| 3633 | for process communication also." | 3646 | for process communication also." |
| 3634 | ;; FIXME: There are problems, when an asynchronous process runs in | ||
| 3635 | ;; parallel, and also timers are active. See | ||
| 3636 | ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>. | ||
| 3637 | (when (and timer-event-last | ||
| 3638 | (string-prefix-p "*tramp/" (process-name proc)) | ||
| 3639 | (let (result) | ||
| 3640 | (maphash | ||
| 3641 | (lambda (key _value) | ||
| 3642 | (and (processp key) | ||
| 3643 | (not (string-prefix-p "*tramp/" (process-name key))) | ||
| 3644 | (process-live-p key) | ||
| 3645 | (setq result t))) | ||
| 3646 | tramp-cache-data) | ||
| 3647 | result)) | ||
| 3648 | (sit-for 0.01 'nodisp)) | ||
| 3649 | (with-current-buffer (process-buffer proc) | 3647 | (with-current-buffer (process-buffer proc) |
| 3650 | (let (buffer-read-only last-coding-system-used) | 3648 | (let (buffer-read-only last-coding-system-used) |
| 3651 | ;; Under Windows XP, accept-process-output doesn't return | 3649 | ;; Under Windows XP, `accept-process-output' doesn't return |
| 3652 | ;; sometimes. So we add an additional timeout. JUST-THIS-ONE | 3650 | ;; sometimes. So we add an additional timeout. JUST-THIS-ONE |
| 3653 | ;; is set due to Bug#12145. | 3651 | ;; is set due to Bug#12145. It is an integer, in order to avoid |
| 3652 | ;; running timers as well. | ||
| 3654 | (tramp-message | 3653 | (tramp-message |
| 3655 | proc 10 "%s %s %s\n%s" | 3654 | proc 10 "%s %s %s\n%s" |
| 3656 | proc (process-status proc) | 3655 | proc (process-status proc) |
| 3657 | (with-timeout (timeout) | 3656 | (with-timeout (timeout) |
| 3658 | (accept-process-output proc timeout nil t)) | 3657 | (accept-process-output proc timeout nil 0)) |
| 3659 | (buffer-string))))) | 3658 | (buffer-string))))) |
| 3660 | 3659 | ||
| 3661 | (defun tramp-check-for-regexp (proc regexp) | 3660 | (defun tramp-check-for-regexp (proc regexp) |
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 387a3c8bb36..4be487e1f4f 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el | |||
| @@ -7,7 +7,7 @@ | |||
| 7 | ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> | 7 | ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> |
| 8 | ;; Keywords: comm, processes | 8 | ;; Keywords: comm, processes |
| 9 | ;; Package: tramp | 9 | ;; Package: tramp |
| 10 | ;; Version: 2.3.2-pre | 10 | ;; Version: 2.3.2 |
| 11 | 11 | ||
| 12 | ;; This file is part of GNU Emacs. | 12 | ;; This file is part of GNU Emacs. |
| 13 | 13 | ||
| @@ -33,7 +33,7 @@ | |||
| 33 | ;; should be changed only there. | 33 | ;; should be changed only there. |
| 34 | 34 | ||
| 35 | ;;;###tramp-autoload | 35 | ;;;###tramp-autoload |
| 36 | (defconst tramp-version "2.3.2-pre" | 36 | (defconst tramp-version "2.3.2" |
| 37 | "This version of Tramp.") | 37 | "This version of Tramp.") |
| 38 | 38 | ||
| 39 | ;;;###tramp-autoload | 39 | ;;;###tramp-autoload |
| @@ -55,7 +55,7 @@ | |||
| 55 | ;; Check for Emacs version. | 55 | ;; Check for Emacs version. |
| 56 | (let ((x (if (>= emacs-major-version 24) | 56 | (let ((x (if (>= emacs-major-version 24) |
| 57 | "ok" | 57 | "ok" |
| 58 | (format "Tramp 2.3.2-pre is not fit for %s" | 58 | (format "Tramp 2.3.2 is not fit for %s" |
| 59 | (when (string-match "^.*$" (emacs-version)) | 59 | (when (string-match "^.*$" (emacs-version)) |
| 60 | (match-string 0 (emacs-version))))))) | 60 | (match-string 0 (emacs-version))))))) |
| 61 | (unless (string-match "\\`ok\\'" x) (error "%s" x))) | 61 | (unless (string-match "\\`ok\\'" x) (error "%s" x))) |
diff --git a/lisp/net/html2text.el b/lisp/obsolete/html2text.el index 87c71dc504a..27560a70c63 100644 --- a/lisp/net/html2text.el +++ b/lisp/obsolete/html2text.el | |||
| @@ -3,6 +3,7 @@ | |||
| 3 | ;; Copyright (C) 2002-2017 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002-2017 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Joakim Hove <hove@phys.ntnu.no> | 5 | ;; Author: Joakim Hove <hove@phys.ntnu.no> |
| 6 | ;; Obsolete-since: 26.1 | ||
| 6 | 7 | ||
| 7 | ;; This file is part of GNU Emacs. | 8 | ;; This file is part of GNU Emacs. |
| 8 | 9 | ||
| @@ -29,6 +30,8 @@ | |||
| 29 | ;; | 30 | ;; |
| 30 | ;; The main function is `html2text'. | 31 | ;; The main function is `html2text'. |
| 31 | 32 | ||
| 33 | ;; This package was obsoleted by shr.el. | ||
| 34 | |||
| 32 | ;;; Code: | 35 | ;;; Code: |
| 33 | 36 | ||
| 34 | ;; | 37 | ;; |
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index c05200b3898..de2543951b9 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el | |||
| @@ -1915,7 +1915,7 @@ with a brace block." | |||
| 1915 | (save-restriction | 1915 | (save-restriction |
| 1916 | (let ((start (point)) | 1916 | (let ((start (point)) |
| 1917 | (paren-state (c-parse-state)) | 1917 | (paren-state (c-parse-state)) |
| 1918 | lim pos end-pos encl-decl-block where) | 1918 | lim pos end-pos where) |
| 1919 | ;; Narrow enclosing brace blocks out, as required by the values of | 1919 | ;; Narrow enclosing brace blocks out, as required by the values of |
| 1920 | ;; `c-defun-tactic', `near', and the position of point. | 1920 | ;; `c-defun-tactic', `near', and the position of point. |
| 1921 | (when (eq c-defun-tactic 'go-outward) | 1921 | (when (eq c-defun-tactic 'go-outward) |
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index dd8f8afc6a3..85a4085e490 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el | |||
| @@ -44,19 +44,12 @@ | |||
| 44 | (load "cc-bytecomp" nil t))) | 44 | (load "cc-bytecomp" nil t))) |
| 45 | 45 | ||
| 46 | (eval-and-compile | 46 | (eval-and-compile |
| 47 | (defvar c--mapcan-status | 47 | (defvar c--cl-library |
| 48 | (cond ((and (fboundp 'mapcan) | 48 | (if (locate-library "cl-lib") |
| 49 | (subrp (symbol-function 'mapcan))) | 49 | 'cl-lib |
| 50 | ;; XEmacs | 50 | 'cl))) |
| 51 | 'mapcan) | 51 | |
| 52 | ((locate-file "cl-lib.elc" load-path) | 52 | (cc-external-require c--cl-library) |
| 53 | ;; Emacs >= 24.3 | ||
| 54 | 'cl-mapcan) | ||
| 55 | (t | ||
| 56 | ;; Emacs <= 24.2 | ||
| 57 | nil)))) | ||
| 58 | |||
| 59 | (cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl)) | ||
| 60 | ; was (cc-external-require 'cl). ACM 2005/11/29. | 53 | ; was (cc-external-require 'cl). ACM 2005/11/29. |
| 61 | ; Changed from (eval-when-compile (require 'cl)) back to | 54 | ; Changed from (eval-when-compile (require 'cl)) back to |
| 62 | ; cc-external-require, 2015-08-12. | 55 | ; cc-external-require, 2015-08-12. |
| @@ -182,9 +175,12 @@ This variant works around bugs in `eval-when-compile' in various | |||
| 182 | ;; The motivation for this macro is to avoid the irritating message | 175 | ;; The motivation for this macro is to avoid the irritating message |
| 183 | ;; "function `mapcan' from cl package called at runtime" produced by Emacs. | 176 | ;; "function `mapcan' from cl package called at runtime" produced by Emacs. |
| 184 | (cond | 177 | (cond |
| 185 | ((eq c--mapcan-status 'mapcan) | 178 | ((and (fboundp 'mapcan) |
| 179 | (subrp (symbol-function 'mapcan))) | ||
| 180 | ;; XEmacs and Emacs >= 26. | ||
| 186 | `(mapcan ,fun ,liszt)) | 181 | `(mapcan ,fun ,liszt)) |
| 187 | ((eq c--mapcan-status 'cl-mapcan) | 182 | ((eq c--cl-library 'cl-lib) |
| 183 | ;; Emacs >= 24.3, < 26. | ||
| 188 | `(cl-mapcan ,fun ,liszt)) | 184 | `(cl-mapcan ,fun ,liszt)) |
| 189 | (t | 185 | (t |
| 190 | ;; Emacs <= 24.2. It would be nice to be able to distinguish between | 186 | ;; Emacs <= 24.2. It would be nice to be able to distinguish between |
| @@ -193,13 +189,13 @@ This variant works around bugs in `eval-when-compile' in various | |||
| 193 | 189 | ||
| 194 | (defmacro c--set-difference (liszt1 liszt2 &rest other-args) | 190 | (defmacro c--set-difference (liszt1 liszt2 &rest other-args) |
| 195 | ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3. | 191 | ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3. |
| 196 | (if (eq c--mapcan-status 'cl-mapcan) | 192 | (if (eq c--cl-library 'cl-lib) |
| 197 | `(cl-set-difference ,liszt1 ,liszt2 ,@other-args) | 193 | `(cl-set-difference ,liszt1 ,liszt2 ,@other-args) |
| 198 | `(set-difference ,liszt1 ,liszt2 ,@other-args))) | 194 | `(set-difference ,liszt1 ,liszt2 ,@other-args))) |
| 199 | 195 | ||
| 200 | (defmacro c--intersection (liszt1 liszt2 &rest other-args) | 196 | (defmacro c--intersection (liszt1 liszt2 &rest other-args) |
| 201 | ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3. | 197 | ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3. |
| 202 | (if (eq c--mapcan-status 'cl-mapcan) | 198 | (if (eq c--cl-library 'cl-lib) |
| 203 | `(cl-intersection ,liszt1 ,liszt2 ,@other-args) | 199 | `(cl-intersection ,liszt1 ,liszt2 ,@other-args) |
| 204 | `(intersection ,liszt1 ,liszt2 ,@other-args))) | 200 | `(intersection ,liszt1 ,liszt2 ,@other-args))) |
| 205 | 201 | ||
| @@ -212,7 +208,7 @@ This variant works around bugs in `eval-when-compile' in various | |||
| 212 | 208 | ||
| 213 | (defmacro c--delete-duplicates (cl-seq &rest cl-keys) | 209 | (defmacro c--delete-duplicates (cl-seq &rest cl-keys) |
| 214 | ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3. | 210 | ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3. |
| 215 | (if (eq c--mapcan-status 'cl-mapcan) | 211 | (if (eq c--cl-library 'cl-lib) |
| 216 | `(cl-delete-duplicates ,cl-seq ,@cl-keys) | 212 | `(cl-delete-duplicates ,cl-seq ,@cl-keys) |
| 217 | `(delete-duplicates ,cl-seq ,@cl-keys)))) | 213 | `(delete-duplicates ,cl-seq ,@cl-keys)))) |
| 218 | 214 | ||
| @@ -1175,6 +1171,63 @@ been put there by c-put-char-property. POINT remains unchanged." | |||
| 1175 | nil ,from ,to ,value nil -property-)) | 1171 | nil ,from ,to ,value nil -property-)) |
| 1176 | ;; GNU Emacs | 1172 | ;; GNU Emacs |
| 1177 | `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) | 1173 | `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) |
| 1174 | |||
| 1175 | (defun c-clear-char-property-with-value-on-char-function (from to property | ||
| 1176 | value char) | ||
| 1177 | "Remove all text-properties PROPERTY with value VALUE on | ||
| 1178 | characters with value CHAR from the region [FROM, TO), as tested | ||
| 1179 | by `equal'. These properties are assumed to be over individual | ||
| 1180 | characters, having been put there by c-put-char-property. POINT | ||
| 1181 | remains unchanged." | ||
| 1182 | (let ((place from) | ||
| 1183 | ) | ||
| 1184 | (while ; loop round occurrences of (PROPERTY VALUE) | ||
| 1185 | (progn | ||
| 1186 | (while ; loop round changes in PROPERTY till we find VALUE | ||
| 1187 | (and | ||
| 1188 | (< place to) | ||
| 1189 | (not (equal (get-text-property place property) value))) | ||
| 1190 | (setq place (c-next-single-property-change place property nil to))) | ||
| 1191 | (< place to)) | ||
| 1192 | (if (eq (char-after place) char) | ||
| 1193 | (remove-text-properties place (1+ place) (cons property nil))) | ||
| 1194 | ;; Do we have to do anything with stickiness here? | ||
| 1195 | (setq place (1+ place))))) | ||
| 1196 | |||
| 1197 | (defmacro c-clear-char-property-with-value-on-char (from to property value char) | ||
| 1198 | "Remove all text-properties PROPERTY with value VALUE on | ||
| 1199 | characters with value CHAR from the region [FROM, TO), as tested | ||
| 1200 | by `equal'. These properties are assumed to be over individual | ||
| 1201 | characters, having been put there by c-put-char-property. POINT | ||
| 1202 | remains unchanged." | ||
| 1203 | (if c-use-extents | ||
| 1204 | ;; XEmacs | ||
| 1205 | `(let ((-property- ,property) | ||
| 1206 | (-char- ,char)) | ||
| 1207 | (map-extents (lambda (ext val) | ||
| 1208 | (if (and (equal (extent-property ext -property-) val) | ||
| 1209 | (eq (char-after | ||
| 1210 | (extent-start-position ext)) | ||
| 1211 | -char-)) | ||
| 1212 | (delete-extent ext))) | ||
| 1213 | nil ,from ,to ,value nil -property-)) | ||
| 1214 | ;; Gnu Emacs | ||
| 1215 | `(c-clear-char-property-with-value-on-char-function ,from ,to ,property | ||
| 1216 | ,value ,char))) | ||
| 1217 | |||
| 1218 | (defmacro c-put-char-properties-on-char (from to property value char) | ||
| 1219 | ;; This needs to be a macro because `property' passed to | ||
| 1220 | ;; `c-put-char-property' must be a constant. | ||
| 1221 | "Put the text property PROPERTY with value VALUE on characters | ||
| 1222 | with value CHAR in the region [FROM to)." | ||
| 1223 | `(let ((skip-string (concat "^" (list ,char))) | ||
| 1224 | (-to- ,to)) | ||
| 1225 | (save-excursion | ||
| 1226 | (goto-char ,from) | ||
| 1227 | (while (progn (skip-chars-forward skip-string -to-) | ||
| 1228 | (< (point) -to-)) | ||
| 1229 | (c-put-char-property (point) ,property ,value) | ||
| 1230 | (forward-char))))) | ||
| 1178 | 1231 | ||
| 1179 | ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. | 1232 | ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. |
| 1180 | ;; For our purposes, these are characterized by being possible to | 1233 | ;; For our purposes, these are characterized by being possible to |
| @@ -1232,6 +1285,8 @@ been put there by c-put-char-property. POINT remains unchanged." | |||
| 1232 | (def-edebug-spec c-put-char-property t) | 1285 | (def-edebug-spec c-put-char-property t) |
| 1233 | (def-edebug-spec c-get-char-property t) | 1286 | (def-edebug-spec c-get-char-property t) |
| 1234 | (def-edebug-spec c-clear-char-property t) | 1287 | (def-edebug-spec c-clear-char-property t) |
| 1288 | (def-edebug-spec c-clear-char-property-with-value-on-char t) | ||
| 1289 | (def-edebug-spec c-put-char-properties-on-char t) | ||
| 1235 | (def-edebug-spec c-clear-char-properties t) | 1290 | (def-edebug-spec c-clear-char-properties t) |
| 1236 | (def-edebug-spec c-put-overlay t) | 1291 | (def-edebug-spec c-put-overlay t) |
| 1237 | (def-edebug-spec c-delete-overlay t) | 1292 | (def-edebug-spec c-delete-overlay t) |
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index aa84ade083c..955e1ebb08d 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el | |||
| @@ -4809,7 +4809,6 @@ comment at the start of cc-engine.el for more info." | |||
| 4809 | 4809 | ||
| 4810 | (c-self-bind-state-cache | 4810 | (c-self-bind-state-cache |
| 4811 | (let ((start (point)) | 4811 | (let ((start (point)) |
| 4812 | state-2 | ||
| 4813 | ;; A list of syntactically relevant positions in descending | 4812 | ;; A list of syntactically relevant positions in descending |
| 4814 | ;; order. It's used to avoid scanning repeatedly over | 4813 | ;; order. It's used to avoid scanning repeatedly over |
| 4815 | ;; potentially large regions with `parse-partial-sexp' to verify | 4814 | ;; potentially large regions with `parse-partial-sexp' to verify |
| @@ -7809,8 +7808,7 @@ comment at the start of cc-engine.el for more info." | |||
| 7809 | ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of | 7808 | ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of |
| 7810 | ;; this construct and return t. If the parsing fails, return nil, leaving | 7809 | ;; this construct and return t. If the parsing fails, return nil, leaving |
| 7811 | ;; point unchanged. | 7810 | ;; point unchanged. |
| 7812 | (let ((here (point)) | 7811 | (let (end) |
| 7813 | end) | ||
| 7814 | (if (not (c-on-identifier)) | 7812 | (if (not (c-on-identifier)) |
| 7815 | nil | 7813 | nil |
| 7816 | (c-simple-skip-symbol-backward) | 7814 | (c-simple-skip-symbol-backward) |
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 9bae7d9aa2f..66f2575f49f 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el | |||
| @@ -702,6 +702,36 @@ stuff. Used on level 1 and higher." | |||
| 702 | t) | 702 | t) |
| 703 | (c-put-font-lock-face start (1+ start) 'font-lock-warning-face))))) | 703 | (c-put-font-lock-face start (1+ start) 'font-lock-warning-face))))) |
| 704 | 704 | ||
| 705 | (defun c-font-lock-invalid-single-quotes (limit) | ||
| 706 | ;; This function will be called from font-lock for a region bounded by POINT | ||
| 707 | ;; and LIMIT, as though it were to identify a keyword for | ||
| 708 | ;; font-lock-keyword-face. It always returns NIL to inhibit this and | ||
| 709 | ;; prevent a repeat invocation. See elisp/lispref page "Search-based | ||
| 710 | ;; Fontification". | ||
| 711 | ;; | ||
| 712 | ;; This function fontifies invalid single quotes with | ||
| 713 | ;; `font-lock-warning-face'. These are the single quotes which | ||
| 714 | ;; o - aren't inside a literal; | ||
| 715 | ;; o - are marked with a syntax-table text property value '(1); and | ||
| 716 | ;; o - are NOT marked with a non-null c-digit-separator property. | ||
| 717 | (let ((limits (c-literal-limits)) | ||
| 718 | state beg end) | ||
| 719 | (if limits | ||
| 720 | (goto-char (cdr limits))) ; Even for being in a ' ' | ||
| 721 | (while (< (point) limit) | ||
| 722 | (setq beg (point)) | ||
| 723 | (setq state (parse-partial-sexp (point) limit nil nil nil 'syntax-table)) | ||
| 724 | (setq end (point)) | ||
| 725 | (goto-char beg) | ||
| 726 | (while (progn (skip-chars-forward "^'" end) | ||
| 727 | (< (point) end)) | ||
| 728 | (if (and (equal (c-get-char-property (point) 'syntax-table) '(1)) | ||
| 729 | (not (c-get-char-property (point) 'c-digit-separator))) | ||
| 730 | (c-put-font-lock-face (point) (1+ (point)) font-lock-warning-face)) | ||
| 731 | (forward-char)) | ||
| 732 | (parse-partial-sexp end limit nil nil state 'syntax-table))) | ||
| 733 | nil) | ||
| 734 | |||
| 705 | (c-lang-defconst c-basic-matchers-before | 735 | (c-lang-defconst c-basic-matchers-before |
| 706 | "Font lock matchers for basic keywords, labels, references and various | 736 | "Font lock matchers for basic keywords, labels, references and various |
| 707 | other easily recognizable things that should be fontified before generic | 737 | 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." | |||
| 723 | (concat ".\\(" c-string-limit-regexp "\\)") | 753 | (concat ".\\(" c-string-limit-regexp "\\)") |
| 724 | '((c-font-lock-invalid-string))) | 754 | '((c-font-lock-invalid-string))) |
| 725 | 755 | ||
| 756 | ;; Invalid single quotes. | ||
| 757 | c-font-lock-invalid-single-quotes | ||
| 758 | |||
| 726 | ;; Fontify C++ raw strings. | 759 | ;; Fontify C++ raw strings. |
| 727 | ,@(when (c-major-mode-is 'c++-mode) | 760 | ,@(when (c-major-mode-is 'c++-mode) |
| 728 | '(c-font-lock-raw-strings)) | 761 | '(c-font-lock-raw-strings)) |
| @@ -777,7 +810,8 @@ casts and declarations are fontified. Used on level 2 and higher." | |||
| 777 | (c-backward-syntactic-ws) | 810 | (c-backward-syntactic-ws) |
| 778 | (setq id-end (point)) | 811 | (setq id-end (point)) |
| 779 | (< (skip-chars-backward | 812 | (< (skip-chars-backward |
| 780 | ,(c-lang-const c-symbol-chars)) 0)) | 813 | ,(c-lang-const c-symbol-chars)) |
| 814 | 0)) | ||
| 781 | (not (get-text-property (point) 'face))) | 815 | (not (get-text-property (point) 'face))) |
| 782 | (c-put-font-lock-face (point) id-end | 816 | (c-put-font-lock-face (point) id-end |
| 783 | c-reference-face-name) | 817 | c-reference-face-name) |
| @@ -1013,13 +1047,11 @@ casts and declarations are fontified. Used on level 2 and higher." | |||
| 1013 | 1047 | ||
| 1014 | ;;(message "c-font-lock-declarators from %s to %s" (point) limit) | 1048 | ;;(message "c-font-lock-declarators from %s to %s" (point) limit) |
| 1015 | (c-fontify-types-and-refs | 1049 | (c-fontify-types-and-refs |
| 1016 | ((pos (point)) next-pos id-start id-end | 1050 | ((pos (point)) next-pos id-start |
| 1017 | decl-res | 1051 | decl-res |
| 1018 | paren-depth | ||
| 1019 | id-face got-type got-init | 1052 | id-face got-type got-init |
| 1020 | c-last-identifier-range | 1053 | c-last-identifier-range |
| 1021 | (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)) | 1054 | (separator-prop (if types 'c-decl-type-start 'c-decl-id-start))) |
| 1022 | brackets-after-id) | ||
| 1023 | 1055 | ||
| 1024 | ;; The following `while' fontifies a single declarator id each time round. | 1056 | ;; The following `while' fontifies a single declarator id each time round. |
| 1025 | ;; It loops only when LIST is non-nil. | 1057 | ;; It loops only when LIST is non-nil. |
| @@ -1036,7 +1068,7 @@ casts and declarations are fontified. Used on level 2 and higher." | |||
| 1036 | (forward-char) | 1068 | (forward-char) |
| 1037 | (c-forward-syntactic-ws) | 1069 | (c-forward-syntactic-ws) |
| 1038 | (looking-at "[*&]"))) | 1070 | (looking-at "[*&]"))) |
| 1039 | (not (car (cddr decl-res))) ; brackets-after-id | 1071 | (not (car (cddr decl-res))) |
| 1040 | (or (not (c-major-mode-is 'c++-mode)) | 1072 | (or (not (c-major-mode-is 'c++-mode)) |
| 1041 | (save-excursion | 1073 | (save-excursion |
| 1042 | (let (c-last-identifier-range) | 1074 | (let (c-last-identifier-range) |
| @@ -1375,7 +1407,6 @@ casts and declarations are fontified. Used on level 2 and higher." | |||
| 1375 | ;; it finds any. That's necessary so that we later will | 1407 | ;; it finds any. That's necessary so that we later will |
| 1376 | ;; stop inside them to fontify types there. | 1408 | ;; stop inside them to fontify types there. |
| 1377 | (c-parse-and-markup-<>-arglists t) | 1409 | (c-parse-and-markup-<>-arglists t) |
| 1378 | lbrace ; position of some {. | ||
| 1379 | ;; The font-lock package in Emacs is known to clobber | 1410 | ;; The font-lock package in Emacs is known to clobber |
| 1380 | ;; `parse-sexp-lookup-properties' (when it exists). | 1411 | ;; `parse-sexp-lookup-properties' (when it exists). |
| 1381 | (parse-sexp-lookup-properties | 1412 | (parse-sexp-lookup-properties |
| @@ -2503,7 +2534,7 @@ need for `c++-font-lock-extra-types'.") | |||
| 2503 | limit | 2534 | limit |
| 2504 | "[-+]" | 2535 | "[-+]" |
| 2505 | nil | 2536 | nil |
| 2506 | (lambda (match-pos inside-macro &optional top-level) | 2537 | (lambda (_match-pos _inside-macro &optional _top-level) |
| 2507 | (forward-char) | 2538 | (forward-char) |
| 2508 | (c-font-lock-objc-method)))) | 2539 | (c-font-lock-objc-method)))) |
| 2509 | nil) | 2540 | nil) |
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index a9d5ac34ad4..8be806094cd 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el | |||
| @@ -130,7 +130,7 @@ | |||
| 130 | 130 | ||
| 131 | 131 | ||
| 132 | ;; This file is not always loaded. See note above. | 132 | ;; This file is not always loaded. See note above. |
| 133 | (cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl)) | 133 | (cc-external-require (if (eq c--cl-library 'cl-lib) 'cl-lib 'cl)) |
| 134 | 134 | ||
| 135 | 135 | ||
| 136 | ;;; Setup for the `c-lang-defvar' system. | 136 | ;;; Setup for the `c-lang-defvar' system. |
| @@ -474,18 +474,19 @@ so that all identifiers are recognized as words.") | |||
| 474 | ;; The value here may be a list of functions or a single function. | 474 | ;; The value here may be a list of functions or a single function. |
| 475 | t nil | 475 | t nil |
| 476 | c++ '(c-extend-region-for-CPP | 476 | c++ '(c-extend-region-for-CPP |
| 477 | ; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed. | ||
| 478 | c-before-change-check-raw-strings | 477 | c-before-change-check-raw-strings |
| 479 | c-before-change-check-<>-operators | 478 | c-before-change-check-<>-operators |
| 480 | c-depropertize-CPP | 479 | c-depropertize-CPP |
| 481 | c-before-after-change-digit-quote | ||
| 482 | c-invalidate-macro-cache | 480 | c-invalidate-macro-cache |
| 483 | c-truncate-bs-cache) | 481 | c-truncate-bs-cache |
| 482 | c-parse-quotes-before-change) | ||
| 484 | (c objc) '(c-extend-region-for-CPP | 483 | (c objc) '(c-extend-region-for-CPP |
| 485 | c-depropertize-CPP | 484 | c-depropertize-CPP |
| 486 | c-invalidate-macro-cache | 485 | c-invalidate-macro-cache |
| 487 | c-truncate-bs-cache) | 486 | c-truncate-bs-cache |
| 488 | ;; java 'c-before-change-check-<>-operators | 487 | c-parse-quotes-before-change) |
| 488 | java 'c-parse-quotes-before-change | ||
| 489 | ;; 'c-before-change-check-<>-operators | ||
| 489 | awk 'c-awk-record-region-clear-NL) | 490 | awk 'c-awk-record-region-clear-NL) |
| 490 | (c-lang-defvar c-get-state-before-change-functions | 491 | (c-lang-defvar c-get-state-before-change-functions |
| 491 | (let ((fs (c-lang-const c-get-state-before-change-functions))) | 492 | (let ((fs (c-lang-const c-get-state-before-change-functions))) |
| @@ -515,18 +516,19 @@ parameters \(point-min) and \(point-max).") | |||
| 515 | t '(c-depropertize-new-text | 516 | t '(c-depropertize-new-text |
| 516 | c-change-expand-fl-region) | 517 | c-change-expand-fl-region) |
| 517 | (c objc) '(c-depropertize-new-text | 518 | (c objc) '(c-depropertize-new-text |
| 519 | c-parse-quotes-after-change | ||
| 518 | c-extend-font-lock-region-for-macros | 520 | c-extend-font-lock-region-for-macros |
| 519 | c-neutralize-syntax-in-and-mark-CPP | 521 | c-neutralize-syntax-in-and-mark-CPP |
| 520 | c-change-expand-fl-region) | 522 | c-change-expand-fl-region) |
| 521 | c++ '(c-depropertize-new-text | 523 | c++ '(c-depropertize-new-text |
| 524 | c-parse-quotes-after-change | ||
| 522 | c-extend-font-lock-region-for-macros | 525 | c-extend-font-lock-region-for-macros |
| 523 | ; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed. | ||
| 524 | c-before-after-change-digit-quote | ||
| 525 | c-after-change-re-mark-raw-strings | 526 | c-after-change-re-mark-raw-strings |
| 526 | c-neutralize-syntax-in-and-mark-CPP | 527 | c-neutralize-syntax-in-and-mark-CPP |
| 527 | c-restore-<>-properties | 528 | c-restore-<>-properties |
| 528 | c-change-expand-fl-region) | 529 | c-change-expand-fl-region) |
| 529 | java '(c-depropertize-new-text | 530 | java '(c-depropertize-new-text |
| 531 | c-parse-quotes-after-change | ||
| 530 | c-restore-<>-properties | 532 | c-restore-<>-properties |
| 531 | c-change-expand-fl-region) | 533 | c-change-expand-fl-region) |
| 532 | awk '(c-depropertize-new-text | 534 | awk '(c-depropertize-new-text |
| @@ -609,6 +611,12 @@ EOL terminated statements." | |||
| 609 | (c c++ objc) t) | 611 | (c c++ objc) t) |
| 610 | (c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields)) | 612 | (c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields)) |
| 611 | 613 | ||
| 614 | (c-lang-defconst c-has-quoted-numbers | ||
| 615 | "Whether the language has numbers quoted like 4'294'967'295." | ||
| 616 | t nil | ||
| 617 | c++ t) | ||
| 618 | (c-lang-defvar c-has-quoted-numbers (c-lang-const c-has-quoted-numbers)) | ||
| 619 | |||
| 612 | (c-lang-defconst c-modified-constant | 620 | (c-lang-defconst c-modified-constant |
| 613 | "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\", | 621 | "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\", |
| 614 | a “long character”. In particular, this recognizes forms of constant | 622 | 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 a501ebba256..ef93f75c5f3 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el | |||
| @@ -1083,101 +1083,219 @@ Note that the style variables are always made local to the buffer." | |||
| 1083 | (forward-line)) ; no infinite loop with, e.g., "#//" | 1083 | (forward-line)) ; no infinite loop with, e.g., "#//" |
| 1084 | ))))) | 1084 | ))))) |
| 1085 | 1085 | ||
| 1086 | (defun c-before-after-change-digit-quote (beg end &optional old-len) | 1086 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1087 | ;; This function either removes or applies the punctuation value ('(1)) of | 1087 | ;; Parsing of quotes. |
| 1088 | ;; the `syntax-table' text property on single quote marks which are | 1088 | ;; |
| 1089 | ;; separator characters in long integer literals, e.g. "4'294'967'295". It | 1089 | ;; Valid digit separators in numbers will get the syntax-table "punctuation" |
| 1090 | ;; applies to both decimal/octal and hex literals. (FIXME (2016-06-10): it | 1090 | ;; property, '(1), and also the text property `c-digit-separator' value t. |
| 1091 | ;; should also apply to binary literals.) | 1091 | ;; |
| 1092 | ;; Invalid other quotes (i.e. those not validly bounding a single character, | ||
| 1093 | ;; or escaped character) will get the syntax-table "punctuation" property, | ||
| 1094 | ;; '(1), too. | ||
| 1095 | ;; | ||
| 1096 | ;; Note that, for convenience, these properties are applied even inside | ||
| 1097 | ;; comments and strings. | ||
| 1098 | |||
| 1099 | (defconst c-maybe-quoted-number-head | ||
| 1100 | (concat | ||
| 1101 | "\\(0\\(" | ||
| 1102 | "\\([Xx]\\([0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*'?\\)?\\)" | ||
| 1103 | "\\|" | ||
| 1104 | "\\([Bb]\\([01]\\('[01]\\|[01]\\)*'?\\)?\\)" | ||
| 1105 | "\\|" | ||
| 1106 | "\\('[0-7]\\|[0-7]\\)*'?" | ||
| 1107 | "\\)" | ||
| 1108 | "\\|" | ||
| 1109 | "[1-9]\\('[0-9]\\|[0-9]\\)*'?" | ||
| 1110 | "\\)") | ||
| 1111 | "Regexp matching the head of a numeric literal, including with digit separators.") | ||
| 1112 | |||
| 1113 | (defun c-quoted-number-head-before-point () | ||
| 1114 | ;; Return non-nil when the head of a possibly quoted number is found | ||
| 1115 | ;; immediately before point. The value returned in this case is the buffer | ||
| 1116 | ;; position of the start of the head. That position is also in | ||
| 1117 | ;; (match-beginning 0). | ||
| 1118 | (when c-has-quoted-numbers | ||
| 1119 | (save-excursion | ||
| 1120 | (let ((here (point)) | ||
| 1121 | found) | ||
| 1122 | (skip-chars-backward "0-9a-fA-F'") | ||
| 1123 | (if (and (memq (char-before) '(?x ?X)) | ||
| 1124 | (eq (char-before (1- (point))) ?0)) | ||
| 1125 | (backward-char 2)) | ||
| 1126 | (while | ||
| 1127 | (and | ||
| 1128 | (setq found | ||
| 1129 | (search-forward-regexp c-maybe-quoted-number-head here t)) | ||
| 1130 | (< found here))) | ||
| 1131 | (and (eq found here) (match-beginning 0)))))) | ||
| 1132 | |||
| 1133 | (defconst c-maybe-quoted-number-tail | ||
| 1134 | (concat | ||
| 1135 | "\\(" | ||
| 1136 | "\\([xX']?[0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)" | ||
| 1137 | "\\|" | ||
| 1138 | "\\([bB']?[01]\\('[01]\\|[01]\\)*\\)" | ||
| 1139 | "\\|" | ||
| 1140 | "\\('?[0-9]\\('[0-9]\\|[0-9]\\)*\\)" | ||
| 1141 | "\\)") | ||
| 1142 | "Regexp matching the tail of a numeric literal, including with digit separators. | ||
| 1143 | Note that this is a strict tail, so won't match, e.g. \"0x....\".") | ||
| 1144 | |||
| 1145 | (defun c-quoted-number-tail-after-point () | ||
| 1146 | ;; Return non-nil when a proper tail of a possibly quoted number is found | ||
| 1147 | ;; immediately after point. The value returned in this case is the buffer | ||
| 1148 | ;; position of the end of the tail. That position is also in (match-end 0). | ||
| 1149 | (when c-has-quoted-numbers | ||
| 1150 | (and (looking-at c-maybe-quoted-number-tail) | ||
| 1151 | (match-end 0)))) | ||
| 1152 | |||
| 1153 | (defconst c-maybe-quoted-number | ||
| 1154 | (concat | ||
| 1155 | "\\(0\\(" | ||
| 1156 | "\\([Xx][0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)" | ||
| 1157 | "\\|" | ||
| 1158 | "\\([Bb][01]\\('[01]\\|[01]\\)*\\)" | ||
| 1159 | "\\|" | ||
| 1160 | "\\('[0-7]\\|[0-7]\\)*" | ||
| 1161 | "\\)" | ||
| 1162 | "\\|" | ||
| 1163 | "[1-9]\\('[0-9]\\|[0-9]\\)*" | ||
| 1164 | "\\)") | ||
| 1165 | "Regexp matching a numeric literal, including with digit separators.") | ||
| 1166 | |||
| 1167 | (defun c-quoted-number-straddling-point () | ||
| 1168 | ;; Return non-nil if a definitely quoted number starts before point and ends | ||
| 1169 | ;; after point. In this case the number is bounded by (match-beginning 0) | ||
| 1170 | ;; and (match-end 0). | ||
| 1171 | (when c-has-quoted-numbers | ||
| 1172 | (save-excursion | ||
| 1173 | (let ((here (point)) | ||
| 1174 | (bound (progn (skip-chars-forward "0-9a-fA-F'") (point)))) | ||
| 1175 | (goto-char here) | ||
| 1176 | (when (< (skip-chars-backward "0-9a-fA-F'") 0) | ||
| 1177 | (if (and (memq (char-before) '(?x ?X)) | ||
| 1178 | (eq (char-before (1- (point))) ?0)) | ||
| 1179 | (backward-char 2)) | ||
| 1180 | (while (and (search-forward-regexp c-maybe-quoted-number bound t) | ||
| 1181 | (<= (match-end 0) here))) | ||
| 1182 | (and (< (match-beginning 0) here) | ||
| 1183 | (> (match-end 0) here) | ||
| 1184 | (save-match-data | ||
| 1185 | (goto-char (match-beginning 0)) | ||
| 1186 | (save-excursion (search-forward "'" (match-end 0) t))))))))) | ||
| 1187 | |||
| 1188 | (defun c-parse-quotes-before-change (beg end) | ||
| 1189 | ;; This function analyzes 's near the region (c-new-BEG c-new-END), amending | ||
| 1190 | ;; those two variables as needed to include 's into that region when they | ||
| 1191 | ;; might be syntactically relevant to the change in progress. | ||
| 1092 | ;; | 1192 | ;; |
| 1093 | ;; In both uses of the function, the `syntax-table' properties are | 1193 | ;; Having amended that region, the function removes pertinent text |
| 1094 | ;; removed/applied only on quote marks which appear to be digit separators. | 1194 | ;; properties (syntax-table properties with value '(1) and c-digit-separator |
| 1195 | ;; props with value t) from 's in it. This operation is performed even | ||
| 1196 | ;; within strings and comments. | ||
| 1095 | ;; | 1197 | ;; |
| 1096 | ;; Point is undefined on both entry and exit to this function, and the | 1198 | ;; This function is called exclusively as a before-change function via the |
| 1097 | ;; return value has no significance. The function is called solely as a | 1199 | ;; variable `c-get-state-before-change-functions'. |
| 1098 | ;; before-change function (see `c-get-state-before-change-functions') and as | 1200 | (c-save-buffer-state (p-limit limits found) |
| 1099 | ;; an after change function (see `c-before-font-lock-functions', with the | 1201 | ;; Special consideraton for deleting \ from '\''. |
| 1100 | ;; parameters BEG, END, and (optionally) OLD-LEN being given the standard | 1202 | (if (and (> end beg) |
| 1101 | ;; values for before/after-change functions. | 1203 | (eq (char-before end) ?\\) |
| 1102 | (c-save-buffer-state ((num-begin c-new-BEG) digit-re try-end) | 1204 | (<= c-new-END end)) |
| 1205 | (setq c-new-END (min (1+ end) (point-max)))) | ||
| 1206 | |||
| 1207 | ;; Do we have a ' (or something like ',',',',',') within range of | ||
| 1208 | ;; c-new-BEG? | ||
| 1209 | (goto-char c-new-BEG) | ||
| 1210 | (setq p-limit (max (- (point) 2) (point-min))) | ||
| 1211 | (while (and (skip-chars-backward "^\\\\'" p-limit) | ||
| 1212 | (> (point) p-limit)) | ||
| 1213 | (when (eq (char-before) ?\\) | ||
| 1214 | (setq p-limit (max (1- p-limit) (point-min)))) | ||
| 1215 | (backward-char) | ||
| 1216 | (setq c-new-BEG (point))) | ||
| 1217 | (beginning-of-line) | ||
| 1218 | (while (and | ||
| 1219 | (setq found (search-forward-regexp "\\('\\([^'\\]\\|\\\\.\\)\\)*'" | ||
| 1220 | c-new-BEG 'limit)) | ||
| 1221 | (< (point) (1- c-new-BEG)))) | ||
| 1222 | (if found | ||
| 1223 | (setq c-new-BEG | ||
| 1224 | (if (and (eq (point) (1- c-new-BEG)) | ||
| 1225 | (eq (char-after) ?')) ; "''" before c-new-BEG. | ||
| 1226 | (1- c-new-BEG) | ||
| 1227 | (match-beginning 0)))) | ||
| 1228 | |||
| 1229 | ;; Check for a number with quote separators straddling c-new-BEG | ||
| 1230 | (when c-has-quoted-numbers | ||
| 1231 | (goto-char c-new-BEG) | ||
| 1232 | (when ;; (c-quoted-number-straddling-point) | ||
| 1233 | (c-quoted-number-head-before-point) | ||
| 1234 | (setq c-new-BEG (match-beginning 0)))) | ||
| 1235 | |||
| 1236 | ;; Do we have a ' (or something like ',',',',...,',') within range of | ||
| 1237 | ;; c-new-END? | ||
| 1103 | (goto-char c-new-END) | 1238 | (goto-char c-new-END) |
| 1104 | (when (looking-at "\\(x\\)?[0-9a-fA-F']+") | 1239 | (setq p-limit (min (+ (point) 2) (point-max))) |
| 1105 | (setq c-new-END (match-end 0))) | 1240 | (while (and (skip-chars-forward "^\\\\'" p-limit) |
| 1241 | (< (point) p-limit)) | ||
| 1242 | (when (eq (char-after) ?\\) | ||
| 1243 | (setq p-limit (min (1+ p-limit) (point-max)))) | ||
| 1244 | (forward-char) | ||
| 1245 | (setq c-new-END (point))) | ||
| 1246 | (if (looking-at "[^']?\\('\\([^'\\]\\|\\\\.\\)\\)*'") | ||
| 1247 | (setq c-new-END (match-end 0))) | ||
| 1248 | |||
| 1249 | ;; Check for a number with quote separators straddling c-new-END. | ||
| 1250 | (when c-has-quoted-numbers | ||
| 1251 | (goto-char c-new-END) | ||
| 1252 | (when ;; (c-quoted-number-straddling-point) | ||
| 1253 | (c-quoted-number-tail-after-point) | ||
| 1254 | (setq c-new-END (match-end 0)))) | ||
| 1255 | |||
| 1256 | ;; Remove the '(1) syntax-table property from all "'"s within (c-new-BEG | ||
| 1257 | ;; c-new-END). | ||
| 1258 | (c-clear-char-property-with-value-on-char | ||
| 1259 | c-new-BEG c-new-END | ||
| 1260 | 'syntax-table '(1) | ||
| 1261 | ?') | ||
| 1262 | ;; Remove the c-digit-separator text property from the same "'"s. | ||
| 1263 | (when c-has-quoted-numbers | ||
| 1264 | (c-clear-char-property-with-value-on-char | ||
| 1265 | c-new-BEG c-new-END | ||
| 1266 | 'c-digit-separator t | ||
| 1267 | ?')))) | ||
| 1268 | |||
| 1269 | (defun c-parse-quotes-after-change (beg end old-len) | ||
| 1270 | ;; This function applies syntax-table properties (value '(1)) and | ||
| 1271 | ;; c-digit-separator properties as needed to 's within the range (c-new-BEG | ||
| 1272 | ;; c-new-END). This operation is performed even within strings and | ||
| 1273 | ;; comments. | ||
| 1274 | ;; | ||
| 1275 | ;; This function is called exclusively as an after-change function via the | ||
| 1276 | ;; variable `c-before-font-lock-functions'. | ||
| 1277 | (c-save-buffer-state (p-limit limits num-beg num-end clear-from-BEG-to) | ||
| 1278 | ;; Apply the needed syntax-table and c-digit-separator text properties to | ||
| 1279 | ;; quotes. | ||
| 1106 | (goto-char c-new-BEG) | 1280 | (goto-char c-new-BEG) |
| 1107 | (when (looking-at "\\(x?\\)[0-9a-fA-F']") | 1281 | (while (and (< (point) c-new-END) |
| 1108 | (if (re-search-backward "\\(0x\\)?[0-9a-fA-F]*\\=" nil t) | 1282 | (search-forward "'" c-new-END 'limit)) |
| 1109 | (setq c-new-BEG (point)))) | 1283 | (cond ((and (eq (char-before (1- (point))) ?\\) |
| 1110 | 1284 | ;; Check we've got an odd number of \s, here. | |
| 1111 | (while | ||
| 1112 | (re-search-forward "[0-9a-fA-F]'[0-9a-fA-F]" c-new-END t) | ||
| 1113 | (setq try-end (1- (point))) | ||
| 1114 | (re-search-backward "[^0-9a-fA-F']" num-begin t) | ||
| 1115 | (setq digit-re | ||
| 1116 | (cond | ||
| 1117 | ((and (not (bobp)) (eq (char-before) ?0) (memq (char-after) '(?x ?X))) | ||
| 1118 | "[0-9a-fA-F]") | ||
| 1119 | ((and (eq (char-after (1+ (point))) ?0) | ||
| 1120 | (memq (char-after (+ 2 (point))) '(?b ?B))) | ||
| 1121 | "[01]") | ||
| 1122 | ((memq (char-after (1+ (point))) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) | ||
| 1123 | "[0-9]") | ||
| 1124 | (t nil))) | ||
| 1125 | (when digit-re | ||
| 1126 | (cond ((eq (char-after) ?x) (forward-char)) | ||
| 1127 | ((looking-at ".?0[Bb]") (goto-char (match-end 0))) | ||
| 1128 | ((looking-at digit-re)) | ||
| 1129 | (t (forward-char))) | ||
| 1130 | (when (not (c-in-literal)) | ||
| 1131 | (let ((num-end ; End of valid sequence of digits/quotes. | ||
| 1132 | (save-excursion | ||
| 1133 | (re-search-forward | ||
| 1134 | (concat "\\=\\(" digit-re "+'\\)*" digit-re "+") nil t) | ||
| 1135 | (point)))) | ||
| 1136 | (setq try-end ; End of sequence of digits/quotes | ||
| 1137 | (save-excursion | 1285 | (save-excursion |
| 1138 | (re-search-forward | 1286 | (backward-char) |
| 1139 | (concat "\\=\\(" digit-re "\\|'\\)+") nil t) | 1287 | (eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '. |
| 1140 | (point))) | 1288 | ((c-quoted-number-straddling-point) |
| 1141 | (while (re-search-forward | 1289 | (setq num-beg (match-beginning 0) |
| 1142 | (concat digit-re "\\('\\)" digit-re) num-end t) | 1290 | num-end (match-end 0)) |
| 1143 | (if old-len ; i.e. are we in an after-change function? | 1291 | (c-put-char-properties-on-char num-beg num-end |
| 1144 | (c-put-char-property (match-beginning 1) 'syntax-table '(1)) | 1292 | 'syntax-table '(1) ?') |
| 1145 | (c-clear-char-property (match-beginning 1) 'syntax-table)) | 1293 | (c-put-char-properties-on-char num-beg num-end |
| 1146 | (backward-char))))) | 1294 | 'c-digit-separator t ?') |
| 1147 | (goto-char try-end) | 1295 | (goto-char num-end)) |
| 1148 | (setq num-begin (point))))) | 1296 | ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression. |
| 1149 | 1297 | (goto-char (match-end 0))) | |
| 1150 | ;; The following doesn't seem needed at the moment (2016-08-15). | 1298 | (t (c-put-char-property (1- (point)) 'syntax-table '(1))))))) |
| 1151 | ;; (defun c-before-after-change-extend-region-for-lambda-capture | ||
| 1152 | ;; (_beg _end &optional _old-len) | ||
| 1153 | ;; ;; In C++ Mode, extend the region (c-new-BEG c-new-END) to cover any lambda | ||
| 1154 | ;; ;; function capture lists we happen to be inside. This function is expected | ||
| 1155 | ;; ;; to be called both as a before-change and after change function. | ||
| 1156 | ;; ;; | ||
| 1157 | ;; ;; Note that these things _might_ be nested, with a capture list looking | ||
| 1158 | ;; ;; like: | ||
| 1159 | ;; ;; | ||
| 1160 | ;; ;; [ ...., &foo = [..](){...}(..), ... ] | ||
| 1161 | ;; ;; | ||
| 1162 | ;; ;; . What a wonderful language is C++. ;-) | ||
| 1163 | ;; (c-save-buffer-state (paren-state pos) | ||
| 1164 | ;; (goto-char c-new-BEG) | ||
| 1165 | ;; (setq paren-state (c-parse-state)) | ||
| 1166 | ;; (while (setq pos (c-pull-open-brace paren-state)) | ||
| 1167 | ;; (goto-char pos) | ||
| 1168 | ;; (when (c-looking-at-c++-lambda-capture-list) | ||
| 1169 | ;; (setq c-new-BEG (min c-new-BEG pos)) | ||
| 1170 | ;; (if (c-go-list-forward) | ||
| 1171 | ;; (setq c-new-END (max c-new-END (point)))))) | ||
| 1172 | |||
| 1173 | ;; (goto-char c-new-END) | ||
| 1174 | ;; (setq paren-state (c-parse-state)) | ||
| 1175 | ;; (while (setq pos (c-pull-open-brace paren-state)) | ||
| 1176 | ;; (goto-char pos) | ||
| 1177 | ;; (when (c-looking-at-c++-lambda-capture-list) | ||
| 1178 | ;; (setq c-new-BEG (min c-new-BEG pos)) | ||
| 1179 | ;; (if (c-go-list-forward) | ||
| 1180 | ;; (setq c-new-END (max c-new-END (point)))))))) | ||
| 1181 | 1299 | ||
| 1182 | (defun c-before-change (beg end) | 1300 | (defun c-before-change (beg end) |
| 1183 | ;; Function to be put on `before-change-functions'. Primarily, this calls | 1301 | ;; Function to be put on `before-change-functions'. Primarily, this calls |
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index b3848a74f97..b1c94c3bc6a 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el | |||
| @@ -47,6 +47,7 @@ | |||
| 47 | ;; `c-add-style' often contains references to functions defined there. | 47 | ;; `c-add-style' often contains references to functions defined there. |
| 48 | 48 | ||
| 49 | ;; Silence the compiler. | 49 | ;; Silence the compiler. |
| 50 | (cc-bytecomp-defun c-guess-basic-syntax) | ||
| 50 | (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs | 51 | (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs |
| 51 | 52 | ||
| 52 | 53 | ||
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 902a5aace08..de0cd50911a 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el | |||
| @@ -353,8 +353,6 @@ information): | |||
| 353 | Quotes all \"#\" characters that don't correspond to actual | 353 | Quotes all \"#\" characters that don't correspond to actual |
| 354 | Tcl comments. (Useful when editing code not originally created | 354 | Tcl comments. (Useful when editing code not originally created |
| 355 | with this mode). | 355 | with this mode). |
| 356 | `tcl-auto-fill-mode' | ||
| 357 | Auto-filling of Tcl comments. | ||
| 358 | 356 | ||
| 359 | Add functions to the hook with `add-hook': | 357 | Add functions to the hook with `add-hook': |
| 360 | 358 | ||
| @@ -1413,6 +1411,9 @@ Prefix argument means switch to the Tcl buffer afterwards." | |||
| 1413 | 1411 | ||
| 1414 | (defun tcl-auto-fill-mode (&optional arg) | 1412 | (defun tcl-auto-fill-mode (&optional arg) |
| 1415 | "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'." | 1413 | "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'." |
| 1414 | (declare | ||
| 1415 | (obsolete | ||
| 1416 | "Use `auto-fill-mode' with `comment-auto-fill-only-comments'." "26.1")) | ||
| 1416 | (interactive "P") | 1417 | (interactive "P") |
| 1417 | (auto-fill-mode arg) | 1418 | (auto-fill-mode arg) |
| 1418 | (if auto-fill-function | 1419 | (if auto-fill-function |
diff --git a/lisp/select.el b/lisp/select.el index 4849d7d515e..579c5c7e2ee 100644 --- a/lisp/select.el +++ b/lisp/select.el | |||
| @@ -475,6 +475,9 @@ two markers or an overlay. Otherwise, it is nil." | |||
| 475 | (t | 475 | (t |
| 476 | (error "Unknown selection type: %S" type))))) | 476 | (error "Unknown selection type: %S" type))))) |
| 477 | 477 | ||
| 478 | ;; Most programs are unable to handle NUL bytes in strings. | ||
| 479 | (setq str (replace-regexp-in-string "\0" "\\0" str t t)) | ||
| 480 | |||
| 478 | (setq next-selection-coding-system nil) | 481 | (setq next-selection-coding-system nil) |
| 479 | (cons type str)))) | 482 | (cons type str)))) |
| 480 | 483 | ||
diff --git a/lisp/ses.el b/lisp/ses.el index fd7174d383d..97bade380ec 100644 --- a/lisp/ses.el +++ b/lisp/ses.el | |||
| @@ -437,7 +437,7 @@ is nil if SYM is not a symbol that names a cell." | |||
| 437 | (declare (debug t)) | 437 | (declare (debug t)) |
| 438 | `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) | 438 | `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) |
| 439 | (if (eq rc :ses-named) | 439 | (if (eq rc :ses-named) |
| 440 | (gethash ,sym ses--named-cell-hashmap) | 440 | (and ses--named-cell-hashmap (gethash ,sym ses--named-cell-hashmap)) |
| 441 | rc))) | 441 | rc))) |
| 442 | 442 | ||
| 443 | (defun ses-cell-p (cell) | 443 | (defun ses-cell-p (cell) |
| @@ -868,27 +868,39 @@ means Emacs will crash if FORMULA contains a circular list." | |||
| 868 | (oldref (ses-formula-references old)) | 868 | (oldref (ses-formula-references old)) |
| 869 | (newref (ses-formula-references formula)) | 869 | (newref (ses-formula-references formula)) |
| 870 | (inhibit-quit t) | 870 | (inhibit-quit t) |
| 871 | not-a-cell-ref-list | ||
| 871 | x xrow xcol) | 872 | x xrow xcol) |
| 872 | (cl-pushnew sym ses--deferred-recalc) | 873 | (cl-pushnew sym ses--deferred-recalc) |
| 873 | ;;Delete old references from this cell. Skip the ones that are also | 874 | ;;Delete old references from this cell. Skip the ones that are also |
| 874 | ;;in the new list. | 875 | ;;in the new list. |
| 875 | (dolist (ref oldref) | 876 | (dolist (ref oldref) |
| 876 | (unless (memq ref newref) | 877 | (unless (memq ref newref) |
| 877 | (setq x (ses-sym-rowcol ref) | 878 | ;; because we do not cancel edit when the user provides a |
| 878 | xrow (car x) | 879 | ;; false reference in it, then we need to check that ref |
| 879 | xcol (cdr x)) | 880 | ;; points to a cell that is within the spreadsheet. |
| 880 | (ses-set-cell xrow xcol 'references | 881 | (setq x (ses-sym-rowcol ref)) |
| 881 | (delq sym (ses-cell-references xrow xcol))))) | 882 | (and x |
| 883 | (< (setq xrow (car x)) ses--numrows) | ||
| 884 | (< (setq xcol (cdr x)) ses--numcols) | ||
| 885 | (ses-set-cell xrow xcol 'references | ||
| 886 | (delq sym (ses-cell-references xrow xcol)))))) | ||
| 882 | ;;Add new ones. Skip ones left over from old list | 887 | ;;Add new ones. Skip ones left over from old list |
| 883 | (dolist (ref newref) | 888 | (dolist (ref newref) |
| 884 | (setq x (ses-sym-rowcol ref) | 889 | (setq x (ses-sym-rowcol ref)) |
| 885 | xrow (car x) | 890 | ;;Do not trust the user, the reference may be outside the spreadsheet |
| 886 | xcol (cdr x) | 891 | (if (and |
| 887 | x (ses-cell-references xrow xcol)) | 892 | x |
| 888 | (or (memq sym x) | 893 | (< (setq xrow (car x)) ses--numrows) |
| 889 | (ses-set-cell xrow xcol 'references (cons sym x)))) | 894 | (< (setq xcol (cdr x)) ses--numcols)) |
| 895 | (progn | ||
| 896 | (setq x (ses-cell-references xrow xcol)) | ||
| 897 | (or (memq sym x) | ||
| 898 | (ses-set-cell xrow xcol 'references (cons sym x)))) | ||
| 899 | (cl-pushnew ref not-a-cell-ref-list))) | ||
| 890 | (ses-formula-record formula) | 900 | (ses-formula-record formula) |
| 891 | (ses-set-cell row col 'formula formula)))) | 901 | (ses-set-cell row col 'formula formula) |
| 902 | (and not-a-cell-ref-list | ||
| 903 | (error "Found in formula cells not in spreadsheet: %S" not-a-cell-ref-list))))) | ||
| 892 | 904 | ||
| 893 | 905 | ||
| 894 | (defun ses-repair-cell-reference-all () | 906 | (defun ses-repair-cell-reference-all () |
| @@ -1529,7 +1541,13 @@ by (ROWINCR,COLINCR)." | |||
| 1529 | ;;Relocate this variable, unless it is a named cell | 1541 | ;;Relocate this variable, unless it is a named cell |
| 1530 | (if (eq (get sym 'ses-cell) :ses-named) | 1542 | (if (eq (get sym 'ses-cell) :ses-named) |
| 1531 | sym | 1543 | sym |
| 1532 | (ses-create-cell-symbol row col)) | 1544 | ;; otherwise, we create the relocated cell symbol because |
| 1545 | ;; ses-cell-symbol gives the old symbols, however since | ||
| 1546 | ;; renamed cell are not relocated we keep the relocated | ||
| 1547 | ;; cell old symbol in this case. | ||
| 1548 | (if (eq (get (setq sym (ses-cell-symbol row col)) 'ses-cell) :ses-named) | ||
| 1549 | sym | ||
| 1550 | (ses-create-cell-symbol row col))) | ||
| 1533 | ;;Delete reference to a deleted cell | 1551 | ;;Delete reference to a deleted cell |
| 1534 | nil)))) | 1552 | nil)))) |
| 1535 | 1553 | ||
| @@ -2337,7 +2355,8 @@ to are recalculated first." | |||
| 2337 | "Recalculate and reprint all cells." | 2355 | "Recalculate and reprint all cells." |
| 2338 | (interactive "*") | 2356 | (interactive "*") |
| 2339 | (let ((startcell (ses--cell-at-pos (point))) | 2357 | (let ((startcell (ses--cell-at-pos (point))) |
| 2340 | (ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows) | 2358 | (ses--curcell (cons (ses-cell-symbol 0 0) |
| 2359 | (ses-cell-symbol (1- ses--numrows) | ||
| 2341 | (1- ses--numcols))))) | 2360 | (1- ses--numcols))))) |
| 2342 | (ses-recalculate-cell ses--curcell) | 2361 | (ses-recalculate-cell ses--curcell) |
| 2343 | (ses-jump-safe startcell))) | 2362 | (ses-jump-safe startcell))) |
diff --git a/lisp/subr.el b/lisp/subr.el index ef00286b341..a9edff6166f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -121,6 +121,7 @@ BODY should be a list of Lisp expressions. | |||
| 121 | (defmacro setq-local (var val) | 121 | (defmacro setq-local (var val) |
| 122 | "Set variable VAR to value VAL in current buffer." | 122 | "Set variable VAR to value VAL in current buffer." |
| 123 | ;; Can't use backquote here, it's too early in the bootstrap. | 123 | ;; Can't use backquote here, it's too early in the bootstrap. |
| 124 | (declare (debug (symbolp form))) | ||
| 124 | (list 'set (list 'make-local-variable (list 'quote var)) val)) | 125 | (list 'set (list 'make-local-variable (list 'quote var)) val)) |
| 125 | 126 | ||
| 126 | (defmacro defvar-local (var val &optional docstring) | 127 | (defmacro defvar-local (var val &optional docstring) |
| @@ -4513,7 +4514,8 @@ EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'." | |||
| 4513 | (defun backtrace () | 4514 | (defun backtrace () |
| 4514 | "Print a trace of Lisp function calls currently active. | 4515 | "Print a trace of Lisp function calls currently active. |
| 4515 | Output stream used is value of `standard-output'." | 4516 | Output stream used is value of `standard-output'." |
| 4516 | (let ((print-level (or print-level 8))) | 4517 | (let ((print-level (or print-level 8)) |
| 4518 | (print-escape-control-characters t)) | ||
| 4517 | (mapbacktrace #'backtrace--print-frame 'backtrace))) | 4519 | (mapbacktrace #'backtrace--print-frame 'backtrace))) |
| 4518 | 4520 | ||
| 4519 | (defun backtrace-frames (&optional base) | 4521 | (defun backtrace-frames (&optional base) |
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index fda93884c40..be895a040da 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el | |||
| @@ -396,7 +396,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") | |||
| 396 | ;;; Fix interface to (X-specific) mouse.el | 396 | ;;; Fix interface to (X-specific) mouse.el |
| 397 | (defun w32--set-selection (type value) | 397 | (defun w32--set-selection (type value) |
| 398 | (if (eq type 'CLIPBOARD) | 398 | (if (eq type 'CLIPBOARD) |
| 399 | (w32-set-clipboard-data value) | 399 | (w32-set-clipboard-data (replace-regexp-in-string "\0" "\\0" value t t)) |
| 400 | (put 'x-selections (or type 'PRIMARY) value))) | 400 | (put 'x-selections (or type 'PRIMARY) value))) |
| 401 | 401 | ||
| 402 | (defun w32--get-selection (&optional type data-type) | 402 | (defun w32--get-selection (&optional type data-type) |
diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 367114b83f5..c011f1b01bc 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el | |||
| @@ -119,7 +119,8 @@ the value of `tooltip-y-offset' is ignored." | |||
| 119 | (defcustom tooltip-frame-parameters | 119 | (defcustom tooltip-frame-parameters |
| 120 | '((name . "tooltip") | 120 | '((name . "tooltip") |
| 121 | (internal-border-width . 2) | 121 | (internal-border-width . 2) |
| 122 | (border-width . 1)) | 122 | (border-width . 1) |
| 123 | (no-special-glyphs . t)) | ||
| 123 | "Frame parameters used for tooltips. | 124 | "Frame parameters used for tooltips. |
| 124 | 125 | ||
| 125 | If `left' or `top' parameters are included, they specify the absolute | 126 | If `left' or `top' parameters are included, they specify the absolute |
| @@ -130,7 +131,8 @@ of the `tooltip' face are used instead." | |||
| 130 | :type '(repeat (cons :format "%v" | 131 | :type '(repeat (cons :format "%v" |
| 131 | (symbol :tag "Parameter") | 132 | (symbol :tag "Parameter") |
| 132 | (sexp :tag "Value"))) | 133 | (sexp :tag "Value"))) |
| 133 | :group 'tooltip) | 134 | :group 'tooltip |
| 135 | :version "26.1") | ||
| 134 | 136 | ||
| 135 | (defface tooltip | 137 | (defface tooltip |
| 136 | '((((class color)) | 138 | '((((class color)) |
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el index 1fa085400d8..8657d19da8c 100644 --- a/lisp/url/url-history.el +++ b/lisp/url/url-history.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; url-history.el --- Global history tracking for URL package | 1 | ;;; url-history.el --- Global history tracking for URL package -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -106,7 +106,7 @@ to run the `url-history-setup-save-timer' function manually." | |||
| 106 | 106 | ||
| 107 | (defun url-history-update-url (url time) | 107 | (defun url-history-update-url (url time) |
| 108 | (setq url-history-changed-since-last-save t) | 108 | (setq url-history-changed-since-last-save t) |
| 109 | (puthash (if (vectorp url) (url-recreate-url url) url) time | 109 | (puthash (if (url-p url) (url-recreate-url url) url) time |
| 110 | url-history-hash-table)) | 110 | url-history-hash-table)) |
| 111 | 111 | ||
| 112 | (autoload 'url-make-private-file "url-util") | 112 | (autoload 'url-make-private-file "url-util") |
| @@ -157,6 +157,7 @@ user for what type to save as." | |||
| 157 | (gethash url url-history-hash-table nil)) | 157 | (gethash url url-history-hash-table nil)) |
| 158 | 158 | ||
| 159 | (defun url-completion-function (string predicate function) | 159 | (defun url-completion-function (string predicate function) |
| 160 | (declare (obsolete url-history-hash-table "26.1")) | ||
| 160 | ;; Completion function to complete urls from the history. | 161 | ;; Completion function to complete urls from the history. |
| 161 | ;; This is obsolete since we can now pass the hash-table directly as a | 162 | ;; This is obsolete since we can now pass the hash-table directly as a |
| 162 | ;; completion table. | 163 | ;; completion table. |
| @@ -164,7 +165,7 @@ user for what type to save as." | |||
| 164 | (cond | 165 | (cond |
| 165 | ((eq function nil) | 166 | ((eq function nil) |
| 166 | (let ((list nil)) | 167 | (let ((list nil)) |
| 167 | (maphash (lambda (key val) (push key list)) | 168 | (maphash (lambda (key _) (push key list)) |
| 168 | url-history-hash-table) | 169 | url-history-hash-table) |
| 169 | ;; Not sure why we bother reversing the list. --Stef | 170 | ;; Not sure why we bother reversing the list. --Stef |
| 170 | (try-completion string (nreverse list) predicate))) | 171 | (try-completion string (nreverse list) predicate))) |
| @@ -172,7 +173,7 @@ user for what type to save as." | |||
| 172 | (let ((stub (concat "\\`" (regexp-quote string))) | 173 | (let ((stub (concat "\\`" (regexp-quote string))) |
| 173 | (retval nil)) | 174 | (retval nil)) |
| 174 | (maphash | 175 | (maphash |
| 175 | (lambda (url time) | 176 | (lambda (url _) |
| 176 | (if (string-match stub url) (push url retval))) | 177 | (if (string-match stub url) (push url retval))) |
| 177 | url-history-hash-table) | 178 | url-history-hash-table) |
| 178 | retval)) | 179 | retval)) |
diff --git a/lisp/window.el b/lisp/window.el index 8b07ed462c9..c933996a72f 100644 --- a/lisp/window.el +++ b/lisp/window.el | |||
| @@ -3703,7 +3703,7 @@ are one more than the actual value of these edges. Note that if | |||
| 3703 | ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too." | 3703 | ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too." |
| 3704 | (let* ((window (window-normalize-window window body)) | 3704 | (let* ((window (window-normalize-window window body)) |
| 3705 | (frame (window-frame window)) | 3705 | (frame (window-frame window)) |
| 3706 | (border-width (frame-border-width frame)) | 3706 | (border-width (frame-internal-border-width frame)) |
| 3707 | (char-width (frame-char-width frame)) | 3707 | (char-width (frame-char-width frame)) |
| 3708 | (char-height (frame-char-height frame)) | 3708 | (char-height (frame-char-height frame)) |
| 3709 | (left (if pixelwise | 3709 | (left (if pixelwise |
| @@ -4572,12 +4572,13 @@ The function is called with one argument - a frame. | |||
| 4572 | Functions affected by this option are those that bury a buffer | 4572 | Functions affected by this option are those that bury a buffer |
| 4573 | shown in a separate frame like `quit-window' and `bury-buffer'." | 4573 | shown in a separate frame like `quit-window' and `bury-buffer'." |
| 4574 | :type '(choice (const :tag "Iconify" iconify-frame) | 4574 | :type '(choice (const :tag "Iconify" iconify-frame) |
| 4575 | (const :tag "Make invisible" make-frame-invisible) | ||
| 4575 | (const :tag "Delete" delete-frame) | 4576 | (const :tag "Delete" delete-frame) |
| 4576 | (const :tag "Do nothing" ignore) | 4577 | (const :tag "Do nothing" ignore) |
| 4577 | function) | 4578 | function) |
| 4578 | :group 'windows | 4579 | :group 'windows |
| 4579 | :group 'frames | 4580 | :group 'frames |
| 4580 | :version "24.1") | 4581 | :version "26.1") |
| 4581 | 4582 | ||
| 4582 | (defun window--delete (&optional window dedicated-only kill) | 4583 | (defun window--delete (&optional window dedicated-only kill) |
| 4583 | "Delete WINDOW if possible. | 4584 | "Delete WINDOW if possible. |
| @@ -4595,7 +4596,9 @@ if WINDOW gets deleted or its frame is auto-hidden." | |||
| 4595 | (cond | 4596 | (cond |
| 4596 | (kill | 4597 | (kill |
| 4597 | (delete-frame frame)) | 4598 | (delete-frame frame)) |
| 4598 | ((functionp frame-auto-hide-function) | 4599 | ((functionp (frame-parameter frame 'auto-hide-function)) |
| 4600 | (funcall (frame-parameter frame 'auto-hide-function))) | ||
| 4601 | ((functionp frame-auto-hide-function) | ||
| 4599 | (funcall frame-auto-hide-function frame)))) | 4602 | (funcall frame-auto-hide-function frame)))) |
| 4600 | 'frame) | 4603 | 'frame) |
| 4601 | (deletable | 4604 | (deletable |
| @@ -6734,15 +6737,17 @@ live." | |||
| 6734 | window)) | 6737 | window)) |
| 6735 | 6738 | ||
| 6736 | (defun window--maybe-raise-frame (frame) | 6739 | (defun window--maybe-raise-frame (frame) |
| 6737 | (let ((visible (frame-visible-p frame))) | 6740 | (make-frame-visible frame) |
| 6738 | (unless (or (not visible) | 6741 | (unless (or (frame-parameter frame 'no-focus-on-map) |
| 6739 | ;; Assume the selected frame is already visible enough. | 6742 | ;; Don't raise frames that should not get focus. |
| 6740 | (eq frame (selected-frame)) | 6743 | (frame-parameter frame 'no-accept-focus) |
| 6741 | ;; Assume the frame from which we invoked the | 6744 | ;; Assume the selected frame is already visible enough. |
| 6742 | ;; minibuffer is visible. | 6745 | (eq frame (selected-frame)) |
| 6743 | (and (minibuffer-window-active-p (selected-window)) | 6746 | ;; Assume the frame from which we invoked the |
| 6744 | (eq frame (window-frame (minibuffer-selected-window))))) | 6747 | ;; minibuffer is visible. |
| 6745 | (raise-frame frame)))) | 6748 | (and (minibuffer-window-active-p (selected-window)) |
| 6749 | (eq frame (window-frame (minibuffer-selected-window))))) | ||
| 6750 | (raise-frame frame))) | ||
| 6746 | 6751 | ||
| 6747 | ;; FIXME: Not implemented. | 6752 | ;; FIXME: Not implemented. |
| 6748 | ;; FIXME: By the way, there could be more levels of dedication: | 6753 | ;; FIXME: By the way, there could be more levels of dedication: |
| @@ -6762,6 +6767,7 @@ The actual non-nil value of this variable will be copied to the | |||
| 6762 | (const display-buffer-pop-up-window) | 6767 | (const display-buffer-pop-up-window) |
| 6763 | (const display-buffer-same-window) | 6768 | (const display-buffer-same-window) |
| 6764 | (const display-buffer-pop-up-frame) | 6769 | (const display-buffer-pop-up-frame) |
| 6770 | (const display-buffer-in-child-frame) | ||
| 6765 | (const display-buffer-below-selected) | 6771 | (const display-buffer-below-selected) |
| 6766 | (const display-buffer-at-bottom) | 6772 | (const display-buffer-at-bottom) |
| 6767 | (const display-buffer-in-previous-window) | 6773 | (const display-buffer-in-previous-window) |
| @@ -6908,6 +6914,7 @@ Available action functions include: | |||
| 6908 | `display-buffer-same-window' | 6914 | `display-buffer-same-window' |
| 6909 | `display-buffer-reuse-window' | 6915 | `display-buffer-reuse-window' |
| 6910 | `display-buffer-pop-up-frame' | 6916 | `display-buffer-pop-up-frame' |
| 6917 | `display-buffer-in-child-frame' | ||
| 6911 | `display-buffer-pop-up-window' | 6918 | `display-buffer-pop-up-window' |
| 6912 | `display-buffer-in-previous-window' | 6919 | `display-buffer-in-previous-window' |
| 6913 | `display-buffer-use-some-window' | 6920 | `display-buffer-use-some-window' |
| @@ -7239,6 +7246,7 @@ raising the frame." | |||
| 7239 | (get-largest-window frame t) alist) | 7246 | (get-largest-window frame t) alist) |
| 7240 | (window--try-to-split-window | 7247 | (window--try-to-split-window |
| 7241 | (get-lru-window frame t) alist)))) | 7248 | (get-lru-window frame t) alist)))) |
| 7249 | |||
| 7242 | (prog1 (window--display-buffer | 7250 | (prog1 (window--display-buffer |
| 7243 | buffer window 'window alist display-buffer-mark-dedicated) | 7251 | buffer window 'window alist display-buffer-mark-dedicated) |
| 7244 | (unless (cdr (assq 'inhibit-switch-frame alist)) | 7252 | (unless (cdr (assq 'inhibit-switch-frame alist)) |
| @@ -7258,6 +7266,47 @@ again with `display-buffer-pop-up-window'." | |||
| 7258 | (and pop-up-windows | 7266 | (and pop-up-windows |
| 7259 | (display-buffer-pop-up-window buffer alist)))) | 7267 | (display-buffer-pop-up-window buffer alist)))) |
| 7260 | 7268 | ||
| 7269 | (defun display-buffer-in-child-frame (buffer alist) | ||
| 7270 | "Display BUFFER in a child frame. | ||
| 7271 | By default, this either reuses a child frame of the selected | ||
| 7272 | frame or makes a new child frame of the selected frame. If | ||
| 7273 | successful, return the window used; otherwise return nil. | ||
| 7274 | |||
| 7275 | If ALIST has a non-nil 'child-frame-parameters' entry, the | ||
| 7276 | corresponding value is an alist of frame parameters to give the | ||
| 7277 | new frame. A 'parent-frame' parameter specifying the selected | ||
| 7278 | frame is provided by default. If the child frame should be or | ||
| 7279 | become the child of any other frame, a corresponding entry must | ||
| 7280 | be added to ALIST." | ||
| 7281 | (let* ((parameters | ||
| 7282 | (append | ||
| 7283 | (cdr (assq 'child-frame-parameters alist)) | ||
| 7284 | `((parent-frame . ,(selected-frame))))) | ||
| 7285 | (parent (or (assq 'parent-frame parameters) | ||
| 7286 | (selected-frame))) | ||
| 7287 | (share (assq 'share-child-frame parameters)) | ||
| 7288 | share1 frame window) | ||
| 7289 | (with-current-buffer buffer | ||
| 7290 | (when (frame-live-p parent) | ||
| 7291 | (catch 'frame | ||
| 7292 | (dolist (frame1 (frame-list)) | ||
| 7293 | (when (eq (frame-parent frame1) parent) | ||
| 7294 | (setq share1 (assq 'share-child-frame | ||
| 7295 | (frame-parameters frame1))) | ||
| 7296 | (when (eq share share1) | ||
| 7297 | (setq frame frame1) | ||
| 7298 | (throw 'frame t)))))) | ||
| 7299 | |||
| 7300 | (if frame | ||
| 7301 | (setq window (frame-selected-window frame)) | ||
| 7302 | (setq frame (make-frame parameters)) | ||
| 7303 | (setq window (frame-selected-window frame)))) | ||
| 7304 | |||
| 7305 | (prog1 (window--display-buffer | ||
| 7306 | buffer window 'frame alist display-buffer-mark-dedicated) | ||
| 7307 | (unless (cdr (assq 'inhibit-switch-frame alist)) | ||
| 7308 | (window--maybe-raise-frame frame))))) | ||
| 7309 | |||
| 7261 | (defun display-buffer-below-selected (buffer alist) | 7310 | (defun display-buffer-below-selected (buffer alist) |
| 7262 | "Try displaying BUFFER in a window below the selected window. | 7311 | "Try displaying BUFFER in a window below the selected window. |
| 7263 | If there is a window below the selected one and that window | 7312 | If there is a window below the selected one and that window |
| @@ -7272,7 +7321,8 @@ below the selected one, use that window." | |||
| 7272 | (and (not (frame-parameter nil 'unsplittable)) | 7321 | (and (not (frame-parameter nil 'unsplittable)) |
| 7273 | (let ((split-height-threshold 0) | 7322 | (let ((split-height-threshold 0) |
| 7274 | split-width-threshold) | 7323 | split-width-threshold) |
| 7275 | (setq window (window--try-to-split-window (selected-window) alist))) | 7324 | (setq window (window--try-to-split-window |
| 7325 | (selected-window) alist))) | ||
| 7276 | (window--display-buffer | 7326 | (window--display-buffer |
| 7277 | buffer window 'window alist display-buffer-mark-dedicated)) | 7327 | buffer window 'window alist display-buffer-mark-dedicated)) |
| 7278 | (and (setq window (window-in-direction 'below)) | 7328 | (and (setq window (window-in-direction 'below)) |
| @@ -7885,10 +7935,12 @@ See also `fit-frame-to-buffer-margins'." | |||
| 7885 | (declare-function x-display-pixel-height "xfns.c" (&optional terminal)) | 7935 | (declare-function x-display-pixel-height "xfns.c" (&optional terminal)) |
| 7886 | 7936 | ||
| 7887 | (defun window--sanitize-margin (margin left right) | 7937 | (defun window--sanitize-margin (margin left right) |
| 7888 | "Return MARGIN if it's a number between LEFT and RIGHT." | 7938 | "Return MARGIN if it's a number between LEFT and RIGHT. |
| 7889 | (when (and (numberp margin) | 7939 | Return 0 otherwise." |
| 7890 | (<= left (- right margin)) (<= margin right)) | 7940 | (if (and (numberp margin) |
| 7891 | margin)) | 7941 | (<= left (- right margin)) (<= margin right)) |
| 7942 | margin | ||
| 7943 | 0)) | ||
| 7892 | 7944 | ||
| 7893 | (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) | 7945 | (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) |
| 7894 | 7946 | ||
| @@ -7906,190 +7958,197 @@ horizontally only. | |||
| 7906 | 7958 | ||
| 7907 | The new position and size of FRAME can be additionally determined | 7959 | The new position and size of FRAME can be additionally determined |
| 7908 | by customizing the options `fit-frame-to-buffer-sizes' and | 7960 | by customizing the options `fit-frame-to-buffer-sizes' and |
| 7909 | `fit-frame-to-buffer-margins' or the corresponding parameters of | 7961 | `fit-frame-to-buffer-margins' or setting the corresponding |
| 7910 | FRAME." | 7962 | parameters of FRAME." |
| 7911 | (interactive) | 7963 | (interactive) |
| 7912 | (unless (and (fboundp 'x-display-pixel-height) | 7964 | (unless (fboundp 'display-monitor-attributes-list) |
| 7913 | ;; We need the respective sizes now. | ||
| 7914 | (fboundp 'display-monitor-attributes-list)) | ||
| 7915 | (user-error "Cannot resize frame in non-graphic Emacs")) | 7965 | (user-error "Cannot resize frame in non-graphic Emacs")) |
| 7916 | (setq frame (window-normalize-frame frame)) | 7966 | (setq frame (window-normalize-frame frame)) |
| 7917 | (when (window-live-p (frame-root-window frame)) | 7967 | (when (window-live-p (frame-root-window frame)) |
| 7918 | (with-selected-window (frame-root-window frame) | 7968 | (let* ((char-width (frame-char-width frame)) |
| 7919 | (let* ((char-width (frame-char-width)) | 7969 | (char-height (frame-char-height frame)) |
| 7920 | (char-height (frame-char-height)) | 7970 | ;; WINDOW is FRAME's root window. |
| 7921 | (monitor-attributes (car (display-monitor-attributes-list | 7971 | (window (frame-root-window frame)) |
| 7922 | (frame-parameter frame 'display)))) | 7972 | (parent (frame-parent frame)) |
| 7923 | (geometry (cdr (assq 'geometry monitor-attributes))) | 7973 | (monitor-attributes |
| 7924 | (display-width (- (nth 2 geometry) (nth 0 geometry))) | 7974 | (unless parent |
| 7925 | (display-height (- (nth 3 geometry) (nth 1 geometry))) | 7975 | (car (display-monitor-attributes-list |
| 7926 | (workarea (cdr (assq 'workarea monitor-attributes))) | 7976 | (frame-parameter frame 'display))))) |
| 7927 | ;; Handle margins. | 7977 | ;; FRAME'S parent or display sizes. Used in connection |
| 7928 | (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins) | 7978 | ;; with margins. |
| 7929 | fit-frame-to-buffer-margins)) | 7979 | (geometry |
| 7930 | (left-margin (if (nth 0 margins) | 7980 | (unless parent |
| 7931 | (or (window--sanitize-margin | 7981 | (cdr (assq 'geometry monitor-attributes)))) |
| 7932 | (nth 0 margins) 0 display-width) | 7982 | (parent-or-display-width |
| 7933 | 0) | 7983 | (if parent |
| 7934 | (nth 0 workarea))) | 7984 | (frame-native-width parent) |
| 7935 | (top-margin (if (nth 1 margins) | 7985 | (- (nth 2 geometry) (nth 0 geometry)))) |
| 7936 | (or (window--sanitize-margin | 7986 | (parent-or-display-height |
| 7937 | (nth 1 margins) 0 display-height) | 7987 | (if parent |
| 7938 | 0) | 7988 | (frame-native-height parent) |
| 7939 | (nth 1 workarea))) | 7989 | (- (nth 3 geometry) (nth 1 geometry)))) |
| 7940 | (workarea-width (nth 2 workarea)) | 7990 | ;; FRAME'S parent or workarea sizes. Used when no margins |
| 7941 | (right-margin (if (nth 2 margins) | 7991 | ;; are specified. |
| 7942 | (- display-width | 7992 | (parent-or-workarea |
| 7943 | (or (window--sanitize-margin | 7993 | (if parent |
| 7944 | (nth 2 margins) left-margin display-width) | 7994 | `(0 0 ,parent-or-display-width ,parent-or-display-height) |
| 7945 | 0)) | 7995 | (cdr (assq 'workarea monitor-attributes)))) |
| 7946 | (nth 2 workarea))) | 7996 | ;; The outer size of FRAME. Needed to calculate the |
| 7947 | (workarea-height (nth 3 workarea)) | 7997 | ;; margins around the root window's body that have to |
| 7948 | (bottom-margin (if (nth 3 margins) | 7998 | ;; remain untouched by fitting. |
| 7949 | (- display-height | 7999 | (outer-edges (frame-edges frame 'outer-edges)) |
| 7950 | (or (window--sanitize-margin | 8000 | (outer-width (if outer-edges |
| 7951 | (nth 3 margins) top-margin display-height) | 8001 | (- (nth 2 outer-edges) (nth 0 outer-edges)) |
| 7952 | 0)) | 8002 | ;; A poor guess. |
| 7953 | (nth 3 workarea))) | 8003 | (frame-pixel-width frame))) |
| 7954 | ;; The pixel width of FRAME (which does not include the | 8004 | (outer-height (if outer-edges |
| 7955 | ;; window manager's decorations). | 8005 | (- (nth 3 outer-edges) (nth 1 outer-edges)) |
| 7956 | (frame-width (frame-pixel-width)) | 8006 | ;; Another poor guess. |
| 7957 | ;; The pixel width of the body of FRAME's root window. | 8007 | (frame-pixel-height frame))) |
| 7958 | (window-body-width (window-body-width nil t)) | 8008 | ;; The text size of of FRAME. Needed to specify FRAME's |
| 7959 | ;; The difference in pixels between total and body width of | 8009 | ;; text size after the root window's body's new sizes have |
| 7960 | ;; FRAME's window. | 8010 | ;; been calculated. |
| 7961 | (window-extra-width (- (window-pixel-width) window-body-width)) | 8011 | (text-width (frame-text-width frame)) |
| 7962 | ;; The difference in pixels between the frame's pixel width | 8012 | (text-height (frame-text-height frame)) |
| 7963 | ;; and the window's body width. This is the space we can't | 8013 | ;; WINDOW's body size. |
| 7964 | ;; use for fitting. | 8014 | (body-width (window-body-width window t)) |
| 7965 | (extra-width (- frame-width window-body-width)) | 8015 | (body-height (window-body-height window t)) |
| 7966 | ;; The pixel position of FRAME's left border. We usually | 8016 | ;; The difference between FRAME's outer size and WINDOW's |
| 7967 | ;; try to leave this alone. | 8017 | ;; body size. |
| 7968 | (left | 8018 | (outer-minus-body-width (- outer-width body-width)) |
| 7969 | (let ((left (frame-parameter nil 'left))) | 8019 | (outer-minus-body-height (- outer-height body-height)) |
| 7970 | (if (consp left) | 8020 | ;; The difference between FRAME's text size and WINDOW's |
| 7971 | (funcall (car left) (cadr left)) | 8021 | ;; body size (these values "should" be positive). |
| 7972 | left))) | 8022 | (text-minus-body-width (- text-width body-width)) |
| 7973 | ;; The pixel height of FRAME (which does not include title | 8023 | (text-minus-body-height (- text-height body-height)) |
| 7974 | ;; line, decorations, and sometimes neither the menu nor | 8024 | ;; The current position of FRAME. |
| 7975 | ;; the toolbar). | 8025 | (position (frame-position frame)) |
| 7976 | (frame-height (frame-pixel-height)) | 8026 | (left (car position)) |
| 7977 | ;; The pixel height of FRAME's root window (we don't care | 8027 | (top (cdr position)) |
| 7978 | ;; about the window's body height since the return value of | 8028 | ;; The margins specified for FRAME. These represent pixel |
| 7979 | ;; `window-text-pixel-size' includes header and mode line). | 8029 | ;; offsets from the left, top, right and bottom edge of the |
| 7980 | (window-height (window-pixel-height)) | 8030 | ;; display or FRAME's parent's native rectangle and have to |
| 7981 | ;; The difference in pixels between the frame's pixel | 8031 | ;; take care of the display's taskbar and other obstacles. |
| 7982 | ;; height and the window's height. | 8032 | ;; If they are unspecified, constrain the resulting frame |
| 7983 | (extra-height (- frame-height window-height)) | 8033 | ;; to its workarea or the parent frame's native rectangle. |
| 7984 | ;; The pixel position of FRAME's top border. | 8034 | (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins) |
| 7985 | (top | 8035 | fit-frame-to-buffer-margins)) |
| 7986 | (let ((top (frame-parameter nil 'top))) | 8036 | ;; Convert margins intto pixel offsets from the left-top |
| 7987 | (if (consp top) | 8037 | ;; corner of FRAME's display or parent. |
| 7988 | (funcall (car top) (cadr top)) | 8038 | (left-margin (if (nth 0 margins) |
| 7989 | top))) | 8039 | (window--sanitize-margin |
| 7990 | ;; Sanitize minimum and maximum sizes. | 8040 | (nth 0 margins) 0 parent-or-display-width) |
| 7991 | (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes) | 8041 | (nth 0 parent-or-workarea))) |
| 7992 | fit-frame-to-buffer-sizes)) | 8042 | (top-margin (if (nth 1 margins) |
| 7993 | (max-height | 8043 | (window--sanitize-margin |
| 7994 | (cond | 8044 | (nth 1 margins) 0 parent-or-display-height) |
| 7995 | ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height)) | 8045 | (nth 1 parent-or-workarea))) |
| 7996 | ((numberp max-height) (* max-height char-height)) | 8046 | (right-margin (if (nth 2 margins) |
| 7997 | (t display-height))) | 8047 | (- parent-or-display-width |
| 7998 | (min-height | 8048 | (window--sanitize-margin |
| 7999 | (cond | 8049 | (nth 2 margins) left-margin |
| 8000 | ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height)) | 8050 | parent-or-display-width)) |
| 8001 | ((numberp min-height) (* min-height char-height)) | 8051 | (nth 2 parent-or-workarea))) |
| 8002 | (t (* window-min-height char-height)))) | 8052 | (bottom-margin (if (nth 3 margins) |
| 8003 | (max-width | 8053 | (- parent-or-display-height |
| 8004 | (cond | 8054 | (window--sanitize-margin |
| 8005 | ((numberp (nth 2 sizes)) | 8055 | (nth 3 margins) top-margin |
| 8006 | (- (* (nth 2 sizes) char-width) window-extra-width)) | 8056 | parent-or-display-height)) |
| 8007 | ((numberp max-width) | 8057 | (nth 3 parent-or-workarea))) |
| 8008 | (- (* max-width char-width) window-extra-width)) | 8058 | ;; Minimum and maximum sizes specified for FRAME. |
| 8009 | (t display-width))) | 8059 | (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes) |
| 8010 | (min-width | 8060 | fit-frame-to-buffer-sizes)) |
| 8011 | (cond | 8061 | ;; Calculate the minimum and maximum pixel sizes of FRAME |
| 8012 | ((numberp (nth 3 sizes)) | 8062 | ;; from the values provided by the MAX-HEIGHT, MIN-HEIGHT, |
| 8013 | (- (* (nth 3 sizes) char-width) window-extra-width)) | 8063 | ;; MAX-WIDTH and MIN-WIDTH arguments or, if these are nil, |
| 8014 | ((numberp min-width) | 8064 | ;; from those provided by `fit-frame-to-buffer-sizes'. |
| 8015 | (- (* min-width char-width) window-extra-width)) | 8065 | (max-height |
| 8016 | (t (* window-min-width char-width)))) | 8066 | (min |
| 8017 | ;; Note: Currently, for a new frame the sizes of the header | 8067 | (cond |
| 8018 | ;; and mode line may be estimated incorrectly | 8068 | ((numberp max-height) (* max-height char-height)) |
| 8019 | (value (window-text-pixel-size | 8069 | ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height)) |
| 8020 | nil t t workarea-width workarea-height t)) | 8070 | (t parent-or-display-height)) |
| 8021 | (width (+ (car value) (window-right-divider-width))) | 8071 | ;; The following is the maximum height that fits into the |
| 8022 | (height | 8072 | ;; top and bottom margins. |
| 8023 | (+ (cdr value) | 8073 | (max (- bottom-margin top-margin outer-minus-body-height)))) |
| 8024 | (window-bottom-divider-width) | 8074 | (min-height |
| 8025 | (window-scroll-bar-height)))) | 8075 | (cond |
| 8026 | ;; Don't change height or width when the window's size is fixed | 8076 | ((numberp min-height) (* min-height char-height)) |
| 8027 | ;; in either direction or ONLY forbids it. | 8077 | ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height)) |
| 8028 | (cond | 8078 | (t (window-min-size window nil nil t)))) |
| 8029 | ((or (eq window-size-fixed 'width) (eq only 'vertically)) | 8079 | (max-width |
| 8030 | (setq width nil)) | 8080 | (min |
| 8031 | ((or (eq window-size-fixed 'height) (eq only 'horizontally)) | 8081 | (cond |
| 8032 | (setq height nil))) | 8082 | ((numberp max-width) (* max-width char-width)) |
| 8033 | ;; Fit width to constraints. | 8083 | ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width)) |
| 8034 | (when width | 8084 | (t parent-or-display-width)) |
| 8035 | (unless frame-resize-pixelwise | 8085 | ;; The following is the maximum width that fits into the |
| 8036 | ;; Round to character sizes. | 8086 | ;; left and right margins. |
| 8037 | (setq width (* (/ (+ width char-width -1) char-width) | 8087 | (max (- right-margin left-margin outer-minus-body-width)))) |
| 8038 | char-width))) | 8088 | (min-width |
| 8039 | ;; Fit to maximum and minimum widths. | 8089 | (cond |
| 8040 | (setq width (max (min width max-width) min-width)) | 8090 | ((numberp min-width) (* min-width char-width)) |
| 8041 | ;; Add extra width. | 8091 | ((numberp (nth 3 sizes)) (nth 3 sizes)) |
| 8042 | (setq width (+ width extra-width)) | 8092 | (t (window-min-size window t nil t)))) |
| 8043 | ;; Preserve margins. | 8093 | ;; Note: Currently, for a new frame the sizes of the header |
| 8044 | (let ((right (+ left width))) | 8094 | ;; and mode line may be estimated incorrectly |
| 8045 | (cond | 8095 | (size |
| 8046 | ((> right right-margin) | 8096 | (window-text-pixel-size window t t max-width max-height)) |
| 8047 | ;; Move frame to left (we don't know its real width). | 8097 | (width (max (car size) min-width)) |
| 8048 | (setq left (max left-margin (- left (- right right-margin))))) | 8098 | (height (max (cdr size) min-height))) |
| 8049 | ((< left left-margin) | 8099 | ;; Don't change height or width when the window's size is fixed |
| 8050 | ;; Move frame to right. | 8100 | ;; in either direction or ONLY forbids it. |
| 8051 | (setq left left-margin))))) | 8101 | (cond |
| 8052 | ;; Fit height to constraints. | 8102 | ((or (eq window-size-fixed 'width) (eq only 'vertically)) |
| 8053 | (when height | 8103 | (setq width nil)) |
| 8054 | (unless frame-resize-pixelwise | 8104 | ((or (eq window-size-fixed 'height) (eq only 'horizontally)) |
| 8055 | (setq height (* (/ (+ height char-height -1) char-height) | 8105 | (setq height nil))) |
| 8056 | char-height))) | 8106 | ;; Fit width to constraints. |
| 8057 | ;; Fit to maximum and minimum heights. | 8107 | (when width |
| 8058 | (setq height (max (min height max-height) min-height)) | 8108 | (unless frame-resize-pixelwise |
| 8059 | ;; Add extra height. | 8109 | ;; Round to character sizes. |
| 8060 | (setq height (+ height extra-height)) | 8110 | (setq width (* (/ (+ width char-width -1) char-width) |
| 8061 | ;; Preserve margins. | 8111 | char-width))) |
| 8062 | (let ((bottom (+ top height))) | 8112 | ;; The new outer width (in pixels). |
| 8063 | (cond | 8113 | (setq outer-width (+ width outer-minus-body-width)) |
| 8064 | ((> bottom bottom-margin) | 8114 | ;; Maybe move FRAME to preserve margins. |
| 8065 | ;; Move frame up (we don't know its real height). | 8115 | (let ((right (+ left outer-width))) |
| 8066 | (setq top (max top-margin (- top (- bottom bottom-margin))))) | 8116 | (cond |
| 8067 | ((< top top-margin) | 8117 | ((> right right-margin) |
| 8068 | ;; Move frame down. | 8118 | ;; Move frame to left. |
| 8069 | (setq top top-margin))))) | 8119 | (setq left (max left-margin (- left (- right right-margin))))) |
| 8070 | ;; Apply changes. | 8120 | ((< left left-margin) |
| 8071 | (set-frame-position frame left top) | 8121 | ;; Move frame to right. |
| 8072 | ;; Clumsily try to translate our calculations to what | 8122 | (setq left left-margin))))) |
| 8073 | ;; `set-frame-size' wants. | 8123 | ;; Fit height to constraints. |
| 8074 | (when width | 8124 | (when height |
| 8075 | (setq width (- (+ (frame-text-width) width) | 8125 | (unless frame-resize-pixelwise |
| 8076 | extra-width window-body-width))) | 8126 | (setq height (* (/ (+ height char-height -1) char-height) |
| 8077 | (when height | 8127 | char-height))) |
| 8078 | (setq height (- (+ (frame-text-height) height) | 8128 | ;; The new outer height. |
| 8079 | extra-height window-height))) | 8129 | (setq outer-height (+ height outer-minus-body-height)) |
| 8080 | (set-frame-size | 8130 | ;; Preserve margins. |
| 8081 | frame | 8131 | (let ((bottom (+ top outer-height))) |
| 8082 | (if width | 8132 | (cond |
| 8083 | (if frame-resize-pixelwise | 8133 | ((> bottom bottom-margin) |
| 8084 | width | 8134 | ;; Move frame up. |
| 8085 | (/ width char-width)) | 8135 | (setq top (max top-margin (- top (- bottom bottom-margin))))) |
| 8086 | (frame-text-width)) | 8136 | ((< top top-margin) |
| 8087 | (if height | 8137 | ;; Move frame down. |
| 8088 | (if frame-resize-pixelwise | 8138 | (setq top top-margin))))) |
| 8089 | height | 8139 | ;; Apply our changes. |
| 8090 | (/ height char-height)) | 8140 | (setq text-width |
| 8091 | (frame-text-height)) | 8141 | (if width |
| 8092 | frame-resize-pixelwise))))) | 8142 | (+ width text-minus-body-width) |
| 8143 | (frame-text-width frame))) | ||
| 8144 | (setq text-height | ||
| 8145 | (if height | ||
| 8146 | (+ height text-minus-body-height) | ||
| 8147 | (frame-text-height frame))) | ||
| 8148 | (modify-frame-parameters | ||
| 8149 | frame `((left . ,left) (top . ,top) | ||
| 8150 | (width . (text-pixels . ,text-width)) | ||
| 8151 | (height . (text-pixels . ,text-height))))))) | ||
| 8093 | 8152 | ||
| 8094 | (defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size) | 8153 | (defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size) |
| 8095 | "Adjust size of WINDOW to display its buffer's contents exactly. | 8154 | "Adjust size of WINDOW to display its buffer's contents exactly. |
| @@ -8286,6 +8345,168 @@ Return non-nil if the window was shrunk, nil otherwise." | |||
| 8286 | (when (and (window-combined-p window) | 8345 | (when (and (window-combined-p window) |
| 8287 | (pos-visible-in-window-p (point-min) window)) | 8346 | (pos-visible-in-window-p (point-min) window)) |
| 8288 | (fit-window-to-buffer window (window-total-height window)))) | 8347 | (fit-window-to-buffer window (window-total-height window)))) |
| 8348 | |||
| 8349 | (defun window-largest-empty-rectangle--maximums-1 (quad maximums) | ||
| 8350 | "Support function for `window-largest-empty-rectangle'." | ||
| 8351 | (cond | ||
| 8352 | ((null maximums) | ||
| 8353 | (list quad)) | ||
| 8354 | ((> (car quad) (caar maximums)) | ||
| 8355 | (cons quad maximums)) | ||
| 8356 | (t | ||
| 8357 | (cons (car maximums) | ||
| 8358 | (window-largest-empty-rectangle--maximums-1 quad (cdr maximums)))))) | ||
| 8359 | |||
| 8360 | (defun window-largest-empty-rectangle--maximums (quad maximums count) | ||
| 8361 | "Support function for `window-largest-empty-rectangle'." | ||
| 8362 | (setq maximums (window-largest-empty-rectangle--maximums-1 quad maximums)) | ||
| 8363 | (if (> (length maximums) count) | ||
| 8364 | (nbutlast maximums) | ||
| 8365 | maximums)) | ||
| 8366 | |||
| 8367 | (defun window-largest-empty-rectangle--disjoint-maximums (maximums count) | ||
| 8368 | "Support function for `window-largest-empty-rectangle'." | ||
| 8369 | (setq maximums (sort maximums (lambda (x y) (> (car x) (car y))))) | ||
| 8370 | (let ((new-length 0) | ||
| 8371 | new-maximums) | ||
| 8372 | (while (and maximums (< new-length count)) | ||
| 8373 | (let* ((maximum (car maximums)) | ||
| 8374 | (at (nth 2 maximum)) | ||
| 8375 | (to (nth 3 maximum))) | ||
| 8376 | (catch 'drop | ||
| 8377 | (dolist (new-maximum new-maximums) | ||
| 8378 | (let ((new-at (nth 2 new-maximum)) | ||
| 8379 | (new-to (nth 3 new-maximum))) | ||
| 8380 | (when (if (< at new-at) (> to new-at) (< at new-to)) | ||
| 8381 | ;; Intersection -> drop. | ||
| 8382 | (throw 'drop nil)))) | ||
| 8383 | (setq new-maximums (cons maximum new-maximums)) | ||
| 8384 | (setq new-length (1+ new-length))) | ||
| 8385 | (setq maximums (cdr maximums)))) | ||
| 8386 | |||
| 8387 | (nreverse new-maximums))) | ||
| 8388 | |||
| 8389 | (defun window-largest-empty-rectangle (&optional window count min-width min-height positions left) | ||
| 8390 | "Return dimensions of largest empty rectangle in WINDOW. | ||
| 8391 | WINDOW must be a live window and defaults to the selected one. | ||
| 8392 | |||
| 8393 | The return value is a triple of the width and the start and end | ||
| 8394 | Y-coordinates of the largest rectangle that can be inscribed into | ||
| 8395 | the empty space (the space not displaying any text) of WINDOW's | ||
| 8396 | text area. The return value is nil if the current glyph matrix | ||
| 8397 | of WINDOW is not up-to-date. | ||
| 8398 | |||
| 8399 | Optional argument COUNT, if non-nil, specifies the maximum number | ||
| 8400 | of rectangles to return. This means that the return value is a | ||
| 8401 | list of triples specifying rectangles with the largest rectangle | ||
| 8402 | first. COUNT can be also a cons cell whose car specifies the | ||
| 8403 | number of rectangles to return and whose cdr, if non-nil, states | ||
| 8404 | that all rectangles returned must be disjoint. | ||
| 8405 | |||
| 8406 | Note that the right edge of any rectangle returned by this | ||
| 8407 | function is the right edge of WINDOW (the left edge if its buffer | ||
| 8408 | displays RTL text). | ||
| 8409 | |||
| 8410 | Optional arguments MIN-WIDTH and MIN-HEIGHT, if non-nil, specify | ||
| 8411 | the minimum width and height of any rectangle returned. | ||
| 8412 | |||
| 8413 | Optional argument POSITIONS, if non-nil, is a cons cell whose car | ||
| 8414 | specifies the uppermost and whose cdr specifies the lowermost | ||
| 8415 | pixel position that must be covered by any rectangle returned. | ||
| 8416 | Note that positions are counted from the start of the text area | ||
| 8417 | of WINDOW. | ||
| 8418 | |||
| 8419 | Optional argument LEFT, if non-nil, means to return values suitable for | ||
| 8420 | buffers displaying right to left text." | ||
| 8421 | ;; Process lines as returned by ‘window-lines-pixel-dimensions’. | ||
| 8422 | ;; STACK is a stack that contains rows that have to be processed yet. | ||
| 8423 | (let* ((window (window-normalize-window window t)) | ||
| 8424 | (disjoint (and (consp count) (cdr count))) | ||
| 8425 | (count (or (and (numberp count) count) | ||
| 8426 | (and (consp count) (numberp (car count)) (car count)))) | ||
| 8427 | (rows (window-lines-pixel-dimensions window nil nil t t left)) | ||
| 8428 | (rows-at 0) | ||
| 8429 | (max-size 0) | ||
| 8430 | row stack stack-at stack-to | ||
| 8431 | top top-width top-at top-to top-size | ||
| 8432 | max-width max-at max-to maximums) | ||
| 8433 | ;; ROWS-AT is the position where the first element of ROWS starts. | ||
| 8434 | ;; STACK-AT is the position where the first element of STACK starts. | ||
| 8435 | (while rows | ||
| 8436 | (setq row (car rows)) | ||
| 8437 | (if (or (not stack) (>= (car row) (caar stack))) | ||
| 8438 | (progn | ||
| 8439 | (unless stack | ||
| 8440 | (setq stack-at rows-at)) | ||
| 8441 | (setq stack (cons row stack)) | ||
| 8442 | ;; Set ROWS-AT to where the first element of ROWS ends | ||
| 8443 | ;; which, after popping ROW, makes it the start position of | ||
| 8444 | ;; the next ROW. | ||
| 8445 | (setq rows-at (cdr row)) | ||
| 8446 | (setq rows (cdr rows))) | ||
| 8447 | (setq top (car stack)) | ||
| 8448 | (setq stack (cdr stack)) | ||
| 8449 | (setq top-width (car top)) | ||
| 8450 | (setq top-at (if stack (cdar stack) stack-at)) | ||
| 8451 | (setq top-to (cdr top)) | ||
| 8452 | (setq top-size (* top-width (- top-to top-at))) | ||
| 8453 | (unless (or (and min-width (< top-width min-width)) | ||
| 8454 | (and min-height (< (- top-to top-at) min-height)) | ||
| 8455 | (and positions | ||
| 8456 | (or (> top-at (car positions)) | ||
| 8457 | (< top-to (cdr positions))))) | ||
| 8458 | (if count | ||
| 8459 | (if disjoint | ||
| 8460 | (setq maximums (cons (list top-size top-width top-at top-to) | ||
| 8461 | maximums)) | ||
| 8462 | (setq maximums (window-largest-empty-rectangle--maximums | ||
| 8463 | (list top-size top-width top-at top-to) | ||
| 8464 | maximums count))) | ||
| 8465 | (when (> top-size max-size) | ||
| 8466 | (setq max-size top-size) | ||
| 8467 | (setq max-width top-width) | ||
| 8468 | (setq max-at top-at) | ||
| 8469 | (setq max-to top-to)))) | ||
| 8470 | (if (and stack (> (caar stack) (car row))) | ||
| 8471 | ;; Have new top element of stack include old top. | ||
| 8472 | (setq stack (cons (cons (caar stack) (cdr top)) (cdr stack))) | ||
| 8473 | ;; Move rows-at backwards to top-at. | ||
| 8474 | (setq rows-at top-at)))) | ||
| 8475 | |||
| 8476 | (when stack | ||
| 8477 | ;; STACK-TO is the position where the stack ends. | ||
| 8478 | (setq stack-to (cdar stack)) | ||
| 8479 | (while stack | ||
| 8480 | (setq top (car stack)) | ||
| 8481 | (setq stack (cdr stack)) | ||
| 8482 | (setq top-width (car top)) | ||
| 8483 | (setq top-at (if stack (cdar stack) stack-at)) | ||
| 8484 | (setq top-size (* top-width (- stack-to top-at))) | ||
| 8485 | (unless (or (and min-width (< top-width min-width)) | ||
| 8486 | (and min-height (< (- stack-to top-at) min-height)) | ||
| 8487 | (and positions | ||
| 8488 | (or (> top-at (car positions)) | ||
| 8489 | (< stack-to (cdr positions))))) | ||
| 8490 | (if count | ||
| 8491 | (if disjoint | ||
| 8492 | (setq maximums (cons (list top-size top-width top-at stack-to) | ||
| 8493 | maximums)) | ||
| 8494 | (setq maximums (window-largest-empty-rectangle--maximums | ||
| 8495 | (list top-size top-width top-at stack-to) | ||
| 8496 | maximums count))) | ||
| 8497 | (when (> top-size max-size) | ||
| 8498 | (setq max-size top-size) | ||
| 8499 | (setq max-width top-width) | ||
| 8500 | (setq max-at top-at) | ||
| 8501 | (setq max-to stack-to)))))) | ||
| 8502 | |||
| 8503 | (cond | ||
| 8504 | (maximums | ||
| 8505 | (if disjoint | ||
| 8506 | (window-largest-empty-rectangle--disjoint-maximums maximums count) | ||
| 8507 | maximums)) | ||
| 8508 | ((> max-size 0) | ||
| 8509 | (list max-width max-at max-to))))) | ||
| 8289 | 8510 | ||
| 8290 | (defun kill-buffer-and-window () | 8511 | (defun kill-buffer-and-window () |
| 8291 | "Kill the current buffer and delete the selected window." | 8512 | "Kill the current buffer and delete the selected window." |
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 1ac58e871cc..107645df4fd 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 | |||
| @@ -158,6 +158,7 @@ AC_DEFUN([gl_EARLY], | |||
| 158 | # Code from module timespec-sub: | 158 | # Code from module timespec-sub: |
| 159 | # Code from module u64: | 159 | # Code from module u64: |
| 160 | # Code from module unistd: | 160 | # Code from module unistd: |
| 161 | # Code from module unlocked-io: | ||
| 161 | # Code from module update-copyright: | 162 | # Code from module update-copyright: |
| 162 | # Code from module utimens: | 163 | # Code from module utimens: |
| 163 | # Code from module vararrays: | 164 | # Code from module vararrays: |
| @@ -399,6 +400,7 @@ AC_DEFUN([gl_INIT], | |||
| 399 | gl_TIMER_TIME | 400 | gl_TIMER_TIME |
| 400 | gl_TIMESPEC | 401 | gl_TIMESPEC |
| 401 | gl_UNISTD_H | 402 | gl_UNISTD_H |
| 403 | gl_FUNC_GLIBC_UNLOCKED_IO | ||
| 402 | gl_UTIMENS | 404 | gl_UTIMENS |
| 403 | AC_C_VARARRAYS | 405 | AC_C_VARARRAYS |
| 404 | gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false | 406 | gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false |
| @@ -940,6 +942,7 @@ AC_DEFUN([gl_FILE_LIST], [ | |||
| 940 | lib/u64.h | 942 | lib/u64.h |
| 941 | lib/unistd.c | 943 | lib/unistd.c |
| 942 | lib/unistd.in.h | 944 | lib/unistd.in.h |
| 945 | lib/unlocked-io.h | ||
| 943 | lib/utimens.c | 946 | lib/utimens.c |
| 944 | lib/utimens.h | 947 | lib/utimens.h |
| 945 | lib/verify.h | 948 | lib/verify.h |
| @@ -1044,6 +1047,7 @@ AC_DEFUN([gl_FILE_LIST], [ | |||
| 1044 | m4/timespec.m4 | 1047 | m4/timespec.m4 |
| 1045 | m4/tm_gmtoff.m4 | 1048 | m4/tm_gmtoff.m4 |
| 1046 | m4/unistd_h.m4 | 1049 | m4/unistd_h.m4 |
| 1050 | m4/unlocked-io.m4 | ||
| 1047 | m4/utimens.m4 | 1051 | m4/utimens.m4 |
| 1048 | m4/utimes.m4 | 1052 | m4/utimes.m4 |
| 1049 | m4/vararrays.m4 | 1053 | m4/vararrays.m4 |
diff --git a/m4/unlocked-io.m4 b/m4/unlocked-io.m4 new file mode 100644 index 00000000000..448ccac2f0e --- /dev/null +++ b/m4/unlocked-io.m4 | |||
| @@ -0,0 +1,41 @@ | |||
| 1 | # unlocked-io.m4 serial 15 | ||
| 2 | |||
| 3 | # Copyright (C) 1998-2006, 2009-2017 Free Software Foundation, Inc. | ||
| 4 | # | ||
| 5 | # This file is free software; the Free Software Foundation | ||
| 6 | # gives unlimited permission to copy and/or distribute it, | ||
| 7 | # with or without modifications, as long as this notice is preserved. | ||
| 8 | |||
| 9 | dnl From Jim Meyering. | ||
| 10 | dnl | ||
| 11 | dnl See if the glibc *_unlocked I/O macros or functions are available. | ||
| 12 | dnl Use only those *_unlocked macros or functions that are declared | ||
| 13 | dnl (because some of them were declared in Solaris 2.5.1 but were removed | ||
| 14 | dnl in Solaris 2.6, whereas we want binaries built on Solaris 2.5.1 to run | ||
| 15 | dnl on Solaris 2.6). | ||
| 16 | |||
| 17 | AC_DEFUN([gl_FUNC_GLIBC_UNLOCKED_IO], | ||
| 18 | [ | ||
| 19 | AC_DEFINE([USE_UNLOCKED_IO], [1], | ||
| 20 | [Define to 1 if you want getc etc. to use unlocked I/O if available. | ||
| 21 | Unlocked I/O can improve performance in unithreaded apps, | ||
| 22 | but it is not safe for multithreaded apps.]) | ||
| 23 | |||
| 24 | dnl Persuade glibc and Solaris <stdio.h> to declare | ||
| 25 | dnl fgets_unlocked(), fputs_unlocked() etc. | ||
| 26 | AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) | ||
| 27 | |||
| 28 | AC_CHECK_DECLS_ONCE([clearerr_unlocked]) | ||
| 29 | AC_CHECK_DECLS_ONCE([feof_unlocked]) | ||
| 30 | AC_CHECK_DECLS_ONCE([ferror_unlocked]) | ||
| 31 | AC_CHECK_DECLS_ONCE([fflush_unlocked]) | ||
| 32 | AC_CHECK_DECLS_ONCE([fgets_unlocked]) | ||
| 33 | AC_CHECK_DECLS_ONCE([fputc_unlocked]) | ||
| 34 | AC_CHECK_DECLS_ONCE([fputs_unlocked]) | ||
| 35 | AC_CHECK_DECLS_ONCE([fread_unlocked]) | ||
| 36 | AC_CHECK_DECLS_ONCE([fwrite_unlocked]) | ||
| 37 | AC_CHECK_DECLS_ONCE([getc_unlocked]) | ||
| 38 | AC_CHECK_DECLS_ONCE([getchar_unlocked]) | ||
| 39 | AC_CHECK_DECLS_ONCE([putc_unlocked]) | ||
| 40 | AC_CHECK_DECLS_ONCE([putchar_unlocked]) | ||
| 41 | ]) | ||
diff --git a/src/charset.c b/src/charset.c index 9d15375dd79..d0840f7d2a9 100644 --- a/src/charset.c +++ b/src/charset.c | |||
| @@ -29,7 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 29 | #include <config.h> | 29 | #include <config.h> |
| 30 | 30 | ||
| 31 | #include <errno.h> | 31 | #include <errno.h> |
| 32 | #include <stdio.h> | ||
| 33 | #include <stdlib.h> | 32 | #include <stdlib.h> |
| 34 | #include <unistd.h> | 33 | #include <unistd.h> |
| 35 | #include <limits.h> | 34 | #include <limits.h> |
| @@ -40,6 +39,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 40 | #include "charset.h" | 39 | #include "charset.h" |
| 41 | #include "coding.h" | 40 | #include "coding.h" |
| 42 | #include "buffer.h" | 41 | #include "buffer.h" |
| 42 | #include "sysstdio.h" | ||
| 43 | 43 | ||
| 44 | /*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) *** | 44 | /*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) *** |
| 45 | 45 | ||
| @@ -198,10 +198,6 @@ static struct | |||
| 198 | 198 | ||
| 199 | #define GET_TEMP_CHARSET_WORK_DECODER(CODE) \ | 199 | #define GET_TEMP_CHARSET_WORK_DECODER(CODE) \ |
| 200 | (temp_charset_work->table.decoder[(CODE)]) | 200 | (temp_charset_work->table.decoder[(CODE)]) |
| 201 | |||
| 202 | #ifndef HAVE_GETC_UNLOCKED | ||
| 203 | #define getc_unlocked getc | ||
| 204 | #endif | ||
| 205 | 201 | ||
| 206 | 202 | ||
| 207 | /* Set to 1 to warn that a charset map is loaded and thus a buffer | 203 | /* Set to 1 to warn that a charset map is loaded and thus a buffer |
| @@ -19,10 +19,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 19 | 19 | ||
| 20 | 20 | ||
| 21 | #include <config.h> | 21 | #include <config.h> |
| 22 | #include <stdio.h> | ||
| 23 | 22 | ||
| 24 | #include "lisp.h" | 23 | #include "lisp.h" |
| 25 | #include "cm.h" | 24 | #include "cm.h" |
| 25 | #include "sysstdio.h" | ||
| 26 | #include "termchar.h" | 26 | #include "termchar.h" |
| 27 | #include "tparam.h" | 27 | #include "tparam.h" |
| 28 | 28 | ||
| @@ -45,8 +45,8 @@ int | |||
| 45 | cmputc (int c) | 45 | cmputc (int c) |
| 46 | { | 46 | { |
| 47 | if (current_tty->termscript) | 47 | if (current_tty->termscript) |
| 48 | putc (c & 0177, current_tty->termscript); | 48 | putc_unlocked (c & 0177, current_tty->termscript); |
| 49 | putc (c & 0177, current_tty->output); | 49 | putc_unlocked (c & 0177, current_tty->output); |
| 50 | return c; | 50 | return c; |
| 51 | } | 51 | } |
| 52 | 52 | ||
| @@ -117,11 +117,11 @@ cmcheckmagic (struct tty_display_info *tty) | |||
| 117 | if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1) | 117 | if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1) |
| 118 | emacs_abort (); | 118 | emacs_abort (); |
| 119 | if (tty->termscript) | 119 | if (tty->termscript) |
| 120 | putc ('\r', tty->termscript); | 120 | putc_unlocked ('\r', tty->termscript); |
| 121 | putc ('\r', tty->output); | 121 | putc_unlocked ('\r', tty->output); |
| 122 | if (tty->termscript) | 122 | if (tty->termscript) |
| 123 | putc ('\n', tty->termscript); | 123 | putc_unlocked ('\n', tty->termscript); |
| 124 | putc ('\n', tty->output); | 124 | putc_unlocked ('\n', tty->output); |
| 125 | curX (tty) = 0; | 125 | curX (tty) = 0; |
| 126 | curY (tty)++; | 126 | curY (tty)++; |
| 127 | } | 127 | } |
diff --git a/src/dispextern.h b/src/dispextern.h index d1e4715c329..8644ce26d13 100644 --- a/src/dispextern.h +++ b/src/dispextern.h | |||
| @@ -1106,7 +1106,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); | |||
| 1106 | #define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \ | 1106 | #define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \ |
| 1107 | ((MATRIX)->rows \ | 1107 | ((MATRIX)->rows \ |
| 1108 | + (MATRIX)->nrows \ | 1108 | + (MATRIX)->nrows \ |
| 1109 | - (WINDOW_WANTS_MODELINE_P ((W)) ? 1 : 0)) | 1109 | - (window_wants_mode_line ((W)) ? 1 : 0)) |
| 1110 | 1110 | ||
| 1111 | /* Non-zero if the face of the last glyph in ROW's text area has | 1111 | /* Non-zero if the face of the last glyph in ROW's text area has |
| 1112 | to be drawn to the end of the text area. */ | 1112 | to be drawn to the end of the text area. */ |
| @@ -1469,40 +1469,6 @@ struct glyph_string | |||
| 1469 | #define DESIRED_HEADER_LINE_HEIGHT(W) \ | 1469 | #define DESIRED_HEADER_LINE_HEIGHT(W) \ |
| 1470 | MATRIX_HEADER_LINE_HEIGHT ((W)->desired_matrix) | 1470 | MATRIX_HEADER_LINE_HEIGHT ((W)->desired_matrix) |
| 1471 | 1471 | ||
| 1472 | /* PXW: The height checks below serve to show at least one text line | ||
| 1473 | instead of a mode- and/or header line when a window gets very small. | ||
| 1474 | But (1) the check fails when the mode- or header-line is taller than | ||
| 1475 | the associated frame's line height and (2) we don't care much about | ||
| 1476 | text visibility anyway when shrinking a frame containing a toolbar. | ||
| 1477 | |||
| 1478 | So maybe these checks should be removed and any clipping left to the | ||
| 1479 | window manager. */ | ||
| 1480 | |||
| 1481 | /* Value is true if window W wants a mode line and is large enough | ||
| 1482 | to accommodate it. */ | ||
| 1483 | #define WINDOW_WANTS_MODELINE_P(W) \ | ||
| 1484 | (BUFFERP ((W)->contents) \ | ||
| 1485 | ? (!MINI_WINDOW_P (W) \ | ||
| 1486 | && !(W)->pseudo_window_p \ | ||
| 1487 | && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \ | ||
| 1488 | && !NILP (BVAR (XBUFFER ((W)->contents), mode_line_format)) \ | ||
| 1489 | && WINDOW_PIXEL_HEIGHT (W) > WINDOW_FRAME_LINE_HEIGHT (W)) \ | ||
| 1490 | : false) | ||
| 1491 | |||
| 1492 | /* Value is true if window W wants a header line and is large enough | ||
| 1493 | to accommodate it. */ | ||
| 1494 | #define WINDOW_WANTS_HEADER_LINE_P(W) \ | ||
| 1495 | (BUFFERP ((W)->contents) \ | ||
| 1496 | ? (!MINI_WINDOW_P (W) \ | ||
| 1497 | && !(W)->pseudo_window_p \ | ||
| 1498 | && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \ | ||
| 1499 | && !NILP (BVAR (XBUFFER ((W)->contents), header_line_format)) \ | ||
| 1500 | && (WINDOW_PIXEL_HEIGHT (W) \ | ||
| 1501 | > (WINDOW_WANTS_MODELINE_P (W) \ | ||
| 1502 | ? (2 * WINDOW_FRAME_LINE_HEIGHT (W)) \ | ||
| 1503 | : WINDOW_FRAME_LINE_HEIGHT (W)))) \ | ||
| 1504 | : false) | ||
| 1505 | |||
| 1506 | /* Return proper value to be used as baseline offset of font that has | 1472 | /* Return proper value to be used as baseline offset of font that has |
| 1507 | ASCENT and DESCENT to draw characters by the font at the vertical | 1473 | ASCENT and DESCENT to draw characters by the font at the vertical |
| 1508 | center of the line of frame F. | 1474 | center of the line of frame F. |
diff --git a/src/dispnew.c b/src/dispnew.c index 27c69bde831..93ef6a55a2e 100644 --- a/src/dispnew.c +++ b/src/dispnew.c | |||
| @@ -377,7 +377,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y | |||
| 377 | { | 377 | { |
| 378 | window_box (w, ANY_AREA, 0, 0, &window_width, &window_height); | 378 | window_box (w, ANY_AREA, 0, 0, &window_width, &window_height); |
| 379 | 379 | ||
| 380 | header_line_p = WINDOW_WANTS_HEADER_LINE_P (w); | 380 | header_line_p = window_wants_header_line (w); |
| 381 | header_line_changed_p = header_line_p != matrix->header_line_p; | 381 | header_line_changed_p = header_line_p != matrix->header_line_p; |
| 382 | } | 382 | } |
| 383 | matrix->header_line_p = header_line_p; | 383 | matrix->header_line_p = header_line_p; |
| @@ -446,7 +446,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y | |||
| 446 | 446 | ||
| 447 | if (w == NULL | 447 | if (w == NULL |
| 448 | || (row == matrix->rows + dim.height - 1 | 448 | || (row == matrix->rows + dim.height - 1 |
| 449 | && WINDOW_WANTS_MODELINE_P (w)) | 449 | && window_wants_mode_line (w)) |
| 450 | || (row == matrix->rows && matrix->header_line_p)) | 450 | || (row == matrix->rows && matrix->header_line_p)) |
| 451 | { | 451 | { |
| 452 | row->glyphs[TEXT_AREA] | 452 | row->glyphs[TEXT_AREA] |
| @@ -491,7 +491,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y | |||
| 491 | 491 | ||
| 492 | /* The mode line, if displayed, never has marginal areas. */ | 492 | /* The mode line, if displayed, never has marginal areas. */ |
| 493 | if ((row == matrix->rows + dim.height - 1 | 493 | if ((row == matrix->rows + dim.height - 1 |
| 494 | && !(w && WINDOW_WANTS_MODELINE_P (w))) | 494 | && !(w && window_wants_mode_line (w))) |
| 495 | || (row == matrix->rows && matrix->header_line_p)) | 495 | || (row == matrix->rows && matrix->header_line_p)) |
| 496 | { | 496 | { |
| 497 | row->glyphs[TEXT_AREA] | 497 | row->glyphs[TEXT_AREA] |
| @@ -570,7 +570,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y | |||
| 570 | the mode line, if any, since otherwise it will remain | 570 | the mode line, if any, since otherwise it will remain |
| 571 | disabled in the current matrix, and expose events won't | 571 | disabled in the current matrix, and expose events won't |
| 572 | redraw it. */ | 572 | redraw it. */ |
| 573 | if (WINDOW_WANTS_MODELINE_P (w)) | 573 | if (window_wants_mode_line (w)) |
| 574 | w->update_mode_line = 1; | 574 | w->update_mode_line = 1; |
| 575 | } | 575 | } |
| 576 | else if (matrix == w->desired_matrix) | 576 | else if (matrix == w->desired_matrix) |
| @@ -3126,9 +3126,9 @@ update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p) | |||
| 3126 | if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) | 3126 | if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) |
| 3127 | { | 3127 | { |
| 3128 | if (FRAME_TTY (f)->termscript) | 3128 | if (FRAME_TTY (f)->termscript) |
| 3129 | fflush (FRAME_TTY (f)->termscript); | 3129 | fflush_unlocked (FRAME_TTY (f)->termscript); |
| 3130 | if (FRAME_TERMCAP_P (f)) | 3130 | if (FRAME_TERMCAP_P (f)) |
| 3131 | fflush (FRAME_TTY (f)->output); | 3131 | fflush_unlocked (FRAME_TTY (f)->output); |
| 3132 | } | 3132 | } |
| 3133 | 3133 | ||
| 3134 | /* Check window matrices for lost pointers. */ | 3134 | /* Check window matrices for lost pointers. */ |
| @@ -3181,8 +3181,8 @@ update_frame_with_menu (struct frame *f, int row, int col) | |||
| 3181 | update_end (f); | 3181 | update_end (f); |
| 3182 | 3182 | ||
| 3183 | if (FRAME_TTY (f)->termscript) | 3183 | if (FRAME_TTY (f)->termscript) |
| 3184 | fflush (FRAME_TTY (f)->termscript); | 3184 | fflush_unlocked (FRAME_TTY (f)->termscript); |
| 3185 | fflush (FRAME_TTY (f)->output); | 3185 | fflush_unlocked (FRAME_TTY (f)->output); |
| 3186 | /* Check window matrices for lost pointers. */ | 3186 | /* Check window matrices for lost pointers. */ |
| 3187 | #if GLYPH_DEBUG | 3187 | #if GLYPH_DEBUG |
| 3188 | #if 0 | 3188 | #if 0 |
| @@ -4531,7 +4531,7 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p, | |||
| 4531 | ptrdiff_t outq = __fpending (display_output); | 4531 | ptrdiff_t outq = __fpending (display_output); |
| 4532 | if (outq > 900 | 4532 | if (outq > 900 |
| 4533 | || (outq > 20 && ((i - 1) % preempt_count == 0))) | 4533 | || (outq > 20 && ((i - 1) % preempt_count == 0))) |
| 4534 | fflush (display_output); | 4534 | fflush_unlocked (display_output); |
| 4535 | } | 4535 | } |
| 4536 | } | 4536 | } |
| 4537 | 4537 | ||
| @@ -5188,7 +5188,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p | |||
| 5188 | start position, i.e. it excludes the header-line row, but | 5188 | start position, i.e. it excludes the header-line row, but |
| 5189 | MATRIX_ROW includes the header-line row. Adjust for a possible | 5189 | MATRIX_ROW includes the header-line row. Adjust for a possible |
| 5190 | header-line row. */ | 5190 | header-line row. */ |
| 5191 | it_vpos = it.vpos + WINDOW_WANTS_HEADER_LINE_P (w); | 5191 | it_vpos = it.vpos + window_wants_header_line (w); |
| 5192 | if (it_vpos < w->current_matrix->nrows | 5192 | if (it_vpos < w->current_matrix->nrows |
| 5193 | && (row = MATRIX_ROW (w->current_matrix, it_vpos), | 5193 | && (row = MATRIX_ROW (w->current_matrix, it_vpos), |
| 5194 | row->enabled_p)) | 5194 | row->enabled_p)) |
| @@ -5615,13 +5615,13 @@ when TERMINAL is nil. */) | |||
| 5615 | 5615 | ||
| 5616 | if (tty->termscript) | 5616 | if (tty->termscript) |
| 5617 | { | 5617 | { |
| 5618 | fwrite (SDATA (string), 1, SBYTES (string), tty->termscript); | 5618 | fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->termscript); |
| 5619 | fflush (tty->termscript); | 5619 | fflush_unlocked (tty->termscript); |
| 5620 | } | 5620 | } |
| 5621 | out = tty->output; | 5621 | out = tty->output; |
| 5622 | } | 5622 | } |
| 5623 | fwrite (SDATA (string), 1, SBYTES (string), out); | 5623 | fwrite_unlocked (SDATA (string), 1, SBYTES (string), out); |
| 5624 | fflush (out); | 5624 | fflush_unlocked (out); |
| 5625 | unblock_input (); | 5625 | unblock_input (); |
| 5626 | return Qnil; | 5626 | return Qnil; |
| 5627 | } | 5627 | } |
| @@ -5636,7 +5636,7 @@ terminate any keyboard macro currently executing. */) | |||
| 5636 | if (!NILP (arg)) | 5636 | if (!NILP (arg)) |
| 5637 | { | 5637 | { |
| 5638 | if (noninteractive) | 5638 | if (noninteractive) |
| 5639 | putchar (07); | 5639 | putchar_unlocked (07); |
| 5640 | else | 5640 | else |
| 5641 | ring_bell (XFRAME (selected_frame)); | 5641 | ring_bell (XFRAME (selected_frame)); |
| 5642 | } | 5642 | } |
| @@ -5650,7 +5650,7 @@ void | |||
| 5650 | bitch_at_user (void) | 5650 | bitch_at_user (void) |
| 5651 | { | 5651 | { |
| 5652 | if (noninteractive) | 5652 | if (noninteractive) |
| 5653 | putchar (07); | 5653 | putchar_unlocked (07); |
| 5654 | else if (!INTERACTIVE) /* Stop executing a keyboard macro. */ | 5654 | else if (!INTERACTIVE) /* Stop executing a keyboard macro. */ |
| 5655 | { | 5655 | { |
| 5656 | const char *msg | 5656 | const char *msg |
diff --git a/src/emacs-module.c b/src/emacs-module.c index 2693a4529d6..7b1a402eeff 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c | |||
| @@ -575,6 +575,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) | |||
| 575 | MODULE_FUNCTION_BEGIN (module_nil); | 575 | MODULE_FUNCTION_BEGIN (module_nil); |
| 576 | if (! (0 <= length && length <= STRING_BYTES_BOUND)) | 576 | if (! (0 <= length && length <= STRING_BYTES_BOUND)) |
| 577 | xsignal0 (Qoverflow_error); | 577 | xsignal0 (Qoverflow_error); |
| 578 | /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated, | ||
| 579 | but we shouldn’t require that. */ | ||
| 578 | AUTO_STRING_WITH_LEN (lstr, str, length); | 580 | AUTO_STRING_WITH_LEN (lstr, str, length); |
| 579 | return lisp_to_value (env, | 581 | return lisp_to_value (env, |
| 580 | code_convert_string_norecord (lstr, Qutf_8, false)); | 582 | code_convert_string_norecord (lstr, Qutf_8, false)); |
| @@ -599,7 +601,6 @@ module_get_user_ptr (emacs_env *env, emacs_value uptr) | |||
| 599 | static void | 601 | static void |
| 600 | module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) | 602 | module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) |
| 601 | { | 603 | { |
| 602 | /* FIXME: This function should return bool because it can fail. */ | ||
| 603 | MODULE_FUNCTION_BEGIN (); | 604 | MODULE_FUNCTION_BEGIN (); |
| 604 | Lisp_Object lisp = value_to_lisp (uptr); | 605 | Lisp_Object lisp = value_to_lisp (uptr); |
| 605 | CHECK_USER_PTR (lisp); | 606 | CHECK_USER_PTR (lisp); |
| @@ -619,7 +620,6 @@ static void | |||
| 619 | module_set_user_finalizer (emacs_env *env, emacs_value uptr, | 620 | module_set_user_finalizer (emacs_env *env, emacs_value uptr, |
| 620 | emacs_finalizer_function fin) | 621 | emacs_finalizer_function fin) |
| 621 | { | 622 | { |
| 622 | /* FIXME: This function should return bool because it can fail. */ | ||
| 623 | MODULE_FUNCTION_BEGIN (); | 623 | MODULE_FUNCTION_BEGIN (); |
| 624 | Lisp_Object lisp = value_to_lisp (uptr); | 624 | Lisp_Object lisp = value_to_lisp (uptr); |
| 625 | CHECK_USER_PTR (lisp); | 625 | CHECK_USER_PTR (lisp); |
| @@ -638,7 +638,6 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i) | |||
| 638 | static void | 638 | static void |
| 639 | module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) | 639 | module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) |
| 640 | { | 640 | { |
| 641 | /* FIXME: This function should return bool because it can fail. */ | ||
| 642 | MODULE_FUNCTION_BEGIN (); | 641 | MODULE_FUNCTION_BEGIN (); |
| 643 | Lisp_Object lvec = value_to_lisp (vec); | 642 | Lisp_Object lvec = value_to_lisp (vec); |
| 644 | check_vec_index (lvec, i); | 643 | check_vec_index (lvec, i); |
| @@ -657,7 +656,6 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) | |||
| 657 | static ptrdiff_t | 656 | static ptrdiff_t |
| 658 | module_vec_size (emacs_env *env, emacs_value vec) | 657 | module_vec_size (emacs_env *env, emacs_value vec) |
| 659 | { | 658 | { |
| 660 | /* FIXME: Return a sentinel value (e.g., -1) on error. */ | ||
| 661 | MODULE_FUNCTION_BEGIN (0); | 659 | MODULE_FUNCTION_BEGIN (0); |
| 662 | Lisp_Object lvec = value_to_lisp (vec); | 660 | Lisp_Object lvec = value_to_lisp (vec); |
| 663 | CHECK_VECTOR (lvec); | 661 | CHECK_VECTOR (lvec); |
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 339234fdb51..40b6448d27e 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in | |||
| @@ -80,7 +80,7 @@ enum emacs_funcall_exit | |||
| 80 | emacs_funcall_exit_signal = 1, | 80 | emacs_funcall_exit_signal = 1, |
| 81 | 81 | ||
| 82 | /* Function has exit using `throw'. */ | 82 | /* Function has exit using `throw'. */ |
| 83 | emacs_funcall_exit_throw = 2, | 83 | emacs_funcall_exit_throw = 2 |
| 84 | }; | 84 | }; |
| 85 | 85 | ||
| 86 | struct emacs_env_25 | 86 | struct emacs_env_25 |
| @@ -97,6 +97,7 @@ struct emacs_env_26 | |||
| 97 | 97 | ||
| 98 | /* Every module should define a function as follows. */ | 98 | /* Every module should define a function as follows. */ |
| 99 | extern int emacs_module_init (struct emacs_runtime *ert) | 99 | extern int emacs_module_init (struct emacs_runtime *ert) |
| 100 | EMACS_NOEXCEPT | ||
| 100 | EMACS_ATTRIBUTE_NONNULL(1); | 101 | EMACS_ATTRIBUTE_NONNULL(1); |
| 101 | 102 | ||
| 102 | #ifdef __cplusplus | 103 | #ifdef __cplusplus |
diff --git a/src/emacs.c b/src/emacs.c index da8df1bf1c7..0fec7167588 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 23 | 23 | ||
| 24 | #include <errno.h> | 24 | #include <errno.h> |
| 25 | #include <fcntl.h> | 25 | #include <fcntl.h> |
| 26 | #include <stdio.h> | ||
| 27 | #include <stdlib.h> | 26 | #include <stdlib.h> |
| 28 | 27 | ||
| 29 | #include <sys/file.h> | 28 | #include <sys/file.h> |
| @@ -33,6 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 33 | 32 | ||
| 34 | #define MAIN_PROGRAM | 33 | #define MAIN_PROGRAM |
| 35 | #include "lisp.h" | 34 | #include "lisp.h" |
| 35 | #include "sysstdio.h" | ||
| 36 | 36 | ||
| 37 | #ifdef WINDOWSNT | 37 | #ifdef WINDOWSNT |
| 38 | #include <fcntl.h> | 38 | #include <fcntl.h> |
| @@ -885,7 +885,7 @@ main (int argc, char **argv) | |||
| 885 | } | 885 | } |
| 886 | #endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */ | 886 | #endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */ |
| 887 | 887 | ||
| 888 | clearerr (stdin); | 888 | clearerr_unlocked (stdin); |
| 889 | 889 | ||
| 890 | emacs_backtrace (-1); | 890 | emacs_backtrace (-1); |
| 891 | 891 | ||
| @@ -983,7 +983,7 @@ main (int argc, char **argv) | |||
| 983 | int i; | 983 | int i; |
| 984 | printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]); | 984 | printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]); |
| 985 | for (i = 0; i < ARRAYELTS (usage_message); i++) | 985 | for (i = 0; i < ARRAYELTS (usage_message); i++) |
| 986 | fputs (usage_message[i], stdout); | 986 | fputs_unlocked (usage_message[i], stdout); |
| 987 | exit (0); | 987 | exit (0); |
| 988 | } | 988 | } |
| 989 | 989 | ||
| @@ -2197,7 +2197,7 @@ You must run Emacs in batch mode in order to dump it. */) | |||
| 2197 | } | 2197 | } |
| 2198 | #endif | 2198 | #endif |
| 2199 | 2199 | ||
| 2200 | fflush (stdout); | 2200 | fflush_unlocked (stdout); |
| 2201 | /* Tell malloc where start of impure now is. */ | 2201 | /* Tell malloc where start of impure now is. */ |
| 2202 | /* Also arrange for warnings when nearly out of space. */ | 2202 | /* Also arrange for warnings when nearly out of space. */ |
| 2203 | #if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC | 2203 | #if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC |
diff --git a/src/fileio.c b/src/fileio.c index cb070029a9b..a57d50b24e0 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -5643,14 +5643,12 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) | |||
| 5643 | { | 5643 | { |
| 5644 | block_input (); | 5644 | block_input (); |
| 5645 | if (!NILP (BVAR (b, filename))) | 5645 | if (!NILP (BVAR (b, filename))) |
| 5646 | { | 5646 | fwrite_unlocked (SDATA (BVAR (b, filename)), 1, |
| 5647 | fwrite (SDATA (BVAR (b, filename)), 1, | 5647 | SBYTES (BVAR (b, filename)), stream); |
| 5648 | SBYTES (BVAR (b, filename)), stream); | 5648 | putc_unlocked ('\n', stream); |
| 5649 | } | 5649 | fwrite_unlocked (SDATA (BVAR (b, auto_save_file_name)), 1, |
| 5650 | putc ('\n', stream); | 5650 | SBYTES (BVAR (b, auto_save_file_name)), stream); |
| 5651 | fwrite (SDATA (BVAR (b, auto_save_file_name)), 1, | 5651 | putc_unlocked ('\n', stream); |
| 5652 | SBYTES (BVAR (b, auto_save_file_name)), stream); | ||
| 5653 | putc ('\n', stream); | ||
| 5654 | unblock_input (); | 5652 | unblock_input (); |
| 5655 | } | 5653 | } |
| 5656 | 5654 | ||
| @@ -5841,7 +5839,7 @@ effect except for flushing STREAM's data. */) | |||
| 5841 | 5839 | ||
| 5842 | binmode = NILP (mode) ? O_TEXT : O_BINARY; | 5840 | binmode = NILP (mode) ? O_TEXT : O_BINARY; |
| 5843 | if (fp != stdin) | 5841 | if (fp != stdin) |
| 5844 | fflush (fp); | 5842 | fflush_unlocked (fp); |
| 5845 | 5843 | ||
| 5846 | return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil; | 5844 | return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil; |
| 5847 | } | 5845 | } |
diff --git a/src/frame.c b/src/frame.c index 4d17a071dc7..1e5e4bbdb48 100644 --- a/src/frame.c +++ b/src/frame.c | |||
| @@ -328,8 +328,8 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size, | |||
| 328 | * frame_windows_min_size: | 328 | * frame_windows_min_size: |
| 329 | * | 329 | * |
| 330 | * Return the minimum number of lines (columns if HORIZONTAL is non-nil) | 330 | * Return the minimum number of lines (columns if HORIZONTAL is non-nil) |
| 331 | * of FRAME. If PIXELWISE is non-nil, return the minimum height (width) | 331 | * of FRAME. If PIXELWISE is non-nil, return the minimum inner height |
| 332 | * in pixels. | 332 | * (width) of FRAME in pixels. |
| 333 | * | 333 | * |
| 334 | * This value is calculated by the function `frame-windows-min-size' in | 334 | * This value is calculated by the function `frame-windows-min-size' in |
| 335 | * window.el unless the `min-height' (`min-width' if HORIZONTAL is | 335 | * window.el unless the `min-height' (`min-width' if HORIZONTAL is |
| @@ -341,7 +341,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size, | |||
| 341 | * of `window-min-height' (`window-min-width' if HORIZONTAL is non-nil). | 341 | * of `window-min-height' (`window-min-width' if HORIZONTAL is non-nil). |
| 342 | * With IGNORE non-nil the values of these variables are ignored. | 342 | * With IGNORE non-nil the values of these variables are ignored. |
| 343 | * | 343 | * |
| 344 | * In either case never return a value less than 1. | 344 | * In either case, never return a value less than 1. |
| 345 | */ | 345 | */ |
| 346 | static int | 346 | static int |
| 347 | frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, | 347 | frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, |
| @@ -373,46 +373,173 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, | |||
| 373 | } | 373 | } |
| 374 | 374 | ||
| 375 | 375 | ||
| 376 | /* Make sure windows sizes of frame F are OK. new_width and new_height | 376 | #ifdef HAVE_WINDOW_SYSTEM |
| 377 | are in pixels. A value of -1 means no change is requested for that | 377 | /** |
| 378 | size (but the frame may still have to be resized to accommodate | 378 | * keep_ratio: |
| 379 | windows with their minimum sizes). This can either issue a request | 379 | * |
| 380 | to resize the frame externally (via x_set_window_size), to resize the | 380 | * Preserve ratios of frame F which usually happens after its parent |
| 381 | frame internally (via resize_frame_windows) or do nothing at all. | 381 | * frame P got resized. OLD_WIDTH, OLD_HEIGHT specifies the old native |
| 382 | * size of F's parent, NEW_WIDTH and NEW_HEIGHT its new size. | ||
| 383 | * | ||
| 384 | * Adjust F's width if F's 'keep_ratio' parameter is non-nil and, if | ||
| 385 | * it is a cons, its car is not 'height-only'. Adjust F's height if F's | ||
| 386 | * 'keep_ratio' parameter is non-nil and, if it is a cons, its car | ||
| 387 | * is not 'width-only'. | ||
| 388 | * | ||
| 389 | * Adjust F's left position if F's 'keep_ratio' parameter is non-nil | ||
| 390 | * and, if its is a cons, its cdr is non-nil and not 'top-only'. Adjust | ||
| 391 | * F's top position if F's 'keep_ratio' parameter is non-nil and, if | ||
| 392 | * its is a cons, its cdr is non-nil and not 'left-only'. | ||
| 393 | * | ||
| 394 | * Note that when positional adjustment is requested but the size of F | ||
| 395 | * should remain unaltered in the corresponding direction, this routine | ||
| 396 | * tries to constrain F to its parent frame - something which usually | ||
| 397 | * happens when the parent frame shrinks. This means, however, that | ||
| 398 | * when the parent frame is re-enlarged later, the child's original | ||
| 399 | * position will not get restored to its pre-shrinking value. | ||
| 400 | * | ||
| 401 | * This routine is currently useful for child frames only. It might be | ||
| 402 | * eventually useful when moving non-child frames between monitors with | ||
| 403 | * different resolutions. | ||
| 404 | */ | ||
| 405 | static void | ||
| 406 | keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height, | ||
| 407 | int new_width, int new_height) | ||
| 408 | { | ||
| 409 | Lisp_Object keep_ratio = get_frame_param (f, Qkeep_ratio); | ||
| 410 | |||
| 411 | |||
| 412 | if (!NILP (keep_ratio)) | ||
| 413 | { | ||
| 414 | double width_factor = (double)new_width / (double)old_width; | ||
| 415 | double height_factor = (double)new_height / (double)old_height; | ||
| 416 | int pixel_width, pixel_height, pos_x, pos_y; | ||
| 417 | |||
| 418 | if (!CONSP (keep_ratio) || !NILP (Fcdr (keep_ratio))) | ||
| 419 | { | ||
| 420 | if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qtop_only)) | ||
| 421 | pos_x = f->left_pos; | ||
| 422 | else | ||
| 423 | { | ||
| 424 | pos_x = (int)(f->left_pos * width_factor + 0.5); | ||
| 382 | 425 | ||
| 383 | The argument INHIBIT can assume the following values: | 426 | if (CONSP (keep_ratio) |
| 427 | && (NILP (Fcar (keep_ratio)) | ||
| 428 | || EQ (Fcar (keep_ratio), Qheight_only)) | ||
| 429 | && p->pixel_width - f->pixel_width < pos_x) | ||
| 430 | { | ||
| 431 | int p_f_width = p->pixel_width - f->pixel_width; | ||
| 384 | 432 | ||
| 385 | 0 means to unconditionally call x_set_window_size even if sizes | 433 | if (p_f_width <= 0) |
| 386 | apparently do not change. Fx_create_frame uses this to pass the | 434 | pos_x = 0; |
| 387 | initial size to the window manager. | 435 | else |
| 436 | pos_x = (int)(p_f_width * width_factor * 0.5 + 0.5); | ||
| 437 | } | ||
| 388 | 438 | ||
| 389 | 1 means to call x_set_window_size if the outer frame size really | 439 | f->left_pos = pos_x; |
| 390 | changes. Fset_frame_size, Fset_frame_height, ... use this. | 440 | } |
| 391 | 441 | ||
| 392 | 2 means to call x_set_window_size provided frame_inhibit_resize | 442 | if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qleft_only)) |
| 393 | allows it. The menu and tool bar code use this ("3" won't work | 443 | pos_y = f->top_pos; |
| 394 | here in general because menu and tool bar are often not counted in | 444 | else |
| 395 | the frame's text height). | 445 | { |
| 446 | pos_y = (int)(f->top_pos * height_factor + 0.5); | ||
| 447 | |||
| 448 | if (CONSP (keep_ratio) | ||
| 449 | && (NILP (Fcar (keep_ratio)) | ||
| 450 | || EQ (Fcar (keep_ratio), Qwidth_only)) | ||
| 451 | && p->pixel_height - f->pixel_height < pos_y) | ||
| 452 | /* When positional adjustment was requested and the | ||
| 453 | width of F should remain unaltered, try to constrain | ||
| 454 | F to its parent. This means that when the parent | ||
| 455 | frame is enlarged later the child's original position | ||
| 456 | won't get restored. */ | ||
| 457 | { | ||
| 458 | int p_f_height = p->pixel_height - f->pixel_height; | ||
| 396 | 459 | ||
| 397 | 3 means call x_set_window_size if window minimum sizes must be | 460 | if (p_f_height <= 0) |
| 398 | preserved or frame_inhibit_resize allows it. x_set_left_fringe, | 461 | pos_y = 0; |
| 399 | x_set_scroll_bar_width, x_new_font ... use (or should use) this. | 462 | else |
| 463 | pos_y = (int)(p_f_height * height_factor * 0.5 + 0.5); | ||
| 464 | } | ||
| 400 | 465 | ||
| 401 | 4 means call x_set_window_size only if window minimum sizes must be | 466 | f->top_pos = pos_y; |
| 402 | preserved. x_set_right_divider_width, x_set_border_width and the | 467 | } |
| 403 | code responsible for wrapping the tool bar use this. | ||
| 404 | 468 | ||
| 405 | 5 means to never call x_set_window_size. change_frame_size uses | 469 | x_set_offset (f, pos_x, pos_y, -1); |
| 406 | this. | 470 | } |
| 407 | 471 | ||
| 408 | Note that even when x_set_window_size is not called, individual | 472 | if (!CONSP (keep_ratio) || !NILP (Fcar (keep_ratio))) |
| 409 | windows may have to be resized (via `window--sanitize-window-sizes') | 473 | { |
| 410 | in order to support minimum size constraints. | 474 | if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qheight_only)) |
| 475 | pixel_width = -1; | ||
| 476 | else | ||
| 477 | { | ||
| 478 | pixel_width = (int)(f->pixel_width * width_factor + 0.5); | ||
| 479 | pixel_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, pixel_width); | ||
| 480 | } | ||
| 411 | 481 | ||
| 412 | PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the | 482 | if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qwidth_only)) |
| 413 | symbol of the parameter changed (like `menu-bar-lines', `font', ...). | 483 | pixel_height = -1; |
| 414 | This is passed on to frame_inhibit_resize to let the latter decide on | 484 | else |
| 415 | a case-by-case basis whether the frame may be resized externally. */ | 485 | { |
| 486 | pixel_height = (int)(f->pixel_height * height_factor + 0.5); | ||
| 487 | pixel_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixel_height); | ||
| 488 | } | ||
| 489 | |||
| 490 | adjust_frame_size (f, pixel_width, pixel_height, 1, 0, | ||
| 491 | Qkeep_ratio); | ||
| 492 | } | ||
| 493 | } | ||
| 494 | } | ||
| 495 | #endif | ||
| 496 | |||
| 497 | |||
| 498 | /** | ||
| 499 | * adjust_frame_size: | ||
| 500 | * | ||
| 501 | * Adjust size of frame F. NEW_WIDTH and NEW_HEIGHT specify the new | ||
| 502 | * text size of F in pixels. A value of -1 means no change is requested | ||
| 503 | * for that direction (but the frame may still have to be resized to | ||
| 504 | * accommodate windows with their minimum sizes). This can either issue | ||
| 505 | * a request to resize the frame externally (via x_set_window_size), to | ||
| 506 | * resize the frame internally (via resize_frame_windows) or do nothing | ||
| 507 | * at all. | ||
| 508 | * | ||
| 509 | * The argument INHIBIT can assume the following values: | ||
| 510 | * | ||
| 511 | * 0 means to unconditionally call x_set_window_size even if sizes | ||
| 512 | * apparently do not change. Fx_create_frame uses this to pass the | ||
| 513 | * initial size to the window manager. | ||
| 514 | * | ||
| 515 | * 1 means to call x_set_window_size if the native frame size really | ||
| 516 | * changes. Fset_frame_size, Fset_frame_height, ... use this. | ||
| 517 | * | ||
| 518 | * 2 means to call x_set_window_size provided frame_inhibit_resize | ||
| 519 | * allows it. The menu and tool bar code use this ("3" won't work | ||
| 520 | * here in general because menu and tool bar are often not counted in | ||
| 521 | * the frame's text height). | ||
| 522 | * | ||
| 523 | * 3 means call x_set_window_size if window minimum sizes must be | ||
| 524 | * preserved or frame_inhibit_resize allows it. x_set_left_fringe, | ||
| 525 | * x_set_scroll_bar_width, x_new_font ... use (or should use) this. | ||
| 526 | * | ||
| 527 | * 4 means call x_set_window_size only if window minimum sizes must be | ||
| 528 | * preserved. x_set_right_divider_width, x_set_border_width and the | ||
| 529 | * code responsible for wrapping the tool bar use this. | ||
| 530 | * | ||
| 531 | * 5 means to never call x_set_window_size. change_frame_size uses | ||
| 532 | * this. | ||
| 533 | * | ||
| 534 | * Note that even when x_set_window_size is not called, individual | ||
| 535 | * windows may have to be resized (via `window--sanitize-window-sizes') | ||
| 536 | * in order to support minimum size constraints. | ||
| 537 | * | ||
| 538 | * PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the | ||
| 539 | * symbol of the parameter changed (like `menu-bar-lines', `font', ...). | ||
| 540 | * This is passed on to frame_inhibit_resize to let the latter decide on | ||
| 541 | * a case-by-case basis whether the frame may be resized externally. | ||
| 542 | */ | ||
| 416 | void | 543 | void |
| 417 | adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, | 544 | adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, |
| 418 | bool pretend, Lisp_Object parameter) | 545 | bool pretend, Lisp_Object parameter) |
| @@ -636,6 +763,18 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, | |||
| 636 | || new_pixel_height != old_pixel_height); | 763 | || new_pixel_height != old_pixel_height); |
| 637 | 764 | ||
| 638 | unblock_input (); | 765 | unblock_input (); |
| 766 | |||
| 767 | #ifdef HAVE_WINDOW_SYSTEM | ||
| 768 | { | ||
| 769 | /* Adjust size of F's child frames. */ | ||
| 770 | Lisp_Object frames, frame1; | ||
| 771 | |||
| 772 | FOR_EACH_FRAME (frames, frame1) | ||
| 773 | if (FRAME_PARENT_FRAME (XFRAME (frame1)) == f) | ||
| 774 | keep_ratio (XFRAME (frame1), f, old_pixel_width, old_pixel_height, | ||
| 775 | new_pixel_width, new_pixel_height); | ||
| 776 | } | ||
| 777 | #endif | ||
| 639 | } | 778 | } |
| 640 | 779 | ||
| 641 | /* Allocate basically initialized frame. */ | 780 | /* Allocate basically initialized frame. */ |
| @@ -684,6 +823,7 @@ make_frame (bool mini_p) | |||
| 684 | f->horizontal_scroll_bars = false; | 823 | f->horizontal_scroll_bars = false; |
| 685 | f->want_fullscreen = FULLSCREEN_NONE; | 824 | f->want_fullscreen = FULLSCREEN_NONE; |
| 686 | f->undecorated = false; | 825 | f->undecorated = false; |
| 826 | f->no_special_glyphs = false; | ||
| 687 | #ifndef HAVE_NTGUI | 827 | #ifndef HAVE_NTGUI |
| 688 | f->override_redirect = false; | 828 | f->override_redirect = false; |
| 689 | #endif | 829 | #endif |
| @@ -2004,8 +2144,101 @@ The functions are run with one argument, the frame to be deleted. */) | |||
| 2004 | { | 2144 | { |
| 2005 | return delete_frame (frame, !NILP (force) ? Qt : Qnil); | 2145 | return delete_frame (frame, !NILP (force) ? Qt : Qnil); |
| 2006 | } | 2146 | } |
| 2007 | |||
| 2008 | 2147 | ||
| 2148 | #ifdef HAVE_WINDOW_SYSTEM | ||
| 2149 | /** | ||
| 2150 | * frame_internal_border_part: | ||
| 2151 | * | ||
| 2152 | * Return part of internal border the coordinates X and Y relative to | ||
| 2153 | * frame F are on. Return nil if the coordinates are not on the | ||
| 2154 | * internal border of F. | ||
| 2155 | * | ||
| 2156 | * Return one of INTERNAL_BORDER_LEFT_EDGE, INTERNAL_BORDER_TOP_EDGE, | ||
| 2157 | * INTERNAL_BORDER_RIGHT_EDGE or INTERNAL_BORDER_BOTTOM_EDGE when the | ||
| 2158 | * mouse cursor is on the corresponding border with an offset of at | ||
| 2159 | * least one canonical character height from that border's edges. | ||
| 2160 | * | ||
| 2161 | * If no border part could be found this way, return one of | ||
| 2162 | * INTERNAL_BORDER_TOP_LEFT_CORNER, INTERNAL_BORDER_TOP_RIGHT_CORNER, | ||
| 2163 | * INTERNAL_BORDER_BOTTOM_LEFT_CORNER or | ||
| 2164 | * INTERNAL_BORDER_BOTTOM_RIGHT_CORNER to indicate that the mouse is in | ||
| 2165 | * one of the corresponding corners. This means that for very small | ||
| 2166 | * frames an `edge' return value is preferred. | ||
| 2167 | */ | ||
| 2168 | enum internal_border_part | ||
| 2169 | frame_internal_border_part (struct frame *f, int x, int y) | ||
| 2170 | { | ||
| 2171 | int border = FRAME_INTERNAL_BORDER_WIDTH (f); | ||
| 2172 | int offset = FRAME_LINE_HEIGHT (f); | ||
| 2173 | int width = FRAME_PIXEL_WIDTH (f); | ||
| 2174 | int height = FRAME_PIXEL_HEIGHT (f); | ||
| 2175 | enum internal_border_part part = INTERNAL_BORDER_NONE; | ||
| 2176 | |||
| 2177 | if (offset < border) | ||
| 2178 | /* For very wide borders make offset at least as large as | ||
| 2179 | border. */ | ||
| 2180 | offset = border; | ||
| 2181 | |||
| 2182 | if (offset < x && x < width - offset) | ||
| 2183 | /* Top or bottom border. */ | ||
| 2184 | { | ||
| 2185 | if (0 <= y && y <= border) | ||
| 2186 | part = INTERNAL_BORDER_TOP_EDGE; | ||
| 2187 | else if (height - border <= y && y <= height) | ||
| 2188 | part = INTERNAL_BORDER_BOTTOM_EDGE; | ||
| 2189 | } | ||
| 2190 | else if (offset < y && y < height - offset) | ||
| 2191 | /* Left or right border. */ | ||
| 2192 | { | ||
| 2193 | if (0 <= x && x <= border) | ||
| 2194 | part = INTERNAL_BORDER_LEFT_EDGE; | ||
| 2195 | else if (width - border <= x && x <= width) | ||
| 2196 | part = INTERNAL_BORDER_RIGHT_EDGE; | ||
| 2197 | } | ||
| 2198 | else | ||
| 2199 | { | ||
| 2200 | /* An edge. */ | ||
| 2201 | int half_width = width / 2; | ||
| 2202 | int half_height = height / 2; | ||
| 2203 | |||
| 2204 | if (0 <= x && x <= border) | ||
| 2205 | { | ||
| 2206 | /* A left edge. */ | ||
| 2207 | if (0 <= y && y <= half_height) | ||
| 2208 | part = INTERNAL_BORDER_TOP_LEFT_CORNER; | ||
| 2209 | else if (half_height < y && y <= height) | ||
| 2210 | part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER; | ||
| 2211 | } | ||
| 2212 | else if (width - border <= x && x <= width) | ||
| 2213 | { | ||
| 2214 | /* A right edge. */ | ||
| 2215 | if (0 <= y && y <= half_height) | ||
| 2216 | part = INTERNAL_BORDER_TOP_RIGHT_CORNER; | ||
| 2217 | else if (half_height < y && y <= height) | ||
| 2218 | part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER; | ||
| 2219 | } | ||
| 2220 | else if (0 <= y && y <= border) | ||
| 2221 | { | ||
| 2222 | /* A top edge. */ | ||
| 2223 | if (0 <= x && x <= half_width) | ||
| 2224 | part = INTERNAL_BORDER_TOP_LEFT_CORNER; | ||
| 2225 | else if (half_width < x && x <= width) | ||
| 2226 | part = INTERNAL_BORDER_TOP_RIGHT_CORNER; | ||
| 2227 | } | ||
| 2228 | else if (height - border <= y && y <= height) | ||
| 2229 | { | ||
| 2230 | /* A bottom edge. */ | ||
| 2231 | if (0 <= x && x <= half_width) | ||
| 2232 | part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER; | ||
| 2233 | else if (half_width < x && x <= width) | ||
| 2234 | part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER; | ||
| 2235 | } | ||
| 2236 | } | ||
| 2237 | |||
| 2238 | return part; | ||
| 2239 | } | ||
| 2240 | #endif | ||
| 2241 | |||
| 2009 | /* Return mouse position in character cell units. */ | 2242 | /* Return mouse position in character cell units. */ |
| 2010 | 2243 | ||
| 2011 | DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0, | 2244 | DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0, |
| @@ -2962,49 +3195,47 @@ For a terminal screen, the value is always 1. */) | |||
| 2962 | return make_number (1); | 3195 | return make_number (1); |
| 2963 | } | 3196 | } |
| 2964 | 3197 | ||
| 2965 | DEFUN ("frame-pixel-height", Fframe_pixel_height, | 3198 | DEFUN ("frame-native-width", Fframe_native_width, |
| 2966 | Sframe_pixel_height, 0, 1, 0, | 3199 | Sframe_native_width, 0, 1, 0, |
| 2967 | doc: /* Return a FRAME's height in pixels. | 3200 | doc: /* Return FRAME's native width in pixels. |
| 2968 | If FRAME is omitted or nil, the selected frame is used. The exact value | 3201 | For a terminal frame, the result really gives the width in characters. |
| 2969 | of the result depends on the window-system and toolkit in use: | 3202 | If FRAME is omitted or nil, the selected frame is used. */) |
| 2970 | |||
| 2971 | In the Gtk+ version of Emacs, it includes only any window (including | ||
| 2972 | the minibuffer or echo area), mode line, and header line. It does not | ||
| 2973 | include the tool bar or menu bar. | ||
| 2974 | |||
| 2975 | With other graphical versions, it also includes the tool bar and the | ||
| 2976 | menu bar. | ||
| 2977 | |||
| 2978 | For a text terminal, it includes the menu bar. In this case, the | ||
| 2979 | result is really in characters rather than pixels (i.e., is identical | ||
| 2980 | to `frame-height'). */) | ||
| 2981 | (Lisp_Object frame) | 3203 | (Lisp_Object frame) |
| 2982 | { | 3204 | { |
| 2983 | struct frame *f = decode_any_frame (frame); | 3205 | struct frame *f = decode_any_frame (frame); |
| 2984 | 3206 | ||
| 2985 | #ifdef HAVE_WINDOW_SYSTEM | 3207 | #ifdef HAVE_WINDOW_SYSTEM |
| 2986 | if (FRAME_WINDOW_P (f)) | 3208 | if (FRAME_WINDOW_P (f)) |
| 2987 | return make_number (FRAME_PIXEL_HEIGHT (f)); | 3209 | return make_number (FRAME_PIXEL_WIDTH (f)); |
| 2988 | else | 3210 | else |
| 2989 | #endif | 3211 | #endif |
| 2990 | return make_number (FRAME_TOTAL_LINES (f)); | 3212 | return make_number (FRAME_TOTAL_COLS (f)); |
| 2991 | } | 3213 | } |
| 2992 | 3214 | ||
| 2993 | DEFUN ("frame-pixel-width", Fframe_pixel_width, | 3215 | DEFUN ("frame-native-height", Fframe_native_height, |
| 2994 | Sframe_pixel_width, 0, 1, 0, | 3216 | Sframe_native_height, 0, 1, 0, |
| 2995 | doc: /* Return FRAME's width in pixels. | 3217 | doc: /* Return FRAME's native height in pixels. |
| 2996 | For a terminal frame, the result really gives the width in characters. | 3218 | If FRAME is omitted or nil, the selected frame is used. The exact value |
| 2997 | If FRAME is omitted or nil, the selected frame is used. */) | 3219 | of the result depends on the window-system and toolkit in use: |
| 3220 | |||
| 3221 | In the Gtk+ and NS versions, it includes only any window (including the | ||
| 3222 | minibuffer or echo area), mode line, and header line. It does not | ||
| 3223 | include the tool bar or menu bar. With other graphical versions, it may | ||
| 3224 | also include the tool bar and the menu bar. | ||
| 3225 | |||
| 3226 | For a text terminal, it includes the menu bar. In this case, the | ||
| 3227 | result is really in characters rather than pixels (i.e., is identical | ||
| 3228 | to `frame-height'). */) | ||
| 2998 | (Lisp_Object frame) | 3229 | (Lisp_Object frame) |
| 2999 | { | 3230 | { |
| 3000 | struct frame *f = decode_any_frame (frame); | 3231 | struct frame *f = decode_any_frame (frame); |
| 3001 | 3232 | ||
| 3002 | #ifdef HAVE_WINDOW_SYSTEM | 3233 | #ifdef HAVE_WINDOW_SYSTEM |
| 3003 | if (FRAME_WINDOW_P (f)) | 3234 | if (FRAME_WINDOW_P (f)) |
| 3004 | return make_number (FRAME_PIXEL_WIDTH (f)); | 3235 | return make_number (FRAME_PIXEL_HEIGHT (f)); |
| 3005 | else | 3236 | else |
| 3006 | #endif | 3237 | #endif |
| 3007 | return make_number (FRAME_TOTAL_COLS (f)); | 3238 | return make_number (FRAME_TOTAL_LINES (f)); |
| 3008 | } | 3239 | } |
| 3009 | 3240 | ||
| 3010 | DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width, | 3241 | DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width, |
| @@ -3087,8 +3318,8 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0, | |||
| 3087 | return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame))); | 3318 | return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame))); |
| 3088 | } | 3319 | } |
| 3089 | 3320 | ||
| 3090 | DEFUN ("frame-border-width", Fborder_width, Sborder_width, 0, 1, 0, | 3321 | DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0, |
| 3091 | doc: /* Return border width of FRAME in pixels. */) | 3322 | doc: /* Return width of FRAME's internal border in pixels. */) |
| 3092 | (Lisp_Object frame) | 3323 | (Lisp_Object frame) |
| 3093 | { | 3324 | { |
| 3094 | return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame))); | 3325 | return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame))); |
| @@ -3224,7 +3455,6 @@ bottom edge of FRAME's display. */) | |||
| 3224 | 3455 | ||
| 3225 | return Qt; | 3456 | return Qt; |
| 3226 | } | 3457 | } |
| 3227 | |||
| 3228 | 3458 | ||
| 3229 | /*********************************************************************** | 3459 | /*********************************************************************** |
| 3230 | Frame Parameters | 3460 | Frame Parameters |
| @@ -3289,10 +3519,193 @@ static const struct frame_parm_table frame_parms[] = | |||
| 3289 | {"no-accept-focus", SYMBOL_INDEX (Qno_accept_focus)}, | 3519 | {"no-accept-focus", SYMBOL_INDEX (Qno_accept_focus)}, |
| 3290 | {"z-group", SYMBOL_INDEX (Qz_group)}, | 3520 | {"z-group", SYMBOL_INDEX (Qz_group)}, |
| 3291 | {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, | 3521 | {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, |
| 3522 | {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)}, | ||
| 3292 | }; | 3523 | }; |
| 3293 | 3524 | ||
| 3294 | #ifdef HAVE_WINDOW_SYSTEM | 3525 | #ifdef HAVE_WINDOW_SYSTEM |
| 3295 | 3526 | ||
| 3527 | /* Enumeration type for switch in frame_float. */ | ||
| 3528 | enum frame_float_type | ||
| 3529 | { | ||
| 3530 | FRAME_FLOAT_WIDTH, | ||
| 3531 | FRAME_FLOAT_HEIGHT, | ||
| 3532 | FRAME_FLOAT_LEFT, | ||
| 3533 | FRAME_FLOAT_TOP | ||
| 3534 | }; | ||
| 3535 | |||
| 3536 | /** | ||
| 3537 | * frame_float: | ||
| 3538 | * | ||
| 3539 | * Process the value VAL of the float type frame parameter 'width', | ||
| 3540 | * 'height', 'left', or 'top' specified via a frame_float_type | ||
| 3541 | * enumeration type WHAT for frame F. Such parameters relate the outer | ||
| 3542 | * size or position of F to the size of the F's display or parent frame | ||
| 3543 | * which have to be both available in some way. | ||
| 3544 | * | ||
| 3545 | * The return value is a size or position value in pixels. VAL must be | ||
| 3546 | * in the range 0.0 to 1.0 where a width/height of 0.0 means to return 0 | ||
| 3547 | * and 1.0 means to return the full width/height of the display/parent. | ||
| 3548 | * For positions, 0.0 means position in the left/top corner of the | ||
| 3549 | * display/parent while 1.0 means to position at the right/bottom corner | ||
| 3550 | * of the display/parent frame. | ||
| 3551 | * | ||
| 3552 | * Set PARENT_DONE and OUTER_DONE to avoid recalculation of the outer | ||
| 3553 | * size or parent or display attributes when more float parameters are | ||
| 3554 | * calculated in a row: -1 means not processed yet, 0 means processing | ||
| 3555 | * failed, 1 means processing succeeded. | ||
| 3556 | * | ||
| 3557 | * Return DEFAULT_VALUE when processing fails for whatever reason with | ||
| 3558 | * one exception: When calculating F's outer edges fails (probably | ||
| 3559 | * because F has not been created yet) return the difference between F's | ||
| 3560 | * native and text size. | ||
| 3561 | */ | ||
| 3562 | static int | ||
| 3563 | frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, | ||
| 3564 | int *parent_done, int *outer_done, int default_value) | ||
| 3565 | { | ||
| 3566 | double d_val = XFLOAT_DATA (val); | ||
| 3567 | |||
| 3568 | if (d_val < 0.0 || d_val > 1.0) | ||
| 3569 | /* Invalid VAL. */ | ||
| 3570 | return default_value; | ||
| 3571 | else | ||
| 3572 | { | ||
| 3573 | static unsigned parent_width, parent_height; | ||
| 3574 | static int parent_left, parent_top; | ||
| 3575 | static unsigned outer_minus_text_width, outer_minus_text_height; | ||
| 3576 | struct frame *p = FRAME_PARENT_FRAME (f); | ||
| 3577 | |||
| 3578 | if (*parent_done == 1) | ||
| 3579 | ; | ||
| 3580 | else if (p) | ||
| 3581 | { | ||
| 3582 | parent_width = FRAME_PIXEL_WIDTH (p); | ||
| 3583 | parent_height = FRAME_PIXEL_HEIGHT (p); | ||
| 3584 | *parent_done = 1; | ||
| 3585 | } | ||
| 3586 | else | ||
| 3587 | { | ||
| 3588 | if (*parent_done == 0) | ||
| 3589 | /* No workarea available. */ | ||
| 3590 | return default_value; | ||
| 3591 | else if (*parent_done == -1) | ||
| 3592 | { | ||
| 3593 | Lisp_Object monitor_attributes; | ||
| 3594 | Lisp_Object workarea; | ||
| 3595 | Lisp_Object frame; | ||
| 3596 | |||
| 3597 | XSETFRAME (frame, f); | ||
| 3598 | monitor_attributes = Fcar (call1 (Qdisplay_monitor_attributes_list, frame)); | ||
| 3599 | if (NILP (monitor_attributes)) | ||
| 3600 | { | ||
| 3601 | /* No monitor attributes available. */ | ||
| 3602 | *parent_done = 0; | ||
| 3603 | |||
| 3604 | return default_value; | ||
| 3605 | } | ||
| 3606 | |||
| 3607 | workarea = Fcdr (Fassq (Qworkarea, monitor_attributes)); | ||
| 3608 | if (NILP (workarea)) | ||
| 3609 | { | ||
| 3610 | /* No workarea available. */ | ||
| 3611 | *parent_done = 0; | ||
| 3612 | |||
| 3613 | return default_value; | ||
| 3614 | } | ||
| 3615 | |||
| 3616 | /* Workarea available. */ | ||
| 3617 | parent_left = XINT (Fnth (make_number (0), workarea)); | ||
| 3618 | parent_top = XINT (Fnth (make_number (1), workarea)); | ||
| 3619 | parent_width = XINT (Fnth (make_number (2), workarea)); | ||
| 3620 | parent_height = XINT (Fnth (make_number (3), workarea)); | ||
| 3621 | *parent_done = 1; | ||
| 3622 | } | ||
| 3623 | } | ||
| 3624 | |||
| 3625 | if (*outer_done == 1) | ||
| 3626 | ; | ||
| 3627 | else if (FRAME_UNDECORATED (f)) | ||
| 3628 | { | ||
| 3629 | outer_minus_text_width | ||
| 3630 | = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f); | ||
| 3631 | outer_minus_text_height | ||
| 3632 | = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f); | ||
| 3633 | *outer_done = 1; | ||
| 3634 | } | ||
| 3635 | else if (*outer_done == 0) | ||
| 3636 | /* No outer size available. */ | ||
| 3637 | return default_value; | ||
| 3638 | else if (*outer_done == -1) | ||
| 3639 | { | ||
| 3640 | Lisp_Object frame, outer_edges; | ||
| 3641 | |||
| 3642 | XSETFRAME (frame, f); | ||
| 3643 | outer_edges = call2 (Qframe_edges, frame, Qouter_edges); | ||
| 3644 | |||
| 3645 | if (!NILP (outer_edges)) | ||
| 3646 | { | ||
| 3647 | outer_minus_text_width | ||
| 3648 | = (XINT (Fnth (make_number (2), outer_edges)) | ||
| 3649 | - XINT (Fnth (make_number (0), outer_edges)) | ||
| 3650 | - FRAME_TEXT_WIDTH (f)); | ||
| 3651 | outer_minus_text_height | ||
| 3652 | = (XINT (Fnth (make_number (3), outer_edges)) | ||
| 3653 | - XINT (Fnth (make_number (1), outer_edges)) | ||
| 3654 | - FRAME_TEXT_HEIGHT (f)); | ||
| 3655 | } | ||
| 3656 | else | ||
| 3657 | { | ||
| 3658 | /* If we can't get any outer edges, proceed as if the frame | ||
| 3659 | were undecorated. */ | ||
| 3660 | outer_minus_text_width | ||
| 3661 | = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f); | ||
| 3662 | outer_minus_text_height | ||
| 3663 | = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f); | ||
| 3664 | } | ||
| 3665 | |||
| 3666 | *outer_done = 1; | ||
| 3667 | } | ||
| 3668 | |||
| 3669 | switch (what) | ||
| 3670 | { | ||
| 3671 | case FRAME_FLOAT_WIDTH: | ||
| 3672 | return parent_width * d_val - outer_minus_text_width; | ||
| 3673 | |||
| 3674 | case FRAME_FLOAT_HEIGHT: | ||
| 3675 | return parent_height * d_val - outer_minus_text_height; | ||
| 3676 | |||
| 3677 | case FRAME_FLOAT_LEFT: | ||
| 3678 | { | ||
| 3679 | int rest_width = (parent_width | ||
| 3680 | - FRAME_TEXT_WIDTH (f) | ||
| 3681 | - outer_minus_text_width); | ||
| 3682 | |||
| 3683 | if (p) | ||
| 3684 | return (rest_width <= 0 ? 0 : d_val * rest_width); | ||
| 3685 | else | ||
| 3686 | return (rest_width <= 0 | ||
| 3687 | ? parent_left | ||
| 3688 | : parent_left + d_val * rest_width); | ||
| 3689 | } | ||
| 3690 | case FRAME_FLOAT_TOP: | ||
| 3691 | { | ||
| 3692 | int rest_height = (parent_height | ||
| 3693 | - FRAME_TEXT_HEIGHT (f) | ||
| 3694 | - outer_minus_text_height); | ||
| 3695 | |||
| 3696 | if (p) | ||
| 3697 | return (rest_height <= 0 ? 0 : d_val * rest_height); | ||
| 3698 | else | ||
| 3699 | return (rest_height <= 0 | ||
| 3700 | ? parent_top | ||
| 3701 | : parent_top + d_val * rest_height); | ||
| 3702 | } | ||
| 3703 | default: | ||
| 3704 | emacs_abort (); | ||
| 3705 | } | ||
| 3706 | } | ||
| 3707 | } | ||
| 3708 | |||
| 3296 | /* Change the parameters of frame F as specified by ALIST. | 3709 | /* Change the parameters of frame F as specified by ALIST. |
| 3297 | If a parameter is not specially recognized, do nothing special; | 3710 | If a parameter is not specially recognized, do nothing special; |
| 3298 | otherwise call the `x_set_...' function for that parameter. | 3711 | otherwise call the `x_set_...' function for that parameter. |
| @@ -3302,7 +3715,8 @@ static const struct frame_parm_table frame_parms[] = | |||
| 3302 | void | 3715 | void |
| 3303 | x_set_frame_parameters (struct frame *f, Lisp_Object alist) | 3716 | x_set_frame_parameters (struct frame *f, Lisp_Object alist) |
| 3304 | { | 3717 | { |
| 3305 | Lisp_Object tail; | 3718 | Lisp_Object tail, frame; |
| 3719 | |||
| 3306 | 3720 | ||
| 3307 | /* If both of these parameters are present, it's more efficient to | 3721 | /* If both of these parameters are present, it's more efficient to |
| 3308 | set them both at once. So we wait until we've looked at the | 3722 | set them both at once. So we wait until we've looked at the |
| @@ -3327,7 +3741,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) | |||
| 3327 | #ifdef HAVE_X_WINDOWS | 3741 | #ifdef HAVE_X_WINDOWS |
| 3328 | bool icon_left_no_change = 0, icon_top_no_change = 0; | 3742 | bool icon_left_no_change = 0, icon_top_no_change = 0; |
| 3329 | #endif | 3743 | #endif |
| 3744 | int parent_done = -1, outer_done = -1; | ||
| 3330 | 3745 | ||
| 3746 | XSETFRAME (frame, f); | ||
| 3331 | for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail)) | 3747 | for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail)) |
| 3332 | size++; | 3748 | size++; |
| 3333 | CHECK_LIST_END (tail, alist); | 3749 | CHECK_LIST_END (tail, alist); |
| @@ -3388,6 +3804,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) | |||
| 3388 | else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) | 3804 | else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) |
| 3389 | && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) | 3805 | && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) |
| 3390 | width = XFASTINT (XCDR (val)); | 3806 | width = XFASTINT (XCDR (val)); |
| 3807 | else if (FLOATP (val)) | ||
| 3808 | width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done, | ||
| 3809 | &outer_done, -1); | ||
| 3391 | } | 3810 | } |
| 3392 | else if (EQ (prop, Qheight)) | 3811 | else if (EQ (prop, Qheight)) |
| 3393 | { | 3812 | { |
| @@ -3396,6 +3815,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) | |||
| 3396 | else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) | 3815 | else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels) |
| 3397 | && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) | 3816 | && RANGED_INTEGERP (0, XCDR (val), INT_MAX)) |
| 3398 | height = XFASTINT (XCDR (val)); | 3817 | height = XFASTINT (XCDR (val)); |
| 3818 | else if (FLOATP (val)) | ||
| 3819 | height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done, | ||
| 3820 | &outer_done, -1); | ||
| 3399 | } | 3821 | } |
| 3400 | else if (EQ (prop, Qtop)) | 3822 | else if (EQ (prop, Qtop)) |
| 3401 | top = val; | 3823 | top = val; |
| @@ -3472,105 +3894,100 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) | |||
| 3472 | Don't set these parameters unless they actually differ from the | 3894 | Don't set these parameters unless they actually differ from the |
| 3473 | window's current parameters; the window may not actually exist | 3895 | window's current parameters; the window may not actually exist |
| 3474 | yet. */ | 3896 | yet. */ |
| 3475 | { | 3897 | if ((width != -1 && width != FRAME_TEXT_WIDTH (f)) |
| 3476 | Lisp_Object frame; | 3898 | || (height != -1 && height != FRAME_TEXT_HEIGHT (f))) |
| 3477 | 3899 | /* We could consider checking f->after_make_frame here, but I | |
| 3478 | XSETFRAME (frame, f); | 3900 | don't have the faintest idea why the following is needed at |
| 3479 | 3901 | all. With the old setting it can get a Heisenbug when | |
| 3480 | if ((width != -1 && width != FRAME_TEXT_WIDTH (f)) | 3902 | EmacsFrameResize intermittently provokes a delayed |
| 3481 | || (height != -1 && height != FRAME_TEXT_HEIGHT (f))) | 3903 | change_frame_size in the middle of adjust_frame_size. */ |
| 3482 | /* We could consider checking f->after_make_frame here, but I | 3904 | /** || (f->can_x_set_window_size && (f->new_height || f->new_width))) **/ |
| 3483 | don't have the faintest idea why the following is needed at | 3905 | adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters); |
| 3484 | all. With the old setting it can get a Heisenbug when | 3906 | |
| 3485 | EmacsFrameResize intermittently provokes a delayed | 3907 | if ((!NILP (left) || !NILP (top)) |
| 3486 | change_frame_size in the middle of adjust_frame_size. */ | 3908 | && ! (left_no_change && top_no_change) |
| 3487 | /** || (f->can_x_set_window_size && (f->new_height || f->new_width))) **/ | 3909 | && ! (NUMBERP (left) && XINT (left) == f->left_pos |
| 3488 | adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters); | 3910 | && NUMBERP (top) && XINT (top) == f->top_pos)) |
| 3489 | 3911 | { | |
| 3490 | if ((!NILP (left) || !NILP (top)) | 3912 | int leftpos = 0; |
| 3491 | && ! (left_no_change && top_no_change) | 3913 | int toppos = 0; |
| 3492 | && ! (NUMBERP (left) && XINT (left) == f->left_pos | ||
| 3493 | && NUMBERP (top) && XINT (top) == f->top_pos)) | ||
| 3494 | { | ||
| 3495 | int leftpos = 0; | ||
| 3496 | int toppos = 0; | ||
| 3497 | 3914 | ||
| 3498 | /* Record the signs. */ | 3915 | /* Record the signs. */ |
| 3499 | f->size_hint_flags &= ~ (XNegative | YNegative); | 3916 | f->size_hint_flags &= ~ (XNegative | YNegative); |
| 3500 | if (EQ (left, Qminus)) | 3917 | if (EQ (left, Qminus)) |
| 3501 | f->size_hint_flags |= XNegative; | 3918 | f->size_hint_flags |= XNegative; |
| 3502 | else if (TYPE_RANGED_INTEGERP (int, left)) | 3919 | else if (TYPE_RANGED_INTEGERP (int, left)) |
| 3503 | { | 3920 | { |
| 3504 | leftpos = XINT (left); | 3921 | leftpos = XINT (left); |
| 3505 | if (leftpos < 0) | 3922 | if (leftpos < 0) |
| 3506 | f->size_hint_flags |= XNegative; | ||
| 3507 | } | ||
| 3508 | else if (CONSP (left) && EQ (XCAR (left), Qminus) | ||
| 3509 | && CONSP (XCDR (left)) | ||
| 3510 | && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) | ||
| 3511 | { | ||
| 3512 | leftpos = - XINT (XCAR (XCDR (left))); | ||
| 3513 | f->size_hint_flags |= XNegative; | 3923 | f->size_hint_flags |= XNegative; |
| 3514 | } | 3924 | } |
| 3515 | else if (CONSP (left) && EQ (XCAR (left), Qplus) | 3925 | else if (CONSP (left) && EQ (XCAR (left), Qminus) |
| 3516 | && CONSP (XCDR (left)) | 3926 | && CONSP (XCDR (left)) |
| 3517 | && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left)))) | 3927 | && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX)) |
| 3518 | { | 3928 | { |
| 3519 | leftpos = XINT (XCAR (XCDR (left))); | 3929 | leftpos = - XINT (XCAR (XCDR (left))); |
| 3520 | } | 3930 | f->size_hint_flags |= XNegative; |
| 3931 | } | ||
| 3932 | else if (CONSP (left) && EQ (XCAR (left), Qplus) | ||
| 3933 | && CONSP (XCDR (left)) | ||
| 3934 | && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left)))) | ||
| 3935 | leftpos = XINT (XCAR (XCDR (left))); | ||
| 3936 | else if (FLOATP (left)) | ||
| 3937 | leftpos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done, | ||
| 3938 | &outer_done, 0); | ||
| 3521 | 3939 | ||
| 3522 | if (EQ (top, Qminus)) | 3940 | if (EQ (top, Qminus)) |
| 3523 | f->size_hint_flags |= YNegative; | 3941 | f->size_hint_flags |= YNegative; |
| 3524 | else if (TYPE_RANGED_INTEGERP (int, top)) | 3942 | else if (TYPE_RANGED_INTEGERP (int, top)) |
| 3525 | { | 3943 | { |
| 3526 | toppos = XINT (top); | 3944 | toppos = XINT (top); |
| 3527 | if (toppos < 0) | 3945 | if (toppos < 0) |
| 3528 | f->size_hint_flags |= YNegative; | ||
| 3529 | } | ||
| 3530 | else if (CONSP (top) && EQ (XCAR (top), Qminus) | ||
| 3531 | && CONSP (XCDR (top)) | ||
| 3532 | && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) | ||
| 3533 | { | ||
| 3534 | toppos = - XINT (XCAR (XCDR (top))); | ||
| 3535 | f->size_hint_flags |= YNegative; | 3946 | f->size_hint_flags |= YNegative; |
| 3536 | } | 3947 | } |
| 3537 | else if (CONSP (top) && EQ (XCAR (top), Qplus) | 3948 | else if (CONSP (top) && EQ (XCAR (top), Qminus) |
| 3538 | && CONSP (XCDR (top)) | 3949 | && CONSP (XCDR (top)) |
| 3539 | && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top)))) | 3950 | && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX)) |
| 3540 | { | 3951 | { |
| 3541 | toppos = XINT (XCAR (XCDR (top))); | 3952 | toppos = - XINT (XCAR (XCDR (top))); |
| 3542 | } | 3953 | f->size_hint_flags |= YNegative; |
| 3543 | 3954 | } | |
| 3955 | else if (CONSP (top) && EQ (XCAR (top), Qplus) | ||
| 3956 | && CONSP (XCDR (top)) | ||
| 3957 | && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top)))) | ||
| 3958 | toppos = XINT (XCAR (XCDR (top))); | ||
| 3959 | else if (FLOATP (top)) | ||
| 3960 | toppos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done, | ||
| 3961 | &outer_done, 0); | ||
| 3544 | 3962 | ||
| 3545 | /* Store the numeric value of the position. */ | 3963 | /* Store the numeric value of the position. */ |
| 3546 | f->top_pos = toppos; | 3964 | f->top_pos = toppos; |
| 3547 | f->left_pos = leftpos; | 3965 | f->left_pos = leftpos; |
| 3548 | 3966 | ||
| 3549 | f->win_gravity = NorthWestGravity; | 3967 | f->win_gravity = NorthWestGravity; |
| 3550 | 3968 | ||
| 3551 | /* Actually set that position, and convert to absolute. */ | 3969 | /* Actually set that position, and convert to absolute. */ |
| 3552 | x_set_offset (f, leftpos, toppos, -1); | 3970 | x_set_offset (f, leftpos, toppos, -1); |
| 3553 | } | 3971 | } |
| 3554 | 3972 | ||
| 3555 | if (fullscreen_change) | 3973 | if (fullscreen_change) |
| 3556 | { | 3974 | { |
| 3557 | Lisp_Object old_value = get_frame_param (f, Qfullscreen); | 3975 | Lisp_Object old_value = get_frame_param (f, Qfullscreen); |
| 3558 | 3976 | ||
| 3559 | frame_size_history_add | 3977 | frame_size_history_add |
| 3560 | (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen)); | 3978 | (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen)); |
| 3561 | 3979 | ||
| 3562 | store_frame_param (f, Qfullscreen, fullscreen); | 3980 | store_frame_param (f, Qfullscreen, fullscreen); |
| 3563 | if (!EQ (fullscreen, old_value)) | 3981 | if (!EQ (fullscreen, old_value)) |
| 3564 | x_set_fullscreen (f, fullscreen, old_value); | 3982 | x_set_fullscreen (f, fullscreen, old_value); |
| 3565 | } | 3983 | } |
| 3566 | 3984 | ||
| 3567 | 3985 | ||
| 3568 | #ifdef HAVE_X_WINDOWS | 3986 | #ifdef HAVE_X_WINDOWS |
| 3569 | if ((!NILP (icon_left) || !NILP (icon_top)) | 3987 | if ((!NILP (icon_left) || !NILP (icon_top)) |
| 3570 | && ! (icon_left_no_change && icon_top_no_change)) | 3988 | && ! (icon_left_no_change && icon_top_no_change)) |
| 3571 | x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top)); | 3989 | x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top)); |
| 3572 | #endif /* HAVE_X_WINDOWS */ | 3990 | #endif /* HAVE_X_WINDOWS */ |
| 3573 | } | ||
| 3574 | 3991 | ||
| 3575 | SAFE_FREE (); | 3992 | SAFE_FREE (); |
| 3576 | } | 3993 | } |
| @@ -3990,7 +4407,6 @@ x_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) | |||
| 3990 | adjust_frame_glyphs (f); | 4407 | adjust_frame_glyphs (f); |
| 3991 | SET_FRAME_GARBAGED (f); | 4408 | SET_FRAME_GARBAGED (f); |
| 3992 | } | 4409 | } |
| 3993 | |||
| 3994 | } | 4410 | } |
| 3995 | 4411 | ||
| 3996 | void | 4412 | void |
| @@ -4204,6 +4620,22 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) | |||
| 4204 | return; | 4620 | return; |
| 4205 | } | 4621 | } |
| 4206 | 4622 | ||
| 4623 | |||
| 4624 | /** | ||
| 4625 | * x_set_no_special_glyphs: | ||
| 4626 | * | ||
| 4627 | * Set frame F's `no-special-glyphs' parameter which, if non-nil, | ||
| 4628 | * suppresses the display of truncation and continuation glyphs | ||
| 4629 | * outside fringes. | ||
| 4630 | */ | ||
| 4631 | void | ||
| 4632 | x_set_no_special_glyphs (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) | ||
| 4633 | { | ||
| 4634 | if (!EQ (new_value, old_value)) | ||
| 4635 | FRAME_NO_SPECIAL_GLYPHS (f) = !NILP (new_value); | ||
| 4636 | } | ||
| 4637 | |||
| 4638 | |||
| 4207 | #ifndef HAVE_NS | 4639 | #ifndef HAVE_NS |
| 4208 | 4640 | ||
| 4209 | /* Non-zero if mouse is grabbed on DPYINFO | 4641 | /* Non-zero if mouse is grabbed on DPYINFO |
| @@ -4759,6 +5191,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x | |||
| 4759 | Lisp_Object height, width, user_size, top, left, user_position; | 5191 | Lisp_Object height, width, user_size, top, left, user_position; |
| 4760 | long window_prompting = 0; | 5192 | long window_prompting = 0; |
| 4761 | Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); | 5193 | Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); |
| 5194 | int parent_done = -1, outer_done = -1; | ||
| 4762 | 5195 | ||
| 4763 | /* Default values if we fall through. | 5196 | /* Default values if we fall through. |
| 4764 | Actually, if that happens we should get | 5197 | Actually, if that happens we should get |
| @@ -4823,6 +5256,21 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x | |||
| 4823 | f->inhibit_horizontal_resize = true; | 5256 | f->inhibit_horizontal_resize = true; |
| 4824 | *x_width = XINT (XCDR (width)); | 5257 | *x_width = XINT (XCDR (width)); |
| 4825 | } | 5258 | } |
| 5259 | else if (FLOATP (width)) | ||
| 5260 | { | ||
| 5261 | double d_width = XFLOAT_DATA (width); | ||
| 5262 | |||
| 5263 | if (d_width < 0.0 || d_width > 1.0) | ||
| 5264 | xsignal1 (Qargs_out_of_range, width); | ||
| 5265 | else | ||
| 5266 | { | ||
| 5267 | int new_width = frame_float (f, width, FRAME_FLOAT_WIDTH, | ||
| 5268 | &parent_done, &outer_done, -1); | ||
| 5269 | |||
| 5270 | if (new_width > -1) | ||
| 5271 | SET_FRAME_WIDTH (f, new_width); | ||
| 5272 | } | ||
| 5273 | } | ||
| 4826 | else | 5274 | else |
| 4827 | { | 5275 | { |
| 4828 | CHECK_NUMBER (width); | 5276 | CHECK_NUMBER (width); |
| @@ -4845,6 +5293,21 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x | |||
| 4845 | f->inhibit_vertical_resize = true; | 5293 | f->inhibit_vertical_resize = true; |
| 4846 | *x_height = XINT (XCDR (height)); | 5294 | *x_height = XINT (XCDR (height)); |
| 4847 | } | 5295 | } |
| 5296 | else if (FLOATP (height)) | ||
| 5297 | { | ||
| 5298 | double d_height = XFLOAT_DATA (height); | ||
| 5299 | |||
| 5300 | if (d_height < 0.0 || d_height > 1.0) | ||
| 5301 | xsignal1 (Qargs_out_of_range, height); | ||
| 5302 | else | ||
| 5303 | { | ||
| 5304 | int new_height = frame_float (f, height, FRAME_FLOAT_HEIGHT, | ||
| 5305 | &parent_done, &outer_done, -1); | ||
| 5306 | |||
| 5307 | if (new_height > -1) | ||
| 5308 | SET_FRAME_HEIGHT (f, new_height); | ||
| 5309 | } | ||
| 5310 | } | ||
| 4848 | else | 5311 | else |
| 4849 | { | 5312 | { |
| 4850 | CHECK_NUMBER (height); | 5313 | CHECK_NUMBER (height); |
| @@ -4885,6 +5348,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x | |||
| 4885 | { | 5348 | { |
| 4886 | f->top_pos = XINT (XCAR (XCDR (top))); | 5349 | f->top_pos = XINT (XCAR (XCDR (top))); |
| 4887 | } | 5350 | } |
| 5351 | else if (FLOATP (top)) | ||
| 5352 | f->top_pos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done, | ||
| 5353 | &outer_done, 0); | ||
| 4888 | else if (EQ (top, Qunbound)) | 5354 | else if (EQ (top, Qunbound)) |
| 4889 | f->top_pos = 0; | 5355 | f->top_pos = 0; |
| 4890 | else | 5356 | else |
| @@ -4913,6 +5379,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x | |||
| 4913 | { | 5379 | { |
| 4914 | f->left_pos = XINT (XCAR (XCDR (left))); | 5380 | f->left_pos = XINT (XCAR (XCDR (left))); |
| 4915 | } | 5381 | } |
| 5382 | else if (FLOATP (left)) | ||
| 5383 | f->left_pos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done, | ||
| 5384 | &outer_done, 0); | ||
| 4916 | else if (EQ (left, Qunbound)) | 5385 | else if (EQ (left, Qunbound)) |
| 4917 | f->left_pos = 0; | 5386 | f->left_pos = 0; |
| 4918 | else | 5387 | else |
| @@ -5071,12 +5540,14 @@ syms_of_frame (void) | |||
| 5071 | DEFSYM (Qframep, "framep"); | 5540 | DEFSYM (Qframep, "framep"); |
| 5072 | DEFSYM (Qframe_live_p, "frame-live-p"); | 5541 | DEFSYM (Qframe_live_p, "frame-live-p"); |
| 5073 | DEFSYM (Qframe_windows_min_size, "frame-windows-min-size"); | 5542 | DEFSYM (Qframe_windows_min_size, "frame-windows-min-size"); |
| 5543 | DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list"); | ||
| 5074 | DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total"); | 5544 | DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total"); |
| 5075 | DEFSYM (Qexplicit_name, "explicit-name"); | 5545 | DEFSYM (Qexplicit_name, "explicit-name"); |
| 5076 | DEFSYM (Qheight, "height"); | 5546 | DEFSYM (Qheight, "height"); |
| 5077 | DEFSYM (Qicon, "icon"); | 5547 | DEFSYM (Qicon, "icon"); |
| 5078 | DEFSYM (Qminibuffer, "minibuffer"); | 5548 | DEFSYM (Qminibuffer, "minibuffer"); |
| 5079 | DEFSYM (Qundecorated, "undecorated"); | 5549 | DEFSYM (Qundecorated, "undecorated"); |
| 5550 | DEFSYM (Qno_special_glyphs, "no-special-glyphs"); | ||
| 5080 | DEFSYM (Qparent_frame, "parent-frame"); | 5551 | DEFSYM (Qparent_frame, "parent-frame"); |
| 5081 | DEFSYM (Qskip_taskbar, "skip-taskbar"); | 5552 | DEFSYM (Qskip_taskbar, "skip-taskbar"); |
| 5082 | DEFSYM (Qno_focus_on_map, "no-focus-on-map"); | 5553 | DEFSYM (Qno_focus_on_map, "no-focus-on-map"); |
| @@ -5129,6 +5600,7 @@ syms_of_frame (void) | |||
| 5129 | DEFSYM (Qframes, "frames"); | 5600 | DEFSYM (Qframes, "frames"); |
| 5130 | DEFSYM (Qsource, "source"); | 5601 | DEFSYM (Qsource, "source"); |
| 5131 | 5602 | ||
| 5603 | DEFSYM (Qframe_edges, "frame-edges"); | ||
| 5132 | DEFSYM (Qouter_edges, "outer-edges"); | 5604 | DEFSYM (Qouter_edges, "outer-edges"); |
| 5133 | DEFSYM (Qouter_position, "outer-position"); | 5605 | DEFSYM (Qouter_position, "outer-position"); |
| 5134 | DEFSYM (Qouter_size, "outer-size"); | 5606 | DEFSYM (Qouter_size, "outer-size"); |
| @@ -5220,6 +5692,11 @@ syms_of_frame (void) | |||
| 5220 | DEFSYM (Qmin_width, "min-width"); | 5692 | DEFSYM (Qmin_width, "min-width"); |
| 5221 | DEFSYM (Qmin_height, "min-height"); | 5693 | DEFSYM (Qmin_height, "min-height"); |
| 5222 | DEFSYM (Qmouse_wheel_frame, "mouse-wheel-frame"); | 5694 | DEFSYM (Qmouse_wheel_frame, "mouse-wheel-frame"); |
| 5695 | DEFSYM (Qkeep_ratio, "keep-ratio"); | ||
| 5696 | DEFSYM (Qwidth_only, "width-only"); | ||
| 5697 | DEFSYM (Qheight_only, "height-only"); | ||
| 5698 | DEFSYM (Qleft_only, "left-only"); | ||
| 5699 | DEFSYM (Qtop_only, "top-only"); | ||
| 5223 | 5700 | ||
| 5224 | { | 5701 | { |
| 5225 | int i; | 5702 | int i; |
| @@ -5564,8 +6041,8 @@ Gtk+ tooltips are not used) and on Windows. */); | |||
| 5564 | defsubr (&Smodify_frame_parameters); | 6041 | defsubr (&Smodify_frame_parameters); |
| 5565 | defsubr (&Sframe_char_height); | 6042 | defsubr (&Sframe_char_height); |
| 5566 | defsubr (&Sframe_char_width); | 6043 | defsubr (&Sframe_char_width); |
| 5567 | defsubr (&Sframe_pixel_height); | 6044 | defsubr (&Sframe_native_height); |
| 5568 | defsubr (&Sframe_pixel_width); | 6045 | defsubr (&Sframe_native_width); |
| 5569 | defsubr (&Sframe_text_cols); | 6046 | defsubr (&Sframe_text_cols); |
| 5570 | defsubr (&Sframe_text_lines); | 6047 | defsubr (&Sframe_text_lines); |
| 5571 | defsubr (&Sframe_total_cols); | 6048 | defsubr (&Sframe_total_cols); |
| @@ -5575,7 +6052,7 @@ Gtk+ tooltips are not used) and on Windows. */); | |||
| 5575 | defsubr (&Sscroll_bar_width); | 6052 | defsubr (&Sscroll_bar_width); |
| 5576 | defsubr (&Sscroll_bar_height); | 6053 | defsubr (&Sscroll_bar_height); |
| 5577 | defsubr (&Sfringe_width); | 6054 | defsubr (&Sfringe_width); |
| 5578 | defsubr (&Sborder_width); | 6055 | defsubr (&Sframe_internal_border_width); |
| 5579 | defsubr (&Sright_divider_width); | 6056 | defsubr (&Sright_divider_width); |
| 5580 | defsubr (&Sbottom_divider_width); | 6057 | defsubr (&Sbottom_divider_width); |
| 5581 | defsubr (&Stool_bar_pixel_width); | 6058 | defsubr (&Stool_bar_pixel_width); |
diff --git a/src/frame.h b/src/frame.h index 4aa7c34a29a..154dc9a3bb4 100644 --- a/src/frame.h +++ b/src/frame.h | |||
| @@ -52,6 +52,19 @@ enum z_group | |||
| 52 | z_group_below, | 52 | z_group_below, |
| 53 | z_group_above_suspended, | 53 | z_group_above_suspended, |
| 54 | }; | 54 | }; |
| 55 | |||
| 56 | enum internal_border_part | ||
| 57 | { | ||
| 58 | INTERNAL_BORDER_NONE, | ||
| 59 | INTERNAL_BORDER_LEFT_EDGE, | ||
| 60 | INTERNAL_BORDER_TOP_LEFT_CORNER, | ||
| 61 | INTERNAL_BORDER_TOP_EDGE, | ||
| 62 | INTERNAL_BORDER_TOP_RIGHT_CORNER, | ||
| 63 | INTERNAL_BORDER_RIGHT_EDGE, | ||
| 64 | INTERNAL_BORDER_BOTTOM_RIGHT_CORNER, | ||
| 65 | INTERNAL_BORDER_BOTTOM_EDGE, | ||
| 66 | INTERNAL_BORDER_BOTTOM_LEFT_CORNER, | ||
| 67 | }; | ||
| 55 | #endif /* HAVE_WINDOW_SYSTEM */ | 68 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 56 | 69 | ||
| 57 | /* The structure representing a frame. */ | 70 | /* The structure representing a frame. */ |
| @@ -354,7 +367,11 @@ struct frame | |||
| 354 | 367 | ||
| 355 | /* The z-group this frame's window belongs to. */ | 368 | /* The z-group this frame's window belongs to. */ |
| 356 | ENUM_BF (z_group) z_group : 2; | 369 | ENUM_BF (z_group) z_group : 2; |
| 357 | #endif /* HAVE_WINDOW_SYSTEM and not HAVE_NS */ | 370 | |
| 371 | /* Non-zero if display of truncation and continuation glyphs outside | ||
| 372 | the fringes is suppressed. */ | ||
| 373 | bool_bf no_special_glyphs : 1; | ||
| 374 | #endif /* HAVE_WINDOW_SYSTEM */ | ||
| 358 | 375 | ||
| 359 | /* Whether new_height and new_width shall be interpreted | 376 | /* Whether new_height and new_width shall be interpreted |
| 360 | in pixels. */ | 377 | in pixels. */ |
| @@ -824,7 +841,7 @@ default_pixels_per_inch_y (void) | |||
| 824 | #ifdef USE_GTK | 841 | #ifdef USE_GTK |
| 825 | #define FRAME_TOOL_BAR_POSITION(f) (f)->tool_bar_position | 842 | #define FRAME_TOOL_BAR_POSITION(f) (f)->tool_bar_position |
| 826 | #else | 843 | #else |
| 827 | #define FRAME_TOOL_BAR_POSITION(f) ((void) f, Qtop) | 844 | #define FRAME_TOOL_BAR_POSITION(f) ((void) (f), Qtop) |
| 828 | #endif | 845 | #endif |
| 829 | 846 | ||
| 830 | /* Number of lines of frame F used for the tool-bar. */ | 847 | /* Number of lines of frame F used for the tool-bar. */ |
| @@ -908,16 +925,17 @@ default_pixels_per_inch_y (void) | |||
| 908 | ((f)->vertical_scroll_bar_type == vertical_scroll_bar_right) | 925 | ((f)->vertical_scroll_bar_type == vertical_scroll_bar_right) |
| 909 | #else /* not HAVE_WINDOW_SYSTEM */ | 926 | #else /* not HAVE_WINDOW_SYSTEM */ |
| 910 | /* If there is no window system, there are no scroll bars. */ | 927 | /* If there is no window system, there are no scroll bars. */ |
| 911 | #define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) ((void) f, vertical_scroll_bar_none) | 928 | #define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) \ |
| 912 | #define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) f, 0) | 929 | ((void) (f), vertical_scroll_bar_none) |
| 913 | #define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) f, 0) | 930 | #define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) (f), 0) |
| 914 | #define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) f, 0) | 931 | #define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) (f), 0) |
| 932 | #define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) (f), 0) | ||
| 915 | #endif /* HAVE_WINDOW_SYSTEM */ | 933 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 916 | 934 | ||
| 917 | #if defined (HAVE_WINDOW_SYSTEM) | 935 | #if defined (HAVE_WINDOW_SYSTEM) |
| 918 | #define FRAME_UNDECORATED(f) ((f)->undecorated) | 936 | #define FRAME_UNDECORATED(f) ((f)->undecorated) |
| 919 | #ifdef HAVE_NTGUI | 937 | #ifdef HAVE_NTGUI |
| 920 | #define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0) | 938 | #define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0) |
| 921 | #else | 939 | #else |
| 922 | #define FRAME_OVERRIDE_REDIRECT(f) ((f)->override_redirect) | 940 | #define FRAME_OVERRIDE_REDIRECT(f) ((f)->override_redirect) |
| 923 | #endif | 941 | #endif |
| @@ -928,6 +946,7 @@ default_pixels_per_inch_y (void) | |||
| 928 | #define FRAME_SKIP_TASKBAR(f) ((f)->skip_taskbar) | 946 | #define FRAME_SKIP_TASKBAR(f) ((f)->skip_taskbar) |
| 929 | #define FRAME_NO_FOCUS_ON_MAP(f) ((f)->no_focus_on_map) | 947 | #define FRAME_NO_FOCUS_ON_MAP(f) ((f)->no_focus_on_map) |
| 930 | #define FRAME_NO_ACCEPT_FOCUS(f) ((f)->no_accept_focus) | 948 | #define FRAME_NO_ACCEPT_FOCUS(f) ((f)->no_accept_focus) |
| 949 | #define FRAME_NO_SPECIAL_GLYPHS(f) ((f)->no_special_glyphs) | ||
| 931 | #define FRAME_Z_GROUP(f) ((f)->z_group) | 950 | #define FRAME_Z_GROUP(f) ((f)->z_group) |
| 932 | #define FRAME_Z_GROUP_NONE(f) ((f)->z_group == z_group_none) | 951 | #define FRAME_Z_GROUP_NONE(f) ((f)->z_group == z_group_none) |
| 933 | #define FRAME_Z_GROUP_ABOVE(f) ((f)->z_group == z_group_above) | 952 | #define FRAME_Z_GROUP_ABOVE(f) ((f)->z_group == z_group_above) |
| @@ -935,16 +954,17 @@ default_pixels_per_inch_y (void) | |||
| 935 | ((f)->z_group == z_group_above_suspended) | 954 | ((f)->z_group == z_group_above_suspended) |
| 936 | #define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below) | 955 | #define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below) |
| 937 | #else /* not HAVE_WINDOW_SYSTEM */ | 956 | #else /* not HAVE_WINDOW_SYSTEM */ |
| 938 | #define FRAME_UNDECORATED(f) ((void) f, 0) | 957 | #define FRAME_UNDECORATED(f) ((void) (f), 0) |
| 939 | #define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0) | 958 | #define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0) |
| 940 | #define FRAME_PARENT_FRAME(f) ((void) f, NULL) | 959 | #define FRAME_PARENT_FRAME(f) ((void) (f), NULL) |
| 941 | #define FRAME_SKIP_TASKBAR(f) ((void) f, 0) | 960 | #define FRAME_SKIP_TASKBAR(f) ((void) (f), 0) |
| 942 | #define FRAME_NO_FOCUS_ON_MAP(f) ((void) f, 0) | 961 | #define FRAME_NO_FOCUS_ON_MAP(f) ((void) (f), 0) |
| 943 | #define FRAME_NO_ACCEPT_FOCUS(f) ((void) f, 0) | 962 | #define FRAME_NO_ACCEPT_FOCUS(f) ((void) (f), 0) |
| 944 | #define FRAME_Z_GROUP(f) ((void) f, z_group_none) | 963 | #define FRAME_NO_SPECIAL_GLYPHS(f) ((void) (f), 0) |
| 945 | #define FRAME_Z_GROUP_NONE(f) ((void) f, true) | 964 | #define FRAME_Z_GROUP(f) ((void) (f), z_group_none) |
| 946 | #define FRAME_Z_GROUP_ABOVE(f) ((void) f, false) | 965 | #define FRAME_Z_GROUP_NONE(f) ((void) (f), true) |
| 947 | #define FRAME_Z_GROUP_BELOW(f) ((void) f, false) | 966 | #define FRAME_Z_GROUP_ABOVE(f) ((void) (f), false) |
| 967 | #define FRAME_Z_GROUP_BELOW(f) ((void) (f), false) | ||
| 948 | #endif /* HAVE_WINDOW_SYSTEM */ | 968 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 949 | 969 | ||
| 950 | /* Whether horizontal scroll bars are currently enabled for frame F. */ | 970 | /* Whether horizontal scroll bars are currently enabled for frame F. */ |
| @@ -952,7 +972,7 @@ default_pixels_per_inch_y (void) | |||
| 952 | #define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) \ | 972 | #define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) \ |
| 953 | ((f)->horizontal_scroll_bars) | 973 | ((f)->horizontal_scroll_bars) |
| 954 | #else | 974 | #else |
| 955 | #define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) f, 0) | 975 | #define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) (f), 0) |
| 956 | #endif | 976 | #endif |
| 957 | 977 | ||
| 958 | /* Width that a scroll bar in frame F should have, if there is one. | 978 | /* Width that a scroll bar in frame F should have, if there is one. |
| @@ -1288,19 +1308,20 @@ FRAME_TOTAL_FRINGE_WIDTH (struct frame *f) | |||
| 1288 | return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f); | 1308 | return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f); |
| 1289 | } | 1309 | } |
| 1290 | 1310 | ||
| 1291 | /* Pixel-width of internal border lines */ | 1311 | /* Pixel-width of internal border lines. */ |
| 1292 | INLINE int | 1312 | INLINE int |
| 1293 | FRAME_INTERNAL_BORDER_WIDTH (struct frame *f) | 1313 | FRAME_INTERNAL_BORDER_WIDTH (struct frame *f) |
| 1294 | { | 1314 | { |
| 1295 | return frame_dimension (f->internal_border_width); | 1315 | return frame_dimension (f->internal_border_width); |
| 1296 | } | 1316 | } |
| 1297 | 1317 | ||
| 1298 | /* Pixel-size of window divider lines */ | 1318 | /* Pixel-size of window divider lines. */ |
| 1299 | INLINE int | 1319 | INLINE int |
| 1300 | FRAME_RIGHT_DIVIDER_WIDTH (struct frame *f) | 1320 | FRAME_RIGHT_DIVIDER_WIDTH (struct frame *f) |
| 1301 | { | 1321 | { |
| 1302 | return frame_dimension (f->right_divider_width); | 1322 | return frame_dimension (f->right_divider_width); |
| 1303 | } | 1323 | } |
| 1324 | |||
| 1304 | INLINE int | 1325 | INLINE int |
| 1305 | FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) | 1326 | FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) |
| 1306 | { | 1327 | { |
| @@ -1498,6 +1519,7 @@ extern void x_set_scroll_bar_height (struct frame *, Lisp_Object, Lisp_Object); | |||
| 1498 | extern long x_figure_window_size (struct frame *, Lisp_Object, bool, int *, int *); | 1519 | extern long x_figure_window_size (struct frame *, Lisp_Object, bool, int *, int *); |
| 1499 | 1520 | ||
| 1500 | extern void x_set_alpha (struct frame *, Lisp_Object, Lisp_Object); | 1521 | extern void x_set_alpha (struct frame *, Lisp_Object, Lisp_Object); |
| 1522 | extern void x_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object); | ||
| 1501 | 1523 | ||
| 1502 | extern void validate_x_resource_name (void); | 1524 | extern void validate_x_resource_name (void); |
| 1503 | 1525 | ||
| @@ -1521,6 +1543,7 @@ extern void x_real_positions (struct frame *, int *, int *); | |||
| 1521 | extern void free_frame_menubar (struct frame *); | 1543 | extern void free_frame_menubar (struct frame *); |
| 1522 | extern void x_free_frame_resources (struct frame *); | 1544 | extern void x_free_frame_resources (struct frame *); |
| 1523 | extern bool frame_ancestor_p (struct frame *af, struct frame *df); | 1545 | extern bool frame_ancestor_p (struct frame *af, struct frame *df); |
| 1546 | extern enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y); | ||
| 1524 | 1547 | ||
| 1525 | #if defined HAVE_X_WINDOWS | 1548 | #if defined HAVE_X_WINDOWS |
| 1526 | extern void x_wm_set_icon_position (struct frame *, int, int); | 1549 | extern void x_wm_set_icon_position (struct frame *, int, int); |
diff --git a/src/gtkutil.c b/src/gtkutil.c index 16eb284d7c7..2d4abefa969 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c | |||
| @@ -1503,6 +1503,7 @@ xg_set_undecorated (struct frame *f, Lisp_Object undecorated) | |||
| 1503 | void | 1503 | void |
| 1504 | xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) | 1504 | xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) |
| 1505 | { | 1505 | { |
| 1506 | #if GTK_CHECK_VERSION (2, 18, 0) | ||
| 1506 | block_input (); | 1507 | block_input (); |
| 1507 | if (FRAME_GTK_OUTER_WIDGET (f1) && FRAME_GTK_OUTER_WIDGET (f2)) | 1508 | if (FRAME_GTK_OUTER_WIDGET (f1) && FRAME_GTK_OUTER_WIDGET (f2)) |
| 1508 | { | 1509 | { |
| @@ -1517,6 +1518,7 @@ xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) | |||
| 1517 | x_sync (f1); | 1518 | x_sync (f1); |
| 1518 | } | 1519 | } |
| 1519 | unblock_input (); | 1520 | unblock_input (); |
| 1521 | #endif | ||
| 1520 | } | 1522 | } |
| 1521 | 1523 | ||
| 1522 | 1524 | ||
diff --git a/src/image.c b/src/image.c index aedec7954ee..07c4769e9e3 100644 --- a/src/image.c +++ b/src/image.c | |||
| @@ -20,7 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 20 | #include <config.h> | 20 | #include <config.h> |
| 21 | 21 | ||
| 22 | #include <fcntl.h> | 22 | #include <fcntl.h> |
| 23 | #include <stdio.h> | ||
| 24 | #include <unistd.h> | 23 | #include <unistd.h> |
| 25 | 24 | ||
| 26 | /* Include this before including <setjmp.h> to work around bugs with | 25 | /* Include this before including <setjmp.h> to work around bugs with |
| @@ -41,6 +40,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 41 | #include "buffer.h" | 40 | #include "buffer.h" |
| 42 | #include "dispextern.h" | 41 | #include "dispextern.h" |
| 43 | #include "blockinput.h" | 42 | #include "blockinput.h" |
| 43 | #include "sysstdio.h" | ||
| 44 | #include "systime.h" | 44 | #include "systime.h" |
| 45 | #include <epaths.h> | 45 | #include <epaths.h> |
| 46 | #include "coding.h" | 46 | #include "coding.h" |
| @@ -2361,7 +2361,7 @@ slurp_file (int fd, ptrdiff_t *size) | |||
| 2361 | This can happen if the file grows as we read it. */ | 2361 | This can happen if the file grows as we read it. */ |
| 2362 | ptrdiff_t buflen = st.st_size; | 2362 | ptrdiff_t buflen = st.st_size; |
| 2363 | buf = xmalloc (buflen + 1); | 2363 | buf = xmalloc (buflen + 1); |
| 2364 | if (fread (buf, 1, buflen + 1, fp) == buflen) | 2364 | if (fread_unlocked (buf, 1, buflen + 1, fp) == buflen) |
| 2365 | *size = buflen; | 2365 | *size = buflen; |
| 2366 | else | 2366 | else |
| 2367 | { | 2367 | { |
| @@ -5890,7 +5890,7 @@ png_read_from_file (png_structp png_ptr, png_bytep data, png_size_t length) | |||
| 5890 | { | 5890 | { |
| 5891 | FILE *fp = png_get_io_ptr (png_ptr); | 5891 | FILE *fp = png_get_io_ptr (png_ptr); |
| 5892 | 5892 | ||
| 5893 | if (fread (data, 1, length, fp) < length) | 5893 | if (fread_unlocked (data, 1, length, fp) < length) |
| 5894 | png_error (png_ptr, "Read error"); | 5894 | png_error (png_ptr, "Read error"); |
| 5895 | } | 5895 | } |
| 5896 | 5896 | ||
| @@ -5959,7 +5959,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) | |||
| 5959 | } | 5959 | } |
| 5960 | 5960 | ||
| 5961 | /* Check PNG signature. */ | 5961 | /* Check PNG signature. */ |
| 5962 | if (fread (sig, 1, sizeof sig, fp) != sizeof sig | 5962 | if (fread_unlocked (sig, 1, sizeof sig, fp) != sizeof sig |
| 5963 | || png_sig_cmp (sig, 0, sizeof sig)) | 5963 | || png_sig_cmp (sig, 0, sizeof sig)) |
| 5964 | { | 5964 | { |
| 5965 | fclose (fp); | 5965 | fclose (fp); |
| @@ -6598,7 +6598,8 @@ our_stdio_fill_input_buffer (j_decompress_ptr cinfo) | |||
| 6598 | { | 6598 | { |
| 6599 | ptrdiff_t bytes; | 6599 | ptrdiff_t bytes; |
| 6600 | 6600 | ||
| 6601 | bytes = fread (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE, src->file); | 6601 | bytes = fread_unlocked (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE, |
| 6602 | src->file); | ||
| 6602 | if (bytes > 0) | 6603 | if (bytes > 0) |
| 6603 | src->mgr.bytes_in_buffer = bytes; | 6604 | src->mgr.bytes_in_buffer = bytes; |
| 6604 | else | 6605 | else |
diff --git a/src/intervals.h b/src/intervals.h index db91b3f21a0..a0da6f37801 100644 --- a/src/intervals.h +++ b/src/intervals.h | |||
| @@ -85,10 +85,10 @@ struct interval | |||
| 85 | #define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL) | 85 | #define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL) |
| 86 | 86 | ||
| 87 | /* True if this interval has no parent and is therefore the root. */ | 87 | /* True if this interval has no parent and is therefore the root. */ |
| 88 | #define ROOT_INTERVAL_P(i) (NULL_PARENT (i)) | 88 | #define ROOT_INTERVAL_P(i) NULL_PARENT (i) |
| 89 | 89 | ||
| 90 | /* True if this interval is the only interval in the interval tree. */ | 90 | /* True if this interval is the only interval in the interval tree. */ |
| 91 | #define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P ((i)) && LEAF_INTERVAL_P ((i))) | 91 | #define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P (i) && LEAF_INTERVAL_P (i)) |
| 92 | 92 | ||
| 93 | /* True if this interval has both left and right children. */ | 93 | /* True if this interval has both left and right children. */ |
| 94 | #define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL) | 94 | #define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL) |
| @@ -98,13 +98,13 @@ struct interval | |||
| 98 | #define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length) | 98 | #define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length) |
| 99 | 99 | ||
| 100 | /* The size of text represented by this interval alone. */ | 100 | /* The size of text represented by this interval alone. */ |
| 101 | #define LENGTH(i) ((i) == NULL ? 0 : (TOTAL_LENGTH ((i)) \ | 101 | #define LENGTH(i) ((i)->total_length \ |
| 102 | - TOTAL_LENGTH ((i)->right) \ | 102 | - TOTAL_LENGTH ((i)->right) \ |
| 103 | - TOTAL_LENGTH ((i)->left))) | 103 | - TOTAL_LENGTH ((i)->left)) |
| 104 | 104 | ||
| 105 | /* The position of the character just past the end of I. Note that | 105 | /* The position of the character just past the end of I. Note that |
| 106 | the position cache i->position must be valid for this to work. */ | 106 | the position cache i->position must be valid for this to work. */ |
| 107 | #define INTERVAL_LAST_POS(i) ((i)->position + LENGTH ((i))) | 107 | #define INTERVAL_LAST_POS(i) ((i)->position + LENGTH (i)) |
| 108 | 108 | ||
| 109 | /* The total size of the left subtree of this interval. */ | 109 | /* The total size of the left subtree of this interval. */ |
| 110 | #define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0) | 110 | #define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0) |
diff --git a/src/keyboard.c b/src/keyboard.c index 55486c6d9ab..9e90899c569 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -39,6 +39,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 39 | #include "intervals.h" | 39 | #include "intervals.h" |
| 40 | #include "keymap.h" | 40 | #include "keymap.h" |
| 41 | #include "blockinput.h" | 41 | #include "blockinput.h" |
| 42 | #include "sysstdio.h" | ||
| 42 | #include "systime.h" | 43 | #include "systime.h" |
| 43 | #include "atimer.h" | 44 | #include "atimer.h" |
| 44 | #include "process.h" | 45 | #include "process.h" |
| @@ -3290,7 +3291,7 @@ record_char (Lisp_Object c) | |||
| 3290 | if (INTEGERP (c)) | 3291 | if (INTEGERP (c)) |
| 3291 | { | 3292 | { |
| 3292 | if (XUINT (c) < 0x100) | 3293 | if (XUINT (c) < 0x100) |
| 3293 | putc (XUINT (c), dribble); | 3294 | putc_unlocked (XUINT (c), dribble); |
| 3294 | else | 3295 | else |
| 3295 | fprintf (dribble, " 0x%"pI"x", XUINT (c)); | 3296 | fprintf (dribble, " 0x%"pI"x", XUINT (c)); |
| 3296 | } | 3297 | } |
| @@ -3303,15 +3304,15 @@ record_char (Lisp_Object c) | |||
| 3303 | 3304 | ||
| 3304 | if (SYMBOLP (dribblee)) | 3305 | if (SYMBOLP (dribblee)) |
| 3305 | { | 3306 | { |
| 3306 | putc ('<', dribble); | 3307 | putc_unlocked ('<', dribble); |
| 3307 | fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char), | 3308 | fwrite_unlocked (SDATA (SYMBOL_NAME (dribblee)), sizeof (char), |
| 3308 | SBYTES (SYMBOL_NAME (dribblee)), | 3309 | SBYTES (SYMBOL_NAME (dribblee)), |
| 3309 | dribble); | 3310 | dribble); |
| 3310 | putc ('>', dribble); | 3311 | putc_unlocked ('>', dribble); |
| 3311 | } | 3312 | } |
| 3312 | } | 3313 | } |
| 3313 | 3314 | ||
| 3314 | fflush (dribble); | 3315 | fflush_unlocked (dribble); |
| 3315 | unblock_input (); | 3316 | unblock_input (); |
| 3316 | } | 3317 | } |
| 3317 | } | 3318 | } |
| @@ -3769,7 +3770,7 @@ kbd_buffer_get_event (KBOARD **kbp, | |||
| 3769 | detaching from the terminal. */ | 3770 | detaching from the terminal. */ |
| 3770 | || (IS_DAEMON && DAEMON_RUNNING)) | 3771 | || (IS_DAEMON && DAEMON_RUNNING)) |
| 3771 | { | 3772 | { |
| 3772 | int c = getchar (); | 3773 | int c = getchar_unlocked (); |
| 3773 | XSETINT (obj, c); | 3774 | XSETINT (obj, c); |
| 3774 | *kbp = current_kboard; | 3775 | *kbp = current_kboard; |
| 3775 | return obj; | 3776 | return obj; |
| @@ -5126,6 +5127,17 @@ static short const scroll_bar_parts[] = { | |||
| 5126 | SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) | 5127 | SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) |
| 5127 | }; | 5128 | }; |
| 5128 | 5129 | ||
| 5130 | /* An array of symbol indexes of internal border parts, indexed by an enum | ||
| 5131 | internal_border_part value. Note that Qnil corresponds to | ||
| 5132 | internal_border_part_none and should not appear in Lisp events. */ | ||
| 5133 | static short const internal_border_parts[] = { | ||
| 5134 | SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qleft_edge), | ||
| 5135 | SYMBOL_INDEX (Qtop_left_corner), SYMBOL_INDEX (Qtop_edge), | ||
| 5136 | SYMBOL_INDEX (Qtop_right_corner), SYMBOL_INDEX (Qright_edge), | ||
| 5137 | SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge), | ||
| 5138 | SYMBOL_INDEX (Qbottom_left_corner) | ||
| 5139 | }; | ||
| 5140 | |||
| 5129 | /* A vector, indexed by button number, giving the down-going location | 5141 | /* A vector, indexed by button number, giving the down-going location |
| 5130 | of currently depressed buttons, both scroll bar and non-scroll bar. | 5142 | of currently depressed buttons, both scroll bar and non-scroll bar. |
| 5131 | 5143 | ||
| @@ -5163,15 +5175,15 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, | |||
| 5163 | Lisp_Object extra_info = Qnil; | 5175 | Lisp_Object extra_info = Qnil; |
| 5164 | /* Coordinate pixel positions to return. */ | 5176 | /* Coordinate pixel positions to return. */ |
| 5165 | int xret = 0, yret = 0; | 5177 | int xret = 0, yret = 0; |
| 5166 | /* The window under frame pixel coordinates (x,y) */ | 5178 | /* The window or frame under frame pixel coordinates (x,y) */ |
| 5167 | Lisp_Object window = f | 5179 | Lisp_Object window_or_frame = f |
| 5168 | ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0) | 5180 | ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0) |
| 5169 | : Qnil; | 5181 | : Qnil; |
| 5170 | 5182 | ||
| 5171 | if (WINDOWP (window)) | 5183 | if (WINDOWP (window_or_frame)) |
| 5172 | { | 5184 | { |
| 5173 | /* It's a click in window WINDOW at frame coordinates (X,Y) */ | 5185 | /* It's a click in window WINDOW at frame coordinates (X,Y) */ |
| 5174 | struct window *w = XWINDOW (window); | 5186 | struct window *w = XWINDOW (window_or_frame); |
| 5175 | Lisp_Object string_info = Qnil; | 5187 | Lisp_Object string_info = Qnil; |
| 5176 | ptrdiff_t textpos = 0; | 5188 | ptrdiff_t textpos = 0; |
| 5177 | int col = -1, row = -1; | 5189 | int col = -1, row = -1; |
| @@ -5360,17 +5372,31 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, | |||
| 5360 | make_number (row)), | 5372 | make_number (row)), |
| 5361 | extra_info))); | 5373 | extra_info))); |
| 5362 | } | 5374 | } |
| 5363 | else if (f != 0) | 5375 | |
| 5376 | #ifdef HAVE_WINDOW_SYSTEM | ||
| 5377 | else if (f) | ||
| 5364 | { | 5378 | { |
| 5365 | /* Return mouse pixel coordinates here. */ | 5379 | /* Return mouse pixel coordinates here. */ |
| 5366 | XSETFRAME (window, f); | 5380 | XSETFRAME (window_or_frame, f); |
| 5367 | xret = XINT (x); | 5381 | xret = XINT (x); |
| 5368 | yret = XINT (y); | 5382 | yret = XINT (y); |
| 5383 | |||
| 5384 | if (FRAME_LIVE_P (f) | ||
| 5385 | && FRAME_INTERNAL_BORDER_WIDTH (f) > 0 | ||
| 5386 | && !NILP (get_frame_param (f, Qdrag_internal_border))) | ||
| 5387 | { | ||
| 5388 | enum internal_border_part part | ||
| 5389 | = frame_internal_border_part (f, xret, yret); | ||
| 5390 | |||
| 5391 | posn = builtin_lisp_symbol (internal_border_parts[part]); | ||
| 5392 | } | ||
| 5369 | } | 5393 | } |
| 5394 | #endif | ||
| 5395 | |||
| 5370 | else | 5396 | else |
| 5371 | window = Qnil; | 5397 | window_or_frame = Qnil; |
| 5372 | 5398 | ||
| 5373 | return Fcons (window, | 5399 | return Fcons (window_or_frame, |
| 5374 | Fcons (posn, | 5400 | Fcons (posn, |
| 5375 | Fcons (Fcons (make_number (xret), | 5401 | Fcons (Fcons (make_number (xret), |
| 5376 | make_number (yret)), | 5402 | make_number (yret)), |
| @@ -10377,7 +10403,7 @@ handle_interrupt (bool in_signal_handler) | |||
| 10377 | sigemptyset (&blocked); | 10403 | sigemptyset (&blocked); |
| 10378 | sigaddset (&blocked, SIGINT); | 10404 | sigaddset (&blocked, SIGINT); |
| 10379 | pthread_sigmask (SIG_BLOCK, &blocked, 0); | 10405 | pthread_sigmask (SIG_BLOCK, &blocked, 0); |
| 10380 | fflush (stdout); | 10406 | fflush_unlocked (stdout); |
| 10381 | } | 10407 | } |
| 10382 | 10408 | ||
| 10383 | reset_all_sys_modes (); | 10409 | reset_all_sys_modes (); |
| @@ -11158,6 +11184,17 @@ syms_of_keyboard (void) | |||
| 11158 | Fset (Qinput_method_exit_on_first_char, Qnil); | 11184 | Fset (Qinput_method_exit_on_first_char, Qnil); |
| 11159 | Fset (Qinput_method_use_echo_area, Qnil); | 11185 | Fset (Qinput_method_use_echo_area, Qnil); |
| 11160 | 11186 | ||
| 11187 | /* Symbols for dragging internal borders. */ | ||
| 11188 | DEFSYM (Qdrag_internal_border, "drag-internal-border"); | ||
| 11189 | DEFSYM (Qleft_edge, "left-edge"); | ||
| 11190 | DEFSYM (Qtop_left_corner, "top-left-corner"); | ||
| 11191 | DEFSYM (Qtop_edge, "top-edge"); | ||
| 11192 | DEFSYM (Qtop_right_corner, "top-right-corner"); | ||
| 11193 | DEFSYM (Qright_edge, "right-edge"); | ||
| 11194 | DEFSYM (Qbottom_right_corner, "bottom-right-corner"); | ||
| 11195 | DEFSYM (Qbottom_edge, "bottom-edge"); | ||
| 11196 | DEFSYM (Qbottom_left_corner, "bottom-left-corner"); | ||
| 11197 | |||
| 11161 | /* Symbols to head events. */ | 11198 | /* Symbols to head events. */ |
| 11162 | DEFSYM (Qmouse_movement, "mouse-movement"); | 11199 | DEFSYM (Qmouse_movement, "mouse-movement"); |
| 11163 | DEFSYM (Qscroll_bar_movement, "scroll-bar-movement"); | 11200 | DEFSYM (Qscroll_bar_movement, "scroll-bar-movement"); |
diff --git a/src/lread.c b/src/lread.c index 8716b86e9bf..182f96223a5 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -72,10 +72,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 72 | #define file_tell ftell | 72 | #define file_tell ftell |
| 73 | #endif | 73 | #endif |
| 74 | 74 | ||
| 75 | #ifndef HAVE_GETC_UNLOCKED | ||
| 76 | #define getc_unlocked getc | ||
| 77 | #endif | ||
| 78 | |||
| 79 | /* The objects or placeholders read with the #n=object form. | 75 | /* The objects or placeholders read with the #n=object form. |
| 80 | 76 | ||
| 81 | A hash table maps a number to either a placeholder (while the | 77 | A hash table maps a number to either a placeholder (while the |
| @@ -474,16 +470,15 @@ readbyte_from_file (int c, Lisp_Object readcharfun) | |||
| 474 | } | 470 | } |
| 475 | 471 | ||
| 476 | block_input (); | 472 | block_input (); |
| 477 | c = getc_unlocked (instream); | ||
| 478 | 473 | ||
| 479 | /* Interrupted reads have been observed while reading over the network. */ | 474 | /* Interrupted reads have been observed while reading over the network. */ |
| 480 | while (c == EOF && ferror (instream) && errno == EINTR) | 475 | while ((c = getc_unlocked (instream)) == EOF && errno == EINTR |
| 476 | && ferror_unlocked (instream)) | ||
| 481 | { | 477 | { |
| 482 | unblock_input (); | 478 | unblock_input (); |
| 483 | maybe_quit (); | 479 | maybe_quit (); |
| 484 | block_input (); | 480 | block_input (); |
| 485 | clearerr (instream); | 481 | clearerr_unlocked (instream); |
| 486 | c = getc_unlocked (instream); | ||
| 487 | } | 482 | } |
| 488 | 483 | ||
| 489 | unblock_input (); | 484 | unblock_input (); |
diff --git a/src/minibuf.c b/src/minibuf.c index 1bbe276776e..d4128ce01c1 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -20,7 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 20 | 20 | ||
| 21 | #include <config.h> | 21 | #include <config.h> |
| 22 | #include <errno.h> | 22 | #include <errno.h> |
| 23 | #include <stdio.h> | ||
| 24 | 23 | ||
| 25 | #include <binary-io.h> | 24 | #include <binary-io.h> |
| 26 | 25 | ||
| @@ -31,6 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 31 | #include "frame.h" | 30 | #include "frame.h" |
| 32 | #include "window.h" | 31 | #include "window.h" |
| 33 | #include "keymap.h" | 32 | #include "keymap.h" |
| 33 | #include "sysstdio.h" | ||
| 34 | #include "systty.h" | 34 | #include "systty.h" |
| 35 | 35 | ||
| 36 | /* List of buffers for use as minibuffers. | 36 | /* List of buffers for use as minibuffers. |
| @@ -209,15 +209,15 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, | |||
| 209 | suppress_echo_on_tty (STDIN_FILENO); | 209 | suppress_echo_on_tty (STDIN_FILENO); |
| 210 | } | 210 | } |
| 211 | 211 | ||
| 212 | fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout); | 212 | fwrite_unlocked (SDATA (prompt), 1, SBYTES (prompt), stdout); |
| 213 | fflush (stdout); | 213 | fflush_unlocked (stdout); |
| 214 | 214 | ||
| 215 | val = Qnil; | 215 | val = Qnil; |
| 216 | size = 100; | 216 | size = 100; |
| 217 | len = 0; | 217 | len = 0; |
| 218 | line = xmalloc (size); | 218 | line = xmalloc (size); |
| 219 | 219 | ||
| 220 | while ((c = getchar ()) != '\n' && c != '\r') | 220 | while ((c = getchar_unlocked ()) != '\n' && c != '\r') |
| 221 | { | 221 | { |
| 222 | if (c == EOF) | 222 | if (c == EOF) |
| 223 | { | 223 | { |
| @@ -874,6 +874,30 @@ read_minibuf_unwind (void) | |||
| 874 | if (minibuf_level == 0) | 874 | if (minibuf_level == 0) |
| 875 | resize_mini_window (XWINDOW (window), 0); | 875 | resize_mini_window (XWINDOW (window), 0); |
| 876 | 876 | ||
| 877 | /* Deal with frames that should be removed when exiting the | ||
| 878 | minibuffer. */ | ||
| 879 | { | ||
| 880 | Lisp_Object frames, frame1, val; | ||
| 881 | struct frame *f1; | ||
| 882 | |||
| 883 | FOR_EACH_FRAME (frames, frame1) | ||
| 884 | { | ||
| 885 | f1 = XFRAME (frame1); | ||
| 886 | |||
| 887 | if ((FRAME_PARENT_FRAME (f1) | ||
| 888 | || !NILP (get_frame_param (f1, Qdelete_before))) | ||
| 889 | && !NILP (val = (get_frame_param (f1, Qminibuffer_exit)))) | ||
| 890 | { | ||
| 891 | if (EQ (val, Qiconify_frame)) | ||
| 892 | Ficonify_frame (frame1); | ||
| 893 | else if (EQ (val, Qdelete_frame)) | ||
| 894 | Fdelete_frame (frame1, Qnil); | ||
| 895 | else | ||
| 896 | Fmake_frame_invisible (frame1, Qnil); | ||
| 897 | } | ||
| 898 | } | ||
| 899 | } | ||
| 900 | |||
| 877 | /* In case the previous minibuffer displayed in this miniwindow is | 901 | /* In case the previous minibuffer displayed in this miniwindow is |
| 878 | dead, we may keep displaying this buffer (tho it's inactive), so reset it, | 902 | dead, we may keep displaying this buffer (tho it's inactive), so reset it, |
| 879 | to make sure we don't leave around bindings and stuff which only | 903 | to make sure we don't leave around bindings and stuff which only |
| @@ -1930,6 +1954,8 @@ syms_of_minibuf (void) | |||
| 1930 | DEFSYM (Qactivate_input_method, "activate-input-method"); | 1954 | DEFSYM (Qactivate_input_method, "activate-input-method"); |
| 1931 | DEFSYM (Qcase_fold_search, "case-fold-search"); | 1955 | DEFSYM (Qcase_fold_search, "case-fold-search"); |
| 1932 | DEFSYM (Qmetadata, "metadata"); | 1956 | DEFSYM (Qmetadata, "metadata"); |
| 1957 | /* A frame parameter. */ | ||
| 1958 | DEFSYM (Qminibuffer_exit, "minibuffer-exit"); | ||
| 1933 | 1959 | ||
| 1934 | DEFVAR_LISP ("read-expression-history", Vread_expression_history, | 1960 | DEFVAR_LISP ("read-expression-history", Vread_expression_history, |
| 1935 | doc: /* A history list for arguments that are Lisp expressions to evaluate. | 1961 | doc: /* A history list for arguments that are Lisp expressions to evaluate. |
diff --git a/src/module-env-25.h b/src/module-env-25.h index 17e67004b24..675010b995b 100644 --- a/src/module-env-25.h +++ b/src/module-env-25.h | |||
| @@ -92,7 +92,7 @@ | |||
| 92 | 92 | ||
| 93 | SIZE must point to the total size of the buffer. If BUFFER is | 93 | SIZE must point to the total size of the buffer. If BUFFER is |
| 94 | NULL or if SIZE is not big enough, write the required buffer size | 94 | NULL or if SIZE is not big enough, write the required buffer size |
| 95 | to SIZE and return false. | 95 | to SIZE and return true. |
| 96 | 96 | ||
| 97 | Note that SIZE must include the last null byte (e.g. "abc" needs | 97 | Note that SIZE must include the last null byte (e.g. "abc" needs |
| 98 | a buffer of size 4). | 98 | a buffer of size 4). |
diff --git a/src/nsfns.m b/src/nsfns.m index dbce279da63..68eba8b6a2e 100644 --- a/src/nsfns.m +++ b/src/nsfns.m | |||
| @@ -984,6 +984,7 @@ frame_parm_handler ns_frame_parm_handlers[] = | |||
| 984 | x_set_no_accept_focus, | 984 | x_set_no_accept_focus, |
| 985 | x_set_z_group, /* x_set_z_group */ | 985 | x_set_z_group, /* x_set_z_group */ |
| 986 | 0, /* x_set_override_redirect */ | 986 | 0, /* x_set_override_redirect */ |
| 987 | x_set_no_special_glyphs, | ||
| 987 | }; | 988 | }; |
| 988 | 989 | ||
| 989 | 990 | ||
| @@ -1256,6 +1257,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 1256 | "leftFringe", "LeftFringe", RES_TYPE_NUMBER); | 1257 | "leftFringe", "LeftFringe", RES_TYPE_NUMBER); |
| 1257 | x_default_parameter (f, parms, Qright_fringe, Qnil, | 1258 | x_default_parameter (f, parms, Qright_fringe, Qnil, |
| 1258 | "rightFringe", "RightFringe", RES_TYPE_NUMBER); | 1259 | "rightFringe", "RightFringe", RES_TYPE_NUMBER); |
| 1260 | x_default_parameter (f, parms, Qno_special_glyphs, Qnil, | ||
| 1261 | NULL, NULL, RES_TYPE_BOOLEAN); | ||
| 1259 | 1262 | ||
| 1260 | init_frame_faces (f); | 1263 | init_frame_faces (f); |
| 1261 | 1264 | ||
| @@ -1325,6 +1328,15 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 1325 | f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor]; | 1328 | f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor]; |
| 1326 | f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor]; | 1329 | f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor]; |
| 1327 | f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor]; | 1330 | f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor]; |
| 1331 | f->output_data.ns->left_edge_cursor = [NSCursor resizeLeftRightCursor]; | ||
| 1332 | f->output_data.ns->top_left_corner_cursor = [NSCursor arrowCursor]; | ||
| 1333 | f->output_data.ns->top_edge_cursor = [NSCursor resizeUpDownCursor]; | ||
| 1334 | f->output_data.ns->top_right_corner_cursor = [NSCursor arrowCursor]; | ||
| 1335 | f->output_data.ns->right_edge_cursor = [NSCursor resizeLeftRightCursor]; | ||
| 1336 | f->output_data.ns->bottom_right_corner_cursor = [NSCursor arrowCursor]; | ||
| 1337 | f->output_data.ns->bottom_edge_cursor = [NSCursor resizeUpDownCursor]; | ||
| 1338 | f->output_data.ns->bottom_left_corner_cursor = [NSCursor arrowCursor]; | ||
| 1339 | |||
| 1328 | FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor | 1340 | FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor |
| 1329 | = [NSCursor arrowCursor]; | 1341 | = [NSCursor arrowCursor]; |
| 1330 | FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor | 1342 | FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor |
diff --git a/src/nsterm.h b/src/nsterm.h index bed0b92c796..0f1b36db7b2 100644 --- a/src/nsterm.h +++ b/src/nsterm.h | |||
| @@ -957,6 +957,14 @@ struct ns_output | |||
| 957 | Cursor hourglass_cursor; | 957 | Cursor hourglass_cursor; |
| 958 | Cursor horizontal_drag_cursor; | 958 | Cursor horizontal_drag_cursor; |
| 959 | Cursor vertical_drag_cursor; | 959 | Cursor vertical_drag_cursor; |
| 960 | Cursor left_edge_cursor; | ||
| 961 | Cursor top_left_corner_cursor; | ||
| 962 | Cursor top_edge_cursor; | ||
| 963 | Cursor top_right_corner_cursor; | ||
| 964 | Cursor right_edge_cursor; | ||
| 965 | Cursor bottom_right_corner_cursor; | ||
| 966 | Cursor bottom_edge_cursor; | ||
| 967 | Cursor bottom_left_corner_cursor; | ||
| 960 | 968 | ||
| 961 | /* NS-specific */ | 969 | /* NS-specific */ |
| 962 | Cursor current_pointer; | 970 | Cursor current_pointer; |
| @@ -1225,8 +1233,11 @@ extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, | |||
| 1225 | extern void x_set_z_group (struct frame *f, Lisp_Object new_value, | 1233 | extern void x_set_z_group (struct frame *f, Lisp_Object new_value, |
| 1226 | Lisp_Object old_value); | 1234 | Lisp_Object old_value); |
| 1227 | extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds, | 1235 | extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds, |
| 1228 | fd_set *exceptfds, struct timespec const *timeout, | 1236 | fd_set *exceptfds, struct timespec *timeout, |
| 1229 | sigset_t const *sigmask); | 1237 | sigset_t *sigmask); |
| 1238 | #ifdef HAVE_PTHREAD | ||
| 1239 | extern void ns_run_loop_break (void); | ||
| 1240 | #endif | ||
| 1230 | extern unsigned long ns_get_rgb_color (struct frame *f, | 1241 | extern unsigned long ns_get_rgb_color (struct frame *f, |
| 1231 | float r, float g, float b, float a); | 1242 | float r, float g, float b, float a); |
| 1232 | 1243 | ||
diff --git a/src/nsterm.m b/src/nsterm.m index e05dbf45fbc..bf83550b3d7 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -4068,7 +4068,7 @@ ns_send_appdefined (int value) | |||
| 4068 | app->nextappdefined = value; | 4068 | app->nextappdefined = value; |
| 4069 | [app performSelectorOnMainThread:@selector (sendFromMainThread:) | 4069 | [app performSelectorOnMainThread:@selector (sendFromMainThread:) |
| 4070 | withObject:nil | 4070 | withObject:nil |
| 4071 | waitUntilDone:YES]; | 4071 | waitUntilDone:NO]; |
| 4072 | return; | 4072 | return; |
| 4073 | } | 4073 | } |
| 4074 | 4074 | ||
| @@ -4293,8 +4293,8 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) | |||
| 4293 | 4293 | ||
| 4294 | int | 4294 | int |
| 4295 | ns_select (int nfds, fd_set *readfds, fd_set *writefds, | 4295 | ns_select (int nfds, fd_set *readfds, fd_set *writefds, |
| 4296 | fd_set *exceptfds, struct timespec const *timeout, | 4296 | fd_set *exceptfds, struct timespec *timeout, |
| 4297 | sigset_t const *sigmask) | 4297 | sigset_t *sigmask) |
| 4298 | /* -------------------------------------------------------------------------- | 4298 | /* -------------------------------------------------------------------------- |
| 4299 | Replacement for select, checking for events | 4299 | Replacement for select, checking for events |
| 4300 | -------------------------------------------------------------------------- */ | 4300 | -------------------------------------------------------------------------- */ |
| @@ -4327,7 +4327,13 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, | |||
| 4327 | if (NSApp == nil | 4327 | if (NSApp == nil |
| 4328 | || ![NSThread isMainThread] | 4328 | || ![NSThread isMainThread] |
| 4329 | || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) | 4329 | || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) |
| 4330 | return pselect (nfds, readfds, writefds, exceptfds, timeout, sigmask); | 4330 | return thread_select(pselect, nfds, readfds, writefds, |
| 4331 | exceptfds, timeout, sigmask); | ||
| 4332 | else | ||
| 4333 | { | ||
| 4334 | struct timespec t = {0, 0}; | ||
| 4335 | thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask); | ||
| 4336 | } | ||
| 4331 | 4337 | ||
| 4332 | [outerpool release]; | 4338 | [outerpool release]; |
| 4333 | outerpool = [[NSAutoreleasePool alloc] init]; | 4339 | outerpool = [[NSAutoreleasePool alloc] init]; |
| @@ -4430,6 +4436,18 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, | |||
| 4430 | return result; | 4436 | return result; |
| 4431 | } | 4437 | } |
| 4432 | 4438 | ||
| 4439 | #ifdef HAVE_PTHREAD | ||
| 4440 | void | ||
| 4441 | ns_run_loop_break () | ||
| 4442 | /* Break out of the NS run loop in ns_select or ns_read_socket. */ | ||
| 4443 | { | ||
| 4444 | NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_run_loop_break"); | ||
| 4445 | |||
| 4446 | /* If we don't have a GUI, don't send the event. */ | ||
| 4447 | if (NSApp != NULL) | ||
| 4448 | ns_send_appdefined(-1); | ||
| 4449 | } | ||
| 4450 | #endif | ||
| 4433 | 4451 | ||
| 4434 | 4452 | ||
| 4435 | /* ========================================================================== | 4453 | /* ========================================================================== |
diff --git a/src/print.c b/src/print.c index aaec5b04956..50c75d7712c 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -228,7 +228,7 @@ printchar_to_stream (unsigned int ch, FILE *stream) | |||
| 228 | { | 228 | { |
| 229 | if (ASCII_CHAR_P (ch)) | 229 | if (ASCII_CHAR_P (ch)) |
| 230 | { | 230 | { |
| 231 | putc (ch, stream); | 231 | putc_unlocked (ch, stream); |
| 232 | #ifdef WINDOWSNT | 232 | #ifdef WINDOWSNT |
| 233 | /* Send the output to a debugger (nothing happens if there | 233 | /* Send the output to a debugger (nothing happens if there |
| 234 | isn't one). */ | 234 | isn't one). */ |
| @@ -246,7 +246,7 @@ printchar_to_stream (unsigned int ch, FILE *stream) | |||
| 246 | if (encode_p) | 246 | if (encode_p) |
| 247 | encoded_ch = code_convert_string_norecord (encoded_ch, | 247 | encoded_ch = code_convert_string_norecord (encoded_ch, |
| 248 | coding_system, true); | 248 | coding_system, true); |
| 249 | fwrite (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream); | 249 | fwrite_unlocked (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream); |
| 250 | #ifdef WINDOWSNT | 250 | #ifdef WINDOWSNT |
| 251 | if (print_output_debug_flag && stream == stderr) | 251 | if (print_output_debug_flag && stream == stderr) |
| 252 | OutputDebugString (SSDATA (encoded_ch)); | 252 | OutputDebugString (SSDATA (encoded_ch)); |
| @@ -298,7 +298,7 @@ printchar (unsigned int ch, Lisp_Object fun) | |||
| 298 | if (DISP_TABLE_P (Vstandard_display_table)) | 298 | if (DISP_TABLE_P (Vstandard_display_table)) |
| 299 | printchar_to_stream (ch, stdout); | 299 | printchar_to_stream (ch, stdout); |
| 300 | else | 300 | else |
| 301 | fwrite (str, 1, len, stdout); | 301 | fwrite_unlocked (str, 1, len, stdout); |
| 302 | noninteractive_need_newline = 1; | 302 | noninteractive_need_newline = 1; |
| 303 | } | 303 | } |
| 304 | else | 304 | else |
| @@ -350,7 +350,7 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte, | |||
| 350 | } | 350 | } |
| 351 | } | 351 | } |
| 352 | else | 352 | else |
| 353 | fwrite (ptr, 1, size_byte, stdout); | 353 | fwrite_unlocked (ptr, 1, size_byte, stdout); |
| 354 | 354 | ||
| 355 | noninteractive_need_newline = 1; | 355 | noninteractive_need_newline = 1; |
| 356 | } | 356 | } |
| @@ -801,7 +801,7 @@ append to existing target file. */) | |||
| 801 | report_file_error ("Cannot open debugging output stream", file); | 801 | report_file_error ("Cannot open debugging output stream", file); |
| 802 | } | 802 | } |
| 803 | 803 | ||
| 804 | fflush (stderr); | 804 | fflush_unlocked (stderr); |
| 805 | if (dup2 (fd, STDERR_FILENO) < 0) | 805 | if (dup2 (fd, STDERR_FILENO) < 0) |
| 806 | report_file_error ("dup2", file); | 806 | report_file_error ("dup2", file); |
| 807 | if (fd != stderr_dup) | 807 | if (fd != stderr_dup) |
| @@ -1870,21 +1870,36 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) | |||
| 1870 | } | 1870 | } |
| 1871 | else | 1871 | else |
| 1872 | { | 1872 | { |
| 1873 | bool still_need_nonhex = false; | ||
| 1873 | /* If we just had a hex escape, and this character | 1874 | /* If we just had a hex escape, and this character |
| 1874 | could be taken as part of it, | 1875 | could be taken as part of it, |
| 1875 | output `\ ' to prevent that. */ | 1876 | output `\ ' to prevent that. */ |
| 1876 | if (need_nonhex && c_isxdigit (c)) | 1877 | if (c_isxdigit (c)) |
| 1877 | print_c_string ("\\ ", printcharfun); | 1878 | { |
| 1878 | 1879 | if (need_nonhex) | |
| 1879 | if (c == '\n' && print_escape_newlines | 1880 | print_c_string ("\\ ", printcharfun); |
| 1880 | ? (c = 'n', true) | 1881 | printchar (c, printcharfun); |
| 1881 | : c == '\f' && print_escape_newlines | 1882 | } |
| 1882 | ? (c = 'f', true) | 1883 | else if (c == '\n' && print_escape_newlines |
| 1883 | : c == '\"' || c == '\\') | 1884 | ? (c = 'n', true) |
| 1884 | printchar ('\\', printcharfun); | 1885 | : c == '\f' && print_escape_newlines |
| 1885 | 1886 | ? (c = 'f', true) | |
| 1886 | printchar (c, printcharfun); | 1887 | : c == '\0' && print_escape_control_characters |
| 1887 | need_nonhex = false; | 1888 | ? (c = '0', still_need_nonhex = true) |
| 1889 | : c == '\"' || c == '\\') | ||
| 1890 | { | ||
| 1891 | printchar ('\\', printcharfun); | ||
| 1892 | printchar (c, printcharfun); | ||
| 1893 | } | ||
| 1894 | else if (print_escape_control_characters && c_iscntrl (c)) | ||
| 1895 | { | ||
| 1896 | char outbuf[1 + 3 + 1]; | ||
| 1897 | int len = sprintf (outbuf, "\\%03o", c + 0u); | ||
| 1898 | strout (outbuf, len, len, printcharfun); | ||
| 1899 | } | ||
| 1900 | else | ||
| 1901 | printchar (c, printcharfun); | ||
| 1902 | need_nonhex = still_need_nonhex; | ||
| 1888 | } | 1903 | } |
| 1889 | } | 1904 | } |
| 1890 | printchar ('\"', printcharfun); | 1905 | printchar ('\"', printcharfun); |
| @@ -2329,6 +2344,11 @@ A value of nil means no limit. See also `eval-expression-print-level'. */); | |||
| 2329 | Also print formfeeds as `\\f'. */); | 2344 | Also print formfeeds as `\\f'. */); |
| 2330 | print_escape_newlines = 0; | 2345 | print_escape_newlines = 0; |
| 2331 | 2346 | ||
| 2347 | DEFVAR_BOOL ("print-escape-control-characters", print_escape_control_characters, | ||
| 2348 | doc: /* Non-nil means print control characters in strings as `\\OOO'. | ||
| 2349 | \(OOO is the octal representation of the character code.)*/); | ||
| 2350 | print_escape_control_characters = 0; | ||
| 2351 | |||
| 2332 | DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii, | 2352 | DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii, |
| 2333 | doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO. | 2353 | doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO. |
| 2334 | \(OOO is the octal representation of the character code.) | 2354 | \(OOO is the octal representation of the character code.) |
| @@ -2418,6 +2438,7 @@ priorities. */); | |||
| 2418 | DEFSYM (Qprint_escape_newlines, "print-escape-newlines"); | 2438 | DEFSYM (Qprint_escape_newlines, "print-escape-newlines"); |
| 2419 | DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte"); | 2439 | DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte"); |
| 2420 | DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii"); | 2440 | DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii"); |
| 2441 | DEFSYM (Qprint_escape_control_characters, "print-escape-control-characters"); | ||
| 2421 | 2442 | ||
| 2422 | print_prune_charset_plist = Qnil; | 2443 | print_prune_charset_plist = Qnil; |
| 2423 | staticpro (&print_prune_charset_plist); | 2444 | staticpro (&print_prune_charset_plist); |
diff --git a/src/process.c b/src/process.c index 2a1c2eecde3..abd017bb907 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -5371,14 +5371,13 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, | |||
| 5371 | nfds = xg_select (max_desc + 1, | 5371 | nfds = xg_select (max_desc + 1, |
| 5372 | &Available, (check_write ? &Writeok : 0), | 5372 | &Available, (check_write ? &Writeok : 0), |
| 5373 | NULL, &timeout, NULL); | 5373 | NULL, &timeout, NULL); |
| 5374 | #elif defined HAVE_NS | ||
| 5375 | /* And NS builds call thread_select in ns_select. */ | ||
| 5376 | nfds = ns_select (max_desc + 1, | ||
| 5377 | &Available, (check_write ? &Writeok : 0), | ||
| 5378 | NULL, &timeout, NULL); | ||
| 5374 | #else /* !HAVE_GLIB */ | 5379 | #else /* !HAVE_GLIB */ |
| 5375 | nfds = thread_select ( | 5380 | nfds = thread_select (pselect, max_desc + 1, |
| 5376 | # ifdef HAVE_NS | ||
| 5377 | ns_select | ||
| 5378 | # else | ||
| 5379 | pselect | ||
| 5380 | # endif | ||
| 5381 | , max_desc + 1, | ||
| 5382 | &Available, | 5381 | &Available, |
| 5383 | (check_write ? &Writeok : 0), | 5382 | (check_write ? &Writeok : 0), |
| 5384 | NULL, &timeout, NULL); | 5383 | NULL, &timeout, NULL); |
diff --git a/src/sysdep.c b/src/sysdep.c index 70f4a9dd7ea..b52236769e0 100644 --- a/src/sysdep.c +++ b/src/sysdep.c | |||
| @@ -1408,7 +1408,7 @@ reset_sys_modes (struct tty_display_info *tty_out) | |||
| 1408 | { | 1408 | { |
| 1409 | if (noninteractive) | 1409 | if (noninteractive) |
| 1410 | { | 1410 | { |
| 1411 | fflush (stdout); | 1411 | fflush_unlocked (stdout); |
| 1412 | return; | 1412 | return; |
| 1413 | } | 1413 | } |
| 1414 | if (!tty_out->term_initted) | 1414 | if (!tty_out->term_initted) |
| @@ -1428,17 +1428,14 @@ reset_sys_modes (struct tty_display_info *tty_out) | |||
| 1428 | } | 1428 | } |
| 1429 | else | 1429 | else |
| 1430 | { /* have to do it the hard way */ | 1430 | { /* have to do it the hard way */ |
| 1431 | int i; | ||
| 1432 | tty_turn_off_insert (tty_out); | 1431 | tty_turn_off_insert (tty_out); |
| 1433 | 1432 | ||
| 1434 | for (i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++) | 1433 | for (int i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++) |
| 1435 | { | 1434 | fputc_unlocked (' ', tty_out->output); |
| 1436 | fputc (' ', tty_out->output); | ||
| 1437 | } | ||
| 1438 | } | 1435 | } |
| 1439 | 1436 | ||
| 1440 | cmgoto (tty_out, FrameRows (tty_out) - 1, 0); | 1437 | cmgoto (tty_out, FrameRows (tty_out) - 1, 0); |
| 1441 | fflush (tty_out->output); | 1438 | fflush_unlocked (tty_out->output); |
| 1442 | 1439 | ||
| 1443 | if (tty_out->terminal->reset_terminal_modes_hook) | 1440 | if (tty_out->terminal->reset_terminal_modes_hook) |
| 1444 | tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal); | 1441 | tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal); |
| @@ -3079,7 +3076,7 @@ procfs_ttyname (int rdev) | |||
| 3079 | char minor[25]; /* 2 32-bit numbers + dash */ | 3076 | char minor[25]; /* 2 32-bit numbers + dash */ |
| 3080 | char *endp; | 3077 | char *endp; |
| 3081 | 3078 | ||
| 3082 | for (; !feof (fdev) && !ferror (fdev); name[0] = 0) | 3079 | for (; !feof_unlocked (fdev) && !ferror_unlocked (fdev); name[0] = 0) |
| 3083 | { | 3080 | { |
| 3084 | if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3 | 3081 | if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3 |
| 3085 | && major == MAJOR (rdev)) | 3082 | && major == MAJOR (rdev)) |
| @@ -3129,7 +3126,7 @@ procfs_get_total_memory (void) | |||
| 3129 | break; | 3126 | break; |
| 3130 | 3127 | ||
| 3131 | case 0: | 3128 | case 0: |
| 3132 | while ((c = getc (fmem)) != EOF && c != '\n') | 3129 | while ((c = getc_unlocked (fmem)) != EOF && c != '\n') |
| 3133 | continue; | 3130 | continue; |
| 3134 | done = c == EOF; | 3131 | done = c == EOF; |
| 3135 | break; | 3132 | break; |
diff --git a/src/sysstdio.h b/src/sysstdio.h index 45ee33f5580..7fbcefcdad9 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h | |||
| @@ -33,4 +33,45 @@ extern FILE *emacs_fopen (char const *, char const *); | |||
| 33 | # define FOPEN_TEXT "" | 33 | # define FOPEN_TEXT "" |
| 34 | #endif | 34 | #endif |
| 35 | 35 | ||
| 36 | /* These are compatible with unlocked-io.h, if both files are included. */ | ||
| 37 | #if !HAVE_DECL_CLEARERR_UNLOCKED | ||
| 38 | # define clearerr_unlocked(x) clearerr (x) | ||
| 39 | #endif | ||
| 40 | #if !HAVE_DECL_FEOF_UNLOCKED | ||
| 41 | # define feof_unlocked(x) feof (x) | ||
| 42 | #endif | ||
| 43 | #if !HAVE_DECL_FERROR_UNLOCKED | ||
| 44 | # define ferror_unlocked(x) ferror (x) | ||
| 45 | #endif | ||
| 46 | #if !HAVE_DECL_FFLUSH_UNLOCKED | ||
| 47 | # define fflush_unlocked(x) fflush (x) | ||
| 48 | #endif | ||
| 49 | #if !HAVE_DECL_FGETS_UNLOCKED | ||
| 50 | # define fgets_unlocked(x,y,z) fgets (x,y,z) | ||
| 51 | #endif | ||
| 52 | #if !HAVE_DECL_FPUTC_UNLOCKED | ||
| 53 | # define fputc_unlocked(x,y) fputc (x,y) | ||
| 54 | #endif | ||
| 55 | #if !HAVE_DECL_FPUTS_UNLOCKED | ||
| 56 | # define fputs_unlocked(x,y) fputs (x,y) | ||
| 57 | #endif | ||
| 58 | #if !HAVE_DECL_FREAD_UNLOCKED | ||
| 59 | # define fread_unlocked(w,x,y,z) fread (w,x,y,z) | ||
| 60 | #endif | ||
| 61 | #if !HAVE_DECL_FWRITE_UNLOCKED | ||
| 62 | # define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z) | ||
| 63 | #endif | ||
| 64 | #if !HAVE_DECL_GETC_UNLOCKED | ||
| 65 | # define getc_unlocked(x) getc (x) | ||
| 66 | #endif | ||
| 67 | #if !HAVE_DECL_GETCHAR_UNLOCKED | ||
| 68 | # define getchar_unlocked() getchar () | ||
| 69 | #endif | ||
| 70 | #if !HAVE_DECL_PUTC_UNLOCKED | ||
| 71 | # define putc_unlocked(x,y) putc (x,y) | ||
| 72 | #endif | ||
| 73 | #if !HAVE_DECL_PUTCHAR_UNLOCKED | ||
| 74 | # define putchar_unlocked(x) putchar (x) | ||
| 75 | #endif | ||
| 76 | |||
| 36 | #endif /* EMACS_SYSSTDIO_H */ | 77 | #endif /* EMACS_SYSSTDIO_H */ |
diff --git a/src/systhread.c b/src/systhread.c index a84060c18f0..aee12a9b482 100644 --- a/src/systhread.c +++ b/src/systhread.c | |||
| @@ -20,6 +20,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 20 | #include <setjmp.h> | 20 | #include <setjmp.h> |
| 21 | #include "lisp.h" | 21 | #include "lisp.h" |
| 22 | 22 | ||
| 23 | #ifdef HAVE_NS | ||
| 24 | #include "nsterm.h" | ||
| 25 | #endif | ||
| 26 | |||
| 23 | #ifndef THREADS_ENABLED | 27 | #ifndef THREADS_ENABLED |
| 24 | 28 | ||
| 25 | void | 29 | void |
| @@ -130,6 +134,13 @@ void | |||
| 130 | sys_cond_broadcast (sys_cond_t *cond) | 134 | sys_cond_broadcast (sys_cond_t *cond) |
| 131 | { | 135 | { |
| 132 | pthread_cond_broadcast (cond); | 136 | pthread_cond_broadcast (cond); |
| 137 | #ifdef HAVE_NS | ||
| 138 | /* Send an app defined event to break out of the NS run loop. | ||
| 139 | It seems that if ns_select is running the NS run loop, this | ||
| 140 | broadcast has no effect until the loop is done, breaking a couple | ||
| 141 | of tests in thread-tests.el. */ | ||
| 142 | ns_run_loop_break (); | ||
| 143 | #endif | ||
| 133 | } | 144 | } |
| 134 | 145 | ||
| 135 | void | 146 | void |
diff --git a/src/term.c b/src/term.c index 8770aff8a92..3d7f4ada0b9 100644 --- a/src/term.c +++ b/src/term.c | |||
| @@ -22,7 +22,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 22 | #include <config.h> | 22 | #include <config.h> |
| 23 | #include <errno.h> | 23 | #include <errno.h> |
| 24 | #include <fcntl.h> | 24 | #include <fcntl.h> |
| 25 | #include <stdio.h> | ||
| 26 | #include <stdlib.h> | 25 | #include <stdlib.h> |
| 27 | #include <sys/file.h> | 26 | #include <sys/file.h> |
| 28 | #include <sys/time.h> | 27 | #include <sys/time.h> |
| @@ -45,6 +44,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 45 | #include "keymap.h" | 44 | #include "keymap.h" |
| 46 | #include "blockinput.h" | 45 | #include "blockinput.h" |
| 47 | #include "syssignal.h" | 46 | #include "syssignal.h" |
| 47 | #include "sysstdio.h" | ||
| 48 | #ifdef MSDOS | 48 | #ifdef MSDOS |
| 49 | #include "msdos.h" | 49 | #include "msdos.h" |
| 50 | static int been_here = -1; | 50 | static int been_here = -1; |
| @@ -146,7 +146,7 @@ tty_ring_bell (struct frame *f) | |||
| 146 | OUTPUT (tty, (tty->TS_visible_bell && visible_bell | 146 | OUTPUT (tty, (tty->TS_visible_bell && visible_bell |
| 147 | ? tty->TS_visible_bell | 147 | ? tty->TS_visible_bell |
| 148 | : tty->TS_bell)); | 148 | : tty->TS_bell)); |
| 149 | fflush (tty->output); | 149 | fflush_unlocked (tty->output); |
| 150 | } | 150 | } |
| 151 | } | 151 | } |
| 152 | 152 | ||
| @@ -167,9 +167,10 @@ tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym) | |||
| 167 | Lisp_Object string = XCAR (extra_codes); | 167 | Lisp_Object string = XCAR (extra_codes); |
| 168 | if (STRINGP (string)) | 168 | if (STRINGP (string)) |
| 169 | { | 169 | { |
| 170 | fwrite (SDATA (string), 1, SBYTES (string), tty->output); | 170 | fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->output); |
| 171 | if (tty->termscript) | 171 | if (tty->termscript) |
| 172 | fwrite (SDATA (string), 1, SBYTES (string), tty->termscript); | 172 | fwrite_unlocked (SDATA (string), 1, SBYTES (string), |
| 173 | tty->termscript); | ||
| 173 | } | 174 | } |
| 174 | } | 175 | } |
| 175 | } | 176 | } |
| @@ -197,7 +198,7 @@ tty_set_terminal_modes (struct terminal *terminal) | |||
| 197 | OUTPUT_IF (tty, tty->TS_keypad_mode); | 198 | OUTPUT_IF (tty, tty->TS_keypad_mode); |
| 198 | losecursor (tty); | 199 | losecursor (tty); |
| 199 | tty_send_additional_strings (terminal, Qtty_mode_set_strings); | 200 | tty_send_additional_strings (terminal, Qtty_mode_set_strings); |
| 200 | fflush (tty->output); | 201 | fflush_unlocked (tty->output); |
| 201 | } | 202 | } |
| 202 | } | 203 | } |
| 203 | 204 | ||
| @@ -220,7 +221,7 @@ tty_reset_terminal_modes (struct terminal *terminal) | |||
| 220 | /* Output raw CR so kernel can track the cursor hpos. */ | 221 | /* Output raw CR so kernel can track the cursor hpos. */ |
| 221 | current_tty = tty; | 222 | current_tty = tty; |
| 222 | cmputc ('\r'); | 223 | cmputc ('\r'); |
| 223 | fflush (tty->output); | 224 | fflush_unlocked (tty->output); |
| 224 | } | 225 | } |
| 225 | } | 226 | } |
| 226 | 227 | ||
| @@ -235,7 +236,7 @@ tty_update_end (struct frame *f) | |||
| 235 | tty_show_cursor (tty); | 236 | tty_show_cursor (tty); |
| 236 | tty_turn_off_insert (tty); | 237 | tty_turn_off_insert (tty); |
| 237 | tty_background_highlight (tty); | 238 | tty_background_highlight (tty); |
| 238 | fflush (tty->output); | 239 | fflush_unlocked (tty->output); |
| 239 | } | 240 | } |
| 240 | 241 | ||
| 241 | /* The implementation of set_terminal_window for termcap frames. */ | 242 | /* The implementation of set_terminal_window for termcap frames. */ |
| @@ -497,8 +498,8 @@ tty_clear_end_of_line (struct frame *f, int first_unused_hpos) | |||
| 497 | for (i = curX (tty); i < first_unused_hpos; i++) | 498 | for (i = curX (tty); i < first_unused_hpos; i++) |
| 498 | { | 499 | { |
| 499 | if (tty->termscript) | 500 | if (tty->termscript) |
| 500 | fputc (' ', tty->termscript); | 501 | fputc_unlocked (' ', tty->termscript); |
| 501 | fputc (' ', tty->output); | 502 | fputc_unlocked (' ', tty->output); |
| 502 | } | 503 | } |
| 503 | cmplus (tty, first_unused_hpos - curX (tty)); | 504 | cmplus (tty, first_unused_hpos - curX (tty)); |
| 504 | } | 505 | } |
| @@ -771,11 +772,11 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len) | |||
| 771 | if (coding->produced > 0) | 772 | if (coding->produced > 0) |
| 772 | { | 773 | { |
| 773 | block_input (); | 774 | block_input (); |
| 774 | fwrite (conversion_buffer, 1, coding->produced, tty->output); | 775 | fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output); |
| 775 | if (ferror (tty->output)) | 776 | clearerr_unlocked (tty->output); |
| 776 | clearerr (tty->output); | ||
| 777 | if (tty->termscript) | 777 | if (tty->termscript) |
| 778 | fwrite (conversion_buffer, 1, coding->produced, tty->termscript); | 778 | fwrite_unlocked (conversion_buffer, 1, coding->produced, |
| 779 | tty->termscript); | ||
| 779 | unblock_input (); | 780 | unblock_input (); |
| 780 | } | 781 | } |
| 781 | string += n; | 782 | string += n; |
| @@ -832,11 +833,11 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str | |||
| 832 | if (coding->produced > 0) | 833 | if (coding->produced > 0) |
| 833 | { | 834 | { |
| 834 | block_input (); | 835 | block_input (); |
| 835 | fwrite (conversion_buffer, 1, coding->produced, tty->output); | 836 | fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output); |
| 836 | if (ferror (tty->output)) | 837 | clearerr_unlocked (tty->output); |
| 837 | clearerr (tty->output); | ||
| 838 | if (tty->termscript) | 838 | if (tty->termscript) |
| 839 | fwrite (conversion_buffer, 1, coding->produced, tty->termscript); | 839 | fwrite_unlocked (conversion_buffer, 1, coding->produced, |
| 840 | tty->termscript); | ||
| 840 | unblock_input (); | 841 | unblock_input (); |
| 841 | } | 842 | } |
| 842 | 843 | ||
| @@ -918,11 +919,11 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len) | |||
| 918 | if (coding->produced > 0) | 919 | if (coding->produced > 0) |
| 919 | { | 920 | { |
| 920 | block_input (); | 921 | block_input (); |
| 921 | fwrite (conversion_buffer, 1, coding->produced, tty->output); | 922 | fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output); |
| 922 | if (ferror (tty->output)) | 923 | clearerr_unlocked (tty->output); |
| 923 | clearerr (tty->output); | ||
| 924 | if (tty->termscript) | 924 | if (tty->termscript) |
| 925 | fwrite (conversion_buffer, 1, coding->produced, tty->termscript); | 925 | fwrite_unlocked (conversion_buffer, 1, coding->produced, |
| 926 | tty->termscript); | ||
| 926 | unblock_input (); | 927 | unblock_input (); |
| 927 | } | 928 | } |
| 928 | 929 | ||
| @@ -3327,7 +3328,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx, | |||
| 3327 | which calls tty_show_cursor. Re-hide it, so it doesn't show | 3328 | which calls tty_show_cursor. Re-hide it, so it doesn't show |
| 3328 | through the menus. */ | 3329 | through the menus. */ |
| 3329 | tty_hide_cursor (tty); | 3330 | tty_hide_cursor (tty); |
| 3330 | fflush (tty->output); | 3331 | fflush_unlocked (tty->output); |
| 3331 | } | 3332 | } |
| 3332 | 3333 | ||
| 3333 | sf->mouse_moved = 0; | 3334 | sf->mouse_moved = 0; |
| @@ -3335,7 +3336,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx, | |||
| 3335 | while (statecount--) | 3336 | while (statecount--) |
| 3336 | free_saved_screen (state[statecount].screen_behind); | 3337 | free_saved_screen (state[statecount].screen_behind); |
| 3337 | tty_show_cursor (tty); /* Turn cursor back on. */ | 3338 | tty_show_cursor (tty); /* Turn cursor back on. */ |
| 3338 | fflush (tty->output); | 3339 | fflush_unlocked (tty->output); |
| 3339 | 3340 | ||
| 3340 | /* Clean up any mouse events that are waiting inside Emacs event queue. | 3341 | /* Clean up any mouse events that are waiting inside Emacs event queue. |
| 3341 | These events are likely to be generated before the menu was even | 3342 | These events are likely to be generated before the menu was even |
diff --git a/src/w32fns.c b/src/w32fns.c index e490588d01b..b0842b5ee6c 100644 --- a/src/w32fns.c +++ b/src/w32fns.c | |||
| @@ -5889,6 +5889,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 5889 | NULL, NULL, RES_TYPE_BOOLEAN); | 5889 | NULL, NULL, RES_TYPE_BOOLEAN); |
| 5890 | x_default_parameter (f, parameters, Qno_accept_focus, Qnil, | 5890 | x_default_parameter (f, parameters, Qno_accept_focus, Qnil, |
| 5891 | NULL, NULL, RES_TYPE_BOOLEAN); | 5891 | NULL, NULL, RES_TYPE_BOOLEAN); |
| 5892 | x_default_parameter (f, parameters, Qno_special_glyphs, Qnil, | ||
| 5893 | NULL, NULL, RES_TYPE_BOOLEAN); | ||
| 5892 | 5894 | ||
| 5893 | /* Process alpha here (Bug#16619). On XP this fails with child | 5895 | /* Process alpha here (Bug#16619). On XP this fails with child |
| 5894 | frames. For `no-focus-on-map' frames delay processing of alpha | 5896 | frames. For `no-focus-on-map' frames delay processing of alpha |
| @@ -5957,6 +5959,14 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 5957 | f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT); | 5959 | f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT); |
| 5958 | f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE); | 5960 | f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE); |
| 5959 | f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS); | 5961 | f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS); |
| 5962 | f->output_data.w32->left_edge_cursor = w32_load_cursor (IDC_SIZEWE); | ||
| 5963 | f->output_data.w32->top_left_corner_cursor = w32_load_cursor (IDC_SIZENWSE); | ||
| 5964 | f->output_data.w32->top_edge_cursor = w32_load_cursor (IDC_SIZENS); | ||
| 5965 | f->output_data.w32->top_right_corner_cursor = w32_load_cursor (IDC_SIZENESW); | ||
| 5966 | f->output_data.w32->right_edge_cursor = w32_load_cursor (IDC_SIZEWE); | ||
| 5967 | f->output_data.w32->bottom_right_corner_cursor = w32_load_cursor (IDC_SIZENWSE); | ||
| 5968 | f->output_data.w32->bottom_edge_cursor = w32_load_cursor (IDC_SIZENS); | ||
| 5969 | f->output_data.w32->bottom_left_corner_cursor = w32_load_cursor (IDC_SIZENESW); | ||
| 5960 | 5970 | ||
| 5961 | f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor; | 5971 | f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor; |
| 5962 | 5972 | ||
| @@ -7049,6 +7059,8 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) | |||
| 7049 | "cursorColor", "Foreground", RES_TYPE_STRING); | 7059 | "cursorColor", "Foreground", RES_TYPE_STRING); |
| 7050 | x_default_parameter (f, parms, Qborder_color, build_string ("black"), | 7060 | x_default_parameter (f, parms, Qborder_color, build_string ("black"), |
| 7051 | "borderColor", "BorderColor", RES_TYPE_STRING); | 7061 | "borderColor", "BorderColor", RES_TYPE_STRING); |
| 7062 | x_default_parameter (f, parms, Qno_special_glyphs, Qt, | ||
| 7063 | NULL, NULL, RES_TYPE_BOOLEAN); | ||
| 7052 | 7064 | ||
| 7053 | /* Init faces before x_default_parameter is called for the | 7065 | /* Init faces before x_default_parameter is called for the |
| 7054 | scroll-bar-width parameter because otherwise we end up in | 7066 | scroll-bar-width parameter because otherwise we end up in |
| @@ -8950,33 +8962,47 @@ menu bar or tool bar of FRAME. */) | |||
| 8950 | if (EQ (type, Qouter_edges)) | 8962 | if (EQ (type, Qouter_edges)) |
| 8951 | { | 8963 | { |
| 8952 | RECT rectangle; | 8964 | RECT rectangle; |
| 8965 | BOOL success = false; | ||
| 8953 | 8966 | ||
| 8954 | block_input (); | 8967 | block_input (); |
| 8955 | /* Outer frame rectangle, including outer borders and title bar. */ | 8968 | /* Outer frame rectangle, including outer borders and title bar. */ |
| 8956 | GetWindowRect (FRAME_W32_WINDOW (f), &rectangle); | 8969 | success = GetWindowRect (FRAME_W32_WINDOW (f), &rectangle); |
| 8957 | unblock_input (); | 8970 | unblock_input (); |
| 8958 | 8971 | ||
| 8959 | return list4 (make_number (rectangle.left), | 8972 | if (success) |
| 8960 | make_number (rectangle.top), | 8973 | return list4 (make_number (rectangle.left), |
| 8961 | make_number (rectangle.right), | 8974 | make_number (rectangle.top), |
| 8962 | make_number (rectangle.bottom)); | 8975 | make_number (rectangle.right), |
| 8976 | make_number (rectangle.bottom)); | ||
| 8977 | else | ||
| 8978 | return Qnil; | ||
| 8963 | } | 8979 | } |
| 8964 | else | 8980 | else |
| 8965 | { | 8981 | { |
| 8966 | RECT rectangle; | 8982 | RECT rectangle; |
| 8967 | POINT pt; | 8983 | POINT pt; |
| 8968 | int left, top, right, bottom; | 8984 | int left, top, right, bottom; |
| 8985 | BOOL success; | ||
| 8969 | 8986 | ||
| 8970 | block_input (); | 8987 | block_input (); |
| 8971 | /* Inner frame rectangle, excluding borders and title bar. */ | 8988 | /* Inner frame rectangle, excluding borders and title bar. */ |
| 8972 | GetClientRect (FRAME_W32_WINDOW (f), &rectangle); | 8989 | success = GetClientRect (FRAME_W32_WINDOW (f), &rectangle); |
| 8973 | /* Get top-left corner of native rectangle in screen | 8990 | /* Get top-left corner of native rectangle in screen |
| 8974 | coordinates. */ | 8991 | coordinates. */ |
| 8992 | if (!success) | ||
| 8993 | { | ||
| 8994 | unblock_input (); | ||
| 8995 | return Qnil; | ||
| 8996 | } | ||
| 8997 | |||
| 8975 | pt.x = 0; | 8998 | pt.x = 0; |
| 8976 | pt.y = 0; | 8999 | pt.y = 0; |
| 8977 | ClientToScreen (FRAME_W32_WINDOW (f), &pt); | 9000 | success = ClientToScreen (FRAME_W32_WINDOW (f), &pt); |
| 8978 | unblock_input (); | 9001 | unblock_input (); |
| 8979 | 9002 | ||
| 9003 | if (!success) | ||
| 9004 | return Qnil; | ||
| 9005 | |||
| 8980 | left = pt.x; | 9006 | left = pt.x; |
| 8981 | top = pt.y; | 9007 | top = pt.y; |
| 8982 | right = left + rectangle.right; | 9008 | right = left + rectangle.right; |
| @@ -10330,6 +10356,7 @@ frame_parm_handler w32_frame_parm_handlers[] = | |||
| 10330 | x_set_no_accept_focus, | 10356 | x_set_no_accept_focus, |
| 10331 | x_set_z_group, | 10357 | x_set_z_group, |
| 10332 | 0, /* x_set_override_redirect */ | 10358 | 0, /* x_set_override_redirect */ |
| 10359 | x_set_no_special_glyphs, | ||
| 10333 | }; | 10360 | }; |
| 10334 | 10361 | ||
| 10335 | void | 10362 | void |
diff --git a/src/w32term.c b/src/w32term.c index 712bdae5fc3..c37805cb6ca 100644 --- a/src/w32term.c +++ b/src/w32term.c | |||
| @@ -5086,6 +5086,51 @@ w32_read_socket (struct terminal *terminal, | |||
| 5086 | } | 5086 | } |
| 5087 | 5087 | ||
| 5088 | case WM_WINDOWPOSCHANGED: | 5088 | case WM_WINDOWPOSCHANGED: |
| 5089 | f = x_window_to_frame (dpyinfo, msg.msg.hwnd); | ||
| 5090 | |||
| 5091 | if (f) | ||
| 5092 | { | ||
| 5093 | RECT rect; | ||
| 5094 | int /* rows, columns, */ width, height, text_width, text_height; | ||
| 5095 | |||
| 5096 | if (GetClientRect (msg.msg.hwnd, &rect) | ||
| 5097 | /* GetClientRect evidently returns (0, 0, 0, 0) if | ||
| 5098 | called on a minimized frame. Such "dimensions" | ||
| 5099 | aren't useful anyway. */ | ||
| 5100 | && !(rect.bottom == 0 | ||
| 5101 | && rect.top == 0 | ||
| 5102 | && rect.left == 0 | ||
| 5103 | && rect.right == 0)) | ||
| 5104 | { | ||
| 5105 | height = rect.bottom - rect.top; | ||
| 5106 | width = rect.right - rect.left; | ||
| 5107 | text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, width); | ||
| 5108 | text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, height); | ||
| 5109 | /* rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, height); */ | ||
| 5110 | /* columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, width); */ | ||
| 5111 | |||
| 5112 | /* TODO: Clip size to the screen dimensions. */ | ||
| 5113 | |||
| 5114 | /* Even if the number of character rows and columns | ||
| 5115 | has not changed, the font size may have changed, | ||
| 5116 | so we need to check the pixel dimensions as well. */ | ||
| 5117 | |||
| 5118 | if (width != FRAME_PIXEL_WIDTH (f) | ||
| 5119 | || height != FRAME_PIXEL_HEIGHT (f) | ||
| 5120 | || text_width != FRAME_TEXT_WIDTH (f) | ||
| 5121 | || text_height != FRAME_TEXT_HEIGHT (f)) | ||
| 5122 | { | ||
| 5123 | change_frame_size (f, text_width, text_height, 0, 1, 0, 1); | ||
| 5124 | SET_FRAME_GARBAGED (f); | ||
| 5125 | cancel_mouse_face (f); | ||
| 5126 | f->win_gravity = NorthWestGravity; | ||
| 5127 | } | ||
| 5128 | } | ||
| 5129 | } | ||
| 5130 | |||
| 5131 | check_visibility = 1; | ||
| 5132 | break; | ||
| 5133 | |||
| 5089 | case WM_ACTIVATE: | 5134 | case WM_ACTIVATE: |
| 5090 | case WM_ACTIVATEAPP: | 5135 | case WM_ACTIVATEAPP: |
| 5091 | f = x_window_to_frame (dpyinfo, msg.msg.hwnd); | 5136 | f = x_window_to_frame (dpyinfo, msg.msg.hwnd); |
| @@ -6052,7 +6097,7 @@ x_calc_absolute_position (struct frame *f) | |||
| 6052 | int display_top = 0; | 6097 | int display_top = 0; |
| 6053 | struct frame *p = FRAME_PARENT_FRAME (f); | 6098 | struct frame *p = FRAME_PARENT_FRAME (f); |
| 6054 | 6099 | ||
| 6055 | if (flags & (XNegative | YNegative)) | 6100 | if (!p && flags & (XNegative | YNegative)) |
| 6056 | { | 6101 | { |
| 6057 | Lisp_Object list; | 6102 | Lisp_Object list; |
| 6058 | 6103 | ||
| @@ -6078,20 +6123,26 @@ x_calc_absolute_position (struct frame *f) | |||
| 6078 | } | 6123 | } |
| 6079 | 6124 | ||
| 6080 | /* Treat negative positions as relative to the rightmost bottommost | 6125 | /* Treat negative positions as relative to the rightmost bottommost |
| 6081 | position that fits on the screen. */ | 6126 | position that fits on the screen or parent frame. |
| 6127 | |||
| 6128 | I see no need for subtracting 1 from the border widths - is there | ||
| 6129 | any on the remaining platforms? Here these subtractions did put | ||
| 6130 | the last pixel line/column of a frame off-display when, for | ||
| 6131 | example, a (set-frame-parameter nil 'left '(- 0)) specification was | ||
| 6132 | used - martin 20017-05-05. */ | ||
| 6082 | if (flags & XNegative) | 6133 | if (flags & XNegative) |
| 6083 | { | 6134 | { |
| 6084 | if (p) | 6135 | if (p) |
| 6085 | f->left_pos = (FRAME_PIXEL_WIDTH (p) | 6136 | f->left_pos = (FRAME_PIXEL_WIDTH (p) |
| 6086 | - FRAME_PIXEL_WIDTH (f) | 6137 | - FRAME_PIXEL_WIDTH (f) |
| 6087 | + f->left_pos | 6138 | + f->left_pos |
| 6088 | - (left_right_borders_width - 1)); | 6139 | - left_right_borders_width); |
| 6089 | else | 6140 | else |
| 6090 | f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) | 6141 | f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) |
| 6091 | + display_left | 6142 | + display_left |
| 6092 | - FRAME_PIXEL_WIDTH (f) | 6143 | - FRAME_PIXEL_WIDTH (f) |
| 6093 | + f->left_pos | 6144 | + f->left_pos |
| 6094 | - (left_right_borders_width - 1)); | 6145 | - left_right_borders_width); |
| 6095 | } | 6146 | } |
| 6096 | 6147 | ||
| 6097 | if (flags & YNegative) | 6148 | if (flags & YNegative) |
| @@ -6100,13 +6151,13 @@ x_calc_absolute_position (struct frame *f) | |||
| 6100 | f->top_pos = (FRAME_PIXEL_HEIGHT (p) | 6151 | f->top_pos = (FRAME_PIXEL_HEIGHT (p) |
| 6101 | - FRAME_PIXEL_HEIGHT (f) | 6152 | - FRAME_PIXEL_HEIGHT (f) |
| 6102 | + f->top_pos | 6153 | + f->top_pos |
| 6103 | - (top_bottom_borders_height - 1)); | 6154 | - top_bottom_borders_height); |
| 6104 | else | 6155 | else |
| 6105 | f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) | 6156 | f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) |
| 6106 | + display_top | 6157 | + display_top |
| 6107 | - FRAME_PIXEL_HEIGHT (f) | 6158 | - FRAME_PIXEL_HEIGHT (f) |
| 6108 | + f->top_pos | 6159 | + f->top_pos |
| 6109 | - (top_bottom_borders_height - 1)); | 6160 | - top_bottom_borders_height); |
| 6110 | } | 6161 | } |
| 6111 | 6162 | ||
| 6112 | /* The left_pos and top_pos are now relative to the top and left | 6163 | /* The left_pos and top_pos are now relative to the top and left |
diff --git a/src/w32term.h b/src/w32term.h index 371cf9005bc..9956682c5cd 100644 --- a/src/w32term.h +++ b/src/w32term.h | |||
| @@ -345,6 +345,14 @@ struct w32_output | |||
| 345 | Cursor hourglass_cursor; | 345 | Cursor hourglass_cursor; |
| 346 | Cursor horizontal_drag_cursor; | 346 | Cursor horizontal_drag_cursor; |
| 347 | Cursor vertical_drag_cursor; | 347 | Cursor vertical_drag_cursor; |
| 348 | Cursor left_edge_cursor; | ||
| 349 | Cursor top_left_corner_cursor; | ||
| 350 | Cursor top_edge_cursor; | ||
| 351 | Cursor top_right_corner_cursor; | ||
| 352 | Cursor right_edge_cursor; | ||
| 353 | Cursor bottom_right_corner_cursor; | ||
| 354 | Cursor bottom_edge_cursor; | ||
| 355 | Cursor bottom_left_corner_cursor; | ||
| 348 | 356 | ||
| 349 | /* Non-zero means hourglass cursor is currently displayed. */ | 357 | /* Non-zero means hourglass cursor is currently displayed. */ |
| 350 | unsigned hourglass_p : 1; | 358 | unsigned hourglass_p : 1; |
diff --git a/src/window.c b/src/window.c index bf89f0e488b..4816bd69909 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -1208,13 +1208,13 @@ coordinates_in_window (register struct window *w, int x, int y) | |||
| 1208 | - WINDOW_BOTTOM_DIVIDER_WIDTH (w)))) | 1208 | - WINDOW_BOTTOM_DIVIDER_WIDTH (w)))) |
| 1209 | return ON_HORIZONTAL_SCROLL_BAR; | 1209 | return ON_HORIZONTAL_SCROLL_BAR; |
| 1210 | /* On the mode or header line? */ | 1210 | /* On the mode or header line? */ |
| 1211 | else if ((WINDOW_WANTS_MODELINE_P (w) | 1211 | else if ((window_wants_mode_line (w) |
| 1212 | && y >= (bottom_y | 1212 | && y >= (bottom_y |
| 1213 | - CURRENT_MODE_LINE_HEIGHT (w) | 1213 | - CURRENT_MODE_LINE_HEIGHT (w) |
| 1214 | - WINDOW_BOTTOM_DIVIDER_WIDTH (w)) | 1214 | - WINDOW_BOTTOM_DIVIDER_WIDTH (w)) |
| 1215 | && y <= bottom_y - WINDOW_BOTTOM_DIVIDER_WIDTH (w) | 1215 | && y <= bottom_y - WINDOW_BOTTOM_DIVIDER_WIDTH (w) |
| 1216 | && (part = ON_MODE_LINE)) | 1216 | && (part = ON_MODE_LINE)) |
| 1217 | || (WINDOW_WANTS_HEADER_LINE_P (w) | 1217 | || (window_wants_header_line (w) |
| 1218 | && y < top_y + CURRENT_HEADER_LINE_HEIGHT (w) | 1218 | && y < top_y + CURRENT_HEADER_LINE_HEIGHT (w) |
| 1219 | && (part = ON_HEADER_LINE))) | 1219 | && (part = ON_HEADER_LINE))) |
| 1220 | { | 1220 | { |
| @@ -1851,7 +1851,7 @@ Return nil if window display is not up-to-date. In that case, use | |||
| 1851 | 1851 | ||
| 1852 | if (EQ (line, Qheader_line)) | 1852 | if (EQ (line, Qheader_line)) |
| 1853 | { | 1853 | { |
| 1854 | if (!WINDOW_WANTS_HEADER_LINE_P (w)) | 1854 | if (!window_wants_header_line (w)) |
| 1855 | return Qnil; | 1855 | return Qnil; |
| 1856 | row = MATRIX_HEADER_LINE_ROW (w->current_matrix); | 1856 | row = MATRIX_HEADER_LINE_ROW (w->current_matrix); |
| 1857 | return row->enabled_p ? list4i (row->height, 0, 0, 0) : Qnil; | 1857 | return row->enabled_p ? list4i (row->height, 0, 0, 0) : Qnil; |
| @@ -1898,6 +1898,129 @@ Return nil if window display is not up-to-date. In that case, use | |||
| 1898 | return list4i (row->height + min (0, row->y) - crop, i, row->y, crop); | 1898 | return list4i (row->height + min (0, row->y) - crop, i, row->y, crop); |
| 1899 | } | 1899 | } |
| 1900 | 1900 | ||
| 1901 | DEFUN ("window-lines-pixel-dimensions", Fwindow_lines_pixel_dimensions, Swindow_lines_pixel_dimensions, 0, 6, 0, | ||
| 1902 | doc: /* Return pixel dimensions of WINDOW's lines. | ||
| 1903 | The return value is a list of the x- and y-coordinates of the lower | ||
| 1904 | right corner of the last character of each line. Return nil if the | ||
| 1905 | current glyph matrix of WINDOW is not up-to-date. | ||
| 1906 | |||
| 1907 | Optional argument WINDOW specifies the window whose lines' dimensions | ||
| 1908 | shall be returned. Nil or omitted means to return the dimensions for | ||
| 1909 | the selected window. | ||
| 1910 | |||
| 1911 | FIRST, if non-nil, specifies the index of the first line whose | ||
| 1912 | dimensions shall be returned. If FIRST is nil and BODY is non-nil, | ||
| 1913 | start with the first text line of WINDOW. Otherwise, start with the | ||
| 1914 | first line of WINDOW. | ||
| 1915 | |||
| 1916 | LAST, if non-nil, specifies the last line whose dimensions shall be | ||
| 1917 | returned. If LAST is nil and BODY is non-nil, the last line is the last | ||
| 1918 | line of the body (text area) of WINDOW. Otherwise, last is the last | ||
| 1919 | line of WINDOW. | ||
| 1920 | |||
| 1921 | INVERSE, if nil, means that the y-pixel value returned for a specific | ||
| 1922 | line specifies the distance in pixels from the left edge (body edge if | ||
| 1923 | BODY is non-nil) of WINDOW to the right edge of the last glyph of that | ||
| 1924 | line. INVERSE non-nil means that the y-pixel value returned for a | ||
| 1925 | specific line specifies the distance in pixels from the right edge of | ||
| 1926 | the last glyph of that line to the right edge (body edge if BODY is | ||
| 1927 | non-nil) of WINDOW. | ||
| 1928 | |||
| 1929 | LEFT non-nil means to return the x- and y-coordinates of the lower left | ||
| 1930 | corner of the leftmost character on each line. This is the value that | ||
| 1931 | should be used for buffers that mostly display text from right to left. | ||
| 1932 | |||
| 1933 | If LEFT is non-nil and INVERSE is nil, this means that the y-pixel value | ||
| 1934 | returned for a specific line specifies the distance in pixels from the | ||
| 1935 | left edge of the last (leftmost) glyph of that line to the right edge | ||
| 1936 | (body edge if BODY is non-nil) of WINDOW. If LEFT and INVERSE are both | ||
| 1937 | non-nil, the y-pixel value returned for a specific line specifies the | ||
| 1938 | distance in pixels from the left edge (body edge if BODY is non-nil) of | ||
| 1939 | WINDOW to the left edge of the last (leftmost) glyph of that line. | ||
| 1940 | |||
| 1941 | Normally, the value of this function is not available while Emacs is | ||
| 1942 | busy, for example, when processing a command. It should be retrievable | ||
| 1943 | though when run from an idle timer with a delay of zero seconds. */) | ||
| 1944 | (Lisp_Object window, Lisp_Object first, Lisp_Object last, Lisp_Object body, Lisp_Object inverse, Lisp_Object left) | ||
| 1945 | { | ||
| 1946 | struct window *w = decode_live_window (window); | ||
| 1947 | struct buffer *b; | ||
| 1948 | struct glyph_row *row, *end_row; | ||
| 1949 | int max_y = NILP (body) ? WINDOW_PIXEL_HEIGHT (w) : window_text_bottom_y (w); | ||
| 1950 | Lisp_Object rows = Qnil; | ||
| 1951 | int window_width = NILP (body) ? w->pixel_width : window_body_width (w, true); | ||
| 1952 | int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w); | ||
| 1953 | int subtract = NILP (body) ? 0 : header_line_height; | ||
| 1954 | bool invert = !NILP (inverse); | ||
| 1955 | bool left_flag = !NILP (left); | ||
| 1956 | |||
| 1957 | if (noninteractive || w->pseudo_window_p) | ||
| 1958 | return Qnil; | ||
| 1959 | |||
| 1960 | CHECK_BUFFER (w->contents); | ||
| 1961 | b = XBUFFER (w->contents); | ||
| 1962 | |||
| 1963 | /* Fail if current matrix is not up-to-date. */ | ||
| 1964 | if (!w->window_end_valid | ||
| 1965 | || windows_or_buffers_changed | ||
| 1966 | || b->clip_changed | ||
| 1967 | || b->prevent_redisplay_optimizations_p | ||
| 1968 | || window_outdated (w)) | ||
| 1969 | return Qnil; | ||
| 1970 | |||
| 1971 | if (NILP (first)) | ||
| 1972 | row = (NILP (body) | ||
| 1973 | ? MATRIX_ROW (w->current_matrix, 0) | ||
| 1974 | : MATRIX_FIRST_TEXT_ROW (w->current_matrix)); | ||
| 1975 | else if (NUMBERP (first)) | ||
| 1976 | { | ||
| 1977 | CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows); | ||
| 1978 | row = MATRIX_ROW (w->current_matrix, XINT (first)); | ||
| 1979 | } | ||
| 1980 | else | ||
| 1981 | error ("Invalid specification of first line"); | ||
| 1982 | |||
| 1983 | if (NILP (last)) | ||
| 1984 | |||
| 1985 | end_row = (NILP (body) | ||
| 1986 | ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows) | ||
| 1987 | : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)); | ||
| 1988 | else if (NUMBERP (last)) | ||
| 1989 | { | ||
| 1990 | CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows); | ||
| 1991 | end_row = MATRIX_ROW (w->current_matrix, XINT (last)); | ||
| 1992 | } | ||
| 1993 | else | ||
| 1994 | error ("Invalid specification of last line"); | ||
| 1995 | |||
| 1996 | while (row <= end_row && row->enabled_p | ||
| 1997 | && row->y + row->height < max_y) | ||
| 1998 | { | ||
| 1999 | |||
| 2000 | if (left_flag) | ||
| 2001 | { | ||
| 2002 | struct glyph *glyph = row->glyphs[TEXT_AREA]; | ||
| 2003 | |||
| 2004 | rows = Fcons (Fcons (make_number | ||
| 2005 | (invert | ||
| 2006 | ? glyph->pixel_width | ||
| 2007 | : window_width - glyph->pixel_width), | ||
| 2008 | make_number (row->y + row->height - subtract)), | ||
| 2009 | rows); | ||
| 2010 | } | ||
| 2011 | else | ||
| 2012 | rows = Fcons (Fcons (make_number | ||
| 2013 | (invert | ||
| 2014 | ? window_width - row->pixel_width | ||
| 2015 | : row->pixel_width), | ||
| 2016 | make_number (row->y + row->height - subtract)), | ||
| 2017 | rows); | ||
| 2018 | row++; | ||
| 2019 | } | ||
| 2020 | |||
| 2021 | return Fnreverse (rows); | ||
| 2022 | } | ||
| 2023 | |||
| 1901 | DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p, | 2024 | DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p, |
| 1902 | 0, 1, 0, | 2025 | 0, 1, 0, |
| 1903 | doc: /* Return non-nil when WINDOW is dedicated to its buffer. | 2026 | doc: /* Return non-nil when WINDOW is dedicated to its buffer. |
| @@ -2003,16 +2126,24 @@ return value is a list of elements of the form (PARAMETER . VALUE). */) | |||
| 2003 | return Fcopy_alist (decode_valid_window (window)->window_parameters); | 2126 | return Fcopy_alist (decode_valid_window (window)->window_parameters); |
| 2004 | } | 2127 | } |
| 2005 | 2128 | ||
| 2129 | Lisp_Object | ||
| 2130 | window_parameter (struct window *w, Lisp_Object parameter) | ||
| 2131 | { | ||
| 2132 | Lisp_Object result = Fassq (parameter, w->window_parameters); | ||
| 2133 | |||
| 2134 | return CDR_SAFE (result); | ||
| 2135 | } | ||
| 2136 | |||
| 2137 | |||
| 2006 | DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter, | 2138 | DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter, |
| 2007 | 2, 2, 0, | 2139 | 2, 2, 0, |
| 2008 | doc: /* Return WINDOW's value for PARAMETER. | 2140 | doc: /* Return WINDOW's value for PARAMETER. |
| 2009 | WINDOW can be any window and defaults to the selected one. */) | 2141 | WINDOW can be any window and defaults to the selected one. */) |
| 2010 | (Lisp_Object window, Lisp_Object parameter) | 2142 | (Lisp_Object window, Lisp_Object parameter) |
| 2011 | { | 2143 | { |
| 2012 | Lisp_Object result; | 2144 | struct window *w = decode_any_window (window); |
| 2013 | 2145 | ||
| 2014 | result = Fassq (parameter, decode_any_window (window)->window_parameters); | 2146 | return window_parameter (w, parameter); |
| 2015 | return CDR_SAFE (result); | ||
| 2016 | } | 2147 | } |
| 2017 | 2148 | ||
| 2018 | DEFUN ("set-window-parameter", Fset_window_parameter, | 2149 | DEFUN ("set-window-parameter", Fset_window_parameter, |
| @@ -4740,6 +4871,69 @@ mark_window_cursors_off (struct window *w) | |||
| 4740 | } | 4871 | } |
| 4741 | 4872 | ||
| 4742 | 4873 | ||
| 4874 | /** | ||
| 4875 | * window_wants_mode_line: | ||
| 4876 | * | ||
| 4877 | * Return 1 if window W wants a mode line and is high enough to | ||
| 4878 | * accomodate it, 0 otherwise. | ||
| 4879 | * | ||
| 4880 | * W wants a mode line if it's a leaf window and neither a minibuffer | ||
| 4881 | * nor a pseudo window. Moreover, its 'window-mode-line-format' | ||
| 4882 | * parameter must not be 'none' and either that parameter or W's | ||
| 4883 | * buffer's 'mode-line-format' value must be non-nil. Finally, W must | ||
| 4884 | * be higher than its frame's canonical character height. | ||
| 4885 | */ | ||
| 4886 | bool | ||
| 4887 | window_wants_mode_line (struct window *w) | ||
| 4888 | { | ||
| 4889 | Lisp_Object window_mode_line_format = | ||
| 4890 | window_parameter (w, Qmode_line_format); | ||
| 4891 | |||
| 4892 | return ((WINDOW_LEAF_P (w) | ||
| 4893 | && !MINI_WINDOW_P (w) | ||
| 4894 | && !WINDOW_PSEUDO_P (w) | ||
| 4895 | && !EQ (window_mode_line_format, Qnone) | ||
| 4896 | && (!NILP (window_mode_line_format) | ||
| 4897 | || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), mode_line_format))) | ||
| 4898 | && WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w)) | ||
| 4899 | ? 1 | ||
| 4900 | : 0); | ||
| 4901 | } | ||
| 4902 | |||
| 4903 | |||
| 4904 | /** | ||
| 4905 | * window_wants_header_line: | ||
| 4906 | * | ||
| 4907 | * Return 1 if window W wants a header line and is high enough to | ||
| 4908 | * accomodate it, 0 otherwise. | ||
| 4909 | * | ||
| 4910 | * W wants a header line if it's a leaf window and neither a minibuffer | ||
| 4911 | * nor a pseudo window. Moreover, its 'window-mode-line-format' | ||
| 4912 | * parameter must not be 'none' and either that parameter or W's | ||
| 4913 | * buffer's 'mode-line-format' value must be non-nil. Finally, W must | ||
| 4914 | * be higher than its frame's canonical character height and be able to | ||
| 4915 | * accomodate a mode line too if necessary (the mode line prevails). | ||
| 4916 | */ | ||
| 4917 | bool | ||
| 4918 | window_wants_header_line (struct window *w) | ||
| 4919 | { | ||
| 4920 | Lisp_Object window_header_line_format = | ||
| 4921 | window_parameter (w, Qheader_line_format); | ||
| 4922 | |||
| 4923 | return ((WINDOW_LEAF_P (w) | ||
| 4924 | && !MINI_WINDOW_P (w) | ||
| 4925 | && !WINDOW_PSEUDO_P (w) | ||
| 4926 | && !EQ (window_header_line_format, Qnone) | ||
| 4927 | && (!NILP (window_header_line_format) | ||
| 4928 | || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format))) | ||
| 4929 | && (WINDOW_PIXEL_HEIGHT (w) | ||
| 4930 | > (window_wants_mode_line (w) | ||
| 4931 | ? 2 * WINDOW_FRAME_LINE_HEIGHT (w) | ||
| 4932 | : WINDOW_FRAME_LINE_HEIGHT (w)))) | ||
| 4933 | ? 1 | ||
| 4934 | : 0); | ||
| 4935 | } | ||
| 4936 | |||
| 4743 | /* Return number of lines of text (not counting mode lines) in W. */ | 4937 | /* Return number of lines of text (not counting mode lines) in W. */ |
| 4744 | 4938 | ||
| 4745 | int | 4939 | int |
| @@ -4753,10 +4947,10 @@ window_internal_height (struct window *w) | |||
| 4753 | || WINDOWP (w->contents) | 4947 | || WINDOWP (w->contents) |
| 4754 | || !NILP (w->next) | 4948 | || !NILP (w->next) |
| 4755 | || !NILP (w->prev) | 4949 | || !NILP (w->prev) |
| 4756 | || WINDOW_WANTS_MODELINE_P (w)) | 4950 | || window_wants_mode_line (w)) |
| 4757 | --ht; | 4951 | --ht; |
| 4758 | 4952 | ||
| 4759 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 4953 | if (window_wants_header_line (w)) |
| 4760 | --ht; | 4954 | --ht; |
| 4761 | } | 4955 | } |
| 4762 | 4956 | ||
| @@ -7354,6 +7548,8 @@ syms_of_window (void) | |||
| 7354 | DEFSYM (Qfloor, "floor"); | 7548 | DEFSYM (Qfloor, "floor"); |
| 7355 | DEFSYM (Qceiling, "ceiling"); | 7549 | DEFSYM (Qceiling, "ceiling"); |
| 7356 | DEFSYM (Qmark_for_redisplay, "mark-for-redisplay"); | 7550 | DEFSYM (Qmark_for_redisplay, "mark-for-redisplay"); |
| 7551 | DEFSYM (Qmode_line_format, "mode-line-format"); | ||
| 7552 | DEFSYM (Qheader_line_format, "header-line-format"); | ||
| 7357 | 7553 | ||
| 7358 | staticpro (&Vwindow_list); | 7554 | staticpro (&Vwindow_list); |
| 7359 | 7555 | ||
| @@ -7603,6 +7799,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */); | |||
| 7603 | defsubr (&Sset_window_point); | 7799 | defsubr (&Sset_window_point); |
| 7604 | defsubr (&Sset_window_start); | 7800 | defsubr (&Sset_window_start); |
| 7605 | defsubr (&Swindow_dedicated_p); | 7801 | defsubr (&Swindow_dedicated_p); |
| 7802 | defsubr (&Swindow_lines_pixel_dimensions); | ||
| 7606 | defsubr (&Sset_window_dedicated_p); | 7803 | defsubr (&Sset_window_dedicated_p); |
| 7607 | defsubr (&Swindow_display_table); | 7804 | defsubr (&Swindow_display_table); |
| 7608 | defsubr (&Sset_window_display_table); | 7805 | defsubr (&Sset_window_display_table); |
diff --git a/src/window.h b/src/window.h index acb8a5cabfa..e9040f816df 100644 --- a/src/window.h +++ b/src/window.h | |||
| @@ -328,8 +328,9 @@ struct window | |||
| 328 | /* True if this window is a minibuffer window. */ | 328 | /* True if this window is a minibuffer window. */ |
| 329 | bool_bf mini : 1; | 329 | bool_bf mini : 1; |
| 330 | 330 | ||
| 331 | /* Meaningful only if contents is a window, true if this | 331 | /* Meaningful for internal windows only: true if this window is a |
| 332 | internal window is used in horizontal combination. */ | 332 | horizontal combination, false if it is a vertical |
| 333 | combination. */ | ||
| 333 | bool_bf horizontal : 1; | 334 | bool_bf horizontal : 1; |
| 334 | 335 | ||
| 335 | /* True means must regenerate mode line of this window. */ | 336 | /* True means must regenerate mode line of this window. */ |
| @@ -481,15 +482,14 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 481 | /* True if W is a minibuffer window. */ | 482 | /* True if W is a minibuffer window. */ |
| 482 | #define MINI_WINDOW_P(W) ((W)->mini) | 483 | #define MINI_WINDOW_P(W) ((W)->mini) |
| 483 | 484 | ||
| 484 | /* 1 if W is a non-only minibuffer window. */ | 485 | /* True if W is a minibuffer window on a frame that contains at least |
| 485 | /* The first check is redundant and the second overly complicated. */ | 486 | one other window. */ |
| 486 | #define MINI_NON_ONLY_WINDOW_P(W) \ | 487 | #define MINI_NON_ONLY_WINDOW_P(W) \ |
| 487 | (MINI_WINDOW_P (W) \ | 488 | (MINI_WINDOW_P (W) && !NILP ((W)->prev)) |
| 488 | && (EQ (W->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))))) | ||
| 489 | 489 | ||
| 490 | /* 1 if W is a minibuffer-only window. */ | 490 | /* True if W is a minibuffer window that is alone on its frame. */ |
| 491 | #define MINI_ONLY_WINDOW_P(W) \ | 491 | #define MINI_ONLY_WINDOW_P(W) \ |
| 492 | (MINI_WINDOW_P (W) && NILP (W->prev)) | 492 | (MINI_WINDOW_P (W) && NILP ((W)->prev)) |
| 493 | 493 | ||
| 494 | /* General window layout: | 494 | /* General window layout: |
| 495 | 495 | ||
| @@ -518,29 +518,34 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 518 | 518 | ||
| 519 | /* A handy macro. */ | 519 | /* A handy macro. */ |
| 520 | 520 | ||
| 521 | /* Non-nil if W is leaf (carry the buffer). */ | 521 | /* Non-nil if window W is leaf window (has a buffer). */ |
| 522 | |||
| 523 | #define WINDOW_LEAF_P(W) \ | 522 | #define WINDOW_LEAF_P(W) \ |
| 524 | (BUFFERP ((W)->contents)) | 523 | (BUFFERP ((W)->contents)) |
| 525 | 524 | ||
| 526 | /* Non-nil if W is internal. */ | 525 | /* Non-nil if window W is internal (is a parent window). */ |
| 527 | #define WINDOW_INTERNAL_P(W) \ | 526 | #define WINDOW_INTERNAL_P(W) \ |
| 528 | (WINDOWP ((W)->contents)) | 527 | (WINDOWP ((W)->contents)) |
| 529 | 528 | ||
| 530 | /* True if W is a member of horizontal combination. */ | 529 | /* True if window W is a horizontal combination of windows. */ |
| 531 | #define WINDOW_HORIZONTAL_COMBINATION_P(W) \ | 530 | #define WINDOW_HORIZONTAL_COMBINATION_P(W) \ |
| 532 | (WINDOW_INTERNAL_P (W) && (W)->horizontal) | 531 | (WINDOW_INTERNAL_P (W) && (W)->horizontal) |
| 533 | 532 | ||
| 534 | /* True if W is a member of vertical combination. */ | 533 | /* True if window W is a vertical combination of windows. */ |
| 535 | #define WINDOW_VERTICAL_COMBINATION_P(W) \ | 534 | #define WINDOW_VERTICAL_COMBINATION_P(W) \ |
| 536 | (WINDOW_INTERNAL_P (W) && !(W)->horizontal) | 535 | (WINDOW_INTERNAL_P (W) && !(W)->horizontal) |
| 537 | 536 | ||
| 538 | /* WINDOW's XFRAME. */ | 537 | /* Window W's XFRAME. */ |
| 539 | #define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W)))) | 538 | #define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W)))) |
| 540 | 539 | ||
| 541 | /* Whether WINDOW is a pseudo window. */ | 540 | /* Whether window W is a pseudo window. */ |
| 542 | #define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p) | 541 | #define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p) |
| 543 | 542 | ||
| 543 | /* Window W's buffer. */ | ||
| 544 | #define WINDOW_BUFFER(W) \ | ||
| 545 | (WINDOW_LEAF_P(W) \ | ||
| 546 | ? (W)->contents \ | ||
| 547 | : Qnil) \ | ||
| 548 | |||
| 544 | /* Return the canonical column width of the frame of window W. */ | 549 | /* Return the canonical column width of the frame of window W. */ |
| 545 | #define WINDOW_FRAME_COLUMN_WIDTH(W) \ | 550 | #define WINDOW_FRAME_COLUMN_WIDTH(W) \ |
| 546 | (FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W)))) | 551 | (FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W)))) |
| @@ -549,24 +554,24 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 549 | #define WINDOW_FRAME_LINE_HEIGHT(W) \ | 554 | #define WINDOW_FRAME_LINE_HEIGHT(W) \ |
| 550 | (FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W)))) | 555 | (FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W)))) |
| 551 | 556 | ||
| 552 | /* Return the pixel width of window W. | 557 | /* Return the pixel width of window W. This includes dividers, scroll |
| 553 | This includes scroll bars and fringes. */ | 558 | bars, fringes and margins, if any. */ |
| 554 | #define WINDOW_PIXEL_WIDTH(W) (W)->pixel_width | 559 | #define WINDOW_PIXEL_WIDTH(W) (W)->pixel_width |
| 555 | 560 | ||
| 556 | /* Return the pixel height of window W. | 561 | /* Return the pixel height of window W. This includes dividers, scroll |
| 557 | This includes header and mode lines, if any. */ | 562 | bars, header and mode lines, if any. */ |
| 558 | #define WINDOW_PIXEL_HEIGHT(W) (W)->pixel_height | 563 | #define WINDOW_PIXEL_HEIGHT(W) (W)->pixel_height |
| 559 | 564 | ||
| 560 | /* Return the width of window W in canonical column units. | 565 | /* Return the width of window W in canonical column units. This |
| 561 | This includes scroll bars and fringes. | 566 | includes dividers, scroll bars, fringes and margins, if any. The |
| 562 | This value is adjusted such that the sum of the widths of all child | 567 | value is adjusted such that the sum of the widths of all child |
| 563 | windows equals the width of their parent window. */ | 568 | windows equals the width of their parent window. */ |
| 564 | #define WINDOW_TOTAL_COLS(W) (W)->total_cols | 569 | #define WINDOW_TOTAL_COLS(W) (W)->total_cols |
| 565 | 570 | ||
| 566 | /* Return the height of window W in canonical line units. | 571 | /* Return the height of window W in canonical line units. This includes |
| 567 | This includes header and mode lines, if any. | 572 | dividers, scroll bars, header and mode lines, if any. The value is |
| 568 | This value is adjusted such that the sum of the heights of all child | 573 | adjusted such that the sum of the heights of all child windows equals |
| 569 | windows equals the height of their parent window. */ | 574 | the height of their parent window. */ |
| 570 | #define WINDOW_TOTAL_LINES(W) (W)->total_lines | 575 | #define WINDOW_TOTAL_LINES(W) (W)->total_lines |
| 571 | 576 | ||
| 572 | /* The smallest acceptable dimensions for a window. Anything smaller | 577 | /* The smallest acceptable dimensions for a window. Anything smaller |
| @@ -581,31 +586,63 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 581 | #define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \ | 586 | #define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \ |
| 582 | (WINDOW_FRAME_LINE_HEIGHT (W)) | 587 | (WINDOW_FRAME_LINE_HEIGHT (W)) |
| 583 | 588 | ||
| 589 | /* True if window W has no other windows to its left on its frame. */ | ||
| 590 | #define WINDOW_LEFTMOST_P(W) \ | ||
| 591 | (WINDOW_LEFT_PIXEL_EDGE (W) == 0) | ||
| 592 | |||
| 593 | /* True if window W has no other windows above it on its frame. */ | ||
| 594 | #define WINDOW_TOPMOST_P(W) \ | ||
| 595 | (WINDOW_TOP_PIXEL_EDGE (W) == 0) | ||
| 596 | |||
| 597 | /* True if window W has no other windows to its right on its frame. */ | ||
| 598 | #define WINDOW_RIGHTMOST_P(W) \ | ||
| 599 | (WINDOW_RIGHT_PIXEL_EDGE (W) \ | ||
| 600 | == (WINDOW_RIGHT_PIXEL_EDGE \ | ||
| 601 | (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ | ||
| 602 | |||
| 603 | /* True if window W has no other windows below it on its frame (the | ||
| 604 | minibuffer window is not counted in this respect unless W itself is a | ||
| 605 | minibuffer window). */ | ||
| 606 | #define WINDOW_BOTTOMMOST_P(W) \ | ||
| 607 | (WINDOW_BOTTOM_PIXEL_EDGE (W) \ | ||
| 608 | == (WINDOW_BOTTOM_PIXEL_EDGE \ | ||
| 609 | (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ | ||
| 610 | |||
| 611 | /* True if window W takes up the full width of its frame. */ | ||
| 612 | #define WINDOW_FULL_WIDTH_P(W) \ | ||
| 613 | (WINDOW_PIXEL_WIDTH (W) \ | ||
| 614 | == (WINDOW_PIXEL_WIDTH \ | ||
| 615 | (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ | ||
| 616 | |||
| 584 | /* Width of right divider of window W. */ | 617 | /* Width of right divider of window W. */ |
| 585 | #define WINDOW_RIGHT_DIVIDER_WIDTH(W) \ | 618 | #define WINDOW_RIGHT_DIVIDER_WIDTH(W) \ |
| 586 | ((WINDOW_RIGHTMOST_P (W) || MINI_WINDOW_P (W)) \ | 619 | (WINDOW_RIGHTMOST_P (W) \ |
| 587 | ? 0 \ | 620 | ? 0 : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W))) |
| 588 | : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W))) | 621 | |
| 622 | /* Width of bottom divider of window W. */ | ||
| 623 | #define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \ | ||
| 624 | (((WINDOW_BOTTOMMOST_P (W) \ | ||
| 625 | && NILP ((XWINDOW (FRAME_ROOT_WINDOW \ | ||
| 626 | (WINDOW_XFRAME (W))))->next)) \ | ||
| 627 | || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \ | ||
| 628 | || (W)->pseudo_window_p) \ | ||
| 629 | ? 0 : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W))) | ||
| 589 | 630 | ||
| 590 | /* Return the canonical frame column at which window W starts. | 631 | /* Return the canonical frame column at which window W starts. |
| 591 | This includes a left-hand scroll bar, if any. */ | 632 | This includes a left-hand scroll bar, if any. */ |
| 592 | |||
| 593 | #define WINDOW_LEFT_EDGE_COL(W) (W)->left_col | 633 | #define WINDOW_LEFT_EDGE_COL(W) (W)->left_col |
| 594 | 634 | ||
| 595 | /* Return the canonical frame column before which window W ends. | 635 | /* Return the canonical frame column before which window W ends. |
| 596 | This includes a right-hand scroll bar, if any. */ | 636 | This includes a right-hand scroll bar, if any. */ |
| 597 | |||
| 598 | #define WINDOW_RIGHT_EDGE_COL(W) \ | 637 | #define WINDOW_RIGHT_EDGE_COL(W) \ |
| 599 | (WINDOW_LEFT_EDGE_COL (W) + WINDOW_TOTAL_COLS (W)) | 638 | (WINDOW_LEFT_EDGE_COL (W) + WINDOW_TOTAL_COLS (W)) |
| 600 | 639 | ||
| 601 | /* Return the canonical frame line at which window W starts. | 640 | /* Return the canonical frame line at which window W starts. |
| 602 | This includes a header line, if any. */ | 641 | This includes a header line, if any. */ |
| 603 | |||
| 604 | #define WINDOW_TOP_EDGE_LINE(W) (W)->top_line | 642 | #define WINDOW_TOP_EDGE_LINE(W) (W)->top_line |
| 605 | 643 | ||
| 606 | /* Return the canonical frame line before which window W ends. | 644 | /* Return the canonical frame line before which window W ends. |
| 607 | This includes a mode line, if any. */ | 645 | This includes a mode line, if any. */ |
| 608 | |||
| 609 | #define WINDOW_BOTTOM_EDGE_LINE(W) \ | 646 | #define WINDOW_BOTTOM_EDGE_LINE(W) \ |
| 610 | (WINDOW_TOP_EDGE_LINE (W) + WINDOW_TOTAL_LINES (W)) | 647 | (WINDOW_TOP_EDGE_LINE (W) + WINDOW_TOTAL_LINES (W)) |
| 611 | 648 | ||
| @@ -629,20 +666,17 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 629 | 666 | ||
| 630 | /* Return the frame x-position at which window W starts. | 667 | /* Return the frame x-position at which window W starts. |
| 631 | This includes a left-hand scroll bar, if any. */ | 668 | This includes a left-hand scroll bar, if any. */ |
| 632 | |||
| 633 | #define WINDOW_LEFT_EDGE_X(W) \ | 669 | #define WINDOW_LEFT_EDGE_X(W) \ |
| 634 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ | 670 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ |
| 635 | + WINDOW_LEFT_PIXEL_EDGE (W)) | 671 | + WINDOW_LEFT_PIXEL_EDGE (W)) |
| 636 | 672 | ||
| 637 | /* Return the frame x- position before which window W ends. | 673 | /* Return the frame x- position before which window W ends. |
| 638 | This includes a right-hand scroll bar, if any. */ | 674 | This includes a right-hand scroll bar, if any. */ |
| 639 | |||
| 640 | #define WINDOW_RIGHT_EDGE_X(W) \ | 675 | #define WINDOW_RIGHT_EDGE_X(W) \ |
| 641 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ | 676 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ |
| 642 | + WINDOW_RIGHT_PIXEL_EDGE (W)) | 677 | + WINDOW_RIGHT_PIXEL_EDGE (W)) |
| 643 | 678 | ||
| 644 | /* True if W is a menu bar window. */ | 679 | /* True if W is a menu bar window. */ |
| 645 | |||
| 646 | #if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) | 680 | #if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) |
| 647 | #define WINDOW_MENU_BAR_P(W) \ | 681 | #define WINDOW_MENU_BAR_P(W) \ |
| 648 | (WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \ | 682 | (WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \ |
| @@ -661,72 +695,24 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 661 | #define WINDOW_TOOL_BAR_P(W) false | 695 | #define WINDOW_TOOL_BAR_P(W) false |
| 662 | #endif | 696 | #endif |
| 663 | 697 | ||
| 664 | /* Return the frame y-position at which window W starts. | 698 | /* Return the frame y-position at which window W starts. */ |
| 665 | This includes a header line, if any. | ||
| 666 | |||
| 667 | PXW: With a menu or tool bar this is not symmetric to the _X values | ||
| 668 | since it _does_ include the internal border width. */ | ||
| 669 | #define WINDOW_TOP_EDGE_Y(W) \ | 699 | #define WINDOW_TOP_EDGE_Y(W) \ |
| 670 | (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \ | 700 | (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \ |
| 671 | ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \ | 701 | ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \ |
| 672 | + WINDOW_TOP_PIXEL_EDGE (W)) | 702 | + WINDOW_TOP_PIXEL_EDGE (W)) |
| 673 | 703 | ||
| 674 | /* Return the frame y-position before which window W ends. | 704 | /* Return the frame y-position before which window W ends. */ |
| 675 | This includes a mode line, if any. */ | ||
| 676 | #define WINDOW_BOTTOM_EDGE_Y(W) \ | 705 | #define WINDOW_BOTTOM_EDGE_Y(W) \ |
| 677 | (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \ | 706 | (((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \ |
| 678 | ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \ | 707 | ? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \ |
| 679 | + WINDOW_BOTTOM_PIXEL_EDGE (W)) | 708 | + WINDOW_BOTTOM_PIXEL_EDGE (W)) |
| 680 | 709 | ||
| 681 | /* True if window W takes up the full width of its frame. */ | 710 | /* Return the pixel value where the text (or left fringe) in window W |
| 682 | #define WINDOW_FULL_WIDTH_P(W) \ | 711 | starts. */ |
| 683 | (WINDOW_PIXEL_WIDTH (W) \ | ||
| 684 | == (WINDOW_PIXEL_WIDTH \ | ||
| 685 | (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ | ||
| 686 | |||
| 687 | /* True if window W's has no other windows to its left in its frame. */ | ||
| 688 | |||
| 689 | #define WINDOW_LEFTMOST_P(W) \ | ||
| 690 | (WINDOW_LEFT_PIXEL_EDGE (W) == 0) | ||
| 691 | |||
| 692 | /* True if window W's has no other windows above in its frame. */ | ||
| 693 | #define WINDOW_TOPMOST_P(W) \ | ||
| 694 | (WINDOW_TOP_PIXEL_EDGE (W) == 0) | ||
| 695 | |||
| 696 | /* True if window W's has no other windows to its right in its frame. */ | ||
| 697 | #define WINDOW_RIGHTMOST_P(W) \ | ||
| 698 | (WINDOW_RIGHT_PIXEL_EDGE (W) \ | ||
| 699 | == (WINDOW_RIGHT_PIXEL_EDGE \ | ||
| 700 | (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ | ||
| 701 | |||
| 702 | /* True if window W's has no other windows below it in its frame | ||
| 703 | (the minibuffer window is not counted in this respect). */ | ||
| 704 | #define WINDOW_BOTTOMMOST_P(W) \ | ||
| 705 | (WINDOW_BOTTOM_PIXEL_EDGE (W) \ | ||
| 706 | == (WINDOW_BOTTOM_PIXEL_EDGE \ | ||
| 707 | (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ | ||
| 708 | |||
| 709 | /* Return the frame column at which the text (or left fringe) in | ||
| 710 | window W starts. This is different from the `LEFT_EDGE' because it | ||
| 711 | does not include a left-hand scroll bar if any. */ | ||
| 712 | #define WINDOW_BOX_LEFT_EDGE_COL(W) \ | ||
| 713 | (WINDOW_LEFT_EDGE_COL (W) \ | ||
| 714 | + WINDOW_LEFT_SCROLL_BAR_COLS (W)) | ||
| 715 | |||
| 716 | /* Return the pixel value where the text (or left fringe) in | ||
| 717 | window W starts. This is different from the `LEFT_EDGE' because it | ||
| 718 | does not include a left-hand scroll bar if any. */ | ||
| 719 | #define WINDOW_BOX_LEFT_PIXEL_EDGE(W) \ | 712 | #define WINDOW_BOX_LEFT_PIXEL_EDGE(W) \ |
| 720 | (WINDOW_LEFT_PIXEL_EDGE (W) \ | 713 | (WINDOW_LEFT_PIXEL_EDGE (W) \ |
| 721 | + WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (W)) | 714 | + WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (W)) |
| 722 | 715 | ||
| 723 | /* Return the window column before which the text in window W ends. | ||
| 724 | This is different from WINDOW_RIGHT_EDGE_COL because it does not | ||
| 725 | include a scroll bar or window-separating line on the right edge. */ | ||
| 726 | #define WINDOW_BOX_RIGHT_EDGE_COL(W) \ | ||
| 727 | (WINDOW_RIGHT_EDGE_COL (W) \ | ||
| 728 | - WINDOW_RIGHT_SCROLL_BAR_COLS (W)) | ||
| 729 | |||
| 730 | /* Return the pixel value before which the text in window W ends. This | 716 | /* Return the pixel value before which the text in window W ends. This |
| 731 | is different from the `RIGHT_EDGE' because it does not include a | 717 | is different from the `RIGHT_EDGE' because it does not include a |
| 732 | right-hand scroll bar or window-separating line on the right | 718 | right-hand scroll bar or window-separating line on the right |
| @@ -736,16 +722,16 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 736 | - WINDOW_RIGHT_DIVIDER_WIDTH (W) \ | 722 | - WINDOW_RIGHT_DIVIDER_WIDTH (W) \ |
| 737 | - WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (W)) | 723 | - WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (W)) |
| 738 | 724 | ||
| 739 | /* Return the frame position at which the text (or left fringe) in | 725 | /* Return the frame x-position at which the text (or left fringe) in |
| 740 | window W starts. This is different from the `LEFT_EDGE' because it | 726 | window W starts. This does not include a left-hand scroll bar if |
| 741 | does not include a left-hand scroll bar if any. */ | 727 | any. */ |
| 742 | #define WINDOW_BOX_LEFT_EDGE_X(W) \ | 728 | #define WINDOW_BOX_LEFT_EDGE_X(W) \ |
| 743 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ | 729 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ |
| 744 | + WINDOW_BOX_LEFT_PIXEL_EDGE (W)) | 730 | + WINDOW_BOX_LEFT_PIXEL_EDGE (W)) |
| 745 | 731 | ||
| 746 | /* Return the window column before which the text in window W ends. | 732 | /* Return the frame x-position before which the text in window W ends. |
| 747 | This is different from WINDOW_RIGHT_EDGE_COL because it does not | 733 | This does not include a scroll bar, divider or window-separating line |
| 748 | include a scroll bar or window-separating line on the right edge. */ | 734 | on the right edge. */ |
| 749 | #define WINDOW_BOX_RIGHT_EDGE_X(W) \ | 735 | #define WINDOW_BOX_RIGHT_EDGE_X(W) \ |
| 750 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ | 736 | (FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \ |
| 751 | + WINDOW_BOX_RIGHT_PIXEL_EDGE (W)) | 737 | + WINDOW_BOX_RIGHT_PIXEL_EDGE (W)) |
| @@ -899,16 +885,6 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 899 | ? WINDOW_BOX_RIGHT_EDGE_X (W) \ | 885 | ? WINDOW_BOX_RIGHT_EDGE_X (W) \ |
| 900 | : WINDOW_LEFT_EDGE_X (W)) | 886 | : WINDOW_LEFT_EDGE_X (W)) |
| 901 | 887 | ||
| 902 | /* Width of bottom divider of window W. */ | ||
| 903 | #define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \ | ||
| 904 | (((WINDOW_BOTTOMMOST_P (W) \ | ||
| 905 | && NILP ((XWINDOW (FRAME_ROOT_WINDOW \ | ||
| 906 | (WINDOW_XFRAME (W))))->next)) \ | ||
| 907 | || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \ | ||
| 908 | || (W)->pseudo_window_p) \ | ||
| 909 | ? 0 \ | ||
| 910 | : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W))) | ||
| 911 | |||
| 912 | /* Height that a scroll bar in window W should have, if there is one. | 888 | /* Height that a scroll bar in window W should have, if there is one. |
| 913 | Measured in pixels. If scroll bars are turned off, this is still | 889 | Measured in pixels. If scroll bars are turned off, this is still |
| 914 | nonzero. */ | 890 | nonzero. */ |
| @@ -942,22 +918,22 @@ wset_next_buffers (struct window *w, Lisp_Object val) | |||
| 942 | /* Height in pixels of the mode line. | 918 | /* Height in pixels of the mode line. |
| 943 | May be zero if W doesn't have a mode line. */ | 919 | May be zero if W doesn't have a mode line. */ |
| 944 | #define WINDOW_MODE_LINE_HEIGHT(W) \ | 920 | #define WINDOW_MODE_LINE_HEIGHT(W) \ |
| 945 | (WINDOW_WANTS_MODELINE_P ((W)) \ | 921 | (window_wants_mode_line ((W)) \ |
| 946 | ? CURRENT_MODE_LINE_HEIGHT (W) \ | 922 | ? CURRENT_MODE_LINE_HEIGHT (W) \ |
| 947 | : 0) | 923 | : 0) |
| 948 | 924 | ||
| 949 | #define WINDOW_MODE_LINE_LINES(W) \ | 925 | #define WINDOW_MODE_LINE_LINES(W) \ |
| 950 | WINDOW_WANTS_MODELINE_P (W) | 926 | window_wants_mode_line (W) |
| 951 | 927 | ||
| 952 | /* Height in pixels of the header line. | 928 | /* Height in pixels of the header line. |
| 953 | Zero if W doesn't have a header line. */ | 929 | Zero if W doesn't have a header line. */ |
| 954 | #define WINDOW_HEADER_LINE_HEIGHT(W) \ | 930 | #define WINDOW_HEADER_LINE_HEIGHT(W) \ |
| 955 | (WINDOW_WANTS_HEADER_LINE_P (W) \ | 931 | (window_wants_header_line (W) \ |
| 956 | ? CURRENT_HEADER_LINE_HEIGHT (W) \ | 932 | ? CURRENT_HEADER_LINE_HEIGHT (W) \ |
| 957 | : 0) | 933 | : 0) |
| 958 | 934 | ||
| 959 | #define WINDOW_HEADER_LINE_LINES(W) \ | 935 | #define WINDOW_HEADER_LINE_LINES(W) \ |
| 960 | WINDOW_WANTS_HEADER_LINE_P (W) | 936 | window_wants_header_line (W) |
| 961 | 937 | ||
| 962 | /* Pixel height of window W without mode line, bottom scroll bar and | 938 | /* Pixel height of window W without mode line, bottom scroll bar and |
| 963 | bottom divider. */ | 939 | bottom divider. */ |
| @@ -1114,10 +1090,13 @@ struct glyph *get_phys_cursor_glyph (struct window *w); | |||
| 1114 | extern Lisp_Object Vwindow_list; | 1090 | extern Lisp_Object Vwindow_list; |
| 1115 | 1091 | ||
| 1116 | extern Lisp_Object window_list (void); | 1092 | extern Lisp_Object window_list (void); |
| 1093 | extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter); | ||
| 1117 | extern struct window *decode_live_window (Lisp_Object); | 1094 | extern struct window *decode_live_window (Lisp_Object); |
| 1118 | extern struct window *decode_any_window (Lisp_Object); | 1095 | extern struct window *decode_any_window (Lisp_Object); |
| 1119 | extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); | 1096 | extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); |
| 1120 | extern void mark_window_cursors_off (struct window *); | 1097 | extern void mark_window_cursors_off (struct window *); |
| 1098 | extern bool window_wants_mode_line (struct window *); | ||
| 1099 | extern bool window_wants_header_line (struct window *); | ||
| 1121 | extern int window_internal_height (struct window *); | 1100 | extern int window_internal_height (struct window *); |
| 1122 | extern int window_body_width (struct window *w, bool); | 1101 | extern int window_body_width (struct window *w, bool); |
| 1123 | enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS }; | 1102 | enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS }; |
| @@ -1133,7 +1112,6 @@ extern void init_window_once (void); | |||
| 1133 | extern void init_window (void); | 1112 | extern void init_window (void); |
| 1134 | extern void syms_of_window (void); | 1113 | extern void syms_of_window (void); |
| 1135 | extern void keys_of_window (void); | 1114 | extern void keys_of_window (void); |
| 1136 | |||
| 1137 | /* Move cursor to row/column position VPOS/HPOS, pixel coordinates | 1115 | /* Move cursor to row/column position VPOS/HPOS, pixel coordinates |
| 1138 | Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y | 1116 | Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y |
| 1139 | are window-relative pixel positions. This is always done during | 1117 | are window-relative pixel positions. This is always done during |
diff --git a/src/xdisp.c b/src/xdisp.c index 34ee877e6be..8bc5d81f448 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -921,7 +921,7 @@ window_text_bottom_y (struct window *w) | |||
| 921 | 921 | ||
| 922 | height -= WINDOW_BOTTOM_DIVIDER_WIDTH (w); | 922 | height -= WINDOW_BOTTOM_DIVIDER_WIDTH (w); |
| 923 | 923 | ||
| 924 | if (WINDOW_WANTS_MODELINE_P (w)) | 924 | if (window_wants_mode_line (w)) |
| 925 | height -= CURRENT_MODE_LINE_HEIGHT (w); | 925 | height -= CURRENT_MODE_LINE_HEIGHT (w); |
| 926 | 926 | ||
| 927 | height -= WINDOW_SCROLL_BAR_AREA_HEIGHT (w); | 927 | height -= WINDOW_SCROLL_BAR_AREA_HEIGHT (w); |
| @@ -978,7 +978,7 @@ window_box_height (struct window *w) | |||
| 978 | the appropriate glyph row has its `mode_line_p' flag set, | 978 | the appropriate glyph row has its `mode_line_p' flag set, |
| 979 | and if it doesn't, uses estimate_mode_line_height instead. */ | 979 | and if it doesn't, uses estimate_mode_line_height instead. */ |
| 980 | 980 | ||
| 981 | if (WINDOW_WANTS_MODELINE_P (w)) | 981 | if (window_wants_mode_line (w)) |
| 982 | { | 982 | { |
| 983 | struct glyph_row *ml_row | 983 | struct glyph_row *ml_row |
| 984 | = (w->current_matrix && w->current_matrix->rows | 984 | = (w->current_matrix && w->current_matrix->rows |
| @@ -990,7 +990,7 @@ window_box_height (struct window *w) | |||
| 990 | height -= estimate_mode_line_height (f, CURRENT_MODE_LINE_FACE_ID (w)); | 990 | height -= estimate_mode_line_height (f, CURRENT_MODE_LINE_FACE_ID (w)); |
| 991 | } | 991 | } |
| 992 | 992 | ||
| 993 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 993 | if (window_wants_header_line (w)) |
| 994 | { | 994 | { |
| 995 | struct glyph_row *hl_row | 995 | struct glyph_row *hl_row |
| 996 | = (w->current_matrix && w->current_matrix->rows | 996 | = (w->current_matrix && w->current_matrix->rows |
| @@ -1102,7 +1102,7 @@ window_box (struct window *w, enum glyph_row_area area, int *box_x, | |||
| 1102 | if (box_y) | 1102 | if (box_y) |
| 1103 | { | 1103 | { |
| 1104 | *box_y = WINDOW_TOP_EDGE_Y (w); | 1104 | *box_y = WINDOW_TOP_EDGE_Y (w); |
| 1105 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 1105 | if (window_wants_header_line (w)) |
| 1106 | *box_y += CURRENT_HEADER_LINE_HEIGHT (w); | 1106 | *box_y += CURRENT_HEADER_LINE_HEIGHT (w); |
| 1107 | } | 1107 | } |
| 1108 | } | 1108 | } |
| @@ -1322,15 +1322,29 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, | |||
| 1322 | return visible_p; | 1322 | return visible_p; |
| 1323 | 1323 | ||
| 1324 | /* Compute exact mode line heights. */ | 1324 | /* Compute exact mode line heights. */ |
| 1325 | if (WINDOW_WANTS_MODELINE_P (w)) | 1325 | if (window_wants_mode_line (w)) |
| 1326 | w->mode_line_height | 1326 | { |
| 1327 | = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), | 1327 | Lisp_Object window_mode_line_format |
| 1328 | BVAR (current_buffer, mode_line_format)); | 1328 | = window_parameter (w, Qmode_line_format); |
| 1329 | |||
| 1330 | w->mode_line_height | ||
| 1331 | = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), | ||
| 1332 | NILP (window_mode_line_format) | ||
| 1333 | ? BVAR (current_buffer, mode_line_format) | ||
| 1334 | : window_mode_line_format); | ||
| 1335 | } | ||
| 1329 | 1336 | ||
| 1330 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 1337 | if (window_wants_header_line (w)) |
| 1331 | w->header_line_height | 1338 | { |
| 1332 | = display_mode_line (w, HEADER_LINE_FACE_ID, | 1339 | Lisp_Object window_header_line_format |
| 1333 | BVAR (current_buffer, header_line_format)); | 1340 | = window_parameter (w, Qheader_line_format); |
| 1341 | |||
| 1342 | w->header_line_height | ||
| 1343 | = display_mode_line (w, HEADER_LINE_FACE_ID, | ||
| 1344 | NILP (window_header_line_format) | ||
| 1345 | ? BVAR (current_buffer, header_line_format) | ||
| 1346 | : window_header_line_format); | ||
| 1347 | } | ||
| 1334 | 1348 | ||
| 1335 | start_display (&it, w, top); | 1349 | start_display (&it, w, top); |
| 1336 | move_it_to (&it, charpos, -1, it.last_visible_y - 1, -1, | 1350 | move_it_to (&it, charpos, -1, it.last_visible_y - 1, -1, |
| @@ -2842,13 +2856,12 @@ init_iterator (struct it *it, struct window *w, | |||
| 2842 | 2856 | ||
| 2843 | /* Get dimensions of truncation and continuation glyphs. These are | 2857 | /* Get dimensions of truncation and continuation glyphs. These are |
| 2844 | displayed as fringe bitmaps under X, but we need them for such | 2858 | displayed as fringe bitmaps under X, but we need them for such |
| 2845 | frames when the fringes are turned off. But leave the dimensions | 2859 | frames when the fringes are turned off. The no_special_glyphs slot |
| 2846 | zero for tooltip frames, as these glyphs look ugly there and also | 2860 | of the iterator's frame, when set, suppresses their display - by |
| 2847 | sabotage calculations of tooltip dimensions in x-show-tip. */ | 2861 | default for tooltip frames and when set via the 'no-special-glyphs' |
| 2862 | frame parameter. */ | ||
| 2848 | #ifdef HAVE_WINDOW_SYSTEM | 2863 | #ifdef HAVE_WINDOW_SYSTEM |
| 2849 | if (!(FRAME_WINDOW_P (it->f) | 2864 | if (!(FRAME_WINDOW_P (it->f) && it->f->no_special_glyphs)) |
| 2850 | && FRAMEP (tip_frame) | ||
| 2851 | && it->f == XFRAME (tip_frame))) | ||
| 2852 | #endif | 2865 | #endif |
| 2853 | { | 2866 | { |
| 2854 | if (it->line_wrap == TRUNCATE) | 2867 | if (it->line_wrap == TRUNCATE) |
| @@ -2920,7 +2933,7 @@ init_iterator (struct it *it, struct window *w, | |||
| 2920 | it->last_visible_x -= it->continuation_pixel_width; | 2933 | it->last_visible_x -= it->continuation_pixel_width; |
| 2921 | } | 2934 | } |
| 2922 | 2935 | ||
| 2923 | it->header_line_p = WINDOW_WANTS_HEADER_LINE_P (w); | 2936 | it->header_line_p = window_wants_header_line (w); |
| 2924 | it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll; | 2937 | it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll; |
| 2925 | } | 2938 | } |
| 2926 | 2939 | ||
| @@ -3019,7 +3032,7 @@ void | |||
| 3019 | start_display (struct it *it, struct window *w, struct text_pos pos) | 3032 | start_display (struct it *it, struct window *w, struct text_pos pos) |
| 3020 | { | 3033 | { |
| 3021 | struct glyph_row *row; | 3034 | struct glyph_row *row; |
| 3022 | bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w); | 3035 | bool first_vpos = window_wants_header_line (w); |
| 3023 | 3036 | ||
| 3024 | row = w->desired_matrix->rows + first_vpos; | 3037 | row = w->desired_matrix->rows + first_vpos; |
| 3025 | init_iterator (it, w, CHARPOS (pos), BYTEPOS (pos), row, DEFAULT_FACE_ID); | 3038 | init_iterator (it, w, CHARPOS (pos), BYTEPOS (pos), row, DEFAULT_FACE_ID); |
| @@ -7755,9 +7768,8 @@ next_element_from_display_vector (struct it *it) | |||
| 7755 | 7768 | ||
| 7756 | /* KFS: This code used to check ip->dpvec[0] instead of the current element. | 7769 | /* KFS: This code used to check ip->dpvec[0] instead of the current element. |
| 7757 | That seemed totally bogus - so I changed it... */ | 7770 | That seemed totally bogus - so I changed it... */ |
| 7758 | gc = it->dpvec[it->current.dpvec_index]; | 7771 | if (it->dpend - it->dpvec > 0 /* empty dpvec[] is invalid */ |
| 7759 | 7772 | && (gc = it->dpvec[it->current.dpvec_index], GLYPH_CODE_P (gc))) | |
| 7760 | if (GLYPH_CODE_P (gc)) | ||
| 7761 | { | 7773 | { |
| 7762 | struct face *this_face, *prev_face, *next_face; | 7774 | struct face *this_face, *prev_face, *next_face; |
| 7763 | 7775 | ||
| @@ -15799,7 +15811,7 @@ compute_window_start_on_continuation_line (struct window *w) | |||
| 15799 | 15811 | ||
| 15800 | /* Find the start of the continued line. This should be fast | 15812 | /* Find the start of the continued line. This should be fast |
| 15801 | because find_newline is fast (newline cache). */ | 15813 | because find_newline is fast (newline cache). */ |
| 15802 | row = w->desired_matrix->rows + WINDOW_WANTS_HEADER_LINE_P (w); | 15814 | row = w->desired_matrix->rows + window_wants_header_line (w); |
| 15803 | init_iterator (&it, w, CHARPOS (start_pos), BYTEPOS (start_pos), | 15815 | init_iterator (&it, w, CHARPOS (start_pos), BYTEPOS (start_pos), |
| 15804 | row, DEFAULT_FACE_ID); | 15816 | row, DEFAULT_FACE_ID); |
| 15805 | reseat_at_previous_visible_line_start (&it); | 15817 | reseat_at_previous_visible_line_start (&it); |
| @@ -15949,7 +15961,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, | |||
| 15949 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); | 15961 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 15950 | 15962 | ||
| 15951 | top_scroll_margin = this_scroll_margin; | 15963 | top_scroll_margin = this_scroll_margin; |
| 15952 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 15964 | if (window_wants_header_line (w)) |
| 15953 | top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); | 15965 | top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); |
| 15954 | 15966 | ||
| 15955 | /* Start with the row the cursor was displayed during the last | 15967 | /* Start with the row the cursor was displayed during the last |
| @@ -16732,7 +16744,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 16732 | margin, even though this part handles windows that didn't | 16744 | margin, even though this part handles windows that didn't |
| 16733 | scroll at all. */ | 16745 | scroll at all. */ |
| 16734 | int pixel_margin = margin * frame_line_height; | 16746 | int pixel_margin = margin * frame_line_height; |
| 16735 | bool header_line = WINDOW_WANTS_HEADER_LINE_P (w); | 16747 | bool header_line = window_wants_header_line (w); |
| 16736 | 16748 | ||
| 16737 | /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop | 16749 | /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop |
| 16738 | below, which finds the row to move point to, advances by | 16750 | below, which finds the row to move point to, advances by |
| @@ -17299,15 +17311,15 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 17299 | || (w->column_number_displayed != -1 | 17311 | || (w->column_number_displayed != -1 |
| 17300 | && (w->column_number_displayed != current_column ()))) | 17312 | && (w->column_number_displayed != current_column ()))) |
| 17301 | /* This means that the window has a mode line. */ | 17313 | /* This means that the window has a mode line. */ |
| 17302 | && (WINDOW_WANTS_MODELINE_P (w) | 17314 | && (window_wants_mode_line (w) |
| 17303 | || WINDOW_WANTS_HEADER_LINE_P (w))) | 17315 | || window_wants_header_line (w))) |
| 17304 | { | 17316 | { |
| 17305 | 17317 | ||
| 17306 | display_mode_lines (w); | 17318 | display_mode_lines (w); |
| 17307 | 17319 | ||
| 17308 | /* If mode line height has changed, arrange for a thorough | 17320 | /* If mode line height has changed, arrange for a thorough |
| 17309 | immediate redisplay using the correct mode line height. */ | 17321 | immediate redisplay using the correct mode line height. */ |
| 17310 | if (WINDOW_WANTS_MODELINE_P (w) | 17322 | if (window_wants_mode_line (w) |
| 17311 | && CURRENT_MODE_LINE_HEIGHT (w) != DESIRED_MODE_LINE_HEIGHT (w)) | 17323 | && CURRENT_MODE_LINE_HEIGHT (w) != DESIRED_MODE_LINE_HEIGHT (w)) |
| 17312 | { | 17324 | { |
| 17313 | f->fonts_changed = true; | 17325 | f->fonts_changed = true; |
| @@ -17318,7 +17330,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 17318 | 17330 | ||
| 17319 | /* If header line height has changed, arrange for a thorough | 17331 | /* If header line height has changed, arrange for a thorough |
| 17320 | immediate redisplay using the correct header line height. */ | 17332 | immediate redisplay using the correct header line height. */ |
| 17321 | if (WINDOW_WANTS_HEADER_LINE_P (w) | 17333 | if (window_wants_header_line (w) |
| 17322 | && CURRENT_HEADER_LINE_HEIGHT (w) != DESIRED_HEADER_LINE_HEIGHT (w)) | 17334 | && CURRENT_HEADER_LINE_HEIGHT (w) != DESIRED_HEADER_LINE_HEIGHT (w)) |
| 17323 | { | 17335 | { |
| 17324 | f->fonts_changed = true; | 17336 | f->fonts_changed = true; |
| @@ -17583,7 +17595,7 @@ try_window_reusing_current_matrix (struct window *w) | |||
| 17583 | return false; | 17595 | return false; |
| 17584 | 17596 | ||
| 17585 | /* If top-line visibility has changed, give up. */ | 17597 | /* If top-line visibility has changed, give up. */ |
| 17586 | if (WINDOW_WANTS_HEADER_LINE_P (w) | 17598 | if (window_wants_header_line (w) |
| 17587 | != MATRIX_HEADER_LINE_ROW (w->current_matrix)->mode_line_p) | 17599 | != MATRIX_HEADER_LINE_ROW (w->current_matrix)->mode_line_p) |
| 17588 | return false; | 17600 | return false; |
| 17589 | 17601 | ||
| @@ -18818,7 +18830,7 @@ try_window_id (struct window *w) | |||
| 18818 | = MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix); | 18830 | = MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix); |
| 18819 | int from = WINDOW_TOP_EDGE_LINE (w) + from_vpos; | 18831 | int from = WINDOW_TOP_EDGE_LINE (w) + from_vpos; |
| 18820 | int end = (WINDOW_TOP_EDGE_LINE (w) | 18832 | int end = (WINDOW_TOP_EDGE_LINE (w) |
| 18821 | + WINDOW_WANTS_HEADER_LINE_P (w) | 18833 | + window_wants_header_line (w) |
| 18822 | + window_internal_height (w)); | 18834 | + window_internal_height (w)); |
| 18823 | 18835 | ||
| 18824 | #if defined (HAVE_GPM) || defined (MSDOS) | 18836 | #if defined (HAVE_GPM) || defined (MSDOS) |
| @@ -18996,7 +19008,7 @@ try_window_id (struct window *w) | |||
| 18996 | { | 19008 | { |
| 18997 | /* Displayed to end of window, but no line containing text was | 19009 | /* Displayed to end of window, but no line containing text was |
| 18998 | displayed. Lines were deleted at the end of the window. */ | 19010 | displayed. Lines were deleted at the end of the window. */ |
| 18999 | bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w); | 19011 | bool first_vpos = window_wants_header_line (w); |
| 19000 | int vpos = w->window_end_vpos; | 19012 | int vpos = w->window_end_vpos; |
| 19001 | struct glyph_row *current_row = current_matrix->rows + vpos; | 19013 | struct glyph_row *current_row = current_matrix->rows + vpos; |
| 19002 | struct glyph_row *desired_row = desired_matrix->rows + vpos; | 19014 | struct glyph_row *desired_row = desired_matrix->rows + vpos; |
| @@ -20696,7 +20708,7 @@ display_line (struct it *it, int cursor_vpos) | |||
| 20696 | ptrdiff_t min_pos = ZV + 1, max_pos = 0; | 20708 | ptrdiff_t min_pos = ZV + 1, max_pos = 0; |
| 20697 | ptrdiff_t min_bpos UNINIT, max_bpos UNINIT; | 20709 | ptrdiff_t min_bpos UNINIT, max_bpos UNINIT; |
| 20698 | bool pending_handle_line_prefix = false; | 20710 | bool pending_handle_line_prefix = false; |
| 20699 | int header_line = WINDOW_WANTS_HEADER_LINE_P (it->w); | 20711 | int header_line = window_wants_header_line (it->w); |
| 20700 | bool hscroll_this_line = (cursor_vpos >= 0 | 20712 | bool hscroll_this_line = (cursor_vpos >= 0 |
| 20701 | && it->vpos == cursor_vpos - header_line | 20713 | && it->vpos == cursor_vpos - header_line |
| 20702 | && hscrolling_current_line_p (it->w)); | 20714 | && hscrolling_current_line_p (it->w)); |
| @@ -22649,20 +22661,30 @@ display_mode_lines (struct window *w) | |||
| 22649 | line_number_displayed = false; | 22661 | line_number_displayed = false; |
| 22650 | w->column_number_displayed = -1; | 22662 | w->column_number_displayed = -1; |
| 22651 | 22663 | ||
| 22652 | if (WINDOW_WANTS_MODELINE_P (w)) | 22664 | if (window_wants_mode_line (w)) |
| 22653 | { | 22665 | { |
| 22666 | Lisp_Object window_mode_line_format | ||
| 22667 | = window_parameter (w, Qmode_line_format); | ||
| 22668 | |||
| 22654 | struct window *sel_w = XWINDOW (old_selected_window); | 22669 | struct window *sel_w = XWINDOW (old_selected_window); |
| 22655 | 22670 | ||
| 22656 | /* Select mode line face based on the real selected window. */ | 22671 | /* Select mode line face based on the real selected window. */ |
| 22657 | display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), | 22672 | display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), |
| 22658 | BVAR (current_buffer, mode_line_format)); | 22673 | NILP (window_mode_line_format) |
| 22674 | ? BVAR (current_buffer, mode_line_format) | ||
| 22675 | : window_mode_line_format); | ||
| 22659 | ++n; | 22676 | ++n; |
| 22660 | } | 22677 | } |
| 22661 | 22678 | ||
| 22662 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 22679 | if (window_wants_header_line (w)) |
| 22663 | { | 22680 | { |
| 22681 | Lisp_Object window_header_line_format | ||
| 22682 | = window_parameter (w, Qheader_line_format); | ||
| 22683 | |||
| 22664 | display_mode_line (w, HEADER_LINE_FACE_ID, | 22684 | display_mode_line (w, HEADER_LINE_FACE_ID, |
| 22665 | BVAR (current_buffer, header_line_format)); | 22685 | NILP (window_header_line_format) |
| 22686 | ? BVAR (current_buffer, header_line_format) | ||
| 22687 | : window_header_line_format); | ||
| 22666 | ++n; | 22688 | ++n; |
| 22667 | } | 22689 | } |
| 22668 | 22690 | ||
| @@ -30442,13 +30464,67 @@ note_mouse_highlight (struct frame *f, int x, int y) | |||
| 30442 | && part != ON_HEADER_LINE)) | 30464 | && part != ON_HEADER_LINE)) |
| 30443 | clear_mouse_face (hlinfo); | 30465 | clear_mouse_face (hlinfo); |
| 30444 | 30466 | ||
| 30467 | /* Reset help_echo_string. It will get recomputed below. */ | ||
| 30468 | help_echo_string = Qnil; | ||
| 30469 | |||
| 30470 | #ifdef HAVE_WINDOW_SYSTEM | ||
| 30471 | /* If the cursor is on the internal border of FRAME and FRAME's | ||
| 30472 | internal border is draggable, provide some visual feedback. */ | ||
| 30473 | if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0 | ||
| 30474 | && !NILP (get_frame_param (f, Qdrag_internal_border))) | ||
| 30475 | { | ||
| 30476 | enum internal_border_part part = frame_internal_border_part (f, x, y); | ||
| 30477 | |||
| 30478 | switch (part) | ||
| 30479 | { | ||
| 30480 | case INTERNAL_BORDER_NONE: | ||
| 30481 | if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor) | ||
| 30482 | /* Reset cursor. */ | ||
| 30483 | cursor = FRAME_X_OUTPUT (f)->nontext_cursor; | ||
| 30484 | break; | ||
| 30485 | case INTERNAL_BORDER_LEFT_EDGE: | ||
| 30486 | cursor = FRAME_X_OUTPUT (f)->left_edge_cursor; | ||
| 30487 | break; | ||
| 30488 | case INTERNAL_BORDER_TOP_LEFT_CORNER: | ||
| 30489 | cursor = FRAME_X_OUTPUT (f)->top_left_corner_cursor; | ||
| 30490 | break; | ||
| 30491 | case INTERNAL_BORDER_TOP_EDGE: | ||
| 30492 | cursor = FRAME_X_OUTPUT (f)->top_edge_cursor; | ||
| 30493 | break; | ||
| 30494 | case INTERNAL_BORDER_TOP_RIGHT_CORNER: | ||
| 30495 | cursor = FRAME_X_OUTPUT (f)->top_right_corner_cursor; | ||
| 30496 | break; | ||
| 30497 | case INTERNAL_BORDER_RIGHT_EDGE: | ||
| 30498 | cursor = FRAME_X_OUTPUT (f)->right_edge_cursor; | ||
| 30499 | break; | ||
| 30500 | case INTERNAL_BORDER_BOTTOM_RIGHT_CORNER: | ||
| 30501 | cursor = FRAME_X_OUTPUT (f)->bottom_right_corner_cursor; | ||
| 30502 | break; | ||
| 30503 | case INTERNAL_BORDER_BOTTOM_EDGE: | ||
| 30504 | cursor = FRAME_X_OUTPUT (f)->bottom_edge_cursor; | ||
| 30505 | break; | ||
| 30506 | case INTERNAL_BORDER_BOTTOM_LEFT_CORNER: | ||
| 30507 | cursor = FRAME_X_OUTPUT (f)->bottom_left_corner_cursor; | ||
| 30508 | break; | ||
| 30509 | default: | ||
| 30510 | /* This should not happen. */ | ||
| 30511 | if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor) | ||
| 30512 | cursor = FRAME_X_OUTPUT (f)->nontext_cursor; | ||
| 30513 | } | ||
| 30514 | |||
| 30515 | if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor) | ||
| 30516 | { | ||
| 30517 | /* Do we really want a help echo here? */ | ||
| 30518 | help_echo_string = build_string ("drag-mouse-1: resize frame"); | ||
| 30519 | goto set_cursor; | ||
| 30520 | } | ||
| 30521 | } | ||
| 30522 | #endif /* HAVE_WINDOW_SYSTEM */ | ||
| 30523 | |||
| 30445 | /* Not on a window -> return. */ | 30524 | /* Not on a window -> return. */ |
| 30446 | if (!WINDOWP (window)) | 30525 | if (!WINDOWP (window)) |
| 30447 | return; | 30526 | return; |
| 30448 | 30527 | ||
| 30449 | /* Reset help_echo_string. It will get recomputed below. */ | ||
| 30450 | help_echo_string = Qnil; | ||
| 30451 | |||
| 30452 | /* Convert to window-relative pixel coordinates. */ | 30528 | /* Convert to window-relative pixel coordinates. */ |
| 30453 | w = XWINDOW (window); | 30529 | w = XWINDOW (window); |
| 30454 | frame_to_window_pixel_xy (w, &x, &y); | 30530 | frame_to_window_pixel_xy (w, &x, &y); |
| @@ -30486,11 +30562,13 @@ note_mouse_highlight (struct frame *f, int x, int y) | |||
| 30486 | { | 30562 | { |
| 30487 | cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; | 30563 | cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; |
| 30488 | help_echo_string = build_string ("drag-mouse-1: resize"); | 30564 | help_echo_string = build_string ("drag-mouse-1: resize"); |
| 30565 | goto set_cursor; | ||
| 30489 | } | 30566 | } |
| 30490 | else if (part == ON_RIGHT_DIVIDER) | 30567 | else if (part == ON_RIGHT_DIVIDER) |
| 30491 | { | 30568 | { |
| 30492 | cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; | 30569 | cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; |
| 30493 | help_echo_string = build_string ("drag-mouse-1: resize"); | 30570 | help_echo_string = build_string ("drag-mouse-1: resize"); |
| 30571 | goto set_cursor; | ||
| 30494 | } | 30572 | } |
| 30495 | else if (part == ON_BOTTOM_DIVIDER) | 30573 | else if (part == ON_BOTTOM_DIVIDER) |
| 30496 | if (! WINDOW_BOTTOMMOST_P (w) | 30574 | if (! WINDOW_BOTTOMMOST_P (w) |
| @@ -30499,6 +30577,7 @@ note_mouse_highlight (struct frame *f, int x, int y) | |||
| 30499 | { | 30577 | { |
| 30500 | cursor = FRAME_X_OUTPUT (f)->vertical_drag_cursor; | 30578 | cursor = FRAME_X_OUTPUT (f)->vertical_drag_cursor; |
| 30501 | help_echo_string = build_string ("drag-mouse-1: resize"); | 30579 | help_echo_string = build_string ("drag-mouse-1: resize"); |
| 30580 | goto set_cursor; | ||
| 30502 | } | 30581 | } |
| 30503 | else | 30582 | else |
| 30504 | cursor = FRAME_X_OUTPUT (f)->nontext_cursor; | 30583 | cursor = FRAME_X_OUTPUT (f)->nontext_cursor; |
| @@ -31193,8 +31272,15 @@ x_draw_right_divider (struct window *w) | |||
| 31193 | int x0 = WINDOW_RIGHT_EDGE_X (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w); | 31272 | int x0 = WINDOW_RIGHT_EDGE_X (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w); |
| 31194 | int x1 = WINDOW_RIGHT_EDGE_X (w); | 31273 | int x1 = WINDOW_RIGHT_EDGE_X (w); |
| 31195 | int y0 = WINDOW_TOP_EDGE_Y (w); | 31274 | int y0 = WINDOW_TOP_EDGE_Y (w); |
| 31196 | /* The bottom divider prevails. */ | 31275 | int y1 = WINDOW_BOTTOM_EDGE_Y (w); |
| 31197 | int y1 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w); | 31276 | |
| 31277 | /* If W is horizontally combined and has a right sibling, don't | ||
| 31278 | draw over any bottom divider. */ | ||
| 31279 | if (WINDOW_BOTTOM_DIVIDER_WIDTH (w) | ||
| 31280 | && !NILP (w->parent) | ||
| 31281 | && WINDOW_HORIZONTAL_COMBINATION_P (XWINDOW (w->parent)) | ||
| 31282 | && !NILP (w->next)) | ||
| 31283 | y1 -= WINDOW_BOTTOM_DIVIDER_WIDTH (w); | ||
| 31198 | 31284 | ||
| 31199 | FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1); | 31285 | FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1); |
| 31200 | } | 31286 | } |
| @@ -31213,8 +31299,22 @@ x_draw_bottom_divider (struct window *w) | |||
| 31213 | int x1 = WINDOW_RIGHT_EDGE_X (w); | 31299 | int x1 = WINDOW_RIGHT_EDGE_X (w); |
| 31214 | int y0 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w); | 31300 | int y0 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w); |
| 31215 | int y1 = WINDOW_BOTTOM_EDGE_Y (w); | 31301 | int y1 = WINDOW_BOTTOM_EDGE_Y (w); |
| 31302 | struct window *p = !NILP (w->parent) ? XWINDOW (w->parent) : false; | ||
| 31216 | 31303 | ||
| 31217 | FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1); | 31304 | /* If W is vertically combined and has a sibling below, don't draw |
| 31305 | over any right divider. */ | ||
| 31306 | if (WINDOW_RIGHT_DIVIDER_WIDTH (w) | ||
| 31307 | && p | ||
| 31308 | && ((WINDOW_VERTICAL_COMBINATION_P (p) | ||
| 31309 | && !NILP (w->next)) | ||
| 31310 | || (WINDOW_HORIZONTAL_COMBINATION_P (p) | ||
| 31311 | && NILP (w->next) | ||
| 31312 | && !NILP (p->parent) | ||
| 31313 | && WINDOW_VERTICAL_COMBINATION_P (XWINDOW (p->parent)) | ||
| 31314 | && !NILP (XWINDOW (p->parent)->next)))) | ||
| 31315 | x1 -= WINDOW_RIGHT_DIVIDER_WIDTH (w); | ||
| 31316 | |||
| 31317 | FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1); | ||
| 31218 | } | 31318 | } |
| 31219 | } | 31319 | } |
| 31220 | 31320 | ||
| @@ -31329,7 +31429,7 @@ expose_window (struct window *w, XRectangle *fr) | |||
| 31329 | } | 31429 | } |
| 31330 | 31430 | ||
| 31331 | /* Display the mode line if there is one. */ | 31431 | /* Display the mode line if there is one. */ |
| 31332 | if (WINDOW_WANTS_MODELINE_P (w) | 31432 | if (window_wants_mode_line (w) |
| 31333 | && (row = MATRIX_MODE_LINE_ROW (w->current_matrix), | 31433 | && (row = MATRIX_MODE_LINE_ROW (w->current_matrix), |
| 31334 | row->enabled_p) | 31434 | row->enabled_p) |
| 31335 | && row->y < r_bottom) | 31435 | && row->y < r_bottom) |
diff --git a/src/xfaces.c b/src/xfaces.c index 4714b7b3cb8..86bb9b0b496 100644 --- a/src/xfaces.c +++ b/src/xfaces.c | |||
| @@ -6232,7 +6232,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */) | |||
| 6232 | int red, green, blue; | 6232 | int red, green, blue; |
| 6233 | int num; | 6233 | int num; |
| 6234 | 6234 | ||
| 6235 | while (fgets (buf, sizeof (buf), fp) != NULL) { | 6235 | while (fgets_unlocked (buf, sizeof (buf), fp) != NULL) { |
| 6236 | if (sscanf (buf, "%d %d %d %n", &red, &green, &blue, &num) == 3) | 6236 | if (sscanf (buf, "%d %d %d %n", &red, &green, &blue, &num) == 3) |
| 6237 | { | 6237 | { |
| 6238 | #ifdef HAVE_NTGUI | 6238 | #ifdef HAVE_NTGUI |
diff --git a/src/xfns.c b/src/xfns.c index 7be2253cc3b..d8bf9747191 100644 --- a/src/xfns.c +++ b/src/xfns.c | |||
| @@ -1120,6 +1120,14 @@ enum mouse_cursor { | |||
| 1120 | mouse_cursor_hand, | 1120 | mouse_cursor_hand, |
| 1121 | mouse_cursor_horizontal_drag, | 1121 | mouse_cursor_horizontal_drag, |
| 1122 | mouse_cursor_vertical_drag, | 1122 | mouse_cursor_vertical_drag, |
| 1123 | mouse_cursor_left_edge, | ||
| 1124 | mouse_cursor_top_left_corner, | ||
| 1125 | mouse_cursor_top_edge, | ||
| 1126 | mouse_cursor_top_right_corner, | ||
| 1127 | mouse_cursor_right_edge, | ||
| 1128 | mouse_cursor_bottom_right_corner, | ||
| 1129 | mouse_cursor_bottom_edge, | ||
| 1130 | mouse_cursor_bottom_left_corner, | ||
| 1123 | mouse_cursor_max | 1131 | mouse_cursor_max |
| 1124 | }; | 1132 | }; |
| 1125 | 1133 | ||
| @@ -1139,13 +1147,21 @@ struct mouse_cursor_types { | |||
| 1139 | 1147 | ||
| 1140 | /* This array must stay in sync with enum mouse_cursor above! */ | 1148 | /* This array must stay in sync with enum mouse_cursor above! */ |
| 1141 | static const struct mouse_cursor_types mouse_cursor_types[] = { | 1149 | static const struct mouse_cursor_types mouse_cursor_types[] = { |
| 1142 | { "text", &Vx_pointer_shape, XC_xterm }, | 1150 | { "text", &Vx_pointer_shape, XC_xterm }, |
| 1143 | { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr }, | 1151 | { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr }, |
| 1144 | { "hourglass", &Vx_hourglass_pointer_shape, XC_watch }, | 1152 | { "hourglass", &Vx_hourglass_pointer_shape, XC_watch }, |
| 1145 | { "modeline", &Vx_mode_pointer_shape, XC_xterm }, | 1153 | { "modeline", &Vx_mode_pointer_shape, XC_xterm }, |
| 1146 | { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 }, | 1154 | { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 }, |
| 1147 | { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow }, | 1155 | { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow }, |
| 1148 | { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow }, | 1156 | { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow }, |
| 1157 | { NULL, &Vx_window_left_edge_shape, XC_left_side }, | ||
| 1158 | { NULL, &Vx_window_top_left_corner_shape, XC_top_left_corner }, | ||
| 1159 | { NULL, &Vx_window_top_edge_shape, XC_top_side }, | ||
| 1160 | { NULL, &Vx_window_top_right_corner_shape, XC_top_right_corner }, | ||
| 1161 | { NULL, &Vx_window_right_edge_shape, XC_right_side }, | ||
| 1162 | { NULL, &Vx_window_bottom_right_corner_shape, XC_bottom_right_corner }, | ||
| 1163 | { NULL, &Vx_window_bottom_edge_shape, XC_bottom_side }, | ||
| 1164 | { NULL, &Vx_window_bottom_left_corner_shape, XC_bottom_left_corner }, | ||
| 1149 | }; | 1165 | }; |
| 1150 | 1166 | ||
| 1151 | struct mouse_cursor_data { | 1167 | struct mouse_cursor_data { |
| @@ -1296,6 +1312,14 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) | |||
| 1296 | INSTALL_CURSOR (hand_cursor, hand); | 1312 | INSTALL_CURSOR (hand_cursor, hand); |
| 1297 | INSTALL_CURSOR (horizontal_drag_cursor, horizontal_drag); | 1313 | INSTALL_CURSOR (horizontal_drag_cursor, horizontal_drag); |
| 1298 | INSTALL_CURSOR (vertical_drag_cursor, vertical_drag); | 1314 | INSTALL_CURSOR (vertical_drag_cursor, vertical_drag); |
| 1315 | INSTALL_CURSOR (left_edge_cursor, left_edge); | ||
| 1316 | INSTALL_CURSOR (top_left_corner_cursor, top_left_corner); | ||
| 1317 | INSTALL_CURSOR (top_edge_cursor, top_edge); | ||
| 1318 | INSTALL_CURSOR (top_right_corner_cursor, top_right_corner); | ||
| 1319 | INSTALL_CURSOR (right_edge_cursor, right_edge); | ||
| 1320 | INSTALL_CURSOR (bottom_right_corner_cursor, bottom_right_corner); | ||
| 1321 | INSTALL_CURSOR (bottom_edge_cursor, bottom_edge); | ||
| 1322 | INSTALL_CURSOR (bottom_left_corner_cursor, bottom_left_corner); | ||
| 1299 | 1323 | ||
| 1300 | #undef INSTALL_CURSOR | 1324 | #undef INSTALL_CURSOR |
| 1301 | 1325 | ||
| @@ -3814,6 +3838,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 3814 | "leftFringe", "LeftFringe", RES_TYPE_NUMBER); | 3838 | "leftFringe", "LeftFringe", RES_TYPE_NUMBER); |
| 3815 | x_default_parameter (f, parms, Qright_fringe, Qnil, | 3839 | x_default_parameter (f, parms, Qright_fringe, Qnil, |
| 3816 | "rightFringe", "RightFringe", RES_TYPE_NUMBER); | 3840 | "rightFringe", "RightFringe", RES_TYPE_NUMBER); |
| 3841 | x_default_parameter (f, parms, Qno_special_glyphs, Qnil, | ||
| 3842 | NULL, NULL, RES_TYPE_BOOLEAN); | ||
| 3817 | 3843 | ||
| 3818 | x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground, | 3844 | x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground, |
| 3819 | "scrollBarForeground", | 3845 | "scrollBarForeground", |
| @@ -5286,7 +5312,7 @@ Frames are listed from topmost (first) to bottommost (last). */) | |||
| 5286 | static void | 5312 | static void |
| 5287 | x_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) | 5313 | x_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) |
| 5288 | { | 5314 | { |
| 5289 | #ifdef USE_GTK | 5315 | #if defined (USE_GTK) && GTK_CHECK_VERSION (2, 18, 0) |
| 5290 | block_input (); | 5316 | block_input (); |
| 5291 | xg_frame_restack (f1, f2, above_flag); | 5317 | xg_frame_restack (f1, f2, above_flag); |
| 5292 | unblock_input (); | 5318 | unblock_input (); |
| @@ -6196,6 +6222,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) | |||
| 6196 | "cursorColor", "Foreground", RES_TYPE_STRING); | 6222 | "cursorColor", "Foreground", RES_TYPE_STRING); |
| 6197 | x_default_parameter (f, parms, Qborder_color, build_string ("black"), | 6223 | x_default_parameter (f, parms, Qborder_color, build_string ("black"), |
| 6198 | "borderColor", "BorderColor", RES_TYPE_STRING); | 6224 | "borderColor", "BorderColor", RES_TYPE_STRING); |
| 6225 | x_default_parameter (f, parms, Qno_special_glyphs, Qnil, | ||
| 6226 | NULL, NULL, RES_TYPE_BOOLEAN); | ||
| 6199 | 6227 | ||
| 6200 | /* Init faces before x_default_parameter is called for the | 6228 | /* Init faces before x_default_parameter is called for the |
| 6201 | scroll-bar-width parameter because otherwise we end up in | 6229 | scroll-bar-width parameter because otherwise we end up in |
| @@ -7486,6 +7514,7 @@ frame_parm_handler x_frame_parm_handlers[] = | |||
| 7486 | x_set_no_accept_focus, | 7514 | x_set_no_accept_focus, |
| 7487 | x_set_z_group, | 7515 | x_set_z_group, |
| 7488 | x_set_override_redirect, | 7516 | x_set_override_redirect, |
| 7517 | x_set_no_special_glyphs, | ||
| 7489 | }; | 7518 | }; |
| 7490 | 7519 | ||
| 7491 | void | 7520 | void |
| @@ -7564,6 +7593,62 @@ This variable takes effect when you create a new frame | |||
| 7564 | or when you set the mouse color. */); | 7593 | or when you set the mouse color. */); |
| 7565 | Vx_window_vertical_drag_shape = Qnil; | 7594 | Vx_window_vertical_drag_shape = Qnil; |
| 7566 | 7595 | ||
| 7596 | DEFVAR_LISP ("x-window-left-edge-cursor", | ||
| 7597 | Vx_window_left_edge_shape, | ||
| 7598 | doc: /* Pointer shape indicating a left x-window edge can be dragged. | ||
| 7599 | This variable takes effect when you create a new frame | ||
| 7600 | or when you set the mouse color. */); | ||
| 7601 | Vx_window_left_edge_shape = Qnil; | ||
| 7602 | |||
| 7603 | DEFVAR_LISP ("x-window-top-left-corner-cursor", | ||
| 7604 | Vx_window_top_left_corner_shape, | ||
| 7605 | doc: /* Pointer shape indicating a top left x-window corner can be dragged. | ||
| 7606 | This variable takes effect when you create a new frame | ||
| 7607 | or when you set the mouse color. */); | ||
| 7608 | Vx_window_top_left_corner_shape = Qnil; | ||
| 7609 | |||
| 7610 | DEFVAR_LISP ("x-window-top-edge-cursor", | ||
| 7611 | Vx_window_top_edge_shape, | ||
| 7612 | doc: /* Pointer shape indicating a top x-window edge can be dragged. | ||
| 7613 | This variable takes effect when you create a new frame | ||
| 7614 | or when you set the mouse color. */); | ||
| 7615 | Vx_window_top_edge_shape = Qnil; | ||
| 7616 | |||
| 7617 | DEFVAR_LISP ("x-window-top-right-corner-cursor", | ||
| 7618 | Vx_window_top_right_corner_shape, | ||
| 7619 | doc: /* Pointer shape indicating a top right x-window corner can be dragged. | ||
| 7620 | This variable takes effect when you create a new frame | ||
| 7621 | or when you set the mouse color. */); | ||
| 7622 | Vx_window_top_right_corner_shape = Qnil; | ||
| 7623 | |||
| 7624 | DEFVAR_LISP ("x-window-right-edge-cursor", | ||
| 7625 | Vx_window_right_edge_shape, | ||
| 7626 | doc: /* Pointer shape indicating a right x-window edge can be dragged. | ||
| 7627 | This variable takes effect when you create a new frame | ||
| 7628 | or when you set the mouse color. */); | ||
| 7629 | Vx_window_right_edge_shape = Qnil; | ||
| 7630 | |||
| 7631 | DEFVAR_LISP ("x-window-bottom-right-corner-cursor", | ||
| 7632 | Vx_window_bottom_right_corner_shape, | ||
| 7633 | doc: /* Pointer shape indicating a bottom right x-window corner can be dragged. | ||
| 7634 | This variable takes effect when you create a new frame | ||
| 7635 | or when you set the mouse color. */); | ||
| 7636 | Vx_window_bottom_right_corner_shape = Qnil; | ||
| 7637 | |||
| 7638 | DEFVAR_LISP ("x-window-bottom-edge-cursor", | ||
| 7639 | Vx_window_bottom_edge_shape, | ||
| 7640 | doc: /* Pointer shape indicating a bottom x-window edge can be dragged. | ||
| 7641 | This variable takes effect when you create a new frame | ||
| 7642 | or when you set the mouse color. */); | ||
| 7643 | Vx_window_bottom_edge_shape = Qnil; | ||
| 7644 | |||
| 7645 | DEFVAR_LISP ("x-window-bottom-left-corner-cursor", | ||
| 7646 | Vx_window_bottom_left_corner_shape, | ||
| 7647 | doc: /* Pointer shape indicating a bottom left x-window corner can be dragged. | ||
| 7648 | This variable takes effect when you create a new frame | ||
| 7649 | or when you set the mouse color. */); | ||
| 7650 | Vx_window_bottom_left_corner_shape = Qnil; | ||
| 7651 | |||
| 7567 | DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, | 7652 | DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, |
| 7568 | doc: /* A string indicating the foreground color of the cursor box. */); | 7653 | doc: /* A string indicating the foreground color of the cursor box. */); |
| 7569 | Vx_cursor_fore_pixel = Qnil; | 7654 | Vx_cursor_fore_pixel = Qnil; |
diff --git a/src/xterm.c b/src/xterm.c index c8836b7ca78..a214cd81031 100644 --- a/src/xterm.c +++ b/src/xterm.c | |||
| @@ -11757,6 +11757,22 @@ x_free_frame_resources (struct frame *f) | |||
| 11757 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->horizontal_drag_cursor); | 11757 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->horizontal_drag_cursor); |
| 11758 | if (f->output_data.x->vertical_drag_cursor != 0) | 11758 | if (f->output_data.x->vertical_drag_cursor != 0) |
| 11759 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->vertical_drag_cursor); | 11759 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->vertical_drag_cursor); |
| 11760 | if (f->output_data.x->left_edge_cursor != 0) | ||
| 11761 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->left_edge_cursor); | ||
| 11762 | if (f->output_data.x->top_left_corner_cursor != 0) | ||
| 11763 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_left_corner_cursor); | ||
| 11764 | if (f->output_data.x->top_edge_cursor != 0) | ||
| 11765 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_edge_cursor); | ||
| 11766 | if (f->output_data.x->top_right_corner_cursor != 0) | ||
| 11767 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_right_corner_cursor); | ||
| 11768 | if (f->output_data.x->right_edge_cursor != 0) | ||
| 11769 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->right_edge_cursor); | ||
| 11770 | if (f->output_data.x->bottom_right_corner_cursor != 0) | ||
| 11771 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_right_corner_cursor); | ||
| 11772 | if (f->output_data.x->bottom_edge_cursor != 0) | ||
| 11773 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_edge_cursor); | ||
| 11774 | if (f->output_data.x->bottom_left_corner_cursor != 0) | ||
| 11775 | XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_left_corner_cursor); | ||
| 11760 | 11776 | ||
| 11761 | XFlush (FRAME_X_DISPLAY (f)); | 11777 | XFlush (FRAME_X_DISPLAY (f)); |
| 11762 | } | 11778 | } |
diff --git a/src/xterm.h b/src/xterm.h index a75257006fd..803feda99f3 100644 --- a/src/xterm.h +++ b/src/xterm.h | |||
| @@ -637,6 +637,14 @@ struct x_output | |||
| 637 | Cursor horizontal_drag_cursor; | 637 | Cursor horizontal_drag_cursor; |
| 638 | Cursor vertical_drag_cursor; | 638 | Cursor vertical_drag_cursor; |
| 639 | Cursor current_cursor; | 639 | Cursor current_cursor; |
| 640 | Cursor left_edge_cursor; | ||
| 641 | Cursor top_left_corner_cursor; | ||
| 642 | Cursor top_edge_cursor; | ||
| 643 | Cursor top_right_corner_cursor; | ||
| 644 | Cursor right_edge_cursor; | ||
| 645 | Cursor bottom_right_corner_cursor; | ||
| 646 | Cursor bottom_edge_cursor; | ||
| 647 | Cursor bottom_left_corner_cursor; | ||
| 640 | 648 | ||
| 641 | /* Window whose cursor is hourglass_cursor. This window is temporarily | 649 | /* Window whose cursor is hourglass_cursor. This window is temporarily |
| 642 | mapped to display an hourglass cursor. */ | 650 | mapped to display an hourglass cursor. */ |
diff --git a/test/Makefile.in b/test/Makefile.in index 414eca90564..11373db8ca9 100644 --- a/test/Makefile.in +++ b/test/Makefile.in | |||
| @@ -147,7 +147,8 @@ endif | |||
| 147 | %.log: %.elc | 147 | %.log: %.elc |
| 148 | $(AM_V_at)${MKDIR_P} $(dir $@) | 148 | $(AM_V_at)${MKDIR_P} $(dir $@) |
| 149 | $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \ | 149 | $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \ |
| 150 | --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} | 150 | --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" \ |
| 151 | $(if $(and ${NIX_STORE}, $(findstring tramp, $(testloadfile))), , ${WRITE_LOG}) | ||
| 151 | 152 | ||
| 152 | ifeq (@HAVE_MODULES@, yes) | 153 | ifeq (@HAVE_MODULES@, yes) |
| 153 | maybe_exclude_module_tests := | 154 | maybe_exclude_module_tests := |
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 78a37650619..6f63d30e755 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el | |||
| @@ -593,5 +593,121 @@ baz\"\"" | |||
| 593 | :bindings '((electric-quote-string . t)) | 593 | :bindings '((electric-quote-string . t)) |
| 594 | :test-in-comments nil :test-in-strings nil) | 594 | :test-in-comments nil :test-in-strings nil) |
| 595 | 595 | ||
| 596 | (define-electric-pair-test electric-quote-opening-single | ||
| 597 | "" "`" :expected-string "‘" :expected-point 2 | ||
| 598 | :modes '(text-mode) | ||
| 599 | :fixture-fn #'electric-quote-local-mode | ||
| 600 | :test-in-comments nil :test-in-strings nil) | ||
| 601 | |||
| 602 | (define-electric-pair-test electric-quote-closing-single | ||
| 603 | "" "'" :expected-string "’" :expected-point 2 | ||
| 604 | :modes '(text-mode) | ||
| 605 | :fixture-fn #'electric-quote-local-mode | ||
| 606 | :test-in-comments nil :test-in-strings nil) | ||
| 607 | |||
| 608 | (define-electric-pair-test electric-quote-opening-double | ||
| 609 | "‘" "-`" :expected-string "“" :expected-point 2 | ||
| 610 | :modes '(text-mode) | ||
| 611 | :fixture-fn #'electric-quote-local-mode | ||
| 612 | :test-in-comments nil :test-in-strings nil) | ||
| 613 | |||
| 614 | (define-electric-pair-test electric-quote-closing-double | ||
| 615 | "’" "-'" :expected-string "”" :expected-point 2 | ||
| 616 | :modes '(text-mode) | ||
| 617 | :fixture-fn #'electric-quote-local-mode | ||
| 618 | :test-in-comments nil :test-in-strings nil) | ||
| 619 | |||
| 620 | (define-electric-pair-test electric-quote-context-sensitive-backtick | ||
| 621 | "" "`" :expected-string "`" :expected-point 2 | ||
| 622 | :modes '(text-mode) | ||
| 623 | :fixture-fn #'electric-quote-local-mode | ||
| 624 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 625 | :test-in-comments nil :test-in-strings nil) | ||
| 626 | |||
| 627 | (define-electric-pair-test electric-quote-context-sensitive-bob-single | ||
| 628 | "" "'" :expected-string "‘" :expected-point 2 | ||
| 629 | :modes '(text-mode) | ||
| 630 | :fixture-fn #'electric-quote-local-mode | ||
| 631 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 632 | :test-in-comments nil :test-in-strings nil) | ||
| 633 | |||
| 634 | (define-electric-pair-test electric-quote-context-sensitive-bob-double | ||
| 635 | "‘" "-'" :expected-string "“" :expected-point 2 | ||
| 636 | :modes '(text-mode) | ||
| 637 | :fixture-fn #'electric-quote-local-mode | ||
| 638 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 639 | :test-in-comments nil :test-in-strings nil) | ||
| 640 | |||
| 641 | (define-electric-pair-test electric-quote-context-sensitive-bol-single | ||
| 642 | "a\n" "--'" :expected-string "a\n‘" :expected-point 4 | ||
| 643 | :modes '(text-mode) | ||
| 644 | :fixture-fn #'electric-quote-local-mode | ||
| 645 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 646 | :test-in-comments nil :test-in-strings nil) | ||
| 647 | |||
| 648 | (define-electric-pair-test electric-quote-context-sensitive-bol-double | ||
| 649 | "a\n‘" "---'" :expected-string "a\n“" :expected-point 4 | ||
| 650 | :modes '(text-mode) | ||
| 651 | :fixture-fn #'electric-quote-local-mode | ||
| 652 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 653 | :test-in-comments nil :test-in-strings nil) | ||
| 654 | |||
| 655 | (define-electric-pair-test electric-quote-context-sensitive-after-space-single | ||
| 656 | " " "-'" :expected-string " ‘" :expected-point 3 | ||
| 657 | :modes '(text-mode) | ||
| 658 | :fixture-fn #'electric-quote-local-mode | ||
| 659 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 660 | :test-in-comments nil :test-in-strings nil) | ||
| 661 | |||
| 662 | (define-electric-pair-test electric-quote-context-sensitive-after-space-double | ||
| 663 | " ‘" "--'" :expected-string " “" :expected-point 3 | ||
| 664 | :modes '(text-mode) | ||
| 665 | :fixture-fn #'electric-quote-local-mode | ||
| 666 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 667 | :test-in-comments nil :test-in-strings nil) | ||
| 668 | |||
| 669 | (define-electric-pair-test electric-quote-context-sensitive-after-letter-single | ||
| 670 | "a" "-'" :expected-string "a’" :expected-point 3 | ||
| 671 | :modes '(text-mode) | ||
| 672 | :fixture-fn #'electric-quote-local-mode | ||
| 673 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 674 | :test-in-comments nil :test-in-strings nil) | ||
| 675 | |||
| 676 | (define-electric-pair-test electric-quote-context-sensitive-after-letter-double | ||
| 677 | "a’" "--'" :expected-string "a”" :expected-point 3 | ||
| 678 | :modes '(text-mode) | ||
| 679 | :fixture-fn #'electric-quote-local-mode | ||
| 680 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 681 | :test-in-comments nil :test-in-strings nil) | ||
| 682 | |||
| 683 | (define-electric-pair-test electric-quote-context-sensitive-after-paren-single | ||
| 684 | "(" "-'" :expected-string "(‘" :expected-point 3 | ||
| 685 | :modes '(text-mode) | ||
| 686 | :fixture-fn #'electric-quote-local-mode | ||
| 687 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 688 | :test-in-comments nil :test-in-strings nil) | ||
| 689 | |||
| 690 | (define-electric-pair-test electric-quote-context-sensitive-after-paren-double | ||
| 691 | "(‘" "--'" :expected-string "(“" :expected-point 3 | ||
| 692 | :modes '(text-mode) | ||
| 693 | :fixture-fn #'electric-quote-local-mode | ||
| 694 | :bindings '((electric-quote-context-sensitive . t)) | ||
| 695 | :test-in-comments nil :test-in-strings nil) | ||
| 696 | |||
| 697 | (define-electric-pair-test electric-quote-markdown-in-text | ||
| 698 | "" "'" :expected-string "’" :expected-point 2 | ||
| 699 | :modes '(text-mode) | ||
| 700 | :fixture-fn #'electric-quote-local-mode | ||
| 701 | :bindings '((electric-quote-code-faces font-lock-constant-face)) | ||
| 702 | :test-in-comments nil :test-in-strings nil) | ||
| 703 | |||
| 704 | (define-electric-pair-test electric-quote-markdown-in-code | ||
| 705 | #("`a`" 1 2 (face font-lock-constant-face)) "-'" | ||
| 706 | :expected-string "`'a`" :expected-point 3 | ||
| 707 | :modes '(text-mode) | ||
| 708 | :fixture-fn #'electric-quote-local-mode | ||
| 709 | :bindings '((electric-quote-code-faces font-lock-constant-face)) | ||
| 710 | :test-in-comments nil :test-in-strings nil) | ||
| 711 | |||
| 596 | (provide 'electric-tests) | 712 | (provide 'electric-tests) |
| 597 | ;;; electric-tests.el ends here | 713 | ;;; electric-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index dfbe18d7844..6448a1b37f7 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el | |||
| @@ -34,7 +34,7 @@ | |||
| 34 | (let ((print-circle t)) | 34 | (let ((print-circle t)) |
| 35 | (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) | 35 | (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) |
| 36 | "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))"))) | 36 | "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))"))) |
| 37 | (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'" | 37 | (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'" |
| 38 | (cl-prin1-to-string (symbol-function #'caar)))))) | 38 | (cl-prin1-to-string (symbol-function #'caar)))))) |
| 39 | 39 | ||
| 40 | (ert-deftest cl-print-tests-2 () | 40 | (ert-deftest cl-print-tests-2 () |
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index fc5790c3659..317838b250f 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el | |||
| @@ -367,12 +367,8 @@ This macro is used to test if macroexpansion in `should' works." | |||
| 367 | (test (make-ert-test :body test-body)) | 367 | (test (make-ert-test :body test-body)) |
| 368 | (result (ert-run-test test))) | 368 | (result (ert-run-test test))) |
| 369 | (should (ert-test-failed-p result)) | 369 | (should (ert-test-failed-p result)) |
| 370 | (with-temp-buffer | 370 | (should (eq (nth 1 (car (ert-test-failed-backtrace result))) |
| 371 | (ert--print-backtrace (ert-test-failed-backtrace result)) | 371 | 'signal)))) |
| 372 | (goto-char (point-min)) | ||
| 373 | (end-of-line) | ||
| 374 | (let ((first-line (buffer-substring-no-properties (point-min) (point)))) | ||
| 375 | (should (equal first-line (format " %S()" test-body))))))) | ||
| 376 | 372 | ||
| 377 | (ert-deftest ert-test-messages () | 373 | (ert-deftest ert-test-messages () |
| 378 | :tags '(:causes-redisplay) | 374 | :tags '(:causes-redisplay) |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a90e3fff355..85990a848f5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -53,6 +53,8 @@ | |||
| 53 | (defvar tramp-copy-size-limit) | 53 | (defvar tramp-copy-size-limit) |
| 54 | (defvar tramp-persistency-file-name) | 54 | (defvar tramp-persistency-file-name) |
| 55 | (defvar tramp-remote-process-environment) | 55 | (defvar tramp-remote-process-environment) |
| 56 | ;; Suppress nasty messages. | ||
| 57 | (fset 'shell-command-sentinel 'ignore) | ||
| 56 | 58 | ||
| 57 | ;; There is no default value on w32 systems, which could work out of the box. | 59 | ;; There is no default value on w32 systems, which could work out of the box. |
| 58 | (defconst tramp-test-temporary-file-directory | 60 | (defconst tramp-test-temporary-file-directory |
| @@ -70,6 +72,10 @@ | |||
| 70 | (add-to-list | 72 | (add-to-list |
| 71 | 'tramp-default-host-alist | 73 | 'tramp-default-host-alist |
| 72 | `("\\`mock\\'" nil ,(system-name))) | 74 | `("\\`mock\\'" nil ,(system-name))) |
| 75 | ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in | ||
| 76 | ;; batch mode only, therefore. | ||
| 77 | (unless (and (null noninteractive) (file-directory-p "~/")) | ||
| 78 | (setenv "HOME" temporary-file-directory)) | ||
| 73 | (format "/mock::%s" temporary-file-directory))) | 79 | (format "/mock::%s" temporary-file-directory))) |
| 74 | "Temporary directory for Tramp tests.") | 80 | "Temporary directory for Tramp tests.") |
| 75 | 81 | ||
| @@ -126,29 +132,52 @@ If QUOTED is non-nil, the local part of the file is quoted." | |||
| 126 | (make-temp-name "tramp-test") | 132 | (make-temp-name "tramp-test") |
| 127 | (if local temporary-file-directory tramp-test-temporary-file-directory)))) | 133 | (if local temporary-file-directory tramp-test-temporary-file-directory)))) |
| 128 | 134 | ||
| 135 | ;; Don't print messages in nested `tramp--instrument-test-case' calls. | ||
| 136 | (defvar tramp--instrument-test-case-p nil | ||
| 137 | "Whether `tramp--instrument-test-case' run. | ||
| 138 | This shall used dynamically bound only.") | ||
| 139 | |||
| 129 | (defmacro tramp--instrument-test-case (verbose &rest body) | 140 | (defmacro tramp--instrument-test-case (verbose &rest body) |
| 130 | "Run BODY with `tramp-verbose' equal VERBOSE. | 141 | "Run BODY with `tramp-verbose' equal VERBOSE. |
| 131 | Print the the content of the Tramp debug buffer, if BODY does not | 142 | Print the the content of the Tramp debug buffer, if BODY does not |
| 132 | eval properly in `should' or `should-not'. `should-error' is not | 143 | eval properly in `should' or `should-not'. `should-error' is not |
| 133 | handled properly. BODY shall not contain a timeout." | 144 | handled properly. BODY shall not contain a timeout." |
| 134 | (declare (indent 1) (debug (natnump body))) | 145 | (declare (indent 1) (debug (natnump body))) |
| 135 | `(let ((tramp-verbose ,verbose) | 146 | `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) |
| 147 | (tramp-message-show-message t) | ||
| 136 | (tramp-debug-on-error t) | 148 | (tramp-debug-on-error t) |
| 137 | (debug-ignored-errors | 149 | (debug-ignored-errors |
| 138 | (cons "^make-symbolic-link not supported$" debug-ignored-errors))) | 150 | (cons "^make-symbolic-link not supported$" debug-ignored-errors)) |
| 151 | inhibit-message) | ||
| 139 | (unwind-protect | 152 | (unwind-protect |
| 140 | (progn ,@body) | 153 | (let ((tramp--instrument-test-case-p t)) ,@body) |
| 141 | (when (> tramp-verbose 3) | 154 | ;; Unwind forms. |
| 155 | (when (and (null tramp--instrument-test-case-p) (> tramp-verbose 3)) | ||
| 142 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil | 156 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil |
| 143 | (with-current-buffer (tramp-get-connection-buffer v) | 157 | (with-current-buffer (tramp-get-connection-buffer v) |
| 144 | (message "%s" (buffer-string))) | 158 | (message "%s" (buffer-string))) |
| 145 | (with-current-buffer (tramp-get-debug-buffer v) | 159 | (with-current-buffer (tramp-get-debug-buffer v) |
| 146 | (message "%s" (buffer-string)))))))) | 160 | (message "%s" (buffer-string)))))))) |
| 147 | 161 | ||
| 162 | (defsubst tramp--test-message (fmt-string &rest arguments) | ||
| 163 | "Emit a message into ERT *Messages*." | ||
| 164 | (tramp--instrument-test-case 0 | ||
| 165 | (apply | ||
| 166 | 'tramp-message | ||
| 167 | (tramp-dissect-file-name tramp-test-temporary-file-directory) 0 | ||
| 168 | fmt-string arguments))) | ||
| 169 | |||
| 170 | (defsubst tramp--test-backtrace () | ||
| 171 | "Dump a backtrace into ERT *Messages*." | ||
| 172 | (tramp--instrument-test-case 10 | ||
| 173 | (tramp-backtrace | ||
| 174 | (tramp-dissect-file-name tramp-test-temporary-file-directory)))) | ||
| 175 | |||
| 148 | (ert-deftest tramp-test00-availability () | 176 | (ert-deftest tramp-test00-availability () |
| 149 | "Test availability of Tramp functions." | 177 | "Test availability of Tramp functions." |
| 150 | :expected-result (if (tramp--test-enabled) :passed :failed) | 178 | :expected-result (if (tramp--test-enabled) :passed :failed) |
| 151 | (message "Remote directory: `%s'" tramp-test-temporary-file-directory) | 179 | (tramp--test-message |
| 180 | "Remote directory: `%s'" tramp-test-temporary-file-directory) | ||
| 152 | (should (ignore-errors | 181 | (should (ignore-errors |
| 153 | (and | 182 | (and |
| 154 | (file-remote-p tramp-test-temporary-file-directory) | 183 | (file-remote-p tramp-test-temporary-file-directory) |
| @@ -2759,6 +2788,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 2759 | (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) | 2788 | (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) |
| 2760 | (let ((tmp-name (tramp--test-make-temp-name nil quoted)) | 2789 | (let ((tmp-name (tramp--test-make-temp-name nil quoted)) |
| 2761 | (default-directory tramp-test-temporary-file-directory) | 2790 | (default-directory tramp-test-temporary-file-directory) |
| 2791 | ;; Suppress nasty messages. | ||
| 2792 | (inhibit-message t) | ||
| 2762 | kill-buffer-query-functions) | 2793 | kill-buffer-query-functions) |
| 2763 | (unwind-protect | 2794 | (unwind-protect |
| 2764 | (with-temp-buffer | 2795 | (with-temp-buffer |
| @@ -2787,7 +2818,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 2787 | (async-shell-command | 2818 | (async-shell-command |
| 2788 | (format "ls %s" (file-name-nondirectory tmp-name)) | 2819 | (format "ls %s" (file-name-nondirectory tmp-name)) |
| 2789 | (current-buffer)) | 2820 | (current-buffer)) |
| 2790 | (set-process-sentinel (get-buffer-process (current-buffer)) nil) | ||
| 2791 | ;; Read output. | 2821 | ;; Read output. |
| 2792 | (with-timeout (10 (ert-fail "`async-shell-command' timed out")) | 2822 | (with-timeout (10 (ert-fail "`async-shell-command' timed out")) |
| 2793 | (while (< (- (point-max) (point-min)) | 2823 | (while (< (- (point-max) (point-min)) |
| @@ -2816,7 +2846,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 2816 | (write-region "foo" nil tmp-name) | 2846 | (write-region "foo" nil tmp-name) |
| 2817 | (should (file-exists-p tmp-name)) | 2847 | (should (file-exists-p tmp-name)) |
| 2818 | (async-shell-command "read line; ls $line" (current-buffer)) | 2848 | (async-shell-command "read line; ls $line" (current-buffer)) |
| 2819 | (set-process-sentinel (get-buffer-process (current-buffer)) nil) | ||
| 2820 | (process-send-string | 2849 | (process-send-string |
| 2821 | (get-buffer-process (current-buffer)) | 2850 | (get-buffer-process (current-buffer)) |
| 2822 | (format "%s\n" (file-name-nondirectory tmp-name))) | 2851 | (format "%s\n" (file-name-nondirectory tmp-name))) |
| @@ -2847,8 +2876,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 2847 | "Like `shell-command-to-string', but for asynchronous processes." | 2876 | "Like `shell-command-to-string', but for asynchronous processes." |
| 2848 | (with-temp-buffer | 2877 | (with-temp-buffer |
| 2849 | (async-shell-command command (current-buffer)) | 2878 | (async-shell-command command (current-buffer)) |
| 2850 | ;; Suppress nasty messages. | ||
| 2851 | (set-process-sentinel (get-buffer-process (current-buffer)) nil) | ||
| 2852 | (with-timeout (10) | 2879 | (with-timeout (10) |
| 2853 | (while (get-buffer-process (current-buffer)) | 2880 | (while (get-buffer-process (current-buffer)) |
| 2854 | (accept-process-output (get-buffer-process (current-buffer)) 0.1))) | 2881 | (accept-process-output (get-buffer-process (current-buffer)) 0.1))) |
| @@ -3046,11 +3073,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 3046 | ;; We must force a reconnect, in order to activate $BZR_HOME. | 3073 | ;; We must force a reconnect, in order to activate $BZR_HOME. |
| 3047 | (tramp-cleanup-connection | 3074 | (tramp-cleanup-connection |
| 3048 | (tramp-dissect-file-name tramp-test-temporary-file-directory) | 3075 | (tramp-dissect-file-name tramp-test-temporary-file-directory) |
| 3049 | nil 'keep-password) | 3076 | 'keep-debug 'keep-password) |
| 3050 | '(Bzr)) | 3077 | '(Bzr)) |
| 3051 | (t nil))))) | 3078 | (t nil)))) |
| 3079 | ;; Suppress nasty messages. | ||
| 3080 | (inhibit-message t)) | ||
| 3052 | (skip-unless vc-handled-backends) | 3081 | (skip-unless vc-handled-backends) |
| 3053 | (message "%s" vc-handled-backends) | 3082 | (unless quoted (tramp--test-message "%s" vc-handled-backends)) |
| 3054 | 3083 | ||
| 3055 | (unwind-protect | 3084 | (unwind-protect |
| 3056 | (progn | 3085 | (progn |
| @@ -3656,90 +3685,134 @@ Use the `ls' command." | |||
| 3656 | "Check parallel asynchronous requests. | 3685 | "Check parallel asynchronous requests. |
| 3657 | Such requests could arrive from timers, process filters and | 3686 | Such requests could arrive from timers, process filters and |
| 3658 | process sentinels. They shall not disturb each other." | 3687 | process sentinels. They shall not disturb each other." |
| 3659 | ;; Mark as failed until bug has been fixed. | ||
| 3660 | :expected-result :failed | ||
| 3661 | :tags '(:expensive-test) | 3688 | :tags '(:expensive-test) |
| 3662 | (skip-unless (tramp--test-enabled)) | 3689 | (skip-unless (tramp--test-enabled)) |
| 3663 | (skip-unless (tramp--test-sh-p)) | 3690 | (skip-unless (tramp--test-sh-p)) |
| 3664 | 3691 | ||
| 3665 | (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) | 3692 | ;; This test times out on hydra. |
| 3666 | ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. | 3693 | (with-timeout |
| 3667 | ;; This has the side effect, that this test fails instead to | 3694 | (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out")) |
| 3668 | ;; abort. Good for hydra. | 3695 | (let* ((tmp-name (tramp--test-make-temp-name)) |
| 3669 | (tramp--instrument-test-case 0 | 3696 | (default-directory tmp-name) |
| 3670 | (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) | 3697 | ;; Do not cache Tramp properties. |
| 3671 | (default-directory tmp-name) | 3698 | (remote-file-name-inhibit-cache t) |
| 3672 | (remote-file-name-inhibit-cache t) | 3699 | (process-file-side-effects t) |
| 3673 | timer buffers kill-buffer-query-functions) | 3700 | ;; Suppress nasty messages. |
| 3701 | (inhibit-message t) | ||
| 3702 | (number-proc 10) | ||
| 3703 | ;; On hydra, timings are bad. | ||
| 3704 | (timer-repeat | ||
| 3705 | (cond | ||
| 3706 | ((getenv "NIX_STORE") 10 | ||
| 3707 | (t 1)))) | ||
| 3708 | ;; We must distinguish due to performance reasons. | ||
| 3709 | (timer-operation | ||
| 3710 | (cond | ||
| 3711 | ((string-equal "mock" (file-remote-p tmp-name 'method)) | ||
| 3712 | 'vc-registered) | ||
| 3713 | (t 'file-attributes))) | ||
| 3714 | timer buffers kill-buffer-query-functions) | ||
| 3674 | 3715 | ||
| 3675 | (unwind-protect | 3716 | (unwind-protect |
| 3676 | (progn | 3717 | (progn |
| 3677 | (make-directory tmp-name) | 3718 | (make-directory tmp-name) |
| 3678 | 3719 | ||
| 3679 | ;; Setup a timer in order to raise an ordinary command | 3720 | ;; Setup a timer in order to raise an ordinary command again |
| 3680 | ;; again and again. `vc-registered' is well suited, | 3721 | ;; and again. `vc-registered' is well suited, because there |
| 3681 | ;; because there are many checks. | 3722 | ;; are many checks. |
| 3682 | (setq | 3723 | (setq |
| 3683 | timer | 3724 | timer |
| 3684 | (run-at-time | 3725 | (run-at-time |
| 3685 | 0 1 | 3726 | 0 timer-repeat |
| 3686 | (lambda () | 3727 | (lambda () |
| 3687 | (when buffers | 3728 | (when buffers |
| 3688 | (vc-registered | 3729 | (let ((default-directory tmp-name) |
| 3689 | (buffer-name (nth (random (length buffers)) buffers))))))) | 3730 | (file |
| 3690 | 3731 | (buffer-name (nth (random (length buffers)) buffers)))) | |
| 3691 | ;; Create temporary buffers. The number of buffers | 3732 | (tramp--test-message |
| 3692 | ;; corresponds to the number of processes; it could be | 3733 | "Start timer %s %s %s" |
| 3693 | ;; increased in order to make pressure on Tramp. | 3734 | timer-operation file (current-time-string)) |
| 3694 | (dotimes (_i 5) | 3735 | (funcall timer-operation file) |
| 3695 | (add-to-list 'buffers (generate-new-buffer "*temp*"))) | 3736 | (tramp--test-message |
| 3696 | 3737 | "Stop timer %s %s %s" | |
| 3697 | ;; Open asynchronous processes. Set process sentinel. | 3738 | timer-operation file (current-time-string))))))) |
| 3698 | (dolist (buf buffers) | 3739 | |
| 3699 | (async-shell-command "read line; touch $line; echo $line" buf) | 3740 | ;; Create temporary buffers. The number of buffers |
| 3741 | ;; corresponds to the number of processes; it could be | ||
| 3742 | ;; increased in order to make pressure on Tramp. | ||
| 3743 | (dotimes (_i number-proc) | ||
| 3744 | (add-to-list 'buffers (generate-new-buffer "foo"))) | ||
| 3745 | |||
| 3746 | ;; Open asynchronous processes. Set process sentinel. | ||
| 3747 | (dolist (buf buffers) | ||
| 3748 | (tramp--test-message "Start process %s" buf) | ||
| 3749 | (let ((proc | ||
| 3750 | (start-file-process-shell-command | ||
| 3751 | (buffer-name buf) buf | ||
| 3752 | (concat | ||
| 3753 | "(read line && echo $line >$line);" | ||
| 3754 | "(read line && cat $line);" | ||
| 3755 | "(read line && rm $line)"))) | ||
| 3756 | (file (expand-file-name (buffer-name buf)))) | ||
| 3757 | ;; Remember the file name. Add counter. | ||
| 3758 | (process-put proc 'foo file) | ||
| 3759 | (process-put proc 'bar 0) | ||
| 3760 | ;; Add process filter. | ||
| 3761 | (set-process-filter | ||
| 3762 | proc | ||
| 3763 | (lambda (proc string) | ||
| 3764 | (tramp--test-message "Process filter %s" proc) | ||
| 3765 | (with-current-buffer (process-buffer proc) | ||
| 3766 | (insert string)) | ||
| 3767 | (unless (zerop (length string)) | ||
| 3768 | (should (file-attributes (process-get proc 'foo)))))) | ||
| 3769 | ;; Add process sentinel. | ||
| 3700 | (set-process-sentinel | 3770 | (set-process-sentinel |
| 3701 | (get-buffer-process buf) | 3771 | proc |
| 3702 | (lambda (proc _state) | 3772 | (lambda (proc _state) |
| 3703 | (delete-file (buffer-name (process-buffer proc)))))) | 3773 | (tramp--test-message "Process sentinel %s" proc) |
| 3704 | 3774 | (should-not (file-attributes (process-get proc 'foo))))))) | |
| 3705 | ;; Send a string. Use a random order of the buffers. Mix | 3775 | |
| 3706 | ;; with regular operation. | 3776 | ;; Send a string. Use a random order of the buffers. Mix |
| 3707 | (let ((buffers (copy-sequence buffers)) | 3777 | ;; with regular operation. |
| 3708 | buf) | 3778 | (let ((buffers (copy-sequence buffers))) |
| 3709 | (while buffers | 3779 | (while buffers |
| 3710 | (setq buf (nth (random (length buffers)) buffers)) | 3780 | (let* ((buf (nth (random (length buffers)) buffers)) |
| 3711 | (process-send-string | 3781 | (proc (get-buffer-process buf)) |
| 3712 | (get-buffer-process buf) (format "'%s'\n" buf)) | 3782 | (file (process-get proc 'foo)) |
| 3713 | (file-attributes (buffer-name buf)) | 3783 | (count (process-get proc 'bar))) |
| 3714 | (setq buffers (delq buf buffers)))) | 3784 | ;; Regular operation. |
| 3715 | 3785 | (if (= count 0) | |
| 3716 | ;; Wait until the whole output has been read. | 3786 | (should-not (file-attributes file)) |
| 3717 | (with-timeout ((* 10 (length buffers)) | 3787 | (should (file-attributes file))) |
| 3718 | (ert-fail "`async-shell-command' timed out")) | 3788 | ;; Send string to process. |
| 3719 | (let ((buffers (copy-sequence buffers)) | 3789 | (tramp--test-message "Send string %s" proc) |
| 3720 | buf) | 3790 | (process-send-string proc (format "%s\n" (buffer-name buf))) |
| 3721 | (while buffers | 3791 | (accept-process-output proc 0.1 nil 0) |
| 3722 | (setq buf (nth (random (length buffers)) buffers)) | 3792 | ;; Regular operation. |
| 3723 | (if (ignore-errors | 3793 | (if (= count 2) |
| 3724 | (memq (process-status (get-buffer-process buf)) | 3794 | (should-not (file-attributes file)) |
| 3725 | '(run open))) | 3795 | (should (file-attributes file))) |
| 3726 | (accept-process-output (get-buffer-process buf) 0.1) | 3796 | (process-put proc 'bar (1+ count)) |
| 3727 | (setq buffers (delq buf buffers)))))) | 3797 | (unless (process-live-p proc) |
| 3728 | 3798 | (tramp--test-message "Buffer delete %s" buf) | |
| 3729 | ;; Check. | 3799 | (setq buffers (delq buf buffers)))))) |
| 3730 | (dolist (buf buffers) | 3800 | |
| 3731 | (with-current-buffer buf | 3801 | ;; Checks. All process output shall exists in the |
| 3732 | (should | 3802 | ;; respective buffers. All created files shall be deleted. |
| 3733 | (string-equal (format "'%s'\n" buf) (buffer-string))))) | 3803 | (tramp--test-message "Checks %s" buffers) |
| 3734 | (should-not | 3804 | (dolist (buf buffers) |
| 3735 | (directory-files | 3805 | (with-current-buffer buf |
| 3736 | tmp-name nil directory-files-no-dot-files-regexp))) | 3806 | (should (string-equal (format "%s\n" buf) (buffer-string))))) |
| 3737 | 3807 | (should-not | |
| 3738 | ;; Cleanup. | 3808 | (directory-files tmp-name nil directory-files-no-dot-files-regexp))) |
| 3739 | (ignore-errors (cancel-timer timer)) | 3809 | |
| 3740 | (ignore-errors (delete-directory tmp-name 'recursive)) | 3810 | ;; Cleanup. |
| 3741 | (dolist (buf buffers) | 3811 | (dolist (buf buffers) |
| 3742 | (ignore-errors (kill-buffer buf)))))))) | 3812 | (ignore-errors (delete-process (get-buffer-process buf))) |
| 3813 | (ignore-errors (kill-buffer buf))) | ||
| 3814 | (ignore-errors (cancel-timer timer)) | ||
| 3815 | (ignore-errors (delete-directory tmp-name 'recursive)))))) | ||
| 3743 | 3816 | ||
| 3744 | (ert-deftest tramp-test37-recursive-load () | 3817 | (ert-deftest tramp-test37-recursive-load () |
| 3745 | "Check that Tramp does not fail due to recursive load." | 3818 | "Check that Tramp does not fail due to recursive load." |
| @@ -3836,8 +3909,8 @@ Since it unloads Tramp, it shall be the last test to run." | |||
| 3836 | ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). | 3909 | ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). |
| 3837 | ;; * Fix Bug#27009. Set expected error of | 3910 | ;; * Fix Bug#27009. Set expected error of |
| 3838 | ;; `tramp-test29-environment-variables-and-port-numbers'. | 3911 | ;; `tramp-test29-environment-variables-and-port-numbers'. |
| 3839 | ;; * Fix Bug#16928. Set expected error of `tramp-test36-asynchronous-requests'. | 3912 | ;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'. |
| 3840 | ;; * Fix `tramp-test38-unload' (Not all symbols are unbound). Set | 3913 | ;; * Fix `tramp-test39-unload' (Not all symbols are unbound). Set |
| 3841 | ;; expected error. | 3914 | ;; expected error. |
| 3842 | 3915 | ||
| 3843 | (defun tramp-test-all (&optional interactive) | 3916 | (defun tramp-test-all (&optional interactive) |