HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(GETPGRP_NO_ARG): Defined.
[bpt/emacs.git] / src / fileio.c
CommitLineData
570d7624 1/* File IO for GNU Emacs.
c6c5df7f 2 Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
570d7624
JB		 3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
4746118a 8the Free Software Foundation; either version 2, or (at your option)
570d7624
JB		 9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
ffd56f97 20#include "config.h"
570d7624
JB		 21
22#include <sys/types.h>
23#include <sys/stat.h>
bfb61299
JB		 24
25#ifdef VMS
de5bf5d3 26#include "vms-pwd.h"
bfb61299 27#else
570d7624 28#include <pwd.h>
bfb61299
JB		 29#endif
30
570d7624 31#include <ctype.h>
bfb61299
JB		 32
33#ifdef VMS
34#include "dir.h"
35#include <perror.h>
36#include <stddef.h>
37#include <string.h>
bfb61299
JB		 38#endif
39
570d7624
JB		 40#include <errno.h>
41
bfb61299 42#ifndef vax11c
570d7624
JB		 43extern int errno;
44extern char *sys_errlist[];
45extern int sys_nerr;
46#endif
47
48#define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
49
50#ifdef APOLLO
51#include <sys/time.h>
52#endif
53
6e23c83e
JB		 54#ifndef USG
55#ifndef VMS
56#ifndef BSD4_1
57#define HAVE_FSYNC
58#endif
59#endif
60#endif
61
570d7624 62#include "lisp.h"
8d4e077b 63#include "intervals.h"
570d7624
JB		 64#include "buffer.h"
65#include "window.h"
66
67#ifdef VMS
570d7624
JB		 68#include <file.h>
69#include <rmsdef.h>
70#include <fab.h>
71#include <nam.h>
72#endif
73
de5bf5d3 74#include "systime.h"
570d7624
JB		 75
76#ifdef HPUX
77#include <netio.h>
9b7828a5 78#ifndef HPUX8
47e7b9e5 79#ifndef HPUX9
570d7624
JB		 80#include <errnet.h>
81#endif
9b7828a5 82#endif
47e7b9e5 83#endif
570d7624
JB		 84
85#ifndef O_WRONLY
86#define O_WRONLY 1
87#endif
88
89#define min(a, b) ((a) < (b) ? (a) : (b))
90#define max(a, b) ((a) > (b) ? (a) : (b))
91
92/* Nonzero during writing of auto-save files */
93int auto_saving;
94
95/* Set by auto_save_1 to mode of original file so Fwrite_region will create
96 a new file with the same mode as the original */
97int auto_save_mode_bits;
98
32f4334d
RS		 99/* Alist of elements (REGEXP . HANDLER) for file names
100 whose I/O is done with a special handler. */
101Lisp_Object Vfile_name_handler_alist;
102
570d7624
JB		 103/* Nonzero means, when reading a filename in the minibuffer,
104 start out by inserting the default directory into the minibuffer. */
105int insert_default_directory;
106
107/* On VMS, nonzero means write new files with record format stmlf.
108 Zero means use var format. */
109int vms_stmlf_recfm;
110
111Lisp_Object Qfile_error, Qfile_already_exists;
112
15c65264
RS		 113Lisp_Object Qfile_name_history;
114
570d7624
JB		 115report_file_error (string, data)
116 char *string;
117 Lisp_Object data;
118{
119 Lisp_Object errstring;
120
121 if (errno >= 0 && errno < sys_nerr)
122 errstring = build_string (sys_errlist[errno]);
123 else
124 errstring = build_string ("undocumented error code");
125
126 /* System error messages are capitalized. Downcase the initial
127 unless it is followed by a slash. */
128 if (XSTRING (errstring)->data[1] != '/')
129 XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
130
131 while (1)
132 Fsignal (Qfile_error,
133 Fcons (build_string (string), Fcons (errstring, data)));
134}
b5148e85
RS		 135
136close_file_unwind (fd)
137 Lisp_Object fd;
138{
139 close (XFASTINT (fd));
140}
570d7624 141\f
0bf2eed2
RS		 142Lisp_Object Qexpand_file_name;
143Lisp_Object Qdirectory_file_name;
144Lisp_Object Qfile_name_directory;
145Lisp_Object Qfile_name_nondirectory;
642ef245 146Lisp_Object Qunhandled_file_name_directory;
0bf2eed2 147Lisp_Object Qfile_name_as_directory;
32f4334d
RS		 148Lisp_Object Qcopy_file;
149Lisp_Object Qmake_directory;
150Lisp_Object Qdelete_directory;
151Lisp_Object Qdelete_file;
152Lisp_Object Qrename_file;
153Lisp_Object Qadd_name_to_file;
154Lisp_Object Qmake_symbolic_link;
155Lisp_Object Qfile_exists_p;
156Lisp_Object Qfile_executable_p;
157Lisp_Object Qfile_readable_p;
158Lisp_Object Qfile_symlink_p;
159Lisp_Object Qfile_writable_p;
160Lisp_Object Qfile_directory_p;
161Lisp_Object Qfile_accessible_directory_p;
162Lisp_Object Qfile_modes;
163Lisp_Object Qset_file_modes;
164Lisp_Object Qfile_newer_than_file_p;
165Lisp_Object Qinsert_file_contents;
166Lisp_Object Qwrite_region;
167Lisp_Object Qverify_visited_file_modtime;
168
642ef245
JB		 169DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 1, 1, 0,
170 "Return FILENAME's handler function, if its syntax is handled specially.\n\
171Otherwise, return nil.\n\
172A file name is handled if one of the regular expressions in\n\
173`file-name-handler-alist' matches it.")
174 (filename)
175 Lisp_Object filename;
32f4334d 176{
642ef245 177 /* This function must not munge the match data. */
4554406a 178 Lisp_Object chain;
642ef245 179
e4432095
JB		 180 CHECK_STRING (filename, 0);
181
3eac9910 182 for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
32f4334d
RS		 183 chain = XCONS (chain)->cdr)
184 {
185 Lisp_Object elt;
186 elt = XCONS (chain)->car;
187 if (XTYPE (elt) == Lisp_Cons)
188 {
189 Lisp_Object string;
190 string = XCONS (elt)->car;
191 if (XTYPE (string) == Lisp_String
09121adc 192 && fast_string_match (string, filename) >= 0)
32f4334d
RS		 193 return XCONS (elt)->cdr;
194 }
642ef245
JB		 195
196 QUIT;
32f4334d
RS		 197 }
198 return Qnil;
199}
200\f
570d7624
JB		 201DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
202 1, 1, 0,
203 "Return the directory component in file name NAME.\n\
204Return nil if NAME does not include a directory.\n\
205Otherwise return a directory spec.\n\
206Given a Unix syntax file name, returns a string ending in slash;\n\
207on VMS, perhaps instead a string ending in `:', `]' or `>'.")
208 (file)
209 Lisp_Object file;
210{
211 register unsigned char *beg;
212 register unsigned char *p;
0bf2eed2 213 Lisp_Object handler;
570d7624
JB		 214
215 CHECK_STRING (file, 0);
216
0bf2eed2
RS		 217 /* If the file name has special constructs in it,
218 call the corresponding file handler. */
642ef245 219 handler = Ffind_file_name_handler (file);
0bf2eed2
RS		 220 if (!NILP (handler))
221 return call2 (handler, Qfile_name_directory, file);
222
570d7624
JB		 223 beg = XSTRING (file)->data;
224 p = beg + XSTRING (file)->size;
225
226 while (p != beg && p[-1] != '/'
227#ifdef VMS
228 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
229#endif /* VMS */
230 ) p--;
231
232 if (p == beg)
233 return Qnil;
234 return make_string (beg, p - beg);
235}
236
237DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
238 1, 1, 0,
239 "Return file name NAME sans its directory.\n\
240For example, in a Unix-syntax file name,\n\
241this is everything after the last slash,\n\
242or the entire name if it contains no slash.")
243 (file)
244 Lisp_Object file;
245{
246 register unsigned char *beg, *p, *end;
0bf2eed2 247 Lisp_Object handler;
570d7624
JB		 248
249 CHECK_STRING (file, 0);
250
0bf2eed2
RS		 251 /* If the file name has special constructs in it,
252 call the corresponding file handler. */
642ef245 253 handler = Ffind_file_name_handler (file);
0bf2eed2
RS		 254 if (!NILP (handler))
255 return call2 (handler, Qfile_name_nondirectory, file);
256
570d7624
JB		 257 beg = XSTRING (file)->data;
258 end = p = beg + XSTRING (file)->size;
259
260 while (p != beg && p[-1] != '/'
261#ifdef VMS
262 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
263#endif /* VMS */
264 ) p--;
265
266 return make_string (p, end - p);
267}
642ef245
JB		 268
269DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0,
270 "Return a directly usable directory name somehow associated with FILENAME.\n\
271A `directly usable' directory name is one that may be used without the\n\
272intervention of any file handler.\n\
273If FILENAME is a directly usable file itself, return\n\
274(file-name-directory FILENAME).\n\
275The `call-process' and `start-process' functions use this function to\n\
276get a current directory to run processes in.")
277 (filename)
278 Lisp_Object filename;
279{
280 Lisp_Object handler;
281
282 /* If the file name has special constructs in it,
283 call the corresponding file handler. */
284 handler = Ffind_file_name_handler (filename);
285 if (!NILP (handler))
286 return call2 (handler, Qunhandled_file_name_directory, filename);
287
288 return Ffile_name_directory (filename);
289}
290
570d7624
JB		 291\f
292char *
293file_name_as_directory (out, in)
294 char *out, *in;
295{
296 int size = strlen (in) - 1;
297
298 strcpy (out, in);
299
300#ifdef VMS
301 /* Is it already a directory string? */
302 if (in[size] == ':' || in[size] == ']' || in[size] == '>')
303 return out;
304 /* Is it a VMS directory file name? If so, hack VMS syntax. */
305 else if (! index (in, '/')
306 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
307 || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
308 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
309 || ! strncmp (&in[size - 5], ".dir", 4))
310 && (in[size - 1] == '.' || in[size - 1] == ';')
311 && in[size] == '1')))
312 {
313 register char *p, *dot;
314 char brack;
315
316 /* x.dir -> [.x]
317 dir:x.dir --> dir:[x]
318 dir:[x]y.dir --> dir:[x.y] */
319 p = in + size;
320 while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
321 if (p != in)
322 {
323 strncpy (out, in, p - in);
324 out[p - in] = '\0';
325 if (*p == ':')
326 {
327 brack = ']';
328 strcat (out, ":[");
329 }
330 else
331 {
332 brack = *p;
333 strcat (out, ".");
334 }
335 p++;
336 }
337 else
338 {
339 brack = ']';
340 strcpy (out, "[.");
341 }
bfb61299
JB		 342 dot = index (p, '.');
343 if (dot)
570d7624
JB		 344 {
345 /* blindly remove any extension */
346 size = strlen (out) + (dot - p);
347 strncat (out, p, dot - p);
348 }
349 else
350 {
351 strcat (out, p);
352 size = strlen (out);
353 }
354 out[size++] = brack;
355 out[size] = '\0';
356 }
357#else /* not VMS */
358 /* For Unix syntax, Append a slash if necessary */
359 if (out[size] != '/')
360 strcat (out, "/");
361#endif /* not VMS */
362 return out;
363}
364
365DEFUN ("file-name-as-directory", Ffile_name_as_directory,
366 Sfile_name_as_directory, 1, 1, 0,
367 "Return a string representing file FILENAME interpreted as a directory.\n\
368This operation exists because a directory is also a file, but its name as\n\
369a directory is different from its name as a file.\n\
370The result can be used as the value of `default-directory'\n\
371or passed as second argument to `expand-file-name'.\n\
372For a Unix-syntax file name, just appends a slash.\n\
373On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
374 (file)
375 Lisp_Object file;
376{
377 char *buf;
0bf2eed2 378 Lisp_Object handler;
570d7624
JB		 379
380 CHECK_STRING (file, 0);
265a9e55 381 if (NILP (file))
570d7624 382 return Qnil;
0bf2eed2
RS		 383
384 /* If the file name has special constructs in it,
385 call the corresponding file handler. */
642ef245 386 handler = Ffind_file_name_handler (file);
0bf2eed2
RS		 387 if (!NILP (handler))
388 return call2 (handler, Qfile_name_as_directory, file);
389
570d7624
JB		 390 buf = (char *) alloca (XSTRING (file)->size + 10);
391 return build_string (file_name_as_directory (buf, XSTRING (file)->data));
392}
393\f
394/*
395 * Convert from directory name to filename.
396 * On VMS:
397 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
398 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
399 * On UNIX, it's simple: just make sure there is a terminating /
400
401 * Value is nonzero if the string output is different from the input.
402 */
403
404directory_file_name (src, dst)
405 char *src, *dst;
406{
407 long slen;
408#ifdef VMS
409 long rlen;
410 char * ptr, * rptr;
411 char bracket;
412 struct FAB fab = cc$rms_fab;
413 struct NAM nam = cc$rms_nam;
414 char esa[NAM$C_MAXRSS];
415#endif /* VMS */
416
417 slen = strlen (src);
418#ifdef VMS
419 if (! index (src, '/')
420 && (src[slen - 1] == ']'
421 || src[slen - 1] == ':'
422 || src[slen - 1] == '>'))
423 {
424 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
425 fab.fab$l_fna = src;
426 fab.fab$b_fns = slen;
427 fab.fab$l_nam = &nam;
428 fab.fab$l_fop = FAB$M_NAM;
429
430 nam.nam$l_esa = esa;
431 nam.nam$b_ess = sizeof esa;
432 nam.nam$b_nop |= NAM$M_SYNCHK;
433
434 /* We call SYS$PARSE to handle such things as [--] for us. */
435 if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL)
436 {
437 slen = nam.nam$b_esl;
438 if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
439 slen -= 2;
440 esa[slen] = '\0';
441 src = esa;
442 }
443 if (src[slen - 1] != ']' && src[slen - 1] != '>')
444 {
445 /* what about when we have logical_name:???? */
446 if (src[slen - 1] == ':')
447 { /* Xlate logical name and see what we get */
448 ptr = strcpy (dst, src); /* upper case for getenv */
449 while (*ptr)
450 {
451 if ('a' <= *ptr && *ptr <= 'z')
452 *ptr -= 040;
453 ptr++;
454 }
455 dst[slen - 1] = 0; /* remove colon */
456 if (!(src = egetenv (dst)))
457 return 0;
458 /* should we jump to the beginning of this procedure?
459 Good points: allows us to use logical names that xlate
460 to Unix names,
461 Bad points: can be a problem if we just translated to a device
462 name...
463 For now, I'll punt and always expect VMS names, and hope for
464 the best! */
465 slen = strlen (src);
466 if (src[slen - 1] != ']' && src[slen - 1] != '>')
467 { /* no recursion here! */
468 strcpy (dst, src);
469 return 0;
470 }
471 }
472 else
473 { /* not a directory spec */
474 strcpy (dst, src);
475 return 0;
476 }
477 }
478 bracket = src[slen - 1];
479
480 /* If bracket is ']' or '>', bracket - 2 is the corresponding
481 opening bracket. */
bfb61299
JB		 482 ptr = index (src, bracket - 2);
483 if (ptr == 0)
570d7624
JB		 484 { /* no opening bracket */
485 strcpy (dst, src);
486 return 0;
487 }
488 if (!(rptr = rindex (src, '.')))
489 rptr = ptr;
490 slen = rptr - src;
491 strncpy (dst, src, slen);
492 dst[slen] = '\0';
493 if (*rptr == '.')
494 {
495 dst[slen++] = bracket;
496 dst[slen] = '\0';
497 }
498 else
499 {
500 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
501 then translate the device and recurse. */
502 if (dst[slen - 1] == ':'
503 && dst[slen - 2] != ':' /* skip decnet nodes */
504 && strcmp(src + slen, "[000000]") == 0)
505 {
506 dst[slen - 1] = '\0';
507 if ((ptr = egetenv (dst))
508 && (rlen = strlen (ptr) - 1) > 0
509 && (ptr[rlen] == ']' || ptr[rlen] == '>')
510 && ptr[rlen - 1] == '.')
511 {
72b21817
RS		 512 char * buf = (char *) alloca (strlen (ptr) + 1);
513 strcpy (buf, ptr);
514 buf[rlen - 1] = ']';
515 buf[rlen] = '\0';
516 return directory_file_name (buf, dst);
570d7624
JB		 517 }
518 else
519 dst[slen - 1] = ':';
520 }
521 strcat (dst, "[000000]");
522 slen += 8;
523 }
524 rptr++;
525 rlen = strlen (rptr) - 1;
526 strncat (dst, rptr, rlen);
527 dst[slen + rlen] = '\0';
528 strcat (dst, ".DIR.1");
529 return 1;
530 }
531#endif /* VMS */
532 /* Process as Unix format: just remove any final slash.
533 But leave "/" unchanged; do not change it to "". */
534 strcpy (dst, src);
4746118a 535 if (slen > 1 && dst[slen - 1] == '/')
570d7624
JB		 536 dst[slen - 1] = 0;
537 return 1;
538}
539
540DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
541 1, 1, 0,
542 "Returns the file name of the directory named DIR.\n\
543This is the name of the file that holds the data for the directory DIR.\n\
544This operation exists because a directory is also a file, but its name as\n\
545a directory is different from its name as a file.\n\
546In Unix-syntax, this function just removes the final slash.\n\
547On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
548it returns a file name such as \"[X]Y.DIR.1\".")
549 (directory)
550 Lisp_Object directory;
551{
552 char *buf;
0bf2eed2 553 Lisp_Object handler;
570d7624
JB		 554
555 CHECK_STRING (directory, 0);
556
265a9e55 557 if (NILP (directory))
570d7624 558 return Qnil;
0bf2eed2
RS		 559
560 /* If the file name has special constructs in it,
561 call the corresponding file handler. */
642ef245 562 handler = Ffind_file_name_handler (directory);
0bf2eed2
RS		 563 if (!NILP (handler))
564 return call2 (handler, Qdirectory_file_name, directory);
565
570d7624
JB		 566#ifdef VMS
567 /* 20 extra chars is insufficient for VMS, since we might perform a
568 logical name translation. an equivalence string can be up to 255
569 chars long, so grab that much extra space... - sss */
570 buf = (char *) alloca (XSTRING (directory)->size + 20 + 255);
571#else
572 buf = (char *) alloca (XSTRING (directory)->size + 20);
573#endif
574 directory_file_name (XSTRING (directory)->data, buf);
575 return build_string (buf);
576}
577
578DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
579 "Generate temporary file name (string) starting with PREFIX (a string).\n\
580The Emacs process number forms part of the result,\n\
581so there is no danger of generating a name being used by another process.")
582 (prefix)
583 Lisp_Object prefix;
584{
585 Lisp_Object val;
586 val = concat2 (prefix, build_string ("XXXXXX"));
587 mktemp (XSTRING (val)->data);
588 return val;
589}
590\f
591DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
592 "Convert FILENAME to absolute, and canonicalize it.\n\
593Second arg DEFAULT is directory to start with if FILENAME is relative\n\
594 (does not start with slash); if DEFAULT is nil or missing,\n\
595the current buffer's value of default-directory is used.\n\
b72dea2a
JB		 596Path components that are `.' are removed, and \n\
597path components followed by `..' are removed, along with the `..' itself;\n\
598note that these simplifications are done without checking the resulting\n\
599paths in the file system.\n\
600An initial `~/' expands to your home directory.\n\
601An initial `~USER/' expands to USER's home directory.\n\
570d7624
JB		 602See also the function `substitute-in-file-name'.")
603 (name, defalt)
604 Lisp_Object name, defalt;
605{
606 unsigned char *nm;
607
608 register unsigned char *newdir, *p, *o;
609 int tlen;
610 unsigned char *target;
611 struct passwd *pw;
570d7624
JB		 612#ifdef VMS
613 unsigned char * colon = 0;
614 unsigned char * close = 0;
615 unsigned char * slash = 0;
616 unsigned char * brack = 0;
617 int lbrack = 0, rbrack = 0;
618 int dots = 0;
619#endif /* VMS */
0bf2eed2 620 Lisp_Object handler;
570d7624
JB		 621
622 CHECK_STRING (name, 0);
623
0bf2eed2
RS		 624 /* If the file name has special constructs in it,
625 call the corresponding file handler. */
642ef245 626 handler = Ffind_file_name_handler (name);
0bf2eed2 627 if (!NILP (handler))
09121adc 628 return call3 (handler, Qexpand_file_name, name, defalt);
0bf2eed2 629
4ad827c5
RS		 630 /* Use the buffer's default-directory if DEFALT is omitted. */
631 if (NILP (defalt))
632 defalt = current_buffer->directory;
633 CHECK_STRING (defalt, 1);
634
f14b1c68
JB		 635 /* Make sure DEFALT is properly expanded.
636 It would be better to do this down below where we actually use
637 defalt. Unfortunately, calling Fexpand_file_name recursively
638 could invoke GC, and the strings might be relocated. This would
639 be annoying because we have pointers into strings lying around
640 that would need adjusting, and people would add new pointers to
641 the code and forget to adjust them, resulting in intermittent bugs.
4ad827c5
RS		 642 Putting this call here avoids all that crud.
643
644 The EQ test avoids infinite recursion. */
645 if (! NILP (defalt) && !EQ (defalt, name)
646 /* This saves time in a common case. */
647 && XSTRING (defalt)->data[0] != '/')
f14b1c68
JB		 648 {
649 struct gcpro gcpro1;
650
651 GCPRO1 (name);
652 defalt = Fexpand_file_name (defalt, Qnil);
653 UNGCPRO;
654 }
655
570d7624
JB		 656#ifdef VMS
657 /* Filenames on VMS are always upper case. */
658 name = Fupcase (name);
659#endif
660
661 nm = XSTRING (name)->data;
662
663 /* If nm is absolute, flush ...// and detect /./ and /../.
664 If no /./ or /../ we can return right away. */
665 if (
666 nm[0] == '/'
667#ifdef VMS
668 || index (nm, ':')
669#endif /* VMS */
670 )
671 {
f14b1c68
JB		 672 /* If it turns out that the filename we want to return is just a
673 suffix of FILENAME, we don't need to go through and edit
674 things; we just need to construct a new string using data
675 starting at the middle of FILENAME. If we set lose to a
676 non-zero value, that means we've discovered that we can't do
677 that cool trick. */
678 int lose = 0;
679
570d7624 680 p = nm;
570d7624
JB		 681 while (*p)
682 {
c77d647e
JB		 683 /* Since we know the path is absolute, we can assume that each
684 element starts with a "/". */
685
686 /* "//" anywhere isn't necessarily hairy; we just start afresh
687 with the second slash. */
570d7624
JB		 688 if (p[0] == '/' && p[1] == '/'
689#ifdef APOLLO
690 /* // at start of filename is meaningful on Apollo system */
691 && nm != p
692#endif /* APOLLO */
693 )
694 nm = p + 1;
c77d647e
JB		 695
696 /* "~" is hairy as the start of any path element. */
570d7624
JB		 697 if (p[0] == '/' && p[1] == '~')
698 nm = p + 1, lose = 1;
c77d647e
JB		 699
700 /* "." and ".." are hairy. */
701 if (p[0] == '/'
702 && p[1] == '.'
703 && (p[2] == '/'
704 || p[2] == 0
705 || (p[2] == '.' && (p[3] == '/'
706 || p[3] == 0))))
570d7624
JB		 707 lose = 1;
708#ifdef VMS
709 if (p[0] == '\\')
710 lose = 1;
711 if (p[0] == '/') {
712 /* if dev:[dir]/, move nm to / */
713 if (!slash && p > nm && (brack || colon)) {
714 nm = (brack ? brack + 1 : colon + 1);
715 lbrack = rbrack = 0;
716 brack = 0;
717 colon = 0;
718 }
719 slash = p;
720 }
721 if (p[0] == '-')
722#ifndef VMS4_4
723 /* VMS pre V4.4,convert '-'s in filenames. */
724 if (lbrack == rbrack)
725 {
726 if (dots < 2) /* this is to allow negative version numbers */
727 p[0] = '_';
728 }
729 else
730#endif /* VMS4_4 */
731 if (lbrack > rbrack &&
732 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
733 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
734 lose = 1;
735#ifndef VMS4_4
736 else
737 p[0] = '_';
738#endif /* VMS4_4 */
739 /* count open brackets, reset close bracket pointer */
740 if (p[0] == '[' || p[0] == '<')
741 lbrack++, brack = 0;
742 /* count close brackets, set close bracket pointer */
743 if (p[0] == ']' || p[0] == '>')
744 rbrack++, brack = p;
745 /* detect ][ or >< */
746 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
747 lose = 1;
748 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
749 nm = p + 1, lose = 1;
750 if (p[0] == ':' && (colon || slash))
751 /* if dev1:[dir]dev2:, move nm to dev2: */
752 if (brack)
753 {
754 nm = brack + 1;
755 brack = 0;
756 }
757 /* if /pathname/dev:, move nm to dev: */
758 else if (slash)
759 nm = slash + 1;
760 /* if node::dev:, move colon following dev */
761 else if (colon && colon[-1] == ':')
762 colon = p;
763 /* if dev1:dev2:, move nm to dev2: */
764 else if (colon && colon[-1] != ':')
765 {
766 nm = colon + 1;
767 colon = 0;
768 }
769 if (p[0] == ':' && !colon)
770 {
771 if (p[1] == ':')
772 p++;
773 colon = p;
774 }
775 if (lbrack == rbrack)
776 if (p[0] == ';')
777 dots = 2;
778 else if (p[0] == '.')
779 dots++;
780#endif /* VMS */
781 p++;
782 }
783 if (!lose)
784 {
785#ifdef VMS
786 if (index (nm, '/'))
787 return build_string (sys_translate_unix (nm));
788#endif /* VMS */
789 if (nm == XSTRING (name)->data)
790 return name;
791 return build_string (nm);
792 }
793 }
794
795 /* Now determine directory to start with and put it in newdir */
796
797 newdir = 0;
798
799 if (nm[0] == '~') /* prefix ~ */
c77d647e
JB		 800 {
801 if (nm[1] == '/'
570d7624 802#ifdef VMS
c77d647e
JB		 803 || nm[1] == ':'
804#endif /* VMS */
805 || nm[1] == 0) /* ~ by itself */
806 {
807 if (!(newdir = (unsigned char *) egetenv ("HOME")))
808 newdir = (unsigned char *) "";
809 nm++;
570d7624 810#ifdef VMS
c77d647e
JB		 811 nm++; /* Don't leave the slash in nm. */
812#endif /* VMS */
813 }
814 else /* ~user/filename */
815 {
816 for (p = nm; *p && (*p != '/'
570d7624 817#ifdef VMS
c77d647e
JB		 818 && *p != ':'
819#endif /* VMS */
820 ); p++);
821 o = (unsigned char *) alloca (p - nm + 1);
822 bcopy ((char *) nm, o, p - nm);
823 o [p - nm] = 0;
824
825 pw = (struct passwd *) getpwnam (o + 1);
826 if (pw)
827 {
828 newdir = (unsigned char *) pw -> pw_dir;
570d7624 829#ifdef VMS
c77d647e 830 nm = p + 1; /* skip the terminator */
570d7624 831#else
c77d647e
JB		 832 nm = p;
833#endif /* VMS */
834 }
e5d77022 835
c77d647e
JB		 836 /* If we don't find a user of that name, leave the name
837 unchanged; don't move nm forward to p. */
838 }
839 }
570d7624
JB		 840
841 if (nm[0] != '/'
842#ifdef VMS
843 && !index (nm, ':')
844#endif /* not VMS */
845 && !newdir)
846 {
570d7624
JB		 847 newdir = XSTRING (defalt)->data;
848 }
849
bfb61299
JB		 850 if (newdir != 0)
851 {
852 /* Get rid of any slash at the end of newdir. */
853 int length = strlen (newdir);
eabf01d4
RS		 854 /* Adding `length > 1 &&' makes ~ expand into / when homedir
855 is the root dir. People disagree about whether that is right.
856 Anyway, we can't take the risk of this change now. */
857 if (newdir[length - 1] == '/')
bfb61299
JB		 858 {
859 unsigned char *temp = (unsigned char *) alloca (length);
860 bcopy (newdir, temp, length - 1);
861 temp[length - 1] = 0;
862 newdir = temp;
863 }
864 tlen = length + 1;
865 }
866 else
867 tlen = 0;
570d7624 868
bfb61299
JB		 869 /* Now concatenate the directory and name to new space in the stack frame */
870 tlen += strlen (nm) + 1;
570d7624
JB		 871 target = (unsigned char *) alloca (tlen);
872 *target = 0;
873
874 if (newdir)
875 {
876#ifndef VMS
877 if (nm[0] == 0 || nm[0] == '/')
878 strcpy (target, newdir);
879 else
880#endif
c77d647e 881 file_name_as_directory (target, newdir);
570d7624
JB		 882 }
883
884 strcat (target, nm);
885#ifdef VMS
886 if (index (target, '/'))
887 strcpy (target, sys_translate_unix (target));
888#endif /* VMS */
889
c77d647e 890 /* Now canonicalize by removing /. and /foo/.. if they appear. */
570d7624
JB		 891
892 p = target;
893 o = target;
894
895 while (*p)
896 {
897#ifdef VMS
898 if (*p != ']' && *p != '>' && *p != '-')
899 {
900 if (*p == '\\')
901 p++;
902 *o++ = *p++;
903 }
904 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
905 /* brackets are offset from each other by 2 */
906 {
907 p += 2;
908 if (*p != '.' && *p != '-' && o[-1] != '.')
909 /* convert [foo][bar] to [bar] */
910 while (o[-1] != '[' && o[-1] != '<')
911 o--;
912 else if (*p == '-' && *o != '.')
913 *--p = '.';
914 }
915 else if (p[0] == '-' && o[-1] == '.' &&
916 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
917 /* flush .foo.- ; leave - if stopped by '[' or '<' */
918 {
919 do
920 o--;
921 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
922 if (p[1] == '.') /* foo.-.bar ==> bar*/
923 p += 2;
924 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
925 p++, o--;
926 /* else [foo.-] ==> [-] */
927 }
928 else
929 {
930#ifndef VMS4_4
931 if (*p == '-' &&
932 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
933 p[1] != ']' && p[1] != '>' && p[1] != '.')
934 *p = '_';
935#endif /* VMS4_4 */
936 *o++ = *p++;
937 }
938#else /* not VMS */
939 if (*p != '/')
940 {
941 *o++ = *p++;
942 }
943 else if (!strncmp (p, "//", 2)
944#ifdef APOLLO
945 /* // at start of filename is meaningful in Apollo system */
946 && o != target
947#endif /* APOLLO */
948 )
949 {
950 o = target;
951 p++;
952 }
c77d647e
JB		 953 else if (p[0] == '/'
954 && p[1] == '.'
955 && (p[2] == '/'
956 || p[2] == 0))
957 {
958 /* If "/." is the entire filename, keep the "/". Otherwise,
959 just delete the whole "/.". */
960 if (o == target && p[2] == '\0')
961 *o++ = *p;
962 p += 2;
963 }
570d7624
JB		 964 else if (!strncmp (p, "/..", 3)
965 /* `/../' is the "superroot" on certain file systems. */
966 && o != target
967 && (p[3] == '/' || p[3] == 0))
968 {
969 while (o != target && *--o != '/')
970 ;
971#ifdef APOLLO
972 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
973 ++o;
974 else
975#endif /* APOLLO */
976 if (o == target && *o == '/')
977 ++o;
978 p += 3;
979 }
980 else
981 {
982 *o++ = *p++;
983 }
984#endif /* not VMS */
985 }
986
987 return make_string (target, o - target);
988}
989#if 0
e5d77022
JB		 990/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
991DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
570d7624
JB		 992 "Convert FILENAME to absolute, and canonicalize it.\n\
993Second arg DEFAULT is directory to start with if FILENAME is relative\n\
994 (does not start with slash); if DEFAULT is nil or missing,\n\
995the current buffer's value of default-directory is used.\n\
996Filenames containing `.' or `..' as components are simplified;\n\
997initial `~/' expands to your home directory.\n\
998See also the function `substitute-in-file-name'.")
999 (name, defalt)
1000 Lisp_Object name, defalt;
1001{
1002 unsigned char *nm;
1003
1004 register unsigned char *newdir, *p, *o;
1005 int tlen;
1006 unsigned char *target;
1007 struct passwd *pw;
1008 int lose;
1009#ifdef VMS
1010 unsigned char * colon = 0;
1011 unsigned char * close = 0;
1012 unsigned char * slash = 0;
1013 unsigned char * brack = 0;
1014 int lbrack = 0, rbrack = 0;
1015 int dots = 0;
1016#endif /* VMS */
1017
1018 CHECK_STRING (name, 0);
1019
1020#ifdef VMS
1021 /* Filenames on VMS are always upper case. */
1022 name = Fupcase (name);
1023#endif
1024
1025 nm = XSTRING (name)->data;
1026
1027 /* If nm is absolute, flush ...// and detect /./ and /../.
1028 If no /./ or /../ we can return right away. */
1029 if (
1030 nm[0] == '/'
1031#ifdef VMS
1032 || index (nm, ':')
1033#endif /* VMS */
1034 )
1035 {
1036 p = nm;
1037 lose = 0;
1038 while (*p)
1039 {
1040 if (p[0] == '/' && p[1] == '/'
1041#ifdef APOLLO
1042 /* // at start of filename is meaningful on Apollo system */
1043 && nm != p
1044#endif /* APOLLO */
1045 )
1046 nm = p + 1;
1047 if (p[0] == '/' && p[1] == '~')
1048 nm = p + 1, lose = 1;
1049 if (p[0] == '/' && p[1] == '.'
1050 && (p[2] == '/' || p[2] == 0
1051 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1052 lose = 1;
1053#ifdef VMS
1054 if (p[0] == '\\')
1055 lose = 1;
1056 if (p[0] == '/') {
1057 /* if dev:[dir]/, move nm to / */
1058 if (!slash && p > nm && (brack || colon)) {
1059 nm = (brack ? brack + 1 : colon + 1);
1060 lbrack = rbrack = 0;
1061 brack = 0;
1062 colon = 0;
1063 }
1064 slash = p;
1065 }
1066 if (p[0] == '-')
1067#ifndef VMS4_4
1068 /* VMS pre V4.4,convert '-'s in filenames. */
1069 if (lbrack == rbrack)
1070 {
1071 if (dots < 2) /* this is to allow negative version numbers */
1072 p[0] = '_';
1073 }
1074 else
1075#endif /* VMS4_4 */
1076 if (lbrack > rbrack &&
1077 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
1078 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
1079 lose = 1;
1080#ifndef VMS4_4
1081 else
1082 p[0] = '_';
1083#endif /* VMS4_4 */
1084 /* count open brackets, reset close bracket pointer */
1085 if (p[0] == '[' || p[0] == '<')
1086 lbrack++, brack = 0;
1087 /* count close brackets, set close bracket pointer */
1088 if (p[0] == ']' || p[0] == '>')
1089 rbrack++, brack = p;
1090 /* detect ][ or >< */
1091 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
1092 lose = 1;
1093 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
1094 nm = p + 1, lose = 1;
1095 if (p[0] == ':' && (colon || slash))
1096 /* if dev1:[dir]dev2:, move nm to dev2: */
1097 if (brack)
1098 {
1099 nm = brack + 1;
1100 brack = 0;
1101 }
1102 /* if /pathname/dev:, move nm to dev: */
1103 else if (slash)
1104 nm = slash + 1;
1105 /* if node::dev:, move colon following dev */
1106 else if (colon && colon[-1] == ':')
1107 colon = p;
1108 /* if dev1:dev2:, move nm to dev2: */
1109 else if (colon && colon[-1] != ':')
1110 {
1111 nm = colon + 1;
1112 colon = 0;
1113 }
1114 if (p[0] == ':' && !colon)
1115 {
1116 if (p[1] == ':')
1117 p++;
1118 colon = p;
1119 }
1120 if (lbrack == rbrack)
1121 if (p[0] == ';')
1122 dots = 2;
1123 else if (p[0] == '.')
1124 dots++;
1125#endif /* VMS */
1126 p++;
1127 }
1128 if (!lose)
1129 {
1130#ifdef VMS
1131 if (index (nm, '/'))
1132 return build_string (sys_translate_unix (nm));
1133#endif /* VMS */
1134 if (nm == XSTRING (name)->data)
1135 return name;
1136 return build_string (nm);
1137 }
1138 }
1139
1140 /* Now determine directory to start with and put it in NEWDIR */
1141
1142 newdir = 0;
1143
1144 if (nm[0] == '~') /* prefix ~ */
1145 if (nm[1] == '/'
1146#ifdef VMS
1147 || nm[1] == ':'
1148#endif /* VMS */
1149 || nm[1] == 0)/* ~/filename */
1150 {
1151 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1152 newdir = (unsigned char *) "";
1153 nm++;
1154#ifdef VMS
1155 nm++; /* Don't leave the slash in nm. */
1156#endif /* VMS */
1157 }
1158 else /* ~user/filename */
1159 {
1160 /* Get past ~ to user */
1161 unsigned char *user = nm + 1;
1162 /* Find end of name. */
1163 unsigned char *ptr = (unsigned char *) index (user, '/');
1164 int len = ptr ? ptr - user : strlen (user);
1165#ifdef VMS
1166 unsigned char *ptr1 = index (user, ':');
1167 if (ptr1 != 0 && ptr1 - user < len)
1168 len = ptr1 - user;
1169#endif /* VMS */
1170 /* Copy the user name into temp storage. */
1171 o = (unsigned char *) alloca (len + 1);
1172 bcopy ((char *) user, o, len);
1173 o[len] = 0;
1174
1175 /* Look up the user name. */
1176 pw = (struct passwd *) getpwnam (o + 1);
1177 if (!pw)
1178 error ("\"%s\" isn't a registered user", o + 1);
1179
1180 newdir = (unsigned char *) pw->pw_dir;
1181
1182 /* Discard the user name from NM. */
1183 nm += len;
1184 }
1185
1186 if (nm[0] != '/'
1187#ifdef VMS
1188 && !index (nm, ':')
1189#endif /* not VMS */
1190 && !newdir)
1191 {
265a9e55 1192 if (NILP (defalt))
570d7624
JB		 1193 defalt = current_buffer->directory;
1194 CHECK_STRING (defalt, 1);
1195 newdir = XSTRING (defalt)->data;
1196 }
1197
1198 /* Now concatenate the directory and name to new space in the stack frame */
1199
1200 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
1201 target = (unsigned char *) alloca (tlen);
1202 *target = 0;
1203
1204 if (newdir)
1205 {
1206#ifndef VMS
1207 if (nm[0] == 0 || nm[0] == '/')
1208 strcpy (target, newdir);
1209 else
1210#endif
1211 file_name_as_directory (target, newdir);
1212 }
1213
1214 strcat (target, nm);
1215#ifdef VMS
1216 if (index (target, '/'))
1217 strcpy (target, sys_translate_unix (target));
1218#endif /* VMS */
1219
1220 /* Now canonicalize by removing /. and /foo/.. if they appear */
1221
1222 p = target;
1223 o = target;
1224
1225 while (*p)
1226 {
1227#ifdef VMS
1228 if (*p != ']' && *p != '>' && *p != '-')
1229 {
1230 if (*p == '\\')
1231 p++;
1232 *o++ = *p++;
1233 }
1234 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
1235 /* brackets are offset from each other by 2 */
1236 {
1237 p += 2;
1238 if (*p != '.' && *p != '-' && o[-1] != '.')
1239 /* convert [foo][bar] to [bar] */
1240 while (o[-1] != '[' && o[-1] != '<')
1241 o--;
1242 else if (*p == '-' && *o != '.')
1243 *--p = '.';
1244 }
1245 else if (p[0] == '-' && o[-1] == '.' &&
1246 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
1247 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1248 {
1249 do
1250 o--;
1251 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
1252 if (p[1] == '.') /* foo.-.bar ==> bar*/
1253 p += 2;
1254 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
1255 p++, o--;
1256 /* else [foo.-] ==> [-] */
1257 }
1258 else
1259 {
1260#ifndef VMS4_4
1261 if (*p == '-' &&
1262 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
1263 p[1] != ']' && p[1] != '>' && p[1] != '.')
1264 *p = '_';
1265#endif /* VMS4_4 */
1266 *o++ = *p++;
1267 }
1268#else /* not VMS */
1269 if (*p != '/')
1270 {
1271 *o++ = *p++;
1272 }
1273 else if (!strncmp (p, "//", 2)
1274#ifdef APOLLO
1275 /* // at start of filename is meaningful in Apollo system */
1276 && o != target
1277#endif /* APOLLO */
1278 )
1279 {
1280 o = target;
1281 p++;
1282 }
1283 else if (p[0] == '/' && p[1] == '.' &&
1284 (p[2] == '/' || p[2] == 0))
1285 p += 2;
1286 else if (!strncmp (p, "/..", 3)
1287 /* `/../' is the "superroot" on certain file systems. */
1288 && o != target
1289 && (p[3] == '/' || p[3] == 0))
1290 {
1291 while (o != target && *--o != '/')
1292 ;
1293#ifdef APOLLO
1294 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
1295 ++o;
1296 else
1297#endif /* APOLLO */
1298 if (o == target && *o == '/')
1299 ++o;
1300 p += 3;
1301 }
1302 else
1303 {
1304 *o++ = *p++;
1305 }
1306#endif /* not VMS */
1307 }
1308
1309 return make_string (target, o - target);
1310}
1311#endif
1312\f
1313DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1314 Ssubstitute_in_file_name, 1, 1, 0,
1315 "Substitute environment variables referred to in FILENAME.\n\
1316`$FOO' where FOO is an environment variable name means to substitute\n\
1317the value of that variable. The variable name should be terminated\n\
1318with a character not a letter, digit or underscore; otherwise, enclose\n\
1319the entire variable name in braces.\n\
1320If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1321On VMS, `$' substitution is not done; this function does little and only\n\
1322duplicates what `expand-file-name' does.")
1323 (string)
1324 Lisp_Object string;
1325{
1326 unsigned char *nm;
1327
1328 register unsigned char *s, *p, *o, *x, *endp;
1329 unsigned char *target;
1330 int total = 0;
1331 int substituted = 0;
1332 unsigned char *xnm;
1333
1334 CHECK_STRING (string, 0);
1335
1336 nm = XSTRING (string)->data;
1337 endp = nm + XSTRING (string)->size;
1338
1339 /* If /~ or // appears, discard everything through first slash. */
1340
1341 for (p = nm; p != endp; p++)
1342 {
1343 if ((p[0] == '~' ||
1344#ifdef APOLLO
1345 /* // at start of file name is meaningful in Apollo system */
1346 (p[0] == '/' && p - 1 != nm)
1347#else /* not APOLLO */
1348 p[0] == '/'
1349#endif /* not APOLLO */
1350 )
1351 && p != nm &&
1352#ifdef VMS
1353 (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' ||
1354#endif /* VMS */
1355 p[-1] == '/')
1356#ifdef VMS
1357 )
1358#endif /* VMS */
1359 {
1360 nm = p;
1361 substituted = 1;
1362 }
1363 }
1364
1365#ifdef VMS
1366 return build_string (nm);
1367#else
1368
1369 /* See if any variables are substituted into the string
1370 and find the total length of their values in `total' */
1371
1372 for (p = nm; p != endp;)
1373 if (*p != '$')
1374 p++;
1375 else
1376 {
1377 p++;
1378 if (p == endp)
1379 goto badsubst;
1380 else if (*p == '$')
1381 {
1382 /* "$$" means a single "$" */
1383 p++;
1384 total -= 1;
1385 substituted = 1;
1386 continue;
1387 }
1388 else if (*p == '{')
1389 {
1390 o = ++p;
1391 while (p != endp && *p != '}') p++;
1392 if (*p != '}') goto missingclose;
1393 s = p;
1394 }
1395 else
1396 {
1397 o = p;
1398 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1399 s = p;
1400 }
1401
1402 /* Copy out the variable name */
1403 target = (unsigned char *) alloca (s - o + 1);
1404 strncpy (target, o, s - o);
1405 target[s - o] = 0;
1406
1407 /* Get variable value */
1408 o = (unsigned char *) egetenv (target);
1409/* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1410#if 0
1411#ifdef USG
1412 if (!o && !strcmp (target, "USER"))
1413 o = egetenv ("LOGNAME");
1414#endif /* USG */
1415#endif /* 0 */
1416 if (!o) goto badvar;
1417 total += strlen (o);
1418 substituted = 1;
1419 }
1420
1421 if (!substituted)
1422 return string;
1423
1424 /* If substitution required, recopy the string and do it */
1425 /* Make space in stack frame for the new copy */
1426 xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1);
1427 x = xnm;
1428
1429 /* Copy the rest of the name through, replacing $ constructs with values */
1430 for (p = nm; *p;)
1431 if (*p != '$')
1432 *x++ = *p++;
1433 else
1434 {
1435 p++;
1436 if (p == endp)
1437 goto badsubst;
1438 else if (*p == '$')
1439 {
1440 *x++ = *p++;
1441 continue;
1442 }
1443 else if (*p == '{')
1444 {
1445 o = ++p;
1446 while (p != endp && *p != '}') p++;
1447 if (*p != '}') goto missingclose;
1448 s = p++;
1449 }
1450 else
1451 {
1452 o = p;
1453 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1454 s = p;
1455 }
1456
1457 /* Copy out the variable name */
1458 target = (unsigned char *) alloca (s - o + 1);
1459 strncpy (target, o, s - o);
1460 target[s - o] = 0;
1461
1462 /* Get variable value */
1463 o = (unsigned char *) egetenv (target);
1464/* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1465#if 0
1466#ifdef USG
1467 if (!o && !strcmp (target, "USER"))
1468 o = egetenv ("LOGNAME");
1469#endif /* USG */
1470#endif /* 0 */
1471 if (!o)
1472 goto badvar;
1473
1474 strcpy (x, o);
1475 x += strlen (o);
1476 }
1477
1478 *x = 0;
1479
1480 /* If /~ or // appears, discard everything through first slash. */
1481
1482 for (p = xnm; p != x; p++)
1483 if ((p[0] == '~' ||
1484#ifdef APOLLO
1485 /* // at start of file name is meaningful in Apollo system */
1486 (p[0] == '/' && p - 1 != xnm)
1487#else /* not APOLLO */
1488 p[0] == '/'
1489#endif /* not APOLLO */
1490 )
1491 && p != nm && p[-1] == '/')
1492 xnm = p;
1493
1494 return make_string (xnm, x - xnm);
1495
1496 badsubst:
1497 error ("Bad format environment-variable substitution");
1498 missingclose:
1499 error ("Missing \"}\" in environment-variable substitution");
1500 badvar:
1501 error ("Substituting nonexistent environment variable \"%s\"", target);
1502
1503 /* NOTREACHED */
1504#endif /* not VMS */
1505}
1506\f
067ffa38
JB		 1507/* A slightly faster and more convenient way to get
1508 (directory-file-name (expand-file-name FOO)). The return value may
1509 have had its last character zapped with a '\0' character, meaning
1510 that it is acceptable to system calls, but not to other lisp
1511 functions. Callers should make sure that the return value doesn't
1512 escape. */
1513
570d7624
JB		 1514Lisp_Object
1515expand_and_dir_to_file (filename, defdir)
1516 Lisp_Object filename, defdir;
1517{
1518 register Lisp_Object abspath;
1519
1520 abspath = Fexpand_file_name (filename, defdir);
1521#ifdef VMS
1522 {
1523 register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1];
1524 if (c == ':' || c == ']' || c == '>')
1525 abspath = Fdirectory_file_name (abspath);
1526 }
1527#else
1528 /* Remove final slash, if any (unless path is root).
1529 stat behaves differently depending! */
1530 if (XSTRING (abspath)->size > 1
1531 && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
1532 {
1533 if (EQ (abspath, filename))
1534 abspath = Fcopy_sequence (abspath);
1535 XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
1536 }
1537#endif
1538 return abspath;
1539}
1540\f
1541barf_or_query_if_file_exists (absname, querystring, interactive)
1542 Lisp_Object absname;
1543 unsigned char *querystring;
1544 int interactive;
1545{
1546 register Lisp_Object tem;
1547 struct gcpro gcpro1;
1548
1549 if (access (XSTRING (absname)->data, 4) >= 0)
1550 {
1551 if (! interactive)
1552 Fsignal (Qfile_already_exists,
1553 Fcons (build_string ("File already exists"),
1554 Fcons (absname, Qnil)));
1555 GCPRO1 (absname);
1556 tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1557 XSTRING (absname)->data, querystring));
1558 UNGCPRO;
265a9e55 1559 if (NILP (tem))
570d7624
JB		 1560 Fsignal (Qfile_already_exists,
1561 Fcons (build_string ("File already exists"),
1562 Fcons (absname, Qnil)));
1563 }
1564 return;
1565}
1566
1567DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
349a7710 1568 "fCopy file: \nFCopy %s to file: \np\nP",
570d7624
JB		 1569 "Copy FILE to NEWNAME. Both args must be strings.\n\
1570Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1571unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1572A number as third arg means request confirmation if NEWNAME already exists.\n\
1573This is what happens in interactive use with M-x.\n\
349a7710
JB		 1574Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1575last-modified time as the old one. (This works on only some systems.)\n\
1576A prefix arg makes KEEP-TIME non-nil.")
570d7624
JB		 1577 (filename, newname, ok_if_already_exists, keep_date)
1578 Lisp_Object filename, newname, ok_if_already_exists, keep_date;
1579{
1580 int ifd, ofd, n;
1581 char buf[16 * 1024];
1582 struct stat st;
32f4334d 1583 Lisp_Object handler;
570d7624 1584 struct gcpro gcpro1, gcpro2;
b5148e85 1585 int count = specpdl_ptr - specpdl;
570d7624
JB		 1586
1587 GCPRO2 (filename, newname);
1588 CHECK_STRING (filename, 0);
1589 CHECK_STRING (newname, 1);
1590 filename = Fexpand_file_name (filename, Qnil);
1591 newname = Fexpand_file_name (newname, Qnil);
32f4334d 1592
0bf2eed2 1593 /* If the input file name has special constructs in it,
32f4334d 1594 call the corresponding file handler. */
642ef245 1595 handler = Ffind_file_name_handler (filename);
0bf2eed2
RS		 1596 if (!NILP (handler))
1597 return call3 (handler, Qcopy_file, filename, newname);
1598 /* Likewise for output file name. */
642ef245 1599 handler = Ffind_file_name_handler (newname);
32f4334d
RS		 1600 if (!NILP (handler))
1601 return call3 (handler, Qcopy_file, filename, newname);
1602
265a9e55 1603 if (NILP (ok_if_already_exists)
570d7624
JB		 1604 || XTYPE (ok_if_already_exists) == Lisp_Int)
1605 barf_or_query_if_file_exists (newname, "copy to it",
1606 XTYPE (ok_if_already_exists) == Lisp_Int);
1607
1608 ifd = open (XSTRING (filename)->data, 0);
1609 if (ifd < 0)
1610 report_file_error ("Opening input file", Fcons (filename, Qnil));
1611
b5148e85
RS		 1612 record_unwind_protect (close_file_unwind, make_number (ifd));
1613
570d7624
JB		 1614#ifdef VMS
1615 /* Create the copy file with the same record format as the input file */
1616 ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
1617#else
1618 ofd = creat (XSTRING (newname)->data, 0666);
1619#endif /* VMS */
1620 if (ofd < 0)
66331187 1621 report_file_error ("Opening output file", Fcons (newname, Qnil));
b5148e85
RS		 1622
1623 record_unwind_protect (close_file_unwind, make_number (ofd));
570d7624 1624
b5148e85
RS		 1625 immediate_quit = 1;
1626 QUIT;
570d7624
JB		 1627 while ((n = read (ifd, buf, sizeof buf)) > 0)
1628 if (write (ofd, buf, n) != n)
66331187 1629 report_file_error ("I/O error", Fcons (newname, Qnil));
b5148e85 1630 immediate_quit = 0;
570d7624
JB		 1631
1632 if (fstat (ifd, &st) >= 0)
1633 {
265a9e55 1634 if (!NILP (keep_date))
570d7624 1635 {
de5bf5d3
JB		 1636 EMACS_TIME atime, mtime;
1637 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1638 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1639 EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime);
570d7624 1640 }
570d7624
JB		 1641#ifdef APOLLO
1642 if (!egetenv ("USE_DOMAIN_ACLS"))
1643#endif
de5bf5d3 1644 chmod (XSTRING (newname)->data, st.st_mode & 07777);
570d7624
JB		 1645 }
1646
b5148e85
RS		 1647 /* Discard the unwind protects. */
1648 specpdl_ptr = specpdl + count;
1649
570d7624
JB		 1650 close (ifd);
1651 if (close (ofd) < 0)
1652 report_file_error ("I/O error", Fcons (newname, Qnil));
1653
1654 UNGCPRO;
1655 return Qnil;
1656}
1657
9bbe01fb 1658DEFUN ("make-directory-internal", Fmake_directory_internal,
353cfc19 1659 Smake_directory_internal, 1, 1, 0,
570d7624
JB		 1660 "Create a directory. One argument, a file name string.")
1661 (dirname)
1662 Lisp_Object dirname;
1663{
1664 unsigned char *dir;
32f4334d 1665 Lisp_Object handler;
570d7624
JB		 1666
1667 CHECK_STRING (dirname, 0);
1668 dirname = Fexpand_file_name (dirname, Qnil);
32f4334d 1669
642ef245 1670 handler = Ffind_file_name_handler (dirname);
32f4334d 1671 if (!NILP (handler))
9bbe01fb
RS		 1672 return call3 (handler, Qmake_directory, dirname, Qnil);
1673
570d7624
JB		 1674 dir = XSTRING (dirname)->data;
1675
1676 if (mkdir (dir, 0777) != 0)
1677 report_file_error ("Creating directory", Flist (1, &dirname));
1678
32f4334d 1679 return Qnil;
570d7624
JB		 1680}
1681
aa734e17
RS		 1682DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
1683 "Delete a directory. One argument, a file name string.")
570d7624
JB		 1684 (dirname)
1685 Lisp_Object dirname;
1686{
1687 unsigned char *dir;
32f4334d 1688 Lisp_Object handler;
570d7624
JB		 1689
1690 CHECK_STRING (dirname, 0);
1691 dirname = Fexpand_file_name (dirname, Qnil);
1692 dir = XSTRING (dirname)->data;
1693
642ef245 1694 handler = Ffind_file_name_handler (dirname);
32f4334d
RS		 1695 if (!NILP (handler))
1696 return call2 (handler, Qdelete_directory, dirname);
1697
570d7624
JB		 1698 if (rmdir (dir) != 0)
1699 report_file_error ("Removing directory", Flist (1, &dirname));
1700
1701 return Qnil;
1702}
1703
1704DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
1705 "Delete specified file. One argument, a file name string.\n\
1706If file has multiple names, it continues to exist with the other names.")
1707 (filename)
1708 Lisp_Object filename;
1709{
32f4334d 1710 Lisp_Object handler;
570d7624
JB		 1711 CHECK_STRING (filename, 0);
1712 filename = Fexpand_file_name (filename, Qnil);
32f4334d 1713
642ef245 1714 handler = Ffind_file_name_handler (filename);
32f4334d
RS		 1715 if (!NILP (handler))
1716 return call2 (handler, Qdelete_file, filename);
1717
570d7624
JB		 1718 if (0 > unlink (XSTRING (filename)->data))
1719 report_file_error ("Removing old name", Flist (1, &filename));
1720 return Qnil;
1721}
1722
1723DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
1724 "fRename file: \nFRename %s to file: \np",
1725 "Rename FILE as NEWNAME. Both args strings.\n\
1726If file has names other than FILE, it continues to have those names.\n\
1727Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1728unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1729A number as third arg means request confirmation if NEWNAME already exists.\n\
1730This is what happens in interactive use with M-x.")
1731 (filename, newname, ok_if_already_exists)
1732 Lisp_Object filename, newname, ok_if_already_exists;
1733{
1734#ifdef NO_ARG_ARRAY
1735 Lisp_Object args[2];
1736#endif
32f4334d 1737 Lisp_Object handler;
570d7624
JB		 1738 struct gcpro gcpro1, gcpro2;
1739
1740 GCPRO2 (filename, newname);
1741 CHECK_STRING (filename, 0);
1742 CHECK_STRING (newname, 1);
1743 filename = Fexpand_file_name (filename, Qnil);
1744 newname = Fexpand_file_name (newname, Qnil);
32f4334d
RS		 1745
1746 /* If the file name has special constructs in it,
1747 call the corresponding file handler. */
642ef245 1748 handler = Ffind_file_name_handler (filename);
32f4334d
RS		 1749 if (!NILP (handler))
1750 return call3 (handler, Qrename_file, filename, newname);
1751
265a9e55 1752 if (NILP (ok_if_already_exists)
570d7624
JB		 1753 || XTYPE (ok_if_already_exists) == Lisp_Int)
1754 barf_or_query_if_file_exists (newname, "rename to it",
1755 XTYPE (ok_if_already_exists) == Lisp_Int);
1756#ifndef BSD4_1
1757 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
1758#else
1759 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)
1760 || 0 > unlink (XSTRING (filename)->data))
1761#endif
1762 {
1763 if (errno == EXDEV)
1764 {
1765 Fcopy_file (filename, newname, ok_if_already_exists, Qt);
1766 Fdelete_file (filename);
1767 }
1768 else
1769#ifdef NO_ARG_ARRAY
1770 {
1771 args[0] = filename;
1772 args[1] = newname;
1773 report_file_error ("Renaming", Flist (2, args));
1774 }
1775#else
1776 report_file_error ("Renaming", Flist (2, &filename));
1777#endif
1778 }
1779 UNGCPRO;
1780 return Qnil;
1781}
1782
1783DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
1784 "fAdd name to file: \nFName to add to %s: \np",
1785 "Give FILE additional name NEWNAME. Both args strings.\n\
1786Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1787unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1788A number as third arg means request confirmation if NEWNAME already exists.\n\
1789This is what happens in interactive use with M-x.")
1790 (filename, newname, ok_if_already_exists)
1791 Lisp_Object filename, newname, ok_if_already_exists;
1792{
1793#ifdef NO_ARG_ARRAY
1794 Lisp_Object args[2];
1795#endif
32f4334d 1796 Lisp_Object handler;
570d7624
JB		 1797 struct gcpro gcpro1, gcpro2;
1798
1799 GCPRO2 (filename, newname);
1800 CHECK_STRING (filename, 0);
1801 CHECK_STRING (newname, 1);
1802 filename = Fexpand_file_name (filename, Qnil);
1803 newname = Fexpand_file_name (newname, Qnil);
32f4334d
RS		 1804
1805 /* If the file name has special constructs in it,
1806 call the corresponding file handler. */
642ef245 1807 handler = Ffind_file_name_handler (filename);
32f4334d
RS		 1808 if (!NILP (handler))
1809 return call3 (handler, Qadd_name_to_file, filename, newname);
1810
265a9e55 1811 if (NILP (ok_if_already_exists)
570d7624
JB		 1812 || XTYPE (ok_if_already_exists) == Lisp_Int)
1813 barf_or_query_if_file_exists (newname, "make it a new name",
1814 XTYPE (ok_if_already_exists) == Lisp_Int);
1815 unlink (XSTRING (newname)->data);
1816 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
1817 {
1818#ifdef NO_ARG_ARRAY
1819 args[0] = filename;
1820 args[1] = newname;
1821 report_file_error ("Adding new name", Flist (2, args));
1822#else
1823 report_file_error ("Adding new name", Flist (2, &filename));
1824#endif
1825 }
1826
1827 UNGCPRO;
1828 return Qnil;
1829}
1830
1831#ifdef S_IFLNK
1832DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
1833 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1834 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1835Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1836unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1837A number as third arg means request confirmation if NEWNAME already exists.\n\
1838This happens for interactive use with M-x.")
e5d77022
JB		 1839 (filename, linkname, ok_if_already_exists)
1840 Lisp_Object filename, linkname, ok_if_already_exists;
570d7624
JB		 1841{
1842#ifdef NO_ARG_ARRAY
1843 Lisp_Object args[2];
1844#endif
32f4334d 1845 Lisp_Object handler;
570d7624
JB		 1846 struct gcpro gcpro1, gcpro2;
1847
e5d77022 1848 GCPRO2 (filename, linkname);
570d7624 1849 CHECK_STRING (filename, 0);
e5d77022 1850 CHECK_STRING (linkname, 1);
570d7624
JB		 1851#if 0 /* This made it impossible to make a link to a relative name. */
1852 filename = Fexpand_file_name (filename, Qnil);
1853#endif
e5d77022 1854 linkname = Fexpand_file_name (linkname, Qnil);
32f4334d
RS		 1855
1856 /* If the file name has special constructs in it,
1857 call the corresponding file handler. */
642ef245 1858 handler = Ffind_file_name_handler (filename);
32f4334d 1859 if (!NILP (handler))
3eac9910 1860 return call3 (handler, Qmake_symbolic_link, filename, linkname);
32f4334d 1861
265a9e55 1862 if (NILP (ok_if_already_exists)
570d7624 1863 || XTYPE (ok_if_already_exists) == Lisp_Int)
e5d77022 1864 barf_or_query_if_file_exists (linkname, "make it a link",
570d7624 1865 XTYPE (ok_if_already_exists) == Lisp_Int);
e5d77022 1866 if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
570d7624
JB		 1867 {
1868 /* If we didn't complain already, silently delete existing file. */
1869 if (errno == EEXIST)
1870 {
9083124b 1871 unlink (XSTRING (linkname)->data);
e5d77022 1872 if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
570d7624
JB		 1873 return Qnil;
1874 }
1875
1876#ifdef NO_ARG_ARRAY
1877 args[0] = filename;
e5d77022 1878 args[1] = linkname;
570d7624
JB		 1879 report_file_error ("Making symbolic link", Flist (2, args));
1880#else
1881 report_file_error ("Making symbolic link", Flist (2, &filename));
1882#endif
1883 }
1884 UNGCPRO;
1885 return Qnil;
1886}
1887#endif /* S_IFLNK */
1888
1889#ifdef VMS
1890
1891DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
1892 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1893 "Define the job-wide logical name NAME to have the value STRING.\n\
1894If STRING is nil or a null string, the logical name NAME is deleted.")
1895 (varname, string)
1896 Lisp_Object varname;
1897 Lisp_Object string;
1898{
1899 CHECK_STRING (varname, 0);
265a9e55 1900 if (NILP (string))
570d7624
JB		 1901 delete_logical_name (XSTRING (varname)->data);
1902 else
1903 {
1904 CHECK_STRING (string, 1);
1905
1906 if (XSTRING (string)->size == 0)
1907 delete_logical_name (XSTRING (varname)->data);
1908 else
1909 define_logical_name (XSTRING (varname)->data, XSTRING (string)->data);
1910 }
1911
1912 return string;
1913}
1914#endif /* VMS */
1915
1916#ifdef HPUX_NET
1917
1918DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
1919 "Open a network connection to PATH using LOGIN as the login string.")
1920 (path, login)
1921 Lisp_Object path, login;
1922{
1923 int netresult;
1924
1925 CHECK_STRING (path, 0);
1926 CHECK_STRING (login, 0);
1927
1928 netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
1929
1930 if (netresult == -1)
1931 return Qnil;
1932 else
1933 return Qt;
1934}
1935#endif /* HPUX_NET */
1936\f
1937DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
1938 1, 1, 0,
1939 "Return t if file FILENAME specifies an absolute path name.\n\
1940On Unix, this is a name starting with a `/' or a `~'.")
1941 (filename)
1942 Lisp_Object filename;
1943{
1944 unsigned char *ptr;
1945
1946 CHECK_STRING (filename, 0);
1947 ptr = XSTRING (filename)->data;
1948 if (*ptr == '/' || *ptr == '~'
1949#ifdef VMS
1950/* ??? This criterion is probably wrong for '<'. */
1951 || index (ptr, ':') || index (ptr, '<')
1952 || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
1953 && ptr[1] != '.')
1954#endif /* VMS */
1955 )
1956 return Qt;
1957 else
1958 return Qnil;
1959}
1960
1961DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
1962 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1963See also `file-readable-p' and `file-attributes'.")
1964 (filename)
1965 Lisp_Object filename;
1966{
1967 Lisp_Object abspath;
32f4334d 1968 Lisp_Object handler;
570d7624
JB		 1969
1970 CHECK_STRING (filename, 0);
1971 abspath = Fexpand_file_name (filename, Qnil);
32f4334d
RS		 1972
1973 /* If the file name has special constructs in it,
1974 call the corresponding file handler. */
642ef245 1975 handler = Ffind_file_name_handler (abspath);
32f4334d 1976 if (!NILP (handler))
09121adc 1977 return call2 (handler, Qfile_exists_p, abspath);
32f4334d 1978
570d7624
JB		 1979 return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
1980}
1981
1982DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
1983 "Return t if FILENAME can be executed by you.\n\
8b235fde 1984For a directory, this means you can access files in that directory.")
570d7624
JB		 1985 (filename)
1986 Lisp_Object filename;
1987
1988{
1989 Lisp_Object abspath;
32f4334d 1990 Lisp_Object handler;
570d7624
JB		 1991
1992 CHECK_STRING (filename, 0);
1993 abspath = Fexpand_file_name (filename, Qnil);
32f4334d
RS		 1994
1995 /* If the file name has special constructs in it,
1996 call the corresponding file handler. */
642ef245 1997 handler = Ffind_file_name_handler (abspath);
32f4334d 1998 if (!NILP (handler))
09121adc 1999 return call2 (handler, Qfile_executable_p, abspath);
32f4334d 2000
570d7624
JB		 2001 return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
2002}
2003
2004DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2005 "Return t if file FILENAME exists and you can read it.\n\
2006See also `file-exists-p' and `file-attributes'.")
2007 (filename)
2008 Lisp_Object filename;
2009{
2010 Lisp_Object abspath;
32f4334d 2011 Lisp_Object handler;
570d7624
JB		 2012
2013 CHECK_STRING (filename, 0);
2014 abspath = Fexpand_file_name (filename, Qnil);
32f4334d
RS		 2015
2016 /* If the file name has special constructs in it,
2017 call the corresponding file handler. */
642ef245 2018 handler = Ffind_file_name_handler (abspath);
32f4334d 2019 if (!NILP (handler))
09121adc 2020 return call2 (handler, Qfile_readable_p, abspath);
32f4334d 2021
570d7624
JB		 2022 return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
2023}
2024
2025DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2026 "If file FILENAME is the name of a symbolic link\n\
2027returns the name of the file to which it is linked.\n\
2028Otherwise returns NIL.")
2029 (filename)
2030 Lisp_Object filename;
2031{
2032#ifdef S_IFLNK
2033 char *buf;
2034 int bufsize;
2035 int valsize;
2036 Lisp_Object val;
32f4334d 2037 Lisp_Object handler;
570d7624
JB		 2038
2039 CHECK_STRING (filename, 0);
2040 filename = Fexpand_file_name (filename, Qnil);
2041
32f4334d
RS		 2042 /* If the file name has special constructs in it,
2043 call the corresponding file handler. */
642ef245 2044 handler = Ffind_file_name_handler (filename);
32f4334d
RS		 2045 if (!NILP (handler))
2046 return call2 (handler, Qfile_symlink_p, filename);
2047
570d7624
JB		 2048 bufsize = 100;
2049 while (1)
2050 {
2051 buf = (char *) xmalloc (bufsize);
2052 bzero (buf, bufsize);
2053 valsize = readlink (XSTRING (filename)->data, buf, bufsize);
2054 if (valsize < bufsize) break;
2055 /* Buffer was not long enough */
9ac0d9e0 2056 xfree (buf);
570d7624
JB		 2057 bufsize *= 2;
2058 }
2059 if (valsize == -1)
2060 {
9ac0d9e0 2061 xfree (buf);
570d7624
JB		 2062 return Qnil;
2063 }
2064 val = make_string (buf, valsize);
9ac0d9e0 2065 xfree (buf);
570d7624
JB		 2066 return val;
2067#else /* not S_IFLNK */
2068 return Qnil;
2069#endif /* not S_IFLNK */
2070}
2071
a253bab2
JB		 2072#ifdef SOLARIS_BROKEN_ACCESS
2073/* In Solaris 2.1, the readonly-ness of the filesystem is not
2074 considered by the access system call. This is Sun's bug, but we
2075 still have to make Emacs work. */
2076
2077#include <sys/statvfs.h>
2078
2079static int
2080ro_fsys (path)
2081 char *path;
2082{
2083 struct statvfs statvfsb;
2084
2085 if (statvfs(path, &statvfsb))
2086 return 1; /* error from statvfs, be conservative and say not wrtable */
2087 else
2088 /* Otherwise, fsys is ro if bit is set. */
2089 return statvfsb.f_flag & ST_RDONLY;
2090}
2091#else
2092/* But on every other os, access has already done the right thing. */
2093#define ro_fsys(path) 0
2094#endif
2095
570d7624
JB		 2096/* Having this before file-symlink-p mysteriously caused it to be forgotten
2097 on the RT/PC. */
2098DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2099 "Return t if file FILENAME can be written or created by you.")
2100 (filename)
2101 Lisp_Object filename;
2102{
2103 Lisp_Object abspath, dir;
32f4334d 2104 Lisp_Object handler;
570d7624
JB		 2105
2106 CHECK_STRING (filename, 0);
2107 abspath = Fexpand_file_name (filename, Qnil);
32f4334d
RS		 2108
2109 /* If the file name has special constructs in it,
2110 call the corresponding file handler. */
642ef245 2111 handler = Ffind_file_name_handler (abspath);
32f4334d 2112 if (!NILP (handler))
09121adc 2113 return call2 (handler, Qfile_writable_p, abspath);
32f4334d 2114
570d7624 2115 if (access (XSTRING (abspath)->data, 0) >= 0)
a253bab2 2116 return ((access (XSTRING (abspath)->data, 2) >= 0
e7c7295c 2117 && ! ro_fsys ((char *) XSTRING (abspath)->data))
a253bab2 2118 ? Qt : Qnil);
570d7624
JB		 2119 dir = Ffile_name_directory (abspath);
2120#ifdef VMS
265a9e55 2121 if (!NILP (dir))
570d7624
JB		 2122 dir = Fdirectory_file_name (dir);
2123#endif /* VMS */
a253bab2 2124 return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
e7c7295c 2125 && ! ro_fsys ((char *) XSTRING (dir)->data))
570d7624
JB		 2126 ? Qt : Qnil);
2127}
2128
2129DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2130 "Return t if file FILENAME is the name of a directory as a file.\n\
2131A directory name spec may be given instead; then the value is t\n\
2132if the directory so specified exists and really is a directory.")
2133 (filename)
2134 Lisp_Object filename;
2135{
2136 register Lisp_Object abspath;
2137 struct stat st;
32f4334d 2138 Lisp_Object handler;
570d7624
JB		 2139
2140 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2141
32f4334d
RS		 2142 /* If the file name has special constructs in it,
2143 call the corresponding file handler. */
642ef245 2144 handler = Ffind_file_name_handler (abspath);
32f4334d 2145 if (!NILP (handler))
09121adc 2146 return call2 (handler, Qfile_directory_p, abspath);
32f4334d 2147
570d7624
JB		 2148 if (stat (XSTRING (abspath)->data, &st) < 0)
2149 return Qnil;
2150 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2151}
2152
b72dea2a
JB		 2153DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
2154 "Return t if file FILENAME is the name of a directory as a file,\n\
2155and files in that directory can be opened by you. In order to use a\n\
2156directory as a buffer's current directory, this predicate must return true.\n\
2157A directory name spec may be given instead; then the value is t\n\
2158if the directory so specified exists and really is a readable and\n\
2159searchable directory.")
2160 (filename)
2161 Lisp_Object filename;
2162{
32f4334d
RS		 2163 Lisp_Object handler;
2164
2165 /* If the file name has special constructs in it,
2166 call the corresponding file handler. */
642ef245 2167 handler = Ffind_file_name_handler (filename);
32f4334d
RS		 2168 if (!NILP (handler))
2169 return call2 (handler, Qfile_accessible_directory_p, filename);
2170
b72dea2a
JB		 2171 if (NILP (Ffile_directory_p (filename))
2172 || NILP (Ffile_executable_p (filename)))
2173 return Qnil;
2174 else
2175 return Qt;
2176}
2177
570d7624
JB		 2178DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
2179 "Return mode bits of FILE, as an integer.")
2180 (filename)
2181 Lisp_Object filename;
2182{
2183 Lisp_Object abspath;
2184 struct stat st;
32f4334d 2185 Lisp_Object handler;
570d7624
JB		 2186
2187 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2188
32f4334d
RS		 2189 /* If the file name has special constructs in it,
2190 call the corresponding file handler. */
642ef245 2191 handler = Ffind_file_name_handler (abspath);
32f4334d 2192 if (!NILP (handler))
09121adc 2193 return call2 (handler, Qfile_modes, abspath);
32f4334d 2194
570d7624
JB		 2195 if (stat (XSTRING (abspath)->data, &st) < 0)
2196 return Qnil;
2197 return make_number (st.st_mode & 07777);
2198}
2199
2200DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
2201 "Set mode bits of FILE to MODE (an integer).\n\
2202Only the 12 low bits of MODE are used.")
2203 (filename, mode)
2204 Lisp_Object filename, mode;
2205{
2206 Lisp_Object abspath;
32f4334d 2207 Lisp_Object handler;
570d7624
JB		 2208
2209 abspath = Fexpand_file_name (filename, current_buffer->directory);
2210 CHECK_NUMBER (mode, 1);
2211
32f4334d
RS		 2212 /* If the file name has special constructs in it,
2213 call the corresponding file handler. */
642ef245 2214 handler = Ffind_file_name_handler (abspath);
32f4334d 2215 if (!NILP (handler))
09121adc 2216 return call3 (handler, Qset_file_modes, abspath, mode);
32f4334d 2217
570d7624
JB		 2218#ifndef APOLLO
2219 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
2220 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
2221#else /* APOLLO */
2222 if (!egetenv ("USE_DOMAIN_ACLS"))
2223 {
2224 struct stat st;
2225 struct timeval tvp[2];
2226
2227 /* chmod on apollo also change the file's modtime; need to save the
2228 modtime and then restore it. */
2229 if (stat (XSTRING (abspath)->data, &st) < 0)
2230 {
2231 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
2232 return (Qnil);
2233 }
2234
2235 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
2236 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
2237
2238 /* reset the old accessed and modified times. */
2239 tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */
2240 tvp[0].tv_usec = 0;
2241 tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */
2242 tvp[1].tv_usec = 0;
2243
2244 if (utimes (XSTRING (abspath)->data, tvp) < 0)
2245 report_file_error ("Doing utimes", Fcons (abspath, Qnil));
2246 }
2247#endif /* APOLLO */
2248
2249 return Qnil;
2250}
2251
c24e9a53 2252DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
5f85ea58
RS		 2253 "Set the file permission bits for newly created files.\n\
2254The argument MODE should be an integer; only the low 9 bits are used.\n\
36a8c287 2255This setting is inherited by subprocesses.")
5f85ea58
RS		 2256 (mode)
2257 Lisp_Object mode;
36a8c287 2258{
5f85ea58 2259 CHECK_NUMBER (mode, 0);
36a8c287 2260
5f85ea58 2261 umask ((~ XINT (mode)) & 0777);
36a8c287
JB		 2262
2263 return Qnil;
2264}
2265
c24e9a53 2266DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
5f85ea58
RS		 2267 "Return the default file protection for created files.\n\
2268The value is an integer.")
36a8c287
JB		 2269 ()
2270{
5f85ea58
RS		 2271 int realmask;
2272 Lisp_Object value;
36a8c287 2273
5f85ea58
RS		 2274 realmask = umask (0);
2275 umask (realmask);
36a8c287 2276
5f85ea58
RS		 2277 XSET (value, Lisp_Int, (~ realmask) & 0777);
2278 return value;
36a8c287
JB		 2279}
2280
85ffea93
RS		 2281#ifdef unix
2282
2283DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
2284 "Tell Unix to finish all pending disk updates.")
2285 ()
2286{
2287 sync ();
2288 return Qnil;
2289}
2290
2291#endif /* unix */
2292
570d7624
JB		 2293DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
2294 "Return t if file FILE1 is newer than file FILE2.\n\
2295If FILE1 does not exist, the answer is nil;\n\
2296otherwise, if FILE2 does not exist, the answer is t.")
2297 (file1, file2)
2298 Lisp_Object file1, file2;
2299{
32f4334d 2300 Lisp_Object abspath1, abspath2;
570d7624
JB		 2301 struct stat st;
2302 int mtime1;
32f4334d 2303 Lisp_Object handler;
09121adc 2304 struct gcpro gcpro1, gcpro2;
570d7624
JB		 2305
2306 CHECK_STRING (file1, 0);
2307 CHECK_STRING (file2, 0);
2308
09121adc
RS		 2309 abspath1 = Qnil;
2310 GCPRO2 (abspath1, file2);
32f4334d
RS		 2311 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2312 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
09121adc 2313 UNGCPRO;
570d7624 2314
32f4334d
RS		 2315 /* If the file name has special constructs in it,
2316 call the corresponding file handler. */
642ef245 2317 handler = Ffind_file_name_handler (abspath1);
32f4334d
RS		 2318 if (!NILP (handler))
2319 return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
2320
2321 if (stat (XSTRING (abspath1)->data, &st) < 0)
570d7624
JB		 2322 return Qnil;
2323
2324 mtime1 = st.st_mtime;
2325
32f4334d 2326 if (stat (XSTRING (abspath2)->data, &st) < 0)
570d7624
JB		 2327 return Qt;
2328
2329 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2330}
2331\f
570d7624
JB		 2332DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
2333 1, 2, 0,
2334 "Insert contents of file FILENAME after point.\n\
2335Returns list of absolute pathname and length of data inserted.\n\
2336If second argument VISIT is non-nil, the buffer's visited filename\n\
2337and last save file modtime are set, and it is marked unmodified.\n\
2338If visiting and the file does not exist, visiting is completed\n\
2339before the error is signaled.")
2340 (filename, visit)
2341 Lisp_Object filename, visit;
2342{
2343 struct stat st;
2344 register int fd;
2345 register int inserted = 0;
2346 register int how_much;
2347 int count = specpdl_ptr - specpdl;
2348 struct gcpro gcpro1;
32f4334d
RS		 2349 Lisp_Object handler, val;
2350
2351 val = Qnil;
2352
570d7624 2353 GCPRO1 (filename);
265a9e55 2354 if (!NILP (current_buffer->read_only))
570d7624
JB		 2355 Fbarf_if_buffer_read_only();
2356
2357 CHECK_STRING (filename, 0);
2358 filename = Fexpand_file_name (filename, Qnil);
2359
32f4334d
RS		 2360 /* If the file name has special constructs in it,
2361 call the corresponding file handler. */
642ef245 2362 handler = Ffind_file_name_handler (filename);
32f4334d
RS		 2363 if (!NILP (handler))
2364 {
2365 val = call3 (handler, Qinsert_file_contents, filename, visit);
2366 st.st_mtime = 0;
2367 goto handled;
2368 }
2369
570d7624
JB		 2370 fd = -1;
2371
2372#ifndef APOLLO
2373 if (stat (XSTRING (filename)->data, &st) < 0
349a7710 2374 || (fd = open (XSTRING (filename)->data, 0)) < 0)
570d7624
JB		 2375#else
2376 if ((fd = open (XSTRING (filename)->data, 0)) < 0
2377 || fstat (fd, &st) < 0)
2378#endif /* not APOLLO */
2379 {
2380 if (fd >= 0) close (fd);
265a9e55 2381 if (NILP (visit))
570d7624
JB		 2382 report_file_error ("Opening input file", Fcons (filename, Qnil));
2383 st.st_mtime = -1;
2384 how_much = 0;
2385 goto notfound;
2386 }
2387
2388 record_unwind_protect (close_file_unwind, make_number (fd));
2389
be53b411
JB		 2390#ifdef S_IFSOCK
2391 /* This code will need to be changed in order to work on named
2392 pipes, and it's probably just not worth it. So we should at
2393 least signal an error. */
2394 if ((st.st_mode & S_IFMT) == S_IFSOCK)
2395 Fsignal (Qfile_error,
2396 Fcons (build_string ("reading from named pipe"),
2397 Fcons (filename, Qnil)));
2398#endif
2399
570d7624
JB		 2400 /* Supposedly happens on VMS. */
2401 if (st.st_size < 0)
2402 error ("File size is negative");
be53b411 2403
570d7624
JB		 2404 {
2405 register Lisp_Object temp;
2406
2407 /* Make sure point-max won't overflow after this insertion. */
2408 XSET (temp, Lisp_Int, st.st_size + Z);
2409 if (st.st_size + Z != XINT (temp))
2410 error ("maximum buffer size exceeded");
2411 }
2412
265a9e55 2413 if (NILP (visit))
570d7624
JB		 2414 prepare_to_modify_buffer (point, point);
2415
2416 move_gap (point);
2417 if (GAP_SIZE < st.st_size)
2418 make_gap (st.st_size - GAP_SIZE);
2419
2420 while (1)
2421 {
2422 int try = min (st.st_size - inserted, 64 << 10);
b5148e85
RS		 2423 int this;
2424
2425 /* Allow quitting out of the actual I/O. */
2426 immediate_quit = 1;
2427 QUIT;
2428 this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
2429 immediate_quit = 0;
570d7624
JB		 2430
2431 if (this <= 0)
2432 {
2433 how_much = this;
2434 break;
2435 }
2436
2437 GPT += this;
2438 GAP_SIZE -= this;
2439 ZV += this;
2440 Z += this;
2441 inserted += this;
2442 }
2443
2444 if (inserted > 0)
7d8451f1
RS		 2445 {
2446 record_insert (point, inserted);
8d4e077b
JA		 2447
2448 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2449 offset_intervals (current_buffer, point, inserted);
7d8451f1
RS		 2450 MODIFF++;
2451 }
570d7624
JB		 2452
2453 close (fd);
2454
2455 /* Discard the unwind protect */
2456 specpdl_ptr = specpdl + count;
2457
2458 if (how_much < 0)
2459 error ("IO error reading %s: %s",
2460 XSTRING (filename)->data, err_str (errno));
2461
2462 notfound:
32f4334d 2463 handled:
570d7624 2464
265a9e55 2465 if (!NILP (visit))
570d7624
JB		 2466 {
2467 current_buffer->undo_list = Qnil;
2468#ifdef APOLLO
2469 stat (XSTRING (filename)->data, &st);
2470#endif
2471 current_buffer->modtime = st.st_mtime;
2472 current_buffer->save_modified = MODIFF;
2473 current_buffer->auto_save_modified = MODIFF;
2474 XFASTINT (current_buffer->save_length) = Z - BEG;
2475#ifdef CLASH_DETECTION
32f4334d
RS		 2476 if (NILP (handler))
2477 {
2478 if (!NILP (current_buffer->filename))
2479 unlock_file (current_buffer->filename);
2480 unlock_file (filename);
2481 }
570d7624
JB		 2482#endif /* CLASH_DETECTION */
2483 current_buffer->filename = filename;
2484 /* If visiting nonexistent file, return nil. */
32f4334d 2485 if (current_buffer->modtime == -1)
570d7624
JB		 2486 report_file_error ("Opening input file", Fcons (filename, Qnil));
2487 }
2488
2489 signal_after_change (point, 0, inserted);
2490
32f4334d
RS		 2491 if (!NILP (val))
2492 RETURN_UNGCPRO (val);
9b7828a5
JB		 2493 RETURN_UNGCPRO (Fcons (filename,
2494 Fcons (make_number (inserted),
2495 Qnil)));
570d7624
JB		 2496}
2497
2498DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
2499 "r\nFWrite region to file: ",
2500 "Write current region into specified file.\n\
2501When called from a program, takes three arguments:\n\
2502START, END and FILENAME. START and END are buffer positions.\n\
2503Optional fourth argument APPEND if non-nil means\n\
2504 append to existing file contents (if any).\n\
2505Optional fifth argument VISIT if t means\n\
2506 set the last-save-file-modtime of buffer to this file's modtime\n\
2507 and mark buffer not modified.\n\
3b7792ed
RS		 2508If VISIT is a string, it is a second file name;\n\
2509 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2510 VISIT is also the file name to lock and unlock for clash detection.\n\
1d386d28
RS		 2511If VISIT is neither t nor nil nor a string,\n\
2512 that means do not print the \"Wrote file\" message.\n\
570d7624
JB		 2513Kludgy feature: if START is a string, then that string is written\n\
2514to the file, instead of any buffer contents, and END is ignored.")
2515 (start, end, filename, append, visit)
2516 Lisp_Object start, end, filename, append, visit;
2517{
2518 register int desc;
2519 int failure;
2520 int save_errno;
2521 unsigned char *fn;
2522 struct stat st;
2523 int tem;
2524 int count = specpdl_ptr - specpdl;
2525#ifdef VMS
2526 unsigned char *fname = 0; /* If non-0, original filename (must rename) */
2527#endif /* VMS */
3eac9910 2528 Lisp_Object handler;
4ad827c5 2529 Lisp_Object visit_file;
3b7792ed 2530 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
570d7624
JB		 2531
2532 /* Special kludge to simplify auto-saving */
265a9e55 2533 if (NILP (start))
570d7624
JB		 2534 {
2535 XFASTINT (start) = BEG;
2536 XFASTINT (end) = Z;
2537 }
2538 else if (XTYPE (start) != Lisp_String)
2539 validate_region (&start, &end);
2540
2541 filename = Fexpand_file_name (filename, Qnil);
4ad827c5 2542 if (XTYPE (visit) == Lisp_String)
e5176bae 2543 visit_file = Fexpand_file_name (visit, Qnil);
4ad827c5
RS		 2544 else
2545 visit_file = filename;
2546
2547 GCPRO4 (start, filename, visit, visit_file);
570d7624 2548
32f4334d
RS		 2549 /* If the file name has special constructs in it,
2550 call the corresponding file handler. */
642ef245 2551 handler = Ffind_file_name_handler (filename);
3eac9910 2552
32f4334d
RS		 2553 if (!NILP (handler))
2554 {
2555 Lisp_Object args[7];
2556 Lisp_Object val;
2557 args[0] = handler;
2558 args[1] = Qwrite_region;
2559 args[2] = start;
2560 args[3] = end;
2561 args[4] = filename;
2562 args[5] = append;
2563 args[6] = visit;
2564 val = Ffuncall (7, args);
2565
2566 /* Do this before reporting IO error
2567 to avoid a "file has changed on disk" warning on
2568 next attempt to save. */
3b7792ed 2569 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
32f4334d
RS		 2570 {
2571 current_buffer->modtime = 0;
2572 current_buffer->save_modified = MODIFF;
2573 XFASTINT (current_buffer->save_length) = Z - BEG;
3b7792ed 2574 current_buffer->filename = visit_file;
32f4334d 2575 }
09121adc 2576 UNGCPRO;
32f4334d
RS		 2577 return val;
2578 }
2579
570d7624
JB		 2580#ifdef CLASH_DETECTION
2581 if (!auto_saving)
3b7792ed 2582 lock_file (visit_file);
570d7624
JB		 2583#endif /* CLASH_DETECTION */
2584
09121adc 2585 fn = XSTRING (filename)->data;
570d7624 2586 desc = -1;
265a9e55 2587 if (!NILP (append))
570d7624
JB		 2588 desc = open (fn, O_WRONLY);
2589
2590 if (desc < 0)
2591#ifdef VMS
2592 if (auto_saving) /* Overwrite any previous version of autosave file */
2593 {
2594 vms_truncate (fn); /* if fn exists, truncate to zero length */
2595 desc = open (fn, O_RDWR);
2596 if (desc < 0)
2597 desc = creat_copy_attrs (XTYPE (current_buffer->filename) == Lisp_String
b72dea2a
JB		 2598 ? XSTRING (current_buffer->filename)->data : 0,
2599 fn);
570d7624
JB		 2600 }
2601 else /* Write to temporary name and rename if no errors */
2602 {
2603 Lisp_Object temp_name;
2604 temp_name = Ffile_name_directory (filename);
2605
265a9e55 2606 if (!NILP (temp_name))
570d7624
JB		 2607 {
2608 temp_name = Fmake_temp_name (concat2 (temp_name,
2609 build_string ("$$SAVE$$")));
2610 fname = XSTRING (filename)->data;
2611 fn = XSTRING (temp_name)->data;
2612 desc = creat_copy_attrs (fname, fn);
2613 if (desc < 0)
2614 {
2615 /* If we can't open the temporary file, try creating a new
2616 version of the original file. VMS "creat" creates a
2617 new version rather than truncating an existing file. */
2618 fn = fname;
2619 fname = 0;
2620 desc = creat (fn, 0666);
2621#if 0 /* This can clobber an existing file and fail to replace it,
2622 if the user runs out of space. */
2623 if (desc < 0)
2624 {
2625 /* We can't make a new version;
2626 try to truncate and rewrite existing version if any. */
2627 vms_truncate (fn);
2628 desc = open (fn, O_RDWR);
2629 }
2630#endif
2631 }
2632 }
2633 else
2634 desc = creat (fn, 0666);
2635 }
2636#else /* not VMS */
2637 desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
2638#endif /* not VMS */
2639
09121adc
RS		 2640 UNGCPRO;
2641
570d7624
JB		 2642 if (desc < 0)
2643 {
2644#ifdef CLASH_DETECTION
2645 save_errno = errno;
3b7792ed 2646 if (!auto_saving) unlock_file (visit_file);
570d7624
JB		 2647 errno = save_errno;
2648#endif /* CLASH_DETECTION */
2649 report_file_error ("Opening output file", Fcons (filename, Qnil));
2650 }
2651
2652 record_unwind_protect (close_file_unwind, make_number (desc));
2653
265a9e55 2654 if (!NILP (append))
570d7624
JB		 2655 if (lseek (desc, 0, 2) < 0)
2656 {
2657#ifdef CLASH_DETECTION
3b7792ed 2658 if (!auto_saving) unlock_file (visit_file);
570d7624
JB		 2659#endif /* CLASH_DETECTION */
2660 report_file_error ("Lseek error", Fcons (filename, Qnil));
2661 }
2662
2663#ifdef VMS
2664/*
2665 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2666 * if we do writes that don't end with a carriage return. Furthermore
2667 * it cannot handle writes of more then 16K. The modified
2668 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2669 * this EXCEPT for the last record (iff it doesn't end with a carriage
2670 * return). This implies that if your buffer doesn't end with a carriage
2671 * return, you get one free... tough. However it also means that if
2672 * we make two calls to sys_write (a la the following code) you can
2673 * get one at the gap as well. The easiest way to fix this (honest)
2674 * is to move the gap to the next newline (or the end of the buffer).
2675 * Thus this change.
2676 *
2677 * Yech!
2678 */
2679 if (GPT > BEG && GPT_ADDR[-1] != '\n')
2680 move_gap (find_next_newline (GPT, 1));
2681#endif
2682
2683 failure = 0;
2684 immediate_quit = 1;
2685
2686 if (XTYPE (start) == Lisp_String)
2687 {
2688 failure = 0 > e_write (desc, XSTRING (start)->data,
2689 XSTRING (start)->size);
2690 save_errno = errno;
2691 }
2692 else if (XINT (start) != XINT (end))
2693 {
2694 if (XINT (start) < GPT)
2695 {
2696 register int end1 = XINT (end);
2697 tem = XINT (start);
2698 failure = 0 > e_write (desc, &FETCH_CHAR (tem),
2699 min (GPT, end1) - tem);
2700 save_errno = errno;
2701 }
2702
2703 if (XINT (end) > GPT && !failure)
2704 {
2705 tem = XINT (start);
2706 tem = max (tem, GPT);
2707 failure = 0 > e_write (desc, &FETCH_CHAR (tem), XINT (end) - tem);
2708 save_errno = errno;
2709 }
2710 }
2711
2712 immediate_quit = 0;
2713
6e23c83e 2714#ifdef HAVE_FSYNC
570d7624
JB		 2715 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2716 Disk full in NFS may be reported here. */
2717 if (fsync (desc) < 0)
2718 failure = 1, save_errno = errno;
570d7624
JB		 2719#endif
2720
2721 /* Spurious "file has changed on disk" warnings have been
2722 observed on Suns as well.
2723 It seems that `close' can change the modtime, under nfs.
2724
2725 (This has supposedly been fixed in Sunos 4,
2726 but who knows about all the other machines with NFS?) */
2727#if 0
2728
2729 /* On VMS and APOLLO, must do the stat after the close
2730 since closing changes the modtime. */
2731#ifndef VMS
2732#ifndef APOLLO
2733 /* Recall that #if defined does not work on VMS. */
2734#define FOO
2735 fstat (desc, &st);
2736#endif
2737#endif
2738#endif
2739
2740 /* NFS can report a write failure now. */
2741 if (close (desc) < 0)
2742 failure = 1, save_errno = errno;
2743
2744#ifdef VMS
2745 /* If we wrote to a temporary name and had no errors, rename to real name. */
2746 if (fname)
2747 {
2748 if (!failure)
2749 failure = (rename (fn, fname) != 0), save_errno = errno;
2750 fn = fname;
2751 }
2752#endif /* VMS */
2753
2754#ifndef FOO
2755 stat (fn, &st);
2756#endif
2757 /* Discard the unwind protect */
2758 specpdl_ptr = specpdl + count;
2759
2760#ifdef CLASH_DETECTION
2761 if (!auto_saving)
3b7792ed 2762 unlock_file (visit_file);
570d7624
JB		 2763#endif /* CLASH_DETECTION */
2764
2765 /* Do this before reporting IO error
2766 to avoid a "file has changed on disk" warning on
2767 next attempt to save. */
3b7792ed 2768 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
570d7624
JB		 2769 current_buffer->modtime = st.st_mtime;
2770
2771 if (failure)
2772 error ("IO error writing %s: %s", fn, err_str (save_errno));
2773
3b7792ed 2774 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
570d7624
JB		 2775 {
2776 current_buffer->save_modified = MODIFF;
2777 XFASTINT (current_buffer->save_length) = Z - BEG;
3b7792ed 2778 current_buffer->filename = visit_file;
570d7624 2779 }
265a9e55 2780 else if (!NILP (visit))
570d7624
JB		 2781 return Qnil;
2782
2783 if (!auto_saving)
3b7792ed 2784 message ("Wrote %s", XSTRING (visit_file)->data);
570d7624
JB		 2785
2786 return Qnil;
2787}
2788
2789int
2790e_write (desc, addr, len)
2791 int desc;
2792 register char *addr;
2793 register int len;
2794{
2795 char buf[16 * 1024];
2796 register char *p, *end;
2797
2798 if (!EQ (current_buffer->selective_display, Qt))
2799 return write (desc, addr, len) - len;
2800 else
2801 {
2802 p = buf;
2803 end = p + sizeof buf;
2804 while (len--)
2805 {
2806 if (p == end)
2807 {
2808 if (write (desc, buf, sizeof buf) != sizeof buf)
2809 return -1;
2810 p = buf;
2811 }
2812 *p = *addr++;
2813 if (*p++ == '\015')
2814 p[-1] = '\n';
2815 }
2816 if (p != buf)
2817 if (write (desc, buf, p - buf) != p - buf)
2818 return -1;
2819 }
2820 return 0;
2821}
2822
2823DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
2824 Sverify_visited_file_modtime, 1, 1, 0,
2825 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2826This means that the file has not been changed since it was visited or saved.")
2827 (buf)
2828 Lisp_Object buf;
2829{
2830 struct buffer *b;
2831 struct stat st;
32f4334d 2832 Lisp_Object handler;
570d7624
JB		 2833
2834 CHECK_BUFFER (buf, 0);
2835 b = XBUFFER (buf);
2836
2837 if (XTYPE (b->filename) != Lisp_String) return Qt;
2838 if (b->modtime == 0) return Qt;
2839
32f4334d
RS		 2840 /* If the file name has special constructs in it,
2841 call the corresponding file handler. */
642ef245 2842 handler = Ffind_file_name_handler (b->filename);
32f4334d 2843 if (!NILP (handler))
09121adc 2844 return call2 (handler, Qverify_visited_file_modtime, buf);
32f4334d 2845
570d7624
JB		 2846 if (stat (XSTRING (b->filename)->data, &st) < 0)
2847 {
2848 /* If the file doesn't exist now and didn't exist before,
2849 we say that it isn't modified, provided the error is a tame one. */
2850 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
2851 st.st_mtime = -1;
2852 else
2853 st.st_mtime = 0;
2854 }
2855 if (st.st_mtime == b->modtime
2856 /* If both are positive, accept them if they are off by one second. */
2857 || (st.st_mtime > 0 && b->modtime > 0
2858 && (st.st_mtime == b->modtime + 1
2859 || st.st_mtime == b->modtime - 1)))
2860 return Qt;
2861 return Qnil;
2862}
2863
2864DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
2865 Sclear_visited_file_modtime, 0, 0, 0,
2866 "Clear out records of last mod time of visited file.\n\
2867Next attempt to save will certainly not complain of a discrepancy.")
2868 ()
2869{
2870 current_buffer->modtime = 0;
2871 return Qnil;
2872}
2873
f5d5eccf
RS		 2874DEFUN ("visited-file-modtime", Fvisited_file_modtime,
2875 Svisited_file_modtime, 0, 0, 0,
2876 "Return the current buffer's recorded visited file modification time.\n\
2877The value is a list of the form (HIGH . LOW), like the time values\n\
2878that `file-attributes' returns.")
2879 ()
2880{
2881 return long_to_cons (current_buffer->modtime);
2882}
2883
570d7624 2884DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
f5d5eccf 2885 Sset_visited_file_modtime, 0, 1, 0,
570d7624
JB		 2886 "Update buffer's recorded modification time from the visited file's time.\n\
2887Useful if the buffer was not read from the file normally\n\
f5d5eccf
RS		 2888or if the file itself has been changed for some known benign reason.\n\
2889An argument specifies the modification time value to use\n\
2890\(instead of that of the visited file), in the form of a list\n\
2891\(HIGH . LOW) or (HIGH LOW).")
2892 (time_list)
2893 Lisp_Object time_list;
570d7624 2894{
f5d5eccf
RS		 2895 if (!NILP (time_list))
2896 current_buffer->modtime = cons_to_long (time_list);
2897 else
2898 {
2899 register Lisp_Object filename;
2900 struct stat st;
2901 Lisp_Object handler;
570d7624 2902
f5d5eccf 2903 filename = Fexpand_file_name (current_buffer->filename, Qnil);
32f4334d 2904
f5d5eccf
RS		 2905 /* If the file name has special constructs in it,
2906 call the corresponding file handler. */
2907 handler = Ffind_file_name_handler (filename);
2908 if (!NILP (handler))
2909 return call3 (handler, Qfile_name_directory, filename, Qnil);
2910 else if (stat (XSTRING (filename)->data, &st) >= 0)
2911 current_buffer->modtime = st.st_mtime;
2912 }
570d7624
JB		 2913
2914 return Qnil;
2915}
2916\f
2917Lisp_Object
2918auto_save_error ()
2919{
2920 unsigned char *name = XSTRING (current_buffer->name)->data;
2921
2922 ring_bell ();
2923 message ("Autosaving...error for %s", name);
de49a6d3 2924 Fsleep_for (make_number (1), Qnil);
570d7624 2925 message ("Autosaving...error!for %s", name);
de49a6d3 2926 Fsleep_for (make_number (1), Qnil);
570d7624 2927 message ("Autosaving...error for %s", name);
de49a6d3 2928 Fsleep_for (make_number (1), Qnil);
570d7624
JB		 2929 return Qnil;
2930}
2931
2932Lisp_Object
2933auto_save_1 ()
2934{
2935 unsigned char *fn;
2936 struct stat st;
2937
2938 /* Get visited file's mode to become the auto save file's mode. */
2939 if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
2940 /* But make sure we can overwrite it later! */
2941 auto_save_mode_bits = st.st_mode | 0600;
2942 else
2943 auto_save_mode_bits = 0666;
2944
2945 return
2946 Fwrite_region (Qnil, Qnil,
2947 current_buffer->auto_save_file_name,
2948 Qnil, Qlambda);
2949}
2950
2951DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
2952 "Auto-save all buffers that need it.\n\
2953This is all buffers that have auto-saving enabled\n\
2954and are changed since last auto-saved.\n\
2955Auto-saving writes the buffer into a file\n\
2956so that your editing is not lost if the system crashes.\n\
2957This file is not the file you visited; that changes only when you save.\n\n\
2958Non-nil first argument means do not print any message if successful.\n\
4746118a 2959Non-nil second argument means save only current buffer.")
17857782
JB		 2960 (no_message, current_only)
2961 Lisp_Object no_message, current_only;
570d7624
JB		 2962{
2963 struct buffer *old = current_buffer, *b;
2964 Lisp_Object tail, buf;
2965 int auto_saved = 0;
2966 char *omessage = echo_area_glyphs;
f14b1c68
JB		 2967 extern int minibuf_level;
2968 int do_handled_files;
570d7624
JB		 2969
2970 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2971 point to non-strings reached from Vbuffer_alist. */
2972
2973 auto_saving = 1;
2974 if (minibuf_level)
17857782 2975 no_message = Qt;
570d7624
JB		 2976
2977 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2978 eventually call do-auto-save, so don't err here in that case. */
265a9e55 2979 if (!NILP (Vrun_hooks))
570d7624
JB		 2980 call1 (Vrun_hooks, intern ("auto-save-hook"));
2981
f14b1c68
JB		 2982 /* First, save all files which don't have handlers. If Emacs is
2983 crashing, the handlers may tweak what is causing Emacs to crash
2984 in the first place, and it would be a shame if Emacs failed to
2985 autosave perfectly ordinary files because it couldn't handle some
2986 ange-ftp'd file. */
2987 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
2988 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
2989 tail = XCONS (tail)->cdr)
2990 {
2991 buf = XCONS (XCONS (tail)->car)->cdr;
2992 b = XBUFFER (buf);
17857782 2993
f14b1c68
JB		 2994 if (!NILP (current_only)
2995 && b != current_buffer)
2996 continue;
17857782 2997
f14b1c68
JB		 2998 /* Check for auto save enabled
2999 and file changed since last auto save
3000 and file changed since last real save. */
3001 if (XTYPE (b->auto_save_file_name) == Lisp_String
3002 && b->save_modified < BUF_MODIFF (b)
3003 && b->auto_save_modified < BUF_MODIFF (b)
3004 && (do_handled_files
3005 || NILP (Ffind_file_name_handler (b->auto_save_file_name))))
3006 {
3007 if ((XFASTINT (b->save_length) * 10
3008 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3009 /* A short file is likely to change a large fraction;
3010 spare the user annoying messages. */
3011 && XFASTINT (b->save_length) > 5000
3012 /* These messages are frequent and annoying for `*mail*'. */
3013 && !EQ (b->filename, Qnil)
3014 && NILP (no_message))
3015 {
3016 /* It has shrunk too much; turn off auto-saving here. */
3017 message ("Buffer %s has shrunk a lot; auto save turned off there",
3018 XSTRING (b->name)->data);
3019 /* User can reenable saving with M-x auto-save. */
3020 b->auto_save_file_name = Qnil;
3021 /* Prevent warning from repeating if user does so. */
3022 XFASTINT (b->save_length) = 0;
3023 Fsleep_for (make_number (1), Qnil);
3024 continue;
3025 }
3026 set_buffer_internal (b);
3027 if (!auto_saved && NILP (no_message))
3028 message1 ("Auto-saving...");
3029 internal_condition_case (auto_save_1, Qt, auto_save_error);
3030 auto_saved++;
3031 b->auto_save_modified = BUF_MODIFF (b);
3032 XFASTINT (current_buffer->save_length) = Z - BEG;
3033 set_buffer_internal (old);
3034 }
3035 }
570d7624 3036
b67f2ca5
RS		 3037 /* Prevent another auto save till enough input events come in. */
3038 record_auto_save ();
570d7624 3039
17857782 3040 if (auto_saved && NILP (no_message))
570d7624
JB		 3041 message1 (omessage ? omessage : "Auto-saving...done");
3042
3043 auto_saving = 0;
3044 return Qnil;
3045}
3046
3047DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
3048 Sset_buffer_auto_saved, 0, 0, 0,
3049 "Mark current buffer as auto-saved with its current text.\n\
3050No auto-save file will be written until the buffer changes again.")
3051 ()
3052{
3053 current_buffer->auto_save_modified = MODIFF;
3054 XFASTINT (current_buffer->save_length) = Z - BEG;
3055 return Qnil;
3056}
3057
3058DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
3059 0, 0, 0,
3060 "Return t if buffer has been auto-saved since last read in or saved.")
3061 ()
3062{
3063 return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil;
3064}
3065\f
3066/* Reading and completing file names */
3067extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
3068
3069DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
3070 3, 3, 0,
3071 "Internal subroutine for read-file-name. Do not call this.")
3072 (string, dir, action)
3073 Lisp_Object string, dir, action;
3074 /* action is nil for complete, t for return list of completions,
3075 lambda for verify final value */
3076{
3077 Lisp_Object name, specdir, realdir, val, orig_string;
09121adc
RS		 3078 int changed;
3079 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3080
3081 realdir = dir;
3082 name = string;
3083 orig_string = Qnil;
3084 specdir = Qnil;
3085 changed = 0;
3086 /* No need to protect ACTION--we only compare it with t and nil. */
3087 GCPRO4 (string, realdir, name, specdir);
570d7624
JB		 3088
3089 if (XSTRING (string)->size == 0)
3090 {
570d7624 3091 if (EQ (action, Qlambda))
09121adc
RS		 3092 {
3093 UNGCPRO;
3094 return Qnil;
3095 }
570d7624
JB		 3096 }
3097 else
3098 {
3099 orig_string = string;
3100 string = Fsubstitute_in_file_name (string);
09121adc 3101 changed = NILP (Fstring_equal (string, orig_string));
570d7624 3102 name = Ffile_name_nondirectory (string);
09121adc
RS		 3103 val = Ffile_name_directory (string);
3104 if (! NILP (val))
3105 realdir = Fexpand_file_name (val, realdir);
570d7624
JB		 3106 }
3107
265a9e55 3108 if (NILP (action))
570d7624
JB		 3109 {
3110 specdir = Ffile_name_directory (string);
3111 val = Ffile_name_completion (name, realdir);
09121adc 3112 UNGCPRO;
570d7624
JB		 3113 if (XTYPE (val) != Lisp_String)
3114 {
09121adc 3115 if (changed)
570d7624 3116 return string;
09121adc 3117 return val;
570d7624
JB		 3118 }
3119
265a9e55 3120 if (!NILP (specdir))
570d7624
JB		 3121 val = concat2 (specdir, val);
3122#ifndef VMS
3123 {
3124 register unsigned char *old, *new;
3125 register int n;
3126 int osize, count;
3127
3128 osize = XSTRING (val)->size;
3129 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3130 for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
3131 if (*old++ == '$') count++;
3132 if (count > 0)
3133 {
3134 old = XSTRING (val)->data;
3135 val = Fmake_string (make_number (osize + count), make_number (0));
3136 new = XSTRING (val)->data;
3137 for (n = osize; n > 0; n--)
3138 if (*old != '$')
3139 *new++ = *old++;
3140 else
3141 {
3142 *new++ = '$';
3143 *new++ = '$';
3144 old++;
3145 }
3146 }
3147 }
3148#endif /* Not VMS */
09121adc 3149 return val;
570d7624 3150 }
09121adc 3151 UNGCPRO;
570d7624
JB		 3152
3153 if (EQ (action, Qt))
3154 return Ffile_name_all_completions (name, realdir);
3155 /* Only other case actually used is ACTION = lambda */
3156#ifdef VMS
3157 /* Supposedly this helps commands such as `cd' that read directory names,
3158 but can someone explain how it helps them? -- RMS */
3159 if (XSTRING (name)->size == 0)
3160 return Qt;
3161#endif /* VMS */
3162 return Ffile_exists_p (string);
3163}
3164
3165DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
3166 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3167Value is not expanded---you must call `expand-file-name' yourself.\n\
3168Default name to DEFAULT if user enters a null string.\n\
3169 (If DEFAULT is omitted, the visited file name is used.)\n\
3170Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3171 Non-nil and non-t means also require confirmation after completion.\n\
3172Fifth arg INITIAL specifies text to start with.\n\
3173DIR defaults to current buffer's directory default.")
3174 (prompt, dir, defalt, mustmatch, initial)
3175 Lisp_Object prompt, dir, defalt, mustmatch, initial;
3176{
85b5fe07 3177 Lisp_Object val, insdef, insdef1, tem;
570d7624
JB		 3178 struct gcpro gcpro1, gcpro2;
3179 register char *homedir;
3180 int count;
3181
265a9e55 3182 if (NILP (dir))
570d7624 3183 dir = current_buffer->directory;
265a9e55 3184 if (NILP (defalt))
570d7624
JB		 3185 defalt = current_buffer->filename;
3186
3187 /* If dir starts with user's homedir, change that to ~. */
3188 homedir = (char *) egetenv ("HOME");
3189 if (homedir != 0
3190 && XTYPE (dir) == Lisp_String
3191 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
3192 && XSTRING (dir)->data[strlen (homedir)] == '/')
3193 {
3194 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
3195 XSTRING (dir)->size - strlen (homedir) + 1);
3196 XSTRING (dir)->data[0] = '~';
3197 }
3198
3199 if (insert_default_directory)
3200 {
3201 insdef = dir;
85b5fe07 3202 insdef1 = dir;
265a9e55 3203 if (!NILP (initial))
570d7624 3204 {
15c65264 3205 Lisp_Object args[2], pos;
570d7624
JB		 3206
3207 args[0] = insdef;
3208 args[1] = initial;
3209 insdef = Fconcat (2, args);
509b05ed 3210 pos = make_number (XSTRING (dir)->size);
85b5fe07 3211 insdef1 = Fcons (insdef, pos);
570d7624 3212 }
570d7624
JB		 3213 }
3214 else
85b5fe07 3215 insdef = Qnil, insdef1 = Qnil;
570d7624
JB		 3216
3217#ifdef VMS
3218 count = specpdl_ptr - specpdl;
3219 specbind (intern ("completion-ignore-case"), Qt);
3220#endif
3221
3222 GCPRO2 (insdef, defalt);
3223 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
85b5fe07 3224 dir, mustmatch, insdef1,
15c65264 3225 Qfile_name_history);
570d7624
JB		 3226
3227#ifdef VMS
3228 unbind_to (count, Qnil);
3229#endif
3230
3231 UNGCPRO;
265a9e55 3232 if (NILP (val))
570d7624
JB		 3233 error ("No file name specified");
3234 tem = Fstring_equal (val, insdef);
265a9e55 3235 if (!NILP (tem) && !NILP (defalt))
570d7624 3236 return defalt;
b320926a
RS		 3237 if (XSTRING (val)->size == 0 && NILP (insdef))
3238 return defalt;
570d7624
JB		 3239 return Fsubstitute_in_file_name (val);
3240}
3241
3242#if 0 /* Old version */
3243DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
3244 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3245Value is not expanded---you must call `expand-file-name' yourself.\n\
3246Default name to DEFAULT if user enters a null string.\n\
3247 (If DEFAULT is omitted, the visited file name is used.)\n\
3248Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3249 Non-nil and non-t means also require confirmation after completion.\n\
3250Fifth arg INITIAL specifies text to start with.\n\
3251DIR defaults to current buffer's directory default.")
3252 (prompt, dir, defalt, mustmatch, initial)
3253 Lisp_Object prompt, dir, defalt, mustmatch, initial;
3254{
3255 Lisp_Object val, insdef, tem;
3256 struct gcpro gcpro1, gcpro2;
3257 register char *homedir;
3258 int count;
3259
265a9e55 3260 if (NILP (dir))
570d7624 3261 dir = current_buffer->directory;
265a9e55 3262 if (NILP (defalt))
570d7624
JB		 3263 defalt = current_buffer->filename;
3264
3265 /* If dir starts with user's homedir, change that to ~. */
3266 homedir = (char *) egetenv ("HOME");
3267 if (homedir != 0
3268 && XTYPE (dir) == Lisp_String
3269 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
3270 && XSTRING (dir)->data[strlen (homedir)] == '/')
3271 {
3272 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
3273 XSTRING (dir)->size - strlen (homedir) + 1);
3274 XSTRING (dir)->data[0] = '~';
3275 }
3276
265a9e55 3277 if (!NILP (initial))
570d7624
JB		 3278 insdef = initial;
3279 else if (insert_default_directory)
3280 insdef = dir;
3281 else
3282 insdef = build_string ("");
3283
3284#ifdef VMS
3285 count = specpdl_ptr - specpdl;
3286 specbind (intern ("completion-ignore-case"), Qt);
3287#endif
3288
3289 GCPRO2 (insdef, defalt);
3290 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
3291 dir, mustmatch,
15c65264
RS		 3292 insert_default_directory ? insdef : Qnil,
3293 Qfile_name_history);
570d7624
JB		 3294
3295#ifdef VMS
3296 unbind_to (count, Qnil);
3297#endif
3298
3299 UNGCPRO;
265a9e55 3300 if (NILP (val))
570d7624
JB		 3301 error ("No file name specified");
3302 tem = Fstring_equal (val, insdef);
265a9e55 3303 if (!NILP (tem) && !NILP (defalt))
570d7624
JB		 3304 return defalt;
3305 return Fsubstitute_in_file_name (val);
3306}
3307#endif /* Old version */
3308\f
3309syms_of_fileio ()
3310{
0bf2eed2
RS		 3311 Qexpand_file_name = intern ("expand-file-name");
3312 Qdirectory_file_name = intern ("directory-file-name");
3313 Qfile_name_directory = intern ("file-name-directory");
3314 Qfile_name_nondirectory = intern ("file-name-nondirectory");
642ef245 3315 Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
0bf2eed2 3316 Qfile_name_as_directory = intern ("file-name-as-directory");
32f4334d
RS		 3317 Qcopy_file = intern ("copy-file");
3318 Qmake_directory = intern ("make-directory");
3319 Qdelete_directory = intern ("delete-directory");
3320 Qdelete_file = intern ("delete-file");
3321 Qrename_file = intern ("rename-file");
3322 Qadd_name_to_file = intern ("add-name-to-file");
3323 Qmake_symbolic_link = intern ("make-symbolic-link");
3324 Qfile_exists_p = intern ("file-exists-p");
3325 Qfile_executable_p = intern ("file-executable-p");
3326 Qfile_readable_p = intern ("file-readable-p");
3327 Qfile_symlink_p = intern ("file-symlink-p");
3328 Qfile_writable_p = intern ("file-writable-p");
3329 Qfile_directory_p = intern ("file-directory-p");
3330 Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
3331 Qfile_modes = intern ("file-modes");
3332 Qset_file_modes = intern ("set-file-modes");
3333 Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
3334 Qinsert_file_contents = intern ("insert-file-contents");
3335 Qwrite_region = intern ("write-region");
3336 Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
3337
642ef245
JB		 3338 staticpro (&Qexpand_file_name);
3339 staticpro (&Qdirectory_file_name);
3340 staticpro (&Qfile_name_directory);
3341 staticpro (&Qfile_name_nondirectory);
3342 staticpro (&Qunhandled_file_name_directory);
3343 staticpro (&Qfile_name_as_directory);
15c65264
RS		 3344 staticpro (&Qcopy_file);
3345 staticpro (&Qmake_directory);
3346 staticpro (&Qdelete_directory);
3347 staticpro (&Qdelete_file);
3348 staticpro (&Qrename_file);
3349 staticpro (&Qadd_name_to_file);
3350 staticpro (&Qmake_symbolic_link);
3351 staticpro (&Qfile_exists_p);
3352 staticpro (&Qfile_executable_p);
3353 staticpro (&Qfile_readable_p);
3354 staticpro (&Qfile_symlink_p);
3355 staticpro (&Qfile_writable_p);
3356 staticpro (&Qfile_directory_p);
3357 staticpro (&Qfile_accessible_directory_p);
3358 staticpro (&Qfile_modes);
3359 staticpro (&Qset_file_modes);
3360 staticpro (&Qfile_newer_than_file_p);
3361 staticpro (&Qinsert_file_contents);
3362 staticpro (&Qwrite_region);
3363 staticpro (&Qverify_visited_file_modtime);
642ef245
JB		 3364
3365 Qfile_name_history = intern ("file-name-history");
3366 Fset (Qfile_name_history, Qnil);
15c65264
RS		 3367 staticpro (&Qfile_name_history);
3368
570d7624
JB		 3369 Qfile_error = intern ("file-error");
3370 staticpro (&Qfile_error);
3371 Qfile_already_exists = intern("file-already-exists");
3372 staticpro (&Qfile_already_exists);
3373
3374 Fput (Qfile_error, Qerror_conditions,
3375 Fcons (Qfile_error, Fcons (Qerror, Qnil)));
3376 Fput (Qfile_error, Qerror_message,
3377 build_string ("File error"));
3378
3379 Fput (Qfile_already_exists, Qerror_conditions,
3380 Fcons (Qfile_already_exists,
3381 Fcons (Qfile_error, Fcons (Qerror, Qnil))));
3382 Fput (Qfile_already_exists, Qerror_message,
3383 build_string ("File already exists"));
3384
3385 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
3386 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3387 insert_default_directory = 1;
3388
3389 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
3390 "*Non-nil means write new files with record format `stmlf'.\n\
3391nil means use format `var'. This variable is meaningful only on VMS.");
3392 vms_stmlf_recfm = 0;
3393
1d1826db
RS		 3394 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
3395 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3396If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3397HANDLER.\n\
3398\n\
3399The first argument given to HANDLER is the name of the I/O primitive\n\
3400to be handled; the remaining arguments are the arguments that were\n\
3401passed to that primitive. For example, if you do\n\
3402 (file-exists-p FILENAME)\n\
3403and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
642ef245
JB		 3404 (funcall HANDLER 'file-exists-p FILENAME)\n\
3405The function `find-file-name-handler' checks this list for a handler\n\
3406for its argument.");
09121adc
RS		 3407 Vfile_name_handler_alist = Qnil;
3408
642ef245 3409 defsubr (&Sfind_file_name_handler);
570d7624
JB		 3410 defsubr (&Sfile_name_directory);
3411 defsubr (&Sfile_name_nondirectory);
642ef245 3412 defsubr (&Sunhandled_file_name_directory);
570d7624
JB		 3413 defsubr (&Sfile_name_as_directory);
3414 defsubr (&Sdirectory_file_name);
3415 defsubr (&Smake_temp_name);
3416 defsubr (&Sexpand_file_name);
3417 defsubr (&Ssubstitute_in_file_name);
3418 defsubr (&Scopy_file);
9bbe01fb 3419 defsubr (&Smake_directory_internal);
aa734e17 3420 defsubr (&Sdelete_directory);
570d7624
JB		 3421 defsubr (&Sdelete_file);
3422 defsubr (&Srename_file);
3423 defsubr (&Sadd_name_to_file);
3424#ifdef S_IFLNK
3425 defsubr (&Smake_symbolic_link);
3426#endif /* S_IFLNK */
3427#ifdef VMS
3428 defsubr (&Sdefine_logical_name);
3429#endif /* VMS */
3430#ifdef HPUX_NET
3431 defsubr (&Ssysnetunam);
3432#endif /* HPUX_NET */
3433 defsubr (&Sfile_name_absolute_p);
3434 defsubr (&Sfile_exists_p);
3435 defsubr (&Sfile_executable_p);
3436 defsubr (&Sfile_readable_p);
3437 defsubr (&Sfile_writable_p);
3438 defsubr (&Sfile_symlink_p);
3439 defsubr (&Sfile_directory_p);
b72dea2a 3440 defsubr (&Sfile_accessible_directory_p);
570d7624
JB		 3441 defsubr (&Sfile_modes);
3442 defsubr (&Sset_file_modes);
c24e9a53
RS		 3443 defsubr (&Sset_default_file_modes);
3444 defsubr (&Sdefault_file_modes);
570d7624
JB		 3445 defsubr (&Sfile_newer_than_file_p);
3446 defsubr (&Sinsert_file_contents);
3447 defsubr (&Swrite_region);
3448 defsubr (&Sverify_visited_file_modtime);
3449 defsubr (&Sclear_visited_file_modtime);
f5d5eccf 3450 defsubr (&Svisited_file_modtime);
570d7624
JB		 3451 defsubr (&Sset_visited_file_modtime);
3452 defsubr (&Sdo_auto_save);
3453 defsubr (&Sset_buffer_auto_saved);
3454 defsubr (&Srecent_auto_save_p);
3455
3456 defsubr (&Sread_file_name_internal);
3457 defsubr (&Sread_file_name);
85ffea93 3458
483a2e10 3459#ifdef unix
85ffea93 3460 defsubr (&Sunix_sync);
483a2e10 3461#endif
570d7624 3462}
Unnamed repository; edit this file 'description' to name the repository.