annotate src/doc.c @ 40072:22a7c39a8c32

(syms_of_eval): Doc fixes.
author Richard M. Stallman <rms@gnu.org>
date Fri, 19 Oct 2001 23:33:55 +0000
parents 579177964efa
children 0600331ddd52
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* Record indices of function doc strings stored in a file.
27560
a7b55765b7c4 Copyright up-date.
Dave Love <fx@gnu.org>
parents: 27552
diff changeset
2 Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 Free Software Foundation, Inc.
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 This file is part of GNU Emacs.
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
10344
a6e8525a1a9d (store_function_docstring, Fdocumentation): Use & PSEUDOVECTOR_SIZE_MASK on
Roland McGrath <roland@gnu.org>
parents: 10330
diff changeset
8 the Free Software Foundation; either version 2, or (at your option)
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 any later version.
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU General Public License for more details.
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 along with GNU Emacs; see the file COPYING. If not, write to
14186
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14069
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14069
diff changeset
19 Boston, MA 02111-1307, USA. */
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 3999
diff changeset
22 #include <config.h>
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 #include <sys/types.h>
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
25 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
27 #ifdef USG5
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28 #include <fcntl.h>
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 #endif
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30
6862
653504b6b5dd [HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents: 6030
diff changeset
31 #ifdef HAVE_UNISTD_H
653504b6b5dd [HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents: 6030
diff changeset
32 #include <unistd.h>
653504b6b5dd [HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents: 6030
diff changeset
33 #endif
653504b6b5dd [HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents: 6030
diff changeset
34
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35 #ifndef O_RDONLY
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
36 #define O_RDONLY 0
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37 #endif
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
39 #include "lisp.h"
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 #include "buffer.h"
1511
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
41 #include "keyboard.h"
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
42 #include "charset.h"
39697
0b986bb45526 Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39675
diff changeset
43 #include "keymap.h"
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44
31336
3ecef4a7b3cd Remove includes of
Gerd Moellmann <gerd@gnu.org>
parents: 31225
diff changeset
45 #ifdef HAVE_INDEX
3ecef4a7b3cd Remove includes of
Gerd Moellmann <gerd@gnu.org>
parents: 31225
diff changeset
46 extern char *index P_ ((const char *, int));
31225
7930c46bb365 (toplevel) [HAVE_STRING_H]: Include string.h.
Gerd Moellmann <gerd@gnu.org>
parents: 30154
diff changeset
47 #endif
7930c46bb365 (toplevel) [HAVE_STRING_H]: Include string.h.
Gerd Moellmann <gerd@gnu.org>
parents: 30154
diff changeset
48
27552
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
49 Lisp_Object Vdoc_file_name, Vhelp_manyarg_func_alist;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50
28334
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
51 Lisp_Object Qfunction_documentation;
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
52
5784
9c3be8e0d2ef (Fsubstitute_command_keys): Pass keymap as that arg
Richard M. Stallman <rms@gnu.org>
parents: 5550
diff changeset
53 extern Lisp_Object Voverriding_local_map;
9c3be8e0d2ef (Fsubstitute_command_keys): Pass keymap as that arg
Richard M. Stallman <rms@gnu.org>
parents: 5550
diff changeset
54
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
55 /* For VMS versions with limited file name syntax,
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
56 convert the name to something VMS will allow. */
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
57 static void
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
58 munge_doc_file_name (name)
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
59 char *name;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
60 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61 #ifdef VMS
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62 #ifndef VMS4_4
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
63 /* For VMS versions with limited file name syntax,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
64 convert the name to something VMS will allow. */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
65 p = name;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
66 while (*p)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
68 if (*p == '-')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69 *p = '_';
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
70 p++;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
71 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 #endif /* not VMS4_4 */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
73 #ifdef VMS4_4
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 strcpy (name, sys_translate_unix (name));
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75 #endif /* VMS4_4 */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 #endif /* VMS */
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
77 }
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
78
14648
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
79 /* Buffer used for reading from documentation file. */
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
80 static char *get_doc_string_buffer;
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
81 static int get_doc_string_buffer_size;
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
82
22690
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
83 static unsigned char *read_bytecode_pointer;
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
84
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
85 /* readchar in lread.c calls back here to fetch the next byte.
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
86 If UNREADFLAG is 1, we unread a byte. */
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
87
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
88 int
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
89 read_bytecode_char (unreadflag)
25758
fca9459a0555 (read_bytecode_char): Declare arg.
Dave Love <fx@gnu.org>
parents: 25662
diff changeset
90 int unreadflag;
22690
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
91 {
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
92 if (unreadflag)
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
93 {
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
94 read_bytecode_pointer--;
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
95 return 0;
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
96 }
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
97 return *read_bytecode_pointer++;
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
98 }
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
99
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
100 /* Extract a doc string from a file. FILEPOS says where to get it.
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
101 If it is an integer, use that position in the standard DOC-... file.
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
102 If it is (FILE . INTEGER), use FILE as the file name
11252
f610f9d7e3ca (get_doc_string): In (STRING . INTEGER), if INTEGER
Richard M. Stallman <rms@gnu.org>
parents: 10345
diff changeset
103 and INTEGER as the position in that file.
f610f9d7e3ca (get_doc_string): In (STRING . INTEGER), if INTEGER
Richard M. Stallman <rms@gnu.org>
parents: 10345
diff changeset
104 But if INTEGER is negative, make it positive.
f610f9d7e3ca (get_doc_string): In (STRING . INTEGER), if INTEGER
Richard M. Stallman <rms@gnu.org>
parents: 10345
diff changeset
105 (A negative integer is used for user variables, so we can distinguish
22043
10a9f355a346 (get_doc_string): New arg UNIBYTE
Richard M. Stallman <rms@gnu.org>
parents: 21514
diff changeset
106 them without actually fetching the doc string.)
10a9f355a346 (get_doc_string): New arg UNIBYTE
Richard M. Stallman <rms@gnu.org>
parents: 21514
diff changeset
107
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
108 If UNIBYTE is nonzero, always make a unibyte string.
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
109
22562
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
110 If DEFINITION is nonzero, assume this is for reading
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
111 a dynamic function definition; convert the bytestring
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
112 and the constants vector with appropriate byte handling,
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
113 and return a cons cell. */
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
114
22268
9308a15aa8f8 (get_doc_string): Make non-static.
Richard M. Stallman <rms@gnu.org>
parents: 22043
diff changeset
115 Lisp_Object
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
116 get_doc_string (filepos, unibyte, definition)
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
117 Lisp_Object filepos;
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
118 int unibyte, definition;
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
119 {
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
120 char *from, *to;
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
121 register int fd;
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
122 register char *name;
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
123 register char *p, *p1;
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
124 int minsize;
14552
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
125 int offset, position;
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
126 Lisp_Object file, tem;
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
127
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
128 if (INTEGERP (filepos))
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
129 {
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
130 file = Vdoc_file_name;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
131 position = XINT (filepos);
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
132 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
133 else if (CONSP (filepos))
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
134 {
25662
0a7261c1d487 Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 24573
diff changeset
135 file = XCAR (filepos);
0a7261c1d487 Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 24573
diff changeset
136 position = XINT (XCDR (filepos));
11252
f610f9d7e3ca (get_doc_string): In (STRING . INTEGER), if INTEGER
Richard M. Stallman <rms@gnu.org>
parents: 10345
diff changeset
137 if (position < 0)
f610f9d7e3ca (get_doc_string): In (STRING . INTEGER), if INTEGER
Richard M. Stallman <rms@gnu.org>
parents: 10345
diff changeset
138 position = - position;
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
139 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
140 else
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
141 return Qnil;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
142
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
143 if (!STRINGP (Vdoc_directory))
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
144 return Qnil;
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
145
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
146 if (!STRINGP (file))
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
147 return Qnil;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
148
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
149 /* Put the file name in NAME as a C string.
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
150 If it is relative, combine it with Vdoc_directory. */
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
151
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
152 tem = Ffile_name_absolute_p (file);
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
153 if (NILP (tem))
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
154 {
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
155 minsize = XSTRING (Vdoc_directory)->size;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
156 /* sizeof ("../etc/") == 8 */
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
157 if (minsize < 8)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
158 minsize = 8;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
159 name = (char *) alloca (minsize + XSTRING (file)->size + 8);
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
160 strcpy (name, XSTRING (Vdoc_directory)->data);
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
161 strcat (name, XSTRING (file)->data);
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
162 munge_doc_file_name (name);
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
163 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
164 else
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
165 {
11446
cee0510aa3aa (get_doc_string): Add cast.
Richard M. Stallman <rms@gnu.org>
parents: 11252
diff changeset
166 name = (char *) XSTRING (file)->data;
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
167 }
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
169 fd = emacs_open (name, O_RDONLY, 0);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 if (fd < 0)
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
171 {
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
172 #ifndef CANNOT_DUMP
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
173 if (!NILP (Vpurify_flag))
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
174 {
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
175 /* Preparing to dump; DOC file is probably not installed.
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
176 So check in ../etc. */
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
177 strcpy (name, "../etc/");
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
178 strcat (name, XSTRING (file)->data);
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
179 munge_doc_file_name (name);
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
180
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
181 fd = emacs_open (name, O_RDONLY, 0);
9087
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
182 }
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
183 #endif
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
184 if (fd < 0)
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
185 error ("Cannot open doc string file \"%s\"", name);
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
186 }
e3c272c7f4d2 (get_doc_string): Look in ../etc while dumping.
Richard M. Stallman <rms@gnu.org>
parents: 8823
diff changeset
187
14552
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
188 /* Seek only to beginning of disk block. */
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
189 offset = position % (8 * 1024);
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
190 if (0 > lseek (fd, position - offset, 0))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
191 {
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
192 emacs_close (fd);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 error ("Position %ld out of range in doc string file \"%s\"",
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
194 position, name);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 }
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
196
14648
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
197 /* Read the doc string into get_doc_string_buffer.
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
198 P points beyond the data just read. */
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
199
14648
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
200 p = get_doc_string_buffer;
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
201 while (1)
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
202 {
14648
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
203 int space_left = (get_doc_string_buffer_size
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
204 - (p - get_doc_string_buffer));
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
205 int nread;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
206
14552
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
207 /* Allocate or grow the buffer if we need to. */
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
208 if (space_left == 0)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
209 {
14648
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
210 int in_buffer = p - get_doc_string_buffer;
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
211 get_doc_string_buffer_size += 16 * 1024;
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
212 get_doc_string_buffer
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
213 = (char *) xrealloc (get_doc_string_buffer,
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
214 get_doc_string_buffer_size + 1);
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
215 p = get_doc_string_buffer + in_buffer;
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
216 space_left = (get_doc_string_buffer_size
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
217 - (p - get_doc_string_buffer));
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
218 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
219
14552
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
220 /* Read a disk block at a time.
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
221 If we read the same block last time, maybe skip this? */
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
222 if (space_left > 1024 * 8)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
223 space_left = 1024 * 8;
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
224 nread = emacs_read (fd, p, space_left);
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
225 if (nread < 0)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
226 {
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
227 emacs_close (fd);
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
228 error ("Read error on documentation file");
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
229 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
230 p[nread] = 0;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
231 if (!nread)
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 break;
14648
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
233 if (p == get_doc_string_buffer)
31225
7930c46bb365 (toplevel) [HAVE_STRING_H]: Include string.h.
Gerd Moellmann <gerd@gnu.org>
parents: 30154
diff changeset
234 p1 = (char *) index (p + offset, '\037');
14552
e6f31368feeb (get_doc_string): Always read entire disk blocks.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
235 else
31225
7930c46bb365 (toplevel) [HAVE_STRING_H]: Include string.h.
Gerd Moellmann <gerd@gnu.org>
parents: 30154
diff changeset
236 p1 = (char *) index (p, '\037');
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237 if (p1)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
238 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
239 *p1 = 0;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
240 p = p1;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
241 break;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
242 }
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
243 p += nread;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
244 }
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
245 emacs_close (fd);
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
246
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
247 /* Scan the text and perform quoting with ^A (char code 1).
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
248 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
14648
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
249 from = get_doc_string_buffer + offset;
45d13c154bb4 (get_doc_string): Move static vars outside the function,
Richard M. Stallman <rms@gnu.org>
parents: 14552
diff changeset
250 to = get_doc_string_buffer + offset;
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
251 while (from != p)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
252 {
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
253 if (*from == 1)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
254 {
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
255 int c;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
256
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
257 from++;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
258 c = *from++;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
259 if (c == 1)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
260 *to++ = c;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
261 else if (c == '0')
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
262 *to++ = 0;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
263 else if (c == '_')
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
264 *to++ = 037;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
265 else
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
266 error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
267 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
268 else
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
269 *to++ = *from++;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
270 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
271
22690
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
272 /* If DEFINITION, read from this buffer
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
273 the same way we would read bytes from a file. */
22562
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
274 if (definition)
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
275 {
22690
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
276 read_bytecode_pointer = get_doc_string_buffer + offset;
31bc848c5f18 (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22602
diff changeset
277 return Fread (Qlambda);
22562
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
278 }
ddb3fd464b77 (get_doc_string): 2nd arg is now DEFINITION;
Richard M. Stallman <rms@gnu.org>
parents: 22268
diff changeset
279
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
280 if (unibyte)
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
281 return make_unibyte_string (get_doc_string_buffer + offset,
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
282 to - (get_doc_string_buffer + offset));
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
283 else
24573
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
284 {
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
285 /* Let the data determine whether the string is multibyte,
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
286 even if Emacs is running in --unibyte mode. */
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
287 int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
288 to - (get_doc_string_buffer + offset));
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
289 return make_string_from_bytes (get_doc_string_buffer + offset,
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
290 nchars,
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
291 to - (get_doc_string_buffer + offset));
aa24b1cb428a (get_doc_string): When UNIBYTE and DEFINITION are 0,
Richard M. Stallman <rms@gnu.org>
parents: 23921
diff changeset
292 }
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
293 }
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
294
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
295 /* Get a string from position FILEPOS and pass it through the Lisp reader.
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
296 We use this for fetching the bytecode string and constants vector
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
297 of a compiled function from the .elc file. */
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
298
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
299 Lisp_Object
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
300 read_doc_string (filepos)
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
301 Lisp_Object filepos;
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
302 {
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
303 return get_doc_string (filepos, 0, 1);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
304 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
305
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
306 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
604
63a8e7b3c547 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 577
diff changeset
307 "Return the documentation string of FUNCTION.\n\
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
308 Unless a non-nil second argument RAW is given, the\n\
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
309 string is passed through `substitute-command-keys'.")
647
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
310 (function, raw)
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
311 Lisp_Object function, raw;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313 Lisp_Object fun;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 Lisp_Object funcar;
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
315 Lisp_Object tem, doc;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
316
34363
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
317 doc = Qnil;
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
318
28334
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
319 if (SYMBOLP (function)
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
320 && (tem = Fget (function, Qfunction_documentation),
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
321 !NILP (tem)))
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
322 return Fdocumentation_property (function, Qfunction_documentation, raw);
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
323
647
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
324 fun = Findirect_function (function);
10002
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
325 if (SUBRP (fun))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
326 {
28334
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
327 if (XSUBR (fun)->doc == 0)
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
328 return Qnil;
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
329 else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
330 doc = build_string (XSUBR (fun)->doc);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
331 else
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
332 doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
333 0, 0);
27552
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
334 if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
335 doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
10002
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
336 }
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
337 else if (COMPILEDP (fun))
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
338 {
10345
9952a5ab70d1 Fix typo in last change.
Roland McGrath <roland@gnu.org>
parents: 10344
diff changeset
339 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
340 return Qnil;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
341 tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
342 if (STRINGP (tem))
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
343 doc = tem;
10202
4013c083162e (get_doc_string): Now static. Arg now Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 10002
diff changeset
344 else if (NATNUMP (tem) || CONSP (tem))
22890
5044c732dbde (Fdocumentation): Specify UNIBYTE = 0
Richard M. Stallman <rms@gnu.org>
parents: 22690
diff changeset
345 doc = get_doc_string (tem, 0, 0);
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
346 else
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
347 return Qnil;
10002
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
348 }
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
349 else if (STRINGP (fun) || VECTORP (fun))
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
350 {
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
351 return build_string ("Keyboard macro.");
10002
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
352 }
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
353 else if (CONSP (fun))
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
354 {
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 funcar = Fcar (fun);
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
356 if (!SYMBOLP (funcar))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
647
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
358 else if (EQ (funcar, Qkeymap))
23921
81a6345fd5e8 (Fdocumentation): Change the doc string for prefix
Andreas Schwab <schwab@suse.de>
parents: 22890
diff changeset
359 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
647
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
360 else if (EQ (funcar, Qlambda)
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
361 || EQ (funcar, Qautoload))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 {
13521
13e55327ef5e (Fdocumentation): Reject a file reference
Richard M. Stallman <rms@gnu.org>
parents: 13244
diff changeset
363 Lisp_Object tem1;
13e55327ef5e (Fdocumentation): Reject a file reference
Richard M. Stallman <rms@gnu.org>
parents: 13244
diff changeset
364 tem1 = Fcdr (Fcdr (fun));
13e55327ef5e (Fdocumentation): Reject a file reference
Richard M. Stallman <rms@gnu.org>
parents: 13244
diff changeset
365 tem = Fcar (tem1);
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
366 if (STRINGP (tem))
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
367 doc = tem;
13521
13e55327ef5e (Fdocumentation): Reject a file reference
Richard M. Stallman <rms@gnu.org>
parents: 13244
diff changeset
368 /* Handle a doc reference--but these never come last
13e55327ef5e (Fdocumentation): Reject a file reference
Richard M. Stallman <rms@gnu.org>
parents: 13244
diff changeset
369 in the function body, so reject them if they are last. */
13e55327ef5e (Fdocumentation): Reject a file reference
Richard M. Stallman <rms@gnu.org>
parents: 13244
diff changeset
370 else if ((NATNUMP (tem) || CONSP (tem))
25662
0a7261c1d487 Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 24573
diff changeset
371 && ! NILP (XCDR (tem1)))
22890
5044c732dbde (Fdocumentation): Specify UNIBYTE = 0
Richard M. Stallman <rms@gnu.org>
parents: 22690
diff changeset
372 doc = get_doc_string (tem, 0, 0);
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
373 else
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
374 return Qnil;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
375 }
647
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
376 else if (EQ (funcar, Qmocklisp))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 return Qnil;
647
529171c8b71c entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
378 else if (EQ (funcar, Qmacro))
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
379 return Fdocumentation (Fcdr (fun), raw);
10002
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
380 else
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
381 goto oops;
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
382 }
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
383 else
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
384 {
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
385 oops:
5b2b7e378772 (Fdocumentation): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9958
diff changeset
386 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 }
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
388
577
53f29271d1b0 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 570
diff changeset
389 if (NILP (raw))
26471
b1863c0b8f9c (Fdocumentation): Remove gcpro here too.
Dave Love <fx@gnu.org>
parents: 26420
diff changeset
390 doc = Fsubstitute_command_keys (doc);
570
c5bfe6e87d93 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 485
diff changeset
391 return doc;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393
28036
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
394 DEFUN ("documentation-property", Fdocumentation_property,
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
395 Sdocumentation_property, 2, 3, 0,
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396 "Return the documentation string that is SYMBOL's PROP property.\n\
28036
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
397 Third argument RAW omitted or nil means pass the result through\n\
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
398 `substitute-command-keys' if it is a string.\n\
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
399 \n\
39675
a4def4204419 *** empty log message ***
Pavel Janík <Pavel@Janik.cz>
parents: 34963
diff changeset
400 This differs from `get' in that it can refer to strings stored in the\n\
28036
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
401 `etc/DOC' file; and that it evaluates documentation properties that\n\
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
402 aren't strings.")
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
403 (symbol, prop, raw)
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
404 Lisp_Object symbol, prop, raw;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
405 {
26076
edbfca66058d (Fdocumentation_property): Remove register declaration for `tem'.
Dave Love <fx@gnu.org>
parents: 26075
diff changeset
406 Lisp_Object tem;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
408 tem = Fget (symbol, prop);
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
409 if (INTEGERP (tem))
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
410 tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
28036
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
411 else if (CONSP (tem) && INTEGERP (XCDR (tem)))
22602
9c6b3b9c3c8f (get_doc_string): Take both UNIBYTE and DEFINITION as args.
Richard M. Stallman <rms@gnu.org>
parents: 22562
diff changeset
412 tem = get_doc_string (tem, 0, 0);
28036
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
413 else if (!STRINGP (tem))
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
414 /* Feval protects its argument. */
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
415 tem = Feval (tem);
ec8b11f3d3da (Fdocumentation_property): If value is not a string,
Gerd Moellmann <gerd@gnu.org>
parents: 27560
diff changeset
416
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
417 if (NILP (raw) && STRINGP (tem))
26420
00b7d6135be4 (Fdocumentation_property): Remove GCPRO because
Gerd Moellmann <gerd@gnu.org>
parents: 26317
diff changeset
418 tem = Fsubstitute_command_keys (tem);
312
adba7439e87c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 297
diff changeset
419 return tem;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
422 /* Scanning the DOC files and placing docstring offsets into functions. */
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
423
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
424 static void
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
425 store_function_docstring (fun, offset)
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
426 Lisp_Object fun;
10330
240a2c88d439 (store_function_docstring): Arg is now EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 10202
diff changeset
427 /* Use EMACS_INT because we get this from pointer subtraction. */
240a2c88d439 (store_function_docstring): Arg is now EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 10202
diff changeset
428 EMACS_INT offset;
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
429 {
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
430 fun = indirect_function (fun);
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
431
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
432 /* The type determines where the docstring is stored. */
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
433
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
434 /* Lisp_Subrs have a slot for it. */
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
435 if (SUBRP (fun))
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
436 XSUBR (fun)->doc = (char *) - offset;
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
437
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
438 /* If it's a lisp form, stick it in the form. */
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
439 else if (CONSP (fun))
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
440 {
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
441 Lisp_Object tem;
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
442
25662
0a7261c1d487 Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 24573
diff changeset
443 tem = XCAR (fun);
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
444 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
445 {
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
446 tem = Fcdr (Fcdr (fun));
25662
0a7261c1d487 Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 24573
diff changeset
447 if (CONSP (tem) && INTEGERP (XCAR (tem)))
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39697
diff changeset
448 XSETCARFASTINT (tem, offset);
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
449 }
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
450 else if (EQ (tem, Qmacro))
25662
0a7261c1d487 Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 24573
diff changeset
451 store_function_docstring (XCDR (fun), offset);
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
452 }
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
453
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
454 /* Bytecode objects sometimes have slots for it. */
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
455 else if (COMPILEDP (fun))
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
456 {
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
457 /* This bytecode object must have a slot for the
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
458 docstring, since we've found a docstring for it. */
10345
9952a5ab70d1 Fix typo in last change.
Roland McGrath <roland@gnu.org>
parents: 10344
diff changeset
459 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
9304
1fbc46670cb0 (store_function_docstring): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9133
diff changeset
460 XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
461 }
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
462 }
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
463
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
464
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
465 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
466 1, 1, 0,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
467 "Used during Emacs initialization, before dumping runnable Emacs,\n\
604
63a8e7b3c547 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 577
diff changeset
468 to find pointers to doc strings stored in `etc/DOC...' and\n\
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
469 record them in function definitions.\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
470 One arg, FILENAME, a string which does not include a directory.\n\
604
63a8e7b3c547 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 577
diff changeset
471 The file is found in `../etc' now; found in the `data-directory'\n\
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 when doc strings are referred to later in the dumped Emacs.")
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
473 (filename)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
474 Lisp_Object filename;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
475 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476 int fd;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 char buf[1024 + 1];
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478 register int filled;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 register int pos;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 register char *p, *end;
34963
681963400696 (Fsnarf_documentation): Remove unused variables `fun' and
Eli Zaretskii <eliz@gnu.org>
parents: 34363
diff changeset
481 Lisp_Object sym;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 char *name;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483
1116
6d0d442e2ada * doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents: 961
diff changeset
484 #ifndef CANNOT_DUMP
6d0d442e2ada * doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents: 961
diff changeset
485 if (NILP (Vpurify_flag))
6d0d442e2ada * doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents: 961
diff changeset
486 error ("Snarf-documentation can only be called in an undumped Emacs");
6d0d442e2ada * doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents: 961
diff changeset
487 #endif
6d0d442e2ada * doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents: 961
diff changeset
488
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 CHECK_STRING (filename, 0);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 #ifndef CANNOT_DUMP
463
ffdbf3445088 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 312
diff changeset
492 name = (char *) alloca (XSTRING (filename)->size + 14);
604
63a8e7b3c547 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 577
diff changeset
493 strcpy (name, "../etc/");
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494 #else /* CANNOT_DUMP */
6030
8b3f54fb451f (get_doc_string, Snarf_documentation): Use new variable doc_directory.
Karl Heuer <kwzh@gnu.org>
parents: 5784
diff changeset
495 CHECK_STRING (Vdoc_directory, 0);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496 name = (char *) alloca (XSTRING (filename)->size +
6030
8b3f54fb451f (get_doc_string, Snarf_documentation): Use new variable doc_directory.
Karl Heuer <kwzh@gnu.org>
parents: 5784
diff changeset
497 XSTRING (Vdoc_directory)->size + 1);
8b3f54fb451f (get_doc_string, Snarf_documentation): Use new variable doc_directory.
Karl Heuer <kwzh@gnu.org>
parents: 5784
diff changeset
498 strcpy (name, XSTRING (Vdoc_directory)->data);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
499 #endif /* CANNOT_DUMP */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
500 strcat (name, XSTRING (filename)->data); /*** Add this line ***/
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
501 #ifdef VMS
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
502 #ifndef VMS4_4
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
503 /* For VMS versions with limited file name syntax,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
504 convert the name to something VMS will allow. */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
505 p = name;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
506 while (*p)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
507 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
508 if (*p == '-')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
509 *p = '_';
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 p++;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 #endif /* not VMS4_4 */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513 #ifdef VMS4_4
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
514 strcpy (name, sys_translate_unix (name));
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
515 #endif /* VMS4_4 */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 #endif /* VMS */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
518 fd = emacs_open (name, O_RDONLY, 0);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 if (fd < 0)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 report_file_error ("Opening doc string file",
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 Fcons (build_string (name), Qnil));
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522 Vdoc_file_name = filename;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 filled = 0;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 pos = 0;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 while (1)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 if (filled < 512)
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
528 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 if (!filled)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 break;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
531
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
532 buf[filled] = 0;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
533 p = buf;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 end = buf + (filled < 512 ? filled : filled - 128);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
535 while (p != end && *p != '\037') p++;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537 if (p != end)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538 {
31225
7930c46bb365 (toplevel) [HAVE_STRING_H]: Include string.h.
Gerd Moellmann <gerd@gnu.org>
parents: 30154
diff changeset
539 end = (char *) index (p, '\n');
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
540 sym = oblookup (Vobarray, p + 2,
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
541 multibyte_chars_in_text (p + 2, end - p - 2),
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
542 end - p - 2);
9133
48820d57a24c (get_doc_string, Fdocumentation, Fdocumentation_property,
Karl Heuer <kwzh@gnu.org>
parents: 9087
diff changeset
543 if (SYMBOLP (sym))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
545 /* Attach a docstring to a variable? */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546 if (p[1] == 'V')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
547 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
548 /* Install file-position as variable-documentation property
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
549 and make it negative for a user-variable
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550 (doc starts with a `*'). */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
551 Fput (sym, Qvariable_documentation,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
552 make_number ((pos + end + 1 - buf)
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
553 * (end[1] == '*' ? -1 : 1)));
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
555
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
556 /* Attach a docstring to a function? */
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 else if (p[1] == 'F')
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
558 store_function_docstring (sym, pos + end + 1 - buf);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559
1651
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
560 else
ef09501a0a9b * doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents: 1511
diff changeset
561 error ("DOC file invalid at position %d", pos);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 pos += end - buf;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565 filled -= end - buf;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 bcopy (end, buf, filled);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 }
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 26076
diff changeset
568 emacs_close (fd);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569 return Qnil;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
571
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
572 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573 Ssubstitute_command_keys, 1, 1, 0,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 "Substitute key descriptions for command names in STRING.\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
576 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
577 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
578 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
579 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
580 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
581 as the keymap for future \\=\\[COMMAND] substrings.\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
582 \\=\\= quotes the following character and is discarded;\n\
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
583 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
584 (string)
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
585 Lisp_Object string;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
586 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
587 unsigned char *buf;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
588 int changed = 0;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 register unsigned char *strp;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 register unsigned char *bufp;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591 int idx;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 int bsize;
1511
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
593 Lisp_Object tem;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594 Lisp_Object keymap;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 unsigned char *start;
20802
8cd0a6343a84 (Fsubstitute_command_keys): Declare length_byte out of
Kenichi Handa <handa@m17n.org>
parents: 20708
diff changeset
596 int length, length_byte;
1511
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
597 Lisp_Object name;
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
598 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
599 int multibyte;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
600 int nchars;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
601
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
602 if (NILP (string))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603 return Qnil;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
604
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
605 CHECK_STRING (string, 0);
1511
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
606 tem = Qnil;
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
607 keymap = Qnil;
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
608 name = Qnil;
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
609 GCPRO4 (string, tem, keymap, name);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
610
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
611 multibyte = STRING_MULTIBYTE (string);
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
612 nchars = 0;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
613
5784
9c3be8e0d2ef (Fsubstitute_command_keys): Pass keymap as that arg
Richard M. Stallman <rms@gnu.org>
parents: 5550
diff changeset
614 /* KEYMAP is either nil (which means search all the active keymaps)
9c3be8e0d2ef (Fsubstitute_command_keys): Pass keymap as that arg
Richard M. Stallman <rms@gnu.org>
parents: 5550
diff changeset
615 or a specified local map (which means search just that and the
9c3be8e0d2ef (Fsubstitute_command_keys): Pass keymap as that arg
Richard M. Stallman <rms@gnu.org>
parents: 5550
diff changeset
616 global map). If non-nil, it might come from Voverriding_local_map,
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
617 or from a \\<mapname> construct in STRING itself.. */
12261
cd2e7821bbf5 (Fsubstitute_command_keys):
Karl Heuer <kwzh@gnu.org>
parents: 11925
diff changeset
618 keymap = current_kboard->Voverriding_terminal_local_map;
cd2e7821bbf5 (Fsubstitute_command_keys):
Karl Heuer <kwzh@gnu.org>
parents: 11925
diff changeset
619 if (NILP (keymap))
cd2e7821bbf5 (Fsubstitute_command_keys):
Karl Heuer <kwzh@gnu.org>
parents: 11925
diff changeset
620 keymap = Voverriding_local_map;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
621
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 20802
diff changeset
622 bsize = STRING_BYTES (XSTRING (string));
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
623 bufp = buf = (unsigned char *) xmalloc (bsize);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
624
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
625 strp = (unsigned char *) XSTRING (string)->data;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 20802
diff changeset
626 while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
627 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
628 if (strp[0] == '\\' && strp[1] == '=')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
629 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
630 /* \= quotes the next character;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
631 thus, to put in \[ without its special meaning, use \=\[. */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
632 changed = 1;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
633 strp += 2;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
634 if (multibyte)
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
635 {
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
636 int len;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 20802
diff changeset
637 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
638
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
639 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
640 if (len == 1)
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
641 *bufp = *strp;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
642 else
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
643 bcopy (strp, bufp, len);
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
644 strp += len;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
645 bufp += len;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
646 nchars++;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
647 }
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
648 else
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
649 *bufp++ = *strp++, nchars++;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
650 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
651 else if (strp[0] == '\\' && strp[1] == '[')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
652 {
5248
27d6275810a7 (Fsubstitute_command_keys): Ignore menu bar bindings.
Richard M. Stallman <rms@gnu.org>
parents: 4716
diff changeset
653 Lisp_Object firstkey;
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
654 int start_idx;
5248
27d6275810a7 (Fsubstitute_command_keys): Ignore menu bar bindings.
Richard M. Stallman <rms@gnu.org>
parents: 4716
diff changeset
655
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
656 changed = 1;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
657 strp += 2; /* skip \[ */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
658 start = strp;
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
659 start_idx = start - XSTRING (string)->data;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
660
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
661 while ((strp - (unsigned char *) XSTRING (string)->data
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 20802
diff changeset
662 < STRING_BYTES (XSTRING (string)))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
663 && *strp != ']')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
664 strp++;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
665 length_byte = strp - start;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
666
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
667 strp++; /* skip ] */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
668
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
669 /* Save STRP in IDX. */
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
670 idx = strp - (unsigned char *) XSTRING (string)->data;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
671 tem = Fintern (make_string (start, length_byte), Qnil);
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
672
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
673 /* Note the Fwhere_is_internal can GC, so we have to take
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
674 relocation of string contents into account. */
5784
9c3be8e0d2ef (Fsubstitute_command_keys): Pass keymap as that arg
Richard M. Stallman <rms@gnu.org>
parents: 5550
diff changeset
675 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
676 strp = XSTRING (string)->data + idx;
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
677 start = XSTRING (string)->data + start_idx;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
678
5248
27d6275810a7 (Fsubstitute_command_keys): Ignore menu bar bindings.
Richard M. Stallman <rms@gnu.org>
parents: 4716
diff changeset
679 /* Disregard menu bar bindings; it is positively annoying to
27d6275810a7 (Fsubstitute_command_keys): Ignore menu bar bindings.
Richard M. Stallman <rms@gnu.org>
parents: 4716
diff changeset
680 mention them when there's no menu bar, and it isn't terribly
27d6275810a7 (Fsubstitute_command_keys): Ignore menu bar bindings.
Richard M. Stallman <rms@gnu.org>
parents: 4716
diff changeset
681 useful even when there is a menu bar. */
5377
7a8463c07d8f (Fsubstitute_command_keys): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5248
diff changeset
682 if (!NILP (tem))
7a8463c07d8f (Fsubstitute_command_keys): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5248
diff changeset
683 {
7a8463c07d8f (Fsubstitute_command_keys): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5248
diff changeset
684 firstkey = Faref (tem, make_number (0));
7a8463c07d8f (Fsubstitute_command_keys): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5248
diff changeset
685 if (EQ (firstkey, Qmenu_bar))
7a8463c07d8f (Fsubstitute_command_keys): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5248
diff changeset
686 tem = Qnil;
7a8463c07d8f (Fsubstitute_command_keys): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5248
diff changeset
687 }
5248
27d6275810a7 (Fsubstitute_command_keys): Ignore menu bar bindings.
Richard M. Stallman <rms@gnu.org>
parents: 4716
diff changeset
688
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
689 if (NILP (tem)) /* but not on any keys */
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
690 {
34363
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
691 int offset = bufp - buf;
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
692 buf = (unsigned char *) xrealloc (buf, bsize += 4);
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
693 bufp = buf + offset;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
694 bcopy ("M-x ", bufp, 4);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
695 bufp += 4;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
696 nchars += 4;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
697 if (multibyte)
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
698 length = multibyte_chars_in_text (start, length_byte);
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
699 else
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
700 length = length_byte;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
701 goto subst;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
702 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703 else
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 { /* function is on a key */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
705 tem = Fkey_description (tem);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
706 goto subst_string;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
707 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
708 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
709 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
710 \<foo> just sets the keymap used for \[cmd]. */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
711 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
712 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
713 struct buffer *oldbuf;
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
714 int start_idx;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
715
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
716 changed = 1;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
717 strp += 2; /* skip \{ or \< */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
718 start = strp;
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
719 start_idx = start - XSTRING (string)->data;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
720
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
721 while ((strp - (unsigned char *) XSTRING (string)->data
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
722 < XSTRING (string)->size)
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
723 && *strp != '}' && *strp != '>')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724 strp++;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
725
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
726 length_byte = strp - start;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
727 strp++; /* skip } or > */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
728
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
729 /* Save STRP in IDX. */
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
730 idx = strp - (unsigned char *) XSTRING (string)->data;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
731
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
732 /* Get the value of the keymap in TEM, or nil if undefined.
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
733 Do this while still in the user's current buffer
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
734 in case it is a local variable. */
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
735 name = Fintern (make_string (start, length_byte), Qnil);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
736 tem = Fboundp (name);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
737 if (! NILP (tem))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
738 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
739 tem = Fsymbol_value (name);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
740 if (! NILP (tem))
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
741 {
32988
c3435dc00ed7 * lisp.h (KEYMAPP): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31336
diff changeset
742 tem = get_keymap (tem, 0, 1);
c3435dc00ed7 * lisp.h (KEYMAPP): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31336
diff changeset
743 /* Note that get_keymap can GC. */
30154
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
744 strp = XSTRING (string)->data + idx;
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
745 start = XSTRING (string)->data + start_idx;
f8e2064c56b1 (Fsubstitute_command_keys): Handle case that a GC
Gerd Moellmann <gerd@gnu.org>
parents: 28334
diff changeset
746 }
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
747 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
748
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
749 /* Now switch to a temp buffer. */
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
750 oldbuf = current_buffer;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
751 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
752
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
753 if (NILP (tem))
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
754 {
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
755 name = Fsymbol_name (name);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
756 insert_string ("\nUses keymap \"");
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
757 insert_from_string (name, 0, 0,
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
758 XSTRING (name)->size,
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 20802
diff changeset
759 STRING_BYTES (XSTRING (name)), 1);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
760 insert_string ("\", which is not currently defined.\n");
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
761 if (start[-1] == '<') keymap = Qnil;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
762 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
763 else if (start[-1] == '<')
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
764 keymap = tem;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
765 else
18746
c7ada1684ebb (Fsubstitute_command_keys): Add missing describe_map_tree argument.
Richard M. Stallman <rms@gnu.org>
parents: 14648
diff changeset
766 describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
767 tem = Fbuffer_string ();
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
768 Ferase_buffer ();
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
769 set_buffer_internal (oldbuf);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
770
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
771 subst_string:
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
772 start = XSTRING (tem)->data;
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
773 length = XSTRING (tem)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 20802
diff changeset
774 length_byte = STRING_BYTES (XSTRING (tem));
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
775 subst:
34363
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
776 {
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
777 int offset = bufp - buf;
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
778 buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
779 bufp = buf + offset;
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
780 bcopy (start, bufp, length_byte);
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
781 bufp += length_byte;
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
782 nchars += length;
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
783 /* Check STRING again in case gc relocated it. */
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
784 strp = (unsigned char *) XSTRING (string)->data + idx;
62a349fc3d3c (Fsubstitute_command_keys): Change the way buffers
Gerd Moellmann <gerd@gnu.org>
parents: 32988
diff changeset
785 }
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
786 }
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
787 else if (! multibyte) /* just copy other chars */
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
788 *bufp++ = *strp++, nchars++;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
789 else
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
790 {
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
791 int len;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 20802
diff changeset
792 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
20619
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
793
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
794 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
795 if (len == 1)
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
796 *bufp = *strp;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
797 else
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
798 bcopy (strp, bufp, len);
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
799 strp += len;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
800 bufp += len;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
801 nchars++;
0a559893331d Include charset.h.
Richard M. Stallman <rms@gnu.org>
parents: 18746
diff changeset
802 }
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
803 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
804
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
805 if (changed) /* don't bother if nothing substituted */
21252
fce0c8c246d1 (Fsubstitute_command_keys): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
806 tem = make_string_from_bytes (buf, nchars, bufp - buf);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
807 else
14069
a45a97ebdf1c (Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
parents: 13521
diff changeset
808 tem = string;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 1651
diff changeset
809 xfree (buf);
1511
ff88f962a982 * doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1116
diff changeset
810 RETURN_UNGCPRO (tem);
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
811 }
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
812
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21252
diff changeset
813 void
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
814 syms_of_doc ()
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
815 {
28334
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
816 Qfunction_documentation = intern ("function-documentation");
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
817 staticpro (&Qfunction_documentation);
f9cb3463ee2a (Qfunction_documentation): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 28036
diff changeset
818
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
819 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
820 "Name of file containing documentation strings of built-in symbols.");
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
821 Vdoc_file_name = Qnil;
27552
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
822 DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
823 "Alist of primitive functions and descriptions of their arg lists.\n\
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
824 All special forms and primitives which effectively have &rest args\n\
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
825 should have an entry here so that `documentation' can provide their\n\
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
826 arg list.");
60c820c7f330 (Vhelp_manyarg_func_alist): New variable.
Dave Love <fx@gnu.org>
parents: 26471
diff changeset
827 Vhelp_manyarg_func_alist = Qnil;
297
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
828
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
829 defsubr (&Sdocumentation);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
830 defsubr (&Sdocumentation_property);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
831 defsubr (&Ssnarf_documentation);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
832 defsubr (&Ssubstitute_command_keys);
785f88514b16 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
833 }