1 /* Record indices of function doc strings stored in a file. 2 Copyright (C) 1985, 1986 Free Software Foundation, Inc. 3 4 This file is part of GNU Emacs. 5 6 GNU Emacs is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 1, or (at your option) 9 any later version. 10 11 GNU Emacs is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with GNU Emacs; see the file COPYING. If not, write to 18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ 19 20 21 #include "config.h" 22 #include "lisp.h" 23 #include "buffer.h" 24 25 #include <sys/types.h> 26 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/ 27 28 #ifdef USG5 29 #include <fcntl.h> 30 #endif 31 32 #ifndef O_RDONLY 33 #define O_RDONLY 0 34 #endif 35 36 Lisp_Object Vdoc_file_name; 37 38 Lisp_Object 39 get_doc_string (filepos) 40 long filepos; 41 { 42 char buf[512 * 32 + 1]; 43 register int fd; 44 register char *name; 45 register char *p, *p1; 46 register int count; 47 extern char *index (); 48 49 if (XTYPE (Vexec_directory) != Lisp_String 50 || XTYPE (Vdoc_file_name) != Lisp_String) 51 return Qnil; 52 53 name = (char *) alloca (XSTRING (Vexec_directory)->size 54 + XSTRING (Vdoc_file_name)->size + 8); 55 strcpy (name, XSTRING (Vexec_directory)->data); 56 strcat (name, XSTRING (Vdoc_file_name)->data); 57 #ifdef VMS 58 #ifndef VMS4_4 59 /* For VMS versions with limited file name syntax, 60 convert the name to something VMS will allow. */ 61 p = name; 62 while (*p) 63 { 64 if (*p == '-') 65 *p = '_'; 66 p++; 67 } 68 #endif /* not VMS4_4 */ 69 #ifdef VMS4_4 70 strcpy (name, sys_translate_unix (name)); 71 #endif /* VMS4_4 */ 72 #endif /* VMS */ 73 74 fd = open (name, O_RDONLY, 0); 75 if (fd < 0) 76 error ("Cannot open doc string file \"%s\"", name); 77 if (0 > lseek (fd, (off_t) filepos, 0)) 78 { 79 close (fd); 80 error ("Position %ld out of range in doc string file \"%s\"", 81 filepos, name); 82 } 83 p = buf; 84 while (p != buf + sizeof buf - 1) 85 { 86 count = read (fd, p, 512); 87 p[count] = 0; 88 if (!count) 89 break; 90 p1 = index (p, '\037'); 91 if (p1) 92 { 93 *p1 = 0; 94 p = p1; 95 break; 96 } 97 p += count; 98 } 99 close (fd); 100 return make_string (buf, p - buf); 101 } 102 103 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 1, 0, 104 "Return the documentation string of FUNCTION.") 105 (fun1) 106 Lisp_Object fun1; 107 { 108 Lisp_Object fun; 109 Lisp_Object funcar; 110 Lisp_Object tem; 111 112 fun = fun1; 113 while (XTYPE (fun) == Lisp_Symbol) 114 fun = Fsymbol_function (fun); 115 if (XTYPE (fun) == Lisp_Subr) 116 { 117 if (XSUBR (fun)->doc == 0) return Qnil; 118 if ((int) XSUBR (fun)->doc >= 0) 119 return Fsubstitute_command_keys (build_string (XSUBR (fun)->doc)); 120 return Fsubstitute_command_keys (get_doc_string (- (int) XSUBR (fun)->doc)); 121 } 122 if (XTYPE (fun) == Lisp_Vector) 123 return build_string ("Prefix command (definition is a Lisp vector of subcommands)."); 124 if (XTYPE (fun) == Lisp_String) 125 return build_string ("Keyboard macro."); 126 if (!CONSP (fun)) 127 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); 128 funcar = Fcar (fun); 129 if (XTYPE (funcar) != Lisp_Symbol) 130 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); 131 if (XSYMBOL (funcar) == XSYMBOL (Qkeymap)) 132 return build_string ("Prefix command (definition is a list whose cdr is an alist of subcommands.)"); 133 if (XSYMBOL (funcar) == XSYMBOL (Qlambda) 134 || XSYMBOL (funcar) == XSYMBOL (Qautoload)) 135 { 136 tem = Fcar (Fcdr (Fcdr (fun))); 137 if (XTYPE (tem) == Lisp_String) 138 return Fsubstitute_command_keys (tem); 139 if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) 140 return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem))); 141 return Qnil; 142 } 143 if (XSYMBOL (funcar) == XSYMBOL (Qmocklisp)) 144 return Qnil; 145 if (XSYMBOL (funcar) == XSYMBOL (Qmacro)) 146 return Fdocumentation (Fcdr (fun)); 147 else 148 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); 149 } 150 151 DEFUN ("documentation-property", Fdocumentation_property, 152 Sdocumentation_property, 2, 2, 0, 153 "Return the documentation string that is SYMBOL's PROP property.\n\ 154 This differs from using `get' only in that it can refer to strings\n\ 155 stored in the etc/DOC file.") 156 (sym, prop) 157 Lisp_Object sym, prop; 158 { 159 register Lisp_Object tem; 160 161 tem = Fget (sym, prop); 162 if (XTYPE (tem) == Lisp_Int) 163 tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem)); 164 return Fsubstitute_command_keys (tem); 165 } 166 167 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation, 168 1, 1, 0, 169 "Used during Emacs initialization, before dumping runnable Emacs,\n\ 170 to find pointers to doc strings stored in etc/DOC... and\n\ 171 record them in function definitions.\n\ 172 One arg, FILENAME, a string which does not include a directory.\n\ 173 The file is found in ../etc now; found in the exec-directory\n\ 174 when doc strings are referred to later in the dumped Emacs.") 175 (filename) 176 Lisp_Object filename; 177 { 178 int fd; 179 char buf[1024 + 1]; 180 register int filled; 181 register int pos; 182 register char *p, *end; 183 Lisp_Object sym, fun, tem; 184 char *name; 185 extern char *index (); 186 187 CHECK_STRING (filename, 0); 188 189 #ifndef CANNOT_DUMP 190 name = (char *) alloca (XSTRING (filename)->size + 8); 191 strcpy (name, "../etc/"); 192 #else /* CANNOT_DUMP */ 193 CHECK_STRING (Vexec_directory, 0); 194 name = (char *) alloca (XSTRING (filename)->size + 195 XSTRING (Vexec_directory)->size + 1); 196 strcpy (name, XSTRING (Vexec_directory)->data); 197 #endif /* CANNOT_DUMP */ 198 strcat (name, XSTRING (filename)->data); /*** Add this line ***/ 199 #ifdef VMS 200 #ifndef VMS4_4 201 /* For VMS versions with limited file name syntax, 202 convert the name to something VMS will allow. */ 203 p = name; 204 while (*p) 205 { 206 if (*p == '-') 207 *p = '_'; 208 p++; 209 } 210 #endif /* not VMS4_4 */ 211 #ifdef VMS4_4 212 strcpy (name, sys_translate_unix (name)); 213 #endif /* VMS4_4 */ 214 #endif /* VMS */ 215 216 fd = open (name, O_RDONLY, 0); 217 if (fd < 0) 218 report_file_error ("Opening doc string file", 219 Fcons (build_string (name), Qnil)); 220 Vdoc_file_name = filename; 221 filled = 0; 222 pos = 0; 223 while (1) 224 { 225 if (filled < 512) 226 filled += read (fd, &buf[filled], sizeof buf - 1 - filled); 227 if (!filled) 228 break; 229 230 buf[filled] = 0; 231 p = buf; 232 end = buf + (filled < 512 ? filled : filled - 128); 233 while (p != end && *p != '\037') p++; 234 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ 235 if (p != end) 236 { 237 end = index (p, '\n'); 238 sym = oblookup (Vobarray, p + 2, end - p - 2); 239 if (XTYPE (sym) == Lisp_Symbol) 240 { 241 if (p[1] == 'V') 242 { 243 /* Install file-position as variable-documentation property 244 and make it negative for a user-variable 245 (doc starts with a `*'). */ 246 Fput (sym, Qvariable_documentation, 247 make_number ((pos + end + 1 - buf) 248 * (end[1] == '*' ? -1 : 1))); 249 } 250 else if (p[1] == 'F') 251 { 252 fun = XSYMBOL (sym)->function; 253 if (XTYPE (fun) == Lisp_Subr) 254 XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf); 255 else if (CONSP (fun)) 256 { 257 tem = XCONS (fun)->car; 258 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) 259 { 260 tem = Fcdr (Fcdr (fun)); 261 if (CONSP (tem) && 262 XTYPE (XCONS (tem)->car) == Lisp_Int) 263 XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf); 264 } 265 } 266 } 267 else error ("DOC file invalid at position %d", pos); 268 } 269 } 270 pos += end - buf; 271 filled -= end - buf; 272 bcopy (end, buf, filled); 273 } 274 close (fd); 275 return Qnil; 276 } 277 278 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 279 Ssubstitute_command_keys, 1, 1, 0, 280 "Return the STRING with substrings of the form \\=\\[COMMAND]\n\ 281 replaced by either: a keystroke sequence that will invoke COMMAND,\n\ 282 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\ 283 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\ 284 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\ 285 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\ 286 as the keymap for future \\=\\[COMMAND] substrings.\n\ 287 \\=\\= quotes the following character and is discarded;\n\ 288 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.") 289 (str) 290 Lisp_Object str; 291 { 292 unsigned char *buf; 293 int changed = 0; 294 register unsigned char *strp; 295 register unsigned char *bufp; 296 int idx; 297 int bsize; 298 unsigned char *new; 299 register Lisp_Object tem; 300 Lisp_Object keymap; 301 unsigned char *start; 302 int length; 303 struct gcpro gcpro1; 304 305 if (NULL (str)) 306 return Qnil; 307 308 CHECK_STRING (str, 0); 309 GCPRO1 (str); 310 311 keymap = current_buffer->keymap; 312 313 bsize = XSTRING (str)->size; 314 bufp = buf = (unsigned char *) xmalloc (bsize); 315 316 strp = (unsigned char *) XSTRING (str)->data; 317 while (strp - (unsigned char *) XSTRING (str)->data < XSTRING (str)->size) 318 { 319 if (strp[0] == '\\' && strp[1] == '=') 320 { 321 /* \= quotes the next character; 322 thus, to put in \[ without its special meaning, use \=\[. */ 323 changed = 1; 324 *bufp++ = strp[2]; 325 strp += 3; 326 } 327 else if (strp[0] == '\\' && strp[1] == '[') 328 { 329 changed = 1; 330 strp += 2; /* skip \[ */ 331 start = strp; 332 333 while (strp - (unsigned char *) XSTRING (str)->data < XSTRING (str)->size 334 && *strp != ']') 335 strp++; 336 length = strp - start; 337 strp++; /* skip ] */ 338 339 /* Save STRP in IDX. */ 340 idx = strp - (unsigned char *) XSTRING (str)->data; 341 tem = Fintern (make_string (start, length), Qnil); 342 tem = Fwhere_is_internal (tem, keymap, Qt); 343 344 if (NULL (tem)) /* but not on any keys */ 345 { 346 new = (unsigned char *) xrealloc (buf, bsize += 4); 347 bufp += new - buf; 348 buf = new; 349 bcopy ("M-x ", bufp, 4); 350 bufp += 4; 351 goto subst; 352 } 353 else 354 { /* function is on a key */ 355 tem = Fkey_description (tem); 356 goto subst_string; 357 } 358 } 359 /* \{foo} is replaced with a summary of the keymap (symeval foo). 360 \<foo> just sets the keymap used for \[cmd]. */ 361 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')) 362 { 363 struct buffer *oldbuf; 364 Lisp_Object name; 365 366 changed = 1; 367 strp += 2; /* skip \{ or \< */ 368 start = strp; 369 370 while (strp - (unsigned char *) XSTRING (str)->data < XSTRING (str)->size 371 && *strp != '}' && *strp != '>') 372 strp++; 373 length = strp - start; 374 strp++; /* skip } or > */ 375 376 /* Save STRP in IDX. */ 377 idx = strp - (unsigned char *) XSTRING (str)->data; 378 379 oldbuf = current_buffer; 380 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); 381 name = Fintern (make_string (start, length), Qnil); 382 if ((tem = (Fboundp (name)), NULL (tem)) || 383 (tem = (Fsymbol_value (name)), NULL (tem)) || 384 (tem = (get_keymap_1 (tem, 0)), NULL (tem))) 385 { 386 name = Fsymbol_name (name); 387 InsStr ("\nUses keymap \""); 388 insert (XSTRING (name)->data, XSTRING (name)->size); 389 InsStr ("\", which is not currently defined.\n"); 390 if (start[-1] == '<') keymap = Qnil; 391 } 392 else if (start[-1] == '<') 393 keymap = tem; 394 else 395 describe_map_tree (tem, 1, Qnil); 396 tem = Fbuffer_string (); 397 Ferase_buffer (); 398 set_buffer_internal (oldbuf); 399 400 subst_string: 401 start = XSTRING (tem)->data; 402 length = XSTRING (tem)->size; 403 subst: 404 new = (unsigned char *) xrealloc (buf, bsize += length); 405 bufp += new - buf; 406 buf = new; 407 bcopy (start, bufp, length); 408 bufp += length; 409 /* Check STR again in case gc relocated it. */ 410 strp = (unsigned char *) XSTRING (str)->data + idx; 411 } 412 else /* just copy other chars */ 413 *bufp++ = *strp++; 414 } 415 416 if (changed) /* don't bother if nothing substituted */ 417 tem = make_string (buf, bufp - buf); 418 else 419 tem = str; 420 UNGCPRO; 421 free (buf); 422 return tem; 423 } 424 425 syms_of_doc () 426 { 427 staticpro (&Vdoc_file_name); 428 Vdoc_file_name = Qnil; 429 430 defsubr (&Sdocumentation); 431 defsubr (&Sdocumentation_property); 432 defsubr (&Ssnarf_documentation); 433 defsubr (&Ssubstitute_command_keys); 434 } 435