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 * 32 + 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                 CHECK_STRING(Vdoc_directory);
 712                 name = (char *)alloca(alloca_sz);
 713                 snprintf(name, alloca_sz, "%s%s",
 714                          (char*)XSTRING_DATA(Vdoc_directory),
 715                          (char*)XSTRING_DATA(filename))
 716         } else
 717 #endif                          /* CANNOT_DUMP */
 718         {
 719                 int alloca_sz = 2 + XSTRING_LENGTH(filename) + 3 + 9 + 1;
 720                 name = (char *)alloca(alloca_sz);
 721                 snprintf(name, alloca_sz, "./%s",
 722                          (char*)XSTRING_DATA(filename));
 723         }
 724
 725         fd = open(name, O_RDONLY | OPEN_BINARY, 0);
 726         if (fd < 0)
 727                 report_file_error("Opening doc string file",
 728                                   Fcons(build_string(name), Qnil));
 729         Vinternal_doc_file_name = filename;
 730         filled = 0;
 731         pos = 0;
 732         while (1) {
 733                 if (filled < 512)
 734                         filled +=
 735                             read(fd, &buf[filled], sizeof buf - 1 - filled);
 736                 if (!filled)
 737                         break;
 738
 739                 buf[filled] = 0;
 740                 p = buf;
 741                 end = buf + (filled < 512 ? filled : filled - 128);
 742                 while (p != end && *p != '\037')
 743                         p++;
 744                 /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 745                 if (p != end) {
 746                         end = strchr(p, '\n');
 747                         sym =
 748                             oblookup(Vobarray, (Bufbyte *) p + 2, end - p - 2);
 749                         if (SYMBOLP(sym)) {
 750                                 Lisp_Object offset =
 751                                     make_int(pos + end + 1 - buf);
 752                                 /* Attach a docstring to a variable */
 753                                 if (p[1] == 'V') {
 754                                         /* Install file-position as variable-documentation property
 755                                            and make it negative for a user-variable
 756                                            (doc starts with a `*').  */
 757                                         Lisp_Object old =
 758                                             Fget(sym, Qvariable_documentation,
 759                                                  Qzero);
 760                                         if (!ZEROP(old)) {
 761                                                 weird_doc(sym,
 762                                                           GETTEXT("duplicate"),
 763                                                           GETTEXT("variable"),
 764                                                           pos);
 765                                                 /* In the case of duplicate doc file entries, always
 766                                                    take the later one.  But if the doc is not an int
 767                                                    (a string, say) leave it alone. */
 768                                                 if (!INTP(old))
 769                                                         goto weird;
 770                                         }
 771                                         Fput(sym, Qvariable_documentation,
 772                                              ((end[1] == '*')
 773                                               ? make_int(-XINT(offset))
 774                                               : offset));
 775                                 }
 776                                 /* Attach a docstring to a function.
 777                                    The type determines where the docstring is stored.  */
 778                                 else if (p[1] == 'F') {
 779                                         fun = indirect_function(sym, 0);
 780
 781                                         if (CONSP(fun) && EQ(XCAR(fun), Qmacro))
 782                                                 fun = XCDR(fun);
 783
 784                                         if (UNBOUNDP(fun)) {
 785                                                 /* May have been #if'ed out or something */
 786                                                 weird_doc(sym,
 787                                                           GETTEXT
 788                                                           ("not fboundp"),
 789                                                           GETTEXT("function"),
 790                                                           pos);
 791                                                 goto weird;
 792                                         } else if (SUBRP(fun)) {
 793                                                 /* Lisp_Subrs have a slot for it.  */
 794                                                 if (XSUBR(fun)->doc) {
 795                                                         weird_doc(sym,
 796                                                                   GETTEXT
 797                                                                   ("duplicate"),
 798                                                                   GETTEXT
 799                                                                   ("subr"),
 800                                                                   pos);
 801                                                         goto weird;
 802                                                 }
 803                                                 XSUBR(fun)->doc =
 804                                                     (char *)(-XINT(offset));
 805                                         } else if (CONSP(fun)) {
 806                                                 /* If it's a lisp form, stick it in the form.  */
 807                                                 tem = XCAR(fun);
 808                                                 if (EQ(tem, Qlambda)
 809                                                     || EQ(tem, Qautoload)) {
 810                                                         tem = Fcdr(Fcdr(fun));
 811                                                         if (CONSP(tem) &&
 812                                                             INTP(XCAR(tem))) {
 813                                                                 Lisp_Object old
 814                                                                     = XCAR(tem);
 815                                                                 if (!ZEROP(old)) {
 816                                                                         weird_doc
 817                                                                             (sym,
 818                                                                              GETTEXT
 819                                                                              ("duplicate"),
 820                                                                              (EQ
 821                                                                               (tem,
 822                                                                                Qlambda)
 823                                                                               ?
 824                                                                               GETTEXT
 825                                                                               ("lambda")
 826                                                                               :
 827                                                                               GETTEXT
 828                                                                               ("autoload")),
 829                                                                              pos);
 830                                                                         /* In the case of duplicate doc file entries,
 831                                                                            always take the later one.  But if the doc
 832                                                                            is not an int (a string, say) leave it
 833                                                                            alone. */
 834                                                                         if (!INTP(old))
 835                                                                                 goto weird;
 836                                                                 }
 837                                                                 XCAR(tem) =
 838                                                                     offset;
 839                                                         } else if (!CONSP(tem)) {
 840                                                                 weird_doc(sym,
 841                                                                           GETTEXT
 842                                                                           ("!CONSP(tem)"),
 843                                                                           GETTEXT
 844                                                                           ("function"),
 845                                                                           pos);
 846                                                                 goto cont;
 847                                                         } else {
 848                                                                 /* DOC string is a string not integer 0 */
 849 #if 0
 850                                                                 weird_doc(sym,
 851                                                                           GETTEXT
 852                                                                           ("!INTP(XCAR(tem))"),
 853                                                                           GETTEXT
 854                                                                           ("function"),
 855                                                                           pos);
 856 #endif
 857                                                                 goto cont;
 858                                                         }
 859                                                 } else {
 860                                                         weird_doc(sym,
 861                                                                   GETTEXT
 862                                                                   ("not lambda or autoload"),
 863                                                                   GETTEXT
 864                                                                   ("function"),
 865                                                                   pos);
 866                                                         goto cont;
 867                                                 }
 868                                         } else if (COMPILED_FUNCTIONP(fun)) {
 869                                                 /* Compiled-Function objects sometimes have
 870                                                    slots for it.  */
 871                                                 Lisp_Compiled_Function *f =
 872                                                     XCOMPILED_FUNCTION(fun);
 873
 874                                                 /* This compiled-function object must have a
 875                                                    slot for the docstring, since we've found a
 876                                                    docstring for it.  Unless there were multiple
 877                                                    definitions of it, and the latter one didn't
 878                                                    have any doc, which is a legal if slightly
 879                                                    bogus situation, so don't blow up. */
 880
 881                                                 if (!(f->flags.documentationp)) {
 882                                                         weird_doc(sym,
 883                                                                   GETTEXT
 884                                                                   ("no doc slot"),
 885                                                                   GETTEXT
 886                                                                   ("bytecode"),
 887                                                                   pos);
 888                                                         goto weird;
 889                                                 } else {
 890                                                         Lisp_Object old =
 891                                                             compiled_function_documentation
 892                                                             (f);
 893                                                         if (!ZEROP(old)) {
 894                                                                 weird_doc(sym,
 895                                                                           GETTEXT
 896                                                                           ("duplicate"),
 897                                                                           GETTEXT
 898                                                                           ("bytecode"),
 899                                                                           pos);
 900                                                                 /* In the case of duplicate doc file entries,
 901                                                                    always take the later one.  But if the doc is
 902                                                                    not an int (a string, say) leave it alone. */
 903                                                                 if (!INTP(old))
 904                                                                         goto weird;
 905                                                         }
 906                                                         set_compiled_function_documentation
 907                                                             (f, offset);
 908                                                 }
 909                                         } else {
 910                                                 /* Otherwise the function is undefined or
 911                                                    otherwise weird.   Ignore it. */
 912                                                 weird_doc(sym,
 913                                                           GETTEXT
 914                                                           ("weird function"),
 915                                                           GETTEXT("function"),
 916                                                           pos);
 917                                                 goto weird;
 918                                         }
 919                                 } else {
 920                                         /* lose: */
 921                                         error("DOC file invalid at position %d",
 922                                               pos);
 923                                       weird:
 924                                         /* goto lose */ ;
 925                                 }
 926                         }
 927                 }
 928               cont:
 929                 pos += end - buf;
 930                 filled -= end - buf;
 931                 memmove(buf, end, filled);
 932         }
 933         close(fd);
 934         return Qnil;
 935 }
 936
 937 #if 1                           /* Don't warn about functions whose doc was lost because they were
 938                                    wrapped by advice-freeze.el... */
 939 static int kludgily_ignore_lost_doc_p(Lisp_Object sym)
 940 {
 941 # define kludge_prefix "ad-Orig-"
 942         Lisp_String *name = XSYMBOL(sym)->name;
 943         return (string_length(name) > (Bytecount) (sizeof(kludge_prefix)) &&
 944                 !strncmp((char *)string_data(name), kludge_prefix,
 945                          sizeof(kludge_prefix) - 1));
 946 # undef kludge_prefix
 947 }
 948 #else
 949 # define kludgily_ignore_lost_doc_p(sym) 0
 950 #endif
 951
 952 static int verify_doc_mapper(Lisp_Object sym, void *arg)
 953 {
 954         Lisp_Object closure = *(Lisp_Object *) arg;
 955
 956         if (!NILP(Ffboundp(sym))) {
 957                 int doc = 0;
 958                 Lisp_Object fun = XSYMBOL(sym)->function;
 959                 if (CONSP(fun) && EQ(XCAR(fun), Qmacro))
 960                         fun = XCDR(fun);
 961
 962                 if (SUBRP(fun))
 963                         doc = (EMACS_INT) XSUBR(fun)->doc;
 964                 else if (SYMBOLP(fun))
 965                         doc = -1;
 966                 else if (KEYMAPP(fun))
 967                         doc = -1;
 968                 else if (CONSP(fun)) {
 969                         Lisp_Object tem = XCAR(fun);
 970                         if (EQ(tem, Qlambda) || EQ(tem, Qautoload)) {
 971                                 doc = -1;
 972                                 tem = Fcdr(Fcdr(fun));
 973                                 if (CONSP(tem) && INTP(XCAR(tem)))
 974                                         doc = XINT(XCAR(tem));
 975                         }
 976                 } else if (COMPILED_FUNCTIONP(fun)) {
 977                         Lisp_Compiled_Function *f = XCOMPILED_FUNCTION(fun);
 978                         if (!(f->flags.documentationp))
 979                                 doc = -1;
 980                         else {
 981                                 Lisp_Object tem =
 982                                     compiled_function_documentation(f);
 983                                 if (INTP(tem))
 984                                         doc = XINT(tem);
 985                         }
 986                 }
 987
 988                 if (doc == 0 && !kludgily_ignore_lost_doc_p(sym)) {
 989                         message("Warning: doc lost for function %s.",
 990                                 string_data(XSYMBOL(sym)->name));
 991                         XCDR(closure) = Qt;
 992                 }
 993         }
 994         if (!NILP(Fboundp(sym))) {
 995                 Lisp_Object doc = Fget(sym, Qvariable_documentation, Qnil);
 996                 if (ZEROP(doc)) {
 997                         message("Warning: doc lost for variable %s.",
 998                                 string_data(XSYMBOL(sym)->name));
 999                         XCDR(closure) = Qt;
1000                 }
1001         }
1002         return 0;               /* Never stop */
1003 }
1004
1005 DEFUN("Verify-documentation", Fverify_documentation, 0, 0, 0,   /*
1006 Used to make sure everything went well with Snarf-documentation.
1007 Writes to stderr if not.
1008 */
1009       ())
1010 {
1011         Lisp_Object closure = Fcons(Qnil, Qnil);
1012         struct gcpro gcpro1;
1013         GCPRO1(closure);
1014         map_obarray(Vobarray, verify_doc_mapper, &closure);
1015         if (!NILP(Fcdr(closure)))
1016                 message("\n"
1017                         "This is usually because some files were preloaded by loaddefs.el or\n"
1018                         "site-load.el, but were not passed to make-docfile by Makefile.\n");
1019         UNGCPRO;
1020         return NILP(Fcdr(closure)) ? Qt : Qnil;
1021 }
1022 \f
1023 DEFUN("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0,     /*
1024 Substitute key descriptions for command names in STRING.
1025 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
1026 replaced by either:  a keystroke sequence that will invoke COMMAND,
1027 or "M-x COMMAND" if COMMAND is not on any keys.
1028 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
1029 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
1030 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
1031 as the keymap for future \\=\\[COMMAND] substrings.
1032 \\=\\= quotes the following character and is discarded;
1033 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
1034 */
1035       (string))
1036 {
1037         /* This function can GC */
1038         Bufbyte *buf;
1039         int changed = 0;
1040         REGISTER Bufbyte *strdata;
1041         REGISTER Bufbyte *bufp;
1042         Bytecount strlength;
1043         Bytecount idx;
1044         Bytecount bsize;
1045         Bufbyte *new;
1046         Lisp_Object tem = Qnil;
1047         Lisp_Object keymap = Qnil;
1048         Lisp_Object name = Qnil;
1049         Bufbyte *start;
1050         Bytecount length;
1051         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1052
1053         if (NILP(string))
1054                 return Qnil;
1055
1056         CHECK_STRING(string);
1057         GCPRO4(string, tem, keymap, name);
1058
1059         /* There is the possibility that the string is not destined for a
1060            translating stream, and it could be argued that we should do the
1061            same thing here as in Fformat(), but there are very few times
1062            when this will be the case and many calls to this function
1063            would have to have `gettext' calls added. (I18N3) */
1064         string = LISP_GETTEXT(string);
1065
1066         /* KEYMAP is either nil (which means search all the active keymaps)
1067            or a specified local map (which means search just that and the
1068            global map).  If non-nil, it might come from Voverriding_local_map,
1069            or from a \\<mapname> construct in STRING itself..  */
1070 #if 0                           /* FSFmacs */
1071         /* This is really weird and garbagey.  If keymap is nil and there's
1072            an overriding-local-map, `where-is-internal' will correctly note
1073            this, so there's no reason to do it here.  Maybe FSFmacs
1074            `where-is-internal' is broken. */
1075         /*
1076            keymap = current_kboard->Voverriding_terminal_local_map;
1077            if (NILP (keymap))
1078            keymap = Voverriding_local_map;
1079          */
1080 #endif
1081
1082         strlength = XSTRING_LENGTH(string);
1083         bsize = 1 + strlength;
1084         buf = (Bufbyte*)xmalloc_atomic(bsize);
1085         bufp = buf;
1086
1087         /* Have to reset strdata every time GC might be called */
1088         strdata = XSTRING_DATA(string);
1089         for (idx = 0; idx < strlength;) {
1090                 Bufbyte *strp = strdata + idx;
1091
1092                 if (strp[0] != '\\') {
1093                         /* just copy other chars */
1094                         /* As it happens, this will work with Mule even if the
1095                            character quoted is multi-byte; the remaining multi-byte
1096                            characters will just be copied by this loop. */
1097                         *bufp++ = *strp;
1098                         idx++;
1099                 } else
1100                         switch (strp[1]) {
1101                         default: {
1102                                 /* just copy unknown escape sequences */
1103                                 *bufp++ = *strp;
1104                                 idx++;
1105                                 break;
1106                         }
1107                         case '=': {
1108                                 /* \= quotes the next character; thus, to put in
1109                                    \[ without its special meaning, use \=\[.  */
1110                                 /* As it happens, this will work with Mule even
1111                                    if the character quoted is multi-byte; the
1112                                    remaining multi-byte characters will just be
1113                                    copied by this loop. */
1114                                 changed = 1;
1115                                 *bufp++ = strp[2];
1116                                 idx += 3;
1117                                 break;
1118                         }
1119                         case '[': {
1120                                 changed = 1;
1121                                 idx += 2;       /* skip \[ */
1122                                 strp += 2;
1123                                 start = strp;
1124
1125                                 while ((idx < strlength)
1126                                        && *strp != ']') {
1127                                         strp++;
1128                                         idx++;
1129                                 }
1130                                 length = strp - start;
1131                                 idx++;  /* skip ] */
1132
1133                                 tem = Fintern(make_string(start, length), Qnil);
1134                                 tem = Fwhere_is_internal(
1135                                         tem, keymap, Qt, Qnil, Qnil);
1136
1137 #if 0                           /* FSFmacs */
1138                                 /* Disregard menu bar bindings; it is
1139                                    positively annoying to mention them
1140                                    when there's no menu bar, and it
1141                                    isn't terribly useful even when there
1142                                    is a menu bar.  */
1143                                 if (!NILP(tem)) {
1144                                         firstkey = Faref(tem, Qzero);
1145                                         if (EQ(firstkey, Qmenu_bar))
1146                                                 tem = Qnil;
1147                                 }
1148 #endif
1149
1150                                 if (NILP(tem)) {
1151                                         /* but not on any keys */
1152                                         new = xrealloc(buf, bsize += 4);
1153                                         bufp += new - buf;
1154                                         buf = new;
1155                                         memcpy(bufp, "M-x ", 4);
1156                                         bufp += 4;
1157                                         goto subst;
1158                                 } else {        /* function is on a key */
1159                                         tem = Fkey_description(tem);
1160                                         goto subst_string;
1161                                 }
1162                         }
1163                         case '{':
1164                         case '<': {
1165                                 Lisp_Object buffer =
1166                                         Fget_buffer_create(QSsubstitute);
1167                                 struct buffer *buf_ = XBUFFER(buffer);
1168
1169                                 Fbuffer_disable_undo(buffer);
1170                                 Ferase_buffer(buffer);
1171
1172                                 /* \{foo} is replaced with a summary of keymap
1173                                    (symbol-value foo).  \<foo> just sets the
1174                                    keymap used for \[cmd]. */
1175                                 changed = 1;
1176                                 idx += 2;       /* skip \{ or \< */
1177                                 strp += 2;
1178                                 start = strp;
1179
1180                                 while ((idx < strlength)
1181                                        && *strp != '}' && *strp != '>') {
1182                                         strp++;
1183                                         idx++;
1184                                 }
1185                                 length = strp - start;
1186                                 idx++;  /* skip } or > */
1187
1188                                         /* Get the value of the keymap in TEM,
1189                                            or nil if undefined.  Do this while
1190                                            still in the user's current buffer in
1191                                            case it is a local variable.  */
1192                                 name = Fintern(
1193                                         make_string(start, length), Qnil);
1194                                 tem = Fboundp(name);
1195                                 if (!NILP(tem)) {
1196                                         tem = Fsymbol_value(name);
1197                                         if (!NILP(tem)) {
1198                                                 tem = get_keymap(tem, 0, 1);
1199                                         }
1200                                 }
1201
1202                                 if (NILP(tem)) {
1203                                         buffer_insert_c_string(
1204                                                 buf_, "(uses keymap \"");
1205                                         buffer_insert_lisp_string(
1206                                                 buf_, Fsymbol_name(name));
1207                                         buffer_insert_c_string(
1208                                                 buf_, "\", which is not "
1209                                                 "currently defined) ");
1210
1211                                         if (start[-1] == '<') {
1212                                                 keymap = Qnil;
1213                                         }
1214                                 } else if (start[-1] == '<') {
1215                                         keymap = tem;
1216                                 } else {
1217                                         describe_map_tree(
1218                                                 tem, 1, Qnil, Qnil, 0, buffer);
1219                                 }
1220                                 tem = make_string_from_buffer(
1221                                         buf_, BUF_BEG(buf_),
1222                                         BUF_Z(buf_) - BUF_BEG(buf_));
1223                                 Ferase_buffer(buffer);
1224                         }
1225                                 goto subst_string;
1226
1227                         subst_string:
1228                                 start = XSTRING_DATA(tem);
1229                                 length = XSTRING_LENGTH(tem);
1230                         subst:
1231                                 bsize += length;
1232                                 new = (Bufbyte *)xrealloc(buf, bsize);
1233                                 bufp += new - buf;
1234                                 buf = new;
1235                                 memcpy(bufp, start, length);
1236                                 bufp += length;
1237
1238                                 /* Reset STRDATA in case gc relocated it.  */
1239                                 strdata = XSTRING_DATA(string);
1240
1241                                 break;
1242                         }
1243         }
1244
1245         if (changed) {
1246                 /* don't bother if nothing substituted */
1247                 tem = make_string(buf, bufp - buf);
1248         } else {
1249                 tem = string;
1250         }
1251         xfree(buf);
1252         UNGCPRO;
1253         return tem;
1254 }
1255 \f
1256 /************************************************************************/
1257 /*                            initialization                            */
1258 /************************************************************************/
1259
1260 void syms_of_doc(void)
1261 {
1262         DEFSUBR(Fdocumentation);
1263         DEFSUBR(Fdocumentation_property);
1264         DEFSUBR(Fsnarf_documentation);
1265         DEFSUBR(Fverify_documentation);
1266         DEFSUBR(Fsubstitute_command_keys);
1267         DEFSUBR(Fbuilt_in_symbol_file);
1268
1269         DEFSYMBOL (Qdefvar);
1270 }
1271
1272 void vars_of_doc(void)
1273 {
1274         DEFVAR_LISP("internal-doc-file-name", &Vinternal_doc_file_name  /*
1275 Name of file containing documentation strings of built-in symbols.
1276                                                                          */ );
1277         Vinternal_doc_file_name = Qnil;
1278
1279         /* We don't really want this accessible from lisp... */
1280         Vinternal_doc_fd = make_int(-2);
1281
1282         QSsubstitute = build_string(" *substitute*");
1283         staticpro(&QSsubstitute);
1284 }