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