X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cbd447e1cdbbebcd2a04144194138bb7936dea9d..9bf31d1d3f35880c652f76509d1e27d33e454121:/src/doc.c diff --git a/src/doc.c b/src/doc.c index 8b18fb0a5a..6ffdad10f0 100644 --- a/src/doc.c +++ b/src/doc.c @@ -1,14 +1,14 @@ -/* Record indices of function doc strings stored in a file. +/* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*- -Copyright (C) 1985-1986, 1993-1995, 1997-2015 Free Software Foundation, +Copyright (C) 1985-1986, 1993-1995, 1997-2016 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -31,8 +31,10 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "character.h" +#include "coding.h" #include "buffer.h" -#include "keyboard.h" +#include "disptab.h" +#include "intervals.h" #include "keymap.h" /* Buffer used for reading from documentation file. */ @@ -137,6 +139,9 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) #endif if (fd < 0) { + if (errno == EMFILE || errno == ENFILE) + report_file_error ("Read error on documentation file", file); + SAFE_FREE (); AUTO_STRING (cannot_open, "Cannot open doc string file \""); AUTO_STRING (quote_nl, "\"\n"); @@ -334,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) @@ -406,10 +402,7 @@ string is passed through `substitute-command-keys'. */) if (NILP (tem) && try_reload) { /* The file is newer, we need to reset the pointers. */ - struct gcpro gcpro1, gcpro2; - GCPRO2 (function, raw); try_reload = reread_doc_file (Fcar_safe (doc)); - UNGCPRO; if (try_reload) { try_reload = 0; @@ -451,10 +444,7 @@ aren't strings. */) if (NILP (tem) && try_reload) { /* The file is newer, we need to reset the pointers. */ - struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (symbol, prop, raw); try_reload = reread_doc_file (Fcar_safe (doc)); - UNGCPRO; if (try_reload) { try_reload = 0; @@ -474,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). */ @@ -482,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; @@ -504,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)) { @@ -516,8 +503,13 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset) if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING) ASET (fun, COMPILED_DOC_STRING, make_number (offset)); else - message ("No docstring slot for %s", - SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : ""); + { + AUTO_STRING (format, "No docstring slot for %s"); + CALLN (Fmessage, format, + (SYMBOLP (obj) + ? SYMBOL_NAME (obj) + : build_string (""))); + } } } @@ -678,6 +670,34 @@ the same file name is found in the `doc-directory'. */) return unbind_to (count, Qnil); } +/* Return true if text quoting style should default to quote `like this'. */ +static bool +default_to_grave_quoting_style (void) +{ + if (!text_quoting_flag) + return true; + if (! DISP_TABLE_P (Vstandard_display_table)) + return false; + Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table), + LEFT_SINGLE_QUOTATION_MARK); + return (VECTORP (dv) && ASIZE (dv) == 1 + && EQ (AREF (dv, 0), make_number ('`'))); +} + +/* Return the current effective text quoting style. */ +enum text_quoting_style +text_quoting_style (void) +{ + if (NILP (Vtext_quoting_style) + ? default_to_grave_quoting_style () + : EQ (Vtext_quoting_style, Qgrave)) + 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. @@ -693,25 +713,31 @@ summary). Each substring of the form \\=\\ specifies the use of MAPVAR as the keymap for future \\=\\[COMMAND] substrings. -\\=\\= quotes the following character and is discarded; -thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. + +Each \\=‘ and \\=` is replaced by left quote, and each \\=’ and \\=' +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 = 0; + 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 *start; + unsigned char const *start; ptrdiff_t length, length_byte; Lisp_Object name; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; bool multibyte; ptrdiff_t nchars; @@ -722,7 +748,8 @@ Otherwise, return a new string. */) tem = Qnil; keymap = Qnil; name = Qnil; - GCPRO4 (string, tem, keymap, name); + + enum text_quoting_style quoting_style = text_quoting_style (); multibyte = STRING_MULTIBYTE (string); nchars = 0; @@ -734,6 +761,12 @@ Otherwise, return a new string. */) keymap = Voverriding_local_map; bsize = SBYTES (string); + + /* Add some room for expansion due to quote replacement. */ + enum { EXTRA_ROOM = 20 }; + if (bsize <= STRING_BYTES_BOUND - EXTRA_ROOM) + bsize += EXTRA_ROOM; + bufp = buf = xmalloc (bsize); strp = SDATA (string); @@ -743,7 +776,7 @@ Otherwise, return a new string. */) { /* \= quotes the next character; thus, to put in \[ without its special meaning, use \=\[. */ - changed = 1; + changed = nonquotes_changed = true; strp += 2; if (multibyte) { @@ -766,7 +799,6 @@ Otherwise, return a new string. */) ptrdiff_t start_idx; bool follow_remap = 1; - changed = 1; strp += 2; /* skip \[ */ start = strp; start_idx = start - SDATA (string); @@ -826,17 +858,14 @@ Otherwise, return a new string. */) \ just sets the keymap used for \[cmd]. */ else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')) { - struct buffer *oldbuf; - ptrdiff_t start_idx; + { /* 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 (); - changed = 1; strp += 2; /* skip \{ or \< */ start = strp; - start_idx = start - SDATA (string); + ptrdiff_t start_idx = start - SDATA (string); while ((strp - SDATA (string) < SBYTES (string)) && *strp != '}' && *strp != '>') @@ -866,7 +895,7 @@ Otherwise, return a new string. */) } /* 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 @@ -876,11 +905,13 @@ Otherwise, return a new string. */) if (NILP (tem)) { name = Fsymbol_name (name); - insert_string ("\nUses keymap `"); + AUTO_STRING (msg_prefix, "\nUses keymap `"); + insert1 (Fsubstitute_command_keys (msg_prefix)); insert_from_string (name, 0, 0, SCHARS (name), SBYTES (name), 1); - insert_string ("', which is not currently defined.\n"); + AUTO_STRING (msg_suffix, "', which is not currently defined.\n"); + insert1 (Fsubstitute_command_keys (msg_suffix)); if (start[-1] == '<') keymap = Qnil; } else if (start[-1] == '<') @@ -889,7 +920,8 @@ Otherwise, return a new string. */) { /* 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); } @@ -897,12 +929,16 @@ Otherwise, return a new string. */) Ferase_buffer (); set_buffer_internal (oldbuf); unbind_to (count, Qnil); + } subst_string: start = SDATA (tem); length = SCHARS (tem); length_byte = SBYTES (tem); subst: + nonquotes_changed = true; + subst_quote: + changed = true; { ptrdiff_t offset = bufp - buf; if (STRING_BYTES_BOUND - length_byte < bsize) @@ -916,35 +952,61 @@ Otherwise, return a new string. */) strp = SDATA (string) + idx; } } - else if (! multibyte) /* just copy other chars */ - *bufp++ = *strp++, nchars++; + 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 (string) + 1; + goto subst_quote; + } + else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE) + { + *bufp++ = '\''; + strp++; + nchars++; + changed = true; + } else { - int len; - - STRING_CHAR_AND_LENGTH (strp, len); - if (len == 1) - *bufp = *strp; - else - memcpy (bufp, strp, len); - strp += len; - bufp += len; + *bufp++ = *strp++; + if (multibyte) + while (! CHAR_HEAD_P (*strp)) + *bufp++ = *strp++; nchars++; } } if (changed) /* don't bother if nothing substituted */ - tem = make_string_from_bytes (buf, nchars, bufp - buf); + { + 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); + } + } + } else tem = string; xfree (buf); - RETURN_UNGCPRO (tem); + return tem; } void syms_of_doc (void) { DEFSYM (Qfunction_documentation, "function-documentation"); + DEFSYM (Qgrave, "grave"); + DEFSYM (Qstraight, "straight"); DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name, doc: /* Name of file containing documentation strings of built-in symbols. */); @@ -954,6 +1016,25 @@ syms_of_doc (void) doc: /* A list of files used to build this Emacs binary. */); Vbuild_files = Qnil; + 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. 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\\='; +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, + doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); + /* Initialized by ‘main’. */ + defsubr (&Sdocumentation); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation);