summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAndrea Corallo <akrl@sdf.org>2021-02-17 22:26:28 +0100
committerAndrea Corallo <akrl@sdf.org>2021-02-17 22:26:28 +0100
commitf92bb788a073c6b3ca7f188e0edea714598193fd (patch)
tree9bea27955098bfc33d0daaa345cfa3dca5b695fd /src
parent1fe5994bcb8b58012dbba0a5f7d03138c293286f (diff)
parent6735bb3d22dc64f3fe42e4a7f439ea9d62f75b5a (diff)
downloademacs-f92bb788a073c6b3ca7f188e0edea714598193fd.tar.gz
emacs-f92bb788a073c6b3ca7f188e0edea714598193fd.tar.bz2
emacs-f92bb788a073c6b3ca7f188e0edea714598193fd.zip
Merge remote-tracking branch 'savannah/master' into native-comp
Diffstat (limited to 'src')
-rw-r--r--src/buffer.c14
-rw-r--r--src/buffer.h3
-rw-r--r--src/callint.c9
-rw-r--r--src/data.c87
-rw-r--r--src/emacs-module.c8
-rw-r--r--src/eval.c41
-rw-r--r--src/frame.c4
-rw-r--r--src/image.c13
-rw-r--r--src/json.c77
-rw-r--r--src/lisp.h4
-rw-r--r--src/minibuf.c115
-rw-r--r--src/nsterm.h1
-rw-r--r--src/nsterm.m58
-rw-r--r--src/pdumper.c3
-rw-r--r--src/window.h4
-rw-r--r--src/xdisp.c9
-rw-r--r--src/xfns.c7
17 files changed, 349 insertions, 108 deletions
diff --git a/src/buffer.c b/src/buffer.c
index 80c799e719b..5bd9b37702f 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -292,6 +292,11 @@ bset_major_mode (struct buffer *b, Lisp_Object val)
b->major_mode_ = val;
}
static void
+bset_local_minor_modes (struct buffer *b, Lisp_Object val)
+{
+ b->local_minor_modes_ = val;
+}
+static void
bset_mark (struct buffer *b, Lisp_Object val)
{
b->mark_ = val;
@@ -893,6 +898,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
bset_file_truename (b, Qnil);
bset_display_count (b, make_fixnum (0));
bset_backed_up (b, Qnil);
+ bset_local_minor_modes (b, Qnil);
bset_auto_save_file_name (b, Qnil);
set_buffer_internal_1 (b);
Fset (intern ("buffer-save-without-query"), Qnil);
@@ -967,6 +973,7 @@ reset_buffer (register struct buffer *b)
b->clip_changed = 0;
b->prevent_redisplay_optimizations_p = 1;
bset_backed_up (b, Qnil);
+ bset_local_minor_modes (b, Qnil);
BUF_AUTOSAVE_MODIFF (b) = 0;
b->auto_save_failure_time = 0;
bset_auto_save_file_name (b, Qnil);
@@ -5151,6 +5158,7 @@ init_buffer_once (void)
bset_auto_save_file_name (&buffer_local_flags, make_fixnum (-1));
bset_read_only (&buffer_local_flags, make_fixnum (-1));
bset_major_mode (&buffer_local_flags, make_fixnum (-1));
+ bset_local_minor_modes (&buffer_local_flags, make_fixnum (-1));
bset_mode_name (&buffer_local_flags, make_fixnum (-1));
bset_undo_list (&buffer_local_flags, make_fixnum (-1));
bset_mark_active (&buffer_local_flags, make_fixnum (-1));
@@ -5617,6 +5625,12 @@ The default value (normally `fundamental-mode') affects new buffers.
A value of nil means to use the current buffer's major mode, provided
it is not marked as "special". */);
+ DEFVAR_PER_BUFFER ("local-minor-modes",
+ &BVAR (current_buffer, local_minor_modes),
+ Qnil,
+ doc: /* Minor modes currently active in the current buffer.
+This is a list of symbols, or nil if there are no minor modes active. */);
+
DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
Qnil,
doc: /* Pretty name of current buffer's major mode.
diff --git a/src/buffer.h b/src/buffer.h
index 790291f1185..24e9c3fcbc8 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -338,6 +338,9 @@ struct buffer
/* Symbol naming major mode (e.g., lisp-mode). */
Lisp_Object major_mode_;
+ /* Symbol listing all currently enabled minor modes. */
+ Lisp_Object local_minor_modes_;
+
/* Pretty name of major mode (e.g., "Lisp"). */
Lisp_Object mode_name_;
diff --git a/src/callint.c b/src/callint.c
index d3f49bc35d1..18624637843 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -104,7 +104,14 @@ If the string begins with `^' and `shift-select-mode' is non-nil,
Emacs first calls the function `handle-shift-selection'.
You may use `@', `*', and `^' together. They are processed in the
order that they appear, before reading any arguments.
-usage: (interactive &optional ARG-DESCRIPTOR) */
+
+If MODES is present, it should be a list of mode names (symbols) that
+this command is applicable for. The main effect of this is that
+`M-x TAB' (by default) won't list this command if the current buffer's
+mode doesn't match the list. That is, if either the major mode isn't
+derived from them, or (when it's a minor mode) the mode isn't in effect.
+
+usage: (interactive &optional ARG-DESCRIPTOR &rest MODES) */
attributes: const)
(Lisp_Object args)
{
diff --git a/src/data.c b/src/data.c
index 2fa92fecc4f..5177a7cc649 100644
--- a/src/data.c
+++ b/src/data.c
@@ -978,7 +978,17 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (COMPILEDP (fun))
{
if (PVSIZE (fun) > COMPILED_INTERACTIVE)
- return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
+ {
+ Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ if (VECTORP (form))
+ /* The vector form is the new form, where the first
+ element is the interactive spec, and the second is the
+ command modes. */
+ return list2 (Qinteractive, AREF (form, 0));
+ else
+ /* Old form -- just the interactive spec. */
+ return list2 (Qinteractive, form);
+ }
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
@@ -994,10 +1004,75 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
- if (EQ (funcar, Qclosure))
- return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
- else if (EQ (funcar, Qlambda))
- return Fassq (Qinteractive, Fcdr (XCDR (fun)));
+ if (EQ (funcar, Qclosure)
+ || EQ (funcar, Qlambda))
+ {
+ Lisp_Object form = Fcdr (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ form = Fcdr (form);
+ Lisp_Object spec = Fassq (Qinteractive, form);
+ if (NILP (Fcdr (Fcdr (spec))))
+ return spec;
+ else
+ return list2 (Qinteractive, Fcar (Fcdr (spec)));
+ }
+ }
+ return Qnil;
+}
+
+DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0,
+ doc: /* Return the modes COMMAND is defined for.
+If COMMAND is not a command, the return value is nil.
+The value, if non-nil, is a list of mode name symbols. */)
+ (Lisp_Object command)
+{
+ Lisp_Object fun = indirect_function (command); /* Check cycles. */
+
+ if (NILP (fun))
+ return Qnil;
+
+ fun = command;
+ while (SYMBOLP (fun))
+ fun = Fsymbol_function (fun);
+
+ if (COMPILEDP (fun))
+ {
+ Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ if (VECTORP (form))
+ /* New form -- the second element is the command modes. */
+ return AREF (form, 1);
+ else
+ /* Old .elc file -- no command modes. */
+ return Qnil;
+ }
+#ifdef HAVE_MODULES
+ else if (MODULE_FUNCTIONP (fun))
+ {
+ Lisp_Object form
+ = module_function_command_modes (XMODULE_FUNCTION (fun));
+ if (! NILP (form))
+ return form;
+ }
+#endif
+ else if (AUTOLOADP (fun))
+ {
+ Lisp_Object modes = Fnth (make_int (3), fun);
+ if (CONSP (modes))
+ return modes;
+ else
+ return Qnil;
+ }
+ else if (CONSP (fun))
+ {
+ Lisp_Object funcar = XCAR (fun);
+ if (EQ (funcar, Qclosure)
+ || EQ (funcar, Qlambda))
+ {
+ Lisp_Object form = Fcdr (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ form = Fcdr (form);
+ return Fcdr (Fcdr (Fassq (Qinteractive, form)));
+ }
}
return Qnil;
}
@@ -3983,6 +4058,7 @@ syms_of_data (void)
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
+ defsubr (&Scommand_modes);
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
@@ -4113,6 +4189,7 @@ This variable cannot be set; trying to do so will signal an error. */);
DEFSYM (Qunlet, "unlet");
DEFSYM (Qset, "set");
DEFSYM (Qset_default, "set-default");
+ DEFSYM (Qcommand_modes, "command-modes");
defsubr (&Sadd_variable_watcher);
defsubr (&Sremove_variable_watcher);
defsubr (&Sget_variable_watchers);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 894dffcf21e..f8fb54c0728 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -549,7 +549,7 @@ struct Lisp_Module_Function
union vectorlike_header header;
/* Fields traced by GC; these must come first. */
- Lisp_Object documentation, interactive_form;
+ Lisp_Object documentation, interactive_form, command_modes;
/* Fields ignored by GC. */
ptrdiff_t min_arity, max_arity;
@@ -646,6 +646,12 @@ module_function_interactive_form (const struct Lisp_Module_Function *fun)
return fun->interactive_form;
}
+Lisp_Object
+module_function_command_modes (const struct Lisp_Module_Function *fun)
+{
+ return fun->command_modes;
+}
+
static emacs_value
module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
emacs_value *args)
diff --git a/src/eval.c b/src/eval.c
index bf5f6995d87..10e53cf9aed 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1174,21 +1174,23 @@ usage: (catch TAG BODY...) */)
FUNC should return a Lisp_Object.
This is how catches are done from within C code. */
+/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
+ throwing t to tag `exit'.
+ 0 means there is no (throw 'exit t) in progress, or it wasn't from
+ a minibuffer which isn't the most nested;
+ N > 0 means the `throw' was done from the minibuffer at level N which
+ wasn't the most nested. */
+EMACS_INT minibuffer_quit_level = 0;
+
Lisp_Object
internal_catch (Lisp_Object tag,
Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
- /* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
- throwing t to tag `exit'.
- Value -1 means there is no (throw 'exit t) in progress;
- 0 means the `throw' wasn't done from an active minibuffer;
- N > 0 means the `throw' was done from the minibuffer at level N. */
- static EMACS_INT minibuffer_quit_level = -1;
/* This structure is made part of the chain `catchlist'. */
struct handler *c = push_handler (tag, CATCHER);
if (EQ (tag, Qexit))
- minibuffer_quit_level = -1;
+ minibuffer_quit_level = 0;
/* Call FUNC. */
if (! sys_setjmp (c->jmp))
@@ -1203,22 +1205,16 @@ internal_catch (Lisp_Object tag,
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
- if (EQ (tag, Qexit) && EQ (val, Qt))
+ if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0)
/* If we've thrown t to tag `exit' from within a minibuffer, we
exit all minibuffers more deeply nested than the current
one. */
{
- EMACS_INT mini_depth = this_minibuffer_depth (Qnil);
- if (mini_depth && mini_depth != minibuffer_quit_level)
- {
- if (minibuffer_quit_level == -1)
- minibuffer_quit_level = mini_depth;
- if (minibuffer_quit_level
- && (minibuf_level > minibuffer_quit_level))
- Fthrow (Qexit, Qt);
- }
+ if (minibuf_level > minibuffer_quit_level
+ && !NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
+ Fthrow (Qexit, Qt);
else
- minibuffer_quit_level = -1;
+ minibuffer_quit_level = 0;
}
return val;
}
@@ -2177,14 +2173,21 @@ then strings and vectors are not accepted. */)
DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
doc: /* Define FUNCTION to autoload from FILE.
FUNCTION is a symbol; FILE is a file name string to pass to `load'.
+
Third arg DOCSTRING is documentation for the function.
-Fourth arg INTERACTIVE if non-nil says function can be called interactively.
+
+Fourth arg INTERACTIVE if non-nil says function can be called
+interactively. If INTERACTIVE is a list, it is interpreted as a list
+of modes the function is applicable for.
+
Fifth arg TYPE indicates the type of the object:
nil or omitted says FUNCTION is a function,
`keymap' says FUNCTION is really a keymap, and
`macro' or t says FUNCTION is really a macro.
+
Third through fifth args give info about the real definition.
They default to nil.
+
If FUNCTION is already defined other than as an autoload,
this does nothing and returns nil. */)
(Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object interactive, Lisp_Object type)
diff --git a/src/frame.c b/src/frame.c
index 635fc945604..a62347c1fb2 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3890,7 +3890,7 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what,
Lisp_Object frame;
XSETFRAME (frame, f);
- monitor_attributes = Fcar (call1 (Qdisplay_monitor_attributes_list, frame));
+ monitor_attributes = call1 (Qframe_monitor_attributes, frame);
if (NILP (monitor_attributes))
{
/* No monitor attributes available. */
@@ -5890,7 +5890,7 @@ syms_of_frame (void)
DEFSYM (Qframep, "framep");
DEFSYM (Qframe_live_p, "frame-live-p");
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
- DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list");
+ DEFSYM (Qframe_monitor_attributes, "frame-monitor-attributes");
DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
diff --git a/src/image.c b/src/image.c
index a124cf91ba0..8137dbea8d7 100644
--- a/src/image.c
+++ b/src/image.c
@@ -135,6 +135,12 @@ typedef struct ns_bitmap_record Bitmap_Record;
# define COLOR_TABLE_SUPPORT 1
#endif
+#if defined HAVE_NS
+# define FRAME_SCALE_FACTOR(f) ns_frame_scale_factor (f)
+#else
+# define FRAME_SCALE_FACTOR(f) 1;
+#endif
+
static void image_disable_image (struct frame *, struct image *);
static void image_edge_detection (struct frame *, struct image *, Lisp_Object,
Lisp_Object);
@@ -2207,8 +2213,8 @@ image_set_transform (struct frame *f, struct image *img)
/* SVGs are pre-scaled to the correct size. */
if (EQ (image_spec_value (img->spec, QCtype, NULL), Qsvg))
{
- width = img->width;
- height = img->height;
+ width = img->width / FRAME_SCALE_FACTOR (f);
+ height = img->height / FRAME_SCALE_FACTOR (f);
}
else
#endif
@@ -10008,6 +10014,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
compute_image_size (viewbox_width, viewbox_height, img->spec,
&width, &height);
+ width *= FRAME_SCALE_FACTOR (f);
+ height *= FRAME_SCALE_FACTOR (f);
+
if (! check_image_size (f, width, height))
{
image_size_error ();
diff --git a/src/json.c b/src/json.c
index 2901a20811a..3f1d27ad7fb 100644
--- a/src/json.c
+++ b/src/json.c
@@ -327,13 +327,14 @@ struct json_configuration {
Lisp_Object false_object;
};
-static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf);
+static json_t *lisp_to_json (Lisp_Object,
+ const struct json_configuration *conf);
-/* Convert a Lisp object to a toplevel JSON object (array or object). */
+/* Convert a Lisp object to a nonscalar JSON object (array or object). */
static json_t *
-lisp_to_json_toplevel_1 (Lisp_Object lisp,
- struct json_configuration *conf)
+lisp_to_json_nonscalar_1 (Lisp_Object lisp,
+ const struct json_configuration *conf)
{
json_t *json;
ptrdiff_t count;
@@ -448,16 +449,17 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp,
return json;
}
-/* Convert LISP to a toplevel JSON object (array or object). Signal
+/* Convert LISP to a nonscalar JSON object (array or object). Signal
an error of type `wrong-type-argument' if LISP is not a vector,
hashtable, alist, or plist. */
static json_t *
-lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf)
+lisp_to_json_nonscalar (Lisp_Object lisp,
+ const struct json_configuration *conf)
{
if (++lisp_eval_depth > max_lisp_eval_depth)
xsignal0 (Qjson_object_too_deep);
- json_t *json = lisp_to_json_toplevel_1 (lisp, conf);
+ json_t *json = lisp_to_json_nonscalar_1 (lisp, conf);
--lisp_eval_depth;
return json;
}
@@ -467,7 +469,7 @@ lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf)
JSON object. */
static json_t *
-lisp_to_json (Lisp_Object lisp, struct json_configuration *conf)
+lisp_to_json (Lisp_Object lisp, const struct json_configuration *conf)
{
if (EQ (lisp, conf->null_object))
return json_check (json_null ());
@@ -499,7 +501,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf)
}
/* LISP now must be a vector, hashtable, alist, or plist. */
- return lisp_to_json_toplevel (lisp, conf);
+ return lisp_to_json_nonscalar (lisp, conf);
}
static void
@@ -557,15 +559,15 @@ DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY,
NULL,
doc: /* Return the JSON representation of OBJECT as a string.
-OBJECT must be a vector, hashtable, alist, or plist and its elements
-can recursively contain the Lisp equivalents to the JSON null and
-false values, t, numbers, strings, or other vectors hashtables, alists
-or plists. t will be converted to the JSON true value. Vectors will
-be converted to JSON arrays, whereas hashtables, alists and plists are
-converted to JSON objects. Hashtable keys must be strings without
-embedded null characters and must be unique within each object. Alist
-and plist keys must be symbols; if a key is duplicate, the first
-instance is used.
+OBJECT must be t, a number, string, vector, hashtable, alist, plist,
+or the Lisp equivalents to the JSON null and false values, and its
+elements must recursively consist of the same kinds of values. t will
+be converted to the JSON true value. Vectors will be converted to
+JSON arrays, whereas hashtables, alists and plists are converted to
+JSON objects. Hashtable keys must be strings without embedded null
+characters and must be unique within each object. Alist and plist
+keys must be symbols; if a key is duplicate, the first instance is
+used.
The Lisp equivalents to the JSON null and false values are
configurable in the arguments ARGS, a list of keyword/argument pairs:
@@ -603,12 +605,10 @@ usage: (json-serialize OBJECT &rest ARGS) */)
{json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, false);
- json_t *json = lisp_to_json_toplevel (args[0], &conf);
+ json_t *json = lisp_to_json (args[0], &conf);
record_unwind_protect_ptr (json_release_object, json);
- /* If desired, we might want to add the following flags:
- JSON_DECODE_ANY, JSON_ALLOW_NUL. */
- char *string = json_dumps (json, JSON_COMPACT);
+ char *string = json_dumps (json, JSON_COMPACT | JSON_ENCODE_ANY);
if (string == NULL)
json_out_of_memory ();
record_unwind_protect_ptr (json_free, string);
@@ -723,12 +723,10 @@ usage: (json-insert OBJECT &rest ARGS) */)
move_gap_both (PT, PT_BYTE);
struct json_insert_data data;
data.inserted_bytes = 0;
- /* If desired, we might want to add the following flags:
- JSON_DECODE_ANY, JSON_ALLOW_NUL. */
- int status
- /* Could have used json_dumpb, but that became available only in
- Jansson 2.10, whereas we want to support 2.7 and upward. */
- = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT);
+ /* Could have used json_dumpb, but that became available only in
+ Jansson 2.10, whereas we want to support 2.7 and upward. */
+ int status = json_dump_callback (json, json_insert_callback, &data,
+ JSON_COMPACT | JSON_ENCODE_ANY);
if (status == -1)
{
if (CONSP (data.error))
@@ -791,7 +789,7 @@ usage: (json-insert OBJECT &rest ARGS) */)
/* Convert a JSON object to a Lisp object. */
static Lisp_Object ARG_NONNULL ((1))
-json_to_lisp (json_t *json, struct json_configuration *conf)
+json_to_lisp (json_t *json, const struct json_configuration *conf)
{
switch (json_typeof (json))
{
@@ -932,12 +930,12 @@ DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
NULL,
doc: /* Parse the JSON STRING into a Lisp object.
This is essentially the reverse operation of `json-serialize', which
-see. The returned object will be a vector, list, hashtable, alist, or
-plist. Its elements will be the JSON null value, the JSON false
-value, t, numbers, strings, or further vectors, hashtables, alists, or
-plists. If there are duplicate keys in an object, all but the last
-one are ignored. If STRING doesn't contain a valid JSON object, this
-function signals an error of type `json-parse-error'.
+see. The returned object will be the JSON null value, the JSON false
+value, t, a number, a string, a vector, a list, a hashtable, an alist,
+or a plist. Its elements will be further objects of these types. If
+there are duplicate keys in an object, all but the last one are
+ignored. If STRING doesn't contain a valid JSON object, this function
+signals an error of type `json-parse-error'.
The arguments ARGS are a list of keyword/argument pairs:
@@ -982,7 +980,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
json_parse_args (nargs - 1, args + 1, &conf, true);
json_error_t error;
- json_t *object = json_loads (SSDATA (encoded), 0, &error);
+ json_t *object
+ = json_loads (SSDATA (encoded), JSON_DECODE_ANY, &error);
if (object == NULL)
json_parse_error (&error);
@@ -1078,8 +1077,10 @@ usage: (json-parse-buffer &rest args) */)
ptrdiff_t point = PT_BYTE;
struct json_read_buffer_data data = {.point = point};
json_error_t error;
- json_t *object = json_load_callback (json_read_buffer_callback, &data,
- JSON_DISABLE_EOF_CHECK, &error);
+ json_t *object
+ = json_load_callback (json_read_buffer_callback, &data,
+ JSON_DECODE_ANY | JSON_DISABLE_EOF_CHECK,
+ &error);
if (object == NULL)
json_parse_error (&error);
diff --git a/src/lisp.h b/src/lisp.h
index 1d4f16bd581..fcdf8e27181 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4110,6 +4110,7 @@ intern_c_string (const char *str)
}
/* Defined in eval.c. */
+extern EMACS_INT minibuffer_quit_level;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
@@ -4242,6 +4243,8 @@ extern Lisp_Object module_function_documentation
(struct Lisp_Module_Function const *);
extern Lisp_Object module_function_interactive_form
(const struct Lisp_Module_Function *);
+extern Lisp_Object module_function_command_modes
+ (const struct Lisp_Module_Function *);
extern module_funcptr module_function_address
(struct Lisp_Module_Function const *);
extern void *module_function_data (const struct Lisp_Module_Function *);
@@ -4391,6 +4394,7 @@ extern void syms_of_casetab (void);
/* Defined in keyboard.c. */
+extern EMACS_INT command_loop_level;
extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard;
extern void cancel_echoing (void);
diff --git a/src/minibuf.c b/src/minibuf.c
index 949c3d989d5..4b1f4b1ff72 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -41,6 +41,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
minibuffer recursions are encountered. */
Lisp_Object Vminibuffer_list;
+Lisp_Object Vcommand_loop_level_list;
/* Data to remember during recursive minibuffer invocations. */
@@ -64,6 +65,8 @@ static Lisp_Object minibuf_prompt;
static ptrdiff_t minibuf_prompt_width;
static Lisp_Object nth_minibuffer (EMACS_INT depth);
+static EMACS_INT minibuf_c_loop_level (EMACS_INT depth);
+static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth);
/* Return TRUE when a frame switch causes a minibuffer on the old
@@ -181,7 +184,12 @@ void move_minibuffer_onto_frame (void)
set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0);
minibuf_window = sf->minibuffer_window;
if (of != sf)
- set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0);
+ {
+ Lisp_Object temp = get_minibuffer (0);
+
+ set_window_buffer (of->minibuffer_window, temp, 0, 0);
+ set_minibuffer_mode (temp, 0);
+ }
}
}
@@ -389,6 +397,21 @@ No argument or nil as argument means use the current buffer as BUFFER. */)
: Qnil;
}
+DEFUN ("minibuffer-innermost-command-loop-p", Fminibuffer_innermost_command_loop_p,
+ Sminibuffer_innermost_command_loop_p, 0, 1, 0,
+ doc: /* Return t if BUFFER is a minibuffer at the current command loop level.
+No argument or nil as argument means use the current buffer as BUFFER. */)
+ (Lisp_Object buffer)
+{
+ EMACS_INT depth;
+ if (NILP (buffer))
+ buffer = Fcurrent_buffer ();
+ depth = this_minibuffer_depth (buffer);
+ return depth && minibuf_c_loop_level (depth) == command_loop_level
+ ? Qt
+ : Qnil;
+}
+
/* Return the nesting depth of the active minibuffer BUFFER, or 0 if
BUFFER isn't such a thing. If BUFFER is nil, this means use the current
buffer. */
@@ -420,12 +443,17 @@ confirm the aborting of the current minibuffer and all contained ones. */)
if (!minibuf_depth)
error ("Not in a minibuffer");
+ if (NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
+ error ("Not in most nested command loop");
if (minibuf_depth < minibuf_level)
{
array[0] = fmt;
array[1] = make_fixnum (minibuf_level - minibuf_depth + 1);
if (!NILP (Fyes_or_no_p (Fformat (2, array))))
- Fthrow (Qexit, Qt);
+ {
+ minibuffer_quit_level = minibuf_depth;
+ Fthrow (Qexit, Qt);
+ }
}
else
Fthrow (Qexit, Qt);
@@ -508,6 +536,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
Lisp_Object calling_frame = selected_frame;
+ Lisp_Object calling_window = selected_window;
Lisp_Object enable_multibyte;
EMACS_INT pos = 0;
/* String to add to the history. */
@@ -598,7 +627,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
if (minibuf_level > 1
&& minibuf_moves_frame_when_opened ()
- && !minibuf_follows_frame ())
+ && (!minibuf_follows_frame ()
+ || (!EQ (mini_frame, selected_frame))))
{
EMACS_INT i;
@@ -607,8 +637,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
set_window_buffer (minibuf_window, nth_minibuffer (i), 0, 0);
}
- record_unwind_protect_void (choose_minibuf_frame);
-
record_unwind_protect (restore_window_configuration,
Fcons (Qt, Fcurrent_window_configuration (Qnil)));
@@ -640,7 +668,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
minibuf_save_list
= Fcons (Voverriding_local_map,
Fcons (minibuf_window,
- minibuf_save_list));
+ Fcons (calling_frame,
+ Fcons (calling_window,
+ minibuf_save_list))));
minibuf_save_list
= Fcons (minibuf_prompt,
Fcons (make_fixnum (minibuf_prompt_width),
@@ -694,6 +724,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Switch to the minibuffer. */
minibuffer = get_minibuffer (minibuf_level);
+ set_minibuffer_mode (minibuffer, minibuf_level);
Fset_buffer (minibuffer);
/* Defeat (setq-default truncate-lines t), since truncated lines do
@@ -738,6 +769,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
where there is an active minibuffer.
Set them to point to ` *Minibuf-0*', which is always empty. */
empty_minibuf = get_minibuffer (0);
+ set_minibuffer_mode (empty_minibuf, 0);
FOR_EACH_FRAME (dummy, frame)
{
@@ -837,20 +869,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
recursive_edit_1 ();
- /* We've exited the recursive edit without an error, so switch the
- current window away from the expired minibuffer window. */
- {
- Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
- /* PREV can be on a different frame when we have a minibuffer only
- frame, the other frame's minibuffer window is MINIBUF_WINDOW,
- and its "focus window" is also MINIBUF_WINDOW. */
- while (!EQ (prev, minibuf_window)
- && !EQ (selected_frame, WINDOW_FRAME (XWINDOW (prev))))
- prev = Fprevious_window (prev, Qnil, Qnil);
- if (!EQ (prev, minibuf_window))
- Fset_frame_selected_window (selected_frame, prev, Qnil);
- }
-
/* If cursor is on the minibuffer line,
show the user we have exited by putting it in column 0. */
if (XWINDOW (minibuf_window)->cursor.vpos >= 0
@@ -959,11 +977,16 @@ Lisp_Object
get_minibuffer (EMACS_INT depth)
{
Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
+ Lisp_Object cll_tail = Fnthcdr (make_fixnum (depth),
+ Vcommand_loop_level_list);
if (NILP (tail))
{
tail = list1 (Qnil);
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
+ cll_tail = list1 (Qnil);
+ Vcommand_loop_level_list = nconc2 (Vcommand_loop_level_list, cll_tail);
}
+ XSETCAR (cll_tail, make_fixnum (depth ? command_loop_level : 0));
Lisp_Object buf = Fcar (tail);
if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf)))
{
@@ -973,7 +996,6 @@ get_minibuffer (EMACS_INT depth)
buf = Fget_buffer_create (lname, Qnil);
/* Do this before set_minibuffer_mode. */
XSETCAR (tail, buf);
- set_minibuffer_mode (buf, depth);
/* Although the buffer's name starts with a space, undo should be
enabled in it. */
Fbuffer_enable_undo (buf);
@@ -985,12 +1007,19 @@ get_minibuffer (EMACS_INT depth)
while the buffer doesn't know about them any more. */
delete_all_overlays (XBUFFER (buf));
reset_buffer (XBUFFER (buf));
- set_minibuffer_mode (buf, depth);
}
return buf;
}
+static EMACS_INT minibuf_c_loop_level (EMACS_INT depth)
+{
+ Lisp_Object cll = Fnth (make_fixnum (depth), Vcommand_loop_level_list);
+ if (FIXNUMP (cll))
+ return XFIXNUM (cll);
+ return 0;
+}
+
static void
run_exit_minibuf_hook (void)
{
@@ -1004,17 +1033,16 @@ static void
read_minibuf_unwind (void)
{
Lisp_Object old_deactivate_mark;
- Lisp_Object window;
+ Lisp_Object calling_frame;
+ Lisp_Object calling_window;
Lisp_Object future_mini_window;
- /* If this was a recursive minibuffer,
- tie the minibuffer window back to the outer level minibuffer buffer. */
- minibuf_level--;
-
- window = minibuf_window;
/* To keep things predictable, in case it matters, let's be in the
- minibuffer when we reset the relevant variables. */
- Fset_buffer (XWINDOW (window)->contents);
+ minibuffer when we reset the relevant variables. Don't depend on
+ `minibuf_window' here. This could by now be the mini-window of any
+ frame. */
+ Fset_buffer (nth_minibuffer (minibuf_level));
+ minibuf_level--;
/* Restore prompt, etc, from outer minibuffer level. */
Lisp_Object key_vec = Fcar (minibuf_save_list);
@@ -1042,6 +1070,10 @@ read_minibuf_unwind (void)
#endif
future_mini_window = Fcar (minibuf_save_list);
minibuf_save_list = Fcdr (minibuf_save_list);
+ calling_frame = Fcar (minibuf_save_list);
+ minibuf_save_list = Fcdr (minibuf_save_list);
+ calling_window = Fcar (minibuf_save_list);
+ minibuf_save_list = Fcdr (minibuf_save_list);
/* Erase the minibuffer we were using at this level. */
{
@@ -1059,7 +1091,7 @@ read_minibuf_unwind (void)
mini-window back to its normal size. */
if (minibuf_level == 0
|| !EQ (selected_frame, WINDOW_FRAME (XWINDOW (future_mini_window))))
- resize_mini_window (XWINDOW (window), 0);
+ resize_mini_window (XWINDOW (minibuf_window), 0);
/* Deal with frames that should be removed when exiting the
minibuffer. */
@@ -1090,6 +1122,24 @@ read_minibuf_unwind (void)
to make sure we don't leave around bindings and stuff which only
made sense during the read_minibuf invocation. */
call0 (intern ("minibuffer-inactive-mode"));
+
+ /* We've exited the recursive edit, so switch the current windows
+ away from the expired minibuffer window, both in the current
+ minibuffer's frame and the original calling frame. */
+ choose_minibuf_frame ();
+ if (!EQ (WINDOW_FRAME (XWINDOW (minibuf_window)), calling_frame))
+ {
+ Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
+ /* PREV can be on a different frame when we have a minibuffer only
+ frame, the other frame's minibuffer window is MINIBUF_WINDOW,
+ and its "focus window" is also MINIBUF_WINDOW. */
+ if (!EQ (prev, minibuf_window)
+ && EQ (WINDOW_FRAME (XWINDOW (prev)),
+ WINDOW_FRAME (XWINDOW (minibuf_window))))
+ Fset_frame_selected_window (selected_frame, prev, Qnil);
+ }
+ else
+ Fset_frame_selected_window (calling_frame, calling_window, Qnil);
}
@@ -2137,6 +2187,7 @@ void
init_minibuf_once (void)
{
staticpro (&Vminibuffer_list);
+ staticpro (&Vcommand_loop_level_list);
pdumper_do_now_and_after_load (init_minibuf_once_for_pdumper);
}
@@ -2150,6 +2201,7 @@ init_minibuf_once_for_pdumper (void)
restore from a dump file. pdumper doesn't try to preserve
frames, windows, and so on, so reset everything related here. */
Vminibuffer_list = Qnil;
+ Vcommand_loop_level_list = Qnil;
minibuf_level = 0;
minibuf_prompt = Qnil;
minibuf_save_list = Qnil;
@@ -2380,6 +2432,7 @@ instead. */);
defsubr (&Sminibufferp);
defsubr (&Sinnermost_minibuffer_p);
+ defsubr (&Sminibuffer_innermost_command_loop_p);
defsubr (&Sabort_minibuffers);
defsubr (&Sminibuffer_prompt_end);
defsubr (&Sminibuffer_contents);
diff --git a/src/nsterm.h b/src/nsterm.h
index eae1d0725ea..017c2394ef1 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -1252,6 +1252,7 @@ struct input_event;
extern void ns_init_events (struct input_event *);
extern void ns_finish_events (void);
+extern double ns_frame_scale_factor (struct frame *);
#ifdef NS_IMPL_GNUSTEP
extern char gnustep_base_version[]; /* version tracking */
diff --git a/src/nsterm.m b/src/nsterm.m
index 1b2328628ee..b0cf5952fd5 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -857,6 +857,17 @@ ns_row_rect (struct window *w, struct glyph_row *row,
}
+double
+ns_frame_scale_factor (struct frame *f)
+{
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > 1060
+ return [[FRAME_NS_VIEW (f) window] backingScaleFactor];
+#else
+ return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor];
+#endif
+}
+
+
/* ==========================================================================
Focus (clipping) and screen update
@@ -7339,6 +7350,8 @@ not_in_argv (NSString *arg)
[surface release];
surface = nil;
+
+ [self setNeedsDisplay:YES];
}
#endif
@@ -7510,6 +7523,16 @@ not_in_argv (NSString *arg)
[self initWithFrame: r];
[self setAutoresizingMask: NSViewWidthSizable | NSViewHeightSizable];
+#ifdef NS_DRAW_TO_BUFFER
+ /* These settings mean AppKit will retain the contents of the frame
+ on resize. Unfortunately it also means the frame will not be
+ automatically marked for display, but we can do that ourselves in
+ viewDidResize. */
+ [self setLayerContentsRedrawPolicy:
+ NSViewLayerContentsRedrawOnSetNeedsDisplay];
+ [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
+#endif
+
FRAME_NS_VIEW (f) = self;
emacsframe = f;
#ifdef NS_IMPL_COCOA
@@ -8452,6 +8475,34 @@ not_in_argv (NSString *arg)
}
+#ifdef NS_IMPL_COCOA
+/* If the frame has been garbaged but the toolkit wants to draw, for
+ example when resizing the frame, we end up with a blank screen.
+ Sometimes this results in an unpleasant flicker, so try to
+ redisplay before drawing. */
+- (void)viewWillDraw
+{
+ if (FRAME_GARBAGED_P (emacsframe)
+ && !redisplaying_p)
+ {
+ /* If there is IO going on when redisplay is run here Emacs
+ crashes. I think it's because this code will always be run
+ within the run loop and for whatever reason processing input
+ is dangerous. This technique was stolen wholesale from
+ nsmenu.m and seems to work. */
+ bool owfi = waiting_for_input;
+ waiting_for_input = 0;
+ block_input ();
+
+ redisplay ();
+
+ unblock_input ();
+ waiting_for_input = owfi;
+ }
+}
+#endif
+
+
#ifdef NS_DRAW_TO_BUFFER
- (BOOL)wantsUpdateLayer
{
@@ -8469,6 +8520,13 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsView updateLayer]");
+ /* We run redisplay on frames that are garbaged, but marked for
+ display, before updateLayer is called so if the frame is still
+ garbaged that means the last redisplay must have refused to
+ update the frame. */
+ if (FRAME_GARBAGED_P (emacsframe))
+ return;
+
/* This can fail to update the screen if the same surface is
provided twice in a row, even if its contents have changed.
There's a private method, -[CALayer setContentsChanged], that we
diff --git a/src/pdumper.c b/src/pdumper.c
index 1f1f6e05df4..f053143a9f7 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2712,7 +2712,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_99D642C1CB
+#if CHECK_STRUCTS && !defined HASH_buffer_F8FE65D42F
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2723,6 +2723,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
buffer->window_count = 0;
else
eassert (buffer->window_count == -1);
+ buffer->local_minor_modes_ = Qnil;
buffer->last_selected_window_ = Qnil;
buffer->display_count_ = make_fixnum (0);
buffer->clip_changed = 0;
diff --git a/src/window.h b/src/window.h
index 79eb44e7a38..b6f88e8f55f 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1120,10 +1120,6 @@ void set_window_buffer (Lisp_Object window, Lisp_Object buffer,
extern Lisp_Object echo_area_window;
-/* Depth in recursive edits. */
-
-extern EMACS_INT command_loop_level;
-
/* Non-zero if we should redraw the mode lines on the next redisplay.
Usually set to a unique small integer so we can track the main causes of
full redisplays in `redisplay--mode-lines-cause'. */
diff --git a/src/xdisp.c b/src/xdisp.c
index fb8eaf4b967..f86d3527b3d 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -9227,10 +9227,10 @@ move_it_in_display_line_to (struct it *it,
|| prev_method == GET_FROM_STRING)
/* Passed TO_CHARPOS from left to right. */
&& ((prev_pos < to_charpos
- && IT_CHARPOS (*it) > to_charpos)
+ && IT_CHARPOS (*it) >= to_charpos)
/* Passed TO_CHARPOS from right to left. */
|| (prev_pos > to_charpos
- && IT_CHARPOS (*it) < to_charpos)))))
+ && IT_CHARPOS (*it) <= to_charpos)))))
{
if (it->line_wrap != WORD_WRAP || wrap_it.sp < 0)
{
@@ -10049,7 +10049,10 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
it->continuation_lines_width = 0;
reseat_at_next_visible_line_start (it, false);
if ((op & MOVE_TO_POS) != 0
- && IT_CHARPOS (*it) > to_charpos)
+ && (IT_CHARPOS (*it) > to_charpos
+ || (IT_CHARPOS (*it) == to_charpos
+ && to_charpos == ZV
+ && FETCH_BYTE (ZV_BYTE - 1) != '\n')))
{
reached = 9;
goto out;
diff --git a/src/xfns.c b/src/xfns.c
index 481ee0e2255..d90644819b6 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -4599,7 +4599,7 @@ On MS Windows, this just returns nil. */)
return Qnil;
}
-#if !defined USE_GTK || !defined HAVE_GTK3
+#if !(defined USE_GTK && defined HAVE_GTK3)
/* Store the geometry of the workarea on display DPYINFO into *RECT.
Return false if and only if the workarea information cannot be
@@ -4662,6 +4662,9 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect)
return result;
}
+#endif /* !(USE_GTK && HAVE_GTK3) */
+
+#ifndef USE_GTK
/* Return monitor number where F is "most" or closest to. */
static int
@@ -4877,6 +4880,8 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
pxid = XRRGetOutputPrimary (dpy, dpyinfo->root_window);
#endif
+#undef RANDR13_LIBRARY
+
for (i = 0; i < n_monitors; ++i)
{
XRROutputInfo *info = XRRGetOutputInfo (dpy, resources,