This source file includes following definitions.
- read_bytecode_char
- close_file_unwind_android_fd
- get_doc_string
- read_doc_string
- reread_doc_file
- DEFUN
- store_function_docstring
- DEFUN
- default_to_grave_quoting_style
- DEFUN
- syms_of_doc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 #include <config.h>
23
24 #include <errno.h>
25 #include <sys/types.h>
26 #include <sys/file.h>
27 #include <fcntl.h>
28 #include <unistd.h>
29
30 #include <c-ctype.h>
31
32 #include "lisp.h"
33 #include "character.h"
34 #include "coding.h"
35 #include "buffer.h"
36 #include "disptab.h"
37 #include "intervals.h"
38 #include "keymap.h"
39
40
41
42 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY \
43 || (__ANDROID_API__ < 9)
44 #define doc_fd int
45 #define doc_fd_p(fd) ((fd) >= 0)
46 #define doc_open emacs_open
47 #define doc_read_quit emacs_read_quit
48 #define doc_lseek lseek
49 #else
50
51
52 #include "android.h"
53
54
55
56
57
58
59
60
61
62
63 #define doc_fd struct android_fd_or_asset
64 #define doc_fd_p(fd) ((fd).asset != (void *) -1)
65 #define doc_open android_open_asset
66 #define doc_read_quit android_asset_read_quit
67 #define doc_lseek android_asset_lseek
68 #define USE_ANDROID_ASSETS
69 #endif
70
71
72
73
74 static char *get_doc_string_buffer;
75 static ptrdiff_t get_doc_string_buffer_size;
76
77 static unsigned char *read_bytecode_pointer;
78
79 static char const sibling_etc[] = "../etc/";
80
81
82
83
84 int
85 read_bytecode_char (bool unreadflag)
86 {
87 if (unreadflag)
88 {
89 read_bytecode_pointer--;
90 return 0;
91 }
92 return *read_bytecode_pointer++;
93 }
94
95 #ifdef USE_ANDROID_ASSETS
96
97
98
99
100 static void
101 close_file_unwind_android_fd (void *ptr)
102 {
103 struct android_fd_or_asset *fd;
104
105 fd = ptr;
106 android_close_asset (*fd);
107 }
108
109 #endif
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130 Lisp_Object
131 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
132 {
133 char *from, *to, *name, *p, *p1;
134 Lisp_Object file, pos;
135 specpdl_ref count = SPECPDL_INDEX ();
136 Lisp_Object dir;
137 USE_SAFE_ALLOCA;
138
139 if (FIXNUMP (filepos))
140 {
141 file = Vdoc_file_name;
142 dir = Vdoc_directory;
143 pos = filepos;
144 }
145 else if (CONSP (filepos))
146 {
147 file = XCAR (filepos);
148 dir = Fsymbol_value (Qlisp_directory);
149 pos = XCDR (filepos);
150 }
151 else
152 return Qnil;
153
154 EMACS_INT position = eabs (XFIXNUM (pos));
155
156 if (!STRINGP (dir))
157 return Qnil;
158
159 if (!STRINGP (file))
160 return Qnil;
161
162
163
164
165 Lisp_Object tem = Ffile_name_absolute_p (file);
166 file = ENCODE_FILE (file);
167 Lisp_Object docdir
168 = NILP (tem) ? ENCODE_FILE (dir) : empty_unibyte_string;
169 ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
170 if (will_dump_p ())
171 docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
172 name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
173 lispstpcpy (lispstpcpy (name, docdir), file);
174
175 doc_fd fd = doc_open (name, O_RDONLY, 0);
176 if (!doc_fd_p (fd))
177 {
178 if (will_dump_p ())
179 {
180
181
182 lispstpcpy (stpcpy (name, sibling_etc), file);
183
184 fd = doc_open (name, O_RDONLY, 0);
185 }
186 if (!doc_fd_p (fd))
187 {
188 if (errno != ENOENT && errno != ENOTDIR)
189 report_file_error ("Read error on documentation file", file);
190
191 SAFE_FREE ();
192 AUTO_STRING (cannot_open, "Cannot open doc string file \"");
193 AUTO_STRING (quote_nl, "\"\n");
194 return concat3 (cannot_open, file, quote_nl);
195 }
196 }
197 #ifndef USE_ANDROID_ASSETS
198 record_unwind_protect_int (close_file_unwind, fd);
199 #else
200 record_unwind_protect_ptr (close_file_unwind_android_fd, &fd);
201 #endif
202
203
204
205
206 int offset = min (position, max (1024, position % (8 * 1024)));
207 if (TYPE_MAXIMUM (off_t) < position
208 || doc_lseek (fd, position - offset, 0) < 0)
209 error ("Position %"pI"d out of range in doc string file \"%s\"",
210 position, name);
211
212
213
214
215 p = get_doc_string_buffer;
216 while (1)
217 {
218 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
219 - (p - get_doc_string_buffer));
220
221
222 if (space_left <= 0)
223 {
224 ptrdiff_t in_buffer = p - get_doc_string_buffer;
225 get_doc_string_buffer
226 = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
227 16 * 1024, -1, 1);
228 p = get_doc_string_buffer + in_buffer;
229 space_left = (get_doc_string_buffer_size - 1
230 - (p - get_doc_string_buffer));
231 }
232
233
234
235 if (space_left > 1024 * 8)
236 space_left = 1024 * 8;
237 int nread = doc_read_quit (fd, p, space_left);
238 if (nread < 0)
239 report_file_error ("Read error on documentation file", file);
240 p[nread] = 0;
241 if (!nread)
242 break;
243 if (p == get_doc_string_buffer)
244 p1 = strchr (p + offset, '\037');
245 else
246 p1 = strchr (p, '\037');
247 if (p1)
248 {
249 *p1 = 0;
250 p = p1;
251 break;
252 }
253 p += nread;
254 }
255 SAFE_FREE_UNBIND_TO (count, Qnil);
256
257
258 if (CONSP (filepos))
259 {
260 int test = 1;
261
262
263
264 if (get_doc_string_buffer[offset - test] != '\037')
265 {
266 if (get_doc_string_buffer[offset - test++] != ' ')
267 return Qnil;
268 while (get_doc_string_buffer[offset - test] >= '0'
269 && get_doc_string_buffer[offset - test] <= '9')
270 test++;
271 if (get_doc_string_buffer[offset - test++] != '@'
272 || get_doc_string_buffer[offset - test] != '#')
273 return Qnil;
274 }
275 }
276 else
277 {
278 int test = 1;
279 if (get_doc_string_buffer[offset - test++] != '\n')
280 return Qnil;
281 while (get_doc_string_buffer[offset - test] > ' ')
282 test++;
283 if (get_doc_string_buffer[offset - test] != '\037')
284 return Qnil;
285 }
286
287
288
289 from = get_doc_string_buffer + offset;
290 to = get_doc_string_buffer + offset;
291 while (from != p)
292 {
293 if (*from == 1)
294 {
295 from++;
296 int c = *from++;
297 if (c == 1)
298 *to++ = c;
299 else if (c == '0')
300 *to++ = 0;
301 else if (c == '_')
302 *to++ = 037;
303 else
304 {
305 unsigned char uc = c;
306 error ("\
307 Invalid data in documentation file -- %c followed by code %03o",
308 1, uc);
309 }
310 }
311 else
312 *to++ = *from++;
313 }
314
315
316
317 if (definition)
318 {
319 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
320 return Fread (Qlambda);
321 }
322
323 if (unibyte)
324 return make_unibyte_string (get_doc_string_buffer + offset,
325 to - (get_doc_string_buffer + offset));
326 else
327 {
328
329 ptrdiff_t nchars
330 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
331 + offset),
332 to - (get_doc_string_buffer + offset));
333 return make_string_from_bytes (get_doc_string_buffer + offset,
334 nchars,
335 to - (get_doc_string_buffer + offset));
336 }
337 }
338
339
340
341
342
343 Lisp_Object
344 read_doc_string (Lisp_Object filepos)
345 {
346 return get_doc_string (filepos, 0, 1);
347 }
348
349 static bool
350 reread_doc_file (Lisp_Object file)
351 {
352 if (NILP (file))
353 Fsnarf_documentation (Vdoc_file_name);
354 else
355 save_match_data_load (file, Qt, Qt, Qt, Qnil);
356
357 return 1;
358 }
359
360 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
361 doc:
362
363 )
364 (Lisp_Object function, Lisp_Object raw)
365 {
366 Lisp_Object doc;
367 bool try_reload = true;
368
369 documentation:
370
371 doc = Qnil;
372
373 if (SYMBOLP (function))
374 {
375 Lisp_Object tem = Fget (function, Qfunction_documentation);
376 if (!NILP (tem))
377 return Fdocumentation_property (function, Qfunction_documentation,
378 raw);
379 }
380
381 Lisp_Object fun = Findirect_function (function, Qnil);
382 if (NILP (fun))
383 xsignal1 (Qvoid_function, function);
384 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
385 fun = XCDR (fun);
386 doc = call1 (Qfunction_documentation, fun);
387
388
389
390 if (BASE_EQ (doc, make_fixnum (0)))
391 doc = Qnil;
392 if (FIXNUMP (doc) || CONSP (doc))
393 {
394 Lisp_Object tem;
395 tem = get_doc_string (doc, 0, 0);
396 if (NILP (tem) && try_reload)
397 {
398
399 try_reload = reread_doc_file (Fcar_safe (doc));
400 if (try_reload)
401 {
402 try_reload = false;
403 goto documentation;
404 }
405 }
406 else
407 doc = tem;
408 }
409
410 if (NILP (raw))
411 doc = call1 (Qsubstitute_command_keys, doc);
412 return doc;
413 }
414
415 DEFUN ("internal-subr-documentation", Fsubr_documentation, Ssubr_documentation, 1, 1, 0,
416 doc: )
417 (Lisp_Object function)
418 {
419 #ifdef HAVE_NATIVE_COMP
420 if (!NILP (Fsubr_native_elisp_p (function)))
421 return native_function_doc (function);
422 else
423 #endif
424 if (SUBRP (function))
425 return make_fixnum (XSUBR (function)->doc);
426 #ifdef HAVE_MODULES
427 else if (MODULE_FUNCTIONP (function))
428 return module_function_documentation (XMODULE_FUNCTION (function));
429 #endif
430 else
431 return Qt;
432 }
433
434 DEFUN ("documentation-property", Fdocumentation_property,
435 Sdocumentation_property, 2, 3, 0,
436 doc:
437
438
439
440
441
442 )
443 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
444 {
445 bool try_reload = true;
446 Lisp_Object tem;
447
448 documentation_property:
449
450 tem = Fget (symbol, prop);
451
452
453
454
455 if (EQ (prop, Qvariable_documentation)
456 && NILP (tem))
457 {
458 Lisp_Object indirect = Findirect_variable (symbol);
459 if (!NILP (indirect))
460 tem = Fget (indirect, prop);
461 }
462
463 if (BASE_EQ (tem, make_fixnum (0)))
464 tem = Qnil;
465
466
467 if (FIXNUMP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem))))
468 {
469 Lisp_Object doc = tem;
470 tem = get_doc_string (tem, 0, 0);
471 if (NILP (tem) && try_reload)
472 {
473
474 try_reload = reread_doc_file (Fcar_safe (doc));
475 if (try_reload)
476 {
477 try_reload = false;
478 goto documentation_property;
479 }
480 }
481 }
482 else if (!STRINGP (tem))
483
484 tem = Feval (tem, Qnil);
485
486 if (NILP (raw) && STRINGP (tem))
487 tem = call1 (Qsubstitute_command_keys, tem);
488 return tem;
489 }
490
491
492
493 static void
494 store_function_docstring (Lisp_Object obj, EMACS_INT offset)
495 {
496
497
498 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->u.s.function : obj;
499
500
501
502
503 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
504 fun = XCDR (fun);
505 if (CONSP (fun))
506 {
507 Lisp_Object tem = XCAR (fun);
508 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
509 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
510 {
511 tem = Fcdr (Fcdr (fun));
512 if (CONSP (tem) && FIXNUMP (XCAR (tem)))
513
514
515 XSETCAR (tem, make_fixnum (offset));
516 }
517 }
518
519 else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
520 {
521 XSUBR (fun)->doc = offset;
522 }
523
524
525 else if (COMPILEDP (fun))
526 {
527
528
529 if (PVSIZE (fun) > COMPILED_DOC_STRING
530
531
532 && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING)))
533 ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset));
534 else
535 {
536 AUTO_STRING (format,
537 (PVSIZE (fun) > COMPILED_DOC_STRING
538 ? "Docstring slot busy for %s"
539 : "No docstring slot for %s"));
540 CALLN (Fmessage, format,
541 (SYMBOLP (obj)
542 ? SYMBOL_NAME (obj)
543 : build_string ("<anonymous>")));
544 }
545 }
546 }
547
548
549 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
550 1, 1, 0,
551 doc:
552
553
554
555
556
557 )
558 (Lisp_Object filename)
559 {
560 doc_fd fd;
561 char buf[1024 + 1];
562 int filled;
563 EMACS_INT pos;
564 Lisp_Object sym;
565 char *p, *name;
566 char const *dirname;
567 ptrdiff_t dirlen;
568
569
570 Lisp_Object delayed_init =
571 find_symbol_value (intern ("custom-delayed-init-variables"));
572
573 if (!CONSP (delayed_init)) delayed_init = Qnil;
574
575 CHECK_STRING (filename);
576
577 if (will_dump_p ())
578 {
579 dirname = sibling_etc;
580 dirlen = sizeof sibling_etc - 1;
581 }
582 else
583 {
584 CHECK_STRING (Vdoc_directory);
585 dirname = SSDATA (Vdoc_directory);
586 dirlen = SBYTES (Vdoc_directory);
587 }
588
589 specpdl_ref count = SPECPDL_INDEX ();
590 USE_SAFE_ALLOCA;
591 name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
592 lispstpcpy (stpcpy (name, dirname), filename);
593
594
595 if (NILP (Vbuild_files))
596 {
597 static char const *const buildobj[] =
598 {
599 #include "buildobj.h"
600 };
601 int i = ARRAYELTS (buildobj);
602 while (0 <= --i)
603 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
604 Vbuild_files = Fpurecopy (Vbuild_files);
605 }
606
607 fd = doc_open (name, O_RDONLY, 0);
608 if (!doc_fd_p (fd))
609 {
610 int open_errno = errno;
611 report_file_errno ("Opening doc string file", build_string (name),
612 open_errno);
613 }
614 #ifndef USE_ANDROID_ASSETS
615 record_unwind_protect_int (close_file_unwind, fd);
616 #else
617 record_unwind_protect_ptr (close_file_unwind_android_fd, &fd);
618 #endif
619 Vdoc_file_name = filename;
620 filled = 0;
621 pos = 0;
622 while (true)
623 {
624 if (filled < 512)
625 filled += doc_read_quit (fd, &buf[filled], sizeof buf - 1 - filled);
626 if (!filled)
627 break;
628
629 buf[filled] = 0;
630 char *end = buf + (filled < 512 ? filled : filled - 128);
631 p = memchr (buf, '\037', end - buf);
632
633 if (p)
634 {
635 end = strchr (p, '\n');
636 if (!end)
637 error ("DOC file invalid at position %"pI"d", pos);
638
639
640
641
642
643
644
645
646
647
648
649
650 sym = oblookup (Vobarray, p + 2,
651 multibyte_chars_in_text ((unsigned char *) p + 2,
652 end - p - 2),
653 end - p - 2);
654
655
656 if (SYMBOLP (sym))
657 {
658
659 if (p[1] == 'V')
660 {
661
662
663
664 if ((!NILP (Fboundp (sym))
665 || !NILP (Fmemq (sym, delayed_init)))
666 && strncmp (end, "\nSKIP", 5))
667 Fput (sym, Qvariable_documentation,
668 make_fixnum ((pos + end + 1 - buf)
669 * (end[1] == '*' ? -1 : 1)));
670 }
671
672
673 else if (p[1] == 'F')
674 {
675 if (!NILP (Ffboundp (sym)) && strncmp (end, "\nSKIP", 5))
676 store_function_docstring (sym, pos + end + 1 - buf);
677 }
678 else if (p[1] == 'S')
679 ;
680
681 else
682 error ("DOC file invalid at position %"pI"d", pos);
683 }
684 }
685 pos += end - buf;
686 filled -= end - buf;
687 memmove (buf, end, filled);
688 }
689
690 return SAFE_FREE_UNBIND_TO (count, Qnil);
691 }
692
693
694 static bool
695 default_to_grave_quoting_style (void)
696 {
697 if (!text_quoting_flag)
698 return true;
699 if (! DISP_TABLE_P (Vstandard_display_table))
700 return false;
701 Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
702 LEFT_SINGLE_QUOTATION_MARK);
703 return (VECTORP (dv) && ASIZE (dv) == 1
704 && BASE_EQ (AREF (dv, 0), make_fixnum ('`')));
705 }
706
707 DEFUN ("text-quoting-style", Ftext_quoting_style,
708 Stext_quoting_style, 0, 0, 0,
709 doc:
710
711
712
713
714
715
716
717 )
718 (void)
719 {
720
721 if (NILP (Vtext_quoting_style)
722 ? default_to_grave_quoting_style ()
723 : EQ (Vtext_quoting_style, Qgrave))
724 return Qgrave;
725
726
727 else if (EQ (Vtext_quoting_style, Qstraight))
728 return Qstraight;
729
730
731 else
732 return Qcurve;
733 }
734
735
736 void
737 syms_of_doc (void)
738 {
739 DEFSYM (Qlisp_directory, "lisp-directory");
740 DEFSYM (Qsubstitute_command_keys, "substitute-command-keys");
741 DEFSYM (Qfunction_documentation, "function-documentation");
742 DEFSYM (Qgrave, "grave");
743 DEFSYM (Qstraight, "straight");
744 DEFSYM (Qcurve, "curve");
745
746 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
747 doc: );
748 Vdoc_file_name = Qnil;
749
750 DEFVAR_LISP ("build-files", Vbuild_files,
751 doc: );
752 Vbuild_files = Qnil;
753
754 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style,
755 doc:
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772 );
773 Vtext_quoting_style = Qnil;
774
775 DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag,
776 doc: );
777
778
779 defsubr (&Sdocumentation);
780 defsubr (&Ssubr_documentation);
781 defsubr (&Sdocumentation_property);
782 defsubr (&Ssnarf_documentation);
783 defsubr (&Stext_quoting_style);
784 }