aboutsummaryrefslogtreecommitdiffstats
path: root/src/doc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/doc.c')
-rw-r--r--src/doc.c58
1 files changed, 20 insertions, 38 deletions
diff --git a/src/doc.c b/src/doc.c
index a451b468ef2..b5a9ed498af 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file)
357 return 1; 357 return 1;
358} 358}
359 359
360DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp,
361 1, 1, 0,
362 doc: /* Return non-nil if OBJECT is a well-formed docstring object.
363OBJECT can be either a string or a reference if it's kept externally. */)
364 (Lisp_Object object)
365{
366 return (STRINGP (object)
367 || FIXNUMP (object) /* Reference to DOC. */
368 || (CONSP (object) /* Reference to .elc. */
369 && STRINGP (XCAR (object))
370 && FIXNUMP (XCDR (object)))
371 ? Qt : Qnil);
372}
373
360DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, 374DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
361 doc: /* Return the documentation string of FUNCTION. 375 doc: /* Return the documentation string of FUNCTION.
362Unless a non-nil second argument RAW is given, the 376Unless a non-nil second argument RAW is given, the
@@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
502 /* If it's a lisp form, stick it in the form. */ 516 /* If it's a lisp form, stick it in the form. */
503 if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) 517 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
504 fun = XCDR (fun); 518 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 /* FIXME: This modifies typically pure hash-cons'd data, so its
514 correctness is quite delicate. */
515 XSETCAR (tem, make_fixnum (offset));
516 }
517 }
518 /* Lisp_Subrs have a slot for it. */ 519 /* Lisp_Subrs have a slot for it. */
519 else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) 520 if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
520 { 521 XSUBR (fun)->doc = offset;
521 XSUBR (fun)->doc = offset; 522 else
522 }
523
524 /* Bytecode objects sometimes have slots for it. */
525 else if (COMPILEDP (fun))
526 { 523 {
527 /* This bytecode object must have a slot for the 524 AUTO_STRING (format, "Ignoring DOC string on non-subr: %S");
528 docstring, since we've found a docstring for it. */ 525 CALLN (Fmessage, format, obj);
529 if (PVSIZE (fun) > COMPILED_DOC_STRING
530 /* Don't overwrite a non-docstring value placed there,
531 * such as the symbols used for Oclosures. */
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 } 526 }
546} 527}
547 528
@@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case. */);
776 doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); 757 doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */);
777 /* Initialized by ‘main’. */ 758 /* Initialized by ‘main’. */
778 759
760 defsubr (&Sdocumentation_stringp);
779 defsubr (&Sdocumentation); 761 defsubr (&Sdocumentation);
780 defsubr (&Ssubr_documentation); 762 defsubr (&Ssubr_documentation);
781 defsubr (&Sdocumentation_property); 763 defsubr (&Sdocumentation_property);