X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fd60bf6c902b47daadda6ebf442045dbe1328941..7ed767557eb608a0ad7097dc80d84af568ab00b1:/src/doc.c
diff --git a/src/doc.c b/src/doc.c
index df8cfba3f2..017dd173d0 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -1,13 +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-2014 Free Software Foundation, Inc.
+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
@@ -30,18 +31,20 @@ 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"
-Lisp_Object Qfunction_documentation;
-
/* Buffer used for reading from documentation file. */
static char *get_doc_string_buffer;
static ptrdiff_t get_doc_string_buffer_size;
static unsigned char *read_bytecode_pointer;
+static char const sibling_etc[] = "../etc/";
+
/* `readchar' in lread.c calls back here to fetch the next byte.
If UNREADFLAG is 1, we unread a byte. */
@@ -80,7 +83,6 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
char *from, *to, *name, *p, *p1;
int fd;
- ptrdiff_t minsize;
int offset;
EMACS_INT position;
Lisp_Object file, tem, pos;
@@ -113,21 +115,14 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
tem = Ffile_name_absolute_p (file);
file = ENCODE_FILE (file);
- if (NILP (tem))
- {
- Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
- minsize = SCHARS (docdir);
- /* sizeof ("../etc/") == 8 */
- if (minsize < 8)
- minsize = 8;
- name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
- strcpy (name, SSDATA (docdir));
- strcat (name, SSDATA (file));
- }
- else
- {
- name = SSDATA (file);
- }
+ Lisp_Object docdir
+ = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
+ ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
+#ifndef CANNOT_DUMP
+ docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
+#endif
+ name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
+ lispstpcpy (lispstpcpy (name, docdir), file);
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
@@ -137,17 +132,20 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
- strcpy (name, "../etc/");
- strcat (name, SSDATA (file));
+ lispstpcpy (stpcpy (name, sibling_etc), file);
fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
{
+ if (errno == EMFILE || errno == ENFILE)
+ report_file_error ("Read error on documentation file", file);
+
SAFE_FREE ();
- return concat3 (build_string ("Cannot open doc string file \""),
- file, build_string ("\"\n"));
+ AUTO_STRING (cannot_open, "Cannot open doc string file \"");
+ AUTO_STRING (quote_nl, "\"\n");
+ return concat3 (cannot_open, file, quote_nl);
}
}
count = SPECPDL_INDEX ();
@@ -306,19 +304,6 @@ read_doc_string (Lisp_Object filepos)
static bool
reread_doc_file (Lisp_Object file)
{
-#if 0
- Lisp_Object reply, prompt[3];
- struct gcpro gcpro1;
- GCPRO1 (file);
- prompt[0] = build_string ("File ");
- prompt[1] = NILP (file) ? Vdoc_file_name : file;
- prompt[2] = build_string (" is out of sync. Reload? ");
- reply = Fy_or_n_p (Fconcat (3, prompt));
- UNGCPRO;
- if (NILP (reply))
- return 0;
-#endif
-
if (NILP (file))
Fsnarf_documentation (Vdoc_file_name);
else
@@ -426,10 +411,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;
@@ -471,10 +453,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;
@@ -536,8 +515,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 ("")));
+ }
}
}
@@ -561,6 +545,8 @@ the same file name is found in the `doc-directory'. */)
char *p, *name;
bool skip_file = 0;
ptrdiff_t count;
+ char const *dirname;
+ ptrdiff_t dirlen;
/* Preloaded defcustoms using custom-initialize-delay are added to
this list, but kept unbound. See http://debbugs.gnu.org/11565 */
Lisp_Object delayed_init =
@@ -577,16 +563,20 @@ the same file name is found in the `doc-directory'. */)
(0)
#endif /* CANNOT_DUMP */
{
- name = alloca (SCHARS (filename) + 14);
- strcpy (name, "../etc/");
+ dirname = sibling_etc;
+ dirlen = sizeof sibling_etc - 1;
}
else
{
CHECK_STRING (Vdoc_directory);
- name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
- strcpy (name, SSDATA (Vdoc_directory));
+ dirname = SSDATA (Vdoc_directory);
+ dirlen = SBYTES (Vdoc_directory);
}
- strcat (name, SSDATA (filename)); /*** Add this line ***/
+
+ count = SPECPDL_INDEX ();
+ USE_SAFE_ALLOCA;
+ name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
+ lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/
/* Vbuild_files is nil when temacs is run, and non-nil after that. */
if (NILP (Vbuild_files))
@@ -608,7 +598,6 @@ the same file name is found in the `doc-directory'. */)
report_file_errno ("Opening doc string file", build_string (name),
open_errno);
}
- count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
Vdoc_file_name = filename;
filled = 0;
@@ -637,7 +626,7 @@ the same file name is found in the `doc-directory'. */)
&& (end[-1] == 'o' || end[-1] == 'c'))
{
ptrdiff_t len = end - p - 2;
- char *fromfile = alloca (len + 1);
+ char *fromfile = SAFE_ALLOCA (len + 1);
memcpy (fromfile, &p[2], len);
fromfile[len] = 0;
if (fromfile[len-1] == 'c')
@@ -688,9 +677,39 @@ the same file name is found in the `doc-directory'. */)
filled -= end - buf;
memmove (buf, end, filled);
}
+
+ SAFE_FREE ();
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.
@@ -706,25 +725,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;
@@ -735,7 +760,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;
@@ -747,6 +773,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);
@@ -756,7 +788,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)
{
@@ -779,7 +811,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);
@@ -839,17 +870,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 != '>')
@@ -879,7 +907,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
@@ -889,11 +917,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] == '<')
@@ -902,7 +932,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);
}
@@ -910,12 +941,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)
@@ -929,35 +964,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. */);
@@ -967,6 +1028,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);