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 if (p
[0] == '/' && p
[1] == '/'
612 /* // at start of filename is meaningful on Apollo system */
617 if (p
[0] == '/' && p
[1] == '~')
618 nm
= p
+ 1, lose
= 1;
619 if (p
[0] == '/' && p
[1] == '.'
620 && (p
[2] == '/' || p
[2] == 0
621 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
627 /* if dev:[dir]/, move nm to / */
628 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
629 nm
= (brack
? brack
+ 1 : colon
+ 1);
638 /* VMS pre V4.4,convert '-'s in filenames. */
639 if (lbrack
== rbrack
)
641 if (dots
< 2) /* this is to allow negative version numbers */
646 if (lbrack
> rbrack
&&
647 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
648 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
654 /* count open brackets, reset close bracket pointer */
655 if (p
[0] == '[' || p
[0] == '<')
657 /* count close brackets, set close bracket pointer */
658 if (p
[0] == ']' || p
[0] == '>')
660 /* detect ][ or >< */
661 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
663 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
664 nm
= p
+ 1, lose
= 1;
665 if (p
[0] == ':' && (colon
|| slash
))
666 /* if dev1:[dir]dev2:, move nm to dev2: */
672 /* if /pathname/dev:, move nm to dev: */
675 /* if node::dev:, move colon following dev */
676 else if (colon
&& colon
[-1] == ':')
678 /* if dev1:dev2:, move nm to dev2: */
679 else if (colon
&& colon
[-1] != ':')
684 if (p
[0] == ':' && !colon
)
690 if (lbrack
== rbrack
)
693 else if (p
[0] == '.')
702 return build_string (sys_translate_unix (nm
));
704 if (nm
== XSTRING (name
)->data
)
706 return build_string (nm
);
710 /* Now determine directory to start with and put it in newdir */
714 if (nm
[0] == '~') /* prefix ~ */
719 || nm
[1] == 0)/* ~ by itself */
721 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
722 newdir
= (unsigned char *) "";
725 nm
++; /* Don't leave the slash in nm. */
728 else /* ~user/filename */
730 for (p
= nm
; *p
&& (*p
!= '/'
735 o
= (unsigned char *) alloca (p
- nm
+ 1);
736 bcopy ((char *) nm
, o
, p
- nm
);
739 pw
= (struct passwd
*) getpwnam (o
+ 1);
742 newdir
= (unsigned char *) pw
-> pw_dir
;
744 nm
= p
+ 1; /* skip the terminator */
750 /* If we don't find a user of that name, leave the name
751 unchanged; don't move nm forward to p. */
761 defalt
= current_buffer
->directory
;
762 CHECK_STRING (defalt
, 1);
763 newdir
= XSTRING (defalt
)->data
;
768 /* Get rid of any slash at the end of newdir. */
769 int length
= strlen (newdir
);
770 if (newdir
[length
- 1] == '/')
772 unsigned char *temp
= (unsigned char *) alloca (length
);
773 bcopy (newdir
, temp
, length
- 1);
774 temp
[length
- 1] = 0;
782 /* Now concatenate the directory and name to new space in the stack frame */
783 tlen
+= strlen (nm
) + 1;
784 target
= (unsigned char *) alloca (tlen
);
790 if (nm
[0] == 0 || nm
[0] == '/')
791 strcpy (target
, newdir
);
794 file_name_as_directory (target
, newdir
);
799 if (index (target
, '/'))
800 strcpy (target
, sys_translate_unix (target
));
803 /* Now canonicalize by removing /. and /foo/.. if they appear */
811 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
817 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
818 /* brackets are offset from each other by 2 */
821 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
822 /* convert [foo][bar] to [bar] */
823 while (o
[-1] != '[' && o
[-1] != '<')
825 else if (*p
== '-' && *o
!= '.')
828 else if (p
[0] == '-' && o
[-1] == '.' &&
829 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
830 /* flush .foo.- ; leave - if stopped by '[' or '<' */
834 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
835 if (p
[1] == '.') /* foo.-.bar ==> bar*/
837 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
839 /* else [foo.-] ==> [-] */
845 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
846 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
856 else if (!strncmp (p
, "//", 2)
858 /* // at start of filename is meaningful in Apollo system */
866 else if (p
[0] == '/' && p
[1] == '.' &&
867 (p
[2] == '/' || p
[2] == 0))
869 else if (!strncmp (p
, "/..", 3)
870 /* `/../' is the "superroot" on certain file systems. */
872 && (p
[3] == '/' || p
[3] == 0))
874 while (o
!= target
&& *--o
!= '/')
877 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
881 if (o
== target
&& *o
== '/')
892 return make_string (target
, o
- target
);
895 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
896 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
897 "Convert FILENAME to absolute, and canonicalize it.\n\
898 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
899 (does not start with slash); if DEFAULT is nil or missing,\n\
900 the current buffer's value of default-directory is used.\n\
901 Filenames containing `.' or `..' as components are simplified;\n\
902 initial `~/' expands to your home directory.\n\
903 See also the function `substitute-in-file-name'.")
905 Lisp_Object name, defalt;
909 register unsigned char *newdir, *p, *o;
911 unsigned char *target;
915 unsigned char * colon = 0;
916 unsigned char * close = 0;
917 unsigned char * slash = 0;
918 unsigned char * brack = 0;
919 int lbrack = 0, rbrack = 0;
923 CHECK_STRING (name
, 0);
926 /* Filenames on VMS are always upper case. */
927 name
= Fupcase (name
);
930 nm
= XSTRING (name
)->data
;
932 /* If nm is absolute, flush ...// and detect /./ and /../.
933 If no /./ or /../ we can return right away. */
945 if (p
[0] == '/' && p
[1] == '/'
947 /* // at start of filename is meaningful on Apollo system */
952 if (p
[0] == '/' && p
[1] == '~')
953 nm
= p
+ 1, lose
= 1;
954 if (p
[0] == '/' && p
[1] == '.'
955 && (p
[2] == '/' || p
[2] == 0
956 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
962 /* if dev:[dir]/, move nm to / */
963 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
964 nm
= (brack
? brack
+ 1 : colon
+ 1);
973 /* VMS pre V4.4,convert '-'s in filenames. */
974 if (lbrack
== rbrack
)
976 if (dots
< 2) /* this is to allow negative version numbers */
981 if (lbrack
> rbrack
&&
982 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
983 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
989 /* count open brackets, reset close bracket pointer */
990 if (p
[0] == '[' || p
[0] == '<')
992 /* count close brackets, set close bracket pointer */
993 if (p
[0] == ']' || p
[0] == '>')
995 /* detect ][ or >< */
996 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
998 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
999 nm
= p
+ 1, lose
= 1;
1000 if (p
[0] == ':' && (colon
|| slash
))
1001 /* if dev1:[dir]dev2:, move nm to dev2: */
1007 /* if /pathname/dev:, move nm to dev: */
1010 /* if node::dev:, move colon following dev */
1011 else if (colon
&& colon
[-1] == ':')
1013 /* if dev1:dev2:, move nm to dev2: */
1014 else if (colon
&& colon
[-1] != ':')
1019 if (p
[0] == ':' && !colon
)
1025 if (lbrack
== rbrack
)
1028 else if (p
[0] == '.')
1036 if (index (nm
, '/'))
1037 return build_string (sys_translate_unix (nm
));
1039 if (nm
== XSTRING (name
)->data
)
1041 return build_string (nm
);
1045 /* Now determine directory to start with and put it in NEWDIR */
1049 if (nm
[0] == '~') /* prefix ~ */
1054 || nm
[1] == 0)/* ~/filename */
1056 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1057 newdir
= (unsigned char *) "";
1060 nm
++; /* Don't leave the slash in nm. */
1063 else /* ~user/filename */
1065 /* Get past ~ to user */
1066 unsigned char *user
= nm
+ 1;
1067 /* Find end of name. */
1068 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1069 int len
= ptr
? ptr
- user
: strlen (user
);
1071 unsigned char *ptr1
= index (user
, ':');
1072 if (ptr1
!= 0 && ptr1
- user
< len
)
1075 /* Copy the user name into temp storage. */
1076 o
= (unsigned char *) alloca (len
+ 1);
1077 bcopy ((char *) user
, o
, len
);
1080 /* Look up the user name. */
1081 pw
= (struct passwd
*) getpwnam (o
+ 1);
1083 error ("\"%s\" isn't a registered user", o
+ 1);
1085 newdir
= (unsigned char *) pw
->pw_dir
;
1087 /* Discard the user name from NM. */
1094 #endif /* not VMS */
1098 defalt
= current_buffer
->directory
;
1099 CHECK_STRING (defalt
, 1);
1100 newdir
= XSTRING (defalt
)->data
;
1103 /* Now concatenate the directory and name to new space in the stack frame */
1105 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1106 target
= (unsigned char *) alloca (tlen
);
1112 if (nm
[0] == 0 || nm
[0] == '/')
1113 strcpy (target
, newdir
);
1116 file_name_as_directory (target
, newdir
);
1119 strcat (target
, nm
);
1121 if (index (target
, '/'))
1122 strcpy (target
, sys_translate_unix (target
));
1125 /* Now canonicalize by removing /. and /foo/.. if they appear */
1133 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1139 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1140 /* brackets are offset from each other by 2 */
1143 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1144 /* convert [foo][bar] to [bar] */
1145 while (o
[-1] != '[' && o
[-1] != '<')
1147 else if (*p
== '-' && *o
!= '.')
1150 else if (p
[0] == '-' && o
[-1] == '.' &&
1151 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1152 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1156 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1157 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1159 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1161 /* else [foo.-] ==> [-] */
1167 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1168 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1178 else if (!strncmp (p
, "//", 2)
1180 /* // at start of filename is meaningful in Apollo system */
1188 else if (p
[0] == '/' && p
[1] == '.' &&
1189 (p
[2] == '/' || p
[2] == 0))
1191 else if (!strncmp (p
, "/..", 3)
1192 /* `/../' is the "superroot" on certain file systems. */
1194 && (p
[3] == '/' || p
[3] == 0))
1196 while (o
!= target
&& *--o
!= '/')
1199 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1203 if (o
== target
&& *o
== '/')
1211 #endif /* not VMS */
1214 return make_string (target
, o
- target
);
1218 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1219 Ssubstitute_in_file_name
, 1, 1, 0,
1220 "Substitute environment variables referred to in FILENAME.\n\
1221 `$FOO' where FOO is an environment variable name means to substitute\n\
1222 the value of that variable. The variable name should be terminated\n\
1223 with a character not a letter, digit or underscore; otherwise, enclose\n\
1224 the entire variable name in braces.\n\
1225 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1226 On VMS, `$' substitution is not done; this function does little and only\n\
1227 duplicates what `expand-file-name' does.")
1233 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1234 unsigned char *target
;
1236 int substituted
= 0;
1239 CHECK_STRING (string
, 0);
1241 nm
= XSTRING (string
)->data
;
1242 endp
= nm
+ XSTRING (string
)->size
;
1244 /* If /~ or // appears, discard everything through first slash. */
1246 for (p
= nm
; p
!= endp
; p
++)
1250 /* // at start of file name is meaningful in Apollo system */
1251 (p
[0] == '/' && p
- 1 != nm
)
1252 #else /* not APOLLO */
1254 #endif /* not APOLLO */
1258 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1271 return build_string (nm
);
1274 /* See if any variables are substituted into the string
1275 and find the total length of their values in `total' */
1277 for (p
= nm
; p
!= endp
;)
1287 /* "$$" means a single "$" */
1296 while (p
!= endp
&& *p
!= '}') p
++;
1297 if (*p
!= '}') goto missingclose
;
1303 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1307 /* Copy out the variable name */
1308 target
= (unsigned char *) alloca (s
- o
+ 1);
1309 strncpy (target
, o
, s
- o
);
1312 /* Get variable value */
1313 o
= (unsigned char *) egetenv (target
);
1314 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1317 if (!o
&& !strcmp (target
, "USER"))
1318 o
= egetenv ("LOGNAME");
1321 if (!o
) goto badvar
;
1322 total
+= strlen (o
);
1329 /* If substitution required, recopy the string and do it */
1330 /* Make space in stack frame for the new copy */
1331 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1334 /* Copy the rest of the name through, replacing $ constructs with values */
1351 while (p
!= endp
&& *p
!= '}') p
++;
1352 if (*p
!= '}') goto missingclose
;
1358 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1362 /* Copy out the variable name */
1363 target
= (unsigned char *) alloca (s
- o
+ 1);
1364 strncpy (target
, o
, s
- o
);
1367 /* Get variable value */
1368 o
= (unsigned char *) egetenv (target
);
1369 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1372 if (!o
&& !strcmp (target
, "USER"))
1373 o
= egetenv ("LOGNAME");
1385 /* If /~ or // appears, discard everything through first slash. */
1387 for (p
= xnm
; p
!= x
; p
++)
1390 /* // at start of file name is meaningful in Apollo system */
1391 (p
[0] == '/' && p
- 1 != xnm
)
1392 #else /* not APOLLO */
1394 #endif /* not APOLLO */
1396 && p
!= nm
&& p
[-1] == '/')
1399 return make_string (xnm
, x
- xnm
);
1402 error ("Bad format environment-variable substitution");
1404 error ("Missing \"}\" in environment-variable substitution");
1406 error ("Substituting nonexistent environment variable \"%s\"", target
);
1409 #endif /* not VMS */
1412 /* A slightly faster and more convenient way to get
1413 (directory-file-name (expand-file-name FOO)). The return value may
1414 have had its last character zapped with a '\0' character, meaning
1415 that it is acceptable to system calls, but not to other lisp
1416 functions. Callers should make sure that the return value doesn't
1420 expand_and_dir_to_file (filename
, defdir
)
1421 Lisp_Object filename
, defdir
;
1423 register Lisp_Object abspath
;
1425 abspath
= Fexpand_file_name (filename
, defdir
);
1428 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1429 if (c
== ':' || c
== ']' || c
== '>')
1430 abspath
= Fdirectory_file_name (abspath
);
1433 /* Remove final slash, if any (unless path is root).
1434 stat behaves differently depending! */
1435 if (XSTRING (abspath
)->size
> 1
1436 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1438 if (EQ (abspath
, filename
))
1439 abspath
= Fcopy_sequence (abspath
);
1440 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1446 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1447 Lisp_Object absname
;
1448 unsigned char *querystring
;
1451 register Lisp_Object tem
;
1452 struct gcpro gcpro1
;
1454 if (access (XSTRING (absname
)->data
, 4) >= 0)
1457 Fsignal (Qfile_already_exists
,
1458 Fcons (build_string ("File already exists"),
1459 Fcons (absname
, Qnil
)));
1461 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1462 XSTRING (absname
)->data
, querystring
));
1465 Fsignal (Qfile_already_exists
,
1466 Fcons (build_string ("File already exists"),
1467 Fcons (absname
, Qnil
)));
1472 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1473 "fCopy file: \nFCopy %s to file: \np\nP",
1474 "Copy FILE to NEWNAME. Both args must be strings.\n\
1475 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1476 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1477 A number as third arg means request confirmation if NEWNAME already exists.\n\
1478 This is what happens in interactive use with M-x.\n\
1479 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1480 last-modified time as the old one. (This works on only some systems.)\n\
1481 A prefix arg makes KEEP-TIME non-nil.")
1482 (filename
, newname
, ok_if_already_exists
, keep_date
)
1483 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1486 char buf
[16 * 1024];
1488 Lisp_Object handler
;
1489 struct gcpro gcpro1
, gcpro2
;
1490 int count
= specpdl_ptr
- specpdl
;
1492 GCPRO2 (filename
, newname
);
1493 CHECK_STRING (filename
, 0);
1494 CHECK_STRING (newname
, 1);
1495 filename
= Fexpand_file_name (filename
, Qnil
);
1496 newname
= Fexpand_file_name (newname
, Qnil
);
1498 /* If the input file name has special constructs in it,
1499 call the corresponding file handler. */
1500 handler
= find_file_handler (filename
);
1501 if (!NILP (handler
))
1502 return call3 (handler
, Qcopy_file
, filename
, newname
);
1503 /* Likewise for output file name. */
1504 handler
= find_file_handler (newname
);
1505 if (!NILP (handler
))
1506 return call3 (handler
, Qcopy_file
, filename
, newname
);
1508 if (NILP (ok_if_already_exists
)
1509 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1510 barf_or_query_if_file_exists (newname
, "copy to it",
1511 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1513 ifd
= open (XSTRING (filename
)->data
, 0);
1515 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1517 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1520 /* Create the copy file with the same record format as the input file */
1521 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1523 ofd
= creat (XSTRING (newname
)->data
, 0666);
1526 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1528 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1532 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1533 if (write (ofd
, buf
, n
) != n
)
1534 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1537 if (fstat (ifd
, &st
) >= 0)
1539 if (!NILP (keep_date
))
1541 EMACS_TIME atime
, mtime
;
1542 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1543 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1544 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1547 if (!egetenv ("USE_DOMAIN_ACLS"))
1549 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1552 /* Discard the unwind protects. */
1553 specpdl_ptr
= specpdl
+ count
;
1556 if (close (ofd
) < 0)
1557 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1563 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1564 "Create a directory. One argument, a file name string.")
1566 Lisp_Object dirname
;
1569 Lisp_Object handler
;
1571 CHECK_STRING (dirname
, 0);
1572 dirname
= Fexpand_file_name (dirname
, Qnil
);
1574 handler
= find_file_handler (dirname
);
1575 if (!NILP (handler
))
1576 return call2 (handler
, Qmake_directory
, dirname
);
1578 dir
= XSTRING (dirname
)->data
;
1580 if (mkdir (dir
, 0777) != 0)
1581 report_file_error ("Creating directory", Flist (1, &dirname
));
1586 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1587 "Delete 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
);
1596 dir
= XSTRING (dirname
)->data
;
1598 handler
= find_file_handler (dirname
);
1599 if (!NILP (handler
))
1600 return call2 (handler
, Qdelete_directory
, dirname
);
1602 if (rmdir (dir
) != 0)
1603 report_file_error ("Removing directory", Flist (1, &dirname
));
1608 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1609 "Delete specified file. One argument, a file name string.\n\
1610 If file has multiple names, it continues to exist with the other names.")
1612 Lisp_Object filename
;
1614 Lisp_Object handler
;
1615 CHECK_STRING (filename
, 0);
1616 filename
= Fexpand_file_name (filename
, Qnil
);
1618 handler
= find_file_handler (filename
);
1619 if (!NILP (handler
))
1620 return call2 (handler
, Qdelete_file
, filename
);
1622 if (0 > unlink (XSTRING (filename
)->data
))
1623 report_file_error ("Removing old name", Flist (1, &filename
));
1627 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1628 "fRename file: \nFRename %s to file: \np",
1629 "Rename FILE as NEWNAME. Both args strings.\n\
1630 If file has names other than FILE, it continues to have those names.\n\
1631 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1632 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1633 A number as third arg means request confirmation if NEWNAME already exists.\n\
1634 This is what happens in interactive use with M-x.")
1635 (filename
, newname
, ok_if_already_exists
)
1636 Lisp_Object filename
, newname
, ok_if_already_exists
;
1639 Lisp_Object args
[2];
1641 Lisp_Object handler
;
1642 struct gcpro gcpro1
, gcpro2
;
1644 GCPRO2 (filename
, newname
);
1645 CHECK_STRING (filename
, 0);
1646 CHECK_STRING (newname
, 1);
1647 filename
= Fexpand_file_name (filename
, Qnil
);
1648 newname
= Fexpand_file_name (newname
, Qnil
);
1650 /* If the file name has special constructs in it,
1651 call the corresponding file handler. */
1652 handler
= find_file_handler (filename
);
1653 if (!NILP (handler
))
1654 return call3 (handler
, Qrename_file
, filename
, newname
);
1656 if (NILP (ok_if_already_exists
)
1657 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1658 barf_or_query_if_file_exists (newname
, "rename to it",
1659 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1661 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1663 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1664 || 0 > unlink (XSTRING (filename
)->data
))
1669 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1670 Fdelete_file (filename
);
1677 report_file_error ("Renaming", Flist (2, args
));
1680 report_file_error ("Renaming", Flist (2, &filename
));
1687 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1688 "fAdd name to file: \nFName to add to %s: \np",
1689 "Give FILE additional name NEWNAME. Both args strings.\n\
1690 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1691 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1692 A number as third arg means request confirmation if NEWNAME already exists.\n\
1693 This is what happens in interactive use with M-x.")
1694 (filename
, newname
, ok_if_already_exists
)
1695 Lisp_Object filename
, newname
, ok_if_already_exists
;
1698 Lisp_Object args
[2];
1700 Lisp_Object handler
;
1701 struct gcpro gcpro1
, gcpro2
;
1703 GCPRO2 (filename
, newname
);
1704 CHECK_STRING (filename
, 0);
1705 CHECK_STRING (newname
, 1);
1706 filename
= Fexpand_file_name (filename
, Qnil
);
1707 newname
= Fexpand_file_name (newname
, Qnil
);
1709 /* If the file name has special constructs in it,
1710 call the corresponding file handler. */
1711 handler
= find_file_handler (filename
);
1712 if (!NILP (handler
))
1713 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1715 if (NILP (ok_if_already_exists
)
1716 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1717 barf_or_query_if_file_exists (newname
, "make it a new name",
1718 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1719 unlink (XSTRING (newname
)->data
);
1720 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1725 report_file_error ("Adding new name", Flist (2, args
));
1727 report_file_error ("Adding new name", Flist (2, &filename
));
1736 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1737 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1738 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1739 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1740 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1741 A number as third arg means request confirmation if NEWNAME already exists.\n\
1742 This happens for interactive use with M-x.")
1743 (filename
, linkname
, ok_if_already_exists
)
1744 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1747 Lisp_Object args
[2];
1749 Lisp_Object handler
;
1750 struct gcpro gcpro1
, gcpro2
;
1752 GCPRO2 (filename
, linkname
);
1753 CHECK_STRING (filename
, 0);
1754 CHECK_STRING (linkname
, 1);
1755 #if 0 /* This made it impossible to make a link to a relative name. */
1756 filename
= Fexpand_file_name (filename
, Qnil
);
1758 linkname
= Fexpand_file_name (linkname
, Qnil
);
1760 /* If the file name has special constructs in it,
1761 call the corresponding file handler. */
1762 handler
= find_file_handler (filename
);
1763 if (!NILP (handler
))
1764 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1766 if (NILP (ok_if_already_exists
)
1767 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1768 barf_or_query_if_file_exists (linkname
, "make it a link",
1769 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1770 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1772 /* If we didn't complain already, silently delete existing file. */
1773 if (errno
== EEXIST
)
1775 unlink (XSTRING (filename
)->data
);
1776 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1783 report_file_error ("Making symbolic link", Flist (2, args
));
1785 report_file_error ("Making symbolic link", Flist (2, &filename
));
1791 #endif /* S_IFLNK */
1795 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1796 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1797 "Define the job-wide logical name NAME to have the value STRING.\n\
1798 If STRING is nil or a null string, the logical name NAME is deleted.")
1800 Lisp_Object varname
;
1803 CHECK_STRING (varname
, 0);
1805 delete_logical_name (XSTRING (varname
)->data
);
1808 CHECK_STRING (string
, 1);
1810 if (XSTRING (string
)->size
== 0)
1811 delete_logical_name (XSTRING (varname
)->data
);
1813 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1822 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1823 "Open a network connection to PATH using LOGIN as the login string.")
1825 Lisp_Object path
, login
;
1829 CHECK_STRING (path
, 0);
1830 CHECK_STRING (login
, 0);
1832 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1834 if (netresult
== -1)
1839 #endif /* HPUX_NET */
1841 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1843 "Return t if file FILENAME specifies an absolute path name.\n\
1844 On Unix, this is a name starting with a `/' or a `~'.")
1846 Lisp_Object filename
;
1850 CHECK_STRING (filename
, 0);
1851 ptr
= XSTRING (filename
)->data
;
1852 if (*ptr
== '/' || *ptr
== '~'
1854 /* ??? This criterion is probably wrong for '<'. */
1855 || index (ptr
, ':') || index (ptr
, '<')
1856 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1865 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1866 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1867 See also `file-readable-p' and `file-attributes'.")
1869 Lisp_Object filename
;
1871 Lisp_Object abspath
;
1872 Lisp_Object handler
;
1874 CHECK_STRING (filename
, 0);
1875 abspath
= Fexpand_file_name (filename
, Qnil
);
1877 /* If the file name has special constructs in it,
1878 call the corresponding file handler. */
1879 handler
= find_file_handler (abspath
);
1880 if (!NILP (handler
))
1881 return call2 (handler
, Qfile_exists_p
, abspath
);
1883 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1886 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1887 "Return t if FILENAME can be executed by you.\n\
1888 For directories this means you can change to that directory.")
1890 Lisp_Object filename
;
1893 Lisp_Object abspath
;
1894 Lisp_Object handler
;
1896 CHECK_STRING (filename
, 0);
1897 abspath
= Fexpand_file_name (filename
, Qnil
);
1899 /* If the file name has special constructs in it,
1900 call the corresponding file handler. */
1901 handler
= find_file_handler (abspath
);
1902 if (!NILP (handler
))
1903 return call2 (handler
, Qfile_executable_p
, abspath
);
1905 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1908 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1909 "Return t if file FILENAME exists and you can read it.\n\
1910 See also `file-exists-p' and `file-attributes'.")
1912 Lisp_Object filename
;
1914 Lisp_Object abspath
;
1915 Lisp_Object handler
;
1917 CHECK_STRING (filename
, 0);
1918 abspath
= Fexpand_file_name (filename
, Qnil
);
1920 /* If the file name has special constructs in it,
1921 call the corresponding file handler. */
1922 handler
= find_file_handler (abspath
);
1923 if (!NILP (handler
))
1924 return call2 (handler
, Qfile_readable_p
, abspath
);
1926 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1929 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1930 "If file FILENAME is the name of a symbolic link\n\
1931 returns the name of the file to which it is linked.\n\
1932 Otherwise returns NIL.")
1934 Lisp_Object filename
;
1941 Lisp_Object handler
;
1943 CHECK_STRING (filename
, 0);
1944 filename
= Fexpand_file_name (filename
, Qnil
);
1946 /* If the file name has special constructs in it,
1947 call the corresponding file handler. */
1948 handler
= find_file_handler (filename
);
1949 if (!NILP (handler
))
1950 return call2 (handler
, Qfile_symlink_p
, filename
);
1955 buf
= (char *) xmalloc (bufsize
);
1956 bzero (buf
, bufsize
);
1957 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1958 if (valsize
< bufsize
) break;
1959 /* Buffer was not long enough */
1968 val
= make_string (buf
, valsize
);
1971 #else /* not S_IFLNK */
1973 #endif /* not S_IFLNK */
1976 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1978 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1979 "Return t if file FILENAME can be written or created by you.")
1981 Lisp_Object filename
;
1983 Lisp_Object abspath
, dir
;
1984 Lisp_Object handler
;
1986 CHECK_STRING (filename
, 0);
1987 abspath
= Fexpand_file_name (filename
, Qnil
);
1989 /* If the file name has special constructs in it,
1990 call the corresponding file handler. */
1991 handler
= find_file_handler (abspath
);
1992 if (!NILP (handler
))
1993 return call2 (handler
, Qfile_writable_p
, abspath
);
1995 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1996 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1997 dir
= Ffile_name_directory (abspath
);
2000 dir
= Fdirectory_file_name (dir
);
2002 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2006 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2007 "Return t if file FILENAME is the name of a directory as a file.\n\
2008 A directory name spec may be given instead; then the value is t\n\
2009 if the directory so specified exists and really is a directory.")
2011 Lisp_Object filename
;
2013 register Lisp_Object abspath
;
2015 Lisp_Object handler
;
2017 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2019 /* If the file name has special constructs in it,
2020 call the corresponding file handler. */
2021 handler
= find_file_handler (abspath
);
2022 if (!NILP (handler
))
2023 return call2 (handler
, Qfile_directory_p
, abspath
);
2025 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2027 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2030 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2031 "Return t if file FILENAME is the name of a directory as a file,\n\
2032 and files in that directory can be opened by you. In order to use a\n\
2033 directory as a buffer's current directory, this predicate must return true.\n\
2034 A directory name spec may be given instead; then the value is t\n\
2035 if the directory so specified exists and really is a readable and\n\
2036 searchable directory.")
2038 Lisp_Object filename
;
2040 Lisp_Object handler
;
2042 /* If the file name has special constructs in it,
2043 call the corresponding file handler. */
2044 handler
= find_file_handler (filename
);
2045 if (!NILP (handler
))
2046 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2048 if (NILP (Ffile_directory_p (filename
))
2049 || NILP (Ffile_executable_p (filename
)))
2055 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2056 "Return mode bits of FILE, as an integer.")
2058 Lisp_Object filename
;
2060 Lisp_Object abspath
;
2062 Lisp_Object handler
;
2064 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2066 /* If the file name has special constructs in it,
2067 call the corresponding file handler. */
2068 handler
= find_file_handler (abspath
);
2069 if (!NILP (handler
))
2070 return call2 (handler
, Qfile_modes
, abspath
);
2072 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2074 return make_number (st
.st_mode
& 07777);
2077 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2078 "Set mode bits of FILE to MODE (an integer).\n\
2079 Only the 12 low bits of MODE are used.")
2081 Lisp_Object filename
, mode
;
2083 Lisp_Object abspath
;
2084 Lisp_Object handler
;
2086 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2087 CHECK_NUMBER (mode
, 1);
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 call3 (handler
, Qset_file_modes
, abspath
, mode
);
2096 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2097 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2099 if (!egetenv ("USE_DOMAIN_ACLS"))
2102 struct timeval tvp
[2];
2104 /* chmod on apollo also change the file's modtime; need to save the
2105 modtime and then restore it. */
2106 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2108 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2112 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2113 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2115 /* reset the old accessed and modified times. */
2116 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2118 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2121 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2122 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2129 DEFUN ("set-umask", Fset_umask
, Sset_umask
, 1, 1, 0,
2130 "Select which permission bits to disable in newly created files.\n\
2131 MASK should be an integer; if a permission's bit in MASK is 1,\n\
2132 subsequently created files will not have that permission enabled.\n\
2133 Only the low 9 bits are used.\n\
2134 This setting is inherited by subprocesses.")
2138 CHECK_NUMBER (mask
, 0);
2140 umask (XINT (mask
) & 0777);
2145 DEFUN ("umask", Fumask
, Sumask
, 0, 0, 0,
2146 "Return the current umask value.\n\
2147 The umask value determines which permissions are enabled in newly\n\
2148 created files. If a permission's bit in the umask is 1, subsequently\n\
2149 created files will not have that permission enabled.")
2154 XSET (mask
, Lisp_Int
, umask (0));
2155 umask (XINT (mask
));
2162 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2163 "Tell Unix to finish all pending disk updates.")
2172 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2173 "Return t if file FILE1 is newer than file FILE2.\n\
2174 If FILE1 does not exist, the answer is nil;\n\
2175 otherwise, if FILE2 does not exist, the answer is t.")
2177 Lisp_Object file1
, file2
;
2179 Lisp_Object abspath1
, abspath2
;
2182 Lisp_Object handler
;
2183 struct gcpro gcpro1
, gcpro2
;
2185 CHECK_STRING (file1
, 0);
2186 CHECK_STRING (file2
, 0);
2189 GCPRO2 (abspath1
, file2
);
2190 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2191 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2194 /* If the file name has special constructs in it,
2195 call the corresponding file handler. */
2196 handler
= find_file_handler (abspath1
);
2197 if (!NILP (handler
))
2198 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2200 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2203 mtime1
= st
.st_mtime
;
2205 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2208 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2211 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2213 "Insert contents of file FILENAME after point.\n\
2214 Returns list of absolute pathname and length of data inserted.\n\
2215 If second argument VISIT is non-nil, the buffer's visited filename\n\
2216 and last save file modtime are set, and it is marked unmodified.\n\
2217 If visiting and the file does not exist, visiting is completed\n\
2218 before the error is signaled.")
2220 Lisp_Object filename
, visit
;
2224 register int inserted
= 0;
2225 register int how_much
;
2226 int count
= specpdl_ptr
- specpdl
;
2227 struct gcpro gcpro1
;
2228 Lisp_Object handler
, val
;
2233 if (!NILP (current_buffer
->read_only
))
2234 Fbarf_if_buffer_read_only();
2236 CHECK_STRING (filename
, 0);
2237 filename
= Fexpand_file_name (filename
, Qnil
);
2239 /* If the file name has special constructs in it,
2240 call the corresponding file handler. */
2241 handler
= find_file_handler (filename
);
2242 if (!NILP (handler
))
2244 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2252 if (stat (XSTRING (filename
)->data
, &st
) < 0
2253 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2255 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2256 || fstat (fd
, &st
) < 0)
2257 #endif /* not APOLLO */
2259 if (fd
>= 0) close (fd
);
2261 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2267 record_unwind_protect (close_file_unwind
, make_number (fd
));
2270 /* This code will need to be changed in order to work on named
2271 pipes, and it's probably just not worth it. So we should at
2272 least signal an error. */
2273 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2274 Fsignal (Qfile_error
,
2275 Fcons (build_string ("reading from named pipe"),
2276 Fcons (filename
, Qnil
)));
2279 /* Supposedly happens on VMS. */
2281 error ("File size is negative");
2284 register Lisp_Object temp
;
2286 /* Make sure point-max won't overflow after this insertion. */
2287 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2288 if (st
.st_size
+ Z
!= XINT (temp
))
2289 error ("maximum buffer size exceeded");
2293 prepare_to_modify_buffer (point
, point
);
2296 if (GAP_SIZE
< st
.st_size
)
2297 make_gap (st
.st_size
- GAP_SIZE
);
2301 int try = min (st
.st_size
- inserted
, 64 << 10);
2304 /* Allow quitting out of the actual I/O. */
2307 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2325 record_insert (point
, inserted
);
2327 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2328 offset_intervals (current_buffer
, point
, inserted
);
2334 /* Discard the unwind protect */
2335 specpdl_ptr
= specpdl
+ count
;
2338 error ("IO error reading %s: %s",
2339 XSTRING (filename
)->data
, err_str (errno
));
2346 current_buffer
->undo_list
= Qnil
;
2348 stat (XSTRING (filename
)->data
, &st
);
2350 current_buffer
->modtime
= st
.st_mtime
;
2351 current_buffer
->save_modified
= MODIFF
;
2352 current_buffer
->auto_save_modified
= MODIFF
;
2353 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2354 #ifdef CLASH_DETECTION
2357 if (!NILP (current_buffer
->filename
))
2358 unlock_file (current_buffer
->filename
);
2359 unlock_file (filename
);
2361 #endif /* CLASH_DETECTION */
2362 current_buffer
->filename
= filename
;
2363 /* If visiting nonexistent file, return nil. */
2364 if (current_buffer
->modtime
== -1)
2365 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2368 signal_after_change (point
, 0, inserted
);
2371 RETURN_UNGCPRO (val
);
2372 RETURN_UNGCPRO (Fcons (filename
,
2373 Fcons (make_number (inserted
),
2377 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2378 "r\nFWrite region to file: ",
2379 "Write current region into specified file.\n\
2380 When called from a program, takes three arguments:\n\
2381 START, END and FILENAME. START and END are buffer positions.\n\
2382 Optional fourth argument APPEND if non-nil means\n\
2383 append to existing file contents (if any).\n\
2384 Optional fifth argument VISIT if t means\n\
2385 set the last-save-file-modtime of buffer to this file's modtime\n\
2386 and mark buffer not modified.\n\
2387 If VISIT is neither t nor nil, it means do not print\n\
2388 the \"Wrote file\" message.\n\
2389 If VISIT is a string, it is a second file name;\n\
2390 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2391 VISIT is also the file name to lock and unlock for clash detection.\n\
2392 Kludgy feature: if START is a string, then that string is written\n\
2393 to the file, instead of any buffer contents, and END is ignored.")
2394 (start
, end
, filename
, append
, visit
)
2395 Lisp_Object start
, end
, filename
, append
, visit
;
2403 int count
= specpdl_ptr
- specpdl
;
2405 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2407 Lisp_Object handler
;
2408 Lisp_Object visit_file
= XTYPE (visit
) == Lisp_String
? visit
: filename
;
2409 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2411 /* Special kludge to simplify auto-saving */
2414 XFASTINT (start
) = BEG
;
2417 else if (XTYPE (start
) != Lisp_String
)
2418 validate_region (&start
, &end
);
2420 GCPRO4 (start
, filename
, visit
, visit_file
);
2421 filename
= Fexpand_file_name (filename
, Qnil
);
2423 /* If the file name has special constructs in it,
2424 call the corresponding file handler. */
2425 handler
= find_file_handler (filename
);
2427 if (!NILP (handler
))
2429 Lisp_Object args
[7];
2432 args
[1] = Qwrite_region
;
2438 val
= Ffuncall (7, args
);
2440 /* Do this before reporting IO error
2441 to avoid a "file has changed on disk" warning on
2442 next attempt to save. */
2443 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2445 current_buffer
->modtime
= 0;
2446 current_buffer
->save_modified
= MODIFF
;
2447 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2448 current_buffer
->filename
= visit_file
;
2454 #ifdef CLASH_DETECTION
2456 lock_file (visit_file
);
2457 #endif /* CLASH_DETECTION */
2459 fn
= XSTRING (filename
)->data
;
2462 desc
= open (fn
, O_WRONLY
);
2466 if (auto_saving
) /* Overwrite any previous version of autosave file */
2468 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2469 desc
= open (fn
, O_RDWR
);
2471 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2472 ? XSTRING (current_buffer
->filename
)->data
: 0,
2475 else /* Write to temporary name and rename if no errors */
2477 Lisp_Object temp_name
;
2478 temp_name
= Ffile_name_directory (filename
);
2480 if (!NILP (temp_name
))
2482 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2483 build_string ("$$SAVE$$")));
2484 fname
= XSTRING (filename
)->data
;
2485 fn
= XSTRING (temp_name
)->data
;
2486 desc
= creat_copy_attrs (fname
, fn
);
2489 /* If we can't open the temporary file, try creating a new
2490 version of the original file. VMS "creat" creates a
2491 new version rather than truncating an existing file. */
2494 desc
= creat (fn
, 0666);
2495 #if 0 /* This can clobber an existing file and fail to replace it,
2496 if the user runs out of space. */
2499 /* We can't make a new version;
2500 try to truncate and rewrite existing version if any. */
2502 desc
= open (fn
, O_RDWR
);
2508 desc
= creat (fn
, 0666);
2511 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2512 #endif /* not VMS */
2518 #ifdef CLASH_DETECTION
2520 if (!auto_saving
) unlock_file (visit_file
);
2522 #endif /* CLASH_DETECTION */
2523 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2526 record_unwind_protect (close_file_unwind
, make_number (desc
));
2529 if (lseek (desc
, 0, 2) < 0)
2531 #ifdef CLASH_DETECTION
2532 if (!auto_saving
) unlock_file (visit_file
);
2533 #endif /* CLASH_DETECTION */
2534 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2539 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2540 * if we do writes that don't end with a carriage return. Furthermore
2541 * it cannot handle writes of more then 16K. The modified
2542 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2543 * this EXCEPT for the last record (iff it doesn't end with a carriage
2544 * return). This implies that if your buffer doesn't end with a carriage
2545 * return, you get one free... tough. However it also means that if
2546 * we make two calls to sys_write (a la the following code) you can
2547 * get one at the gap as well. The easiest way to fix this (honest)
2548 * is to move the gap to the next newline (or the end of the buffer).
2553 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2554 move_gap (find_next_newline (GPT
, 1));
2560 if (XTYPE (start
) == Lisp_String
)
2562 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2563 XSTRING (start
)->size
);
2566 else if (XINT (start
) != XINT (end
))
2568 if (XINT (start
) < GPT
)
2570 register int end1
= XINT (end
);
2572 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2573 min (GPT
, end1
) - tem
);
2577 if (XINT (end
) > GPT
&& !failure
)
2580 tem
= max (tem
, GPT
);
2581 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2591 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2592 Disk full in NFS may be reported here. */
2593 if (fsync (desc
) < 0)
2594 failure
= 1, save_errno
= errno
;
2599 /* Spurious "file has changed on disk" warnings have been
2600 observed on Suns as well.
2601 It seems that `close' can change the modtime, under nfs.
2603 (This has supposedly been fixed in Sunos 4,
2604 but who knows about all the other machines with NFS?) */
2607 /* On VMS and APOLLO, must do the stat after the close
2608 since closing changes the modtime. */
2611 /* Recall that #if defined does not work on VMS. */
2618 /* NFS can report a write failure now. */
2619 if (close (desc
) < 0)
2620 failure
= 1, save_errno
= errno
;
2623 /* If we wrote to a temporary name and had no errors, rename to real name. */
2627 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2635 /* Discard the unwind protect */
2636 specpdl_ptr
= specpdl
+ count
;
2638 #ifdef CLASH_DETECTION
2640 unlock_file (visit_file
);
2641 #endif /* CLASH_DETECTION */
2643 /* Do this before reporting IO error
2644 to avoid a "file has changed on disk" warning on
2645 next attempt to save. */
2646 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2647 current_buffer
->modtime
= st
.st_mtime
;
2650 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2652 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2654 current_buffer
->save_modified
= MODIFF
;
2655 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2656 current_buffer
->filename
= visit_file
;
2658 else if (!NILP (visit
))
2662 message ("Wrote %s", XSTRING (visit_file
)->data
);
2668 e_write (desc
, addr
, len
)
2670 register char *addr
;
2673 char buf
[16 * 1024];
2674 register char *p
, *end
;
2676 if (!EQ (current_buffer
->selective_display
, Qt
))
2677 return write (desc
, addr
, len
) - len
;
2681 end
= p
+ sizeof buf
;
2686 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2695 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2701 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2702 Sverify_visited_file_modtime
, 1, 1, 0,
2703 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2704 This means that the file has not been changed since it was visited or saved.")
2710 Lisp_Object handler
;
2712 CHECK_BUFFER (buf
, 0);
2715 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2716 if (b
->modtime
== 0) return Qt
;
2718 /* If the file name has special constructs in it,
2719 call the corresponding file handler. */
2720 handler
= find_file_handler (b
->filename
);
2721 if (!NILP (handler
))
2722 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2724 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2726 /* If the file doesn't exist now and didn't exist before,
2727 we say that it isn't modified, provided the error is a tame one. */
2728 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2733 if (st
.st_mtime
== b
->modtime
2734 /* If both are positive, accept them if they are off by one second. */
2735 || (st
.st_mtime
> 0 && b
->modtime
> 0
2736 && (st
.st_mtime
== b
->modtime
+ 1
2737 || st
.st_mtime
== b
->modtime
- 1)))
2742 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2743 Sclear_visited_file_modtime
, 0, 0, 0,
2744 "Clear out records of last mod time of visited file.\n\
2745 Next attempt to save will certainly not complain of a discrepancy.")
2748 current_buffer
->modtime
= 0;
2752 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2753 Sset_visited_file_modtime
, 0, 0, 0,
2754 "Update buffer's recorded modification time from the visited file's time.\n\
2755 Useful if the buffer was not read from the file normally\n\
2756 or if the file itself has been changed for some known benign reason.")
2759 register Lisp_Object filename
;
2761 Lisp_Object handler
;
2763 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2765 /* If the file name has special constructs in it,
2766 call the corresponding file handler. */
2767 handler
= find_file_handler (filename
);
2768 if (!NILP (handler
))
2769 current_buffer
->modtime
= 0;
2771 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2772 current_buffer
->modtime
= st
.st_mtime
;
2780 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2783 message ("Autosaving...error for %s", name
);
2784 Fsleep_for (make_number (1), Qnil
);
2785 message ("Autosaving...error!for %s", name
);
2786 Fsleep_for (make_number (1), Qnil
);
2787 message ("Autosaving...error for %s", name
);
2788 Fsleep_for (make_number (1), Qnil
);
2798 /* Get visited file's mode to become the auto save file's mode. */
2799 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2800 /* But make sure we can overwrite it later! */
2801 auto_save_mode_bits
= st
.st_mode
| 0600;
2803 auto_save_mode_bits
= 0666;
2806 Fwrite_region (Qnil
, Qnil
,
2807 current_buffer
->auto_save_file_name
,
2811 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2812 "Auto-save all buffers that need it.\n\
2813 This is all buffers that have auto-saving enabled\n\
2814 and are changed since last auto-saved.\n\
2815 Auto-saving writes the buffer into a file\n\
2816 so that your editing is not lost if the system crashes.\n\
2817 This file is not the file you visited; that changes only when you save.\n\n\
2818 Non-nil first argument means do not print any message if successful.\n\
2819 Non-nil second argument means save only current buffer.")
2823 struct buffer
*old
= current_buffer
, *b
;
2824 Lisp_Object tail
, buf
;
2826 char *omessage
= echo_area_glyphs
;
2827 extern minibuf_level
;
2829 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2830 point to non-strings reached from Vbuffer_alist. */
2836 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2837 eventually call do-auto-save, so don't err here in that case. */
2838 if (!NILP (Vrun_hooks
))
2839 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2841 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2842 tail
= XCONS (tail
)->cdr
)
2844 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2846 /* Check for auto save enabled
2847 and file changed since last auto save
2848 and file changed since last real save. */
2849 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2850 && b
->save_modified
< BUF_MODIFF (b
)
2851 && b
->auto_save_modified
< BUF_MODIFF (b
))
2853 if ((XFASTINT (b
->save_length
) * 10
2854 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2855 /* A short file is likely to change a large fraction;
2856 spare the user annoying messages. */
2857 && XFASTINT (b
->save_length
) > 5000
2858 /* These messages are frequent and annoying for `*mail*'. */
2859 && !EQ (b
->filename
, Qnil
))
2861 /* It has shrunk too much; turn off auto-saving here. */
2862 message ("Buffer %s has shrunk a lot; auto save turned off there",
2863 XSTRING (b
->name
)->data
);
2864 /* User can reenable saving with M-x auto-save. */
2865 b
->auto_save_file_name
= Qnil
;
2866 /* Prevent warning from repeating if user does so. */
2867 XFASTINT (b
->save_length
) = 0;
2868 Fsleep_for (make_number (1), Qnil
);
2871 set_buffer_internal (b
);
2872 if (!auto_saved
&& NILP (nomsg
))
2873 message1 ("Auto-saving...");
2874 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2876 b
->auto_save_modified
= BUF_MODIFF (b
);
2877 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2878 set_buffer_internal (old
);
2882 /* Prevent another auto save till enough input events come in. */
2883 record_auto_save ();
2885 if (auto_saved
&& NILP (nomsg
))
2886 message1 (omessage
? omessage
: "Auto-saving...done");
2892 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2893 Sset_buffer_auto_saved
, 0, 0, 0,
2894 "Mark current buffer as auto-saved with its current text.\n\
2895 No auto-save file will be written until the buffer changes again.")
2898 current_buffer
->auto_save_modified
= MODIFF
;
2899 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2903 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2905 "Return t if buffer has been auto-saved since last read in or saved.")
2908 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2911 /* Reading and completing file names */
2912 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2914 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2916 "Internal subroutine for read-file-name. Do not call this.")
2917 (string
, dir
, action
)
2918 Lisp_Object string
, dir
, action
;
2919 /* action is nil for complete, t for return list of completions,
2920 lambda for verify final value */
2922 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2924 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2931 /* No need to protect ACTION--we only compare it with t and nil. */
2932 GCPRO4 (string
, realdir
, name
, specdir
);
2934 if (XSTRING (string
)->size
== 0)
2936 if (EQ (action
, Qlambda
))
2944 orig_string
= string
;
2945 string
= Fsubstitute_in_file_name (string
);
2946 changed
= NILP (Fstring_equal (string
, orig_string
));
2947 name
= Ffile_name_nondirectory (string
);
2948 val
= Ffile_name_directory (string
);
2950 realdir
= Fexpand_file_name (val
, realdir
);
2955 specdir
= Ffile_name_directory (string
);
2956 val
= Ffile_name_completion (name
, realdir
);
2958 if (XTYPE (val
) != Lisp_String
)
2965 if (!NILP (specdir
))
2966 val
= concat2 (specdir
, val
);
2969 register unsigned char *old
, *new;
2973 osize
= XSTRING (val
)->size
;
2974 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2975 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2976 if (*old
++ == '$') count
++;
2979 old
= XSTRING (val
)->data
;
2980 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2981 new = XSTRING (val
)->data
;
2982 for (n
= osize
; n
> 0; n
--)
2993 #endif /* Not VMS */
2998 if (EQ (action
, Qt
))
2999 return Ffile_name_all_completions (name
, realdir
);
3000 /* Only other case actually used is ACTION = lambda */
3002 /* Supposedly this helps commands such as `cd' that read directory names,
3003 but can someone explain how it helps them? -- RMS */
3004 if (XSTRING (name
)->size
== 0)
3007 return Ffile_exists_p (string
);
3010 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3011 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3012 Value is not expanded---you must call `expand-file-name' yourself.\n\
3013 Default name to DEFAULT if user enters a null string.\n\
3014 (If DEFAULT is omitted, the visited file name is used.)\n\
3015 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3016 Non-nil and non-t means also require confirmation after completion.\n\
3017 Fifth arg INITIAL specifies text to start with.\n\
3018 DIR defaults to current buffer's directory default.")
3019 (prompt
, dir
, defalt
, mustmatch
, initial
)
3020 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3022 Lisp_Object val
, insdef
, insdef1
, tem
;
3023 struct gcpro gcpro1
, gcpro2
;
3024 register char *homedir
;
3028 dir
= current_buffer
->directory
;
3030 defalt
= current_buffer
->filename
;
3032 /* If dir starts with user's homedir, change that to ~. */
3033 homedir
= (char *) egetenv ("HOME");
3035 && XTYPE (dir
) == Lisp_String
3036 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3037 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3039 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3040 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3041 XSTRING (dir
)->data
[0] = '~';
3044 if (insert_default_directory
)
3048 if (!NILP (initial
))
3050 Lisp_Object args
[2], pos
;
3054 insdef
= Fconcat (2, args
);
3055 pos
= make_number (XSTRING (dir
)->size
);
3056 insdef1
= Fcons (insdef
, pos
);
3060 insdef
= Qnil
, insdef1
= Qnil
;
3063 count
= specpdl_ptr
- specpdl
;
3064 specbind (intern ("completion-ignore-case"), Qt
);
3067 GCPRO2 (insdef
, defalt
);
3068 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3069 dir
, mustmatch
, insdef1
,
3070 Qfile_name_history
);
3073 unbind_to (count
, Qnil
);
3078 error ("No file name specified");
3079 tem
= Fstring_equal (val
, insdef
);
3080 if (!NILP (tem
) && !NILP (defalt
))
3082 return Fsubstitute_in_file_name (val
);
3085 #if 0 /* Old version */
3086 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3087 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3088 Value is not expanded---you must call `expand-file-name' yourself.\n\
3089 Default name to DEFAULT if user enters a null string.\n\
3090 (If DEFAULT is omitted, the visited file name is used.)\n\
3091 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3092 Non-nil and non-t means also require confirmation after completion.\n\
3093 Fifth arg INITIAL specifies text to start with.\n\
3094 DIR defaults to current buffer's directory default.")
3095 (prompt
, dir
, defalt
, mustmatch
, initial
)
3096 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3098 Lisp_Object val
, insdef
, tem
;
3099 struct gcpro gcpro1
, gcpro2
;
3100 register char *homedir
;
3104 dir
= current_buffer
->directory
;
3106 defalt
= current_buffer
->filename
;
3108 /* If dir starts with user's homedir, change that to ~. */
3109 homedir
= (char *) egetenv ("HOME");
3111 && XTYPE (dir
) == Lisp_String
3112 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3113 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3115 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3116 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3117 XSTRING (dir
)->data
[0] = '~';
3120 if (!NILP (initial
))
3122 else if (insert_default_directory
)
3125 insdef
= build_string ("");
3128 count
= specpdl_ptr
- specpdl
;
3129 specbind (intern ("completion-ignore-case"), Qt
);
3132 GCPRO2 (insdef
, defalt
);
3133 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3135 insert_default_directory
? insdef
: Qnil
,
3136 Qfile_name_history
);
3139 unbind_to (count
, Qnil
);
3144 error ("No file name specified");
3145 tem
= Fstring_equal (val
, insdef
);
3146 if (!NILP (tem
) && !NILP (defalt
))
3148 return Fsubstitute_in_file_name (val
);
3150 #endif /* Old version */
3154 Qexpand_file_name
= intern ("expand-file-name");
3155 Qdirectory_file_name
= intern ("directory-file-name");
3156 Qfile_name_directory
= intern ("file-name-directory");
3157 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3158 Qfile_name_as_directory
= intern ("file-name-as-directory");
3159 Qcopy_file
= intern ("copy-file");
3160 Qmake_directory
= intern ("make-directory");
3161 Qdelete_directory
= intern ("delete-directory");
3162 Qdelete_file
= intern ("delete-file");
3163 Qrename_file
= intern ("rename-file");
3164 Qadd_name_to_file
= intern ("add-name-to-file");
3165 Qmake_symbolic_link
= intern ("make-symbolic-link");
3166 Qfile_exists_p
= intern ("file-exists-p");
3167 Qfile_executable_p
= intern ("file-executable-p");
3168 Qfile_readable_p
= intern ("file-readable-p");
3169 Qfile_symlink_p
= intern ("file-symlink-p");
3170 Qfile_writable_p
= intern ("file-writable-p");
3171 Qfile_directory_p
= intern ("file-directory-p");
3172 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3173 Qfile_modes
= intern ("file-modes");
3174 Qset_file_modes
= intern ("set-file-modes");
3175 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3176 Qinsert_file_contents
= intern ("insert-file-contents");
3177 Qwrite_region
= intern ("write-region");
3178 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3180 Qfile_name_history
= intern ("file-name-history");
3181 Fset (Qfile_name_history
, Qnil
);
3183 staticpro (&Qcopy_file
);
3184 staticpro (&Qmake_directory
);
3185 staticpro (&Qdelete_directory
);
3186 staticpro (&Qdelete_file
);
3187 staticpro (&Qrename_file
);
3188 staticpro (&Qadd_name_to_file
);
3189 staticpro (&Qmake_symbolic_link
);
3190 staticpro (&Qfile_exists_p
);
3191 staticpro (&Qfile_executable_p
);
3192 staticpro (&Qfile_readable_p
);
3193 staticpro (&Qfile_symlink_p
);
3194 staticpro (&Qfile_writable_p
);
3195 staticpro (&Qfile_directory_p
);
3196 staticpro (&Qfile_accessible_directory_p
);
3197 staticpro (&Qfile_modes
);
3198 staticpro (&Qset_file_modes
);
3199 staticpro (&Qfile_newer_than_file_p
);
3200 staticpro (&Qinsert_file_contents
);
3201 staticpro (&Qwrite_region
);
3202 staticpro (&Qverify_visited_file_modtime
);
3203 staticpro (&Qfile_name_history
);
3205 Qfile_error
= intern ("file-error");
3206 staticpro (&Qfile_error
);
3207 Qfile_already_exists
= intern("file-already-exists");
3208 staticpro (&Qfile_already_exists
);
3210 Fput (Qfile_error
, Qerror_conditions
,
3211 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3212 Fput (Qfile_error
, Qerror_message
,
3213 build_string ("File error"));
3215 Fput (Qfile_already_exists
, Qerror_conditions
,
3216 Fcons (Qfile_already_exists
,
3217 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3218 Fput (Qfile_already_exists
, Qerror_message
,
3219 build_string ("File already exists"));
3221 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3222 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3223 insert_default_directory
= 1;
3225 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3226 "*Non-nil means write new files with record format `stmlf'.\n\
3227 nil means use format `var'. This variable is meaningful only on VMS.");
3228 vms_stmlf_recfm
= 0;
3230 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3231 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3232 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3235 The first argument given to HANDLER is the name of the I/O primitive\n\
3236 to be handled; the remaining arguments are the arguments that were\n\
3237 passed to that primitive. For example, if you do\n\
3238 (file-exists-p FILENAME)\n\
3239 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3240 (funcall HANDLER 'file-exists-p FILENAME)");
3241 Vfile_name_handler_alist
= Qnil
;
3243 defsubr (&Sfile_name_directory
);
3244 defsubr (&Sfile_name_nondirectory
);
3245 defsubr (&Sfile_name_as_directory
);
3246 defsubr (&Sdirectory_file_name
);
3247 defsubr (&Smake_temp_name
);
3248 defsubr (&Sexpand_file_name
);
3249 defsubr (&Ssubstitute_in_file_name
);
3250 defsubr (&Scopy_file
);
3251 defsubr (&Smake_directory
);
3252 defsubr (&Sdelete_directory
);
3253 defsubr (&Sdelete_file
);
3254 defsubr (&Srename_file
);
3255 defsubr (&Sadd_name_to_file
);
3257 defsubr (&Smake_symbolic_link
);
3258 #endif /* S_IFLNK */
3260 defsubr (&Sdefine_logical_name
);
3263 defsubr (&Ssysnetunam
);
3264 #endif /* HPUX_NET */
3265 defsubr (&Sfile_name_absolute_p
);
3266 defsubr (&Sfile_exists_p
);
3267 defsubr (&Sfile_executable_p
);
3268 defsubr (&Sfile_readable_p
);
3269 defsubr (&Sfile_writable_p
);
3270 defsubr (&Sfile_symlink_p
);
3271 defsubr (&Sfile_directory_p
);
3272 defsubr (&Sfile_accessible_directory_p
);
3273 defsubr (&Sfile_modes
);
3274 defsubr (&Sset_file_modes
);
3275 defsubr (&Sset_umask
);
3277 defsubr (&Sfile_newer_than_file_p
);
3278 defsubr (&Sinsert_file_contents
);
3279 defsubr (&Swrite_region
);
3280 defsubr (&Sverify_visited_file_modtime
);
3281 defsubr (&Sclear_visited_file_modtime
);
3282 defsubr (&Sset_visited_file_modtime
);
3283 defsubr (&Sdo_auto_save
);
3284 defsubr (&Sset_buffer_auto_saved
);
3285 defsubr (&Srecent_auto_save_p
);
3287 defsubr (&Sread_file_name_internal
);
3288 defsubr (&Sread_file_name
);
3291 defsubr (&Sunix_sync
);