diff options
Diffstat (limited to 'src/doc.c')
| -rw-r--r-- | src/doc.c | 289 |
1 files changed, 127 insertions, 162 deletions
diff --git a/src/doc.c b/src/doc.c index 36d18b99b05..6a78ed657c1 100644 --- a/src/doc.c +++ b/src/doc.c @@ -339,16 +339,7 @@ string is passed through `substitute-command-keys'. */) if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); if (SUBRP (fun)) - { - if (XSUBR (fun)->doc == 0) - return Qnil; - /* FIXME: This is not portable, as it assumes that string - pointers have the top bit clear. */ - else if ((intptr_t) XSUBR (fun)->doc >= 0) - doc = build_string (XSUBR (fun)->doc); - else - doc = make_number ((intptr_t) XSUBR (fun)->doc); - } + doc = make_number (XSUBR (fun)->doc); else if (COMPILEDP (fun)) { if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING) @@ -473,7 +464,7 @@ aren't strings. */) /* Scanning the DOC files and placing docstring offsets into functions. */ static void -store_function_docstring (Lisp_Object obj, ptrdiff_t offset) +store_function_docstring (Lisp_Object obj, EMACS_INT offset) { /* Don't use indirect_function here, or defaliases will apply their docstrings to the base functions (Bug#2603). */ @@ -481,15 +472,10 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset) /* The type determines where the docstring is stored. */ - /* Lisp_Subrs have a slot for it. */ - if (SUBRP (fun)) - { - intptr_t negative_offset = - offset; - XSUBR (fun)->doc = (char *) negative_offset; - } - /* If it's a lisp form, stick it in the form. */ - else if (CONSP (fun)) + if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) + fun = XCDR (fun); + if (CONSP (fun)) { Lisp_Object tem; @@ -503,10 +489,12 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset) correctness is quite delicate. */ XSETCAR (tem, make_number (offset)); } - else if (EQ (tem, Qmacro)) - store_function_docstring (XCDR (fun), offset); } + /* Lisp_Subrs have a slot for it. */ + else if (SUBRP (fun)) + XSUBR (fun)->doc = offset; + /* Bytecode objects sometimes have slots for it. */ else if (COMPILEDP (fun)) { @@ -726,13 +714,13 @@ summary). Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR as the keymap for future \\=\\[COMMAND] substrings. -Each \\=‘ and \\=` is replaced by left quote, and each \\=’ and \\=' +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. +\\=\\= 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. */) @@ -750,25 +738,20 @@ Otherwise, return a new string. */) unsigned char const *start; ptrdiff_t length, length_byte; Lisp_Object name; - bool multibyte, pure_ascii; ptrdiff_t nchars; if (NILP (string)) return Qnil; - CHECK_STRING (string); - tem = Qnil; - keymap = Qnil; - name = 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 (); - multibyte = STRING_MULTIBYTE (string); - /* Pure-ASCII unibyte input strings should produce unibyte strings - if substitution doesn't yield non-ASCII bytes, otherwise they - should produce multibyte strings. */ - pure_ascii = SBYTES (string) == count_size_as_multibyte (SDATA (string), - SCHARS (string)); nchars = 0; /* KEYMAP is either nil (which means search all the active keymaps) @@ -777,59 +760,58 @@ Otherwise, return a new string. */) or from a \\<mapname> construct in STRING itself.. */ keymap = Voverriding_local_map; - bsize = SBYTES (string); + ptrdiff_t strbytes = SBYTES (str); + bsize = strbytes; + + /* Fixed-size stack buffer. */ + char sbuf[MAX_ALLOCA]; - /* Add some room for expansion due to quote replacement. */ - enum { EXTRA_ROOM = 20 }; - if (bsize <= STRING_BYTES_BOUND - EXTRA_ROOM) - bsize += EXTRA_ROOM; + /* Heap-allocated buffer, if any. */ + char *abuf; - bufp = buf = xmalloc (bsize); + /* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */ + enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" }; - strp = SDATA (string); - while (strp < SDATA (string) + SBYTES (string)) + ptrdiff_t count = SPECPDL_INDEX (); + + if (bsize <= sizeof sbuf - EXTRA_ROOM) { - if (strp[0] == '\\' && strp[1] == '=') + 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; - if (multibyte) - { - int len; - - STRING_CHAR_AND_LENGTH (strp, len); - if (len == 1) - *bufp = *strp; - else - memcpy (bufp, strp, len); - strp += len; - bufp += len; - nchars++; - } - else - *bufp++ = *strp++, nchars++; + /* Fall through to copy one char. */ } - else if (strp[0] == '\\' && strp[1] == '[') + else if (strp[0] == '\\' && strp[1] == '[' + && (close_bracket + = memchr (strp + 2, ']', + SDATA (str) + strbytes - (strp + 2)))) { - ptrdiff_t start_idx; bool follow_remap = 1; - strp += 2; /* skip \[ */ - start = strp; - start_idx = start - SDATA (string); - - while ((strp - SDATA (string) - < SBYTES (string)) - && *strp != ']') - strp++; - length_byte = strp - start; - - strp++; /* skip ] */ + start = strp + 2; + length_byte = close_bracket - start; + idx = close_bracket + 1 - SDATA (str); - /* Save STRP in IDX. */ - idx = strp - SDATA (string); name = Fintern (make_string ((char *) start, length_byte), Qnil); do_remap: @@ -844,25 +826,17 @@ Otherwise, return a new string. */) goto do_remap; } - /* Note the Fwhere_is_internal can GC, so we have to take - relocation of string contents into account. */ - strp = SDATA (string) + idx; - start = SDATA (string) + start_idx; + /* 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 */ { - ptrdiff_t offset = bufp - buf; - if (STRING_BYTES_BOUND - 4 < bsize) - string_overflow (); - buf = xrealloc (buf, bsize += 4); - bufp = buf + offset; memcpy (bufp, "M-x ", 4); bufp += 4; nchars += 4; - if (multibyte) - length = multibyte_chars_in_text (start, length_byte); - else - length = length_byte; + length = multibyte_chars_in_text (start, length_byte); goto subst; } else @@ -873,28 +847,20 @@ Otherwise, return a new string. */) } /* \{foo} is replaced with a summary of the keymap (symbol-value foo). \<foo> just sets the keymap used for \[cmd]. */ - else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')) + else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<') + && (close_bracket + = memchr (strp + 2, strp[1] == '{' ? '}' : '>', + SDATA (str) + strbytes - (strp + 2)))) { - struct buffer *oldbuf; - ptrdiff_t start_idx; + { + 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); - Lisp_Object earlier_maps; ptrdiff_t count = SPECPDL_INDEX (); - strp += 2; /* skip \{ or \< */ - start = strp; - start_idx = start - SDATA (string); - - while ((strp - SDATA (string) < SBYTES (string)) - && *strp != '}' && *strp != '>') - strp++; - - length_byte = strp - start; - strp++; /* skip } or > */ - - /* Save STRP in IDX. */ - idx = strp - SDATA (string); + 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 @@ -905,16 +871,11 @@ Otherwise, return a new string. */) { tem = Fsymbol_value (name); if (! NILP (tem)) - { - tem = get_keymap (tem, 0, 1); - /* Note that get_keymap can GC. */ - strp = SDATA (string) + idx; - start = SDATA (string) + start_idx; - } + tem = get_keymap (tem, 0, 1); } /* Now switch to a temp buffer. */ - oldbuf = current_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 @@ -931,15 +892,17 @@ Otherwise, return a new string. */) SBYTES (name), 1); AUTO_STRING (msg_suffix, "', which is not currently defined.\n"); insert1 (Fsubstitute_command_keys (msg_suffix)); - if (start[-1] == '<') keymap = Qnil; + if (!generate_summary) + keymap = Qnil; } - else if (start[-1] == '<') + 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. */ - earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps))); + Lisp_Object earlier_maps + = Fcdr (Fmemq (tem, Freverse (active_maps))); describe_map_tree (tem, 1, Fnreverse (earlier_maps), Qnil, 0, 1, 0, 0, 1); } @@ -947,42 +910,57 @@ Otherwise, return a new 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); - if (multibyte || pure_ascii) - length = SCHARS (tem); - else - length = length_byte; subst: nonquotes_changed = true; subst_quote: changed = true; { ptrdiff_t offset = bufp - buf; - if (STRING_BYTES_BOUND - length_byte < bsize) + ptrdiff_t avail = bsize - offset; + ptrdiff_t need = strbytes - idx; + if (INT_ADD_WRAPV (need, length_byte + EXTRA_ROOM, &need)) string_overflow (); - buf = xrealloc (buf, bsize += length_byte); - bufp = buf + offset; + 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; - /* Check STRING again in case gc relocated it. */ - strp = SDATA (string) + idx; + + /* 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 - && (multibyte || pure_ascii)) + && quoting_style == CURVE_QUOTING_STYLE) { start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM); + length = 1; length_byte = sizeof uLSQM - 1; - if (multibyte || pure_ascii) - length = 1; - else - length = length_byte; - idx = strp - SDATA (string) + 1; + idx = strp - SDATA (str) + 1; goto subst_quote; } else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE) @@ -991,31 +969,14 @@ Otherwise, return a new string. */) strp++; nchars++; changed = true; + continue; } - else if (! multibyte) - *bufp++ = *strp++, nchars++; - else - { - int len; - int ch = STRING_CHAR_AND_LENGTH (strp, len); - if ((ch == LEFT_SINGLE_QUOTATION_MARK - || ch == RIGHT_SINGLE_QUOTATION_MARK) - && quoting_style != CURVE_QUOTING_STYLE) - { - *bufp++ = ((ch == LEFT_SINGLE_QUOTATION_MARK - && quoting_style == GRAVE_QUOTING_STYLE) - ? '`' : '\''); - strp += len; - changed = true; - } - else - { - do - *bufp++ = *strp++; - while (--len != 0); - } - nchars++; - } + + /* Copy one char. */ + do + *bufp++ = *strp++; + while (! CHAR_HEAD_P (*strp)); + nchars++; } if (changed) /* don't bother if nothing substituted */ @@ -1037,8 +998,7 @@ Otherwise, return a new string. */) } else tem = string; - xfree (buf); - return tem; + return unbind_to (count, tem); } void @@ -1058,12 +1018,17 @@ syms_of_doc (void) DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style, doc: /* Style to use for single quotes in help and messages. -Its value should be a symbol. -`curve' means quote with curved single quotes \\=‘like this\\=’. +Its value should be a symbol. It works by substituting certain single +quotes for grave accent and apostrophe. This is done in help output +and in functions like `message' and `format-message'. It is not done +in `format'. + +`curve' means quote with curved single quotes ‘like this’. `straight' means quote with straight apostrophes \\='like this\\='. -`grave' means quote with grave accent and apostrophe \\=`like this\\='. -The default value nil acts like `curve' if curved single quotes are -displayable, and like `grave' otherwise. */); +`grave' means quote with grave accent and apostrophe \\=`like this\\='; +i.e., do not alter quote marks. The default value nil acts like +`curve' if curved single quotes are displayable, and like `grave' +otherwise. */); Vtext_quoting_style = Qnil; DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag, |