1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
44 extern char *sys_errlist
[];
48 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
55 #include "intervals.h"
79 #define min(a, b) ((a) < (b) ? (a) : (b))
80 #define max(a, b) ((a) > (b) ? (a) : (b))
82 /* Nonzero during writing of auto-save files */
85 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
86 a new file with the same mode as the original */
87 int auto_save_mode_bits
;
89 /* Alist of elements (REGEXP . HANDLER) for file names
90 whose I/O is done with a special handler. */
91 Lisp_Object Vfile_name_handler_alist
;
93 /* Nonzero means, when reading a filename in the minibuffer,
94 start out by inserting the default directory into the minibuffer. */
95 int insert_default_directory
;
97 /* On VMS, nonzero means write new files with record format stmlf.
98 Zero means use var format. */
101 Lisp_Object Qfile_error
, Qfile_already_exists
;
103 Lisp_Object Qfile_name_history
;
105 report_file_error (string
, data
)
109 Lisp_Object errstring
;
111 if (errno
>= 0 && errno
< sys_nerr
)
112 errstring
= build_string (sys_errlist
[errno
]);
114 errstring
= build_string ("undocumented error code");
116 /* System error messages are capitalized. Downcase the initial
117 unless it is followed by a slash. */
118 if (XSTRING (errstring
)->data
[1] != '/')
119 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
122 Fsignal (Qfile_error
,
123 Fcons (build_string (string
), Fcons (errstring
, data
)));
126 close_file_unwind (fd
)
129 close (XFASTINT (fd
));
132 Lisp_Object Qexpand_file_name
;
133 Lisp_Object Qdirectory_file_name
;
134 Lisp_Object Qfile_name_directory
;
135 Lisp_Object Qfile_name_nondirectory
;
136 Lisp_Object Qfile_name_as_directory
;
137 Lisp_Object Qcopy_file
;
138 Lisp_Object Qmake_directory
;
139 Lisp_Object Qdelete_directory
;
140 Lisp_Object Qdelete_file
;
141 Lisp_Object Qrename_file
;
142 Lisp_Object Qadd_name_to_file
;
143 Lisp_Object Qmake_symbolic_link
;
144 Lisp_Object Qfile_exists_p
;
145 Lisp_Object Qfile_executable_p
;
146 Lisp_Object Qfile_readable_p
;
147 Lisp_Object Qfile_symlink_p
;
148 Lisp_Object Qfile_writable_p
;
149 Lisp_Object Qfile_directory_p
;
150 Lisp_Object Qfile_accessible_directory_p
;
151 Lisp_Object Qfile_modes
;
152 Lisp_Object Qset_file_modes
;
153 Lisp_Object Qfile_newer_than_file_p
;
154 Lisp_Object Qinsert_file_contents
;
155 Lisp_Object Qwrite_region
;
156 Lisp_Object Qverify_visited_file_modtime
;
158 /* If FILENAME is handled specially on account of its syntax,
159 return its handler function. Otherwise, return nil. */
162 find_file_handler (filename
)
163 Lisp_Object filename
;
166 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
167 chain
= XCONS (chain
)->cdr
)
170 elt
= XCONS (chain
)->car
;
171 if (XTYPE (elt
) == Lisp_Cons
)
174 string
= XCONS (elt
)->car
;
175 if (XTYPE (string
) == Lisp_String
176 && fast_string_match (string
, filename
) >= 0)
177 return XCONS (elt
)->cdr
;
183 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
185 "Return the directory component in file name NAME.\n\
186 Return nil if NAME does not include a directory.\n\
187 Otherwise return a directory spec.\n\
188 Given a Unix syntax file name, returns a string ending in slash;\n\
189 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
193 register unsigned char *beg
;
194 register unsigned char *p
;
197 CHECK_STRING (file
, 0);
199 /* If the file name has special constructs in it,
200 call the corresponding file handler. */
201 handler
= find_file_handler (file
);
203 return call2 (handler
, Qfile_name_directory
, file
);
205 beg
= XSTRING (file
)->data
;
206 p
= beg
+ XSTRING (file
)->size
;
208 while (p
!= beg
&& p
[-1] != '/'
210 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
216 return make_string (beg
, p
- beg
);
219 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
221 "Return file name NAME sans its directory.\n\
222 For example, in a Unix-syntax file name,\n\
223 this is everything after the last slash,\n\
224 or the entire name if it contains no slash.")
228 register unsigned char *beg
, *p
, *end
;
231 CHECK_STRING (file
, 0);
233 /* If the file name has special constructs in it,
234 call the corresponding file handler. */
235 handler
= find_file_handler (file
);
237 return call2 (handler
, Qfile_name_nondirectory
, file
);
239 beg
= XSTRING (file
)->data
;
240 end
= p
= beg
+ XSTRING (file
)->size
;
242 while (p
!= beg
&& p
[-1] != '/'
244 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
248 return make_string (p
, end
- p
);
252 file_name_as_directory (out
, in
)
255 int size
= strlen (in
) - 1;
260 /* Is it already a directory string? */
261 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
263 /* Is it a VMS directory file name? If so, hack VMS syntax. */
264 else if (! index (in
, '/')
265 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
266 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
267 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
268 || ! strncmp (&in
[size
- 5], ".dir", 4))
269 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
270 && in
[size
] == '1')))
272 register char *p
, *dot
;
276 dir:x.dir --> dir:[x]
277 dir:[x]y.dir --> dir:[x.y] */
279 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
282 strncpy (out
, in
, p
- in
);
301 dot
= index (p
, '.');
304 /* blindly remove any extension */
305 size
= strlen (out
) + (dot
- p
);
306 strncat (out
, p
, dot
- p
);
317 /* For Unix syntax, Append a slash if necessary */
318 if (out
[size
] != '/')
324 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
325 Sfile_name_as_directory
, 1, 1, 0,
326 "Return a string representing file FILENAME interpreted as a directory.\n\
327 This operation exists because a directory is also a file, but its name as\n\
328 a directory is different from its name as a file.\n\
329 The result can be used as the value of `default-directory'\n\
330 or passed as second argument to `expand-file-name'.\n\
331 For a Unix-syntax file name, just appends a slash.\n\
332 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
339 CHECK_STRING (file
, 0);
343 /* If the file name has special constructs in it,
344 call the corresponding file handler. */
345 handler
= find_file_handler (file
);
347 return call2 (handler
, Qfile_name_as_directory
, file
);
349 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
350 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
354 * Convert from directory name to filename.
356 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
357 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
358 * On UNIX, it's simple: just make sure there is a terminating /
360 * Value is nonzero if the string output is different from the input.
363 directory_file_name (src
, dst
)
371 struct FAB fab
= cc$rms_fab
;
372 struct NAM nam
= cc$rms_nam
;
373 char esa
[NAM$C_MAXRSS
];
378 if (! index (src
, '/')
379 && (src
[slen
- 1] == ']'
380 || src
[slen
- 1] == ':'
381 || src
[slen
- 1] == '>'))
383 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
385 fab
.fab$b_fns
= slen
;
386 fab
.fab$l_nam
= &nam
;
387 fab
.fab$l_fop
= FAB$M_NAM
;
390 nam
.nam$b_ess
= sizeof esa
;
391 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
393 /* We call SYS$PARSE to handle such things as [--] for us. */
394 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
396 slen
= nam
.nam$b_esl
;
397 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
402 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
404 /* what about when we have logical_name:???? */
405 if (src
[slen
- 1] == ':')
406 { /* Xlate logical name and see what we get */
407 ptr
= strcpy (dst
, src
); /* upper case for getenv */
410 if ('a' <= *ptr
&& *ptr
<= 'z')
414 dst
[slen
- 1] = 0; /* remove colon */
415 if (!(src
= egetenv (dst
)))
417 /* should we jump to the beginning of this procedure?
418 Good points: allows us to use logical names that xlate
420 Bad points: can be a problem if we just translated to a device
422 For now, I'll punt and always expect VMS names, and hope for
425 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
426 { /* no recursion here! */
432 { /* not a directory spec */
437 bracket
= src
[slen
- 1];
439 /* If bracket is ']' or '>', bracket - 2 is the corresponding
441 ptr
= index (src
, bracket
- 2);
443 { /* no opening bracket */
447 if (!(rptr
= rindex (src
, '.')))
450 strncpy (dst
, src
, slen
);
454 dst
[slen
++] = bracket
;
459 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
460 then translate the device and recurse. */
461 if (dst
[slen
- 1] == ':'
462 && dst
[slen
- 2] != ':' /* skip decnet nodes */
463 && strcmp(src
+ slen
, "[000000]") == 0)
465 dst
[slen
- 1] = '\0';
466 if ((ptr
= egetenv (dst
))
467 && (rlen
= strlen (ptr
) - 1) > 0
468 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
469 && ptr
[rlen
- 1] == '.')
471 char * buf
= (char *) alloca (strlen (ptr
) + 1);
475 return directory_file_name (buf
, dst
);
480 strcat (dst
, "[000000]");
484 rlen
= strlen (rptr
) - 1;
485 strncat (dst
, rptr
, rlen
);
486 dst
[slen
+ rlen
] = '\0';
487 strcat (dst
, ".DIR.1");
491 /* Process as Unix format: just remove any final slash.
492 But leave "/" unchanged; do not change it to "". */
494 if (slen
> 1 && dst
[slen
- 1] == '/')
499 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
501 "Returns the file name of the directory named DIR.\n\
502 This is the name of the file that holds the data for the directory DIR.\n\
503 This operation exists because a directory is also a file, but its name as\n\
504 a directory is different from its name as a file.\n\
505 In Unix-syntax, this function just removes the final slash.\n\
506 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
507 it returns a file name such as \"[X]Y.DIR.1\".")
509 Lisp_Object directory
;
514 CHECK_STRING (directory
, 0);
516 if (NILP (directory
))
519 /* If the file name has special constructs in it,
520 call the corresponding file handler. */
521 handler
= find_file_handler (directory
);
523 return call2 (handler
, Qdirectory_file_name
, directory
);
526 /* 20 extra chars is insufficient for VMS, since we might perform a
527 logical name translation. an equivalence string can be up to 255
528 chars long, so grab that much extra space... - sss */
529 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
531 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
533 directory_file_name (XSTRING (directory
)->data
, buf
);
534 return build_string (buf
);
537 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
538 "Generate temporary file name (string) starting with PREFIX (a string).\n\
539 The Emacs process number forms part of the result,\n\
540 so there is no danger of generating a name being used by another process.")
545 val
= concat2 (prefix
, build_string ("XXXXXX"));
546 mktemp (XSTRING (val
)->data
);
550 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
551 "Convert FILENAME to absolute, and canonicalize it.\n\
552 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
553 (does not start with slash); if DEFAULT is nil or missing,\n\
554 the current buffer's value of default-directory is used.\n\
555 Path components that are `.' are removed, and \n\
556 path components followed by `..' are removed, along with the `..' itself;\n\
557 note that these simplifications are done without checking the resulting\n\
558 paths in the file system.\n\
559 An initial `~/' expands to your home directory.\n\
560 An initial `~USER/' expands to USER's home directory.\n\
561 See also the function `substitute-in-file-name'.")
563 Lisp_Object name
, defalt
;
567 register unsigned char *newdir
, *p
, *o
;
569 unsigned char *target
;
573 unsigned char * colon
= 0;
574 unsigned char * close
= 0;
575 unsigned char * slash
= 0;
576 unsigned char * brack
= 0;
577 int lbrack
= 0, rbrack
= 0;
582 CHECK_STRING (name
, 0);
584 /* If the file name has special constructs in it,
585 call the corresponding file handler. */
586 handler
= find_file_handler (name
);
588 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
591 /* Filenames on VMS are always upper case. */
592 name
= Fupcase (name
);
595 nm
= XSTRING (name
)->data
;
597 /* If nm is absolute, flush ...// and detect /./ and /../.
598 If no /./ or /../ we can return right away. */
610 /* Since we know the path is absolute, we can assume that each
611 element starts with a "/". */
613 /* "//" anywhere isn't necessarily hairy; we just start afresh
614 with the second slash. */
615 if (p
[0] == '/' && p
[1] == '/'
617 /* // at start of filename is meaningful on Apollo system */
623 /* "~" is hairy as the start of any path element. */
624 if (p
[0] == '/' && p
[1] == '~')
625 nm
= p
+ 1, lose
= 1;
627 /* "." and ".." are hairy. */
632 || (p
[2] == '.' && (p
[3] == '/'
639 /* if dev:[dir]/, move nm to / */
640 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
641 nm
= (brack
? brack
+ 1 : colon
+ 1);
650 /* VMS pre V4.4,convert '-'s in filenames. */
651 if (lbrack
== rbrack
)
653 if (dots
< 2) /* this is to allow negative version numbers */
658 if (lbrack
> rbrack
&&
659 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
660 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
666 /* count open brackets, reset close bracket pointer */
667 if (p
[0] == '[' || p
[0] == '<')
669 /* count close brackets, set close bracket pointer */
670 if (p
[0] == ']' || p
[0] == '>')
672 /* detect ][ or >< */
673 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
675 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
676 nm
= p
+ 1, lose
= 1;
677 if (p
[0] == ':' && (colon
|| slash
))
678 /* if dev1:[dir]dev2:, move nm to dev2: */
684 /* if /pathname/dev:, move nm to dev: */
687 /* if node::dev:, move colon following dev */
688 else if (colon
&& colon
[-1] == ':')
690 /* if dev1:dev2:, move nm to dev2: */
691 else if (colon
&& colon
[-1] != ':')
696 if (p
[0] == ':' && !colon
)
702 if (lbrack
== rbrack
)
705 else if (p
[0] == '.')
714 return build_string (sys_translate_unix (nm
));
716 if (nm
== XSTRING (name
)->data
)
718 return build_string (nm
);
722 /* Now determine directory to start with and put it in newdir */
726 if (nm
[0] == '~') /* prefix ~ */
732 || nm
[1] == 0) /* ~ by itself */
734 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
735 newdir
= (unsigned char *) "";
738 nm
++; /* Don't leave the slash in nm. */
741 else /* ~user/filename */
743 for (p
= nm
; *p
&& (*p
!= '/'
748 o
= (unsigned char *) alloca (p
- nm
+ 1);
749 bcopy ((char *) nm
, o
, p
- nm
);
752 pw
= (struct passwd
*) getpwnam (o
+ 1);
755 newdir
= (unsigned char *) pw
-> pw_dir
;
757 nm
= p
+ 1; /* skip the terminator */
763 /* If we don't find a user of that name, leave the name
764 unchanged; don't move nm forward to p. */
775 defalt
= current_buffer
->directory
;
776 CHECK_STRING (defalt
, 1);
777 newdir
= XSTRING (defalt
)->data
;
782 /* Get rid of any slash at the end of newdir. */
783 int length
= strlen (newdir
);
784 if (newdir
[length
- 1] == '/')
786 unsigned char *temp
= (unsigned char *) alloca (length
);
787 bcopy (newdir
, temp
, length
- 1);
788 temp
[length
- 1] = 0;
796 /* Now concatenate the directory and name to new space in the stack frame */
797 tlen
+= strlen (nm
) + 1;
798 target
= (unsigned char *) alloca (tlen
);
804 if (nm
[0] == 0 || nm
[0] == '/')
805 strcpy (target
, newdir
);
808 file_name_as_directory (target
, newdir
);
813 if (index (target
, '/'))
814 strcpy (target
, sys_translate_unix (target
));
817 /* Now canonicalize by removing /. and /foo/.. if they appear. */
825 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
831 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
832 /* brackets are offset from each other by 2 */
835 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
836 /* convert [foo][bar] to [bar] */
837 while (o
[-1] != '[' && o
[-1] != '<')
839 else if (*p
== '-' && *o
!= '.')
842 else if (p
[0] == '-' && o
[-1] == '.' &&
843 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
844 /* flush .foo.- ; leave - if stopped by '[' or '<' */
848 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
849 if (p
[1] == '.') /* foo.-.bar ==> bar*/
851 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
853 /* else [foo.-] ==> [-] */
859 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
860 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
870 else if (!strncmp (p
, "//", 2)
872 /* // at start of filename is meaningful in Apollo system */
885 /* If "/." is the entire filename, keep the "/". Otherwise,
886 just delete the whole "/.". */
887 if (o
== target
&& p
[2] == '\0')
891 else if (!strncmp (p
, "/..", 3)
892 /* `/../' is the "superroot" on certain file systems. */
894 && (p
[3] == '/' || p
[3] == 0))
896 while (o
!= target
&& *--o
!= '/')
899 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
903 if (o
== target
&& *o
== '/')
914 return make_string (target
, o
- target
);
917 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
918 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
919 "Convert FILENAME to absolute, and canonicalize it.\n\
920 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
921 (does not start with slash); if DEFAULT is nil or missing,\n\
922 the current buffer's value of default-directory is used.\n\
923 Filenames containing `.' or `..' as components are simplified;\n\
924 initial `~/' expands to your home directory.\n\
925 See also the function `substitute-in-file-name'.")
927 Lisp_Object name, defalt;
931 register unsigned char *newdir, *p, *o;
933 unsigned char *target;
937 unsigned char * colon = 0;
938 unsigned char * close = 0;
939 unsigned char * slash = 0;
940 unsigned char * brack = 0;
941 int lbrack = 0, rbrack = 0;
945 CHECK_STRING (name
, 0);
948 /* Filenames on VMS are always upper case. */
949 name
= Fupcase (name
);
952 nm
= XSTRING (name
)->data
;
954 /* If nm is absolute, flush ...// and detect /./ and /../.
955 If no /./ or /../ we can return right away. */
967 if (p
[0] == '/' && p
[1] == '/'
969 /* // at start of filename is meaningful on Apollo system */
974 if (p
[0] == '/' && p
[1] == '~')
975 nm
= p
+ 1, lose
= 1;
976 if (p
[0] == '/' && p
[1] == '.'
977 && (p
[2] == '/' || p
[2] == 0
978 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
984 /* if dev:[dir]/, move nm to / */
985 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
986 nm
= (brack
? brack
+ 1 : colon
+ 1);
995 /* VMS pre V4.4,convert '-'s in filenames. */
996 if (lbrack
== rbrack
)
998 if (dots
< 2) /* this is to allow negative version numbers */
1003 if (lbrack
> rbrack
&&
1004 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1005 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1011 /* count open brackets, reset close bracket pointer */
1012 if (p
[0] == '[' || p
[0] == '<')
1013 lbrack
++, brack
= 0;
1014 /* count close brackets, set close bracket pointer */
1015 if (p
[0] == ']' || p
[0] == '>')
1016 rbrack
++, brack
= p
;
1017 /* detect ][ or >< */
1018 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1020 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1021 nm
= p
+ 1, lose
= 1;
1022 if (p
[0] == ':' && (colon
|| slash
))
1023 /* if dev1:[dir]dev2:, move nm to dev2: */
1029 /* if /pathname/dev:, move nm to dev: */
1032 /* if node::dev:, move colon following dev */
1033 else if (colon
&& colon
[-1] == ':')
1035 /* if dev1:dev2:, move nm to dev2: */
1036 else if (colon
&& colon
[-1] != ':')
1041 if (p
[0] == ':' && !colon
)
1047 if (lbrack
== rbrack
)
1050 else if (p
[0] == '.')
1058 if (index (nm
, '/'))
1059 return build_string (sys_translate_unix (nm
));
1061 if (nm
== XSTRING (name
)->data
)
1063 return build_string (nm
);
1067 /* Now determine directory to start with and put it in NEWDIR */
1071 if (nm
[0] == '~') /* prefix ~ */
1076 || nm
[1] == 0)/* ~/filename */
1078 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1079 newdir
= (unsigned char *) "";
1082 nm
++; /* Don't leave the slash in nm. */
1085 else /* ~user/filename */
1087 /* Get past ~ to user */
1088 unsigned char *user
= nm
+ 1;
1089 /* Find end of name. */
1090 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1091 int len
= ptr
? ptr
- user
: strlen (user
);
1093 unsigned char *ptr1
= index (user
, ':');
1094 if (ptr1
!= 0 && ptr1
- user
< len
)
1097 /* Copy the user name into temp storage. */
1098 o
= (unsigned char *) alloca (len
+ 1);
1099 bcopy ((char *) user
, o
, len
);
1102 /* Look up the user name. */
1103 pw
= (struct passwd
*) getpwnam (o
+ 1);
1105 error ("\"%s\" isn't a registered user", o
+ 1);
1107 newdir
= (unsigned char *) pw
->pw_dir
;
1109 /* Discard the user name from NM. */
1116 #endif /* not VMS */
1120 defalt
= current_buffer
->directory
;
1121 CHECK_STRING (defalt
, 1);
1122 newdir
= XSTRING (defalt
)->data
;
1125 /* Now concatenate the directory and name to new space in the stack frame */
1127 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1128 target
= (unsigned char *) alloca (tlen
);
1134 if (nm
[0] == 0 || nm
[0] == '/')
1135 strcpy (target
, newdir
);
1138 file_name_as_directory (target
, newdir
);
1141 strcat (target
, nm
);
1143 if (index (target
, '/'))
1144 strcpy (target
, sys_translate_unix (target
));
1147 /* Now canonicalize by removing /. and /foo/.. if they appear */
1155 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1161 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1162 /* brackets are offset from each other by 2 */
1165 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1166 /* convert [foo][bar] to [bar] */
1167 while (o
[-1] != '[' && o
[-1] != '<')
1169 else if (*p
== '-' && *o
!= '.')
1172 else if (p
[0] == '-' && o
[-1] == '.' &&
1173 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1174 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1178 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1179 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1181 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1183 /* else [foo.-] ==> [-] */
1189 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1190 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1200 else if (!strncmp (p
, "//", 2)
1202 /* // at start of filename is meaningful in Apollo system */
1210 else if (p
[0] == '/' && p
[1] == '.' &&
1211 (p
[2] == '/' || p
[2] == 0))
1213 else if (!strncmp (p
, "/..", 3)
1214 /* `/../' is the "superroot" on certain file systems. */
1216 && (p
[3] == '/' || p
[3] == 0))
1218 while (o
!= target
&& *--o
!= '/')
1221 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1225 if (o
== target
&& *o
== '/')
1233 #endif /* not VMS */
1236 return make_string (target
, o
- target
);
1240 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1241 Ssubstitute_in_file_name
, 1, 1, 0,
1242 "Substitute environment variables referred to in FILENAME.\n\
1243 `$FOO' where FOO is an environment variable name means to substitute\n\
1244 the value of that variable. The variable name should be terminated\n\
1245 with a character not a letter, digit or underscore; otherwise, enclose\n\
1246 the entire variable name in braces.\n\
1247 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1248 On VMS, `$' substitution is not done; this function does little and only\n\
1249 duplicates what `expand-file-name' does.")
1255 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1256 unsigned char *target
;
1258 int substituted
= 0;
1261 CHECK_STRING (string
, 0);
1263 nm
= XSTRING (string
)->data
;
1264 endp
= nm
+ XSTRING (string
)->size
;
1266 /* If /~ or // appears, discard everything through first slash. */
1268 for (p
= nm
; p
!= endp
; p
++)
1272 /* // at start of file name is meaningful in Apollo system */
1273 (p
[0] == '/' && p
- 1 != nm
)
1274 #else /* not APOLLO */
1276 #endif /* not APOLLO */
1280 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1293 return build_string (nm
);
1296 /* See if any variables are substituted into the string
1297 and find the total length of their values in `total' */
1299 for (p
= nm
; p
!= endp
;)
1309 /* "$$" means a single "$" */
1318 while (p
!= endp
&& *p
!= '}') p
++;
1319 if (*p
!= '}') goto missingclose
;
1325 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1329 /* Copy out the variable name */
1330 target
= (unsigned char *) alloca (s
- o
+ 1);
1331 strncpy (target
, o
, s
- o
);
1334 /* Get variable value */
1335 o
= (unsigned char *) egetenv (target
);
1336 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1339 if (!o
&& !strcmp (target
, "USER"))
1340 o
= egetenv ("LOGNAME");
1343 if (!o
) goto badvar
;
1344 total
+= strlen (o
);
1351 /* If substitution required, recopy the string and do it */
1352 /* Make space in stack frame for the new copy */
1353 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1356 /* Copy the rest of the name through, replacing $ constructs with values */
1373 while (p
!= endp
&& *p
!= '}') p
++;
1374 if (*p
!= '}') goto missingclose
;
1380 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1384 /* Copy out the variable name */
1385 target
= (unsigned char *) alloca (s
- o
+ 1);
1386 strncpy (target
, o
, s
- o
);
1389 /* Get variable value */
1390 o
= (unsigned char *) egetenv (target
);
1391 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1394 if (!o
&& !strcmp (target
, "USER"))
1395 o
= egetenv ("LOGNAME");
1407 /* If /~ or // appears, discard everything through first slash. */
1409 for (p
= xnm
; p
!= x
; p
++)
1412 /* // at start of file name is meaningful in Apollo system */
1413 (p
[0] == '/' && p
- 1 != xnm
)
1414 #else /* not APOLLO */
1416 #endif /* not APOLLO */
1418 && p
!= nm
&& p
[-1] == '/')
1421 return make_string (xnm
, x
- xnm
);
1424 error ("Bad format environment-variable substitution");
1426 error ("Missing \"}\" in environment-variable substitution");
1428 error ("Substituting nonexistent environment variable \"%s\"", target
);
1431 #endif /* not VMS */
1434 /* A slightly faster and more convenient way to get
1435 (directory-file-name (expand-file-name FOO)). The return value may
1436 have had its last character zapped with a '\0' character, meaning
1437 that it is acceptable to system calls, but not to other lisp
1438 functions. Callers should make sure that the return value doesn't
1442 expand_and_dir_to_file (filename
, defdir
)
1443 Lisp_Object filename
, defdir
;
1445 register Lisp_Object abspath
;
1447 abspath
= Fexpand_file_name (filename
, defdir
);
1450 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1451 if (c
== ':' || c
== ']' || c
== '>')
1452 abspath
= Fdirectory_file_name (abspath
);
1455 /* Remove final slash, if any (unless path is root).
1456 stat behaves differently depending! */
1457 if (XSTRING (abspath
)->size
> 1
1458 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1460 if (EQ (abspath
, filename
))
1461 abspath
= Fcopy_sequence (abspath
);
1462 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1468 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1469 Lisp_Object absname
;
1470 unsigned char *querystring
;
1473 register Lisp_Object tem
;
1474 struct gcpro gcpro1
;
1476 if (access (XSTRING (absname
)->data
, 4) >= 0)
1479 Fsignal (Qfile_already_exists
,
1480 Fcons (build_string ("File already exists"),
1481 Fcons (absname
, Qnil
)));
1483 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1484 XSTRING (absname
)->data
, querystring
));
1487 Fsignal (Qfile_already_exists
,
1488 Fcons (build_string ("File already exists"),
1489 Fcons (absname
, Qnil
)));
1494 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1495 "fCopy file: \nFCopy %s to file: \np\nP",
1496 "Copy FILE to NEWNAME. Both args must be strings.\n\
1497 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1498 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1499 A number as third arg means request confirmation if NEWNAME already exists.\n\
1500 This is what happens in interactive use with M-x.\n\
1501 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1502 last-modified time as the old one. (This works on only some systems.)\n\
1503 A prefix arg makes KEEP-TIME non-nil.")
1504 (filename
, newname
, ok_if_already_exists
, keep_date
)
1505 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1508 char buf
[16 * 1024];
1510 Lisp_Object handler
;
1511 struct gcpro gcpro1
, gcpro2
;
1512 int count
= specpdl_ptr
- specpdl
;
1514 GCPRO2 (filename
, newname
);
1515 CHECK_STRING (filename
, 0);
1516 CHECK_STRING (newname
, 1);
1517 filename
= Fexpand_file_name (filename
, Qnil
);
1518 newname
= Fexpand_file_name (newname
, Qnil
);
1520 /* If the input file name has special constructs in it,
1521 call the corresponding file handler. */
1522 handler
= find_file_handler (filename
);
1523 if (!NILP (handler
))
1524 return call3 (handler
, Qcopy_file
, filename
, newname
);
1525 /* Likewise for output file name. */
1526 handler
= find_file_handler (newname
);
1527 if (!NILP (handler
))
1528 return call3 (handler
, Qcopy_file
, filename
, newname
);
1530 if (NILP (ok_if_already_exists
)
1531 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1532 barf_or_query_if_file_exists (newname
, "copy to it",
1533 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1535 ifd
= open (XSTRING (filename
)->data
, 0);
1537 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1539 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1542 /* Create the copy file with the same record format as the input file */
1543 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1545 ofd
= creat (XSTRING (newname
)->data
, 0666);
1548 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1550 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1554 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1555 if (write (ofd
, buf
, n
) != n
)
1556 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1559 if (fstat (ifd
, &st
) >= 0)
1561 if (!NILP (keep_date
))
1563 EMACS_TIME atime
, mtime
;
1564 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1565 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1566 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1569 if (!egetenv ("USE_DOMAIN_ACLS"))
1571 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1574 /* Discard the unwind protects. */
1575 specpdl_ptr
= specpdl
+ count
;
1578 if (close (ofd
) < 0)
1579 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1585 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1586 Smake_directory_internal
, 1, 1, 0,
1587 "Create a directory. One argument, a file name string.")
1589 Lisp_Object dirname
;
1592 Lisp_Object handler
;
1594 CHECK_STRING (dirname
, 0);
1595 dirname
= Fexpand_file_name (dirname
, Qnil
);
1597 handler
= find_file_handler (dirname
);
1598 if (!NILP (handler
))
1599 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1601 dir
= XSTRING (dirname
)->data
;
1603 if (mkdir (dir
, 0777) != 0)
1604 report_file_error ("Creating directory", Flist (1, &dirname
));
1609 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1610 "Delete a directory. One argument, a file name string.")
1612 Lisp_Object dirname
;
1615 Lisp_Object handler
;
1617 CHECK_STRING (dirname
, 0);
1618 dirname
= Fexpand_file_name (dirname
, Qnil
);
1619 dir
= XSTRING (dirname
)->data
;
1621 handler
= find_file_handler (dirname
);
1622 if (!NILP (handler
))
1623 return call2 (handler
, Qdelete_directory
, dirname
);
1625 if (rmdir (dir
) != 0)
1626 report_file_error ("Removing directory", Flist (1, &dirname
));
1631 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1632 "Delete specified file. One argument, a file name string.\n\
1633 If file has multiple names, it continues to exist with the other names.")
1635 Lisp_Object filename
;
1637 Lisp_Object handler
;
1638 CHECK_STRING (filename
, 0);
1639 filename
= Fexpand_file_name (filename
, Qnil
);
1641 handler
= find_file_handler (filename
);
1642 if (!NILP (handler
))
1643 return call2 (handler
, Qdelete_file
, filename
);
1645 if (0 > unlink (XSTRING (filename
)->data
))
1646 report_file_error ("Removing old name", Flist (1, &filename
));
1650 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1651 "fRename file: \nFRename %s to file: \np",
1652 "Rename FILE as NEWNAME. Both args strings.\n\
1653 If file has names other than FILE, it continues to have those names.\n\
1654 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1655 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1656 A number as third arg means request confirmation if NEWNAME already exists.\n\
1657 This is what happens in interactive use with M-x.")
1658 (filename
, newname
, ok_if_already_exists
)
1659 Lisp_Object filename
, newname
, ok_if_already_exists
;
1662 Lisp_Object args
[2];
1664 Lisp_Object handler
;
1665 struct gcpro gcpro1
, gcpro2
;
1667 GCPRO2 (filename
, newname
);
1668 CHECK_STRING (filename
, 0);
1669 CHECK_STRING (newname
, 1);
1670 filename
= Fexpand_file_name (filename
, Qnil
);
1671 newname
= Fexpand_file_name (newname
, Qnil
);
1673 /* If the file name has special constructs in it,
1674 call the corresponding file handler. */
1675 handler
= find_file_handler (filename
);
1676 if (!NILP (handler
))
1677 return call3 (handler
, Qrename_file
, filename
, newname
);
1679 if (NILP (ok_if_already_exists
)
1680 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1681 barf_or_query_if_file_exists (newname
, "rename to it",
1682 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1684 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1686 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1687 || 0 > unlink (XSTRING (filename
)->data
))
1692 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1693 Fdelete_file (filename
);
1700 report_file_error ("Renaming", Flist (2, args
));
1703 report_file_error ("Renaming", Flist (2, &filename
));
1710 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1711 "fAdd name to file: \nFName to add to %s: \np",
1712 "Give FILE additional name NEWNAME. Both args strings.\n\
1713 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1714 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1715 A number as third arg means request confirmation if NEWNAME already exists.\n\
1716 This is what happens in interactive use with M-x.")
1717 (filename
, newname
, ok_if_already_exists
)
1718 Lisp_Object filename
, newname
, ok_if_already_exists
;
1721 Lisp_Object args
[2];
1723 Lisp_Object handler
;
1724 struct gcpro gcpro1
, gcpro2
;
1726 GCPRO2 (filename
, newname
);
1727 CHECK_STRING (filename
, 0);
1728 CHECK_STRING (newname
, 1);
1729 filename
= Fexpand_file_name (filename
, Qnil
);
1730 newname
= Fexpand_file_name (newname
, Qnil
);
1732 /* If the file name has special constructs in it,
1733 call the corresponding file handler. */
1734 handler
= find_file_handler (filename
);
1735 if (!NILP (handler
))
1736 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1738 if (NILP (ok_if_already_exists
)
1739 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1740 barf_or_query_if_file_exists (newname
, "make it a new name",
1741 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1742 unlink (XSTRING (newname
)->data
);
1743 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1748 report_file_error ("Adding new name", Flist (2, args
));
1750 report_file_error ("Adding new name", Flist (2, &filename
));
1759 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1760 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1761 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1762 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1763 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1764 A number as third arg means request confirmation if NEWNAME already exists.\n\
1765 This happens for interactive use with M-x.")
1766 (filename
, linkname
, ok_if_already_exists
)
1767 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1770 Lisp_Object args
[2];
1772 Lisp_Object handler
;
1773 struct gcpro gcpro1
, gcpro2
;
1775 GCPRO2 (filename
, linkname
);
1776 CHECK_STRING (filename
, 0);
1777 CHECK_STRING (linkname
, 1);
1778 #if 0 /* This made it impossible to make a link to a relative name. */
1779 filename
= Fexpand_file_name (filename
, Qnil
);
1781 linkname
= Fexpand_file_name (linkname
, Qnil
);
1783 /* If the file name has special constructs in it,
1784 call the corresponding file handler. */
1785 handler
= find_file_handler (filename
);
1786 if (!NILP (handler
))
1787 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1789 if (NILP (ok_if_already_exists
)
1790 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1791 barf_or_query_if_file_exists (linkname
, "make it a link",
1792 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1793 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1795 /* If we didn't complain already, silently delete existing file. */
1796 if (errno
== EEXIST
)
1798 unlink (XSTRING (filename
)->data
);
1799 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1806 report_file_error ("Making symbolic link", Flist (2, args
));
1808 report_file_error ("Making symbolic link", Flist (2, &filename
));
1814 #endif /* S_IFLNK */
1818 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1819 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1820 "Define the job-wide logical name NAME to have the value STRING.\n\
1821 If STRING is nil or a null string, the logical name NAME is deleted.")
1823 Lisp_Object varname
;
1826 CHECK_STRING (varname
, 0);
1828 delete_logical_name (XSTRING (varname
)->data
);
1831 CHECK_STRING (string
, 1);
1833 if (XSTRING (string
)->size
== 0)
1834 delete_logical_name (XSTRING (varname
)->data
);
1836 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1845 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1846 "Open a network connection to PATH using LOGIN as the login string.")
1848 Lisp_Object path
, login
;
1852 CHECK_STRING (path
, 0);
1853 CHECK_STRING (login
, 0);
1855 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1857 if (netresult
== -1)
1862 #endif /* HPUX_NET */
1864 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1866 "Return t if file FILENAME specifies an absolute path name.\n\
1867 On Unix, this is a name starting with a `/' or a `~'.")
1869 Lisp_Object filename
;
1873 CHECK_STRING (filename
, 0);
1874 ptr
= XSTRING (filename
)->data
;
1875 if (*ptr
== '/' || *ptr
== '~'
1877 /* ??? This criterion is probably wrong for '<'. */
1878 || index (ptr
, ':') || index (ptr
, '<')
1879 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1888 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1889 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1890 See also `file-readable-p' and `file-attributes'.")
1892 Lisp_Object filename
;
1894 Lisp_Object abspath
;
1895 Lisp_Object handler
;
1897 CHECK_STRING (filename
, 0);
1898 abspath
= Fexpand_file_name (filename
, Qnil
);
1900 /* If the file name has special constructs in it,
1901 call the corresponding file handler. */
1902 handler
= find_file_handler (abspath
);
1903 if (!NILP (handler
))
1904 return call2 (handler
, Qfile_exists_p
, abspath
);
1906 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1909 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1910 "Return t if FILENAME can be executed by you.\n\
1911 For directories this means you can change to that directory.")
1913 Lisp_Object filename
;
1916 Lisp_Object abspath
;
1917 Lisp_Object handler
;
1919 CHECK_STRING (filename
, 0);
1920 abspath
= Fexpand_file_name (filename
, Qnil
);
1922 /* If the file name has special constructs in it,
1923 call the corresponding file handler. */
1924 handler
= find_file_handler (abspath
);
1925 if (!NILP (handler
))
1926 return call2 (handler
, Qfile_executable_p
, abspath
);
1928 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1931 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1932 "Return t if file FILENAME exists and you can read it.\n\
1933 See also `file-exists-p' and `file-attributes'.")
1935 Lisp_Object filename
;
1937 Lisp_Object abspath
;
1938 Lisp_Object handler
;
1940 CHECK_STRING (filename
, 0);
1941 abspath
= Fexpand_file_name (filename
, Qnil
);
1943 /* If the file name has special constructs in it,
1944 call the corresponding file handler. */
1945 handler
= find_file_handler (abspath
);
1946 if (!NILP (handler
))
1947 return call2 (handler
, Qfile_readable_p
, abspath
);
1949 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1952 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1953 "If file FILENAME is the name of a symbolic link\n\
1954 returns the name of the file to which it is linked.\n\
1955 Otherwise returns NIL.")
1957 Lisp_Object filename
;
1964 Lisp_Object handler
;
1966 CHECK_STRING (filename
, 0);
1967 filename
= Fexpand_file_name (filename
, Qnil
);
1969 /* If the file name has special constructs in it,
1970 call the corresponding file handler. */
1971 handler
= find_file_handler (filename
);
1972 if (!NILP (handler
))
1973 return call2 (handler
, Qfile_symlink_p
, filename
);
1978 buf
= (char *) xmalloc (bufsize
);
1979 bzero (buf
, bufsize
);
1980 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1981 if (valsize
< bufsize
) break;
1982 /* Buffer was not long enough */
1991 val
= make_string (buf
, valsize
);
1994 #else /* not S_IFLNK */
1996 #endif /* not S_IFLNK */
1999 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2001 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2002 "Return t if file FILENAME can be written or created by you.")
2004 Lisp_Object filename
;
2006 Lisp_Object abspath
, dir
;
2007 Lisp_Object handler
;
2009 CHECK_STRING (filename
, 0);
2010 abspath
= Fexpand_file_name (filename
, Qnil
);
2012 /* If the file name has special constructs in it,
2013 call the corresponding file handler. */
2014 handler
= find_file_handler (abspath
);
2015 if (!NILP (handler
))
2016 return call2 (handler
, Qfile_writable_p
, abspath
);
2018 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2019 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
2020 dir
= Ffile_name_directory (abspath
);
2023 dir
= Fdirectory_file_name (dir
);
2025 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2029 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2030 "Return t if file FILENAME is the name of a directory as a file.\n\
2031 A directory name spec may be given instead; then the value is t\n\
2032 if the directory so specified exists and really is a directory.")
2034 Lisp_Object filename
;
2036 register Lisp_Object abspath
;
2038 Lisp_Object handler
;
2040 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2042 /* If the file name has special constructs in it,
2043 call the corresponding file handler. */
2044 handler
= find_file_handler (abspath
);
2045 if (!NILP (handler
))
2046 return call2 (handler
, Qfile_directory_p
, abspath
);
2048 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2050 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2053 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2054 "Return t if file FILENAME is the name of a directory as a file,\n\
2055 and files in that directory can be opened by you. In order to use a\n\
2056 directory as a buffer's current directory, this predicate must return true.\n\
2057 A directory name spec may be given instead; then the value is t\n\
2058 if the directory so specified exists and really is a readable and\n\
2059 searchable directory.")
2061 Lisp_Object filename
;
2063 Lisp_Object handler
;
2065 /* If the file name has special constructs in it,
2066 call the corresponding file handler. */
2067 handler
= find_file_handler (filename
);
2068 if (!NILP (handler
))
2069 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2071 if (NILP (Ffile_directory_p (filename
))
2072 || NILP (Ffile_executable_p (filename
)))
2078 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2079 "Return mode bits of FILE, as an integer.")
2081 Lisp_Object filename
;
2083 Lisp_Object abspath
;
2085 Lisp_Object handler
;
2087 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2089 /* If the file name has special constructs in it,
2090 call the corresponding file handler. */
2091 handler
= find_file_handler (abspath
);
2092 if (!NILP (handler
))
2093 return call2 (handler
, Qfile_modes
, abspath
);
2095 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2097 return make_number (st
.st_mode
& 07777);
2100 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2101 "Set mode bits of FILE to MODE (an integer).\n\
2102 Only the 12 low bits of MODE are used.")
2104 Lisp_Object filename
, mode
;
2106 Lisp_Object abspath
;
2107 Lisp_Object handler
;
2109 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2110 CHECK_NUMBER (mode
, 1);
2112 /* If the file name has special constructs in it,
2113 call the corresponding file handler. */
2114 handler
= find_file_handler (abspath
);
2115 if (!NILP (handler
))
2116 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2119 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2120 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2122 if (!egetenv ("USE_DOMAIN_ACLS"))
2125 struct timeval tvp
[2];
2127 /* chmod on apollo also change the file's modtime; need to save the
2128 modtime and then restore it. */
2129 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2131 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2135 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2136 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2138 /* reset the old accessed and modified times. */
2139 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2141 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2144 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2145 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2152 DEFUN ("set-umask", Fset_umask
, Sset_umask
, 1, 1, 0,
2153 "Select which permission bits to disable in newly created files.\n\
2154 MASK should be an integer; if a permission's bit in MASK is 1,\n\
2155 subsequently created files will not have that permission enabled.\n\
2156 Only the low 9 bits are used.\n\
2157 This setting is inherited by subprocesses.")
2161 CHECK_NUMBER (mask
, 0);
2163 umask (XINT (mask
) & 0777);
2168 DEFUN ("umask", Fumask
, Sumask
, 0, 0, 0,
2169 "Return the current umask value.\n\
2170 The umask value determines which permissions are enabled in newly\n\
2171 created files. If a permission's bit in the umask is 1, subsequently\n\
2172 created files will not have that permission enabled.")
2177 XSET (mask
, Lisp_Int
, umask (0));
2178 umask (XINT (mask
));
2185 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2186 "Tell Unix to finish all pending disk updates.")
2195 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2196 "Return t if file FILE1 is newer than file FILE2.\n\
2197 If FILE1 does not exist, the answer is nil;\n\
2198 otherwise, if FILE2 does not exist, the answer is t.")
2200 Lisp_Object file1
, file2
;
2202 Lisp_Object abspath1
, abspath2
;
2205 Lisp_Object handler
;
2206 struct gcpro gcpro1
, gcpro2
;
2208 CHECK_STRING (file1
, 0);
2209 CHECK_STRING (file2
, 0);
2212 GCPRO2 (abspath1
, file2
);
2213 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2214 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2217 /* If the file name has special constructs in it,
2218 call the corresponding file handler. */
2219 handler
= find_file_handler (abspath1
);
2220 if (!NILP (handler
))
2221 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2223 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2226 mtime1
= st
.st_mtime
;
2228 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2231 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2234 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2236 "Insert contents of file FILENAME after point.\n\
2237 Returns list of absolute pathname and length of data inserted.\n\
2238 If second argument VISIT is non-nil, the buffer's visited filename\n\
2239 and last save file modtime are set, and it is marked unmodified.\n\
2240 If visiting and the file does not exist, visiting is completed\n\
2241 before the error is signaled.")
2243 Lisp_Object filename
, visit
;
2247 register int inserted
= 0;
2248 register int how_much
;
2249 int count
= specpdl_ptr
- specpdl
;
2250 struct gcpro gcpro1
;
2251 Lisp_Object handler
, val
;
2256 if (!NILP (current_buffer
->read_only
))
2257 Fbarf_if_buffer_read_only();
2259 CHECK_STRING (filename
, 0);
2260 filename
= Fexpand_file_name (filename
, Qnil
);
2262 /* If the file name has special constructs in it,
2263 call the corresponding file handler. */
2264 handler
= find_file_handler (filename
);
2265 if (!NILP (handler
))
2267 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2275 if (stat (XSTRING (filename
)->data
, &st
) < 0
2276 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2278 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2279 || fstat (fd
, &st
) < 0)
2280 #endif /* not APOLLO */
2282 if (fd
>= 0) close (fd
);
2284 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2290 record_unwind_protect (close_file_unwind
, make_number (fd
));
2293 /* This code will need to be changed in order to work on named
2294 pipes, and it's probably just not worth it. So we should at
2295 least signal an error. */
2296 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2297 Fsignal (Qfile_error
,
2298 Fcons (build_string ("reading from named pipe"),
2299 Fcons (filename
, Qnil
)));
2302 /* Supposedly happens on VMS. */
2304 error ("File size is negative");
2307 register Lisp_Object temp
;
2309 /* Make sure point-max won't overflow after this insertion. */
2310 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2311 if (st
.st_size
+ Z
!= XINT (temp
))
2312 error ("maximum buffer size exceeded");
2316 prepare_to_modify_buffer (point
, point
);
2319 if (GAP_SIZE
< st
.st_size
)
2320 make_gap (st
.st_size
- GAP_SIZE
);
2324 int try = min (st
.st_size
- inserted
, 64 << 10);
2327 /* Allow quitting out of the actual I/O. */
2330 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2348 record_insert (point
, inserted
);
2350 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2351 offset_intervals (current_buffer
, point
, inserted
);
2357 /* Discard the unwind protect */
2358 specpdl_ptr
= specpdl
+ count
;
2361 error ("IO error reading %s: %s",
2362 XSTRING (filename
)->data
, err_str (errno
));
2369 current_buffer
->undo_list
= Qnil
;
2371 stat (XSTRING (filename
)->data
, &st
);
2373 current_buffer
->modtime
= st
.st_mtime
;
2374 current_buffer
->save_modified
= MODIFF
;
2375 current_buffer
->auto_save_modified
= MODIFF
;
2376 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2377 #ifdef CLASH_DETECTION
2380 if (!NILP (current_buffer
->filename
))
2381 unlock_file (current_buffer
->filename
);
2382 unlock_file (filename
);
2384 #endif /* CLASH_DETECTION */
2385 current_buffer
->filename
= filename
;
2386 /* If visiting nonexistent file, return nil. */
2387 if (current_buffer
->modtime
== -1)
2388 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2391 signal_after_change (point
, 0, inserted
);
2394 RETURN_UNGCPRO (val
);
2395 RETURN_UNGCPRO (Fcons (filename
,
2396 Fcons (make_number (inserted
),
2400 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2401 "r\nFWrite region to file: ",
2402 "Write current region into specified file.\n\
2403 When called from a program, takes three arguments:\n\
2404 START, END and FILENAME. START and END are buffer positions.\n\
2405 Optional fourth argument APPEND if non-nil means\n\
2406 append to existing file contents (if any).\n\
2407 Optional fifth argument VISIT if t means\n\
2408 set the last-save-file-modtime of buffer to this file's modtime\n\
2409 and mark buffer not modified.\n\
2410 If VISIT is neither t nor nil, it means do not print\n\
2411 the \"Wrote file\" message.\n\
2412 If VISIT is a string, it is a second file name;\n\
2413 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2414 VISIT is also the file name to lock and unlock for clash detection.\n\
2415 Kludgy feature: if START is a string, then that string is written\n\
2416 to the file, instead of any buffer contents, and END is ignored.")
2417 (start
, end
, filename
, append
, visit
)
2418 Lisp_Object start
, end
, filename
, append
, visit
;
2426 int count
= specpdl_ptr
- specpdl
;
2428 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2430 Lisp_Object handler
;
2431 Lisp_Object visit_file
= XTYPE (visit
) == Lisp_String
? visit
: filename
;
2432 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2434 /* Special kludge to simplify auto-saving */
2437 XFASTINT (start
) = BEG
;
2440 else if (XTYPE (start
) != Lisp_String
)
2441 validate_region (&start
, &end
);
2443 GCPRO4 (start
, filename
, visit
, visit_file
);
2444 filename
= Fexpand_file_name (filename
, Qnil
);
2446 /* If the file name has special constructs in it,
2447 call the corresponding file handler. */
2448 handler
= find_file_handler (filename
);
2450 if (!NILP (handler
))
2452 Lisp_Object args
[7];
2455 args
[1] = Qwrite_region
;
2461 val
= Ffuncall (7, args
);
2463 /* Do this before reporting IO error
2464 to avoid a "file has changed on disk" warning on
2465 next attempt to save. */
2466 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2468 current_buffer
->modtime
= 0;
2469 current_buffer
->save_modified
= MODIFF
;
2470 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2471 current_buffer
->filename
= visit_file
;
2477 #ifdef CLASH_DETECTION
2479 lock_file (visit_file
);
2480 #endif /* CLASH_DETECTION */
2482 fn
= XSTRING (filename
)->data
;
2485 desc
= open (fn
, O_WRONLY
);
2489 if (auto_saving
) /* Overwrite any previous version of autosave file */
2491 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2492 desc
= open (fn
, O_RDWR
);
2494 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2495 ? XSTRING (current_buffer
->filename
)->data
: 0,
2498 else /* Write to temporary name and rename if no errors */
2500 Lisp_Object temp_name
;
2501 temp_name
= Ffile_name_directory (filename
);
2503 if (!NILP (temp_name
))
2505 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2506 build_string ("$$SAVE$$")));
2507 fname
= XSTRING (filename
)->data
;
2508 fn
= XSTRING (temp_name
)->data
;
2509 desc
= creat_copy_attrs (fname
, fn
);
2512 /* If we can't open the temporary file, try creating a new
2513 version of the original file. VMS "creat" creates a
2514 new version rather than truncating an existing file. */
2517 desc
= creat (fn
, 0666);
2518 #if 0 /* This can clobber an existing file and fail to replace it,
2519 if the user runs out of space. */
2522 /* We can't make a new version;
2523 try to truncate and rewrite existing version if any. */
2525 desc
= open (fn
, O_RDWR
);
2531 desc
= creat (fn
, 0666);
2534 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2535 #endif /* not VMS */
2541 #ifdef CLASH_DETECTION
2543 if (!auto_saving
) unlock_file (visit_file
);
2545 #endif /* CLASH_DETECTION */
2546 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2549 record_unwind_protect (close_file_unwind
, make_number (desc
));
2552 if (lseek (desc
, 0, 2) < 0)
2554 #ifdef CLASH_DETECTION
2555 if (!auto_saving
) unlock_file (visit_file
);
2556 #endif /* CLASH_DETECTION */
2557 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2562 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2563 * if we do writes that don't end with a carriage return. Furthermore
2564 * it cannot handle writes of more then 16K. The modified
2565 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2566 * this EXCEPT for the last record (iff it doesn't end with a carriage
2567 * return). This implies that if your buffer doesn't end with a carriage
2568 * return, you get one free... tough. However it also means that if
2569 * we make two calls to sys_write (a la the following code) you can
2570 * get one at the gap as well. The easiest way to fix this (honest)
2571 * is to move the gap to the next newline (or the end of the buffer).
2576 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2577 move_gap (find_next_newline (GPT
, 1));
2583 if (XTYPE (start
) == Lisp_String
)
2585 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2586 XSTRING (start
)->size
);
2589 else if (XINT (start
) != XINT (end
))
2591 if (XINT (start
) < GPT
)
2593 register int end1
= XINT (end
);
2595 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2596 min (GPT
, end1
) - tem
);
2600 if (XINT (end
) > GPT
&& !failure
)
2603 tem
= max (tem
, GPT
);
2604 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2614 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2615 Disk full in NFS may be reported here. */
2616 if (fsync (desc
) < 0)
2617 failure
= 1, save_errno
= errno
;
2622 /* Spurious "file has changed on disk" warnings have been
2623 observed on Suns as well.
2624 It seems that `close' can change the modtime, under nfs.
2626 (This has supposedly been fixed in Sunos 4,
2627 but who knows about all the other machines with NFS?) */
2630 /* On VMS and APOLLO, must do the stat after the close
2631 since closing changes the modtime. */
2634 /* Recall that #if defined does not work on VMS. */
2641 /* NFS can report a write failure now. */
2642 if (close (desc
) < 0)
2643 failure
= 1, save_errno
= errno
;
2646 /* If we wrote to a temporary name and had no errors, rename to real name. */
2650 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2658 /* Discard the unwind protect */
2659 specpdl_ptr
= specpdl
+ count
;
2661 #ifdef CLASH_DETECTION
2663 unlock_file (visit_file
);
2664 #endif /* CLASH_DETECTION */
2666 /* Do this before reporting IO error
2667 to avoid a "file has changed on disk" warning on
2668 next attempt to save. */
2669 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2670 current_buffer
->modtime
= st
.st_mtime
;
2673 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2675 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2677 current_buffer
->save_modified
= MODIFF
;
2678 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2679 current_buffer
->filename
= visit_file
;
2681 else if (!NILP (visit
))
2685 message ("Wrote %s", XSTRING (visit_file
)->data
);
2691 e_write (desc
, addr
, len
)
2693 register char *addr
;
2696 char buf
[16 * 1024];
2697 register char *p
, *end
;
2699 if (!EQ (current_buffer
->selective_display
, Qt
))
2700 return write (desc
, addr
, len
) - len
;
2704 end
= p
+ sizeof buf
;
2709 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2718 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2724 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2725 Sverify_visited_file_modtime
, 1, 1, 0,
2726 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2727 This means that the file has not been changed since it was visited or saved.")
2733 Lisp_Object handler
;
2735 CHECK_BUFFER (buf
, 0);
2738 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2739 if (b
->modtime
== 0) return Qt
;
2741 /* If the file name has special constructs in it,
2742 call the corresponding file handler. */
2743 handler
= find_file_handler (b
->filename
);
2744 if (!NILP (handler
))
2745 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2747 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2749 /* If the file doesn't exist now and didn't exist before,
2750 we say that it isn't modified, provided the error is a tame one. */
2751 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2756 if (st
.st_mtime
== b
->modtime
2757 /* If both are positive, accept them if they are off by one second. */
2758 || (st
.st_mtime
> 0 && b
->modtime
> 0
2759 && (st
.st_mtime
== b
->modtime
+ 1
2760 || st
.st_mtime
== b
->modtime
- 1)))
2765 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2766 Sclear_visited_file_modtime
, 0, 0, 0,
2767 "Clear out records of last mod time of visited file.\n\
2768 Next attempt to save will certainly not complain of a discrepancy.")
2771 current_buffer
->modtime
= 0;
2775 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2776 Sset_visited_file_modtime
, 0, 0, 0,
2777 "Update buffer's recorded modification time from the visited file's time.\n\
2778 Useful if the buffer was not read from the file normally\n\
2779 or if the file itself has been changed for some known benign reason.")
2782 register Lisp_Object filename
;
2784 Lisp_Object handler
;
2786 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2788 /* If the file name has special constructs in it,
2789 call the corresponding file handler. */
2790 handler
= find_file_handler (filename
);
2791 if (!NILP (handler
))
2792 current_buffer
->modtime
= 0;
2794 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2795 current_buffer
->modtime
= st
.st_mtime
;
2803 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2806 message ("Autosaving...error for %s", name
);
2807 Fsleep_for (make_number (1), Qnil
);
2808 message ("Autosaving...error!for %s", name
);
2809 Fsleep_for (make_number (1), Qnil
);
2810 message ("Autosaving...error for %s", name
);
2811 Fsleep_for (make_number (1), Qnil
);
2821 /* Get visited file's mode to become the auto save file's mode. */
2822 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2823 /* But make sure we can overwrite it later! */
2824 auto_save_mode_bits
= st
.st_mode
| 0600;
2826 auto_save_mode_bits
= 0666;
2829 Fwrite_region (Qnil
, Qnil
,
2830 current_buffer
->auto_save_file_name
,
2834 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2835 "Auto-save all buffers that need it.\n\
2836 This is all buffers that have auto-saving enabled\n\
2837 and are changed since last auto-saved.\n\
2838 Auto-saving writes the buffer into a file\n\
2839 so that your editing is not lost if the system crashes.\n\
2840 This file is not the file you visited; that changes only when you save.\n\n\
2841 Non-nil first argument means do not print any message if successful.\n\
2842 Non-nil second argument means save only current buffer.")
2846 struct buffer
*old
= current_buffer
, *b
;
2847 Lisp_Object tail
, buf
;
2849 char *omessage
= echo_area_glyphs
;
2850 extern minibuf_level
;
2852 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2853 point to non-strings reached from Vbuffer_alist. */
2859 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2860 eventually call do-auto-save, so don't err here in that case. */
2861 if (!NILP (Vrun_hooks
))
2862 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2864 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2865 tail
= XCONS (tail
)->cdr
)
2867 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2869 /* Check for auto save enabled
2870 and file changed since last auto save
2871 and file changed since last real save. */
2872 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2873 && b
->save_modified
< BUF_MODIFF (b
)
2874 && b
->auto_save_modified
< BUF_MODIFF (b
))
2876 if ((XFASTINT (b
->save_length
) * 10
2877 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2878 /* A short file is likely to change a large fraction;
2879 spare the user annoying messages. */
2880 && XFASTINT (b
->save_length
) > 5000
2881 /* These messages are frequent and annoying for `*mail*'. */
2882 && !EQ (b
->filename
, Qnil
))
2884 /* It has shrunk too much; turn off auto-saving here. */
2885 message ("Buffer %s has shrunk a lot; auto save turned off there",
2886 XSTRING (b
->name
)->data
);
2887 /* User can reenable saving with M-x auto-save. */
2888 b
->auto_save_file_name
= Qnil
;
2889 /* Prevent warning from repeating if user does so. */
2890 XFASTINT (b
->save_length
) = 0;
2891 Fsleep_for (make_number (1), Qnil
);
2894 set_buffer_internal (b
);
2895 if (!auto_saved
&& NILP (nomsg
))
2896 message1 ("Auto-saving...");
2897 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2899 b
->auto_save_modified
= BUF_MODIFF (b
);
2900 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2901 set_buffer_internal (old
);
2905 /* Prevent another auto save till enough input events come in. */
2906 record_auto_save ();
2908 if (auto_saved
&& NILP (nomsg
))
2909 message1 (omessage
? omessage
: "Auto-saving...done");
2915 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2916 Sset_buffer_auto_saved
, 0, 0, 0,
2917 "Mark current buffer as auto-saved with its current text.\n\
2918 No auto-save file will be written until the buffer changes again.")
2921 current_buffer
->auto_save_modified
= MODIFF
;
2922 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2926 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2928 "Return t if buffer has been auto-saved since last read in or saved.")
2931 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2934 /* Reading and completing file names */
2935 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2937 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2939 "Internal subroutine for read-file-name. Do not call this.")
2940 (string
, dir
, action
)
2941 Lisp_Object string
, dir
, action
;
2942 /* action is nil for complete, t for return list of completions,
2943 lambda for verify final value */
2945 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2947 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2954 /* No need to protect ACTION--we only compare it with t and nil. */
2955 GCPRO4 (string
, realdir
, name
, specdir
);
2957 if (XSTRING (string
)->size
== 0)
2959 if (EQ (action
, Qlambda
))
2967 orig_string
= string
;
2968 string
= Fsubstitute_in_file_name (string
);
2969 changed
= NILP (Fstring_equal (string
, orig_string
));
2970 name
= Ffile_name_nondirectory (string
);
2971 val
= Ffile_name_directory (string
);
2973 realdir
= Fexpand_file_name (val
, realdir
);
2978 specdir
= Ffile_name_directory (string
);
2979 val
= Ffile_name_completion (name
, realdir
);
2981 if (XTYPE (val
) != Lisp_String
)
2988 if (!NILP (specdir
))
2989 val
= concat2 (specdir
, val
);
2992 register unsigned char *old
, *new;
2996 osize
= XSTRING (val
)->size
;
2997 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2998 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2999 if (*old
++ == '$') count
++;
3002 old
= XSTRING (val
)->data
;
3003 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3004 new = XSTRING (val
)->data
;
3005 for (n
= osize
; n
> 0; n
--)
3016 #endif /* Not VMS */
3021 if (EQ (action
, Qt
))
3022 return Ffile_name_all_completions (name
, realdir
);
3023 /* Only other case actually used is ACTION = lambda */
3025 /* Supposedly this helps commands such as `cd' that read directory names,
3026 but can someone explain how it helps them? -- RMS */
3027 if (XSTRING (name
)->size
== 0)
3030 return Ffile_exists_p (string
);
3033 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3034 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3035 Value is not expanded---you must call `expand-file-name' yourself.\n\
3036 Default name to DEFAULT if user enters a null string.\n\
3037 (If DEFAULT is omitted, the visited file name is used.)\n\
3038 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3039 Non-nil and non-t means also require confirmation after completion.\n\
3040 Fifth arg INITIAL specifies text to start with.\n\
3041 DIR defaults to current buffer's directory default.")
3042 (prompt
, dir
, defalt
, mustmatch
, initial
)
3043 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3045 Lisp_Object val
, insdef
, insdef1
, tem
;
3046 struct gcpro gcpro1
, gcpro2
;
3047 register char *homedir
;
3051 dir
= current_buffer
->directory
;
3053 defalt
= current_buffer
->filename
;
3055 /* If dir starts with user's homedir, change that to ~. */
3056 homedir
= (char *) egetenv ("HOME");
3058 && XTYPE (dir
) == Lisp_String
3059 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3060 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3062 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3063 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3064 XSTRING (dir
)->data
[0] = '~';
3067 if (insert_default_directory
)
3071 if (!NILP (initial
))
3073 Lisp_Object args
[2], pos
;
3077 insdef
= Fconcat (2, args
);
3078 pos
= make_number (XSTRING (dir
)->size
);
3079 insdef1
= Fcons (insdef
, pos
);
3083 insdef
= Qnil
, insdef1
= Qnil
;
3086 count
= specpdl_ptr
- specpdl
;
3087 specbind (intern ("completion-ignore-case"), Qt
);
3090 GCPRO2 (insdef
, defalt
);
3091 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3092 dir
, mustmatch
, insdef1
,
3093 Qfile_name_history
);
3096 unbind_to (count
, Qnil
);
3101 error ("No file name specified");
3102 tem
= Fstring_equal (val
, insdef
);
3103 if (!NILP (tem
) && !NILP (defalt
))
3105 return Fsubstitute_in_file_name (val
);
3108 #if 0 /* Old version */
3109 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3110 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3111 Value is not expanded---you must call `expand-file-name' yourself.\n\
3112 Default name to DEFAULT if user enters a null string.\n\
3113 (If DEFAULT is omitted, the visited file name is used.)\n\
3114 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3115 Non-nil and non-t means also require confirmation after completion.\n\
3116 Fifth arg INITIAL specifies text to start with.\n\
3117 DIR defaults to current buffer's directory default.")
3118 (prompt
, dir
, defalt
, mustmatch
, initial
)
3119 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3121 Lisp_Object val
, insdef
, tem
;
3122 struct gcpro gcpro1
, gcpro2
;
3123 register char *homedir
;
3127 dir
= current_buffer
->directory
;
3129 defalt
= current_buffer
->filename
;
3131 /* If dir starts with user's homedir, change that to ~. */
3132 homedir
= (char *) egetenv ("HOME");
3134 && XTYPE (dir
) == Lisp_String
3135 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3136 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3138 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3139 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3140 XSTRING (dir
)->data
[0] = '~';
3143 if (!NILP (initial
))
3145 else if (insert_default_directory
)
3148 insdef
= build_string ("");
3151 count
= specpdl_ptr
- specpdl
;
3152 specbind (intern ("completion-ignore-case"), Qt
);
3155 GCPRO2 (insdef
, defalt
);
3156 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3158 insert_default_directory
? insdef
: Qnil
,
3159 Qfile_name_history
);
3162 unbind_to (count
, Qnil
);
3167 error ("No file name specified");
3168 tem
= Fstring_equal (val
, insdef
);
3169 if (!NILP (tem
) && !NILP (defalt
))
3171 return Fsubstitute_in_file_name (val
);
3173 #endif /* Old version */
3177 Qexpand_file_name
= intern ("expand-file-name");
3178 Qdirectory_file_name
= intern ("directory-file-name");
3179 Qfile_name_directory
= intern ("file-name-directory");
3180 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3181 Qfile_name_as_directory
= intern ("file-name-as-directory");
3182 Qcopy_file
= intern ("copy-file");
3183 Qmake_directory
= intern ("make-directory");
3184 Qdelete_directory
= intern ("delete-directory");
3185 Qdelete_file
= intern ("delete-file");
3186 Qrename_file
= intern ("rename-file");
3187 Qadd_name_to_file
= intern ("add-name-to-file");
3188 Qmake_symbolic_link
= intern ("make-symbolic-link");
3189 Qfile_exists_p
= intern ("file-exists-p");
3190 Qfile_executable_p
= intern ("file-executable-p");
3191 Qfile_readable_p
= intern ("file-readable-p");
3192 Qfile_symlink_p
= intern ("file-symlink-p");
3193 Qfile_writable_p
= intern ("file-writable-p");
3194 Qfile_directory_p
= intern ("file-directory-p");
3195 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3196 Qfile_modes
= intern ("file-modes");
3197 Qset_file_modes
= intern ("set-file-modes");
3198 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3199 Qinsert_file_contents
= intern ("insert-file-contents");
3200 Qwrite_region
= intern ("write-region");
3201 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3203 Qfile_name_history
= intern ("file-name-history");
3204 Fset (Qfile_name_history
, Qnil
);
3206 staticpro (&Qcopy_file
);
3207 staticpro (&Qmake_directory
);
3208 staticpro (&Qdelete_directory
);
3209 staticpro (&Qdelete_file
);
3210 staticpro (&Qrename_file
);
3211 staticpro (&Qadd_name_to_file
);
3212 staticpro (&Qmake_symbolic_link
);
3213 staticpro (&Qfile_exists_p
);
3214 staticpro (&Qfile_executable_p
);
3215 staticpro (&Qfile_readable_p
);
3216 staticpro (&Qfile_symlink_p
);
3217 staticpro (&Qfile_writable_p
);
3218 staticpro (&Qfile_directory_p
);
3219 staticpro (&Qfile_accessible_directory_p
);
3220 staticpro (&Qfile_modes
);
3221 staticpro (&Qset_file_modes
);
3222 staticpro (&Qfile_newer_than_file_p
);
3223 staticpro (&Qinsert_file_contents
);
3224 staticpro (&Qwrite_region
);
3225 staticpro (&Qverify_visited_file_modtime
);
3226 staticpro (&Qfile_name_history
);
3228 Qfile_error
= intern ("file-error");
3229 staticpro (&Qfile_error
);
3230 Qfile_already_exists
= intern("file-already-exists");
3231 staticpro (&Qfile_already_exists
);
3233 Fput (Qfile_error
, Qerror_conditions
,
3234 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3235 Fput (Qfile_error
, Qerror_message
,
3236 build_string ("File error"));
3238 Fput (Qfile_already_exists
, Qerror_conditions
,
3239 Fcons (Qfile_already_exists
,
3240 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3241 Fput (Qfile_already_exists
, Qerror_message
,
3242 build_string ("File already exists"));
3244 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3245 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3246 insert_default_directory
= 1;
3248 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3249 "*Non-nil means write new files with record format `stmlf'.\n\
3250 nil means use format `var'. This variable is meaningful only on VMS.");
3251 vms_stmlf_recfm
= 0;
3253 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3254 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3255 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3258 The first argument given to HANDLER is the name of the I/O primitive\n\
3259 to be handled; the remaining arguments are the arguments that were\n\
3260 passed to that primitive. For example, if you do\n\
3261 (file-exists-p FILENAME)\n\
3262 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3263 (funcall HANDLER 'file-exists-p FILENAME)");
3264 Vfile_name_handler_alist
= Qnil
;
3266 defsubr (&Sfile_name_directory
);
3267 defsubr (&Sfile_name_nondirectory
);
3268 defsubr (&Sfile_name_as_directory
);
3269 defsubr (&Sdirectory_file_name
);
3270 defsubr (&Smake_temp_name
);
3271 defsubr (&Sexpand_file_name
);
3272 defsubr (&Ssubstitute_in_file_name
);
3273 defsubr (&Scopy_file
);
3274 defsubr (&Smake_directory_internal
);
3275 defsubr (&Sdelete_directory
);
3276 defsubr (&Sdelete_file
);
3277 defsubr (&Srename_file
);
3278 defsubr (&Sadd_name_to_file
);
3280 defsubr (&Smake_symbolic_link
);
3281 #endif /* S_IFLNK */
3283 defsubr (&Sdefine_logical_name
);
3286 defsubr (&Ssysnetunam
);
3287 #endif /* HPUX_NET */
3288 defsubr (&Sfile_name_absolute_p
);
3289 defsubr (&Sfile_exists_p
);
3290 defsubr (&Sfile_executable_p
);
3291 defsubr (&Sfile_readable_p
);
3292 defsubr (&Sfile_writable_p
);
3293 defsubr (&Sfile_symlink_p
);
3294 defsubr (&Sfile_directory_p
);
3295 defsubr (&Sfile_accessible_directory_p
);
3296 defsubr (&Sfile_modes
);
3297 defsubr (&Sset_file_modes
);
3298 defsubr (&Sset_umask
);
3300 defsubr (&Sfile_newer_than_file_p
);
3301 defsubr (&Sinsert_file_contents
);
3302 defsubr (&Swrite_region
);
3303 defsubr (&Sverify_visited_file_modtime
);
3304 defsubr (&Sclear_visited_file_modtime
);
3305 defsubr (&Sset_visited_file_modtime
);
3306 defsubr (&Sdo_auto_save
);
3307 defsubr (&Sset_buffer_auto_saved
);
3308 defsubr (&Srecent_auto_save_p
);
3310 defsubr (&Sread_file_name_internal
);
3311 defsubr (&Sread_file_name
);
3314 defsubr (&Sunix_sync
);