cgit.sxemacs.org Git - sxemacs/blob - src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2    Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995
   3    Free Software Foundation, Inc.
   4
   5 This file is part of SXEmacs
   6
   7 SXEmacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 SXEmacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  19
  20
  21 /* Synched up with: FSF 19.30. */
  22
  23 /* This file has been Mule-ized except as noted. */
  24
  25 #include <config.h>
  26 #include "lisp.h"
  27
  28 #include "buffer.h"
  29 #include "bytecode.h"
  30 #include "ui/insdel.h"
  31 #include "ui/keymap.h"
  32 #include "sysfile.h"
  33
  34 Lisp_Object Vinternal_doc_file_name;
  35 Lisp_Object Vinternal_doc_fd;
  36
  37 Lisp_Object QSsubstitute, Qdefvar;
  38
  39 #ifdef WITH_PDUMP
  40 extern unsigned int dump_id;
  41 #endif
  42
  43 /* Work out what source file a function or variable came from, taking the
  44    information from the documentation file. */
  45
  46 static Lisp_Object extract_object_file_name (int fd, EMACS_INT doc_pos,
  47                                              SBufbyte *name_nonreloc,
  48                                              Lisp_Object name_reloc,
  49                                              int standard_doc_file)
  50 {
  51         Bufbyte buf[DOC_MAX_FILENAME_LENGTH+1];
  52         Bufbyte *buffer = buf;
  53         int buffer_size = sizeof (buf) - 1, space_left;
  54         Bufbyte *from, *to;
  55         REGISTER Bufbyte *p = buffer;
  56         Lisp_Object return_me;
  57         EMACS_INT position, seenS = 0;
  58
  59         position = doc_pos > buffer_size  ?
  60                 doc_pos - buffer_size : 0;
  61
  62         if (0 > lseek (fd, position, 0)) {
  63                 if (name_nonreloc)
  64                         name_reloc = build_string (name_nonreloc);
  65                 return_me = list3 (build_string
  66                                    ("Position out of range in doc string file"),
  67                                    name_reloc, make_int (position));
  68                 goto done;
  69         }
  70
  71         space_left = buffer_size - (p - buffer);
  72         while (space_left > 0) {
  73                 int nread;
  74
  75                 nread = read (fd, p, space_left);
  76                 if (nread < 0) {
  77                         return_me
  78                                 = list1 (build_string
  79                                          ("Read error on documentation file"));
  80                         goto done;
  81                 }
  82
  83                 p[nread] = 0;
  84
  85                 if (!nread)
  86                         break;
  87
  88                 p += nread;
  89                 space_left = buffer_size - (p - buffer);
  90         }
  91
  92         /* First, search backward for the "\037S" that marks the beginning
  93            of the file name, then search forward from that to the newline or
  94            to the end of the buffer. */
  95         from = p;
  96
  97         while (from > buf) {
  98                 --from;
  99                 if (seenS) {
 100                         if ('\037' == *from) {
 101
 102                                 /* Got a file name; adjust `from' to point
 103                                    to it, break out of the loop.  */
 104                                 from += 2;
 105                                 break;
 106                         }
 107                 }
 108                 /* Is *from 'S' ? */
 109                 seenS = ('S' == *from);
 110         }
 111
 112         if (buf == from) {
 113                 /* We've scanned back to the beginning of the buffer without
 114                    hitting the file name. Either the file name plus the
 115                    symbol name is longer than DOC_MAX_FILENAME_LENGTH--which
 116                    shouldn't happen, because it'll trigger an assertion
 117                    failure in make-docfile, the DOC file is corrupt, or it
 118                    was produced by a version of make-docfile that doesn't
 119                    store the file name with the symbol name and
 120                    docstring.  */
 121                 return_me = list1 (build_string
 122                                    ("Object file name not stored in doc file"));
 123                 goto done;
 124         }
 125
 126         to = from;
 127         /* Search for the end of the file name. */
 128         while (++to < p) {
 129                 if ('\n' == *to || '\037' == *to) {
 130                         break;
 131                 }
 132         }
 133
 134         /* Don't require the file name to end in a newline. */
 135         return_me = make_string (from, to - from);
 136
 137 done:
 138
 139         return return_me;
 140 }
 141
 142 /* Read and return doc string from open file descriptor FD
 143    at position POSITION.  Does not close the file.  Returns
 144    string; or if error, returns a cons holding the error
 145    data to pass to Fsignal.  NAME_NONRELOC and NAME_RELOC
 146    are only used for the error messages. */
 147
 148 Lisp_Object
 149 unparesseuxify_doc_string(int fd, EMACS_INT position,
 150                           char *name_nonreloc, Lisp_Object name_reloc)
 151 {
 152         char buf[512 * 8 + 1];
 153         char *buffer = buf;
 154         int buffer_size = sizeof(buf)-1;
 155         char *from, *to;
 156         REGISTER char *p = buffer;
 157         Lisp_Object return_me;
 158
 159         if (0 > lseek(fd, position, 0)) {
 160                 if (name_nonreloc)
 161                         name_reloc = build_string(name_nonreloc);
 162                 return_me = list3(build_string
 163                                   ("Position out of range in doc string file"),
 164                                   name_reloc, make_int(position));
 165                 goto done;
 166         }
 167
 168         /* Read the doc string into a buffer.
 169            Use the fixed buffer BUF if it is big enough; otherwise allocate one.
 170            We store the buffer in use in BUFFER and its size in BUFFER_SIZE.  */
 171
 172         while (1) {
 173                 int space_left = buffer_size - (p - buffer);
 174                 int nread;
 175
 176                 /* Switch to a bigger buffer if we need one.  */
 177                 if (space_left == 0) {
 178                         char *old_buffer = buffer;
 179                         buffer_size *= 2;
 180                         if (buffer == buf) {
 181                                 buffer = (char*)xmalloc_atomic(buffer_size + 1);
 182                                 memcpy(buffer, old_buffer, p - old_buffer);
 183                         } else {
 184                                 char *foo = xrealloc(buffer, buffer_size + 1);
 185                                 buffer = foo;
 186                         }
 187                         p += buffer - old_buffer;
 188                         space_left = buffer_size - (p - buffer);
 189                 }
 190
 191                 /* Don't read too much at one go.  */
 192                 if (space_left > 1024 * 8)
 193                         space_left = 1024 * 8;
 194                 nread = read(fd, p, space_left);
 195                 if (nread < 0) {
 196                         return_me = list1(build_string
 197                                           ("Read error on documentation file"));
 198                         goto done;
 199                 }
 200                 p[nread] = 0;
 201                 if (!nread)
 202                         break;
 203                 {
 204                         char *p1 = strchr(p, '\037');   /* End of doc string marker */
 205                         if (p1) {
 206                                 *p1 = 0;
 207                                 p = p1;
 208                                 break;
 209                         }
 210                 }
 211                 p += nread;
 212         }
 213
 214         /* Scan the text and remove quoting with ^A (char code 1).
 215            ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 216         from = to = buffer;
 217         while (from < p) {
 218                 if (*from != 1 /*^A */ )
 219                         *to++ = *from++;
 220                 else {
 221                         int c = *(++from);
 222
 223                         from++;
 224                         switch (c) {
 225                         case 1:
 226                                 *to++ = c;
 227                                 break;
 228                         case '0':
 229                                 *to++ = '\0';
 230                                 break;
 231                         case '_':
 232                                 *to++ = '\037';
 233                                 break;
 234                         default:
 235                                 return_me = list2(build_string
 236                                                   ("Invalid data in documentation file -- ^A followed by weird code"),
 237                                                   make_int(c));
 238                                 goto done;
 239                         }
 240                 }
 241         }
 242
 243         /* #### mrb: following STILL completely broken */
 244         return_me = make_ext_string(buffer, to - buffer, Qbinary);
 245
 246       done:
 247         if (buffer != buf)      /* We must have allocated buffer above */
 248                 xfree(buffer);
 249         return return_me;
 250 }
 251
 252 #define string_join(dest, s1, s2) \
 253   memcpy ((void *) dest, (void *) XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
 254   memcpy ((void *) ((Bufbyte *) dest + XSTRING_LENGTH (s1)), \
 255           (void *) XSTRING_DATA (s2), XSTRING_LENGTH (s2));  \
 256           dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
 257
 258 /* Extract a doc string from a file.  FILEPOS says where to get it.
 259    (This could actually be byte code instructions/constants instead
 260    of a doc string.)
 261    If it is an integer, use that position in the standard DOC file.
 262    If it is (FILE . INTEGER), use FILE as the file name
 263    and INTEGER as the position in that file.
 264    But if INTEGER is negative, make it positive.
 265    (A negative integer is used for user variables, so we can distinguish
 266    them without actually fetching the doc string.)  */
 267
 268 static Lisp_Object
 269 get_doc_string(Lisp_Object filepos)
 270 {
 271         /* !!#### This function has not been Mule-ized */
 272         REGISTER int fd = -1;
 273         REGISTER char *name_nonreloc = 0;
 274         EMACS_INT position;
 275         Lisp_Object file, tem;
 276         Lisp_Object name_reloc = Qnil;
 277
 278         if (INTP(filepos)) {
 279                 file = Vinternal_doc_file_name;
 280                 position = XINT(filepos);
 281                 if ( INTP(Vinternal_doc_fd) )
 282                         fd = XINT(Vinternal_doc_fd);
 283                 else
 284                         fd = -2;
 285         } else if (CONSP(filepos) && INTP(XCDR(filepos))) {
 286                 file = XCAR(filepos);
 287                 position = XINT(XCDR(filepos));
 288                 if (position < 0)
 289                         position = -position;
 290         } else
 291                 return Qnil;
 292
 293         if (!STRINGP(file))
 294                 return Qnil;
 295
 296         if ( fd < 0 ) {
 297                 int ofd;
 298
 299                 /* Put the file name in NAME as a C string.
 300                    If it is relative, combine it with Vdoc_directory.  */
 301
 302                 tem = Ffile_name_absolute_p(file);
 303                 if (NILP(tem)) {
 304                         size_t minsize;
 305                         /* XEmacs: Move this check here.  OK if called during loadup to
 306                            load byte code instructions. */
 307                         if (!STRINGP(Vdoc_directory))
 308                                 return Qnil;
 309
 310                         minsize = XSTRING_LENGTH(Vdoc_directory);
 311                         /* sizeof ("./") == 3 */
 312                         if (minsize < 3)
 313                                 minsize = 3;
 314                         name_nonreloc =
 315                                 (char *)alloca(minsize + XSTRING_LENGTH(file) + 8);
 316                         string_join(name_nonreloc, Vdoc_directory, file);
 317                 } else
 318                         name_reloc = file;
 319
 320                 ofd = open(name_nonreloc ? name_nonreloc :
 321                            (char *)XSTRING_DATA(name_reloc), O_RDONLY | OPEN_BINARY, 0);
 322                 if ( fd == -2 )
 323                         Vinternal_doc_fd = make_int(ofd);
 324                 fd = ofd;
 325         }
 326         if (fd < 0) {
 327 #ifndef CANNOT_DUMP
 328                 if (purify_flag) {
 329                         /* sizeof ("./") == 3 */
 330                         name_nonreloc =
 331                             (char *)alloca(3 + XSTRING_LENGTH(file) + 8);
 332                         /* Preparing to dump; DOC file is probably not installed.
 333                            So check in ../lib-src. */
 334                         strcpy(name_nonreloc, "./");
 335                         strcat(name_nonreloc, (char *)XSTRING_DATA(file));
 336
 337                         fd = open(name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
 338                 }
 339 #endif                          /* CANNOT_DUMP */
 340
 341                 if (fd < 0)
 342                         error("Cannot open doc string file \"%s\"",
 343                               name_nonreloc ? name_nonreloc :
 344                               (char *)XSTRING_DATA(name_reloc));
 345         }
 346
 347         tem =
 348             unparesseuxify_doc_string(fd, position, name_nonreloc, name_reloc);
 349         if (!INTP(Vinternal_doc_fd) || (fd != XINT(Vinternal_doc_fd))) {
 350                 Vinternal_doc_fd = make_int(-2);
 351                 close(fd);
 352         } else
 353                 lseek(fd,0,0);
 354
 355
 356         if (!STRINGP(tem))
 357                 signal_error(Qerror, tem);
 358
 359         return tem;
 360 }
 361
 362 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 363    We use this for fetching the bytecode string and constants vector
 364    of a compiled function from the .elc file.  */
 365
 366 Lisp_Object read_doc_string(Lisp_Object filepos)
 367 {
 368         Lisp_Object string = get_doc_string(filepos);
 369
 370         if (!STRINGP(string))
 371                 signal_simple_error("loading bytecode failed to return string",
 372                                     string);
 373         return Fread(string);
 374 }
 375
 376 static Lisp_Object get_object_file_name (Lisp_Object filepos) {
 377         REGISTER int fd = -1;
 378         REGISTER SBufbyte *name_nonreloc = 0;
 379         EMACS_INT position;
 380         Lisp_Object file, tem;
 381         Lisp_Object name_reloc = Qnil;
 382         int standard_doc_file = 0;
 383
 384         if (INTP (filepos)) {
 385                 file = Vinternal_doc_file_name;
 386                 standard_doc_file = 1;
 387                 position = XINT (filepos);
 388                 if ( INTP(Vinternal_doc_fd) )
 389                         fd = XINT(Vinternal_doc_fd);
 390                 else
 391                         fd = -2;
 392         } else if (CONSP (filepos) && INTP (XCDR (filepos))) {
 393                 file = XCAR (filepos);
 394                 position = XINT (XCDR (filepos));
 395                 if (position < 0)
 396                         position = - position;
 397         } else return Qnil;
 398
 399         if (!STRINGP (file))
 400                 return Qnil;
 401
 402         /* Put the file name in NAME as a C string.
 403            If it is relative, combine it with Vdoc_directory.  */
 404
 405         tem = Ffile_name_absolute_p (file);
 406         if (NILP (tem)) {
 407                 Bytecount minsize;
 408                 /* XEmacs: Move this check here.  OK if called during loadup to
 409                    load byte code instructions. */
 410                 if (!STRINGP (Vdoc_directory))
 411                         return Qnil;
 412
 413                 minsize = XSTRING_LENGTH (Vdoc_directory);
 414                 /* sizeof ("../lib-src/") == 12 */
 415                 if (minsize < 12)
 416                         minsize = 12;
 417                 name_nonreloc = alloca_array (SBufbyte,
 418                                               minsize +
 419                                               XSTRING_LENGTH (file) + 8);
 420                 string_join (name_nonreloc, Vdoc_directory, file);
 421         } else name_reloc = file;
 422
 423         if (fd < 0) {
 424                 int ofd;
 425
 426                 if (purify_flag) {
 427                         /* sizeof ("../lib-src/") == 12 */
 428                         name_nonreloc
 429                                 = alloca_array (SBufbyte,
 430                                                 12 + XSTRING_LENGTH (file) + 8);
 431                         /* Preparing to dump; DOC file is probably not
 432                            installed.  So check in ../lib-src. */
 433
 434                         strcpy (name_nonreloc, "../lib-src/");
 435                         strcat (name_nonreloc, (char *)XSTRING_DATA (file));
 436
 437                         fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
 438                 }
 439
 440                 ofd = open (name_nonreloc ? name_nonreloc :
 441                             (char *)XSTRING_DATA (name_reloc),
 442                             O_RDONLY | OPEN_BINARY, 0);
 443
 444                 if (fd == -2)
 445                         Vinternal_doc_fd = make_int (ofd);
 446                 fd = ofd;
 447         }
 448         if (fd < 0) {
 449                 report_file_error ("Cannot open doc string file",
 450                                    name_nonreloc ?
 451                                    build_string (name_nonreloc) :
 452                                    name_reloc);
 453         }
 454
 455         tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc,
 456                                         standard_doc_file);
 457         if (!INTP(Vinternal_doc_fd) || (fd != XINT(Vinternal_doc_fd))) {
 458                 Vinternal_doc_fd = make_int(-2);
 459                 close(fd);
 460         } else
 461                 lseek(fd,0,0);
 462
 463         if (!STRINGP (tem))
 464                 signal_error (Qinvalid_byte_code, tem);
 465
 466         return tem;
 467 }
 468
 469 \f
 470 static void
 471 weird_doc(Lisp_Object sym, const char *weirdness, const char *type, int pos)
 472 {
 473         if (!strcmp(weirdness, GETTEXT("duplicate")))
 474                 return;
 475         message("Note: Strange doc (%s) for %s %s @ %d",
 476                 weirdness, type, string_data(XSYMBOL(sym)->name), pos);
 477 }
 478
 479 DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 2, 0, /*
 480 Return the C source file built-in symbol SYM comes from.
 481 Don't use this.  Use the more general `symbol-file' (q.v.) instead.
 482
 483 If TYPE is nil or omitted, any kind of definition is acceptable.
 484 If TYPE is `defun', then function, subr, special form or macro definitions
 485 are acceptable.
 486 If TYPE is `defvar', then variable definitions are acceptable.
 487 */
 488        (symbol, type))
 489 {
 490         /* This function can GC */
 491         Lisp_Object fun;
 492         Lisp_Object filename = Qnil;
 493
 494         if (EQ(Ffboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefun))) {
 495                 fun = Findirect_function (symbol);
 496
 497                 if (SUBRP (fun) || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun)))
 498                                     && (fun = Fcdr_safe (fun), SUBRP (fun)))) {
 499                         if (XSUBR (fun)->doc == 0)
 500                                 return Qnil;
 501
 502                         if ((EMACS_INT) XSUBR (fun)->doc >= 0) {
 503                                 weird_doc
 504                                         (symbol,
 505                                          "No file info available for function",
 506                                          GETTEXT("function"), 0);
 507                                 return Qnil;
 508                         } else {
 509                                 filename = get_object_file_name
 510                                         (make_int (-
 511                                                    (EMACS_INT)
 512                                                    XSUBR (fun)->doc));
 513                                 return filename;
 514                         }
 515                 }
 516
 517                 if (COMPILED_FUNCTIONP (fun)
 518                     || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun)))
 519                         && (fun = Fcdr_safe (fun),
 520                             COMPILED_FUNCTIONP (fun)))) {
 521                         Lisp_Object tem;
 522                         Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
 523
 524                         if (! (f->flags.documentationp))
 525                                 return Qnil;
 526                         tem = compiled_function_documentation (f);
 527                         if (NATNUMP (tem) || CONSP (tem)) {
 528                                 filename = get_object_file_name (tem);
 529                                 return filename;
 530                         }
 531                 }
 532         }
 533
 534         if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar))) {
 535                 Lisp_Object doc_offset
 536                         = Fget (symbol, Qvariable_documentation, Qnil);
 537
 538                 if (!NILP(doc_offset)) {
 539                         if (INTP(doc_offset)) {
 540                                 filename = get_object_file_name
 541                                         (XINT (doc_offset) > 0 ? doc_offset
 542                                          : make_int (- XINT (doc_offset)));
 543                         } else if (CONSP(doc_offset)) {
 544                                 filename = get_object_file_name(doc_offset);
 545                         }
 546                         return filename;
 547                 }
 548         }
 549         return Qnil;
 550 }
 551
 552 DEFUN("documentation", Fdocumentation, 1, 2, 0, /*
 553 Return the documentation string of FUNCTION.
 554 Unless a non-nil second argument RAW is given, the
 555 string is passed through `substitute-command-keys'.
 556 */
 557       (function, raw))
 558 {
 559         /* This function can GC */
 560         Lisp_Object fun;
 561         Lisp_Object doc;
 562
 563         fun = Findirect_function(function);
 564
 565         if (SUBRP(fun)) {
 566                 if (XSUBR(fun)->doc == 0)
 567                         return Qnil;
 568                 if ((EMACS_INT) XSUBR(fun)->doc >= 0)
 569                         doc = build_string(XSUBR(fun)->doc);
 570                 else
 571                         doc =
 572                             get_doc_string(make_int
 573                                            (-(EMACS_INT) XSUBR(fun)->doc));
 574         } else if (COMPILED_FUNCTIONP(fun)) {
 575                 Lisp_Object tem;
 576                 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION(fun);
 577                 if (!(f->flags.documentationp))
 578                         return Qnil;
 579                 tem = compiled_function_documentation(f);
 580                 if (STRINGP(tem))
 581                         doc = tem;
 582                 else if (NATNUMP(tem) || CONSP(tem))
 583                         doc = get_doc_string(tem);
 584                 else
 585                         return Qnil;
 586         } else if (KEYMAPP(fun))
 587                 return
 588                     build_translated_string
 589                     ("Prefix command (definition is a keymap of subcommands).");
 590         else if (STRINGP(fun) || VECTORP(fun))
 591                 return build_translated_string("Keyboard macro.");
 592         else if (CONSP(fun)) {
 593                 Lisp_Object funcar = Fcar(fun);
 594
 595                 if (!SYMBOLP(funcar))
 596                         return Fsignal(Qinvalid_function, list1(fun));
 597                 else if (EQ(funcar, Qlambda)
 598                          || EQ(funcar, Qautoload)) {
 599                         Lisp_Object tem, tem1;
 600                         tem1 = Fcdr(Fcdr(fun));
 601                         tem = Fcar(tem1);
 602                         if (STRINGP(tem))
 603                                 doc = tem;
 604                         /* Handle a doc reference--but these never come last
 605                            in the function body, so reject them if they are last.  */
 606                         else if ((NATNUMP(tem) || CONSP(tem))
 607                                  && !NILP(XCDR(tem1)))
 608                                 doc = get_doc_string(tem);
 609                         else
 610                                 return Qnil;
 611                 } else if (EQ(funcar, Qmacro))
 612                         return Fdocumentation(Fcdr(fun), raw);
 613                 else
 614                         goto oops;
 615         } else {
 616               oops:
 617                 return Fsignal(Qinvalid_function, list1(fun));
 618         }
 619
 620         if (NILP(raw)) {
 621                 struct gcpro gcpro1;
 622 #ifdef I18N3
 623                 Lisp_Object domain = Qnil;
 624                 if (COMPILED_FUNCTIONP(fun))
 625                         domain =
 626                             compiled_function_domain(XCOMPILED_FUNCTION(fun));
 627                 if (NILP(domain))
 628                         doc = Fgettext(doc);
 629                 else
 630                         doc = Fdgettext(domain, doc);
 631 #endif
 632
 633                 GCPRO1(doc);
 634                 doc = Fsubstitute_command_keys(doc);
 635                 UNGCPRO;
 636         }
 637         return doc;
 638 }
 639
 640 DEFUN("documentation-property", Fdocumentation_property, 2, 3, 0,       /*
 641 Return the documentation string that is SYMBOL's PROP property.
 642 This is like `get', but it can refer to strings stored in the
 643 `doc-directory/DOC' file; and if the value is a string, it is passed
 644 through `substitute-command-keys'.  A non-nil third argument avoids this
 645 translation.
 646 */
 647       (symbol, prop, raw))
 648 {
 649         /* This function can GC */
 650         REGISTER Lisp_Object doc = Qnil;
 651 #ifdef I18N3
 652         REGISTER Lisp_Object domain;
 653 #endif
 654         struct gcpro gcpro1;
 655
 656         GCPRO1(doc);
 657
 658         doc = Fget(symbol, prop, Qnil);
 659         if (INTP(doc))
 660                 doc =
 661                     get_doc_string(XINT(doc) > 0 ? doc : make_int(-XINT(doc)));
 662         else if (CONSP(doc))
 663                 doc = get_doc_string(doc);
 664 #ifdef I18N3
 665         if (!NILP(doc)) {
 666                 domain = Fget(symbol, Qvariable_domain, Qnil);
 667                 if (NILP(domain))
 668                         doc = Fgettext(doc);
 669                 else
 670                         doc = Fdgettext(domain, doc);
 671         }
 672 #endif
 673         if (NILP(raw) && STRINGP(doc))
 674                 doc = Fsubstitute_command_keys(doc);
 675         UNGCPRO;
 676         return doc;
 677 }
 678 \f
 679
 680 DEFUN("Snarf-documentation", Fsnarf_documentation, 1, 1, 0,     /*
 681 Used during Emacs initialization, before dumping runnable Emacs,
 682 to find pointers to doc strings stored in `.../lib-src/DOC' and
 683 record them in function definitions.
 684 One arg, FILENAME, a string which does not include a directory.
 685 The file is written to `../lib-src', and later found in `exec-directory'
 686 when doc strings are referred to in the dumped Emacs.
 687 */
 688       (filename))
 689 {
 690         /* !!#### This function has not been Mule-ized */
 691         int fd;
 692         char buf[1024 + 1];
 693         REGISTER int filled;
 694         REGISTER int pos;
 695         REGISTER char *p, *end;
 696         Lisp_Object sym, fun, tem;
 697         char *name;
 698
 699 #ifndef CANNOT_DUMP
 700         if (!purify_flag)
 701                 error("Snarf-documentation can only be called in an undumped "
 702                       "SXEmacs");
 703 #endif
 704
 705         CHECK_STRING(filename);
 706
 707 #ifdef CANNOT_DUMP
 708         if (!NILP(Vdoc_directory)) {
 709                 int alloca_sz = XSTRING_LENGTH(filename)
 710                         + XSTRING_LENGTH(Vdoc_directory) + 1 + 9;
 711                 int prt;
 712                 CHECK_STRING(Vdoc_directory);
 713                 name = (char *)alloca(alloca_sz);
 714                 prt = snprintf(name, alloca_sz, "%s%s",
 715                                (char*)XSTRING_DATA(Vdoc_directory),
 716                                (char*)XSTRING_DATA(filename));
 717                 assert(prt>=0 && prt < alloca_sz);
 718         } else
 719 #endif                          /* CANNOT_DUMP */
 720         {
 721                 int alloca_sz = 2 + XSTRING_LENGTH(filename) + 3 + 9 + 1;
 722                 int prt;
 723                 name = (char *)alloca(alloca_sz);
 724                 prt = snprintf(name, alloca_sz, "./%s",
 725                          (char*)XSTRING_DATA(filename));
 726                 assert(prt >= 0 && prt < alloca_sz);
 727         }
 728
 729         fd = open(name, O_RDONLY | OPEN_BINARY, 0);
 730         if (fd < 0)
 731                 report_file_error("Opening doc string file",
 732                                   Fcons(build_string(name), Qnil));
 733         Vinternal_doc_file_name = filename;
 734         filled = 0;
 735         pos = 0;
 736         while (1) {
 737                 if (filled < 512)
 738                         filled +=
 739                             read(fd, &buf[filled], sizeof buf - 1 - filled);
 740                 if (!filled)
 741                         break;
 742
 743                 buf[filled] = 0;
 744                 p = buf;
 745                 end = buf + (filled < 512 ? filled : filled - 128);
 746                 while (p != end && *p != '\037')
 747                         p++;
 748                 /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 749                 if (p != end) {
 750                         end = strchr(p, '\n');
 751                         sym =
 752                             oblookup(Vobarray, (Bufbyte *) p + 2, end - p - 2);
 753                         if (SYMBOLP(sym)) {
 754                                 Lisp_Object offset =
 755                                     make_int(pos + end + 1 - buf);
 756                                 /* Attach a docstring to a variable */
 757                                 if (p[1] == 'V') {
 758                                         /* Install file-position as variable-documentation property
 759                                            and make it negative for a user-variable
 760                                            (doc starts with a `*').  */
 761                                         Lisp_Object old =
 762                                             Fget(sym, Qvariable_documentation,
 763                                                  Qzero);
 764                                         if (!ZEROP(old)) {
 765                                                 weird_doc(sym,
 766                                                           GETTEXT("duplicate"),
 767                                                           GETTEXT("variable"),
 768                                                           pos);
 769                                                 /* In the case of duplicate doc file entries, always
 770                                                    take the later one.  But if the doc is not an int
 771                                                    (a string, say) leave it alone. */
 772                                                 if (!INTP(old))
 773                                                         goto weird;
 774                                         }
 775                                         Fput(sym, Qvariable_documentation,
 776                                              ((end[1] == '*')
 777                                               ? make_int(-XINT(offset))
 778                                               : offset));
 779                                 }
 780                                 /* Attach a docstring to a function.
 781                                    The type determines where the docstring is stored.  */
 782                                 else if (p[1] == 'F') {
 783                                         fun = indirect_function(sym, 0);
 784
 785                                         if (CONSP(fun) && EQ(XCAR(fun), Qmacro))
 786                                                 fun = XCDR(fun);
 787
 788                                         if (UNBOUNDP(fun)) {
 789                                                 /* May have been #if'ed out or something */
 790                                                 weird_doc(sym,
 791                                                           GETTEXT
 792                                                           ("not fboundp"),
 793                                                           GETTEXT("function"),
 794                                                           pos);
 795                                                 goto weird;
 796                                         } else if (SUBRP(fun)) {
 797                                                 /* Lisp_Subrs have a slot for it.  */
 798                                                 if (XSUBR(fun)->doc) {
 799                                                         weird_doc(sym,
 800                                                                   GETTEXT
 801                                                                   ("duplicate"),
 802                                                                   GETTEXT
 803                                                                   ("subr"),
 804                                                                   pos);
 805                                                         goto weird;
 806                                                 }
 807                                                 XSUBR(fun)->doc =
 808                                                     (char *)(-XINT(offset));
 809                                         } else if (CONSP(fun)) {
 810                                                 /* If it's a lisp form, stick it in the form.  */
 811                                                 tem = XCAR(fun);
 812                                                 if (EQ(tem, Qlambda)
 813                                                     || EQ(tem, Qautoload)) {
 814                                                         tem = Fcdr(Fcdr(fun));
 815                                                         if (CONSP(tem) &&
 816                                                             INTP(XCAR(tem))) {
 817                                                                 Lisp_Object old
 818                                                                     = XCAR(tem);
 819                                                                 if (!ZEROP(old)) {
 820                                                                         weird_doc
 821                                                                             (sym,
 822                                                                              GETTEXT
 823                                                                              ("duplicate"),
 824                                                                              (EQ
 825                                                                               (tem,
 826                                                                                Qlambda)
 827                                                                               ?
 828                                                                               GETTEXT
 829                                                                               ("lambda")
 830                                                                               :
 831                                                                               GETTEXT
 832                                                                               ("autoload")),
 833                                                                              pos);
 834                                                                         /* In the case of duplicate doc file entries,
 835                                                                            always take the later one.  But if the doc
 836                                                                            is not an int (a string, say) leave it
 837                                                                            alone. */
 838                                                                         if (!INTP(old))
 839                                                                                 goto weird;
 840                                                                 }
 841                                                                 XCAR(tem) =
 842                                                                     offset;
 843                                                         } else if (!CONSP(tem)) {
 844                                                                 weird_doc(sym,
 845                                                                           GETTEXT
 846                                                                           ("!CONSP(tem)"),
 847                                                                           GETTEXT
 848                                                                           ("function"),
 849                                                                           pos);
 850                                                                 goto cont;
 851                                                         } else {
 852                                                                 /* DOC string is a string not integer 0 */
 853 #if 0
 854                                                                 weird_doc(sym,
 855                                                                           GETTEXT
 856                                                                           ("!INTP(XCAR(tem))"),
 857                                                                           GETTEXT
 858                                                                           ("function"),
 859                                                                           pos);
 860 #endif
 861                                                                 goto cont;
 862                                                         }
 863                                                 } else {
 864                                                         weird_doc(sym,
 865                                                                   GETTEXT
 866                                                                   ("not lambda or autoload"),
 867                                                                   GETTEXT
 868                                                                   ("function"),
 869                                                                   pos);
 870                                                         goto cont;
 871                                                 }
 872                                         } else if (COMPILED_FUNCTIONP(fun)) {
 873                                                 /* Compiled-Function objects sometimes have
 874                                                    slots for it.  */
 875                                                 Lisp_Compiled_Function *f =
 876                                                     XCOMPILED_FUNCTION(fun);
 877
 878                                                 /* This compiled-function object must have a
 879                                                    slot for the docstring, since we've found a
 880                                                    docstring for it.  Unless there were multiple
 881                                                    definitions of it, and the latter one didn't
 882                                                    have any doc, which is a legal if slightly
 883                                                    bogus situation, so don't blow up. */
 884
 885                                                 if (!(f->flags.documentationp)) {
 886                                                         weird_doc(sym,
 887                                                                   GETTEXT
 888                                                                   ("no doc slot"),
 889                                                                   GETTEXT
 890                                                                   ("bytecode"),
 891                                                                   pos);
 892                                                         goto weird;
 893                                                 } else {
 894                                                         Lisp_Object old =
 895                                                             compiled_function_documentation
 896                                                             (f);
 897                                                         if (!ZEROP(old)) {
 898                                                                 weird_doc(sym,
 899                                                                           GETTEXT
 900                                                                           ("duplicate"),
 901                                                                           GETTEXT
 902                                                                           ("bytecode"),
 903                                                                           pos);
 904                                                                 /* In the case of duplicate doc file entries,
 905                                                                    always take the later one.  But if the doc is
 906                                                                    not an int (a string, say) leave it alone. */
 907                                                                 if (!INTP(old))
 908                                                                         goto weird;
 909                                                         }
 910                                                         set_compiled_function_documentation
 911                                                             (f, offset);
 912                                                 }
 913                                         } else {
 914                                                 /* Otherwise the function is undefined or
 915                                                    otherwise weird.   Ignore it. */
 916                                                 weird_doc(sym,
 917                                                           GETTEXT
 918                                                           ("weird function"),
 919                                                           GETTEXT("function"),
 920                                                           pos);
 921                                                 goto weird;
 922                                         }
 923                                 } else {
 924                                         /* lose: */
 925                                         error("DOC file invalid at position %d",
 926                                               pos);
 927                                       weird:
 928                                         /* goto lose */ ;
 929                                 }
 930                         }
 931                 }
 932               cont:
 933                 pos += end - buf;
 934                 filled -= end - buf;
 935                 memmove(buf, end, filled);
 936         }
 937         close(fd);
 938         return Qnil;
 939 }
 940
 941 #if 1                           /* Don't warn about functions whose doc was lost because they were
 942                                    wrapped by advice-freeze.el... */
 943 static int kludgily_ignore_lost_doc_p(Lisp_Object sym)
 944 {
 945 # define kludge_prefix "ad-Orig-"
 946         Lisp_String *name = XSYMBOL(sym)->name;
 947         return (string_length(name) > (Bytecount) (sizeof(kludge_prefix)) &&
 948                 !strncmp((char *)string_data(name), kludge_prefix,
 949                          sizeof(kludge_prefix) - 1));
 950 # undef kludge_prefix
 951 }
 952 #else
 953 # define kludgily_ignore_lost_doc_p(sym) 0
 954 #endif
 955
 956 static int verify_doc_mapper(Lisp_Object sym, void *arg)
 957 {
 958         Lisp_Object closure = *(Lisp_Object *) arg;
 959
 960         if (!NILP(Ffboundp(sym))) {
 961                 int doc = 0;
 962                 Lisp_Object fun = XSYMBOL(sym)->function;
 963                 if (CONSP(fun) && EQ(XCAR(fun), Qmacro))
 964                         fun = XCDR(fun);
 965
 966                 if (SUBRP(fun))
 967                         doc = (EMACS_INT) XSUBR(fun)->doc;
 968                 else if (SYMBOLP(fun))
 969                         doc = -1;
 970                 else if (KEYMAPP(fun))
 971                         doc = -1;
 972                 else if (CONSP(fun)) {
 973                         Lisp_Object tem = XCAR(fun);
 974                         if (EQ(tem, Qlambda) || EQ(tem, Qautoload)) {
 975                                 doc = -1;
 976                                 tem = Fcdr(Fcdr(fun));
 977                                 if (CONSP(tem) && INTP(XCAR(tem)))
 978                                         doc = XINT(XCAR(tem));
 979                         }
 980                 } else if (COMPILED_FUNCTIONP(fun)) {
 981                         Lisp_Compiled_Function *f = XCOMPILED_FUNCTION(fun);
 982                         if (!(f->flags.documentationp))
 983                                 doc = -1;
 984                         else {
 985                                 Lisp_Object tem =
 986                                     compiled_function_documentation(f);
 987                                 if (INTP(tem))
 988                                         doc = XINT(tem);
 989                         }
 990                 }
 991
 992                 if (doc == 0 && !kludgily_ignore_lost_doc_p(sym)) {
 993                         message("Warning: doc lost for function %s.",
 994                                 string_data(XSYMBOL(sym)->name));
 995                         XCDR(closure) = Qt;
 996                 }
 997         }
 998         if (!NILP(Fboundp(sym))) {
 999                 Lisp_Object doc = Fget(sym, Qvariable_documentation, Qnil);
1000                 if (ZEROP(doc)) {
1001                         message("Warning: doc lost for variable %s.",
1002                                 string_data(XSYMBOL(sym)->name));
1003                         XCDR(closure) = Qt;
1004                 }
1005         }
1006         return 0;               /* Never stop */
1007 }
1008
1009 DEFUN("Verify-documentation", Fverify_documentation, 0, 0, 0,   /*
1010 Used to make sure everything went well with Snarf-documentation.
1011 Writes to stderr if not.
1012 */
1013       ())
1014 {
1015         Lisp_Object closure = Fcons(Qnil, Qnil);
1016         struct gcpro gcpro1;
1017         GCPRO1(closure);
1018         map_obarray(Vobarray, verify_doc_mapper, &closure);
1019         if (!NILP(Fcdr(closure)))
1020                 message("\n"
1021                         "This is usually because some files were preloaded by loaddefs.el or\n"
1022                         "site-load.el, but were not passed to make-docfile by Makefile.\n");
1023         UNGCPRO;
1024         return NILP(Fcdr(closure)) ? Qt : Qnil;
1025 }
1026 \f
1027 DEFUN("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0,     /*
1028 Substitute key descriptions for command names in STRING.
1029 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
1030 replaced by either:  a keystroke sequence that will invoke COMMAND,
1031 or "M-x COMMAND" if COMMAND is not on any keys.
1032 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
1033 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
1034 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
1035 as the keymap for future \\=\\[COMMAND] substrings.
1036 \\=\\= quotes the following character and is discarded;
1037 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
1038 */
1039       (string))
1040 {
1041         /* This function can GC */
1042         Bufbyte *buf;
1043         int changed = 0;
1044         REGISTER Bufbyte *strdata;
1045         REGISTER Bufbyte *bufp;
1046         Bytecount strlength;
1047         Bytecount idx;
1048         Bytecount bsize;
1049         Bufbyte *new;
1050         Lisp_Object tem = Qnil;
1051         Lisp_Object keymap = Qnil;
1052         Lisp_Object name = Qnil;
1053         Bufbyte *start;
1054         Bytecount length;
1055         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1056
1057         if (NILP(string))
1058                 return Qnil;
1059
1060         CHECK_STRING(string);
1061         GCPRO4(string, tem, keymap, name);
1062
1063         /* There is the possibility that the string is not destined for a
1064            translating stream, and it could be argued that we should do the
1065            same thing here as in Fformat(), but there are very few times
1066            when this will be the case and many calls to this function
1067            would have to have `gettext' calls added. (I18N3) */
1068         string = LISP_GETTEXT(string);
1069
1070         /* KEYMAP is either nil (which means search all the active keymaps)
1071            or a specified local map (which means search just that and the
1072            global map).  If non-nil, it might come from Voverriding_local_map,
1073            or from a \\<mapname> construct in STRING itself..  */
1074 #if 0                           /* FSFmacs */
1075         /* This is really weird and garbagey.  If keymap is nil and there's
1076            an overriding-local-map, `where-is-internal' will correctly note
1077            this, so there's no reason to do it here.  Maybe FSFmacs
1078            `where-is-internal' is broken. */
1079         /*
1080            keymap = current_kboard->Voverriding_terminal_local_map;
1081            if (NILP (keymap))
1082            keymap = Voverriding_local_map;
1083          */
1084 #endif
1085
1086         strlength = XSTRING_LENGTH(string);
1087         bsize = 1 + strlength;
1088         buf = (Bufbyte*)xmalloc_atomic(bsize);
1089         bufp = buf;
1090
1091         /* Have to reset strdata every time GC might be called */
1092         strdata = XSTRING_DATA(string);
1093         for (idx = 0; idx < strlength;) {
1094                 Bufbyte *strp = strdata + idx;
1095
1096                 if (strp[0] != '\\') {
1097                         /* just copy other chars */
1098                         /* As it happens, this will work with Mule even if the
1099                            character quoted is multi-byte; the remaining multi-byte
1100                            characters will just be copied by this loop. */
1101                         *bufp++ = *strp;
1102                         idx++;
1103                 } else
1104                         switch (strp[1]) {
1105                         default: {
1106                                 /* just copy unknown escape sequences */
1107                                 *bufp++ = *strp;
1108                                 idx++;
1109                                 break;
1110                         }
1111                         case '=': {
1112                                 /* \= quotes the next character; thus, to put in
1113                                    \[ without its special meaning, use \=\[.  */
1114                                 /* As it happens, this will work with Mule even
1115                                    if the character quoted is multi-byte; the
1116                                    remaining multi-byte characters will just be
1117                                    copied by this loop. */
1118                                 changed = 1;
1119                                 *bufp++ = strp[2];
1120                                 idx += 3;
1121                                 break;
1122                         }
1123                         case '[': {
1124                                 changed = 1;
1125                                 idx += 2;       /* skip \[ */
1126                                 strp += 2;
1127                                 start = strp;
1128
1129                                 while ((idx < strlength)
1130                                        && *strp != ']') {
1131                                         strp++;
1132                                         idx++;
1133                                 }
1134                                 length = strp - start;
1135                                 idx++;  /* skip ] */
1136
1137                                 tem = Fintern(make_string(start, length), Qnil);
1138                                 tem = Fwhere_is_internal(
1139                                         tem, keymap, Qt, Qnil, Qnil);
1140
1141 #if 0                           /* FSFmacs */
1142                                 /* Disregard menu bar bindings; it is
1143                                    positively annoying to mention them
1144                                    when there's no menu bar, and it
1145                                    isn't terribly useful even when there
1146                                    is a menu bar.  */
1147                                 if (!NILP(tem)) {
1148                                         firstkey = Faref(tem, Qzero);
1149                                         if (EQ(firstkey, Qmenu_bar))
1150                                                 tem = Qnil;
1151                                 }
1152 #endif
1153
1154                                 if (NILP(tem)) {
1155                                         /* but not on any keys */
1156                                         new = xrealloc(buf, bsize += 4);
1157                                         bufp += new - buf;
1158                                         buf = new;
1159                                         memcpy(bufp, "M-x ", 4);
1160                                         bufp += 4;
1161                                         goto subst;
1162                                 } else {        /* function is on a key */
1163                                         tem = Fkey_description(tem);
1164                                         goto subst_string;
1165                                 }
1166                         }
1167                         case '{':
1168                         case '<': {
1169                                 Lisp_Object buffer =
1170                                         Fget_buffer_create(QSsubstitute);
1171                                 struct buffer *buf_ = XBUFFER(buffer);
1172
1173                                 Fbuffer_disable_undo(buffer);
1174                                 Ferase_buffer(buffer);
1175
1176                                 /* \{foo} is replaced with a summary of keymap
1177                                    (symbol-value foo).  \<foo> just sets the
1178                                    keymap used for \[cmd]. */
1179                                 changed = 1;
1180                                 idx += 2;       /* skip \{ or \< */
1181                                 strp += 2;
1182                                 start = strp;
1183
1184                                 while ((idx < strlength)
1185                                        && *strp != '}' && *strp != '>') {
1186                                         strp++;
1187                                         idx++;
1188                                 }
1189                                 length = strp - start;
1190                                 idx++;  /* skip } or > */
1191
1192                                         /* Get the value of the keymap in TEM,
1193                                            or nil if undefined.  Do this while
1194                                            still in the user's current buffer in
1195                                            case it is a local variable.  */
1196                                 name = Fintern(
1197                                         make_string(start, length), Qnil);
1198                                 tem = Fboundp(name);
1199                                 if (!NILP(tem)) {
1200                                         tem = Fsymbol_value(name);
1201                                         if (!NILP(tem)) {
1202                                                 tem = get_keymap(tem, 0, 1);
1203                                         }
1204                                 }
1205
1206                                 if (NILP(tem)) {
1207                                         buffer_insert_c_string(
1208                                                 buf_, "(uses keymap \"");
1209                                         buffer_insert_lisp_string(
1210                                                 buf_, Fsymbol_name(name));
1211                                         buffer_insert_c_string(
1212                                                 buf_, "\", which is not "
1213                                                 "currently defined) ");
1214
1215                                         if (start[-1] == '<') {
1216                                                 keymap = Qnil;
1217                                         }
1218                                 } else if (start[-1] == '<') {
1219                                         keymap = tem;
1220                                 } else {
1221                                         describe_map_tree(
1222                                                 tem, 1, Qnil, Qnil, 0, buffer);
1223                                 }
1224                                 tem = make_string_from_buffer(
1225                                         buf_, BUF_BEG(buf_),
1226                                         BUF_Z(buf_) - BUF_BEG(buf_));
1227                                 Ferase_buffer(buffer);
1228                         }
1229                                 goto subst_string;
1230
1231                         subst_string:
1232                                 start = XSTRING_DATA(tem);
1233                                 length = XSTRING_LENGTH(tem);
1234                         subst:
1235                                 bsize += length;
1236                                 new = (Bufbyte *)xrealloc(buf, bsize);
1237                                 bufp += new - buf;
1238                                 buf = new;
1239                                 memcpy(bufp, start, length);
1240                                 bufp += length;
1241
1242                                 /* Reset STRDATA in case gc relocated it.  */
1243                                 strdata = XSTRING_DATA(string);
1244
1245                                 break;
1246                         }
1247         }
1248
1249         if (changed) {
1250                 /* don't bother if nothing substituted */
1251                 tem = make_string(buf, bufp - buf);
1252         } else {
1253                 tem = string;
1254         }
1255         xfree(buf);
1256         UNGCPRO;
1257         return tem;
1258 }
1259 \f
1260 /************************************************************************/
1261 /*                            initialization                            */
1262 /************************************************************************/
1263
1264 void syms_of_doc(void)
1265 {
1266         DEFSUBR(Fdocumentation);
1267         DEFSUBR(Fdocumentation_property);
1268         DEFSUBR(Fsnarf_documentation);
1269         DEFSUBR(Fverify_documentation);
1270         DEFSUBR(Fsubstitute_command_keys);
1271         DEFSUBR(Fbuilt_in_symbol_file);
1272
1273         DEFSYMBOL (Qdefvar);
1274 }
1275
1276 void vars_of_doc(void)
1277 {
1278         DEFVAR_LISP("internal-doc-file-name", &Vinternal_doc_file_name  /*
1279 Name of file containing documentation strings of built-in symbols.
1280                                                                          */ );
1281         Vinternal_doc_file_name = Qnil;
1282
1283         /* We don't really want this accessible from lisp... */
1284         Vinternal_doc_fd = make_int(-2);
1285
1286         QSsubstitute = build_string(" *substitute*");
1287         staticpro(&QSsubstitute);
1288 }