-Copyright (C) 1985-1986, 1993-1995, 1997-2017 Free Software Foundation,

- int fd;

- int offset;

- EMACS_INT position;

- Lisp_Object file, tem, pos;

- ptrdiff_t count;

- if (INTEGERP (filepos))

- position = eabs (XINT (pos));

- if (!STRINGP (Vdoc_directory))

- tem = Ffile_name_absolute_p (file);

- = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;

-#ifndef CANNOT_DUMP

- docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);

-#endif

- fd = emacs_open (name, O_RDONLY, 0);

-#ifndef CANNOT_DUMP

- if (!NILP (Vpurify_flag))

-#endif

- if (errno == EMFILE || errno == ENFILE)

- count = SPECPDL_INDEX ();

- offset = min (position, max (1024, position % (8 * 1024)));

- int nread;

- nread = emacs_read_quit (fd, p, space_left);

- unbind_to (count, Qnil);

- SAFE_FREE ();

- int c;

-

- c = *from++;

- Fload (file, Qt, Qt, Qt, Qnil);

- Lisp_Object fun;

- Lisp_Object funcar;

- bool try_reload = 1;

- fun = Findirect_function (function, Qnil);

- doc = make_number (XSUBR (fun)->doc);

- doc = XMODULE_FUNCTION (fun)->documentation;

- else if (COMPILEDP (fun))

- {

- if (PVSIZE (fun) <= COMPILED_DOC_STRING)

- return Qnil;

- else

- {

- Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);

- if (STRINGP (tem))

- doc = tem;

- else if (NATNUMP (tem) || CONSP (tem))

- doc = tem;

- else

- return Qnil;

- }

- }

- else if (STRINGP (fun) || VECTORP (fun))

- {

- return build_string ("Keyboard macro.");

- }

- else if (CONSP (fun))

- {

- funcar = XCAR (fun);

- if (!SYMBOLP (funcar))

- xsignal1 (Qinvalid_function, fun);

- else if (EQ (funcar, Qkeymap))

- return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");

- else if (EQ (funcar, Qlambda)

- || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))

- || EQ (funcar, Qautoload))

- {

- Lisp_Object tem1 = Fcdr (Fcdr (fun));

- Lisp_Object tem = Fcar (tem1);

- if (STRINGP (tem))

- doc = tem;

- /* Handle a doc reference--but these never come last

- in the function body, so reject them if they are last. */

- else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))

- && !NILP (XCDR (tem1)))

- doc = tem;

- else

- return Qnil;

- }

- else

- goto oops;

- }

- {

- oops:

- xsignal1 (Qinvalid_function, fun);

- }

- if (EQ (doc, make_number (0)))

- if (INTEGERP (doc) || CONSP (doc))

- try_reload = 0;

- doc = Fsubstitute_command_keys (doc);

- bool try_reload = 1;

- if (EQ (tem, make_number (0)))

- if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))

- try_reload = 0;

- tem = Fsubstitute_command_keys (tem);

- Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;

- Lisp_Object tem;

-

- tem = XCAR (fun);

- if (CONSP (tem) && INTEGERP (XCAR (tem)))

- XSETCAR (tem, make_number (offset));

-

- else if (SUBRP (fun))

- XSUBR (fun)->doc = offset;

- if (PVSIZE (fun) > COMPILED_DOC_STRING)

- ASET (fun, COMPILED_DOC_STRING, make_number (offset));

- AUTO_STRING (format, "No docstring slot for %s");

- bool skip_file = 0;

- ptrdiff_t count;

- if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;

- if

-#ifndef CANNOT_DUMP

- (!NILP (Vpurify_flag))

-#else /* CANNOT_DUMP */

- (0)

-#endif /* CANNOT_DUMP */

- count = SPECPDL_INDEX ();

- /* See if this is a file name, and if it is a file in build-files. */

- if (p[1] == 'S')

- {

- skip_file = 0;

- if (end - p > 4 && end[-2] == '.'

- && (end[-1] == 'o' || end[-1] == 'c'))

- {

- ptrdiff_t len = end - p - 2;

- char *fromfile = SAFE_ALLOCA (len + 1);

- memcpy (fromfile, &p[2], len);

- fromfile[len] = 0;

- if (fromfile[len-1] == 'c')

- fromfile[len-1] = 'o';

-

- skip_file = NILP (Fmember (build_string (fromfile),

- Vbuild_files));

- }

- }

- /* Check skip_file so that when a function is defined several

- times in different files (typically, once in xterm, once in

- w32term, ...), we only pay attention to the one that

- matters. */

- if (! skip_file && SYMBOLP (sym))

- if (!NILP (Fboundp (sym))

- make_number ((pos + end + 1 - buf)

- if (!NILP (Ffboundp (sym)))

- SAFE_FREE ();

- return unbind_to (count, Qnil);

- && EQ (AREF (dv, 0), make_number ('`')));

-/* Return the current effective text quoting style. */

-enum text_quoting_style

-text_quoting_style (void)

- return GRAVE_QUOTING_STYLE;

- else if (EQ (Vtext_quoting_style, Qstraight))

- return STRAIGHT_QUOTING_STYLE;

- else

- return CURVE_QUOTING_STYLE;

-}

-

-DEFUN ("substitute-command-keys", Fsubstitute_command_keys,

- Ssubstitute_command_keys, 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 \\=\\<MAPVAR> 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. */)

- (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 \\<mapname> 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).

- \<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 (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 (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. */

- 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);

- }

- }

- }

- tem = string;

- return unbind_to (count, tem);

-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

-`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\\=';

-i.e., do not alter quote marks. The default value nil acts like

-`curve' if curved single quotes are displayable, and like `grave'

-otherwise. */);

- defsubr (&Ssubstitute_command_keys);