1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

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)
This commit is contained in:
Glenn Morris 2018-06-23 07:50:59 -07:00
commit b81e193ac0
11 changed files with 97 additions and 39 deletions

View file

@ -10049,7 +10049,7 @@ kill-ring kill-ring-yank-pointer
| | | | | |
| | --> "yet more text" | | --> "yet more text"
| | | |
| --> "a different piece of text | --> "a different piece of text"
| |
--> "some text" --> "some text"
@end group @end group

View file

@ -109,15 +109,15 @@ not be evaluated later. @xref{Input Functions}, for a description of
@node Comments @node Comments
@section Comments @section Comments
@cindex comments @cindex comments
@cindex @samp{;} in comment @cindex @samp{;} for commenting
A @dfn{comment} is text that is written in a program only for the sake A @dfn{comment} is text that is written in a program only for the
of humans that read the program, and that has no effect on the meaning sake of humans that read the program, and that has no effect on the
of the program. In Lisp, a semicolon (@samp{;}) starts a comment if it meaning of the program. In Lisp, an unescaped semicolon (@samp{;})
is not within a string or character constant. The comment continues to starts a comment if it is not within a string or character constant.
the end of line. The Lisp reader discards comments; they do not become The comment continues to the end of line. The Lisp reader discards
part of the Lisp objects which represent the program within the Lisp comments; they do not become part of the Lisp objects which represent
system. the program within the Lisp system.
The @samp{#@@@var{count}} construct, which skips the next @var{count} The @samp{#@@@var{count}} construct, which skips the next @var{count}
characters, is useful for program-generated comments containing binary characters, is useful for program-generated comments containing binary

View file

@ -474,8 +474,8 @@ built-in sequence types, @code{seq-length} behaves like @code{length}.
@xref{Definition of length}. @xref{Definition of length}.
@end defun @end defun
@defun seqp sequence @defun seqp object
This function returns non-@code{nil} if @var{sequence} is a sequence This function returns non-@code{nil} if @var{object} is a sequence
(a list or array), or any additional type of sequence defined via (a list or array), or any additional type of sequence defined via
@file{seq.el} generic functions. @file{seq.el} generic functions.

View file

@ -1299,17 +1299,18 @@ These forms make @code{let}-like bindings to functions instead
of variables. of variables.
@defmac cl-flet (bindings@dots{}) forms@dots{} @defmac cl-flet (bindings@dots{}) forms@dots{}
This form establishes @code{let}-style bindings on the function This form establishes @code{let}-style bindings for functions rather
cells of symbols rather than on the value cells. Each @var{binding} than values. Each @var{binding} must be a list of the form
must be a list of the form @samp{(@var{name} @var{arglist} @samp{(@var{name} @var{arglist} @var{body}@dots{})}. Within
@var{forms}@dots{})}, which defines a function exactly as if @var{forms}, any reference to the function @var{name} uses the local
it were a @code{cl-defun} form. The function @var{name} is defined definition instead of the global one.
accordingly but only within the body of the @code{cl-flet}, hiding any external
definition if applicable. A ``reference'' to a function name is either a call to that function,
or a use of its name quoted by @code{function} to be passed on to,
say, @code{mapcar}.
The bindings are lexical in scope. This means that all references to The bindings are lexical in scope. This means that all references to
the named functions must appear physically within the body of the the named functions must appear physically within @var{forms}.
@code{cl-flet} form.
Functions defined by @code{cl-flet} may use the full Common Lisp Functions defined by @code{cl-flet} may use the full Common Lisp
argument notation supported by @code{cl-defun}; also, the function argument notation supported by @code{cl-defun}; also, the function
@ -1336,10 +1337,6 @@ functions must appear physically within the body of the
the functions themselves. Thus, @code{cl-labels} can define the functions themselves. Thus, @code{cl-labels} can define
local recursive functions, or mutually-recursive sets of functions. local recursive functions, or mutually-recursive sets of functions.
A ``reference'' to a function name is either a call to that
function, or a use of its name quoted by @code{quote} or
@code{function} to be passed on to, say, @code{mapcar}.
Note that the @file{cl.el} version of this macro behaves slightly Note that the @file{cl.el} version of this macro behaves slightly
differently. @xref{Obsolete Macros}. differently. @xref{Obsolete Macros}.
@end defmac @end defmac

View file

@ -1998,13 +1998,16 @@ a `let' form, except that the list of symbols can be computed at run-time."
;;;###autoload ;;;###autoload
(defmacro cl-flet (bindings &rest body) (defmacro cl-flet (bindings &rest body)
"Make local function definitions. "Make local function definitions.
Like `cl-labels' but the definitions are not recursive. Each definition can take the form (FUNC EXP) where
Each binding can take the form (FUNC EXP) where
FUNC is the function name, and EXP is an expression that returns the FUNC is the function name, and EXP is an expression that returns the
function value to which it should be bound, or it can take the more common function value to which it should be bound, or it can take the more common
form \(FUNC ARGLIST BODY...) which is a shorthand form \(FUNC ARGLIST BODY...) which is a shorthand
for (FUNC (lambda ARGLIST BODY)). for (FUNC (lambda ARGLIST BODY)).
FUNC is defined only within FORM, not BODY, so you can't write
recursive function definitions. Use `cl-labels' for that. See
info node `(cl) Function Bindings' for details.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body))) (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
(let ((binds ()) (newenv macroexpand-all-environment)) (let ((binds ()) (newenv macroexpand-all-environment))
@ -2046,9 +2049,13 @@ Like `cl-flet' but the definitions can refer to previous ones.
;;;###autoload ;;;###autoload
(defmacro cl-labels (bindings &rest body) (defmacro cl-labels (bindings &rest body)
"Make temporary function bindings. "Make local (recursive) function definitions.
The bindings can be recursive and the scoping is lexical, but capturing them Each definition can take the form (FUNC ARGLIST BODY...) where
in closures will only work if `lexical-binding' is in use. FUNC is the function name, ARGLIST its arguments, and BODY the
forms of the function body. FUNC is defined in any BODY, as well
as FORM, so you can write recursive and mutually recursive
function definitions. See info node `(cl) Function Bindings' for
details.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug cl-flet)) (declare (indent 1) (debug cl-flet))

View file

@ -466,9 +466,12 @@ rather than relying on `lexical-binding'."
(push var sets) (push var sets)
(push (cons (car binding) (push (cons (car binding)
`(lambda (&rest cl-labels-args) `(lambda (&rest cl-labels-args)
(cl-list* 'funcall ',var (if (eq (car cl-labels-args) cl--labels-magic)
cl-labels-args))) (list cl--labels-magic ',var)
(cl-list* 'funcall ',var cl-labels-args))))
newenv))) newenv)))
;; `lexical-let' adds `cl--function-convert' (which calls
;; `cl--labels-convert') as a macroexpander for `function'.
(macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv))) (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
;; Generalized variables are provided by gv.el, but some details are ;; Generalized variables are provided by gv.el, but some details are

View file

@ -127,9 +127,9 @@ the sequence, and its index within the sequence."
(setq index (1+ index))) (setq index (1+ index)))
sequence))) sequence)))
(cl-defgeneric seqp (sequence) (cl-defgeneric seqp (object)
"Return non-nil if SEQUENCE is a sequence, nil otherwise." "Return non-nil if OBJECT is a sequence, nil otherwise."
(sequencep sequence)) (sequencep object))
(cl-defgeneric seq-copy (sequence) (cl-defgeneric seq-copy (sequence)
"Return a shallow copy of SEQUENCE." "Return a shallow copy of SEQUENCE."

View file

@ -2502,9 +2502,9 @@ is copied instead of being cut."
(setq drag-but-negligible (setq drag-but-negligible
(and (eq (overlay-buffer mouse-drag-and-drop-overlay) (and (eq (overlay-buffer mouse-drag-and-drop-overlay)
buffer-to-paste) buffer-to-paste)
(< (overlay-start mouse-drag-and-drop-overlay) (<= (overlay-start mouse-drag-and-drop-overlay)
point-to-paste) point-to-paste)
(< point-to-paste (<= point-to-paste
(overlay-end mouse-drag-and-drop-overlay))))) (overlay-end mouse-drag-and-drop-overlay)))))
;; Show a tooltip. ;; Show a tooltip.

