From 7c7950fe006fe19596011637610b934a786c1742 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 25 Dec 2022 10:22:40 -0800 Subject: Add maintainer stub for tree-sitter files * lisp/treesit.el: * src/treesit.c: Add maintainer. --- src/treesit.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src') diff --git a/src/treesit.c b/src/treesit.c index ce8a2804439..ecc977745a6 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2,6 +2,8 @@ Copyright (C) 2021-2022 Free Software Foundation, Inc. +Maintainer: Yuan Fu + This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify -- cgit v1.2.3 From 082fc6e3088354f16ab8293725cc727a9855359b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 25 Dec 2022 15:32:06 +0100 Subject: Fix 'json-available-p' on MS-Windows * src/json.c (json_available_p, ensure_json_available) (Fjson__available_p): New functions. (Fjson_serialize, Fjson_insert, Fjson_parse_string) (Fjson_parse_buffer): Use ensure_json_available. (syms_of_json): Defsubr json--available-p. * lisp/subr.el (json-available-p): Rewrite. --- lisp/subr.el | 10 +++---- src/json.c | 91 ++++++++++++++++++++++++++---------------------------------- 2 files changed, 44 insertions(+), 57 deletions(-) (limited to 'src') diff --git a/lisp/subr.el b/lisp/subr.el index a5e66de27de..701c26f8cd8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6911,11 +6911,11 @@ sentence (see Info node `(elisp) Documentation Tips')." (defun json-available-p () "Return non-nil if Emacs has libjansson support." - (and (fboundp 'json-serialize) - (condition-case nil - (json-serialize t) - (:success t) - (json-unavailable nil)))) + (declare (side-effect-free error-free)) + (and (eval-when-compile (fboundp 'json-serialize)) + ;; If `json--available-p' is present, we need to call it at run-time. + (or (not (eval-when-compile (fboundp 'json--available-p))) + (json--available-p)))) (defun ensure-list (object) "Return OBJECT as a list. diff --git a/src/json.c b/src/json.c index cdcc11358e6..d2105bc27b1 100644 --- a/src/json.c +++ b/src/json.c @@ -555,6 +555,38 @@ json_parse_args (ptrdiff_t nargs, } } +#ifdef WINDOWSNT +static bool +json_available_p (void) +{ + if (json_initialized) + return true; + json_initialized = init_json_functions (); + Lisp_Object status = json_initialized ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); + return json_initialized; +} +#endif + +static void +ensure_json_available (void) +{ +#ifdef WINDOWSNT + if (!json_available_p ()) + Fsignal (Qjson_unavailable, + list1 (build_unibyte_string ("jansson library not found"))); +#endif +} + +#ifdef WINDOWSNT +DEFUN ("json--available-p", Fjson__available_p, Sjson__available_p, 0, 0, NULL, + doc: /* Whether libjansson is available (internal). */) + (void) +{ + return json_available_p () ? Qt : Qnil; +} +#endif + DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, NULL, doc: /* Return the JSON representation of OBJECT as a string. @@ -585,19 +617,7 @@ usage: (json-serialize OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -694,19 +714,7 @@ usage: (json-insert OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -951,19 +959,7 @@ usage: (json-parse-string STRING &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); Lisp_Object string = args[0]; CHECK_STRING (string); @@ -1048,19 +1044,7 @@ usage: (json-parse-buffer &rest args) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -1137,6 +1121,9 @@ syms_of_json (void) DEFSYM (Qplist, "plist"); DEFSYM (Qarray, "array"); +#ifdef WINDOWSNT + defsubr (&Sjson__available_p); +#endif defsubr (&Sjson_serialize); defsubr (&Sjson_insert); defsubr (&Sjson_parse_string); -- cgit v1.2.3 From 26b2ec7cb8c81db7d8705cb87579b325901ed303 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Dec 2022 15:26:48 +0200 Subject: Simplify last change (bug#60311) * src/json.c (json_available_p): Use original code. Always return true for !WINDOWSNT. (ensure_json_available): Now defined only on WINDOWSNT. (Fjson_serialize, Fjson_insert, Fjson_parse_string) (Fjson_parse_buffer): Call ensure_json_available only on WINDOWSNT. * lisp/subr.el (json-available-p): Simplify. --- lisp/subr.el | 7 ++----- src/json.c | 40 ++++++++++++++++++++++++++-------------- 2 files changed, 28 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/lisp/subr.el b/lisp/subr.el index 701c26f8cd8..2fcdc7addf1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6911,11 +6911,8 @@ sentence (see Info node `(elisp) Documentation Tips')." (defun json-available-p () "Return non-nil if Emacs has libjansson support." - (declare (side-effect-free error-free)) - (and (eval-when-compile (fboundp 'json-serialize)) - ;; If `json--available-p' is present, we need to call it at run-time. - (or (not (eval-when-compile (fboundp 'json--available-p))) - (json--available-p)))) + (and (fboundp 'json--available-p) + (json--available-p))) (defun ensure-list (object) "Return OBJECT as a list. diff --git a/src/json.c b/src/json.c index d2105bc27b1..621c7d7c15f 100644 --- a/src/json.c +++ b/src/json.c @@ -555,37 +555,39 @@ json_parse_args (ptrdiff_t nargs, } } -#ifdef WINDOWSNT static bool json_available_p (void) { - if (json_initialized) - return true; - json_initialized = init_json_functions (); - Lisp_Object status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); +#ifdef WINDOWSNT + if (!json_initialized) + { + Lisp_Object status; + json_initialized = init_json_functions (); + status = json_initialized ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); + } return json_initialized; -} +#else /* !WINDOWSNT */ + return true; #endif +} +#ifdef WINDOWSNT static void ensure_json_available (void) { -#ifdef WINDOWSNT if (!json_available_p ()) Fsignal (Qjson_unavailable, list1 (build_unibyte_string ("jansson library not found"))); -#endif } +#endif -#ifdef WINDOWSNT DEFUN ("json--available-p", Fjson__available_p, Sjson__available_p, 0, 0, NULL, - doc: /* Whether libjansson is available (internal). */) + doc: /* Return non-nil if libjansson is available (internal use only). */) (void) { return json_available_p () ? Qt : Qnil; } -#endif DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, NULL, @@ -617,7 +619,10 @@ usage: (json-serialize OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -714,7 +719,10 @@ usage: (json-insert OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -959,7 +967,10 @@ usage: (json-parse-string STRING &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif Lisp_Object string = args[0]; CHECK_STRING (string); @@ -1044,7 +1055,10 @@ usage: (json-parse-buffer &rest args) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -1121,9 +1135,7 @@ syms_of_json (void) DEFSYM (Qplist, "plist"); DEFSYM (Qarray, "array"); -#ifdef WINDOWSNT defsubr (&Sjson__available_p); -#endif defsubr (&Sjson_serialize); defsubr (&Sjson_insert); defsubr (&Sjson_parse_string); -- cgit v1.2.3 From b14bbd108e4bc43f8c7995dfff4c2c59c78f1b5f Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 26 Dec 2022 00:20:59 +0000 Subject: Improve handling of tab-bar height. * src/xdisp.c (redisplay_tab_bar): When 'auto-resize-tab-bar' is not 'grow-only', also consider the case when the tab-bar height needs to shrink. Fixes bug#60210. --- src/xdisp.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index ea2d11e8b4e..c9b3b187fe2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -14271,12 +14271,14 @@ redisplay_tab_bar (struct frame *f) frame_default_tab_bar_height = new_height; } - /* If new_height or new_nrows indicate that we need to enlarge the - tab-bar window, we can return right away. */ + /* If new_height or new_nrows indicate that we need to enlarge or + shrink the tab-bar window, we can return right away. */ if (new_nrows > f->n_tab_bar_rows || (EQ (Vauto_resize_tab_bars, Qgrow_only) && !f->minimize_tab_bar_window_p - && new_height > WINDOW_PIXEL_HEIGHT (w))) + && new_height > WINDOW_PIXEL_HEIGHT (w)) + || (! EQ (Vauto_resize_tab_bars, Qgrow_only) + && new_height < WINDOW_PIXEL_HEIGHT (w))) { if (FRAME_TERMINAL (f)->change_tab_bar_height_hook) FRAME_TERMINAL (f)->change_tab_bar_height_hook (f, new_height); -- cgit v1.2.3 From a6d961ae2fd0eb93938f2afd932f4d3cb63a0412 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 26 Dec 2022 17:16:59 -0800 Subject: Add a new tree-sitter query predicate 'pred' I realized that using an arbitrary function as the predicate in queries is very helpful for some queries I'm writing for python and javascript, and presumably most other languages[1]. Granted, we can already filter out unwanted nodes by using a function instead of a face for the capture name, and (1) determine whether the captured node is valid and (2) fontify that node if it's valid. However, such approach is a bit more cumbersome and more importantly gets in the way of another potential use of the fontification queries: context extraction. For example, I could use the query for the 'variable' feature to get all the variables in a certain region. In this use-case, we want the filtering happen before returning the captured nodes. Besides, the change is relatively small and straightforward: most code are already there, I just need to add some boilerplate. [1] For a code like aa.bb(cc), we want bb to be in function face, because obviously its a function. But for aa.bb, we want bb to be in property face, because it's a property. In the AST, bb is always a property, the difference between the two cases is the enclosing node: in the first case, aa.bb is in a "call_expression" node, indicating that bb is used as a function (a method). So we want a predicate function that checks whether bb is used as a function or a property, and determine whether it should be in function or property face. * doc/lispref/parsing.texi (Pattern Matching): Update manual. * src/treesit.c (Ftreesit_pattern_expand): Handle :pred. (treesit_predicate_capture_name_to_node): A new function extracted from treesit_predicate_capture_name_to_text. (treesit_predicate_capture_name_to_text): Use the newly extracted function. (treesit_predicate_pred): New predicate function. (treesit_eval_predicates): Add new predicate. Also fix a bug: we want to AND the results of each predicate. * test/src/treesit-tests.el (treesit--ert-pred-last-sibling): New helper function. (treesit-query-api): Test #pred predicate. --- doc/lispref/parsing.texi | 14 ++++++++---- src/treesit.c | 57 +++++++++++++++++++++++++++++++++++++---------- test/src/treesit-tests.el | 13 ++++++++--- 3 files changed, 65 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 5d1b11935cf..63741b69c22 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1266,10 +1266,11 @@ example, with the following pattern: @end example @noindent -tree-sitter only matches arrays where the first element equals to -the last element. To attach a predicate to a pattern, we need to -group them together. A predicate always starts with a @samp{#}. -Currently there are two predicates, @code{#equal} and @code{#match}. +tree-sitter only matches arrays where the first element equals to the +last element. To attach a predicate to a pattern, we need to group +them together. A predicate always starts with a @samp{#}. Currently +there are three predicates, @code{#equal}, @code{#match}, and +@code{#pred}. @deffn Predicate equal arg1 arg2 Matches if @var{arg1} equals to @var{arg2}. Arguments can be either @@ -1282,6 +1283,11 @@ Matches if the text that @var{capture-name}'s node spans in the buffer matches regular expression @var{regexp}. Matching is case-sensitive. @end deffn +@deffn Predicate pred fn &rest nodes +Matches if function @var{fn} returns non-@code{nil} when passed each +node in @var{nodes} as arguments. +@end deffn + Note that a predicate can only refer to capture names that appear in the same pattern. Indeed, it makes little sense to refer to capture names in other patterns. diff --git a/src/treesit.c b/src/treesit.c index ecc977745a6..813d4222f98 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2170,6 +2170,8 @@ See Info node `(elisp)Pattern Matching' for detailed explanation. */) return build_pure_c_string ("#equal"); if (EQ (pattern, QCmatch)) return build_pure_c_string ("#match"); + if (EQ (pattern, QCpred)) + return build_pure_c_string ("#pred"); Lisp_Object opening_delimeter = build_pure_c_string (VECTORP (pattern) ? "[" : "("); Lisp_Object closing_delimiter @@ -2269,10 +2271,10 @@ treesit_predicates_for_pattern (TSQuery *query, uint32_t pattern_index) return Fnreverse (result); } -/* Translate a capture NAME (symbol) to the text of the captured node. +/* Translate a capture NAME (symbol) to a node. Signals treesit-query-error if such node is not captured. */ static Lisp_Object -treesit_predicate_capture_name_to_text (Lisp_Object name, +treesit_predicate_capture_name_to_node (Lisp_Object name, struct capture_range captures) { Lisp_Object node = Qnil; @@ -2292,6 +2294,16 @@ treesit_predicate_capture_name_to_text (Lisp_Object name, name, build_pure_c_string ("A predicate can only refer" " to captured nodes in the " "same pattern")); + return node; +} + +/* Translate a capture NAME (symbol) to the text of the captured node. + Signals treesit-query-error if such node is not captured. */ +static Lisp_Object +treesit_predicate_capture_name_to_text (Lisp_Object name, + struct capture_range captures) +{ + Lisp_Object node = treesit_predicate_capture_name_to_node (name, captures); struct buffer *old_buffer = current_buffer; set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer)); @@ -2365,13 +2377,30 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) return false; } -/* About predicates: I decide to hard-code predicates in C instead of - implementing an extensible system where predicates are translated - to Lisp functions, and new predicates can be added by extending a - list of functions, because I really couldn't imagine any useful - predicates besides equal and match. If we later found out that - such system is indeed useful and necessary, it can be easily - added. */ +/* Handles predicate (#pred FN ARG...). Return true if FN returns + non-nil; return false otherwise. The arity of FN must match the + number of ARGs */ +static bool +treesit_predicate_pred (Lisp_Object args, struct capture_range captures) +{ + if (XFIXNUM (Flength (args)) < 2) + xsignal2 (Qtreesit_query_error, + build_pure_c_string ("Predicate `pred' requires " + "at least two arguments, " + "but was only given"), + Flength (args)); + + Lisp_Object fn = Fintern (XCAR (args), Qnil); + Lisp_Object nodes = Qnil; + Lisp_Object tail = XCDR (args); + FOR_EACH_TAIL (tail) + nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail), + captures), + nodes); + nodes = Fnreverse (nodes); + + return !NILP (CALLN (Fapply, fn, nodes)); +} /* If all predicates in PREDICATES passes, return true; otherwise return false. */ @@ -2387,14 +2416,17 @@ treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates) Lisp_Object fn = XCAR (predicate); Lisp_Object args = XCDR (predicate); if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal")))) - pass = treesit_predicate_equal (args, captures); + pass &= treesit_predicate_equal (args, captures); else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match")))) - pass = treesit_predicate_match (args, captures); + pass &= treesit_predicate_match (args, captures); + else if (!NILP (Fstring_equal (fn, build_pure_c_string ("pred")))) + pass &= treesit_predicate_pred (args, captures); else xsignal3 (Qtreesit_query_error, build_pure_c_string ("Invalid predicate"), fn, build_pure_c_string ("Currently Emacs only supports" - " equal and match predicate")); + " equal, match, and pred" + " predicate")); } /* If all predicates passed, add captures to result list. */ return pass; @@ -3217,6 +3249,7 @@ syms_of_treesit (void) DEFSYM (QCanchor, ":anchor"); DEFSYM (QCequal, ":equal"); DEFSYM (QCmatch, ":match"); + DEFSYM (QCpred, ":pred"); DEFSYM (Qnot_found, "not-found"); DEFSYM (Qsymbol_error, "symbol-error"); diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 3fe59a78d07..3770a4d01e5 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -335,6 +335,9 @@ BODY is the test body." ;;; Query +(defun treesit--ert-pred-last-sibling (node) + (null (treesit-node-next-sibling node t))) + (ert-deftest treesit-query-api () "Tests for query API." (skip-unless (treesit-language-available-p 'json)) @@ -357,13 +360,16 @@ BODY is the test body." (pair key: (_) @keyword) ((_) @bob (#match \"^B.b$\" @bob)) (number) @number -((number) @n3 (#equal \"3\" @n3)) " +((number) @n3 (#equal \"3\" @n3)) +((number) @n3p (#pred treesit--ert-pred-last-sibling @n3p))" ;; Sexp query. ((string) @string (pair key: (_) @keyword) ((_) @bob (:match "^B.b$" @bob)) (number) @number - ((number) @n3 (:equal "3" @n3))))) + ((number) @n3 (:equal "3" @n3)) + ((number) @n3p (:pred treesit--ert-pred-last-sibling + @n3p))))) ;; Test `treesit-query-compile'. (dolist (query (list query1 (treesit-query-compile 'json query1))) @@ -375,7 +381,8 @@ BODY is the test body." (string . "\"Bob\"") (bob . "Bob") (number . "3") - (n3 . "3")) + (n3 . "3") + (n3p . "3")) (mapcar (lambda (entry) (cons (car entry) (treesit-node-text -- cgit v1.2.3 From 8b8b79156798b4ffa791e9a9f0262a5ffdc867e8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Dec 2022 20:23:16 +0200 Subject: ; Improve documentation of TAB/SPC indentation * lisp/indent.el (tab-to-tab-stop): * src/indent.c (Findent_to): Mention 'indent-tabs-mode' in doc strings. --- lisp/indent.el | 3 ++- src/indent.c | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/lisp/indent.el b/lisp/indent.el index c7ec5c9a3ed..6b575a86b5e 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -784,7 +784,8 @@ If PREV is non-nil, return the previous one instead." (defun tab-to-tab-stop () "Insert spaces or tabs to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. -Use \\[edit-tab-stops] to edit them interactively." +Use \\[edit-tab-stops] to edit them interactively. +Whether this inserts tabs or spaces depends on `indent-tabs-mode'." (interactive) (and abbrev-mode (= (char-syntax (preceding-char)) ?w) (expand-abbrev)) diff --git a/src/indent.c b/src/indent.c index 4671ccccf90..66edaff67de 100644 --- a/src/indent.c +++ b/src/indent.c @@ -887,6 +887,8 @@ DEFUN ("indent-to", Findent_to, Sindent_to, 1, 2, "NIndent to column: ", Optional second argument MINIMUM says always do at least MINIMUM spaces even if that goes past COLUMN; by default, MINIMUM is zero. +Whether this uses tabs or spaces depends on `indent-tabs-mode'. + The return value is the column where the insertion ends. */) (Lisp_Object column, Lisp_Object minimum) { -- cgit v1.2.3 From 2b55a48d3e3ccc9f5b1f8b6191d63360686d94d9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Dec 2022 20:55:12 +0200 Subject: * src/w32menu.c (simple_dialog_show): Use MB_YESNOCANCEL style. --- src/w32menu.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/w32menu.c b/src/w32menu.c index b10239d5cc6..c6d1efaf25b 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1073,7 +1073,10 @@ is_simple_dialog (Lisp_Object contents) if (NILP (Fstring_equal (name, other))) return false; - /* Check there are no more options. */ + /* Check there are no more options. + + (FIXME: Since we use MB_YESNOCANCEL, we could also consider + dialogs with 3 options: Yes/No/Cancel as "simple". */ options = XCDR (options); return !(CONSP (options)); } @@ -1085,7 +1088,10 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header) UINT type; Lisp_Object lispy_answer = Qnil, temp = XCAR (contents); - type = MB_YESNO; + /* We use MB_YESNOCANCEL to allow the user the equivalent of C-g + when the Yes/No question is asked vya y-or-n-p or + yes-or-no-p. */ + type = MB_YESNOCANCEL; /* Since we only handle Yes/No dialogs, and we already checked is_simple_dialog, we don't need to worry about checking contents -- cgit v1.2.3 From b464e6c490be72e29619c5e101902ab3c3a2e474 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 28 Dec 2022 15:10:39 +0200 Subject: Make last change of w32 GUI dialogs conditional and reversible * src/w32term.c (syms_of_w32term) : New boolean variable. (w32_initialize): Fix query for visible system caret: 'bool' is a single-byte data type, whereas SystemParametersInfo wants a BOOL, which is a 32-bit int. * src/w32menu.c (simple_dialog_show): Show "Cancel" button only if 'w32-yes-no-dialog-show-cancel' is non-nil. * etc/NEWS: Announce the change. --- etc/NEWS | 9 +++++++++ src/w32menu.c | 5 ++++- src/w32term.c | 11 +++++++++-- 3 files changed, 22 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/etc/NEWS b/etc/NEWS index c64db9973d2..3060bba5e93 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4701,6 +4701,15 @@ where those APIs are available. When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now has built-in support for displaying BMP images. +--- +*** GUI Yes/No dialogs now include a "Cancel" button. +The "Cancel" button is in addition to "Yes" and "No", and is intended +to allow users to quit the dialog, as an equivalent of C-g when Emacs +asks a yes/no question via the echo area. This is controlled by the +new variable 'w32-yes-no-dialog-show-cancel', by default t. Set it to +nil to get back the old behavior of showing a modal dialog with only +two buttons: "Yes" and "No". + ** Cygwin --- diff --git a/src/w32menu.c b/src/w32menu.c index c6d1efaf25b..5f06f4c4170 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1091,7 +1091,10 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header) /* We use MB_YESNOCANCEL to allow the user the equivalent of C-g when the Yes/No question is asked vya y-or-n-p or yes-or-no-p. */ - type = MB_YESNOCANCEL; + if (w32_yes_no_dialog_show_cancel) + type = MB_YESNOCANCEL; + else + type = MB_YESNO; /* Since we only handle Yes/No dialogs, and we already checked is_simple_dialog, we don't need to worry about checking contents diff --git a/src/w32term.c b/src/w32term.c index dff21489e5b..e40e4588fde 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -7696,6 +7696,7 @@ static void w32_initialize (void) { HANDLE shell; + BOOL caret; HRESULT (WINAPI * set_user_model) (const wchar_t * id); baud_rate = 19200; @@ -7732,8 +7733,9 @@ w32_initialize (void) /* Initialize w32_use_visible_system_caret based on whether a screen reader is in use. */ - if (!SystemParametersInfo (SPI_GETSCREENREADER, 0, - &w32_use_visible_system_caret, 0)) + if (SystemParametersInfo (SPI_GETSCREENREADER, 0, &caret, 0)) + w32_use_visible_system_caret = caret == TRUE; + else w32_use_visible_system_caret = 0; any_help_event_p = 0; @@ -7923,6 +7925,11 @@ unconditionally set to nil on older systems. */); w32_use_native_image_api = 0; #endif + DEFVAR_BOOL ("w32-yes-no-dialog-show-cancel", + w32_yes_no_dialog_show_cancel, + doc: /* If non-nil, show Cancel button in MS-Windows GUI Yes/No dialogs. */); + w32_yes_no_dialog_show_cancel = 1; + /* FIXME: The following variable will be (hopefully) removed before Emacs 25.1 gets released. */ -- cgit v1.2.3