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 Kludgy feature: if START is a string, then that string is written\n\
2390 to the file, instead of any buffer contents, and END is ignored.")
2391 (start
, end
, filename
, append
, visit
)
2392 Lisp_Object start
, end
, filename
, append
, visit
;
2400 int count
= specpdl_ptr
- specpdl
;
2402 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2404 Lisp_Object handler
;
2405 struct gcpro gcpro1
, gcpro2
;
2407 /* Special kludge to simplify auto-saving */
2410 XFASTINT (start
) = BEG
;
2413 else if (XTYPE (start
) != Lisp_String
)
2414 validate_region (&start
, &end
);
2416 GCPRO2 (start
, filename
);
2417 filename
= Fexpand_file_name (filename
, Qnil
);
2419 /* If the file name has special constructs in it,
2420 call the corresponding file handler. */
2421 handler
= find_file_handler (filename
);
2423 if (!NILP (handler
))
2425 Lisp_Object args
[7];
2428 args
[1] = Qwrite_region
;
2434 val
= Ffuncall (7, args
);
2436 /* Do this before reporting IO error
2437 to avoid a "file has changed on disk" warning on
2438 next attempt to save. */
2441 current_buffer
->modtime
= 0;
2442 current_buffer
->save_modified
= MODIFF
;
2443 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2444 current_buffer
->filename
= filename
;
2450 #ifdef CLASH_DETECTION
2452 lock_file (filename
);
2453 #endif /* CLASH_DETECTION */
2455 fn
= XSTRING (filename
)->data
;
2458 desc
= open (fn
, O_WRONLY
);
2462 if (auto_saving
) /* Overwrite any previous version of autosave file */
2464 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2465 desc
= open (fn
, O_RDWR
);
2467 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2468 ? XSTRING (current_buffer
->filename
)->data
: 0,
2471 else /* Write to temporary name and rename if no errors */
2473 Lisp_Object temp_name
;
2474 temp_name
= Ffile_name_directory (filename
);
2476 if (!NILP (temp_name
))
2478 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2479 build_string ("$$SAVE$$")));
2480 fname
= XSTRING (filename
)->data
;
2481 fn
= XSTRING (temp_name
)->data
;
2482 desc
= creat_copy_attrs (fname
, fn
);
2485 /* If we can't open the temporary file, try creating a new
2486 version of the original file. VMS "creat" creates a
2487 new version rather than truncating an existing file. */
2490 desc
= creat (fn
, 0666);
2491 #if 0 /* This can clobber an existing file and fail to replace it,
2492 if the user runs out of space. */
2495 /* We can't make a new version;
2496 try to truncate and rewrite existing version if any. */
2498 desc
= open (fn
, O_RDWR
);
2504 desc
= creat (fn
, 0666);
2507 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2508 #endif /* not VMS */
2514 #ifdef CLASH_DETECTION
2516 if (!auto_saving
) unlock_file (filename
);
2518 #endif /* CLASH_DETECTION */
2519 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2522 record_unwind_protect (close_file_unwind
, make_number (desc
));
2525 if (lseek (desc
, 0, 2) < 0)
2527 #ifdef CLASH_DETECTION
2528 if (!auto_saving
) unlock_file (filename
);
2529 #endif /* CLASH_DETECTION */
2530 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2535 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2536 * if we do writes that don't end with a carriage return. Furthermore
2537 * it cannot handle writes of more then 16K. The modified
2538 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2539 * this EXCEPT for the last record (iff it doesn't end with a carriage
2540 * return). This implies that if your buffer doesn't end with a carriage
2541 * return, you get one free... tough. However it also means that if
2542 * we make two calls to sys_write (a la the following code) you can
2543 * get one at the gap as well. The easiest way to fix this (honest)
2544 * is to move the gap to the next newline (or the end of the buffer).
2549 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2550 move_gap (find_next_newline (GPT
, 1));
2556 if (XTYPE (start
) == Lisp_String
)
2558 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2559 XSTRING (start
)->size
);
2562 else if (XINT (start
) != XINT (end
))
2564 if (XINT (start
) < GPT
)
2566 register int end1
= XINT (end
);
2568 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2569 min (GPT
, end1
) - tem
);
2573 if (XINT (end
) > GPT
&& !failure
)
2576 tem
= max (tem
, GPT
);
2577 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2587 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2588 Disk full in NFS may be reported here. */
2589 if (fsync (desc
) < 0)
2590 failure
= 1, save_errno
= errno
;
2595 /* Spurious "file has changed on disk" warnings have been
2596 observed on Suns as well.
2597 It seems that `close' can change the modtime, under nfs.
2599 (This has supposedly been fixed in Sunos 4,
2600 but who knows about all the other machines with NFS?) */
2603 /* On VMS and APOLLO, must do the stat after the close
2604 since closing changes the modtime. */
2607 /* Recall that #if defined does not work on VMS. */
2614 /* NFS can report a write failure now. */
2615 if (close (desc
) < 0)
2616 failure
= 1, save_errno
= errno
;
2619 /* If we wrote to a temporary name and had no errors, rename to real name. */
2623 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2631 /* Discard the unwind protect */
2632 specpdl_ptr
= specpdl
+ count
;
2634 #ifdef CLASH_DETECTION
2636 unlock_file (filename
);
2637 #endif /* CLASH_DETECTION */
2639 /* Do this before reporting IO error
2640 to avoid a "file has changed on disk" warning on
2641 next attempt to save. */
2643 current_buffer
->modtime
= st
.st_mtime
;
2646 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2650 current_buffer
->save_modified
= MODIFF
;
2651 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2652 current_buffer
->filename
= filename
;
2654 else if (!NILP (visit
))
2658 message ("Wrote %s", fn
);
2664 e_write (desc
, addr
, len
)
2666 register char *addr
;
2669 char buf
[16 * 1024];
2670 register char *p
, *end
;
2672 if (!EQ (current_buffer
->selective_display
, Qt
))
2673 return write (desc
, addr
, len
) - len
;
2677 end
= p
+ sizeof buf
;
2682 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2691 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2697 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2698 Sverify_visited_file_modtime
, 1, 1, 0,
2699 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2700 This means that the file has not been changed since it was visited or saved.")
2706 Lisp_Object handler
;
2708 CHECK_BUFFER (buf
, 0);
2711 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2712 if (b
->modtime
== 0) return Qt
;
2714 /* If the file name has special constructs in it,
2715 call the corresponding file handler. */
2716 handler
= find_file_handler (b
->filename
);
2717 if (!NILP (handler
))
2718 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2720 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2722 /* If the file doesn't exist now and didn't exist before,
2723 we say that it isn't modified, provided the error is a tame one. */
2724 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2729 if (st
.st_mtime
== b
->modtime
2730 /* If both are positive, accept them if they are off by one second. */
2731 || (st
.st_mtime
> 0 && b
->modtime
> 0
2732 && (st
.st_mtime
== b
->modtime
+ 1
2733 || st
.st_mtime
== b
->modtime
- 1)))
2738 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2739 Sclear_visited_file_modtime
, 0, 0, 0,
2740 "Clear out records of last mod time of visited file.\n\
2741 Next attempt to save will certainly not complain of a discrepancy.")
2744 current_buffer
->modtime
= 0;
2748 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2749 Sset_visited_file_modtime
, 0, 0, 0,
2750 "Update buffer's recorded modification time from the visited file's time.\n\
2751 Useful if the buffer was not read from the file normally\n\
2752 or if the file itself has been changed for some known benign reason.")
2755 register Lisp_Object filename
;
2757 Lisp_Object handler
;
2759 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2761 /* If the file name has special constructs in it,
2762 call the corresponding file handler. */
2763 handler
= find_file_handler (filename
);
2764 if (!NILP (handler
))
2765 current_buffer
->modtime
= 0;
2767 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2768 current_buffer
->modtime
= st
.st_mtime
;
2776 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2779 message ("Autosaving...error for %s", name
);
2780 Fsleep_for (make_number (1), Qnil
);
2781 message ("Autosaving...error!for %s", name
);
2782 Fsleep_for (make_number (1), Qnil
);
2783 message ("Autosaving...error for %s", name
);
2784 Fsleep_for (make_number (1), Qnil
);
2794 /* Get visited file's mode to become the auto save file's mode. */
2795 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2796 /* But make sure we can overwrite it later! */
2797 auto_save_mode_bits
= st
.st_mode
| 0600;
2799 auto_save_mode_bits
= 0666;
2802 Fwrite_region (Qnil
, Qnil
,
2803 current_buffer
->auto_save_file_name
,
2807 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2808 "Auto-save all buffers that need it.\n\
2809 This is all buffers that have auto-saving enabled\n\
2810 and are changed since last auto-saved.\n\
2811 Auto-saving writes the buffer into a file\n\
2812 so that your editing is not lost if the system crashes.\n\
2813 This file is not the file you visited; that changes only when you save.\n\n\
2814 Non-nil first argument means do not print any message if successful.\n\
2815 Non-nil second argument means save only current buffer.")
2819 struct buffer
*old
= current_buffer
, *b
;
2820 Lisp_Object tail
, buf
;
2822 char *omessage
= echo_area_glyphs
;
2823 extern minibuf_level
;
2825 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2826 point to non-strings reached from Vbuffer_alist. */
2832 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2833 eventually call do-auto-save, so don't err here in that case. */
2834 if (!NILP (Vrun_hooks
))
2835 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2837 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2838 tail
= XCONS (tail
)->cdr
)
2840 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2842 /* Check for auto save enabled
2843 and file changed since last auto save
2844 and file changed since last real save. */
2845 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2846 && b
->save_modified
< BUF_MODIFF (b
)
2847 && b
->auto_save_modified
< BUF_MODIFF (b
))
2849 if ((XFASTINT (b
->save_length
) * 10
2850 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2851 /* A short file is likely to change a large fraction;
2852 spare the user annoying messages. */
2853 && XFASTINT (b
->save_length
) > 5000
2854 /* These messages are frequent and annoying for `*mail*'. */
2855 && !EQ (b
->filename
, Qnil
))
2857 /* It has shrunk too much; turn off auto-saving here. */
2858 message ("Buffer %s has shrunk a lot; auto save turned off there",
2859 XSTRING (b
->name
)->data
);
2860 /* User can reenable saving with M-x auto-save. */
2861 b
->auto_save_file_name
= Qnil
;
2862 /* Prevent warning from repeating if user does so. */
2863 XFASTINT (b
->save_length
) = 0;
2864 Fsleep_for (make_number (1), Qnil
);
2867 set_buffer_internal (b
);
2868 if (!auto_saved
&& NILP (nomsg
))
2869 message1 ("Auto-saving...");
2870 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2872 b
->auto_save_modified
= BUF_MODIFF (b
);
2873 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2874 set_buffer_internal (old
);
2878 /* Prevent another auto save till enough input events come in. */
2879 record_auto_save ();
2881 if (auto_saved
&& NILP (nomsg
))
2882 message1 (omessage
? omessage
: "Auto-saving...done");
2888 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2889 Sset_buffer_auto_saved
, 0, 0, 0,
2890 "Mark current buffer as auto-saved with its current text.\n\
2891 No auto-save file will be written until the buffer changes again.")
2894 current_buffer
->auto_save_modified
= MODIFF
;
2895 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2899 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2901 "Return t if buffer has been auto-saved since last read in or saved.")
2904 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2907 /* Reading and completing file names */
2908 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2910 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2912 "Internal subroutine for read-file-name. Do not call this.")
2913 (string
, dir
, action
)
2914 Lisp_Object string
, dir
, action
;
2915 /* action is nil for complete, t for return list of completions,
2916 lambda for verify final value */
2918 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2920 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2927 /* No need to protect ACTION--we only compare it with t and nil. */
2928 GCPRO4 (string
, realdir
, name
, specdir
);
2930 if (XSTRING (string
)->size
== 0)
2932 if (EQ (action
, Qlambda
))
2940 orig_string
= string
;
2941 string
= Fsubstitute_in_file_name (string
);
2942 changed
= NILP (Fstring_equal (string
, orig_string
));
2943 name
= Ffile_name_nondirectory (string
);
2944 val
= Ffile_name_directory (string
);
2946 realdir
= Fexpand_file_name (val
, realdir
);
2951 specdir
= Ffile_name_directory (string
);
2952 val
= Ffile_name_completion (name
, realdir
);
2954 if (XTYPE (val
) != Lisp_String
)
2961 if (!NILP (specdir
))
2962 val
= concat2 (specdir
, val
);
2965 register unsigned char *old
, *new;
2969 osize
= XSTRING (val
)->size
;
2970 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2971 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2972 if (*old
++ == '$') count
++;
2975 old
= XSTRING (val
)->data
;
2976 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2977 new = XSTRING (val
)->data
;
2978 for (n
= osize
; n
> 0; n
--)
2989 #endif /* Not VMS */
2994 if (EQ (action
, Qt
))
2995 return Ffile_name_all_completions (name
, realdir
);
2996 /* Only other case actually used is ACTION = lambda */
2998 /* Supposedly this helps commands such as `cd' that read directory names,
2999 but can someone explain how it helps them? -- RMS */
3000 if (XSTRING (name
)->size
== 0)
3003 return Ffile_exists_p (string
);
3006 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3007 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3008 Value is not expanded---you must call `expand-file-name' yourself.\n\
3009 Default name to DEFAULT if user enters a null string.\n\
3010 (If DEFAULT is omitted, the visited file name is used.)\n\
3011 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3012 Non-nil and non-t means also require confirmation after completion.\n\
3013 Fifth arg INITIAL specifies text to start with.\n\
3014 DIR defaults to current buffer's directory default.")
3015 (prompt
, dir
, defalt
, mustmatch
, initial
)
3016 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3018 Lisp_Object val
, insdef
, insdef1
, tem
;
3019 struct gcpro gcpro1
, gcpro2
;
3020 register char *homedir
;
3024 dir
= current_buffer
->directory
;
3026 defalt
= current_buffer
->filename
;
3028 /* If dir starts with user's homedir, change that to ~. */
3029 homedir
= (char *) egetenv ("HOME");
3031 && XTYPE (dir
) == Lisp_String
3032 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3033 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3035 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3036 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3037 XSTRING (dir
)->data
[0] = '~';
3040 if (insert_default_directory
)
3044 if (!NILP (initial
))
3046 Lisp_Object args
[2], pos
;
3050 insdef
= Fconcat (2, args
);
3051 pos
= make_number (XSTRING (dir
)->size
);
3052 insdef1
= Fcons (insdef
, pos
);
3056 insdef
= Qnil
, insdef1
= Qnil
;
3059 count
= specpdl_ptr
- specpdl
;
3060 specbind (intern ("completion-ignore-case"), Qt
);
3063 GCPRO2 (insdef
, defalt
);
3064 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3065 dir
, mustmatch
, insdef1
,
3066 Qfile_name_history
);
3069 unbind_to (count
, Qnil
);
3074 error ("No file name specified");
3075 tem
= Fstring_equal (val
, insdef
);
3076 if (!NILP (tem
) && !NILP (defalt
))
3078 return Fsubstitute_in_file_name (val
);
3081 #if 0 /* Old version */
3082 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3083 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3084 Value is not expanded---you must call `expand-file-name' yourself.\n\
3085 Default name to DEFAULT if user enters a null string.\n\
3086 (If DEFAULT is omitted, the visited file name is used.)\n\
3087 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3088 Non-nil and non-t means also require confirmation after completion.\n\
3089 Fifth arg INITIAL specifies text to start with.\n\
3090 DIR defaults to current buffer's directory default.")
3091 (prompt
, dir
, defalt
, mustmatch
, initial
)
3092 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3094 Lisp_Object val
, insdef
, tem
;
3095 struct gcpro gcpro1
, gcpro2
;
3096 register char *homedir
;
3100 dir
= current_buffer
->directory
;
3102 defalt
= current_buffer
->filename
;
3104 /* If dir starts with user's homedir, change that to ~. */
3105 homedir
= (char *) egetenv ("HOME");
3107 && XTYPE (dir
) == Lisp_String
3108 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3109 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3111 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3112 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3113 XSTRING (dir
)->data
[0] = '~';
3116 if (!NILP (initial
))
3118 else if (insert_default_directory
)
3121 insdef
= build_string ("");
3124 count
= specpdl_ptr
- specpdl
;
3125 specbind (intern ("completion-ignore-case"), Qt
);
3128 GCPRO2 (insdef
, defalt
);
3129 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3131 insert_default_directory
? insdef
: Qnil
,
3132 Qfile_name_history
);
3135 unbind_to (count
, Qnil
);
3140 error ("No file name specified");
3141 tem
= Fstring_equal (val
, insdef
);
3142 if (!NILP (tem
) && !NILP (defalt
))
3144 return Fsubstitute_in_file_name (val
);
3146 #endif /* Old version */
3150 Qexpand_file_name
= intern ("expand-file-name");
3151 Qdirectory_file_name
= intern ("directory-file-name");
3152 Qfile_name_directory
= intern ("file-name-directory");
3153 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3154 Qfile_name_as_directory
= intern ("file-name-as-directory");
3155 Qcopy_file
= intern ("copy-file");
3156 Qmake_directory
= intern ("make-directory");
3157 Qdelete_directory
= intern ("delete-directory");
3158 Qdelete_file
= intern ("delete-file");
3159 Qrename_file
= intern ("rename-file");
3160 Qadd_name_to_file
= intern ("add-name-to-file");
3161 Qmake_symbolic_link
= intern ("make-symbolic-link");
3162 Qfile_exists_p
= intern ("file-exists-p");
3163 Qfile_executable_p
= intern ("file-executable-p");
3164 Qfile_readable_p
= intern ("file-readable-p");
3165 Qfile_symlink_p
= intern ("file-symlink-p");
3166 Qfile_writable_p
= intern ("file-writable-p");
3167 Qfile_directory_p
= intern ("file-directory-p");
3168 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3169 Qfile_modes
= intern ("file-modes");
3170 Qset_file_modes
= intern ("set-file-modes");
3171 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3172 Qinsert_file_contents
= intern ("insert-file-contents");
3173 Qwrite_region
= intern ("write-region");
3174 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3176 Qfile_name_history
= intern ("file-name-history");
3177 Fset (Qfile_name_history
, Qnil
);
3179 staticpro (&Qcopy_file
);
3180 staticpro (&Qmake_directory
);
3181 staticpro (&Qdelete_directory
);
3182 staticpro (&Qdelete_file
);
3183 staticpro (&Qrename_file
);
3184 staticpro (&Qadd_name_to_file
);
3185 staticpro (&Qmake_symbolic_link
);
3186 staticpro (&Qfile_exists_p
);
3187 staticpro (&Qfile_executable_p
);
3188 staticpro (&Qfile_readable_p
);
3189 staticpro (&Qfile_symlink_p
);
3190 staticpro (&Qfile_writable_p
);
3191 staticpro (&Qfile_directory_p
);
3192 staticpro (&Qfile_accessible_directory_p
);
3193 staticpro (&Qfile_modes
);
3194 staticpro (&Qset_file_modes
);
3195 staticpro (&Qfile_newer_than_file_p
);
3196 staticpro (&Qinsert_file_contents
);
3197 staticpro (&Qwrite_region
);
3198 staticpro (&Qverify_visited_file_modtime
);
3199 staticpro (&Qfile_name_history
);
3201 Qfile_error
= intern ("file-error");
3202 staticpro (&Qfile_error
);
3203 Qfile_already_exists
= intern("file-already-exists");
3204 staticpro (&Qfile_already_exists
);
3206 Fput (Qfile_error
, Qerror_conditions
,
3207 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3208 Fput (Qfile_error
, Qerror_message
,
3209 build_string ("File error"));
3211 Fput (Qfile_already_exists
, Qerror_conditions
,
3212 Fcons (Qfile_already_exists
,
3213 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3214 Fput (Qfile_already_exists
, Qerror_message
,
3215 build_string ("File already exists"));
3217 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3218 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3219 insert_default_directory
= 1;
3221 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3222 "*Non-nil means write new files with record format `stmlf'.\n\
3223 nil means use format `var'. This variable is meaningful only on VMS.");
3224 vms_stmlf_recfm
= 0;
3226 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3227 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3228 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3231 The first argument given to HANDLER is the name of the I/O primitive\n\
3232 to be handled; the remaining arguments are the arguments that were\n\
3233 passed to that primitive. For example, if you do\n\
3234 (file-exists-p FILENAME)\n\
3235 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3236 (funcall HANDLER 'file-exists-p FILENAME)");
3237 Vfile_name_handler_alist
= Qnil
;
3239 defsubr (&Sfile_name_directory
);
3240 defsubr (&Sfile_name_nondirectory
);
3241 defsubr (&Sfile_name_as_directory
);
3242 defsubr (&Sdirectory_file_name
);
3243 defsubr (&Smake_temp_name
);
3244 defsubr (&Sexpand_file_name
);
3245 defsubr (&Ssubstitute_in_file_name
);
3246 defsubr (&Scopy_file
);
3247 defsubr (&Smake_directory
);
3248 defsubr (&Sdelete_directory
);
3249 defsubr (&Sdelete_file
);
3250 defsubr (&Srename_file
);
3251 defsubr (&Sadd_name_to_file
);
3253 defsubr (&Smake_symbolic_link
);
3254 #endif /* S_IFLNK */
3256 defsubr (&Sdefine_logical_name
);
3259 defsubr (&Ssysnetunam
);
3260 #endif /* HPUX_NET */
3261 defsubr (&Sfile_name_absolute_p
);
3262 defsubr (&Sfile_exists_p
);
3263 defsubr (&Sfile_executable_p
);
3264 defsubr (&Sfile_readable_p
);
3265 defsubr (&Sfile_writable_p
);
3266 defsubr (&Sfile_symlink_p
);
3267 defsubr (&Sfile_directory_p
);
3268 defsubr (&Sfile_accessible_directory_p
);
3269 defsubr (&Sfile_modes
);
3270 defsubr (&Sset_file_modes
);
3271 defsubr (&Sset_umask
);
3273 defsubr (&Sfile_newer_than_file_p
);
3274 defsubr (&Sinsert_file_contents
);
3275 defsubr (&Swrite_region
);
3276 defsubr (&Sverify_visited_file_modtime
);
3277 defsubr (&Sclear_visited_file_modtime
);
3278 defsubr (&Sset_visited_file_modtime
);
3279 defsubr (&Sdo_auto_save
);
3280 defsubr (&Sset_buffer_auto_saved
);
3281 defsubr (&Srecent_auto_save_p
);
3283 defsubr (&Sread_file_name_internal
);
3284 defsubr (&Sread_file_name
);
3287 defsubr (&Sunix_sync
);