View file

@ -3226,7 +3226,6 @@ buffer stay intact. */)
/* Since we didnt define EARLY_ABORT, we should never abort /* Since we didnt define EARLY_ABORT, we should never abort
early. */ early. */
eassert (! early_abort); eassert (! early_abort);
SAFE_FREE ();
Fundo_boundary (); Fundo_boundary ();
ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count = SPECPDL_INDEX ();
@ -3272,8 +3271,10 @@ buffer stay intact. */)
--i; --i;
--j; --j;
} }
unbind_to (count, Qnil);
SAFE_FREE ();
return unbind_to (count, Qnil); return Qnil;
} }
static void static void

View file

@ -1158,11 +1158,17 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer
GtkRequisition req; GtkRequisition req;
int max_x = -1; int max_x = -1;
int max_y = -1; int max_y = -1;
#ifdef HAVE_GTK3
int scale;
#endif
Lisp_Object frame, workarea; Lisp_Object frame, workarea;
XSETFRAME (frame, data->f); XSETFRAME (frame, data->f);
#ifdef HAVE_GTK3
scale = xg_get_scale (data->f);
#endif
/* TODO: Get the monitor workarea directly without calculating other /* TODO: Get the monitor workarea directly without calculating other
items in x-display-monitor-attributes-list. */ items in x-display-monitor-attributes-list. */
workarea = call3 (Qframe_monitor_workarea, workarea = call3 (Qframe_monitor_workarea,
@ -1188,11 +1194,20 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer
max_y = x_display_pixel_height (dpyinfo); max_y = x_display_pixel_height (dpyinfo);
} }
/* frame-monitor-workarea and {x,y}_display_pixel_width/height all
return device pixels, but GTK wants scaled pixels. The positions
passed in via data were already scaled for us. */
#ifdef HAVE_GTK3
max_x /= scale;
max_y /= scale;
#endif
*x = data->x; *x = data->x;
*y = data->y; *y = data->y;
/* Check if there is room for the menu. If not, adjust x/y so that /* Check if there is room for the menu. If not, adjust x/y so that
the menu is fully visible. */ the menu is fully visible. gtk_widget_get_preferred_size returns
scaled pixels, so there is no need to apply the scaling
factor. */
gtk_widget_get_preferred_size (GTK_WIDGET (menu), NULL, &req); gtk_widget_get_preferred_size (GTK_WIDGET (menu), NULL, &req);
if (data->x + req.width > max_x) if (data->x + req.width > max_x)
*x -= data->x + req.width - max_x; *x -= data->x + req.width - max_x;

View file

@ -0,0 +1,35 @@
;;; cl-tests.el --- tests for emacs-lisp/cl.el -*- lexical-binding:t -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
;;; Code:
(require 'cl)
(require 'ert)
(ert-deftest labels-function-quoting ()
"Test that #'foo does the right thing in `labels'." ; Bug#31792.
(should (eq (funcall (labels ((foo () t))
#'foo))
t)))
;;; cl-tests.el ends here