aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorJim Blandy1991-04-10 02:13:03 +0000
committerJim Blandy1991-04-10 02:13:03 +0000
commit570d76241f1618c716cbc2451f8cdb0bb46f0e20 (patch)
tree76cfa69a82e63404d3f74d73231a0c0384db890c /src
parent405b4c7a8b5d5fc0c6059a9f2eaf1bb20e298952 (diff)
downloademacs-570d76241f1618c716cbc2451f8cdb0bb46f0e20.tar.gz
emacs-570d76241f1618c716cbc2451f8cdb0bb46f0e20.zip
Initial revision
Diffstat (limited to 'src')
-rw-r--r--src/fileio.c2811
1 files changed, 2811 insertions, 0 deletions
diff --git a/src/fileio.c b/src/fileio.c
new file mode 100644
index 00000000000..7727448feb4
--- /dev/null
+++ b/src/fileio.c
@@ -0,0 +1,2811 @@
1/* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
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
8the Free Software Foundation; either version 1, or (at your option)
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
20
21#include <sys/types.h>
22#include <sys/stat.h>
23#include <pwd.h>
24#include <ctype.h>
25#include <sys/dir.h>
26#include <errno.h>
27
28#ifndef VMS
29extern int errno;
30extern char *sys_errlist[];
31extern int sys_nerr;
32#endif
33
34#define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
35
36#ifdef APOLLO
37#include <sys/time.h>
38#endif
39
40#ifdef NULL
41#undef NULL
42#endif
43#include "config.h"
44#include "lisp.h"
45#include "buffer.h"
46#include "window.h"
47
48#ifdef VMS
49#include <perror.h>
50#include <file.h>
51#include <rmsdef.h>
52#include <fab.h>
53#include <nam.h>
54#endif
55
56#ifdef NEED_TIME_H
57#include <time.h>
58#else /* not NEED_TIME_H */
59#ifdef HAVE_TIMEVAL
60#include <sys/time.h>
61#endif /* HAVE_TIMEVAL */
62#endif /* not NEED_TIME_H */
63
64#ifdef HPUX
65#include <netio.h>
66#include <errnet.h>
67#endif
68
69#ifndef O_WRONLY
70#define O_WRONLY 1
71#endif
72
73#define min(a, b) ((a) < (b) ? (a) : (b))
74#define max(a, b) ((a) > (b) ? (a) : (b))
75
76/* Nonzero during writing of auto-save files */
77int auto_saving;
78
79/* Set by auto_save_1 to mode of original file so Fwrite_region will create
80 a new file with the same mode as the original */
81int auto_save_mode_bits;
82
83/* Nonzero means, when reading a filename in the minibuffer,
84 start out by inserting the default directory into the minibuffer. */
85int insert_default_directory;
86
87/* On VMS, nonzero means write new files with record format stmlf.
88 Zero means use var format. */
89int vms_stmlf_recfm;
90
91Lisp_Object Qfile_error, Qfile_already_exists;
92
93report_file_error (string, data)
94 char *string;
95 Lisp_Object data;
96{
97 Lisp_Object errstring;
98
99 if (errno >= 0 && errno < sys_nerr)
100 errstring = build_string (sys_errlist[errno]);
101 else
102 errstring = build_string ("undocumented error code");
103
104 /* System error messages are capitalized. Downcase the initial
105 unless it is followed by a slash. */
106 if (XSTRING (errstring)->data[1] != '/')
107 XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
108
109 while (1)
110 Fsignal (Qfile_error,
111 Fcons (build_string (string), Fcons (errstring, data)));
112}
113
114DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
115 1, 1, 0,
116 "Return the directory component in file name NAME.\n\
117Return nil if NAME does not include a directory.\n\
118Otherwise return a directory spec.\n\
119Given a Unix syntax file name, returns a string ending in slash;\n\
120on VMS, perhaps instead a string ending in `:', `]' or `>'.")
121 (file)
122 Lisp_Object file;
123{
124 register unsigned char *beg;
125 register unsigned char *p;
126
127 CHECK_STRING (file, 0);
128
129 beg = XSTRING (file)->data;
130 p = beg + XSTRING (file)->size;
131
132 while (p != beg && p[-1] != '/'
133#ifdef VMS
134 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
135#endif /* VMS */
136 ) p--;
137
138 if (p == beg)
139 return Qnil;
140 return make_string (beg, p - beg);
141}
142
143DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
144 1, 1, 0,
145 "Return file name NAME sans its directory.\n\
146For example, in a Unix-syntax file name,\n\
147this is everything after the last slash,\n\
148or the entire name if it contains no slash.")
149 (file)
150 Lisp_Object file;
151{
152 register unsigned char *beg, *p, *end;
153
154 CHECK_STRING (file, 0);
155
156 beg = XSTRING (file)->data;
157 end = p = beg + XSTRING (file)->size;
158
159 while (p != beg && p[-1] != '/'
160#ifdef VMS
161 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
162#endif /* VMS */
163 ) p--;
164
165 return make_string (p, end - p);
166}
167
168char *
169file_name_as_directory (out, in)
170 char *out, *in;
171{
172 int size = strlen (in) - 1;
173
174 strcpy (out, in);
175
176#ifdef VMS
177 /* Is it already a directory string? */
178 if (in[size] == ':' || in[size] == ']' || in[size] == '>')
179 return out;
180 /* Is it a VMS directory file name? If so, hack VMS syntax. */
181 else if (! index (in, '/')
182 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
183 || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
184 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
185 || ! strncmp (&in[size - 5], ".dir", 4))
186 && (in[size - 1] == '.' || in[size - 1] == ';')
187 && in[size] == '1')))
188 {
189 register char *p, *dot;
190 char brack;
191
192 /* x.dir -> [.x]
193 dir:x.dir --> dir:[x]
194 dir:[x]y.dir --> dir:[x.y] */
195 p = in + size;
196 while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
197 if (p != in)
198 {
199 strncpy (out, in, p - in);
200 out[p - in] = '\0';
201 if (*p == ':')
202 {
203 brack = ']';
204 strcat (out, ":[");
205 }
206 else
207 {
208 brack = *p;
209 strcat (out, ".");
210 }
211 p++;
212 }
213 else
214 {
215 brack = ']';
216 strcpy (out, "[.");
217 }
218 if (dot = index (p, '.'))
219 {
220 /* blindly remove any extension */
221 size = strlen (out) + (dot - p);
222 strncat (out, p, dot - p);
223 }
224 else
225 {
226 strcat (out, p);
227 size = strlen (out);
228 }
229 out[size++] = brack;
230 out[size] = '\0';
231 }
232#else /* not VMS */
233 /* For Unix syntax, Append a slash if necessary */
234 if (out[size] != '/')
235 strcat (out, "/");
236#endif /* not VMS */
237 return out;
238}
239
240DEFUN ("file-name-as-directory", Ffile_name_as_directory,
241 Sfile_name_as_directory, 1, 1, 0,
242 "Return a string representing file FILENAME interpreted as a directory.\n\
243This operation exists because a directory is also a file, but its name as\n\
244a directory is different from its name as a file.\n\
245The result can be used as the value of `default-directory'\n\
246or passed as second argument to `expand-file-name'.\n\
247For a Unix-syntax file name, just appends a slash.\n\
248On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
249 (file)
250 Lisp_Object file;
251{
252 char *buf;
253
254 CHECK_STRING (file, 0);
255 if (NULL (file))
256 return Qnil;
257 buf = (char *) alloca (XSTRING (file)->size + 10);
258 return build_string (file_name_as_directory (buf, XSTRING (file)->data));
259}
260
261/*
262 * Convert from directory name to filename.
263 * On VMS:
264 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
265 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
266 * On UNIX, it's simple: just make sure there is a terminating /
267
268 * Value is nonzero if the string output is different from the input.
269 */
270
271directory_file_name (src, dst)
272 char *src, *dst;
273{
274 long slen;
275#ifdef VMS
276 long rlen;
277 char * ptr, * rptr;
278 char bracket;
279 struct FAB fab = cc$rms_fab;
280 struct NAM nam = cc$rms_nam;
281 char esa[NAM$C_MAXRSS];
282#endif /* VMS */
283
284 slen = strlen (src);
285#ifdef VMS
286 if (! index (src, '/')
287 && (src[slen - 1] == ']'
288 || src[slen - 1] == ':'
289 || src[slen - 1] == '>'))
290 {
291 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
292 fab.fab$l_fna = src;
293 fab.fab$b_fns = slen;
294 fab.fab$l_nam = &nam;
295 fab.fab$l_fop = FAB$M_NAM;
296
297 nam.nam$l_esa = esa;
298 nam.nam$b_ess = sizeof esa;
299 nam.nam$b_nop |= NAM$M_SYNCHK;
300
301 /* We call SYS$PARSE to handle such things as [--] for us. */
302 if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL)
303 {
304 slen = nam.nam$b_esl;
305 if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
306 slen -= 2;
307 esa[slen] = '\0';
308 src = esa;
309 }
310 if (src[slen - 1] != ']' && src[slen - 1] != '>')
311 {
312 /* what about when we have logical_name:???? */
313 if (src[slen - 1] == ':')
314 { /* Xlate logical name and see what we get */
315 ptr = strcpy (dst, src); /* upper case for getenv */
316 while (*ptr)
317 {
318 if ('a' <= *ptr && *ptr <= 'z')
319 *ptr -= 040;
320 ptr++;
321 }
322 dst[slen - 1] = 0; /* remove colon */
323 if (!(src = egetenv (dst)))
324 return 0;
325 /* should we jump to the beginning of this procedure?
326 Good points: allows us to use logical names that xlate
327 to Unix names,
328 Bad points: can be a problem if we just translated to a device
329 name...
330 For now, I'll punt and always expect VMS names, and hope for
331 the best! */
332 slen = strlen (src);
333 if (src[slen - 1] != ']' && src[slen - 1] != '>')
334 { /* no recursion here! */
335 strcpy (dst, src);
336 return 0;
337 }
338 }
339 else
340 { /* not a directory spec */
341 strcpy (dst, src);
342 return 0;
343 }
344 }
345 bracket = src[slen - 1];
346
347 /* If bracket is ']' or '>', bracket - 2 is the corresponding
348 opening bracket. */
349 if (!(ptr = index (src, bracket - 2)))
350 { /* no opening bracket */
351 strcpy (dst, src);
352 return 0;
353 }
354 if (!(rptr = rindex (src, '.')))
355 rptr = ptr;
356 slen = rptr - src;
357 strncpy (dst, src, slen);
358 dst[slen] = '\0';
359 if (*rptr == '.')
360 {
361 dst[slen++] = bracket;
362 dst[slen] = '\0';
363 }
364 else
365 {
366 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
367 then translate the device and recurse. */
368 if (dst[slen - 1] == ':'
369 && dst[slen - 2] != ':' /* skip decnet nodes */
370 && strcmp(src + slen, "[000000]") == 0)
371 {
372 dst[slen - 1] = '\0';
373 if ((ptr = egetenv (dst))
374 && (rlen = strlen (ptr) - 1) > 0
375 && (ptr[rlen] == ']' || ptr[rlen] == '>')
376 && ptr[rlen - 1] == '.')
377 {
378 ptr[rlen - 1] = ']';
379 ptr[rlen] = '\0';
380 return directory_file_name (ptr, dst);
381 }
382 else
383 dst[slen - 1] = ':';
384 }
385 strcat (dst, "[000000]");
386 slen += 8;
387 }
388 rptr++;
389 rlen = strlen (rptr) - 1;
390 strncat (dst, rptr, rlen);
391 dst[slen + rlen] = '\0';
392 strcat (dst, ".DIR.1");
393 return 1;
394 }
395#endif /* VMS */
396 /* Process as Unix format: just remove any final slash.
397 But leave "/" unchanged; do not change it to "". */
398 strcpy (dst, src);
399 if (dst[slen - 1] == '/' && slen > 1)
400 dst[slen - 1] = 0;
401 return 1;
402}
403
404DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
405 1, 1, 0,
406 "Returns the file name of the directory named DIR.\n\
407This is the name of the file that holds the data for the directory DIR.\n\
408This operation exists because a directory is also a file, but its name as\n\
409a directory is different from its name as a file.\n\
410In Unix-syntax, this function just removes the final slash.\n\
411On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
412it returns a file name such as \"[X]Y.DIR.1\".")
413 (directory)
414 Lisp_Object directory;
415{
416 char *buf;
417
418 CHECK_STRING (directory, 0);
419
420 if (NULL (directory))
421 return Qnil;
422#ifdef VMS
423 /* 20 extra chars is insufficient for VMS, since we might perform a
424 logical name translation. an equivalence string can be up to 255
425 chars long, so grab that much extra space... - sss */
426 buf = (char *) alloca (XSTRING (directory)->size + 20 + 255);
427#else
428 buf = (char *) alloca (XSTRING (directory)->size + 20);
429#endif
430 directory_file_name (XSTRING (directory)->data, buf);
431 return build_string (buf);
432}
433
434DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
435 "Generate temporary file name (string) starting with PREFIX (a string).\n\
436The Emacs process number forms part of the result,\n\
437so there is no danger of generating a name being used by another process.")
438 (prefix)
439 Lisp_Object prefix;
440{
441 Lisp_Object val;
442 val = concat2 (prefix, build_string ("XXXXXX"));
443 mktemp (XSTRING (val)->data);
444 return val;
445}
446
447DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
448 "Convert FILENAME to absolute, and canonicalize it.\n\
449Second arg DEFAULT is directory to start with if FILENAME is relative\n\
450 (does not start with slash); if DEFAULT is nil or missing,\n\
451the current buffer's value of default-directory is used.\n\
452Filenames containing `.' or `..' as components are simplified;\n\
453initial `~/' expands to your home directory.\n\
454See also the function `substitute-in-file-name'.")
455 (name, defalt)
456 Lisp_Object name, defalt;
457{
458 unsigned char *nm;
459
460 register unsigned char *newdir, *p, *o;
461 int tlen;
462 unsigned char *target;
463 struct passwd *pw;
464 int lose;
465#ifdef VMS
466 unsigned char * colon = 0;
467 unsigned char * close = 0;
468 unsigned char * slash = 0;
469 unsigned char * brack = 0;
470 int lbrack = 0, rbrack = 0;
471 int dots = 0;
472#endif /* VMS */
473
474 CHECK_STRING (name, 0);
475
476#ifdef VMS
477 /* Filenames on VMS are always upper case. */
478 name = Fupcase (name);
479#endif
480
481 nm = XSTRING (name)->data;
482
483 /* If nm is absolute, flush ...// and detect /./ and /../.
484 If no /./ or /../ we can return right away. */
485 if (
486 nm[0] == '/'
487#ifdef VMS
488 || index (nm, ':')
489#endif /* VMS */
490 )
491 {
492 p = nm;
493 lose = 0;
494 while (*p)
495 {
496 if (p[0] == '/' && p[1] == '/'
497#ifdef APOLLO
498 /* // at start of filename is meaningful on Apollo system */
499 && nm != p
500#endif /* APOLLO */
501 )
502 nm = p + 1;
503 if (p[0] == '/' && p[1] == '~')
504 nm = p + 1, lose = 1;
505 if (p[0] == '/' && p[1] == '.'
506 && (p[2] == '/' || p[2] == 0
507 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
508 lose = 1;
509#ifdef VMS
510 if (p[0] == '\\')
511 lose = 1;
512 if (p[0] == '/') {
513 /* if dev:[dir]/, move nm to / */
514 if (!slash && p > nm && (brack || colon)) {
515 nm = (brack ? brack + 1 : colon + 1);
516 lbrack = rbrack = 0;
517 brack = 0;
518 colon = 0;
519 }
520 slash = p;
521 }
522 if (p[0] == '-')
523#ifndef VMS4_4
524 /* VMS pre V4.4,convert '-'s in filenames. */
525 if (lbrack == rbrack)
526 {
527 if (dots < 2) /* this is to allow negative version numbers */
528 p[0] = '_';
529 }
530 else
531#endif /* VMS4_4 */
532 if (lbrack > rbrack &&
533 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
534 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
535 lose = 1;
536#ifndef VMS4_4
537 else
538 p[0] = '_';
539#endif /* VMS4_4 */
540 /* count open brackets, reset close bracket pointer */
541 if (p[0] == '[' || p[0] == '<')
542 lbrack++, brack = 0;
543 /* count close brackets, set close bracket pointer */
544 if (p[0] == ']' || p[0] == '>')
545 rbrack++, brack = p;
546 /* detect ][ or >< */
547 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
548 lose = 1;
549 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
550 nm = p + 1, lose = 1;
551 if (p[0] == ':' && (colon || slash))
552 /* if dev1:[dir]dev2:, move nm to dev2: */
553 if (brack)
554 {
555 nm = brack + 1;
556 brack = 0;
557 }
558 /* if /pathname/dev:, move nm to dev: */
559 else if (slash)
560 nm = slash + 1;
561 /* if node::dev:, move colon following dev */
562 else if (colon && colon[-1] == ':')
563 colon = p;
564 /* if dev1:dev2:, move nm to dev2: */
565 else if (colon && colon[-1] != ':')
566 {
567 nm = colon + 1;
568 colon = 0;
569 }
570 if (p[0] == ':' && !colon)
571 {
572 if (p[1] == ':')
573 p++;
574 colon = p;
575 }
576 if (lbrack == rbrack)
577 if (p[0] == ';')
578 dots = 2;
579 else if (p[0] == '.')
580 dots++;
581#endif /* VMS */
582 p++;
583 }
584 if (!lose)
585 {
586#ifdef VMS
587 if (index (nm, '/'))
588 return build_string (sys_translate_unix (nm));
589#endif /* VMS */
590 if (nm == XSTRING (name)->data)
591 return name;
592 return build_string (nm);
593 }
594 }
595
596 /* Now determine directory to start with and put it in newdir */
597
598 newdir = 0;
599
600 if (nm[0] == '~') /* prefix ~ */
601 if (nm[1] == '/'
602#ifdef VMS
603 || nm[1] == ':'
604#endif /* VMS */
605 || nm[1] == 0)/* ~/filename */
606 {
607 if (!(newdir = (unsigned char *) egetenv ("HOME")))
608 newdir = (unsigned char *) "";
609 nm++;
610#ifdef VMS
611 nm++; /* Don't leave the slash in nm. */
612#endif /* VMS */
613 }
614 else /* ~user/filename */
615 {
616 for (p = nm; *p && (*p != '/'
617#ifdef VMS
618 && *p != ':'
619#endif /* VMS */
620 ); p++);
621 o = (unsigned char *) alloca (p - nm + 1);
622 bcopy ((char *) nm, o, p - nm);
623 o [p - nm] = 0;
624
625 pw = (struct passwd *) getpwnam (o + 1);
626 if (!pw)
627 error ("\"%s\" isn't a registered user", o + 1);
628
629#ifdef VMS
630 nm = p + 1; /* skip the terminator */
631#else
632 nm = p;
633#endif /* VMS */
634 newdir = (unsigned char *) pw -> pw_dir;
635 }
636
637 if (nm[0] != '/'
638#ifdef VMS
639 && !index (nm, ':')
640#endif /* not VMS */
641 && !newdir)
642 {
643 if (NULL (defalt))
644 defalt = current_buffer->directory;
645 CHECK_STRING (defalt, 1);
646 newdir = XSTRING (defalt)->data;
647 }
648
649 /* Now concatenate the directory and name to new space in the stack frame */
650
651 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
652 target = (unsigned char *) alloca (tlen);
653 *target = 0;
654
655 if (newdir)
656 {
657#ifndef VMS
658 if (nm[0] == 0 || nm[0] == '/')
659 strcpy (target, newdir);
660 else
661#endif
662 file_name_as_directory (target, newdir);
663 }
664
665 strcat (target, nm);
666#ifdef VMS
667 if (index (target, '/'))
668 strcpy (target, sys_translate_unix (target));
669#endif /* VMS */
670
671 /* Now canonicalize by removing /. and /foo/.. if they appear */
672
673 p = target;
674 o = target;
675
676 while (*p)
677 {
678#ifdef VMS
679 if (*p != ']' && *p != '>' && *p != '-')
680 {
681 if (*p == '\\')
682 p++;
683 *o++ = *p++;
684 }
685 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
686 /* brackets are offset from each other by 2 */
687 {
688 p += 2;
689 if (*p != '.' && *p != '-' && o[-1] != '.')
690 /* convert [foo][bar] to [bar] */
691 while (o[-1] != '[' && o[-1] != '<')
692 o--;
693 else if (*p == '-' && *o != '.')
694 *--p = '.';
695 }
696 else if (p[0] == '-' && o[-1] == '.' &&
697 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
698 /* flush .foo.- ; leave - if stopped by '[' or '<' */
699 {
700 do
701 o--;
702 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
703 if (p[1] == '.') /* foo.-.bar ==> bar*/
704 p += 2;
705 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
706 p++, o--;
707 /* else [foo.-] ==> [-] */
708 }
709 else
710 {
711#ifndef VMS4_4
712 if (*p == '-' &&
713 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
714 p[1] != ']' && p[1] != '>' && p[1] != '.')
715 *p = '_';
716#endif /* VMS4_4 */
717 *o++ = *p++;
718 }
719#else /* not VMS */
720 if (*p != '/')
721 {
722 *o++ = *p++;
723 }
724 else if (!strncmp (p, "//", 2)
725#ifdef APOLLO
726 /* // at start of filename is meaningful in Apollo system */
727 && o != target
728#endif /* APOLLO */
729 )
730 {
731 o = target;
732 p++;
733 }
734 else if (p[0] == '/' && p[1] == '.' &&
735 (p[2] == '/' || p[2] == 0))
736 p += 2;
737 else if (!strncmp (p, "/..", 3)
738 /* `/../' is the "superroot" on certain file systems. */
739 && o != target
740 && (p[3] == '/' || p[3] == 0))
741 {
742 while (o != target && *--o != '/')
743 ;
744#ifdef APOLLO
745 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
746 ++o;
747 else
748#endif /* APOLLO */
749 if (o == target && *o == '/')
750 ++o;
751 p += 3;
752 }
753 else
754 {
755 *o++ = *p++;
756 }
757#endif /* not VMS */
758 }
759
760 return make_string (target, o - target);
761}
762#if 0
763DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
764 "Convert FILENAME to absolute, and canonicalize it.\n\
765Second arg DEFAULT is directory to start with if FILENAME is relative\n\
766 (does not start with slash); if DEFAULT is nil or missing,\n\
767the current buffer's value of default-directory is used.\n\
768Filenames containing `.' or `..' as components are simplified;\n\
769initial `~/' expands to your home directory.\n\
770See also the function `substitute-in-file-name'.")
771 (name, defalt)
772 Lisp_Object name, defalt;
773{
774 unsigned char *nm;
775
776 register unsigned char *newdir, *p, *o;
777 int tlen;
778 unsigned char *target;
779 struct passwd *pw;
780 int lose;
781#ifdef VMS
782 unsigned char * colon = 0;
783 unsigned char * close = 0;
784 unsigned char * slash = 0;
785 unsigned char * brack = 0;
786 int lbrack = 0, rbrack = 0;
787 int dots = 0;
788#endif /* VMS */
789
790 CHECK_STRING (name, 0);
791
792#ifdef VMS
793 /* Filenames on VMS are always upper case. */
794 name = Fupcase (name);
795#endif
796
797 nm = XSTRING (name)->data;
798
799 /* If nm is absolute, flush ...// and detect /./ and /../.
800 If no /./ or /../ we can return right away. */
801 if (
802 nm[0] == '/'
803#ifdef VMS
804 || index (nm, ':')
805#endif /* VMS */
806 )
807 {
808 p = nm;
809 lose = 0;
810 while (*p)
811 {
812 if (p[0] == '/' && p[1] == '/'
813#ifdef APOLLO
814 /* // at start of filename is meaningful on Apollo system */
815 && nm != p
816#endif /* APOLLO */
817 )
818 nm = p + 1;
819 if (p[0] == '/' && p[1] == '~')
820 nm = p + 1, lose = 1;
821 if (p[0] == '/' && p[1] == '.'
822 && (p[2] == '/' || p[2] == 0
823 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
824 lose = 1;
825#ifdef VMS
826 if (p[0] == '\\')
827 lose = 1;
828 if (p[0] == '/') {
829 /* if dev:[dir]/, move nm to / */
830 if (!slash && p > nm && (brack || colon)) {
831 nm = (brack ? brack + 1 : colon + 1);
832 lbrack = rbrack = 0;
833 brack = 0;
834 colon = 0;
835 }
836 slash = p;
837 }
838 if (p[0] == '-')
839#ifndef VMS4_4
840 /* VMS pre V4.4,convert '-'s in filenames. */
841 if (lbrack == rbrack)
842 {
843 if (dots < 2) /* this is to allow negative version numbers */
844 p[0] = '_';
845 }
846 else
847#endif /* VMS4_4 */
848 if (lbrack > rbrack &&
849 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
850 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
851 lose = 1;
852#ifndef VMS4_4
853 else
854 p[0] = '_';
855#endif /* VMS4_4 */
856 /* count open brackets, reset close bracket pointer */
857 if (p[0] == '[' || p[0] == '<')
858 lbrack++, brack = 0;
859 /* count close brackets, set close bracket pointer */
860 if (p[0] == ']' || p[0] == '>')
861 rbrack++, brack = p;
862 /* detect ][ or >< */
863 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
864 lose = 1;
865 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
866 nm = p + 1, lose = 1;
867 if (p[0] == ':' && (colon || slash))
868 /* if dev1:[dir]dev2:, move nm to dev2: */
869 if (brack)
870 {
871 nm = brack + 1;
872 brack = 0;
873 }
874 /* if /pathname/dev:, move nm to dev: */
875 else if (slash)
876 nm = slash + 1;
877 /* if node::dev:, move colon following dev */
878 else if (colon && colon[-1] == ':')
879 colon = p;
880 /* if dev1:dev2:, move nm to dev2: */
881 else if (colon && colon[-1] != ':')
882 {
883 nm = colon + 1;
884 colon = 0;
885 }
886 if (p[0] == ':' && !colon)
887 {
888 if (p[1] == ':')
889 p++;
890 colon = p;
891 }
892 if (lbrack == rbrack)
893 if (p[0] == ';')
894 dots = 2;
895 else if (p[0] == '.')
896 dots++;
897#endif /* VMS */
898 p++;
899 }
900 if (!lose)
901 {
902#ifdef VMS
903 if (index (nm, '/'))
904 return build_string (sys_translate_unix (nm));
905#endif /* VMS */
906 if (nm == XSTRING (name)->data)
907 return name;
908 return build_string (nm);
909 }
910 }
911
912 /* Now determine directory to start with and put it in NEWDIR */
913
914 newdir = 0;
915
916 if (nm[0] == '~') /* prefix ~ */
917 if (nm[1] == '/'
918#ifdef VMS
919 || nm[1] == ':'
920#endif /* VMS */
921 || nm[1] == 0)/* ~/filename */
922 {
923 if (!(newdir = (unsigned char *) egetenv ("HOME")))
924 newdir = (unsigned char *) "";
925 nm++;
926#ifdef VMS
927 nm++; /* Don't leave the slash in nm. */
928#endif /* VMS */
929 }
930 else /* ~user/filename */
931 {
932 /* Get past ~ to user */
933 unsigned char *user = nm + 1;
934 /* Find end of name. */
935 unsigned char *ptr = (unsigned char *) index (user, '/');
936 int len = ptr ? ptr - user : strlen (user);
937#ifdef VMS
938 unsigned char *ptr1 = index (user, ':');
939 if (ptr1 != 0 && ptr1 - user < len)
940 len = ptr1 - user;
941#endif /* VMS */
942 /* Copy the user name into temp storage. */
943 o = (unsigned char *) alloca (len + 1);
944 bcopy ((char *) user, o, len);
945 o[len] = 0;
946
947 /* Look up the user name. */
948 pw = (struct passwd *) getpwnam (o + 1);
949 if (!pw)
950 error ("\"%s\" isn't a registered user", o + 1);
951
952 newdir = (unsigned char *) pw->pw_dir;
953
954 /* Discard the user name from NM. */
955 nm += len;
956 }
957
958 if (nm[0] != '/'
959#ifdef VMS
960 && !index (nm, ':')
961#endif /* not VMS */
962 && !newdir)
963 {
964 if (NULL (defalt))
965 defalt = current_buffer->directory;
966 CHECK_STRING (defalt, 1);
967 newdir = XSTRING (defalt)->data;
968 }
969
970 /* Now concatenate the directory and name to new space in the stack frame */
971
972 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
973 target = (unsigned char *) alloca (tlen);
974 *target = 0;
975
976 if (newdir)
977 {
978#ifndef VMS
979 if (nm[0] == 0 || nm[0] == '/')
980 strcpy (target, newdir);
981 else
982#endif
983 file_name_as_directory (target, newdir);
984 }
985
986 strcat (target, nm);
987#ifdef VMS
988 if (index (target, '/'))
989 strcpy (target, sys_translate_unix (target));
990#endif /* VMS */
991
992 /* Now canonicalize by removing /. and /foo/.. if they appear */
993
994 p = target;
995 o = target;
996
997 while (*p)
998 {
999#ifdef VMS
1000 if (*p != ']' && *p != '>' && *p != '-')
1001 {
1002 if (*p == '\\')
1003 p++;
1004 *o++ = *p++;
1005 }
1006 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
1007 /* brackets are offset from each other by 2 */
1008 {
1009 p += 2;
1010 if (*p != '.' && *p != '-' && o[-1] != '.')
1011 /* convert [foo][bar] to [bar] */
1012 while (o[-1] != '[' && o[-1] != '<')
1013 o--;
1014 else if (*p == '-' && *o != '.')
1015 *--p = '.';
1016 }
1017 else if (p[0] == '-' && o[-1] == '.' &&
1018 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
1019 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1020 {
1021 do
1022 o--;
1023 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
1024 if (p[1] == '.') /* foo.-.bar ==> bar*/
1025 p += 2;
1026 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
1027 p++, o--;
1028 /* else [foo.-] ==> [-] */
1029 }
1030 else
1031 {
1032#ifndef VMS4_4
1033 if (*p == '-' &&
1034 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
1035 p[1] != ']' && p[1] != '>' && p[1] != '.')
1036 *p = '_';
1037#endif /* VMS4_4 */
1038 *o++ = *p++;
1039 }
1040#else /* not VMS */
1041 if (*p != '/')
1042 {
1043 *o++ = *p++;
1044 }
1045 else if (!strncmp (p, "//", 2)
1046#ifdef APOLLO
1047 /* // at start of filename is meaningful in Apollo system */
1048 && o != target
1049#endif /* APOLLO */
1050 )
1051 {
1052 o = target;
1053 p++;
1054 }
1055 else if (p[0] == '/' && p[1] == '.' &&
1056 (p[2] == '/' || p[2] == 0))
1057 p += 2;
1058 else if (!strncmp (p, "/..", 3)
1059 /* `/../' is the "superroot" on certain file systems. */
1060 && o != target
1061 && (p[3] == '/' || p[3] == 0))
1062 {
1063 while (o != target && *--o != '/')
1064 ;
1065#ifdef APOLLO
1066 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
1067 ++o;
1068 else
1069#endif /* APOLLO */
1070 if (o == target && *o == '/')
1071 ++o;
1072 p += 3;
1073 }
1074 else
1075 {
1076 *o++ = *p++;
1077 }
1078#endif /* not VMS */
1079 }
1080
1081 return make_string (target, o - target);
1082}
1083#endif
1084
1085DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1086 Ssubstitute_in_file_name, 1, 1, 0,
1087 "Substitute environment variables referred to in FILENAME.\n\
1088`$FOO' where FOO is an environment variable name means to substitute\n\
1089the value of that variable. The variable name should be terminated\n\
1090with a character not a letter, digit or underscore; otherwise, enclose\n\
1091the entire variable name in braces.\n\
1092If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1093On VMS, `$' substitution is not done; this function does little and only\n\
1094duplicates what `expand-file-name' does.")
1095 (string)
1096 Lisp_Object string;
1097{
1098 unsigned char *nm;
1099
1100 register unsigned char *s, *p, *o, *x, *endp;
1101 unsigned char *target;
1102 int total = 0;
1103 int substituted = 0;
1104 unsigned char *xnm;
1105
1106 CHECK_STRING (string, 0);
1107
1108 nm = XSTRING (string)->data;
1109 endp = nm + XSTRING (string)->size;
1110
1111 /* If /~ or // appears, discard everything through first slash. */
1112
1113 for (p = nm; p != endp; p++)
1114 {
1115 if ((p[0] == '~' ||
1116#ifdef APOLLO
1117 /* // at start of file name is meaningful in Apollo system */
1118 (p[0] == '/' && p - 1 != nm)
1119#else /* not APOLLO */
1120 p[0] == '/'
1121#endif /* not APOLLO */
1122 )
1123 && p != nm &&
1124#ifdef VMS
1125 (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' ||
1126#endif /* VMS */
1127 p[-1] == '/')
1128#ifdef VMS
1129 )
1130#endif /* VMS */
1131 {
1132 nm = p;
1133 substituted = 1;
1134 }
1135 }
1136
1137#ifdef VMS
1138 return build_string (nm);
1139#else
1140
1141 /* See if any variables are substituted into the string
1142 and find the total length of their values in `total' */
1143
1144 for (p = nm; p != endp;)
1145 if (*p != '$')
1146 p++;
1147 else
1148 {
1149 p++;
1150 if (p == endp)
1151 goto badsubst;
1152 else if (*p == '$')
1153 {
1154 /* "$$" means a single "$" */
1155 p++;
1156 total -= 1;
1157 substituted = 1;
1158 continue;
1159 }
1160 else if (*p == '{')
1161 {
1162 o = ++p;
1163 while (p != endp && *p != '}') p++;
1164 if (*p != '}') goto missingclose;
1165 s = p;
1166 }
1167 else
1168 {
1169 o = p;
1170 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1171 s = p;
1172 }
1173
1174 /* Copy out the variable name */
1175 target = (unsigned char *) alloca (s - o + 1);
1176 strncpy (target, o, s - o);
1177 target[s - o] = 0;
1178
1179 /* Get variable value */
1180 o = (unsigned char *) egetenv (target);
1181/* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1182#if 0
1183#ifdef USG
1184 if (!o && !strcmp (target, "USER"))
1185 o = egetenv ("LOGNAME");
1186#endif /* USG */
1187#endif /* 0 */
1188 if (!o) goto badvar;
1189 total += strlen (o);
1190 substituted = 1;
1191 }
1192
1193 if (!substituted)
1194 return string;
1195
1196 /* If substitution required, recopy the string and do it */
1197 /* Make space in stack frame for the new copy */
1198 xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1);
1199 x = xnm;
1200
1201 /* Copy the rest of the name through, replacing $ constructs with values */
1202 for (p = nm; *p;)
1203 if (*p != '$')
1204 *x++ = *p++;
1205 else
1206 {
1207 p++;
1208 if (p == endp)
1209 goto badsubst;
1210 else if (*p == '$')
1211 {
1212 *x++ = *p++;
1213 continue;
1214 }
1215 else if (*p == '{')
1216 {
1217 o = ++p;
1218 while (p != endp && *p != '}') p++;
1219 if (*p != '}') goto missingclose;
1220 s = p++;
1221 }
1222 else
1223 {
1224 o = p;
1225 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1226 s = p;
1227 }
1228
1229 /* Copy out the variable name */
1230 target = (unsigned char *) alloca (s - o + 1);
1231 strncpy (target, o, s - o);
1232 target[s - o] = 0;
1233
1234 /* Get variable value */
1235 o = (unsigned char *) egetenv (target);
1236/* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1237#if 0
1238#ifdef USG
1239 if (!o && !strcmp (target, "USER"))
1240 o = egetenv ("LOGNAME");
1241#endif /* USG */
1242#endif /* 0 */
1243 if (!o)
1244 goto badvar;
1245
1246 strcpy (x, o);
1247 x += strlen (o);
1248 }
1249
1250 *x = 0;
1251
1252 /* If /~ or // appears, discard everything through first slash. */
1253
1254 for (p = xnm; p != x; p++)
1255 if ((p[0] == '~' ||
1256#ifdef APOLLO
1257 /* // at start of file name is meaningful in Apollo system */
1258 (p[0] == '/' && p - 1 != xnm)
1259#else /* not APOLLO */
1260 p[0] == '/'
1261#endif /* not APOLLO */
1262 )
1263 && p != nm && p[-1] == '/')
1264 xnm = p;
1265
1266 return make_string (xnm, x - xnm);
1267
1268 badsubst:
1269 error ("Bad format environment-variable substitution");
1270 missingclose:
1271 error ("Missing \"}\" in environment-variable substitution");
1272 badvar:
1273 error ("Substituting nonexistent environment variable \"%s\"", target);
1274
1275 /* NOTREACHED */
1276#endif /* not VMS */
1277}
1278
1279Lisp_Object
1280expand_and_dir_to_file (filename, defdir)
1281 Lisp_Object filename, defdir;
1282{
1283 register Lisp_Object abspath;
1284
1285 abspath = Fexpand_file_name (filename, defdir);
1286#ifdef VMS
1287 {
1288 register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1];
1289 if (c == ':' || c == ']' || c == '>')
1290 abspath = Fdirectory_file_name (abspath);
1291 }
1292#else
1293 /* Remove final slash, if any (unless path is root).
1294 stat behaves differently depending! */
1295 if (XSTRING (abspath)->size > 1
1296 && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
1297 {
1298 if (EQ (abspath, filename))
1299 abspath = Fcopy_sequence (abspath);
1300 XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
1301 }
1302#endif
1303 return abspath;
1304}
1305
1306barf_or_query_if_file_exists (absname, querystring, interactive)
1307 Lisp_Object absname;
1308 unsigned char *querystring;
1309 int interactive;
1310{
1311 register Lisp_Object tem;
1312 struct gcpro gcpro1;
1313
1314 if (access (XSTRING (absname)->data, 4) >= 0)
1315 {
1316 if (! interactive)
1317 Fsignal (Qfile_already_exists,
1318 Fcons (build_string ("File already exists"),
1319 Fcons (absname, Qnil)));
1320 GCPRO1 (absname);
1321 tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1322 XSTRING (absname)->data, querystring));
1323 UNGCPRO;
1324 if (NULL (tem))
1325 Fsignal (Qfile_already_exists,
1326 Fcons (build_string ("File already exists"),
1327 Fcons (absname, Qnil)));
1328 }
1329 return;
1330}
1331
1332DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
1333 "fCopy file: \nFCopy %s to file: \np",
1334 "Copy FILE to NEWNAME. Both args must be strings.\n\
1335Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1336unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1337A number as third arg means request confirmation if NEWNAME already exists.\n\
1338This is what happens in interactive use with M-x.\n\
1339Fourth arg non-nil means give the new file the same last-modified time\n\
1340that the old one has. (This works on only some systems.)")
1341 (filename, newname, ok_if_already_exists, keep_date)
1342 Lisp_Object filename, newname, ok_if_already_exists, keep_date;
1343{
1344 int ifd, ofd, n;
1345 char buf[16 * 1024];
1346 struct stat st;
1347 struct gcpro gcpro1, gcpro2;
1348
1349 GCPRO2 (filename, newname);
1350 CHECK_STRING (filename, 0);
1351 CHECK_STRING (newname, 1);
1352 filename = Fexpand_file_name (filename, Qnil);
1353 newname = Fexpand_file_name (newname, Qnil);
1354 if (NULL (ok_if_already_exists)
1355 || XTYPE (ok_if_already_exists) == Lisp_Int)
1356 barf_or_query_if_file_exists (newname, "copy to it",
1357 XTYPE (ok_if_already_exists) == Lisp_Int);
1358
1359 ifd = open (XSTRING (filename)->data, 0);
1360 if (ifd < 0)
1361 report_file_error ("Opening input file", Fcons (filename, Qnil));
1362
1363#ifdef VMS
1364 /* Create the copy file with the same record format as the input file */
1365 ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
1366#else
1367 ofd = creat (XSTRING (newname)->data, 0666);
1368#endif /* VMS */
1369 if (ofd < 0)
1370 {
1371 close (ifd);
1372 report_file_error ("Opening output file", Fcons (newname, Qnil));
1373 }
1374
1375 while ((n = read (ifd, buf, sizeof buf)) > 0)
1376 if (write (ofd, buf, n) != n)
1377 {
1378 close (ifd);
1379 close (ofd);
1380 report_file_error ("I/O error", Fcons (newname, Qnil));
1381 }
1382
1383 if (fstat (ifd, &st) >= 0)
1384 {
1385#ifdef HAVE_TIMEVAL
1386 if (!NULL (keep_date))
1387 {
1388#ifdef USE_UTIME
1389/* AIX has utimes() in compatibility package, but it dies. So use good old
1390 utime interface instead. */
1391 struct {
1392 time_t atime;
1393 time_t mtime;
1394 } tv;
1395 tv.atime = st.st_atime;
1396 tv.mtime = st.st_mtime;
1397 utime (XSTRING (newname)->data, &tv);
1398#else /* not USE_UTIME */
1399 struct timeval timevals[2];
1400 timevals[0].tv_sec = st.st_atime;
1401 timevals[1].tv_sec = st.st_mtime;
1402 timevals[0].tv_usec = timevals[1].tv_usec = 0;
1403 utimes (XSTRING (newname)->data, timevals);
1404#endif /* not USE_UTIME */
1405 }
1406#endif /* HAVE_TIMEVALS */
1407
1408#ifdef APOLLO
1409 if (!egetenv ("USE_DOMAIN_ACLS"))
1410#endif
1411 chmod (XSTRING (newname)->data, st.st_mode & 07777);
1412 }
1413
1414 close (ifd);
1415 if (close (ofd) < 0)
1416 report_file_error ("I/O error", Fcons (newname, Qnil));
1417
1418 UNGCPRO;
1419 return Qnil;
1420}
1421
1422DEFUN ("make-directory", Fmake_directory, Smake_directory, 1, 1, "FMake directory: ",
1423 "Create a directory. One argument, a file name string.")
1424 (dirname)
1425 Lisp_Object dirname;
1426{
1427 unsigned char *dir;
1428
1429 CHECK_STRING (dirname, 0);
1430 dirname = Fexpand_file_name (dirname, Qnil);
1431 dir = XSTRING (dirname)->data;
1432
1433 if (mkdir (dir, 0777) != 0)
1434 report_file_error ("Creating directory", Flist (1, &dirname));
1435
1436 return Qnil;
1437}
1438
1439DEFUN ("remove-directory", Fremove_directory, Sremove_directory, 1, 1, "FRemove directory: ",
1440 "Remove a directory. One argument, a file name string.")
1441 (dirname)
1442 Lisp_Object dirname;
1443{
1444 unsigned char *dir;
1445
1446 CHECK_STRING (dirname, 0);
1447 dirname = Fexpand_file_name (dirname, Qnil);
1448 dir = XSTRING (dirname)->data;
1449
1450 if (rmdir (dir) != 0)
1451 report_file_error ("Removing directory", Flist (1, &dirname));
1452
1453 return Qnil;
1454}
1455
1456DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
1457 "Delete specified file. One argument, a file name string.\n\
1458If file has multiple names, it continues to exist with the other names.")
1459 (filename)
1460 Lisp_Object filename;
1461{
1462 CHECK_STRING (filename, 0);
1463 filename = Fexpand_file_name (filename, Qnil);
1464 if (0 > unlink (XSTRING (filename)->data))
1465 report_file_error ("Removing old name", Flist (1, &filename));
1466 return Qnil;
1467}
1468
1469DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
1470 "fRename file: \nFRename %s to file: \np",
1471 "Rename FILE as NEWNAME. Both args strings.\n\
1472If file has names other than FILE, it continues to have those names.\n\
1473Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1474unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1475A number as third arg means request confirmation if NEWNAME already exists.\n\
1476This is what happens in interactive use with M-x.")
1477 (filename, newname, ok_if_already_exists)
1478 Lisp_Object filename, newname, ok_if_already_exists;
1479{
1480#ifdef NO_ARG_ARRAY
1481 Lisp_Object args[2];
1482#endif
1483 struct gcpro gcpro1, gcpro2;
1484
1485 GCPRO2 (filename, newname);
1486 CHECK_STRING (filename, 0);
1487 CHECK_STRING (newname, 1);
1488 filename = Fexpand_file_name (filename, Qnil);
1489 newname = Fexpand_file_name (newname, Qnil);
1490 if (NULL (ok_if_already_exists)
1491 || XTYPE (ok_if_already_exists) == Lisp_Int)
1492 barf_or_query_if_file_exists (newname, "rename to it",
1493 XTYPE (ok_if_already_exists) == Lisp_Int);
1494#ifndef BSD4_1
1495 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
1496#else
1497 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)
1498 || 0 > unlink (XSTRING (filename)->data))
1499#endif
1500 {
1501 if (errno == EXDEV)
1502 {
1503 Fcopy_file (filename, newname, ok_if_already_exists, Qt);
1504 Fdelete_file (filename);
1505 }
1506 else
1507#ifdef NO_ARG_ARRAY
1508 {
1509 args[0] = filename;
1510 args[1] = newname;
1511 report_file_error ("Renaming", Flist (2, args));
1512 }
1513#else
1514 report_file_error ("Renaming", Flist (2, &filename));
1515#endif
1516 }
1517 UNGCPRO;
1518 return Qnil;
1519}
1520
1521DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
1522 "fAdd name to file: \nFName to add to %s: \np",
1523 "Give FILE additional name NEWNAME. Both args strings.\n\
1524Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1525unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1526A number as third arg means request confirmation if NEWNAME already exists.\n\
1527This is what happens in interactive use with M-x.")
1528 (filename, newname, ok_if_already_exists)
1529 Lisp_Object filename, newname, ok_if_already_exists;
1530{
1531#ifdef NO_ARG_ARRAY
1532 Lisp_Object args[2];
1533#endif
1534 struct gcpro gcpro1, gcpro2;
1535
1536 GCPRO2 (filename, newname);
1537 CHECK_STRING (filename, 0);
1538 CHECK_STRING (newname, 1);
1539 filename = Fexpand_file_name (filename, Qnil);
1540 newname = Fexpand_file_name (newname, Qnil);
1541 if (NULL (ok_if_already_exists)
1542 || XTYPE (ok_if_already_exists) == Lisp_Int)
1543 barf_or_query_if_file_exists (newname, "make it a new name",
1544 XTYPE (ok_if_already_exists) == Lisp_Int);
1545 unlink (XSTRING (newname)->data);
1546 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
1547 {
1548#ifdef NO_ARG_ARRAY
1549 args[0] = filename;
1550 args[1] = newname;
1551 report_file_error ("Adding new name", Flist (2, args));
1552#else
1553 report_file_error ("Adding new name", Flist (2, &filename));
1554#endif
1555 }
1556
1557 UNGCPRO;
1558 return Qnil;
1559}
1560
1561#ifdef S_IFLNK
1562DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
1563 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1564 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1565Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1566unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1567A number as third arg means request confirmation if NEWNAME already exists.\n\
1568This happens for interactive use with M-x.")
1569 (filename, newname, ok_if_already_exists)
1570 Lisp_Object filename, newname, ok_if_already_exists;
1571{
1572#ifdef NO_ARG_ARRAY
1573 Lisp_Object args[2];
1574#endif
1575 struct gcpro gcpro1, gcpro2;
1576
1577 GCPRO2 (filename, newname);
1578 CHECK_STRING (filename, 0);
1579 CHECK_STRING (newname, 1);
1580#if 0 /* This made it impossible to make a link to a relative name. */
1581 filename = Fexpand_file_name (filename, Qnil);
1582#endif
1583 newname = Fexpand_file_name (newname, Qnil);
1584 if (NULL (ok_if_already_exists)
1585 || XTYPE (ok_if_already_exists) == Lisp_Int)
1586 barf_or_query_if_file_exists (newname, "make it a link",
1587 XTYPE (ok_if_already_exists) == Lisp_Int);
1588 if (0 > symlink (XSTRING (filename)->data, XSTRING (newname)->data))
1589 {
1590 /* If we didn't complain already, silently delete existing file. */
1591 if (errno == EEXIST)
1592 {
1593 unlink (XSTRING (filename)->data);
1594 if (0 <= symlink (XSTRING (filename)->data, XSTRING (newname)->data))
1595 return Qnil;
1596 }
1597
1598#ifdef NO_ARG_ARRAY
1599 args[0] = filename;
1600 args[1] = newname;
1601 report_file_error ("Making symbolic link", Flist (2, args));
1602#else
1603 report_file_error ("Making symbolic link", Flist (2, &filename));
1604#endif
1605 }
1606 UNGCPRO;
1607 return Qnil;
1608}
1609#endif /* S_IFLNK */
1610
1611#ifdef VMS
1612
1613DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
1614 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1615 "Define the job-wide logical name NAME to have the value STRING.\n\
1616If STRING is nil or a null string, the logical name NAME is deleted.")
1617 (varname, string)
1618 Lisp_Object varname;
1619 Lisp_Object string;
1620{
1621 CHECK_STRING (varname, 0);
1622 if (NULL (string))
1623 delete_logical_name (XSTRING (varname)->data);
1624 else
1625 {
1626 CHECK_STRING (string, 1);
1627
1628 if (XSTRING (string)->size == 0)
1629 delete_logical_name (XSTRING (varname)->data);
1630 else
1631 define_logical_name (XSTRING (varname)->data, XSTRING (string)->data);
1632 }
1633
1634 return string;
1635}
1636#endif /* VMS */
1637
1638#ifdef HPUX_NET
1639
1640DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
1641 "Open a network connection to PATH using LOGIN as the login string.")
1642 (path, login)
1643 Lisp_Object path, login;
1644{
1645 int netresult;
1646
1647 CHECK_STRING (path, 0);
1648 CHECK_STRING (login, 0);
1649
1650 netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
1651
1652 if (netresult == -1)
1653 return Qnil;
1654 else
1655 return Qt;
1656}
1657#endif /* HPUX_NET */
1658
1659DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
1660 1, 1, 0,
1661 "Return t if file FILENAME specifies an absolute path name.\n\
1662On Unix, this is a name starting with a `/' or a `~'.")
1663 (filename)
1664 Lisp_Object filename;
1665{
1666 unsigned char *ptr;
1667
1668 CHECK_STRING (filename, 0);
1669 ptr = XSTRING (filename)->data;
1670 if (*ptr == '/' || *ptr == '~'
1671#ifdef VMS
1672/* ??? This criterion is probably wrong for '<'. */
1673 || index (ptr, ':') || index (ptr, '<')
1674 || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
1675 && ptr[1] != '.')
1676#endif /* VMS */
1677 )
1678 return Qt;
1679 else
1680 return Qnil;
1681}
1682
1683DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
1684 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1685See also `file-readable-p' and `file-attributes'.")
1686 (filename)
1687 Lisp_Object filename;
1688{
1689 Lisp_Object abspath;
1690
1691 CHECK_STRING (filename, 0);
1692 abspath = Fexpand_file_name (filename, Qnil);
1693 return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
1694}
1695
1696DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
1697 "Return t if FILENAME can be executed by you.\n\
1698For directories this means you can change to that directory.")
1699 (filename)
1700 Lisp_Object filename;
1701
1702{
1703 Lisp_Object abspath;
1704
1705 CHECK_STRING (filename, 0);
1706 abspath = Fexpand_file_name (filename, Qnil);
1707 return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
1708}
1709
1710DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
1711 "Return t if file FILENAME exists and you can read it.\n\
1712See also `file-exists-p' and `file-attributes'.")
1713 (filename)
1714 Lisp_Object filename;
1715{
1716 Lisp_Object abspath;
1717
1718 CHECK_STRING (filename, 0);
1719 abspath = Fexpand_file_name (filename, Qnil);
1720 return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
1721}
1722
1723DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
1724 "If file FILENAME is the name of a symbolic link\n\
1725returns the name of the file to which it is linked.\n\
1726Otherwise returns NIL.")
1727 (filename)
1728 Lisp_Object filename;
1729{
1730#ifdef S_IFLNK
1731 char *buf;
1732 int bufsize;
1733 int valsize;
1734 Lisp_Object val;
1735
1736 CHECK_STRING (filename, 0);
1737 filename = Fexpand_file_name (filename, Qnil);
1738
1739 bufsize = 100;
1740 while (1)
1741 {
1742 buf = (char *) xmalloc (bufsize);
1743 bzero (buf, bufsize);
1744 valsize = readlink (XSTRING (filename)->data, buf, bufsize);
1745 if (valsize < bufsize) break;
1746 /* Buffer was not long enough */
1747 free (buf);
1748 bufsize *= 2;
1749 }
1750 if (valsize == -1)
1751 {
1752 free (buf);
1753 return Qnil;
1754 }
1755 val = make_string (buf, valsize);
1756 free (buf);
1757 return val;
1758#else /* not S_IFLNK */
1759 return Qnil;
1760#endif /* not S_IFLNK */
1761}
1762
1763/* Having this before file-symlink-p mysteriously caused it to be forgotten
1764 on the RT/PC. */
1765DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
1766 "Return t if file FILENAME can be written or created by you.")
1767 (filename)
1768 Lisp_Object filename;
1769{
1770 Lisp_Object abspath, dir;
1771
1772 CHECK_STRING (filename, 0);
1773 abspath = Fexpand_file_name (filename, Qnil);
1774 if (access (XSTRING (abspath)->data, 0) >= 0)
1775 return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
1776 dir = Ffile_name_directory (abspath);
1777#ifdef VMS
1778 if (!NULL (dir))
1779 dir = Fdirectory_file_name (dir);
1780#endif /* VMS */
1781 return (access (!NULL (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
1782 ? Qt : Qnil);
1783}
1784
1785DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
1786 "Return t if file FILENAME is the name of a directory as a file.\n\
1787A directory name spec may be given instead; then the value is t\n\
1788if the directory so specified exists and really is a directory.")
1789 (filename)
1790 Lisp_Object filename;
1791{
1792 register Lisp_Object abspath;
1793 struct stat st;
1794
1795 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
1796
1797 if (stat (XSTRING (abspath)->data, &st) < 0)
1798 return Qnil;
1799 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
1800}
1801
1802DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
1803 "Return mode bits of FILE, as an integer.")
1804 (filename)
1805 Lisp_Object filename;
1806{
1807 Lisp_Object abspath;
1808 struct stat st;
1809
1810 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
1811
1812 if (stat (XSTRING (abspath)->data, &st) < 0)
1813 return Qnil;
1814 return make_number (st.st_mode & 07777);
1815}
1816
1817DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
1818 "Set mode bits of FILE to MODE (an integer).\n\
1819Only the 12 low bits of MODE are used.")
1820 (filename, mode)
1821 Lisp_Object filename, mode;
1822{
1823 Lisp_Object abspath;
1824
1825 abspath = Fexpand_file_name (filename, current_buffer->directory);
1826 CHECK_NUMBER (mode, 1);
1827
1828#ifndef APOLLO
1829 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
1830 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
1831#else /* APOLLO */
1832 if (!egetenv ("USE_DOMAIN_ACLS"))
1833 {
1834 struct stat st;
1835 struct timeval tvp[2];
1836
1837 /* chmod on apollo also change the file's modtime; need to save the
1838 modtime and then restore it. */
1839 if (stat (XSTRING (abspath)->data, &st) < 0)
1840 {
1841 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
1842 return (Qnil);
1843 }
1844
1845 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
1846 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
1847
1848 /* reset the old accessed and modified times. */
1849 tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */
1850 tvp[0].tv_usec = 0;
1851 tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */
1852 tvp[1].tv_usec = 0;
1853
1854 if (utimes (XSTRING (abspath)->data, tvp) < 0)
1855 report_file_error ("Doing utimes", Fcons (abspath, Qnil));
1856 }
1857#endif /* APOLLO */
1858
1859 return Qnil;
1860}
1861
1862DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
1863 "Return t if file FILE1 is newer than file FILE2.\n\
1864If FILE1 does not exist, the answer is nil;\n\
1865otherwise, if FILE2 does not exist, the answer is t.")
1866 (file1, file2)
1867 Lisp_Object file1, file2;
1868{
1869 Lisp_Object abspath;
1870 struct stat st;
1871 int mtime1;
1872
1873 CHECK_STRING (file1, 0);
1874 CHECK_STRING (file2, 0);
1875
1876 abspath = expand_and_dir_to_file (file1, current_buffer->directory);
1877
1878 if (stat (XSTRING (abspath)->data, &st) < 0)
1879 return Qnil;
1880
1881 mtime1 = st.st_mtime;
1882
1883 abspath = expand_and_dir_to_file (file2, current_buffer->directory);
1884
1885 if (stat (XSTRING (abspath)->data, &st) < 0)
1886 return Qt;
1887
1888 return (mtime1 > st.st_mtime) ? Qt : Qnil;
1889}
1890
1891close_file_unwind (fd)
1892 Lisp_Object fd;
1893{
1894 close (XFASTINT (fd));
1895}
1896
1897DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1898 1, 2, 0,
1899 "Insert contents of file FILENAME after point.\n\
1900Returns list of absolute pathname and length of data inserted.\n\
1901If second argument VISIT is non-nil, the buffer's visited filename\n\
1902and last save file modtime are set, and it is marked unmodified.\n\
1903If visiting and the file does not exist, visiting is completed\n\
1904before the error is signaled.")
1905 (filename, visit)
1906 Lisp_Object filename, visit;
1907{
1908 struct stat st;
1909 register int fd;
1910 register int inserted = 0;
1911 register int how_much;
1912 int count = specpdl_ptr - specpdl;
1913 struct gcpro gcpro1;
1914
1915 GCPRO1 (filename);
1916 if (!NULL (current_buffer->read_only))
1917 Fbarf_if_buffer_read_only();
1918
1919 CHECK_STRING (filename, 0);
1920 filename = Fexpand_file_name (filename, Qnil);
1921
1922 fd = -1;
1923
1924#ifndef APOLLO
1925 if (stat (XSTRING (filename)->data, &st) < 0
1926 || (fd = open (XSTRING (filename)->data, 0)) < 0)
1927#else
1928 if ((fd = open (XSTRING (filename)->data, 0)) < 0
1929 || fstat (fd, &st) < 0)
1930#endif /* not APOLLO */
1931 {
1932 if (fd >= 0) close (fd);
1933 if (NULL (visit))
1934 report_file_error ("Opening input file", Fcons (filename, Qnil));
1935 st.st_mtime = -1;
1936 how_much = 0;
1937 goto notfound;
1938 }
1939
1940 record_unwind_protect (close_file_unwind, make_number (fd));
1941
1942 /* Supposedly happens on VMS. */
1943 if (st.st_size < 0)
1944 error ("File size is negative");
1945 {
1946 register Lisp_Object temp;
1947
1948 /* Make sure point-max won't overflow after this insertion. */
1949 XSET (temp, Lisp_Int, st.st_size + Z);
1950 if (st.st_size + Z != XINT (temp))
1951 error ("maximum buffer size exceeded");
1952 }
1953
1954 if (NULL (visit))
1955 prepare_to_modify_buffer (point, point);
1956
1957 move_gap (point);
1958 if (GAP_SIZE < st.st_size)
1959 make_gap (st.st_size - GAP_SIZE);
1960
1961 while (1)
1962 {
1963 int try = min (st.st_size - inserted, 64 << 10);
1964 int this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
1965
1966 if (this <= 0)
1967 {
1968 how_much = this;
1969 break;
1970 }
1971
1972 GPT += this;
1973 GAP_SIZE -= this;
1974 ZV += this;
1975 Z += this;
1976 inserted += this;
1977 }
1978
1979 if (inserted > 0)
1980 MODIFF++;
1981 record_insert (point, inserted);
1982
1983 close (fd);
1984
1985 /* Discard the unwind protect */
1986 specpdl_ptr = specpdl + count;
1987
1988 if (how_much < 0)
1989 error ("IO error reading %s: %s",
1990 XSTRING (filename)->data, err_str (errno));
1991
1992 notfound:
1993
1994 if (!NULL (visit))
1995 {
1996 current_buffer->undo_list = Qnil;
1997#ifdef APOLLO
1998 stat (XSTRING (filename)->data, &st);
1999#endif
2000 current_buffer->modtime = st.st_mtime;
2001 current_buffer->save_modified = MODIFF;
2002 current_buffer->auto_save_modified = MODIFF;
2003 XFASTINT (current_buffer->save_length) = Z - BEG;
2004#ifdef CLASH_DETECTION
2005 if (!NULL (current_buffer->filename))
2006 unlock_file (current_buffer->filename);
2007 unlock_file (filename);
2008#endif /* CLASH_DETECTION */
2009 current_buffer->filename = filename;
2010 /* If visiting nonexistent file, return nil. */
2011 if (st.st_mtime == -1)
2012 report_file_error ("Opening input file", Fcons (filename, Qnil));
2013 }
2014
2015 signal_after_change (point, 0, inserted);
2016
2017 {
2018 Lisp_Object result = Fcons (filename,
2019 Fcons (make_number (inserted),
2020 Qnil));
2021 UNGCPRO;
2022 return result;
2023 }
2024}
2025
2026DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
2027 "r\nFWrite region to file: ",
2028 "Write current region into specified file.\n\
2029When called from a program, takes three arguments:\n\
2030START, END and FILENAME. START and END are buffer positions.\n\
2031Optional fourth argument APPEND if non-nil means\n\
2032 append to existing file contents (if any).\n\
2033Optional fifth argument VISIT if t means\n\
2034 set the last-save-file-modtime of buffer to this file's modtime\n\
2035 and mark buffer not modified.\n\
2036If VISIT is neither t nor nil, it means do not print\n\
2037 the \"Wrote file\" message.\n\
2038Kludgy feature: if START is a string, then that string is written\n\
2039to the file, instead of any buffer contents, and END is ignored.")
2040 (start, end, filename, append, visit)
2041 Lisp_Object start, end, filename, append, visit;
2042{
2043 register int desc;
2044 int failure;
2045 int save_errno;
2046 unsigned char *fn;
2047 struct stat st;
2048 int tem;
2049 int count = specpdl_ptr - specpdl;
2050#ifdef VMS
2051 unsigned char *fname = 0; /* If non-0, original filename (must rename) */
2052#endif /* VMS */
2053
2054 /* Special kludge to simplify auto-saving */
2055 if (NULL (start))
2056 {
2057 XFASTINT (start) = BEG;
2058 XFASTINT (end) = Z;
2059 }
2060 else if (XTYPE (start) != Lisp_String)
2061 validate_region (&start, &end);
2062
2063 filename = Fexpand_file_name (filename, Qnil);
2064 fn = XSTRING (filename)->data;
2065
2066#ifdef CLASH_DETECTION
2067 if (!auto_saving)
2068 lock_file (filename);
2069#endif /* CLASH_DETECTION */
2070
2071 desc = -1;
2072 if (!NULL (append))
2073 desc = open (fn, O_WRONLY);
2074
2075 if (desc < 0)
2076#ifdef VMS
2077 if (auto_saving) /* Overwrite any previous version of autosave file */
2078 {
2079 vms_truncate (fn); /* if fn exists, truncate to zero length */
2080 desc = open (fn, O_RDWR);
2081 if (desc < 0)
2082 desc = creat_copy_attrs (XTYPE (current_buffer->filename) == Lisp_String
2083 ? XSTRING (current_buffer->filename)->data : 0,
2084 fn);
2085 }
2086 else /* Write to temporary name and rename if no errors */
2087 {
2088 Lisp_Object temp_name;
2089 temp_name = Ffile_name_directory (filename);
2090
2091 if (!NULL (temp_name))
2092 {
2093 temp_name = Fmake_temp_name (concat2 (temp_name,
2094 build_string ("$$SAVE$$")));
2095 fname = XSTRING (filename)->data;
2096 fn = XSTRING (temp_name)->data;
2097 desc = creat_copy_attrs (fname, fn);
2098 if (desc < 0)
2099 {
2100 /* If we can't open the temporary file, try creating a new
2101 version of the original file. VMS "creat" creates a
2102 new version rather than truncating an existing file. */
2103 fn = fname;
2104 fname = 0;
2105 desc = creat (fn, 0666);
2106#if 0 /* This can clobber an existing file and fail to replace it,
2107 if the user runs out of space. */
2108 if (desc < 0)
2109 {
2110 /* We can't make a new version;
2111 try to truncate and rewrite existing version if any. */
2112 vms_truncate (fn);
2113 desc = open (fn, O_RDWR);
2114 }
2115#endif
2116 }
2117 }
2118 else
2119 desc = creat (fn, 0666);
2120 }
2121#else /* not VMS */
2122 desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
2123#endif /* not VMS */
2124
2125 if (desc < 0)
2126 {
2127#ifdef CLASH_DETECTION
2128 save_errno = errno;
2129 if (!auto_saving) unlock_file (filename);
2130 errno = save_errno;
2131#endif /* CLASH_DETECTION */
2132 report_file_error ("Opening output file", Fcons (filename, Qnil));
2133 }
2134
2135 record_unwind_protect (close_file_unwind, make_number (desc));
2136
2137 if (!NULL (append))
2138 if (lseek (desc, 0, 2) < 0)
2139 {
2140#ifdef CLASH_DETECTION
2141 if (!auto_saving) unlock_file (filename);
2142#endif /* CLASH_DETECTION */
2143 report_file_error ("Lseek error", Fcons (filename, Qnil));
2144 }
2145
2146#ifdef VMS
2147/*
2148 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2149 * if we do writes that don't end with a carriage return. Furthermore
2150 * it cannot handle writes of more then 16K. The modified
2151 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2152 * this EXCEPT for the last record (iff it doesn't end with a carriage
2153 * return). This implies that if your buffer doesn't end with a carriage
2154 * return, you get one free... tough. However it also means that if
2155 * we make two calls to sys_write (a la the following code) you can
2156 * get one at the gap as well. The easiest way to fix this (honest)
2157 * is to move the gap to the next newline (or the end of the buffer).
2158 * Thus this change.
2159 *
2160 * Yech!
2161 */
2162 if (GPT > BEG && GPT_ADDR[-1] != '\n')
2163 move_gap (find_next_newline (GPT, 1));
2164#endif
2165
2166 failure = 0;
2167 immediate_quit = 1;
2168
2169 if (XTYPE (start) == Lisp_String)
2170 {
2171 failure = 0 > e_write (desc, XSTRING (start)->data,
2172 XSTRING (start)->size);
2173 save_errno = errno;
2174 }
2175 else if (XINT (start) != XINT (end))
2176 {
2177 if (XINT (start) < GPT)
2178 {
2179 register int end1 = XINT (end);
2180 tem = XINT (start);
2181 failure = 0 > e_write (desc, &FETCH_CHAR (tem),
2182 min (GPT, end1) - tem);
2183 save_errno = errno;
2184 }
2185
2186 if (XINT (end) > GPT && !failure)
2187 {
2188 tem = XINT (start);
2189 tem = max (tem, GPT);
2190 failure = 0 > e_write (desc, &FETCH_CHAR (tem), XINT (end) - tem);
2191 save_errno = errno;
2192 }
2193 }
2194
2195 immediate_quit = 0;
2196
2197#ifndef USG
2198#ifndef VMS
2199#ifndef BSD4_1
2200#ifndef alliant /* trinkle@cs.purdue.edu says fsync can return EBUSY
2201 on alliant, for no visible reason. */
2202 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2203 Disk full in NFS may be reported here. */
2204 if (fsync (desc) < 0)
2205 failure = 1, save_errno = errno;
2206#endif
2207#endif
2208#endif
2209#endif
2210
2211 /* Spurious "file has changed on disk" warnings have been
2212 observed on Suns as well.
2213 It seems that `close' can change the modtime, under nfs.
2214
2215 (This has supposedly been fixed in Sunos 4,
2216 but who knows about all the other machines with NFS?) */
2217#if 0
2218
2219 /* On VMS and APOLLO, must do the stat after the close
2220 since closing changes the modtime. */
2221#ifndef VMS
2222#ifndef APOLLO
2223 /* Recall that #if defined does not work on VMS. */
2224#define FOO
2225 fstat (desc, &st);
2226#endif
2227#endif
2228#endif
2229
2230 /* NFS can report a write failure now. */
2231 if (close (desc) < 0)
2232 failure = 1, save_errno = errno;
2233
2234#ifdef VMS
2235 /* If we wrote to a temporary name and had no errors, rename to real name. */
2236 if (fname)
2237 {
2238 if (!failure)
2239 failure = (rename (fn, fname) != 0), save_errno = errno;
2240 fn = fname;
2241 }
2242#endif /* VMS */
2243
2244#ifndef FOO
2245 stat (fn, &st);
2246#endif
2247 /* Discard the unwind protect */
2248 specpdl_ptr = specpdl + count;
2249
2250#ifdef CLASH_DETECTION
2251 if (!auto_saving)
2252 unlock_file (filename);
2253#endif /* CLASH_DETECTION */
2254
2255 /* Do this before reporting IO error
2256 to avoid a "file has changed on disk" warning on
2257 next attempt to save. */
2258 if (EQ (visit, Qt))
2259 current_buffer->modtime = st.st_mtime;
2260
2261 if (failure)
2262 error ("IO error writing %s: %s", fn, err_str (save_errno));
2263
2264 if (EQ (visit, Qt))
2265 {
2266 current_buffer->save_modified = MODIFF;
2267 XFASTINT (current_buffer->save_length) = Z - BEG;
2268 current_buffer->filename = filename;
2269 }
2270 else if (!NULL (visit))
2271 return Qnil;
2272
2273 if (!auto_saving)
2274 message ("Wrote %s", fn);
2275
2276 return Qnil;
2277}
2278
2279int
2280e_write (desc, addr, len)
2281 int desc;
2282 register char *addr;
2283 register int len;
2284{
2285 char buf[16 * 1024];
2286 register char *p, *end;
2287
2288 if (!EQ (current_buffer->selective_display, Qt))
2289 return write (desc, addr, len) - len;
2290 else
2291 {
2292 p = buf;
2293 end = p + sizeof buf;
2294 while (len--)
2295 {
2296 if (p == end)
2297 {
2298 if (write (desc, buf, sizeof buf) != sizeof buf)
2299 return -1;
2300 p = buf;
2301 }
2302 *p = *addr++;
2303 if (*p++ == '\015')
2304 p[-1] = '\n';
2305 }
2306 if (p != buf)
2307 if (write (desc, buf, p - buf) != p - buf)
2308 return -1;
2309 }
2310 return 0;
2311}
2312
2313DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
2314 Sverify_visited_file_modtime, 1, 1, 0,
2315 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2316This means that the file has not been changed since it was visited or saved.")
2317 (buf)
2318 Lisp_Object buf;
2319{
2320 struct buffer *b;
2321 struct stat st;
2322
2323 CHECK_BUFFER (buf, 0);
2324 b = XBUFFER (buf);
2325
2326 if (XTYPE (b->filename) != Lisp_String) return Qt;
2327 if (b->modtime == 0) return Qt;
2328
2329 if (stat (XSTRING (b->filename)->data, &st) < 0)
2330 {
2331 /* If the file doesn't exist now and didn't exist before,
2332 we say that it isn't modified, provided the error is a tame one. */
2333 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
2334 st.st_mtime = -1;
2335 else
2336 st.st_mtime = 0;
2337 }
2338 if (st.st_mtime == b->modtime
2339 /* If both are positive, accept them if they are off by one second. */
2340 || (st.st_mtime > 0 && b->modtime > 0
2341 && (st.st_mtime == b->modtime + 1
2342 || st.st_mtime == b->modtime - 1)))
2343 return Qt;
2344 return Qnil;
2345}
2346
2347DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
2348 Sclear_visited_file_modtime, 0, 0, 0,
2349 "Clear out records of last mod time of visited file.\n\
2350Next attempt to save will certainly not complain of a discrepancy.")
2351 ()
2352{
2353 current_buffer->modtime = 0;
2354 return Qnil;
2355}
2356
2357DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
2358 Sset_visited_file_modtime, 0, 0, 0,
2359 "Update buffer's recorded modification time from the visited file's time.\n\
2360Useful if the buffer was not read from the file normally\n\
2361or if the file itself has been changed for some known benign reason.")
2362 ()
2363{
2364 register Lisp_Object filename;
2365 struct stat st;
2366
2367 filename = Fexpand_file_name (current_buffer->filename, Qnil);
2368
2369 if (stat (XSTRING (filename)->data, &st) >= 0)
2370 current_buffer->modtime = st.st_mtime;
2371
2372 return Qnil;
2373}
2374
2375Lisp_Object
2376auto_save_error ()
2377{
2378 unsigned char *name = XSTRING (current_buffer->name)->data;
2379
2380 ring_bell ();
2381 message ("Autosaving...error for %s", name);
2382 Fsleep_for (make_number (1));
2383 message ("Autosaving...error!for %s", name);
2384 Fsleep_for (make_number (1));
2385 message ("Autosaving...error for %s", name);
2386 Fsleep_for (make_number (1));
2387 return Qnil;
2388}
2389
2390Lisp_Object
2391auto_save_1 ()
2392{
2393 unsigned char *fn;
2394 struct stat st;
2395
2396 /* Get visited file's mode to become the auto save file's mode. */
2397 if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
2398 /* But make sure we can overwrite it later! */
2399 auto_save_mode_bits = st.st_mode | 0600;
2400 else
2401 auto_save_mode_bits = 0666;
2402
2403 return
2404 Fwrite_region (Qnil, Qnil,
2405 current_buffer->auto_save_file_name,
2406 Qnil, Qlambda);
2407}
2408
2409DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
2410 "Auto-save all buffers that need it.\n\
2411This is all buffers that have auto-saving enabled\n\
2412and are changed since last auto-saved.\n\
2413Auto-saving writes the buffer into a file\n\
2414so that your editing is not lost if the system crashes.\n\
2415This file is not the file you visited; that changes only when you save.\n\n\
2416Non-nil first argument means do not print any message if successful.\n\
2417Non-nil second argumet means save only current buffer.")
2418 (nomsg)
2419 Lisp_Object nomsg;
2420{
2421 struct buffer *old = current_buffer, *b;
2422 Lisp_Object tail, buf;
2423 int auto_saved = 0;
2424 char *omessage = echo_area_glyphs;
2425 extern minibuf_level;
2426
2427 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2428 point to non-strings reached from Vbuffer_alist. */
2429
2430 auto_saving = 1;
2431 if (minibuf_level)
2432 nomsg = Qt;
2433
2434 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2435 eventually call do-auto-save, so don't err here in that case. */
2436 if (!NULL (Vrun_hooks))
2437 call1 (Vrun_hooks, intern ("auto-save-hook"));
2438
2439 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
2440 tail = XCONS (tail)->cdr)
2441 {
2442 buf = XCONS (XCONS (tail)->car)->cdr;
2443 b = XBUFFER (buf);
2444 /* Check for auto save enabled
2445 and file changed since last auto save
2446 and file changed since last real save. */
2447 if (XTYPE (b->auto_save_file_name) == Lisp_String
2448 && b->save_modified < BUF_MODIFF (b)
2449 && b->auto_save_modified < BUF_MODIFF (b))
2450 {
2451 if ((XFASTINT (b->save_length) * 10
2452 > (BUF_Z (b) - BUF_BEG (b)) * 13)
2453 /* A short file is likely to change a large fraction;
2454 spare the user annoying messages. */
2455 && XFASTINT (b->save_length) > 5000
2456 /* These messages are frequent and annoying for `*mail*'. */
2457 && !EQ (b->filename, Qnil))
2458 {
2459 /* It has shrunk too much; turn off auto-saving here. */
2460 message ("Buffer %s has shrunk a lot; auto save turned off there",
2461 XSTRING (b->name)->data);
2462 /* User can reenable saving with M-x auto-save. */
2463 b->auto_save_file_name = Qnil;
2464 /* Prevent warning from repeating if user does so. */
2465 XFASTINT (b->save_length) = 0;
2466 Fsleep_for (make_number (1));
2467 continue;
2468 }
2469 set_buffer_internal (b);
2470 if (!auto_saved && NULL (nomsg))
2471 message1 ("Auto-saving...");
2472 internal_condition_case (auto_save_1, Qt, auto_save_error);
2473 auto_saved++;
2474 b->auto_save_modified = BUF_MODIFF (b);
2475 XFASTINT (current_buffer->save_length) = Z - BEG;
2476 set_buffer_internal (old);
2477 }
2478 }
2479
2480 if (auto_saved)
2481 record_auto_save ();
2482
2483 if (auto_saved && NULL (nomsg))
2484 message1 (omessage ? omessage : "Auto-saving...done");
2485
2486 auto_saving = 0;
2487 return Qnil;
2488}
2489
2490DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
2491 Sset_buffer_auto_saved, 0, 0, 0,
2492 "Mark current buffer as auto-saved with its current text.\n\
2493No auto-save file will be written until the buffer changes again.")
2494 ()
2495{
2496 current_buffer->auto_save_modified = MODIFF;
2497 XFASTINT (current_buffer->save_length) = Z - BEG;
2498 return Qnil;
2499}
2500
2501DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
2502 0, 0, 0,
2503 "Return t if buffer has been auto-saved since last read in or saved.")
2504 ()
2505{
2506 return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil;
2507}
2508
2509/* Reading and completing file names */
2510extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
2511
2512DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
2513 3, 3, 0,
2514 "Internal subroutine for read-file-name. Do not call this.")
2515 (string, dir, action)
2516 Lisp_Object string, dir, action;
2517 /* action is nil for complete, t for return list of completions,
2518 lambda for verify final value */
2519{
2520 Lisp_Object name, specdir, realdir, val, orig_string;
2521
2522 if (XSTRING (string)->size == 0)
2523 {
2524 orig_string = Qnil;
2525 name = string;
2526 realdir = dir;
2527 if (EQ (action, Qlambda))
2528 return Qnil;
2529 }
2530 else
2531 {
2532 orig_string = string;
2533 string = Fsubstitute_in_file_name (string);
2534 name = Ffile_name_nondirectory (string);
2535 realdir = Ffile_name_directory (string);
2536 if (NULL (realdir))
2537 realdir = dir;
2538 else
2539 realdir = Fexpand_file_name (realdir, dir);
2540 }
2541
2542 if (NULL (action))
2543 {
2544 specdir = Ffile_name_directory (string);
2545 val = Ffile_name_completion (name, realdir);
2546 if (XTYPE (val) != Lisp_String)
2547 {
2548 if (NULL (Fstring_equal (string, orig_string)))
2549 return string;
2550 return (val);
2551 }
2552
2553 if (!NULL (specdir))
2554 val = concat2 (specdir, val);
2555#ifndef VMS
2556 {
2557 register unsigned char *old, *new;
2558 register int n;
2559 int osize, count;
2560
2561 osize = XSTRING (val)->size;
2562 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2563 for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
2564 if (*old++ == '$') count++;
2565 if (count > 0)
2566 {
2567 old = XSTRING (val)->data;
2568 val = Fmake_string (make_number (osize + count), make_number (0));
2569 new = XSTRING (val)->data;
2570 for (n = osize; n > 0; n--)
2571 if (*old != '$')
2572 *new++ = *old++;
2573 else
2574 {
2575 *new++ = '$';
2576 *new++ = '$';
2577 old++;
2578 }
2579 }
2580 }
2581#endif /* Not VMS */
2582 return (val);
2583 }
2584
2585 if (EQ (action, Qt))
2586 return Ffile_name_all_completions (name, realdir);
2587 /* Only other case actually used is ACTION = lambda */
2588#ifdef VMS
2589 /* Supposedly this helps commands such as `cd' that read directory names,
2590 but can someone explain how it helps them? -- RMS */
2591 if (XSTRING (name)->size == 0)
2592 return Qt;
2593#endif /* VMS */
2594 return Ffile_exists_p (string);
2595}
2596
2597DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
2598 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2599Value is not expanded---you must call `expand-file-name' yourself.\n\
2600Default name to DEFAULT if user enters a null string.\n\
2601 (If DEFAULT is omitted, the visited file name is used.)\n\
2602Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2603 Non-nil and non-t means also require confirmation after completion.\n\
2604Fifth arg INITIAL specifies text to start with.\n\
2605DIR defaults to current buffer's directory default.")
2606 (prompt, dir, defalt, mustmatch, initial)
2607 Lisp_Object prompt, dir, defalt, mustmatch, initial;
2608{
2609 Lisp_Object val, insdef, tem, backup_n;
2610 struct gcpro gcpro1, gcpro2;
2611 register char *homedir;
2612 int count;
2613
2614 if (NULL (dir))
2615 dir = current_buffer->directory;
2616 if (NULL (defalt))
2617 defalt = current_buffer->filename;
2618
2619 /* If dir starts with user's homedir, change that to ~. */
2620 homedir = (char *) egetenv ("HOME");
2621 if (homedir != 0
2622 && XTYPE (dir) == Lisp_String
2623 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
2624 && XSTRING (dir)->data[strlen (homedir)] == '/')
2625 {
2626 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
2627 XSTRING (dir)->size - strlen (homedir) + 1);
2628 XSTRING (dir)->data[0] = '~';
2629 }
2630
2631 if (insert_default_directory)
2632 {
2633 insdef = dir;
2634 if (!NULL (initial))
2635 {
2636 Lisp_Object args[2];
2637
2638 args[0] = insdef;
2639 args[1] = initial;
2640 insdef = Fconcat (2, args);
2641 backup_n = make_number (- (XSTRING (initial)->size));
2642 }
2643 else
2644 backup_n = Qnil;
2645 }
2646 else
2647 {
2648 insdef = build_string ("");
2649 backup_n = Qnil;
2650 }
2651
2652#ifdef VMS
2653 count = specpdl_ptr - specpdl;
2654 specbind (intern ("completion-ignore-case"), Qt);
2655#endif
2656
2657 GCPRO2 (insdef, defalt);
2658 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
2659 dir, mustmatch,
2660 insert_default_directory ? insdef : Qnil, backup_n);
2661
2662#ifdef VMS
2663 unbind_to (count, Qnil);
2664#endif
2665
2666 UNGCPRO;
2667 if (NULL (val))
2668 error ("No file name specified");
2669 tem = Fstring_equal (val, insdef);
2670 if (!NULL (tem) && !NULL (defalt))
2671 return defalt;
2672 return Fsubstitute_in_file_name (val);
2673}
2674
2675#if 0 /* Old version */
2676DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
2677 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2678Value is not expanded---you must call `expand-file-name' yourself.\n\
2679Default name to DEFAULT if user enters a null string.\n\
2680 (If DEFAULT is omitted, the visited file name is used.)\n\
2681Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2682 Non-nil and non-t means also require confirmation after completion.\n\
2683Fifth arg INITIAL specifies text to start with.\n\
2684DIR defaults to current buffer's directory default.")
2685 (prompt, dir, defalt, mustmatch, initial)
2686 Lisp_Object prompt, dir, defalt, mustmatch, initial;
2687{
2688 Lisp_Object val, insdef, tem;
2689 struct gcpro gcpro1, gcpro2;
2690 register char *homedir;
2691 int count;
2692
2693 if (NULL (dir))
2694 dir = current_buffer->directory;
2695 if (NULL (defalt))
2696 defalt = current_buffer->filename;
2697
2698 /* If dir starts with user's homedir, change that to ~. */
2699 homedir = (char *) egetenv ("HOME");
2700 if (homedir != 0
2701 && XTYPE (dir) == Lisp_String
2702 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
2703 && XSTRING (dir)->data[strlen (homedir)] == '/')
2704 {
2705 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
2706 XSTRING (dir)->size - strlen (homedir) + 1);
2707 XSTRING (dir)->data[0] = '~';
2708 }
2709
2710 if (!NULL (initial))
2711 insdef = initial;
2712 else if (insert_default_directory)
2713 insdef = dir;
2714 else
2715 insdef = build_string ("");
2716
2717#ifdef VMS
2718 count = specpdl_ptr - specpdl;
2719 specbind (intern ("completion-ignore-case"), Qt);
2720#endif
2721
2722 GCPRO2 (insdef, defalt);
2723 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
2724 dir, mustmatch,
2725 insert_default_directory ? insdef : Qnil, Qnil);
2726
2727#ifdef VMS
2728 unbind_to (count, Qnil);
2729#endif
2730
2731 UNGCPRO;
2732 if (NULL (val))
2733 error ("No file name specified");
2734 tem = Fstring_equal (val, insdef);
2735 if (!NULL (tem) && !NULL (defalt))
2736 return defalt;
2737 return Fsubstitute_in_file_name (val);
2738}
2739#endif /* Old version */
2740
2741syms_of_fileio ()
2742{
2743 Qfile_error = intern ("file-error");
2744 staticpro (&Qfile_error);
2745 Qfile_already_exists = intern("file-already-exists");
2746 staticpro (&Qfile_already_exists);
2747
2748 Fput (Qfile_error, Qerror_conditions,
2749 Fcons (Qfile_error, Fcons (Qerror, Qnil)));
2750 Fput (Qfile_error, Qerror_message,
2751 build_string ("File error"));
2752
2753 Fput (Qfile_already_exists, Qerror_conditions,
2754 Fcons (Qfile_already_exists,
2755 Fcons (Qfile_error, Fcons (Qerror, Qnil))));
2756 Fput (Qfile_already_exists, Qerror_message,
2757 build_string ("File already exists"));
2758
2759 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
2760 "*Non-nil means when reading a filename start with default dir in minibuffer.");
2761 insert_default_directory = 1;
2762
2763 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
2764 "*Non-nil means write new files with record format `stmlf'.\n\
2765nil means use format `var'. This variable is meaningful only on VMS.");
2766 vms_stmlf_recfm = 0;
2767
2768 defsubr (&Sfile_name_directory);
2769 defsubr (&Sfile_name_nondirectory);
2770 defsubr (&Sfile_name_as_directory);
2771 defsubr (&Sdirectory_file_name);
2772 defsubr (&Smake_temp_name);
2773 defsubr (&Sexpand_file_name);
2774 defsubr (&Ssubstitute_in_file_name);
2775 defsubr (&Scopy_file);
2776 defsubr (&Smake_directory);
2777 defsubr (&Sremove_directory);
2778 defsubr (&Sdelete_file);
2779 defsubr (&Srename_file);
2780 defsubr (&Sadd_name_to_file);
2781#ifdef S_IFLNK
2782 defsubr (&Smake_symbolic_link);
2783#endif /* S_IFLNK */
2784#ifdef VMS
2785 defsubr (&Sdefine_logical_name);
2786#endif /* VMS */
2787#ifdef HPUX_NET
2788 defsubr (&Ssysnetunam);
2789#endif /* HPUX_NET */
2790 defsubr (&Sfile_name_absolute_p);
2791 defsubr (&Sfile_exists_p);
2792 defsubr (&Sfile_executable_p);
2793 defsubr (&Sfile_readable_p);
2794 defsubr (&Sfile_writable_p);
2795 defsubr (&Sfile_symlink_p);
2796 defsubr (&Sfile_directory_p);
2797 defsubr (&Sfile_modes);
2798 defsubr (&Sset_file_modes);
2799 defsubr (&Sfile_newer_than_file_p);
2800 defsubr (&Sinsert_file_contents);
2801 defsubr (&Swrite_region);
2802 defsubr (&Sverify_visited_file_modtime);
2803 defsubr (&Sclear_visited_file_modtime);
2804 defsubr (&Sset_visited_file_modtime);
2805 defsubr (&Sdo_auto_save);
2806 defsubr (&Sset_buffer_auto_saved);
2807 defsubr (&Srecent_auto_save_p);
2808
2809 defsubr (&Sread_file_name_internal);
2810 defsubr (&Sread_file_name);
2811}
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-22 15:53:41 +0000