diff options
author | Andrea Corallo <akrl@sdf.org> | 2021-02-17 22:26:28 +0100 |
---|---|---|
committer | Andrea Corallo <akrl@sdf.org> | 2021-02-17 22:26:28 +0100 |
commit | f92bb788a073c6b3ca7f188e0edea714598193fd (patch) | |
tree | 9bea27955098bfc33d0daaa345cfa3dca5b695fd /src | |
parent | 1fe5994bcb8b58012dbba0a5f7d03138c293286f (diff) | |
parent | 6735bb3d22dc64f3fe42e4a7f439ea9d62f75b5a (diff) | |
download | emacs-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.c | 14 | ||||
-rw-r--r-- | src/buffer.h | 3 | ||||
-rw-r--r-- | src/callint.c | 9 | ||||
-rw-r--r-- | src/data.c | 87 | ||||
-rw-r--r-- | src/emacs-module.c | 8 | ||||
-rw-r--r-- | src/eval.c | 41 | ||||
-rw-r--r-- | src/frame.c | 4 | ||||
-rw-r--r-- | src/image.c | 13 | ||||
-rw-r--r-- | src/json.c | 77 | ||||
-rw-r--r-- | src/lisp.h | 4 | ||||
-rw-r--r-- | src/minibuf.c | 115 | ||||
-rw-r--r-- | src/nsterm.h | 1 | ||||
-rw-r--r-- | src/nsterm.m | 58 | ||||
-rw-r--r-- | src/pdumper.c | 3 | ||||
-rw-r--r-- | src/window.h | 4 | ||||
-rw-r--r-- | src/xdisp.c | 9 | ||||
-rw-r--r-- | src/xfns.c | 7 |
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, |