aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2018-06-23 07:50:59 -0700
committerGlenn Morris2018-06-23 07:50:59 -0700
commitb81e193ac0c4644d041a4eb4fa4cb62cf9446bd6 (patch)
tree837db70e4aff8fce66886b0cfbe82dbccdea4b06
parent4df361557c3f1b4039fa59d23cd1ed66c2ca5b1c (diff)
parent5cb3991a4f78b39a2c95b22a5159ae3ba779397e (diff)
downloademacs-b81e193ac0c4644d041a4eb4fa4cb62cf9446bd6.tar.gz
emacs-b81e193ac0c4644d041a4eb4fa4cb62cf9446bd6.zip
Merge from origin/emacs-26
5cb3991 Fix a typo in emacs-lisp-intro.texi d6aa55e Avoid segfaults in replace-buffer-contents with large buffers d22b8d1 Adjust for scaling for mode-line popup menus (Bug#31880) 3d2e3dc Change name of `seqp' argument (Bug#26411) 40e1db8 Change index of ";" to better reflect it's usage (Bug#31623) d289e7e Fix bug of 'mouse-drag-and-drop-region' to detect edges of re... e292c09 Fix #'fun handling inside `labels' (Bug#31792)
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi2
-rw-r--r--doc/lispref/objects.texi18
-rw-r--r--doc/lispref/sequences.texi4
-rw-r--r--doc/misc/cl.texi23
-rw-r--r--lisp/emacs-lisp/cl-macs.el17
-rw-r--r--lisp/emacs-lisp/cl.el7
-rw-r--r--lisp/emacs-lisp/seq.el6
-rw-r--r--lisp/mouse.el4
-rw-r--r--src/editfns.c5
-rw-r--r--src/xmenu.c17
-rw-r--r--test/lisp/emacs-lisp/cl-tests.el35
11 files changed, 98 insertions, 40 deletions
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index d48f51204cb..a8e9fb13ce7 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -10049,7 +10049,7 @@ kill-ring kill-ring-yank-pointer
10049 | | | 10049 | | |
10050 | | --> "yet more text" 10050 | | --> "yet more text"
10051 | | 10051 | |
10052 | --> "a different piece of text 10052 | --> "a different piece of text"
10053 | 10053 |
10054 --> "some text" 10054 --> "some text"
10055@end group 10055@end group
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 1253e46297f..b94de80b658 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -109,15 +109,15 @@ not be evaluated later. @xref{Input Functions}, for a description of
109@node Comments 109@node Comments
110@section Comments 110@section Comments
111@cindex comments 111@cindex comments
112@cindex @samp{;} in comment 112@cindex @samp{;} for commenting
113 113
114 A @dfn{comment} is text that is written in a program only for the sake 114 A @dfn{comment} is text that is written in a program only for the
115of humans that read the program, and that has no effect on the meaning 115sake of humans that read the program, and that has no effect on the
116of the program. In Lisp, a semicolon (@samp{;}) starts a comment if it 116meaning of the program. In Lisp, an unescaped semicolon (@samp{;})
117is not within a string or character constant. The comment continues to 117starts a comment if it is not within a string or character constant.
118the end of line. The Lisp reader discards comments; they do not become 118The comment continues to the end of line. The Lisp reader discards
119part of the Lisp objects which represent the program within the Lisp 119comments; they do not become part of the Lisp objects which represent
120system. 120the program within the Lisp system.
121 121
122 The @samp{#@@@var{count}} construct, which skips the next @var{count} 122 The @samp{#@@@var{count}} construct, which skips the next @var{count}
123characters, is useful for program-generated comments containing binary 123characters, is useful for program-generated comments containing binary
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index ffec6f37df7..566ba8de18f 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -474,8 +474,8 @@ built-in sequence types, @code{seq-length} behaves like @code{length}.
474@xref{Definition of length}. 474@xref{Definition of length}.
475@end defun 475@end defun
476 476
477@defun seqp sequence 477@defun seqp object
478 This function returns non-@code{nil} if @var{sequence} is a sequence 478 This function returns non-@code{nil} if @var{object} is a sequence
479(a list or array), or any additional type of sequence defined via 479(a list or array), or any additional type of sequence defined via
480@file{seq.el} generic functions. 480@file{seq.el} generic functions.
481 481
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 5ae0faf2554..77105d3364e 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -1299,17 +1299,18 @@ These forms make @code{let}-like bindings to functions instead
1299of variables. 1299of variables.
1300 1300
1301@defmac cl-flet (bindings@dots{}) forms@dots{} 1301@defmac cl-flet (bindings@dots{}) forms@dots{}
1302This form establishes @code{let}-style bindings on the function 1302This form establishes @code{let}-style bindings for functions rather
1303cells of symbols rather than on the value cells. Each @var{binding} 1303than values. Each @var{binding} must be a list of the form
1304must be a list of the form @samp{(@var{name} @var{arglist} 1304@samp{(@var{name} @var{arglist} @var{body}@dots{})}. Within
1305@var{forms}@dots{})}, which defines a function exactly as if 1305@var{forms}, any reference to the function @var{name} uses the local
1306it were a @code{cl-defun} form. The function @var{name} is defined 1306definition instead of the global one.
1307accordingly but only within the body of the @code{cl-flet}, hiding any external 1307
1308definition if applicable. 1308A ``reference'' to a function name is either a call to that function,
1309or a use of its name quoted by @code{function} to be passed on to,
1310say, @code{mapcar}.
1309 1311
1310The bindings are lexical in scope. This means that all references to 1312The bindings are lexical in scope. This means that all references to
1311the named functions must appear physically within the body of the 1313the named functions must appear physically within @var{forms}.
1312@code{cl-flet} form.
1313 1314
1314Functions defined by @code{cl-flet} may use the full Common Lisp 1315Functions defined by @code{cl-flet} may use the full Common Lisp
1315argument notation supported by @code{cl-defun}; also, the function 1316argument notation supported by @code{cl-defun}; also, the function
@@ -1336,10 +1337,6 @@ functions must appear physically within the body of the
1336the functions themselves. Thus, @code{cl-labels} can define 1337the functions themselves. Thus, @code{cl-labels} can define
1337local recursive functions, or mutually-recursive sets of functions. 1338local recursive functions, or mutually-recursive sets of functions.
1338 1339
1339A ``reference'' to a function name is either a call to that
1340function, or a use of its name quoted by @code{quote} or
1341@code{function} to be passed on to, say, @code{mapcar}.
1342
1343Note that the @file{cl.el} version of this macro behaves slightly 1340Note that the @file{cl.el} version of this macro behaves slightly
1344differently. @xref{Obsolete Macros}. 1341differently. @xref{Obsolete Macros}.
1345@end defmac 1342@end defmac
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d7e4b4e611a..b50961adac9 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1998,13 +1998,16 @@ a `let' form, except that the list of symbols can be computed at run-time."
1998;;;###autoload 1998;;;###autoload
1999(defmacro cl-flet (bindings &rest body) 1999(defmacro cl-flet (bindings &rest body)
2000 "Make local function definitions. 2000 "Make local function definitions.
2001Like `cl-labels' but the definitions are not recursive. 2001Each definition can take the form (FUNC EXP) where
2002Each binding can take the form (FUNC EXP) where
2003FUNC is the function name, and EXP is an expression that returns the 2002FUNC is the function name, and EXP is an expression that returns the
2004function value to which it should be bound, or it can take the more common 2003function value to which it should be bound, or it can take the more common
2005form \(FUNC ARGLIST BODY...) which is a shorthand 2004form \(FUNC ARGLIST BODY...) which is a shorthand
2006for (FUNC (lambda ARGLIST BODY)). 2005for (FUNC (lambda ARGLIST BODY)).
2007 2006
2007FUNC is defined only within FORM, not BODY, so you can't write
2008recursive function definitions. Use `cl-labels' for that. See
2009info node `(cl) Function Bindings' for details.
2010
2008\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" 2011\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
2009 (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body))) 2012 (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
2010 (let ((binds ()) (newenv macroexpand-all-environment)) 2013 (let ((binds ()) (newenv macroexpand-all-environment))
@@ -2046,9 +2049,13 @@ Like `cl-flet' but the definitions can refer to previous ones.
2046 2049
2047;;;###autoload 2050;;;###autoload
2048(defmacro cl-labels (bindings &rest body) 2051(defmacro cl-labels (bindings &rest body)
2049 "Make temporary function bindings. 2052 "Make local (recursive) function definitions.
2050The bindings can be recursive and the scoping is lexical, but capturing them 2053Each definition can take the form (FUNC ARGLIST BODY...) where
2051in closures will only work if `lexical-binding' is in use. 2054FUNC is the function name, ARGLIST its arguments, and BODY the
2055forms of the function body. FUNC is defined in any BODY, as well
2056as FORM, so you can write recursive and mutually recursive
2057function definitions. See info node `(cl) Function Bindings' for
2058details.
2052 2059
2053\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" 2060\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
2054 (declare (indent 1) (debug cl-flet)) 2061 (declare (indent 1) (debug cl-flet))
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index d53c8e0bbcf..f6643158d2d 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -466,9 +466,12 @@ rather than relying on `lexical-binding'."
466 (push var sets) 466 (push var sets)
467 (push (cons (car binding) 467 (push (cons (car binding)
468 `(lambda (&rest cl-labels-args) 468 `(lambda (&rest cl-labels-args)
469 (cl-list* 'funcall ',var 469 (if (eq (car cl-labels-args) cl--labels-magic)
470 cl-labels-args))) 470 (list cl--labels-magic ',var)
471 (cl-list* 'funcall ',var cl-labels-args))))
471 newenv))) 472 newenv)))
473 ;; `lexical-let' adds `cl--function-convert' (which calls
474 ;; `cl--labels-convert') as a macroexpander for `function'.
472 (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv))) 475 (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
473 476
474;; Generalized variables are provided by gv.el, but some details are 477;; Generalized variables are provided by gv.el, but some details are
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 5d6ab7e057f..b40c424e303 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -127,9 +127,9 @@ the sequence, and its index within the sequence."
127 (setq index (1+ index))) 127 (setq index (1+ index)))
128 sequence))) 128 sequence)))
129 129
130(cl-defgeneric seqp (sequence) 130(cl-defgeneric seqp (object)
131 "Return non-nil if SEQUENCE is a sequence, nil otherwise." 131 "Return non-nil if OBJECT is a sequence, nil otherwise."
132 (sequencep sequence)) 132 (sequencep object))
133 133
134(cl-defgeneric seq-copy (sequence) 134(cl-defgeneric seq-copy (sequence)
135 "Return a shallow copy of SEQUENCE." 135 "Return a shallow copy of SEQUENCE."
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 693fc0284f2..d5c132f484e 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -2502,9 +2502,9 @@ is copied instead of being cut."
2502 (setq drag-but-negligible 2502 (setq drag-but-negligible
2503 (and (eq (overlay-buffer mouse-drag-and-drop-overlay) 2503 (and (eq (overlay-buffer mouse-drag-and-drop-overlay)
2504 buffer-to-paste) 2504 buffer-to-paste)
2505 (< (overlay-start mouse-drag-and-drop-overlay) 2505 (<= (overlay-start mouse-drag-and-drop-overlay)
2506 point-to-paste) 2506 point-to-paste)
2507 (< point-to-paste 2507 (<= point-to-paste
2508 (overlay-end mouse-drag-and-drop-overlay))))) 2508 (overlay-end mouse-drag-and-drop-overlay)))))
2509 2509
2510 ;; Show a tooltip. 2510 ;; Show a tooltip.
diff --git a/src/editfns.c b/src/editfns.c
index 9501cce20b3..76dd5711960 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3226,7 +3226,6 @@ buffer stay intact. */)
3226 /* Since we didn’t define EARLY_ABORT, we should never abort 3226 /* Since we didn’t define EARLY_ABORT, we should never abort
3227 early. */ 3227 early. */
3228 eassert (! early_abort); 3228 eassert (! early_abort);
3229 SAFE_FREE ();
3230 3229
3231 Fundo_boundary (); 3230 Fundo_boundary ();
3232 ptrdiff_t count = SPECPDL_INDEX (); 3231 ptrdiff_t count = SPECPDL_INDEX ();
@@ -3272,8 +3271,10 @@ buffer stay intact. */)
3272 --i; 3271 --i;
3273 --j; 3272 --j;
3274 } 3273 }
3274 unbind_to (count, Qnil);
3275 SAFE_FREE ();
3275 3276
3276 return unbind_to (count, Qnil); 3277 return Qnil;
3277} 3278}
3278 3279
3279static void 3280static void
diff --git a/src/xmenu.c b/src/xmenu.c
index 22995d8c7e8..6477d5b0aca 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -1158,11 +1158,17 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer
1158 GtkRequisition req; 1158 GtkRequisition req;
1159 int max_x = -1; 1159 int max_x = -1;
1160 int max_y = -1; 1160 int max_y = -1;
1161#ifdef HAVE_GTK3
1162 int scale;
1163#endif
1161 1164
1162 Lisp_Object frame, workarea; 1165 Lisp_Object frame, workarea;
1163 1166
1164 XSETFRAME (frame, data->f); 1167 XSETFRAME (frame, data->f);
1165 1168
1169#ifdef HAVE_GTK3
1170 scale = xg_get_scale (data->f);
1171#endif
1166 /* TODO: Get the monitor workarea directly without calculating other 1172 /* TODO: Get the monitor workarea directly without calculating other
1167 items in x-display-monitor-attributes-list. */ 1173 items in x-display-monitor-attributes-list. */
1168 workarea = call3 (Qframe_monitor_workarea, 1174 workarea = call3 (Qframe_monitor_workarea,
@@ -1188,11 +1194,20 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer
1188 max_y = x_display_pixel_height (dpyinfo); 1194 max_y = x_display_pixel_height (dpyinfo);
1189 } 1195 }
1190 1196
1197 /* frame-monitor-workarea and {x,y}_display_pixel_width/height all
1198 return device pixels, but GTK wants scaled pixels. The positions
1199 passed in via data were already scaled for us. */
1200#ifdef HAVE_GTK3
1201 max_x /= scale;
1202 max_y /= scale;
1203#endif
1191 *x = data->x; 1204 *x = data->x;
1192 *y = data->y; 1205 *y = data->y;
1193 1206
1194 /* Check if there is room for the menu. If not, adjust x/y so that 1207 /* Check if there is room for the menu. If not, adjust x/y so that
1195 the menu is fully visible. */ 1208 the menu is fully visible. gtk_widget_get_preferred_size returns
1209 scaled pixels, so there is no need to apply the scaling
1210 factor. */
1196 gtk_widget_get_preferred_size (GTK_WIDGET (menu), NULL, &req); 1211 gtk_widget_get_preferred_size (GTK_WIDGET (menu), NULL, &req);
1197 if (data->x + req.width > max_x) 1212 if (data->x + req.width > max_x)
1198 *x -= data->x + req.width - max_x; 1213 *x -= data->x + req.width - max_x;
diff --git a/test/lisp/emacs-lisp/cl-tests.el b/test/lisp/emacs-lisp/cl-tests.el
new file mode 100644
index 00000000000..b673822cd9a
--- /dev/null
+++ b/test/lisp/emacs-lisp/cl-tests.el
@@ -0,0 +1,35 @@
1;;; cl-tests.el --- tests for emacs-lisp/cl.el -*- lexical-binding:t -*-
2
3;; Copyright (C) 2018 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; This program is free software: you can redistribute it and/or
8;; modify it under the terms of the GNU General Public License as
9;; published by the Free Software Foundation, either version 3 of the
10;; License, or (at your option) any later version.
11;;
12;; This program is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15;; General Public License for more details.
16;;
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see `https://www.gnu.org/licenses/'.
19
20;;; Commentary:
21
22;;; Code:
23
24(require 'cl)
25(require 'ert)
26
27
28
29(ert-deftest labels-function-quoting ()
30 "Test that #'foo does the right thing in `labels'." ; Bug#31792.
31 (should (eq (funcall (labels ((foo () t))
32 #'foo))
33 t)))
34
35;;; cl-tests.el ends here