From: Stefan Kangas Date: Sun, 18 Oct 2020 13:19:09 +0000 (+0200) Subject: Remove C version of substitute-command-keys X-Git-Tag: emacs-28.0.90~5473^2~1 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ef5a604f082f772424400f48b64e9c04edbcc766;p=emacs.git Remove C version of substitute-command-keys * src/doc.c (Fsubstitute_command_keys_old): Remove. (syms_of_doc): Remove defsubr for Fsubstitute_command_keys_old. * src/keymap.c (describe_map, describe_map_tree) (describe_map_compare, describe_map_elt): Remove. * src/keymap.h: Remove 'describe_map_tree'. * test/lisp/help-tests.el (with-substitute-command-keys-test) (help-tests-substitute-command-keys/compare) (help-tests-substitute-command-keys/compare-all): Don't test the C version of 'substitute-command-keys' removed above. --- diff --git a/src/doc.c b/src/doc.c index 212ebe96334..f1ce266d39f 100644 --- a/src/doc.c +++ b/src/doc.c @@ -715,308 +715,6 @@ See variable `text-quoting-style'. */) } } -DEFUN ("substitute-command-keys-old", Fsubstitute_command_keys_old, - Ssubstitute_command_keys_old, 1, 1, 0, - doc: /* Substitute key descriptions for command names in STRING. -Each substring of the form \\=\\[COMMAND] is replaced by either a -keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND -is not on any keys. - -Each substring of the form \\=\\{MAPVAR} is replaced by a summary of -the value of MAPVAR as a keymap. This summary is similar to the one -produced by `describe-bindings'. The summary ends in two newlines -\(used by the helper function `help-make-xrefs' to find the end of the -summary). - -Each substring of the form \\=\\ specifies the use of MAPVAR -as the keymap for future \\=\\[COMMAND] substrings. - -Each grave accent \\=` is replaced by left quote, and each apostrophe \\=' -is replaced by right quote. Left and right quote characters are -specified by `text-quoting-style'. - -\\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\= -into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and \\=\\=\\=` puts \\=` into the -output. - -Return the original STRING if no substitutions are made. -Otherwise, return a new string (without any text properties). */) - (Lisp_Object string) -{ - char *buf; - bool changed = false; - bool nonquotes_changed = false; - unsigned char *strp; - char *bufp; - ptrdiff_t idx; - ptrdiff_t bsize; - Lisp_Object tem; - Lisp_Object keymap; - unsigned char const *start; - ptrdiff_t length, length_byte; - Lisp_Object name; - ptrdiff_t nchars; - - if (NILP (string)) - return Qnil; - - /* If STRING contains non-ASCII unibyte data, process its - properly-encoded multibyte equivalent instead. This simplifies - the implementation and is OK since substitute-command-keys is - intended for use only on text strings. Keep STRING around, since - it will be returned if no changes occur. */ - Lisp_Object str = Fstring_make_multibyte (string); - - enum text_quoting_style quoting_style = text_quoting_style (); - - nchars = 0; - - /* KEYMAP is either nil (which means search all the active keymaps) - or a specified local map (which means search just that and the - global map). If non-nil, it might come from Voverriding_local_map, - or from a \\ construct in STRING itself.. */ - keymap = Voverriding_local_map; - - ptrdiff_t strbytes = SBYTES (str); - bsize = strbytes; - - /* Fixed-size stack buffer. */ - char sbuf[MAX_ALLOCA]; - - /* Heap-allocated buffer, if any. */ - char *abuf; - - /* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */ - enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" }; - - ptrdiff_t count = SPECPDL_INDEX (); - - if (bsize <= sizeof sbuf - EXTRA_ROOM) - { - abuf = NULL; - buf = sbuf; - bsize = sizeof sbuf; - } - else - { - buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1); - record_unwind_protect_ptr (xfree, abuf); - } - bufp = buf; - - strp = SDATA (str); - while (strp < SDATA (str) + strbytes) - { - unsigned char *close_bracket; - - if (strp[0] == '\\' && strp[1] == '=' - && strp + 2 < SDATA (str) + strbytes) - { - /* \= quotes the next character; - thus, to put in \[ without its special meaning, use \=\[. */ - changed = nonquotes_changed = true; - strp += 2; - /* Fall through to copy one char. */ - } - else if (strp[0] == '\\' && strp[1] == '[' - && (close_bracket - = memchr (strp + 2, ']', - SDATA (str) + strbytes - (strp + 2)))) - { - bool follow_remap = 1; - - start = strp + 2; - length_byte = close_bracket - start; - idx = close_bracket + 1 - SDATA (str); - - name = Fintern (make_string ((char *) start, length_byte), Qnil); - - do_remap: - tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil); - - if (VECTORP (tem) && ASIZE (tem) > 1 - && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1)) - && follow_remap) - { - name = AREF (tem, 1); - follow_remap = 0; - goto do_remap; - } - - /* Fwhere_is_internal can GC, so take relocation of string - contents into account. */ - strp = SDATA (str) + idx; - start = strp - length_byte - 1; - - if (NILP (tem)) /* but not on any keys */ - { - memcpy (bufp, "M-x ", 4); - bufp += 4; - nchars += 4; - length = multibyte_chars_in_text (start, length_byte); - goto subst; - } - else - { /* function is on a key */ - tem = Fkey_description (tem, Qnil); - goto subst_string; - } - } - /* \{foo} is replaced with a summary of the keymap (symbol-value foo). - \ just sets the keymap used for \[cmd]. */ - else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<') - && (close_bracket - = memchr (strp + 2, strp[1] == '{' ? '}' : '>', - SDATA (str) + strbytes - (strp + 2)))) - { - { - bool generate_summary = strp[1] == '{'; - /* This is for computing the SHADOWS arg for describe_map_tree. */ - Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil); - ptrdiff_t count = SPECPDL_INDEX (); - - start = strp + 2; - length_byte = close_bracket - start; - idx = close_bracket + 1 - SDATA (str); - - /* Get the value of the keymap in TEM, or nil if undefined. - Do this while still in the user's current buffer - in case it is a local variable. */ - name = Fintern (make_string ((char *) start, length_byte), Qnil); - tem = Fboundp (name); - if (! NILP (tem)) - { - tem = Fsymbol_value (name); - if (! NILP (tem)) - tem = get_keymap (tem, 0, 1); - } - - /* Now switch to a temp buffer. */ - struct buffer *oldbuf = current_buffer; - set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); - /* This is for an unusual case where some after-change - function uses 'format' or 'prin1' or something else that - will thrash Vprin1_to_string_buffer we are using. */ - specbind (Qinhibit_modification_hooks, Qt); - - if (NILP (tem)) - { - name = Fsymbol_name (name); - AUTO_STRING (msg_prefix, "\nUses keymap `"); - insert1 (Fsubstitute_command_keys_old (msg_prefix)); - insert_from_string (name, 0, 0, - SCHARS (name), - SBYTES (name), 1); - AUTO_STRING (msg_suffix, "', which is not currently defined.\n"); - insert1 (Fsubstitute_command_keys_old (msg_suffix)); - if (!generate_summary) - keymap = Qnil; - } - else if (!generate_summary) - keymap = tem; - else - { - /* Get the list of active keymaps that precede this one. - If this one's not active, get nil. */ - Lisp_Object earlier_maps - = Fcdr (Fmemq (tem, Freverse (active_maps))); - describe_map_tree (tem, 1, Fnreverse (earlier_maps), - Qnil, 0, 1, 0, 0, 1); - } - tem = Fbuffer_string (); - Ferase_buffer (); - set_buffer_internal (oldbuf); - unbind_to (count, Qnil); - } - - subst_string: - /* Convert non-ASCII unibyte data to properly-encoded multibyte, - for the same reason STRING was converted to STR. */ - tem = Fstring_make_multibyte (tem); - start = SDATA (tem); - length = SCHARS (tem); - length_byte = SBYTES (tem); - subst: - nonquotes_changed = true; - subst_quote: - changed = true; - { - ptrdiff_t offset = bufp - buf; - ptrdiff_t avail = bsize - offset; - ptrdiff_t need = strbytes - idx; - if (INT_ADD_WRAPV (need, length_byte + EXTRA_ROOM, &need)) - string_overflow (); - if (avail < need) - { - abuf = xpalloc (abuf, &bsize, need - avail, - STRING_BYTES_BOUND, 1); - if (buf == sbuf) - { - record_unwind_protect_ptr (xfree, abuf); - memcpy (abuf, sbuf, offset); - } - else - set_unwind_protect_ptr (count, xfree, abuf); - buf = abuf; - bufp = buf + offset; - } - memcpy (bufp, start, length_byte); - bufp += length_byte; - nchars += length; - - /* Some of the previous code can GC, so take relocation of - string contents into account. */ - strp = SDATA (str) + idx; - - continue; - } - } - else if ((strp[0] == '`' || strp[0] == '\'') - && quoting_style == CURVE_QUOTING_STYLE) - { - start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM); - length = 1; - length_byte = sizeof uLSQM - 1; - idx = strp - SDATA (str) + 1; - goto subst_quote; - } - else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE) - { - *bufp++ = '\''; - strp++; - nchars++; - changed = true; - continue; - } - - /* Copy one char. */ - do - *bufp++ = *strp++; - while (! CHAR_HEAD_P (*strp)); - nchars++; - } - - if (changed) /* don't bother if nothing substituted */ - { - tem = make_string_from_bytes (buf, nchars, bufp - buf); - if (!nonquotes_changed) - { - /* Nothing has changed other than quoting, so copy the string’s - text properties. FIXME: Text properties should survive other - changes too; see bug#17052. */ - INTERVAL interval_copy = copy_intervals (string_intervals (string), - 0, SCHARS (string)); - if (interval_copy) - { - set_interval_object (interval_copy, tem); - set_string_intervals (tem, interval_copy); - } - } - } - else - tem = string; - return unbind_to (count, tem); -} void syms_of_doc (void) @@ -1058,5 +756,4 @@ otherwise. */); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation); defsubr (&Sget_quoting_style); - defsubr (&Ssubstitute_command_keys_old); } diff --git a/src/keymap.c b/src/keymap.c index 1eded130b5d..46fa586c753 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -91,9 +91,6 @@ static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); static void describe_command (Lisp_Object, Lisp_Object); static void describe_translation (Lisp_Object, Lisp_Object); -static void describe_map (Lisp_Object, Lisp_Object, - void (*) (Lisp_Object, Lisp_Object), - bool, Lisp_Object, Lisp_Object *, bool, bool); static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object, void (*) (Lisp_Object, Lisp_Object), bool, Lisp_Object, Lisp_Object, bool, bool); @@ -2946,119 +2943,6 @@ You type Translation\n\ return Qnil; } -/* Insert a description of the key bindings in STARTMAP, - followed by those of all maps reachable through STARTMAP. - If PARTIAL, omit certain "uninteresting" commands - (such as `undefined'). - If SHADOW is non-nil, it is a list of maps; - don't mention keys which would be shadowed by any of them. - PREFIX, if non-nil, says mention only keys that start with PREFIX. - TITLE, if not 0, is a string to insert at the beginning. - TITLE should not end with a colon or a newline; we supply that. - If NOMENU, then omit menu-bar commands. - - If TRANSL, the definitions are actually key translations - so print strings and vectors differently. - - If ALWAYS_TITLE, print the title even if there are no maps - to look through. - - If MENTION_SHADOW, then when something is shadowed by SHADOW, - don't omit it; instead, mention it but say it is shadowed. - - Any inserted text ends in two newlines (used by `help-make-xrefs'). */ - -void -describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow, - Lisp_Object prefix, const char *title, bool nomenu, - bool transl, bool always_title, bool mention_shadow) -{ - Lisp_Object maps, orig_maps, seen, sub_shadows; - bool something = 0; - const char *key_heading - = "\ -key binding\n\ ---- -------\n"; - - orig_maps = maps = Faccessible_keymaps (startmap, prefix); - seen = Qnil; - sub_shadows = Qnil; - - if (nomenu) - { - Lisp_Object list; - - /* Delete from MAPS each element that is for the menu bar. */ - for (list = maps; CONSP (list); list = XCDR (list)) - { - Lisp_Object elt, elt_prefix, tem; - - elt = XCAR (list); - elt_prefix = Fcar (elt); - if (ASIZE (elt_prefix) >= 1) - { - tem = Faref (elt_prefix, make_fixnum (0)); - if (EQ (tem, Qmenu_bar)) - maps = Fdelq (elt, maps); - } - } - } - - if (!NILP (maps) || always_title) - { - if (title) - { - insert_string (title); - if (!NILP (prefix)) - { - insert_string (" Starting With "); - insert1 (Fkey_description (prefix, Qnil)); - } - insert_string (":\n"); - } - insert_string (key_heading); - something = 1; - } - - for (; CONSP (maps); maps = XCDR (maps)) - { - register Lisp_Object elt, elt_prefix, tail; - - elt = XCAR (maps); - elt_prefix = Fcar (elt); - - sub_shadows = Flookup_key (shadow, elt_prefix, Qt); - if (FIXNATP (sub_shadows)) - sub_shadows = Qnil; - else if (!KEYMAPP (sub_shadows) - && !NILP (sub_shadows) - && !(CONSP (sub_shadows) - && KEYMAPP (XCAR (sub_shadows)))) - /* If elt_prefix is bound to something that's not a keymap, - it completely shadows this map, so don't - describe this map at all. */ - goto skip; - - /* Maps we have already listed in this loop shadow this map. */ - for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail)) - { - Lisp_Object tem; - tem = Fequal (Fcar (XCAR (tail)), elt_prefix); - if (!NILP (tem)) - sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows); - } - - describe_map (Fcdr (elt), elt_prefix, - transl ? describe_translation : describe_command, - partial, sub_shadows, &seen, nomenu, mention_shadow); - - skip: ; - } - - if (something) - insert_string ("\n"); -} - static int previous_description_column; static void @@ -3121,224 +3005,6 @@ describe_translation (Lisp_Object definition, Lisp_Object args) insert_string ("??\n"); } -/* describe_map puts all the usable elements of a sparse keymap - into an array of `struct describe_map_elt', - then sorts them by the events. */ - -struct describe_map_elt -{ - Lisp_Object event; - Lisp_Object definition; - bool shadowed; -}; - -/* qsort comparison function for sorting `struct describe_map_elt' by - the event field. */ - -static int -describe_map_compare (const void *aa, const void *bb) -{ - const struct describe_map_elt *a = aa, *b = bb; - if (FIXNUMP (a->event) && FIXNUMP (b->event)) - return ((XFIXNUM (a->event) > XFIXNUM (b->event)) - - (XFIXNUM (a->event) < XFIXNUM (b->event))); - if (!FIXNUMP (a->event) && FIXNUMP (b->event)) - return 1; - if (FIXNUMP (a->event) && !FIXNUMP (b->event)) - return -1; - if (SYMBOLP (a->event) && SYMBOLP (b->event)) - /* Sort the keystroke names in the "natural" way, with (for - instance) "" coming between "" and "". */ - return string_version_cmp (SYMBOL_NAME (a->event), SYMBOL_NAME (b->event)); - return 0; -} - -/* Describe the contents of map MAP, assuming that this map itself is - reached by the sequence of prefix keys PREFIX (a string or vector). - PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ - -static void -describe_map (Lisp_Object map, Lisp_Object prefix, - void (*elt_describer) (Lisp_Object, Lisp_Object), - bool partial, Lisp_Object shadow, - Lisp_Object *seen, bool nomenu, bool mention_shadow) -{ - Lisp_Object tail, definition, event; - Lisp_Object tem; - Lisp_Object suppress; - Lisp_Object kludge; - bool first = 1; - - /* These accumulate the values from sparse keymap bindings, - so we can sort them and handle them in order. */ - ptrdiff_t length_needed = 0; - struct describe_map_elt *vect; - ptrdiff_t slots_used = 0; - ptrdiff_t i; - - suppress = Qnil; - - if (partial) - suppress = intern ("suppress-keymap"); - - /* This vector gets used to present single keys to Flookup_key. Since - that is done once per keymap element, we don't want to cons up a - fresh vector every time. */ - kludge = make_nil_vector (1); - definition = Qnil; - - map = call1 (Qkeymap_canonicalize, map); - - for (tail = map; CONSP (tail); tail = XCDR (tail)) - length_needed++; - - USE_SAFE_ALLOCA; - SAFE_NALLOCA (vect, 1, length_needed); - - for (tail = map; CONSP (tail); tail = XCDR (tail)) - { - maybe_quit (); - - if (VECTORP (XCAR (tail)) - || CHAR_TABLE_P (XCAR (tail))) - describe_vector (XCAR (tail), - prefix, Qnil, elt_describer, partial, shadow, map, - 1, mention_shadow); - else if (CONSP (XCAR (tail))) - { - bool this_shadowed = 0; - - event = XCAR (XCAR (tail)); - - /* Ignore bindings whose "prefix" are not really valid events. - (We get these in the frames and buffers menu.) */ - if (!(SYMBOLP (event) || FIXNUMP (event))) - continue; - - if (nomenu && EQ (event, Qmenu_bar)) - continue; - - definition = get_keyelt (XCDR (XCAR (tail)), 0); - - /* Don't show undefined commands or suppressed commands. */ - if (NILP (definition)) continue; - if (SYMBOLP (definition) && partial) - { - tem = Fget (definition, suppress); - if (!NILP (tem)) - continue; - } - - /* Don't show a command that isn't really visible - because a local definition of the same key shadows it. */ - - ASET (kludge, 0, event); - if (!NILP (shadow)) - { - tem = shadow_lookup (shadow, kludge, Qt, 0); - if (!NILP (tem)) - { - /* If both bindings are keymaps, this key is a prefix key, - so don't say it is shadowed. */ - if (KEYMAPP (definition) && KEYMAPP (tem)) - ; - /* Avoid generating duplicate entries if the - shadowed binding has the same definition. */ - else if (mention_shadow && !EQ (tem, definition)) - this_shadowed = 1; - else - continue; - } - } - - tem = Flookup_key (map, kludge, Qt); - if (!EQ (tem, definition)) continue; - - vect[slots_used].event = event; - vect[slots_used].definition = definition; - vect[slots_used].shadowed = this_shadowed; - slots_used++; - } - else if (EQ (XCAR (tail), Qkeymap)) - { - /* The same keymap might be in the structure twice, if we're - using an inherited keymap. So skip anything we've already - encountered. */ - tem = Fassq (tail, *seen); - if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix))) - break; - *seen = Fcons (Fcons (tail, prefix), *seen); - } - } - - /* If we found some sparse map events, sort them. */ - - qsort (vect, slots_used, sizeof (struct describe_map_elt), - describe_map_compare); - - /* Now output them in sorted order. */ - - for (i = 0; i < slots_used; i++) - { - Lisp_Object start, end; - - if (first) - { - previous_description_column = 0; - insert ("\n", 1); - first = 0; - } - - ASET (kludge, 0, vect[i].event); - start = vect[i].event; - end = start; - - definition = vect[i].definition; - - /* Find consecutive chars that are identically defined. */ - if (FIXNUMP (vect[i].event)) - { - while (i + 1 < slots_used - && EQ (vect[i+1].event, make_fixnum (XFIXNUM (vect[i].event) + 1)) - && !NILP (Fequal (vect[i + 1].definition, definition)) - && vect[i].shadowed == vect[i + 1].shadowed) - i++; - end = vect[i].event; - } - - /* Now START .. END is the range to describe next. */ - - /* Insert the string to describe the event START. */ - insert1 (Fkey_description (kludge, prefix)); - - if (!EQ (start, end)) - { - insert (" .. ", 4); - - ASET (kludge, 0, end); - /* Insert the string to describe the character END. */ - insert1 (Fkey_description (kludge, prefix)); - } - - /* Print a description of the definition of this character. - elt_describer will take care of spacing out far enough - for alignment purposes. */ - (*elt_describer) (vect[i].definition, Qnil); - - if (vect[i].shadowed) - { - ptrdiff_t pt = max (PT - 1, BEG); - - SET_PT (pt); - insert_string ("\n (this binding is currently shadowed)"); - pt = min (PT + 1, Z); - SET_PT (pt); - } - } - - SAFE_FREE (); -} - static void describe_vector_princ (Lisp_Object elt, Lisp_Object fun) { diff --git a/src/keymap.h b/src/keymap.h index 3ef48fb748e..2f7df2bd955 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -36,8 +36,6 @@ extern Lisp_Object current_global_map; extern char *push_key_description (EMACS_INT, char *); extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); extern Lisp_Object get_keymap (Lisp_Object, bool, bool); -extern void describe_map_tree (Lisp_Object, bool, Lisp_Object, Lisp_Object, - const char *, bool, bool, bool, bool); extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **); extern void initial_define_key (Lisp_Object, int, const char *); extern void initial_define_lispy_key (Lisp_Object, const char *, const char *); diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index aff5d1853a6..079b1114a81 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -58,23 +58,15 @@ ;;; substitute-command-keys (defmacro with-substitute-command-keys-test (&rest body) - `(cl-flet* ((should-be-same-as-c-version - ;; TODO: Remove this when old C function is removed. - (lambda (orig) - (should (equal-including-properties - (substitute-command-keys orig) - (substitute-command-keys-old orig))))) - (test + `(cl-flet* ((test (lambda (orig result) (should (equal-including-properties (substitute-command-keys orig) - result)) - (should-be-same-as-c-version orig))) + result)))) (test-re (lambda (orig regexp) (should (string-match (concat "^" regexp "$") - (substitute-command-keys orig))) - (should-be-same-as-c-version orig)))) + (substitute-command-keys orig)))))) ,@body)) (ert-deftest help-tests-substitute-command-keys/no-change () @@ -369,29 +361,6 @@ C-b undefined "))))) -;; TODO: This is a temporary test that should be removed together with -;; substitute-command-keys-old. -(ert-deftest help-tests-substitute-command-keys/compare () - (with-substitute-command-keys-test - (with-temp-buffer - (Info-mode) - (outline-minor-mode) - (test-re "\\{Info-mode-map}" ".*"))) - (with-substitute-command-keys-test - (with-temp-buffer - (c-mode) - (outline-minor-mode) - (test-re "\\{c-mode-map}" ".*")))) - -(ert-deftest help-tests-substitute-command-keys/compare-all () - (let (keymaps) - (mapatoms (lambda (var) - (when (keymapp var) - (push var keymaps)))) - (dolist (keymap keymaps) - (with-substitute-command-keys-test - (test-re (concat "\\{" (symbol-name keymap) "}") ".*"))))) - (provide 'help-tests) ;;; help-tests.el ends here